diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index d5628002..46141271 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -35,7 +35,7 @@ jobs: - name: Install OCaml uses: avsm/setup-ocaml@v1 with: - ocaml-version: 4.07.1 + ocaml-version: 4.14.1 # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - name: Checkout repo @@ -45,6 +45,6 @@ jobs: - name: Build run: | opam repo add coq-released https://coq.inria.fr/opam/released - opam install coq.8.14.0 coq-equations.1.3+8.14 coq-mathcomp-ssreflect.1.13.0 coq-mathcomp-analysis.0.3.13 coq-extructures.0.3.1 coq-deriving.0.1.0 + opam install coq.8.18.0 coq-equations.1.3+8.18 coq-mathcomp-ssreflect.2.1.0 coq-mathcomp-analysis.1.0.0 coq-extructures.0.4.0 coq-deriving.0.2.0 opam exec -- make -j4 diff --git a/DOC.md b/DOC.md index 8aff46d2..30829a04 100644 --- a/DOC.md +++ b/DOC.md @@ -421,7 +421,7 @@ Proof. (* Now deal with the goals *) ``` -Finally the identity package is defined as `ID I` where `I` is an interface. +Finally, the identity package is defined as `ID I` where `I` is an interface. It both imports and exports `I` by simply forwarding the calls. It is valid as long as `I` does not include two signatures sharing the same identifier, as overloading is not possible in our packages. This property is @@ -790,7 +790,7 @@ then applying `ssprove_swap_lhs 0%N` will leave us to prove ``` instead. -Not any two commands are swappable however. The tactic will try to infer the +However, not any two commands are swappable. The tactic will try to infer the swappability condition automatically, this is the case for sampling which can always be swapped (if dependencies permit), or for `get`/`put` when they talk about distinct locations. If automation proves insufficient, the user will have @@ -900,7 +900,7 @@ and turn it into #### Remember after reading Sometimes, swapping and contracting is not possible, even when the code makes -two reads to the same location. It can happen for instance if the the value read +two reads to the same location. It can happen for instance if the value read is branched upon before being read again. For this we have several rules that will *remember* which location was read. @@ -978,7 +978,7 @@ Dually to how we *remember* read values, we propose a way to write to a memory location, even when it might temporarily break the invariant. As we will se in [[Crafting invariants]], a lot of invariants will involve several locations at once, meaning the most of the time, writing a value will break them. -Thus our machinery to write to the memory freely and then, at the user's +Thus, our machinery to write to the memory freely and then, at the user's command, to restore the invariant. These debts to the precondition are incurred by using one of the following @@ -1060,7 +1060,7 @@ where `L₀` and `L₁` represent the sets of memory locations of both programs. While it can be enough for a lot of examples (our own examples mostly use equality as an invariant), it is not always sufficient. -Another invariant the we propose is called `heap_ignore` and is defined as +Another invariant we propose is called `heap_ignore` and is defined as ```coq Definition heap_ignore (L : {fset Location}) := λ '(h₀, h₁), diff --git a/README.md b/README.md index 869f9fc5..f4d9120b 100644 --- a/README.md +++ b/README.md @@ -2,15 +2,15 @@ This repository contains the Coq formalisation of the paper:\ **SSProve: A Foundational Framework for Modular Cryptographic Proofs in Coq** -- Conference version published at CSF 2021 (distinguished paper award). +- Extended journal version published at TOPLAS ([DOI](https://dl.acm.org/doi/10.1145/3594735)). + Philipp G. Haselwarter, Exequiel Rivas, Antoine Van Muylder, Théo Winterhalter, + Carmine Abate, Nikolaj Sidorenco, Cătălin Hrițcu, Kenji Maillard, and + Bas Spitters. ([eprint](https://eprint.iacr.org/2021/397)) +- Conference version published at CSF 2021 (**distinguished paper award**). Carmine Abate, Philipp G. Haselwarter, Exequiel Rivas, Antoine Van Muylder, Théo Winterhalter, Cătălin Hrițcu, Kenji Maillard, and Bas Spitters. ([ieee](https://www.computer.org/csdl/proceedings-article/csf/2021/760700a608/1uvIdwNa5Ne), [eprint](https://eprint.iacr.org/2021/397/20210526:113037)) -- Extended version under journal review. - Carmine Abate, Philipp G. Haselwarter, Exequiel Rivas, Antoine Van Muylder, - Théo Winterhalter, Nikolaj Sidorenco, Cătălin Hrițcu, Kenji Maillard, and - Bas Spitters. ([eprint](https://eprint.iacr.org/2021/397)) This README serves as a guide to running verification and finding the correspondence between the claims in the paper and the formal proofs in Coq, as @@ -31,11 +31,11 @@ A documentation is available in [DOC.md]. #### Prerequisites -- OCaml `>=4.05.0 & <4.13.0` -- Coq `8.14.0` -- Equations `1.3+8.14` -- Mathcomp `1.13.0` -- Mathcomp analysis `0.3.13` +- OCaml `>=4.05.0 & <5` +- Coq `>=8.16.0 & <8.18.0` +- Equations `1.3` +- Mathcomp `>=1.15.0` +- Mathcomp analysis `>=0.5.3` - Coq Extructures `0.3.1` - Coq Deriving `0.1` @@ -43,7 +43,7 @@ You can get them all from the `opam` package manager for OCaml: ```sh opam repo add coq-released https://coq.inria.fr/opam/released opam update -opam install ./ssprove-opam +opam install ./ssprove.opam ``` To build the dependency graph, you can optionally install `graphviz`. @@ -77,10 +77,14 @@ The formalisation of packages can be found in the [package] directory. The definition of packages can be found in [pkg_core_definition.v]. Herein, `package L I E` is the type of packages with set of locations `L`, -import interface `I` and export interface `E`. +import interface `I` and export interface `E`. It is defined on top of +`raw_package` which does not contain the information about its interfaces +and the locations it uses. Package laws, as introduced in the paper, are all stated and proven in -[pkg_composition.v] directly on raw packages. +[pkg_composition.v] directly on raw packages. This technical detail is not +mentioned in the paper, but we are nonetheless only interested in these +laws over proper packages whose interfaces match. #### Sequential composition @@ -195,7 +199,7 @@ more. Packages created through our operations always verify this property #### Interchange between sequential and parallel composition -Finally we prove a law involving sequential and parallel composition +Finally, we prove a law involving sequential and parallel composition stating how we can interchange them: ```coq Lemma interchange : @@ -331,7 +335,7 @@ Theorem commitment_binding : ɛ_soundness A Adv. ``` -Combining the above theorems with the instatiation of Schnorr's protocol we get a commitment scheme given by: +Combining the above theorems with the instantiation of Schnorr's protocol we get a commitment scheme given by: ```coq Theorem schnorr_com_hiding : @@ -388,7 +392,7 @@ We separate by a slash (/) rule names that differ in the CSF (left) and journal | async-put-lhs | `r_put_lhs` | | restore-pre-lhs | `r_restore_lhs` | -Finally the "bwhile" / "do-while" rule is proven as +Finally, the "bwhile" / "do-while" rule is proven as `bounded_do_while_rule` in [rules/RulesStateProb.v]. ### More Lemmas and Theorems for packages @@ -489,7 +493,7 @@ This relational effect observation is called file [rhl_semantics/only_prob/ThetaDex.v] as a composition: FreeProb² ---`unary_theta_dens²`---> SDistr² ---`θ_morph`---> Wrelprop -The first part `unary_theta_dens²` consists in intepreting pairs +The first part `unary_theta_dens²` consists in interpreting pairs of probabilistic programs into pairs of actual subdistributions. This unary semantics for probabilistic programs `unary_theta_dens` is defined in [rhl_semantics/only_prob/Theta_dens.v]. @@ -512,7 +516,7 @@ It is defined in the file [rhl_semantics/only_prob/Theta_exCP.v]. up to inequalities. The definition of `θ_morph` relies on the notion of couplings, defined in this file [rhl_semantics/only_prob/Couplings.v]. -The prove that it constitutes a lax morphism depends on lemmas +The proof that it constitutes a lax morphism depends on lemmas for couplings that can be found in the same file. @@ -585,8 +589,8 @@ a lax morphism Kl(θ) between those Kleisli adjunctions. Kl(θ) is a lax morphism between left relative adjunctions, (see [LaxMorphismOfRelAdjunctions.v]) and we can transform such morphisms of adjunctions using -the theory developped in [TransformingLaxMorph.v]. -Finallly, out of this transformed morphism of adjunctions we can +the theory developed in [TransformingLaxMorph.v]. +Finally, out of this transformed morphism of adjunctions we can extract a lax morphism between monads Tθ : T M1 → T M2, as expected. This last step is also performed in [TransformingLaxMorph.v]. diff --git a/_CoqProject b/_CoqProject index de0eb968..59e64d6a 100644 --- a/_CoqProject +++ b/_CoqProject @@ -1,6 +1,7 @@ -Q theories/Mon Mon -Q theories/Relational Relational -Q theories/Crypt Crypt +# -Q theories/Jasmin JasminSSProve theories/Mon/Base.v theories/Mon/SPropBase.v @@ -22,6 +23,10 @@ theories/Relational/Commutativity.v theories/Crypt/Prelude.v theories/Crypt/Axioms.v +theories/Crypt/jasmin_util.v +theories/Crypt/jasmin_wsize.v +theories/Crypt/jasmin_word.v +theories/Crypt/Casts.v theories/Crypt/choice_type.v # Categorical semantics @@ -76,18 +81,53 @@ theories/Crypt/rules/UniformStateProb.v #std. distributions # theories/Crypt/only_prob/SymmetricSchemeStateProbStdDistr.v +# # Jasmin +# theories/Jasmin/jasmin_translate.v +# theories/Jasmin/jasmin_x86.v +# theories/Jasmin/jasmin_asm.v +# theories/Jasmin/jasmin_utils.v +# theories/Jasmin/word.v + +# theories/Jasmin/examples/add1.v +# theories/Jasmin/examples/aes.v +# theories/Jasmin/examples/aes/aes_jazz.v +# theories/Jasmin/examples/bigadd.v +# theories/Jasmin/examples/ex.v +# theories/Jasmin/examples/int_add.v +# theories/Jasmin/examples/int_incr.v +# theories/Jasmin/examples/int_reg.v +# theories/Jasmin/examples/int_shift.v +# theories/Jasmin/examples/liveness_bork.v +# theories/Jasmin/examples/matrix_product.v +# theories/Jasmin/examples/retz.v +# theories/Jasmin/examples/test_for.v +# theories/Jasmin/examples/test_inline_var.v +# theories/Jasmin/examples/test_shift.v +# theories/Jasmin/examples/three_functions.v +# theories/Jasmin/examples/two_functions.v +# theories/Jasmin/examples/u64_incr.v +# theories/Jasmin/examples/xor.v + +# theories/Jasmin/examples/aes/aes.v +# theories/Jasmin/examples/aes/aes_prf.v +# theories/Jasmin/examples/aes/aes_utils.v +# theories/Jasmin/examples/aes/aes_valid.v +# theories/Jasmin/examples/aes/aes_spec.v + # Examples theories/Crypt/examples/package_usage_example.v theories/Crypt/examples/interpreter_test.v theories/Crypt/examples/concrete_groups.v theories/Crypt/examples/PRF.v theories/Crypt/examples/AsymScheme.v +theories/Crypt/examples/DDH.v theories/Crypt/examples/ElGamal.v theories/Crypt/examples/OTP.v theories/Crypt/examples/KEMDEM.v theories/Crypt/examples/RandomOracle.v theories/Crypt/examples/SigmaProtocol.v theories/Crypt/examples/Schnorr.v +theories/Crypt/examples/OVN.v # Printing the axioms of all results from the paper theories/Crypt/Main.v diff --git a/flake.lock b/flake.lock new file mode 100644 index 00000000..49c856c9 --- /dev/null +++ b/flake.lock @@ -0,0 +1,60 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1705309234, + "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1707824078, + "narHash": "sha256-Au3wLi2d06bU7TDvahP2jIEeKwmjAxKHqi8l2uiBkGA=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "99d7b32e4cfdaf763d9335b4d9ecf4415cbdc405", + "type": "github" + }, + "original": { + "owner": "nixos", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 00000000..f54ddbc3 --- /dev/null +++ b/flake.nix @@ -0,0 +1,51 @@ +{ + inputs = { + nixpkgs.url = github:nixos/nixpkgs; + flake-utils.url = github:numtide/flake-utils; + }; + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let + pkgs = nixpkgs.legacyPackages.${system}; + in + rec { + mkDrv = { stdenv, which, coqPackages, coq } : + let + extructures' = coqPackages.extructures.override { version = "0.4.0"; }; + in + stdenv.mkDerivation { + pname = "ssprove"; + version = "0.0.1"; + src = ./.; + nativeBuildInputs = [ which coq.ocamlPackages.findlib ] ++ + (with coqPackages; [ + equations + mathcomp-analysis + mathcomp-ssreflect + deriving + ]) + ++ [extructures']; + buildInputs = [ coq ]; + }; + + devShell = + let + args = { + inherit (pkgs) stdenv which; + coq = pkgs.coq_8_18; + coqPackages = pkgs.coqPackages_8_18.overrideScope + (self: super: { + mathcomp = super.mathcomp.override { version = "2.1.0"; }; + mathcomp-analysis = super.mathcomp-analysis.override { version = "1.0.0"; }; + }); + }; + ssprove' = mkDrv args; + in + pkgs.mkShell { + packages = + (with pkgs; [ coq gnumake ]) + ++ + (with ssprove'; nativeBuildInputs); + }; + }); +} diff --git a/ssprove.opam b/ssprove.opam index 71b11cd6..a56f190c 100644 --- a/ssprove.opam +++ b/ssprove.opam @@ -8,12 +8,14 @@ homepage: "https://github.com/SSProve/ssprove" bug-reports: "https://github.com/SSProve/ssprove/issues" license: "MIT" depends: [ - "coq" {>= "8.14"} - "coq-equations" {>= "1.3"} - "coq-mathcomp-ssreflect" {(>= "1.13.0" & < "1.14~")} - "coq-mathcomp-analysis" {= "0.3.13"} - "coq-extructures" {(>= "0.3.1" & < "dev")} - "coq-deriving" {(>= "0.1" & < "dev")} + "coq" {>= "8.18"} + "coq-equations" {>= "1.3+8.18"} + "coq-mathcomp-ssreflect" {(>= "2.1.0")} + "coq-mathcomp-analysis" {= "1.0.0"} + "coq-mathcomp-word" {>= "3.0" & < "3.2"} + "coq-extructures" {(>= "0.4.0" & < "dev")} + "coq-deriving" {(>= "0.2.0" & < "dev")} + "coq-mathcomp-zify" {>= "1.5.0+2.0+8.16"} ] build: [ [make "-j%{jobs}%"] diff --git a/theories/Crypt/Casts.v b/theories/Crypt/Casts.v new file mode 100644 index 00000000..402733b6 --- /dev/null +++ b/theories/Crypt/Casts.v @@ -0,0 +1,67 @@ +Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". +From mathcomp Require Import ssreflect ssrbool ssrnat choice fintype eqtype all_algebra. +Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". + +From deriving Require Import deriving. +From Coq Require Import ZArith. + +From extructures Require Import ord fmap. +From Crypt Require Import Prelude. + +From HB Require Import structures. + +From mathcomp Require Import word_ssrZ word. +From Crypt Require Import jasmin_word jasmin_util. + +Check jasmin_word.word. + +Set Equations With UIP. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. + +Open Scope type_scope. + +HB.instance Definition _ nbits := + [Ord of (word nbits) by <:]. + +HB.instance Definition _ nbits := + [Choice of (word nbits) by <:]. + +(** + Note for any of these types it would also be okay to write the cast, e.g., [(nat:choiceType)%type], + directly in the term. + This (backward-compatibility) file just made porting to mathcomp 2.1.0 easier. + Just delete as soon as all references to the below casts are gone from the code base. + *) + +Definition unit_choiceType : choiceType := Datatypes.unit. +Definition nat_choiceType : choiceType := nat. +Definition int_choiceType : choiceType := Z. +Definition bool_choiceType : choiceType := bool. +Definition prod_choiceType (A B: choiceType) : choiceType := prod A B. +Definition fmap_choiceType (A: ordType) (B: choiceType) : choiceType := {fmap A -> B}. +Definition option_choiceType (A: choiceType) : choiceType := option A. +Definition fin_choiceType (p: positive) : choiceType := ordinal p.(pos). +Definition word_choiceType (nbits : wsize) : choiceType := word nbits. +Definition list_choiceType (A : choiceType) : choiceType := list A. + +Definition sum_choiceType (A B: choiceType) : choiceType := (A + B)%type. + +Definition unit_ordType: ordType := Datatypes.unit. +Definition nat_ordType: ordType := nat. +Definition int_ordType: ordType := Z. +Definition bool_ordType: ordType := bool. +Definition prod_ordType (A B: ordType) : ordType := prod A B. +Definition fmap_ordType (A B: ordType) : ordType := {fmap A -> B}. +Definition option_ordType (A: ordType) : ordType := option A. +Definition fin_ordType (p: positive) : ordType := ordinal p.(pos). +Definition word_ordType (nbits : wsize) : ordType := word nbits. +Definition list_ordType (A : ordType) : ordType := list A. + + +Definition sum_ordType (A B: ordType) : ordType := (A + B)%type. + + +Definition prod_finType (A B: finType) : finType := prod A B. diff --git a/theories/Crypt/Prelude.v b/theories/Crypt/Prelude.v index df763081..7898b94b 100644 --- a/theories/Crypt/Prelude.v +++ b/theories/Crypt/Prelude.v @@ -5,6 +5,7 @@ From Coq Require Import Utf8 Lia. Set Warnings "-notation-overridden". From mathcomp Require Import ssreflect eqtype ssrbool ssrnat. Set Warnings "notation-overridden". +From HB Require Import structures. From extructures Require Import ord fset. From Equations Require Import Equations. From Mon Require SPropBase. @@ -180,9 +181,7 @@ Proof. intro h. apply e. inversion h. reflexivity. Qed. -Canonical positive_eqMixin := EqMixin positive_eqP. - Canonical positive_eqType := - Eval hnf in EqType positive positive_eqMixin. +HB.instance Definition _ := hasDecEq.Build _ positive_eqP. (** Lt class, for finite types *) @@ -314,4 +313,4 @@ Definition testSome {A} (P : A → bool) (o : option A) : bool := match o with | Some a => P a | None => false - end. \ No newline at end of file + end. diff --git a/theories/Crypt/choice_type.v b/theories/Crypt/choice_type.v index a0a50a59..6417c21a 100644 --- a/theories/Crypt/choice_type.v +++ b/theories/Crypt/choice_type.v @@ -9,11 +9,23 @@ From Coq Require Import Utf8 Lia. From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples GenericRulesSimple. + +(* !!! Import before mathcomp, to avoid overriding instances !!! *) +(* specifically, importing after mathcomp results in conflicting instances for + Z_choiceType. *) +From deriving Require Import deriving. + Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". From mathcomp Require Import ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice reals distr realsum seq all_algebra fintype. +From mathcomp Require Import word_ssrZ word. +(* From Jasmin Require Import utils word. *) +From Crypt Require Import jasmin_word jasmin_util. Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". -From Crypt Require Import Prelude Axioms. +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra. + +From Crypt Require Import Prelude Axioms Casts. From extructures Require Import ord fset fmap. From Mon Require Import SPropBase. Require Equations.Prop.DepElim. @@ -31,47 +43,49 @@ Open Scope fset. Open Scope fset_scope. Open Scope type_scope. -(* Basic structure *) - Inductive choice_type := | chUnit | chNat +| chInt | chBool | chProd (A B : choice_type) | chMap (A B : choice_type) | chOption (A : choice_type) -| chFin (n : positive). +| chFin (n : positive) +| chWord (nbits : wsize) +| chList (A : choice_type) +| chSum (A B : choice_type). Derive NoConfusion NoConfusionHom for choice_type. -(* Definition void_leq (x y : void) := true. *) - -(* Lemma void_leqP : Ord.axioms void_leq. *) -(* Proof. split; by do ![case]. Qed. *) - -(* Definition void_ordMixin := OrdMixin void_leqP. *) -(* Canonical void_ordType := Eval hnf in OrdType void void_ordMixin. *) - Fixpoint chElement_ordType (U : choice_type) : ordType := match U with | chUnit => unit_ordType | chNat => nat_ordType + | chInt => int_ordType | chBool => bool_ordType | chProd U1 U2 => prod_ordType (chElement_ordType U1) (chElement_ordType U2) | chMap U1 U2 => fmap_ordType (chElement_ordType U1) (chElement_ordType U2) | chOption U => option_ordType (chElement_ordType U) - | chFin n => [ordType of ordinal n.(pos) ] + | chFin n => fin_ordType n + | chWord nbits => word_ordType nbits + | chList U => list_ordType (chElement_ordType U) + | chSum U1 U2 => sum_ordType (chElement_ordType U1) (chElement_ordType U2) end. Fixpoint chElement (U : choice_type) : choiceType := match U with | chUnit => unit_choiceType | chNat => nat_choiceType + | chInt => int_choiceType | chBool => bool_choiceType | chProd U1 U2 => prod_choiceType (chElement U1) (chElement U2) | chMap U1 U2 => fmap_choiceType (chElement_ordType U1) (chElement U2) | chOption U => option_choiceType (chElement U) - | chFin n => [choiceType of ordinal n.(pos) ] + | chFin n => fin_choiceType n + | chWord nbits => word_choiceType nbits + | chList U => list_choiceType (chElement U) + | chSum U1 U2 => sum_choiceType (chElement U1) (chElement U2) end. Coercion chElement : choice_type >-> choiceType. @@ -81,11 +95,15 @@ Coercion chElement : choice_type >-> choiceType. match T with | chUnit => Datatypes.tt | chNat => 0 + | chInt => 0 | chBool => false | chProd A B => (chCanonical A, chCanonical B) | chMap A B => _ | chOption A => None | chFin n => _ + | chWord nbits => word0 + | chList A => [::] + | chSum A B => inl (chCanonical A) end. Next Obligation. eapply fmap_of_fmap. apply emptym. @@ -100,12 +118,17 @@ Section choice_typeTypes. Fixpoint choice_type_test (u v : choice_type) : bool := match u, v with | chNat , chNat => true + | chInt , chInt => true | chUnit , chUnit => true | chBool , chBool => true | chProd a b , chProd a' b' => choice_type_test a a' && choice_type_test b b' | chMap a b , chMap a' b' => choice_type_test a a' && choice_type_test b b' | chOption a, chOption a' => choice_type_test a a' | chFin n, chFin n' => n == n' + | chWord nbits, chWord nbits' => + nbits == nbits' + | chList a, chList b => choice_type_test a b + | chSum a b, chSum a' b' => choice_type_test a a' && choice_type_test b b' | _ , _ => false end. @@ -115,30 +138,50 @@ Section choice_typeTypes. Lemma choice_type_eqP : Equality.axiom choice_type_eq. Proof. move=> x y. - induction x as [ | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x1 ih1 | x1] + induction x as [ | | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x1 ih1 | x1 | x1 | x1 ih1 | x1 ih1 x2 ih2 ] in y |- *. - all: destruct y as [ | | | y1 y2 | y1 y2 | y1 | y1]. + all: destruct y as [ | | | | y1 y2 | y1 y2 | y1 | y1 | y1 | y1 | y1 y2 ]. all: simpl. all: try solve [ right ; discriminate ]. all: try solve [ left ; reflexivity ]. + (* chProd *) - destruct (ih1 y1), (ih2 y2). all: simpl. all: subst. all: try solve [ right ; congruence ]. left. reflexivity. + (* chMap *) - destruct (ih1 y1), (ih2 y2). all: simpl. all: subst. all: try solve [ right ; congruence ]. left. reflexivity. + (* chOption *) - destruct (ih1 y1). all: subst. + left. reflexivity. + right. congruence. + (* chFin *) + - destruct (x1 == y1) eqn:e. + + move: e => /eqP e. subst. left. reflexivity. + + move: e => /eqP e. right. intro h. + apply e. inversion h. reflexivity. + (* chWord *) - destruct (x1 == y1) eqn:e. + move: e => /eqP e. subst. left. reflexivity. + move: e => /eqP e. right. intro h. apply e. inversion h. reflexivity. + (* chList *) + - destruct (ih1 y1). + all: subst. + + left. reflexivity. + + right. congruence. + (* chSum *) + - destruct (ih1 y1), (ih2 y2). + all: simpl. + all: subst. + all: try solve [right ; congruence]. + left. reflexivity. Qed. Lemma choice_type_refl : @@ -149,9 +192,7 @@ Section choice_typeTypes. - move: e => /choice_type_eqP []. reflexivity. Qed. - Canonical choice_type_eqMixin := EqMixin choice_type_eqP. - Canonical choice_type_eqType := - Eval hnf in EqType choice_type choice_type_eqMixin. + HB.instance Definition _ := hasDecEq.Build choice_type choice_type_eqP. Fixpoint choice_type_lt (t1 t2 : choice_type) := match t1, t2 with @@ -164,51 +205,102 @@ Section choice_typeTypes. | chNat, chBool => false | chNat, chNat => false | chNat, _ => true + | chInt, chUnit => false + | chInt, chBool => false + | chInt, chNat => false + | chInt, chInt => false + | chInt, _ => true | chProd _ _, chUnit => false | chProd _ _, chBool => false | chProd _ _, chNat => false + | chProd _ _, chInt => false | chProd u1 u2, chProd w1 w2 => (choice_type_lt u1 w1) || - (choice_type_eq u1 w1 && choice_type_lt u2 w2) + (eq_op u1 w1 && choice_type_lt u2 w2) | chProd _ _, _ => true | chMap _ _, chUnit => false | chMap _ _, chBool => false | chMap _ _, chNat => false + | chMap _ _, chInt => false | chMap _ _, chProd _ _ => false | chMap u1 u2, chMap w1 w2 => (choice_type_lt u1 w1) || - (choice_type_eq u1 w1 && choice_type_lt u2 w2) + (eq_op u1 w1 && choice_type_lt u2 w2) | chMap _ _, _ => true | chOption _, chUnit => false | chOption _, chBool => false | chOption _, chNat => false + | chOption _, chInt => false | chOption _, chProd _ _ => false | chOption _, chMap _ _ => false | chOption u, chOption w => choice_type_lt u w | chOption _, _ => true - | chFin n, chUnit => false - | chFin n, chBool => false - | chFin n, chNat => false - | chFin n, chProd _ _ => false - | chFin n, chMap _ _ => false - | chFin n, chOption _ => false + | chFin _, chUnit => false + | chFin _, chBool => false + | chFin _, chNat => false + | chFin _, chInt => false + | chFin _, chProd _ _ => false + | chFin _, chMap _ _ => false + | chFin _, chOption _ => false | chFin n, chFin n' => n < n' + | chFin _, _ => true + | chWord _, chUnit => false + | chWord _, chBool => false + | chWord _, chNat => false + | chWord _, chInt => false + | chWord _, chProd _ _ => false + | chWord _, chMap _ _ => false + | chWord _, chOption _ => false + | chWord _, chFin _ => false + | chWord n, chWord n' => (n < n')%CMP + | chWord _, _ => true + | chList _, chUnit => false + | chList _, chBool => false + | chList _, chNat => false + | chList _, chInt => false + | chList _, chProd _ _ => false + | chList _, chMap _ _ => false + | chList _, chOption _ => false + | chList _, chFin _ => false + | chList _, chWord _ => false + | chList u, chList w => choice_type_lt u w + | chList _, _ => true + | chSum _ _, chUnit => false + | chSum _ _, chBool => false + | chSum _ _, chNat => false + | chSum _ _, chInt => false + | chSum _ _, chProd _ _ => false + | chSum _ _, chMap _ _ => false + | chSum _ _, chOption _ => false + | chSum _ _, chFin _ => false + | chSum _ _, chWord _ => false + | chSum _ _, chList _ => false + | chSum u1 u2, chSum w1 w2 => + (choice_type_lt u1 w1) || + (eq_op u1 w1 && choice_type_lt u2 w2) end. Definition choice_type_leq (t1 t2 : choice_type) := - choice_type_eq t1 t2 || choice_type_lt t1 t2. + eq_op t1 t2 || choice_type_lt t1 t2. Lemma choice_type_lt_transitive : transitive (T:=choice_type) choice_type_lt. Proof. intros v u w h1 h2. - induction u as [ | | | u1 ih1 u2 ih2 | u1 ih1 u2 ih2 | u ih | u] + induction u as [ | | | | u1 ih1 u2 ih2 | u1 ih1 u2 ih2 | u ih | u | u | u ih | u1 ih1 u2 ih2 ] in v, w, h1, h2 |- *. + (* chUnit *) - destruct w. all: try auto. destruct v. all: discriminate. + (* chNat *) + - destruct w. all: try auto. + all: destruct v. all: discriminate. + (* chInt *) - destruct w. all: try auto. all: destruct v. all: discriminate. + (* chBool *) - destruct w. all: try auto. all: destruct v. all: discriminate. + (* chProd *) - destruct v. all: try discriminate. all: destruct w. all: try discriminate. all: try reflexivity. cbn in *. @@ -224,6 +316,7 @@ Section choice_typeTypes. apply/andP. subst. split. * apply/eqP. reflexivity. * eapply ih2. all: eauto. + (* chMap *) - destruct v. all: try discriminate. all: destruct w. all: try discriminate. all: try reflexivity. simpl in *. @@ -239,21 +332,49 @@ Section choice_typeTypes. apply/andP. subst. split. * apply/eqP. reflexivity. * eapply ih2. all: eauto. + (* chOption *) - destruct v. all: try discriminate. all: destruct w. all: try reflexivity. all: try discriminate. simpl in *. eapply ih. all: eauto. + (* chFin *) - destruct v. all: try discriminate. - destruct w. all: try discriminate. + all: destruct w; try discriminate; auto. simpl in *. eapply ltn_trans. all: eauto. + (* chWord *) + - destruct v. all: try discriminate. + all: destruct w; try discriminate; auto. + simpl in *. + eapply cmp_lt_trans. all: eauto. + (* chList *) + - destruct v. all: try discriminate. + all: destruct w. all: try reflexivity. all: try discriminate. + simpl in *. + eapply ih. all: eauto. + (* chSum *) + - destruct v. all: try discriminate. + all: destruct w. all: try discriminate. all: try reflexivity. + simpl in *. + move: h1 => /orP h1. + move: h2 => /orP h2. + apply/orP. + destruct h1 as [h1|h1], h2 as [h2|h2]. + + left. eapply ih1. all: eauto. + + left. move: h2 => /andP [/eqP e h2]. subst. auto. + + left. move: h1 => /andP [/eqP e h1]. subst. auto. + + right. move: h1 => /andP [/eqP e1 h1]. + move: h2 => /andP [/eqP e2 h2]. + apply/andP. subst. split. + * apply/eqP. reflexivity. + * eapply ih2. all: eauto. Qed. Lemma choice_type_lt_areflexive : ∀ x, ~~ choice_type_lt x x. Proof. intros x. - induction x as [ | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x ih | x] in |- *. + induction x as [ | | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x ih | x | x | x ih | x1 ih1 x2 ih2] in |- *. all: intuition; simpl. - simpl. apply/norP. split. @@ -266,34 +387,41 @@ Section choice_typeTypes. + apply/nandP. right. apply ih2. - rewrite ltnn. auto. + - rewrite cmp_nlt_le. + apply cmp_le_refl. + - simpl. + apply/norP. split. + + apply ih1. + + apply/nandP. + right. apply ih2. Qed. Lemma choice_type_lt_total_holds : ∀ x y, - ~~ (choice_type_test x y) ==> (choice_type_lt x y || choice_type_lt y x). + ~~ (eq_op x y) ==> (choice_type_lt x y || choice_type_lt y x). Proof. - intros x y. - induction x as [ | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x] - in y |- *. - all: try solve [ destruct y ; intuition ; reflexivity ]. + intros x. + induction x as [ | | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x | x | x ih | x1 ih1 x2 ih2]. + all: try solve [ destruct y ; auto with solve_subterm ; reflexivity ]. + (* chProd *) - destruct y. all: try (intuition; reflexivity). cbn. specialize (ih1 y1). specialize (ih2 y2). apply/implyP. move /nandP => H. apply/orP. - destruct (choice_type_test x1 y1) eqn:Heq. - + destruct H. 1: discriminate. + destruct (eq_op x1 y1) eqn:Heq. + + destruct H. 1: now setoid_rewrite Heq in H. move: ih2. move /implyP => ih2. specialize (ih2 H). move: ih2. move /orP => ih2. destruct ih2. * left. apply/orP. right. apply/andP. split. - all: intuition auto. + all: intuition. * right. apply/orP. right. apply/andP. intuition. move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity. + destruct H. - * move: ih1. move /implyP => ih1. + * move: ih1. rewrite -Heq; move /implyP => ih1. specialize (ih1 H). move: ih1. move /orP => ih1. destruct ih1. @@ -311,25 +439,26 @@ Section choice_typeTypes. destruct ih1. +++ left. apply/orP. left. assumption. +++ right. apply/orP. left. assumption. + (* chMap *) - destruct y. all: try (intuition; reflexivity). cbn. specialize (ih1 y1). specialize (ih2 y2). apply/implyP. move /nandP => H. apply/orP. - destruct (choice_type_test x1 y1) eqn:Heq. - + destruct H. 1: discriminate. + destruct (eq_op x1 y1) eqn:Heq. + + destruct H. 1: now setoid_rewrite Heq in H. move: ih2. move /implyP => ih2. specialize (ih2 H). move: ih2. move /orP => ih2. destruct ih2. * left. apply/orP. right. apply/andP. split. - all: intuition auto. + all: intuition. * right. apply/orP. right. apply/andP. intuition. move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity. + destruct H. * move: ih1. move /implyP => ih1. - specialize (ih1 H). + specialize (ih1 isT). move: ih1. move /orP => ih1. destruct ih1. -- left. apply/orP. left. assumption. @@ -346,11 +475,56 @@ Section choice_typeTypes. destruct ih1. +++ left. apply/orP. left. assumption. +++ right. apply/orP. left. assumption. + (* chFin *) - destruct y. all: try (intuition; reflexivity). unfold choice_type_lt. - unfold choice_type_test. rewrite -neq_ltn. apply /implyP. auto. + (* chWord *) + - destruct y. all: try (intuition; reflexivity). + unfold choice_type_lt. + apply /implyP. + move => H. apply /orP. + destruct (gcmp x nbits) eqn:E. + + by move: E H => /cmp_eq -> /negP. + + left. by apply /eqP. + + right. unfold cmp_lt. rewrite cmp_sym. by move: E => ->. + (* chSum *) + - destruct y. all: try (intuition; reflexivity). + cbn. + specialize (ih1 y1). specialize (ih2 y2). + apply/implyP. + move /nandP => H. + apply/orP. + destruct (eq_op x1 y1) eqn:Heq. + + destruct H. 1: now setoid_rewrite Heq in H. + move: ih2. move /implyP => ih2. + specialize (ih2 H). + move: ih2. move /orP => ih2. + destruct ih2. + * left. apply/orP. right. apply/andP. split. + all: intuition. + * right. apply/orP. right. apply/andP. intuition. + move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity. + + destruct H. + * move: ih1. move /implyP => ih1. + specialize (ih1 isT). + move: ih1. move /orP => ih1. + destruct ih1. + -- left. apply/orP. left. assumption. + -- right. apply/orP. left. assumption. + * move: ih2. move /implyP => ih2. + specialize (ih2 H). + move: ih2. move /orP => ih2. + destruct ih2. + --- simpl in ih1. move: ih1. move /orP => ih1. + destruct ih1. + +++ left. apply/orP. left. assumption. + +++ right. apply/orP. left. assumption. + --- simpl in ih1. move: ih1. move /orP => ih1. + destruct ih1. + +++ left. apply/orP. left. assumption. + +++ right. apply/orP. left. assumption. Qed. Lemma choice_type_lt_asymmetric : @@ -370,7 +544,7 @@ Section choice_typeTypes. Lemma choice_type_lt_total_not_holds : ∀ x y, - ~~ (choice_type_test x y) ==> (~~ (choice_type_lt x y && choice_type_lt y x)). + ~~ (eq_op x y) ==> (~~ (choice_type_lt x y && choice_type_lt y x)). Proof. intros x y. apply /implyP. intros Hneq. pose (choice_type_lt_total_holds x y) as Htot. @@ -384,11 +558,11 @@ Section choice_typeTypes. Lemma choice_type_lt_tot : ∀ x y, - (choice_type_lt x y || choice_type_lt y x || choice_type_eq x y). + (choice_type_lt x y || choice_type_lt y x || eq_op x y). Proof. intros x y. - destruct (choice_type_eq x y) eqn:H. - - intuition. + destruct (eq_op x y) eqn:H. + - apply/orP. by right. - apply/orP. left. unfold choice_type_eq in H. @@ -398,62 +572,77 @@ Section choice_typeTypes. intuition. move: H0. rewrite H. intuition. Qed. - Lemma choice_type_leqP : Ord.axioms choice_type_leq. + Lemma choice_type_leqxx : reflexive choice_type_leq. Proof. - split => //. - - intro x. unfold choice_type_leq. - apply/orP. left. apply /eqP. reflexivity. - - intros v u w h1 h2. - move: h1 h2. unfold choice_type_leq. - move /orP => h1. move /orP => h2. - destruct h1. - + move: H. move /eqP => H. destruct H. - apply/orP. assumption. - + destruct h2. - * move: H0. move /eqP => H0. destruct H0. - apply/orP. right. assumption. - * apply/orP. right. exact (choice_type_lt_transitive _ _ _ H H0). - - unfold antisymmetric. - move => x y. unfold choice_type_leq. move/andP => [h1 h2]. - move: h1 h2. unfold choice_type_leq. - move /orP => h1. move /orP => h2. - destruct h1. - 1:{ move: H. move /eqP. intuition auto. } - destruct h2. - 1:{ move: H0. move /eqP. intuition auto. } - destruct (~~ (choice_type_test x y)) eqn:Heq. - + move: Heq. move /idP => Heq. - pose (choice_type_lt_total_not_holds x y) as Hp. - move: Hp. move /implyP => Hp. specialize (Hp Heq). - move: Hp. move /nandP => Hp. - destruct Hp. - * move: H. move /eqP /eqP => H. rewrite H in H1. simpl in H1. - discriminate. - * move: H0. move /eqP /eqP => H0. rewrite H0 in H1. simpl in H1. - discriminate. - + move: Heq. move /eqP. auto. - - unfold total. - intros x y. unfold choice_type_leq. - pose (choice_type_lt_tot x y). - move: i. move /orP => H. - destruct H. - + move: H. move /orP => H. - destruct H. - * apply/orP. left. apply/orP. right. assumption. - * apply/orP. right. apply/orP. right. assumption. - + apply/orP. left. apply/orP. left. assumption. + intro x. unfold choice_type_leq. + apply/orP. left. apply /eqP. reflexivity. + Qed. + + Lemma choice_type_leq_trans : transitive choice_type_leq. + Proof. + intros v u w h1 h2. + move: h1 h2. unfold choice_type_leq. + move /orP => h1. move /orP => h2. + destruct h1. + + move: H. move /eqP => H. destruct H. + apply/orP. assumption. + + destruct h2. + * move: H0. move /eqP => H0. destruct H0. + apply/orP. right. assumption. + * apply/orP. right. exact (choice_type_lt_transitive _ _ _ H H0). Qed. + Lemma choice_type_leq_asym : antisymmetric choice_type_leq. + Proof. + + unfold antisymmetric. + move => x y. unfold choice_type_leq. move/andP => [h1 h2]. + move: h1 h2. unfold choice_type_leq. + move /orP => h1. move /orP => h2. + destruct h1. + 1:{ move: H. move /eqP. intuition. } + destruct h2. + 1:{ move: H0. move /eqP. intuition. } + destruct (~~ (eq_op x y)) eqn:Heq. + + move: Heq. move /idP => Heq. + pose (choice_type_lt_total_not_holds x y) as Hp. + move: Hp. move /implyP => Hp. specialize (Hp Heq). + move: Hp. move /nandP => Hp. + destruct Hp. + * move: H. move /eqP /eqP => H. rewrite H in H1. simpl in H1. + discriminate. + * move: H0. move /eqP /eqP => H0. rewrite H0 in H1. simpl in H1. + discriminate. + + move: Heq. move /eqP. auto. + + Qed. + + Lemma choice_type_leq_total : total choice_type_leq. + unfold total. + intros x y. unfold choice_type_leq. + pose (choice_type_lt_tot x y). + move: i. move /orP => H. + destruct H. + + move: H. move /orP => H. + destruct H. + * apply/orP. left. apply/orP. right. assumption. + * apply/orP. right. apply/orP. right. assumption. + + apply/orP. left. apply/orP. left. assumption. + Qed. Fixpoint encode (t : choice_type) : GenTree.tree nat := match t with | chUnit => GenTree.Leaf 1 | chBool => GenTree.Leaf 2 | chNat => GenTree.Leaf 3 + | chInt => GenTree.Leaf 4 | chProd l r => GenTree.Node 1 [:: encode l ; encode r] | chMap l r => GenTree.Node 2 [:: encode l ; encode r] | chOption u => GenTree.Node 3 [:: encode u] - | chFin n => GenTree.Leaf ((4 + n) - 1)%N + | chFin n => GenTree.Node 4 [:: GenTree.Leaf (pos n)] + | chWord n => GenTree.Node 5 [:: GenTree.Leaf (wsize_log2 n)] + | chList u => GenTree.Node 6 [:: encode u] + | chSum l r => GenTree.Node 7 [:: encode l ; encode r] end. Fixpoint decode (t : GenTree.tree nat) : option choice_type := @@ -461,8 +650,7 @@ Section choice_typeTypes. | GenTree.Leaf 1 => Some chUnit | GenTree.Leaf 2 => Some chBool | GenTree.Leaf 3 => Some chNat - | GenTree.Leaf n => - Some ( chFin (mkpos ((n - 4).+1)%N) ) + | GenTree.Leaf 4 => Some chInt | GenTree.Node 1 [:: l ; r] => match decode l, decode r with | Some l, Some r => Some (chProd l r) @@ -478,13 +666,25 @@ Section choice_typeTypes. | Some l => Some (chOption l) | _ => None end + | GenTree.Node 4 [:: GenTree.Leaf (S n)] => Some (chFin (mkpos (S n))) + | GenTree.Node 5 [:: GenTree.Leaf n] => Some (chWord (nth U8 wsizes n)) + | GenTree.Node 6 [:: l] => + match decode l with + | Some l => Some (chList l) + | _ => None + end + | GenTree.Node 7 [:: l ; r] => + match decode l, decode r with + | Some l, Some r => Some (chSum l r) + | _, _ => None + end | _ => None end. Lemma codeK : pcancel encode decode. Proof. intro t. induction t. - all: intuition. + all: intuition eauto. all: simpl. - rewrite IHt1. rewrite IHt2. reflexivity. - rewrite IHt1. rewrite IHt2. reflexivity. @@ -492,16 +692,20 @@ Section choice_typeTypes. - destruct n as [n npos]. cbn. destruct n. + discriminate. - + cbn. - rewrite -subnE subn0. repeat f_equal. apply eq_irrelevance. - Defined. - - Definition choice_type_choiceMixin := PcanChoiceMixin codeK. - Canonical choice_type_choiceType := - ChoiceType choice_type choice_type_choiceMixin. + + cbn. repeat f_equal. apply eq_irrelevance. + - repeat f_equal. unfold wsizes. + destruct nbits; reflexivity. + - rewrite IHt. reflexivity. + - rewrite IHt1. rewrite IHt2. reflexivity. + Qed. - Definition choice_type_ordMixin := OrdMixin choice_type_leqP. - Canonical choice_type_ordType := - Eval hnf in OrdType choice_type choice_type_ordMixin. + #[short(type="choice_type_choiceMixin")] + HB.instance Definition _ := PCanHasChoice codeK. + HB.instance Definition _ := + hasOrd.Build choice_type + (choice_type_leqxx) + (choice_type_leq_trans) + (choice_type_leq_asym) + (choice_type_leq_total). End choice_typeTypes. diff --git a/theories/Crypt/examples/AsymScheme.v b/theories/Crypt/examples/AsymScheme.v index 5c6ef172..2d65eee1 100644 --- a/theories/Crypt/examples/AsymScheme.v +++ b/theories/Crypt/examples/AsymScheme.v @@ -121,7 +121,7 @@ Module AsymmetricScheme (π : AsymmetricSchemeParams) Definition i_cipher := #|Cipher|. Definition i_pk := #|PubKey|. Definition i_sk := #|SecKey|. - Definition i_bool := 2. + Definition i_bool : nat := 2. Local Open Scope package_scope. diff --git a/theories/Crypt/examples/DDH.v b/theories/Crypt/examples/DDH.v new file mode 100644 index 00000000..2585e24f --- /dev/null +++ b/theories/Crypt/examples/DDH.v @@ -0,0 +1,118 @@ +From Relational Require Import OrderEnrichedCategory GenericRulesSimple. + +Set Warnings "-notation-overridden,-ambiguous-paths,-notation-incompatible-format". +From mathcomp Require Import all_ssreflect all_algebra reals distr + fingroup.fingroup realsum ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice + seq. +Set Warnings "notation-overridden,ambiguous-paths,notation-incompatible-format". + +From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings + UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb + Package Prelude pkg_composition. + +From Coq Require Import Utf8 Lia. +From extructures Require Import ord fset fmap. + +From Equations Require Import Equations. +Require Equations.Prop.DepElim. + +Set Equations With UIP. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. + +Import Num.Def. +Import Num.Theory. +Import Order.POrderTheory. + +Import PackageNotation. + +#[local] Open Scope ring_scope. +#[local] Open Scope package_scope. +Import GroupScope GRing.Theory. + +Module Type GroupParam. + + Parameter gT : finGroupType. + Definition ζ : {set gT} := [set : gT]. + Parameter g : gT. + Parameter g_gen : ζ = <[g]>. + Parameter prime_order : prime #[g]. + +End GroupParam. + +Module Type DDHParams. + Parameter Space : finType. + Parameter Space_pos : Positive #|Space|. +End DDHParams. + +Module DDH (DDHP : DDHParams) (GP : GroupParam). + + Import DDHP. + Import GP. + + Definition SAMPLE := 0%N. + + #[local] Existing Instance Space_pos. + + Definition GroupSpace : finType := gT. + #[local] Instance GroupSpace_pos : Positive #|GroupSpace|. + Proof. + apply /card_gt0P; by exists g. + (* Needs to be transparent to unify with local positivity proof? *) + Defined. + + Definition chGroup : choice_type := 'fin #|GroupSpace|. + + Definition i_space := #|Space|. + Definition chElem : choice_type := 'fin #|Space|. + + Notation " 'group " := (chGroup) (in custom pack_type at level 2). + + Definition secret_loc1 : Location := (chElem ; 33%N). + Definition secret_loc2 : Location := (chElem ; 34%N). + Definition secret_loc3 : Location := (chElem ; 35%N). + + Definition DDH_locs := + fset [:: secret_loc1 ; secret_loc2 ; secret_loc3]. + + Definition DDH_real : + package DDH_locs [interface] + [interface #val #[ SAMPLE ] : 'unit → 'group × 'group × 'group ] := + [package + #def #[ SAMPLE ] (_ : 'unit) : 'group × 'group × 'group + { + a ← sample uniform i_space ;; + b ← sample uniform i_space ;; + #put secret_loc1 := a ;; + #put secret_loc2 := b ;; + ret (fto (g^+ a), (fto (g^+ b), fto (g^+(a * b)))) + } + ]. + + Definition DDH_E := [interface #val #[ SAMPLE ] : 'unit → 'group × 'group × 'group ]. + + Definition DDH_ideal : + package DDH_locs [interface] DDH_E := + [package + #def #[ SAMPLE ] (_ : 'unit) : 'group × 'group × 'group + { + a ← sample uniform i_space ;; + b ← sample uniform i_space ;; + c ← sample uniform i_space ;; + #put secret_loc1 := a ;; + #put secret_loc2 := b ;; + #put secret_loc3 := c ;; + ret (fto (g^+a), (fto (g^+b), fto (g^+c))) + } + ]. + + Definition DDH : + loc_GamePair [interface #val #[ SAMPLE ] : 'unit → 'group × 'group × 'group ] := + λ b, + if b then {locpackage DDH_real } else {locpackage DDH_ideal }. + + Definition ϵ_DDH := Advantage DDH. + +End DDH. diff --git a/theories/Crypt/examples/ElGamal.v b/theories/Crypt/examples/ElGamal.v index 4c15a32e..40a9829b 100644 --- a/theories/Crypt/examples/ElGamal.v +++ b/theories/Crypt/examples/ElGamal.v @@ -79,12 +79,11 @@ Qed. Module MyParam <: AsymmetricSchemeParams. - Definition SecurityParameter : choiceType := nat_choiceType. - Definition Plain : finType := FinGroup.arg_finType gT. - Definition Cipher : finType := - prod_finType (FinGroup.arg_finType gT) (FinGroup.arg_finType gT). - Definition PubKey : finType := FinGroup.arg_finType gT. - Definition SecKey : finType := [finType of 'Z_q]. + Definition SecurityParameter : choiceType := nat. + Definition Plain : finType := gT. + Definition Cipher : finType := prod (gT:finType) (gT:finType). + Definition PubKey : finType := gT. + Definition SecKey : finType := Finite.clone _ 'Z_q. Definition plain0 := g. Definition cipher0 := (g, g). @@ -134,12 +133,13 @@ Module MyAlg <: AsymmetricSchemeAlgorithms MyParam. Definition challenge_id : nat := 8. (*challenge for LR *) Definition challenge_id' : nat := 9. (*challenge for real rnd *) Definition getpk_id : nat := 42. (* routine to get the public key *) + Definition query_id : nat := 10. Definition i_plain := #|Plain|. Definition i_cipher := #|Cipher|. Definition i_pk := #|PubKey|. Definition i_sk := #|SecKey|. - Definition i_bool := 2. + Definition i_bool : nat := 2. (** Key Generation algorithm *) Definition KeyGen {L : {fset Location}} : @@ -208,9 +208,9 @@ Definition DH_loc := fset [:: pk_loc ; sk_loc]. Definition DH_real : package DH_loc [interface] - [interface #val #[10] : 'unit → 'pubkey × 'cipher ] := + [interface #val #[query_id] : 'unit → 'pubkey × 'cipher ] := [package - #def #[10] (_ : 'unit) : 'pubkey × 'cipher + #def #[query_id] (_ : 'unit) : 'pubkey × 'cipher { a ← sample uniform i_sk ;; let a := otf a in @@ -224,9 +224,9 @@ Definition DH_real : Definition DH_rnd : package DH_loc [interface] - [interface #val #[10] : 'unit → 'pubkey × 'cipher ] := + [interface #val #[query_id] : 'unit → 'pubkey × 'cipher ] := [package - #def #[10] (_ : 'unit) : 'pubkey × 'cipher + #def #[query_id] (_ : 'unit) : 'pubkey × 'cipher { a ← sample uniform i_sk ;; let a := otf a in @@ -242,7 +242,7 @@ Definition DH_rnd : Definition Aux : package (fset [:: counter_loc ; pk_loc ]) - [interface #val #[10] : 'unit → 'pubkey × 'cipher] + [interface #val #[query_id] : 'unit → 'pubkey × 'cipher] [interface #val #[getpk_id] : 'unit → 'pubkey ; #val #[challenge_id'] : 'plain → 'cipher @@ -257,7 +257,7 @@ Definition Aux : #def #[challenge_id'] (m : 'plain) : 'cipher { - #import {sig #[10] : 'unit → 'pubkey × 'cipher } as query ;; + #import {sig #[query_id] : 'unit → 'pubkey × 'cipher } as query ;; count ← get counter_loc ;; #put counter_loc := (count + 1)%N ;; #assert (count == 0)%N ;; @@ -478,7 +478,7 @@ End ElGamal. Module EGP_Z3 <: ElGamalParam. - Definition gT : finGroupType := Zp_finGroupType 2. + Definition gT : finGroupType := 'Z_2. Definition ζ : {set gT} := [set : gT]. Definition g : gT := Zp1. diff --git a/theories/Crypt/examples/KEMDEM.v b/theories/Crypt/examples/KEMDEM.v index 4cb33ffc..9df1e822 100644 --- a/theories/Crypt/examples/KEMDEM.v +++ b/theories/Crypt/examples/KEMDEM.v @@ -316,9 +316,7 @@ Section KEMDEM. #assert (isSome sk) as skSome ;; let sk := getSome sk skSome in ek ← get ek_loc ;; - #assert (isSome ek) as ekSome ;; - let ek := getSome ek ekSome in - #assert (ek != ek') ;; + #assert (ek != Some ek') ;; ret (η.(KEM_decap) sk ek') } ]. @@ -406,9 +404,7 @@ Section KEMDEM. #def #[ DEC ] (c' : 'cipher) : 'plain { #import {sig #[ GET ] : 'unit → 'key } as GET ;; c ← get c_loc ;; - #assert (isSome c) as cSome ;; - let c := getSome c cSome in - #assert (c != c') ;; + #assert (c != Some c') ;; k ← GET Datatypes.tt ;; ret (θ.(DEM_dec) k c') } @@ -490,12 +486,8 @@ Section KEMDEM. #assert (isSome sk) as skSome ;; let sk := getSome sk skSome in ek ← get ek_loc ;; - #assert (isSome ek) as ekSome ;; - let ek := getSome ek ekSome in c ← get c_loc ;; - #assert (isSome c) as cSome ;; - let c := getSome c cSome in - #assert ((ek, c) != c') ;; + #assert ((ek, c) != (Some c'.1, Some c'.2)) ;; ret (ζ.(PKE_dec) sk c') } ]. @@ -550,13 +542,9 @@ Section KEMDEM. pk ← get pk_loc ;; #assert (isSome pk) ;; ek ← get ek_loc ;; - #assert (isSome ek) as ekSome ;; - let ek := getSome ek ekSome in c ← get c_loc ;; - #assert (isSome c) as cSome ;; - let c := getSome c cSome in - #assert ((ek, c) != (ek', c')) ;; - if ek == ek' + #assert ((ek, c) != (Some ek', Some c')) ;; + if ek == Some ek' then ( DEC c' ) @@ -616,7 +604,7 @@ Section KEMDEM. as ineq. eapply le_trans. 1: exact ineq. clear ineq. - eapply ler_add. + eapply lerD. (* Idealising the core keying package *) - replace (par CK₀ CD₀) with ((par (ID EK) CD₀) ∘ (par CK₀ (ID IGET))). 2:{ @@ -708,7 +696,7 @@ Section KEMDEM. as ineq. eapply le_trans. 1: exact ineq. clear ineq. - eapply ler_add. + eapply lerD. - eapply single_key_a. all: eauto. (* De-idealising the core keying package *) - replace (par CK₀ CD₁) with ((par (ID EK) CD₁) ∘ (par CK₀ (ID IGET))). @@ -944,11 +932,7 @@ Section KEMDEM. ssprove_swap_seq_rhs [:: 1 ; 0 ]%N. ssprove_swap_seq_lhs [:: 1 ; 0 ]%N. eapply r_get_vs_get_remember_rhs. 1: ssprove_invariant. intros ek. - ssprove_swap_seq_rhs [:: 1 ; 0 ]%N. - ssprove_swap_seq_lhs [:: 1 ; 0 ]%N. - ssprove_sync. intro ekSome. - destruct ek as [ek|]. 2: discriminate. - simpl. destruct (ek == ek') eqn:eek. + destruct (ek == Some ek') eqn:eek. + rewrite eek. ssprove_code_simpl_more. ssprove_code_simpl. ssprove_code_simpl_more. eapply r_get_remember_rhs. intro pk. @@ -962,16 +946,13 @@ Section KEMDEM. intro eps. eapply sameSomeRel_sameSome in eps as eps'. rewrite eps'. ssprove_sync. intro skSome. - ssprove_swap_seq_rhs [:: 2 ; 1 ; 0 ]%N. + ssprove_swap_seq_rhs [:: 1 ]%N. ssprove_contract_get_rhs. ssprove_sync. intro c. - ssprove_sync. intro cSome. - destruct c as [c|]. 2: discriminate. - simpl. - ssprove_sync. intro ee. - move: ee => /eqP ee. - move: eek => /eqP eek. subst ek'. - destruct (c != c') eqn:e. + ssprove_sync. intro neq. + move: neq => /eqP neq. + move: eek => /eqP eek. subst ek. + destruct (c != Some c') eqn:e. 2:{ move: e => /eqP e. subst. contradiction. } rewrite e. simpl. eapply r_get_remember_rhs. intro k. @@ -984,11 +965,10 @@ Section KEMDEM. ssprove_forget_all. apply r_ret. auto. + rewrite eek. ssprove_code_simpl_more. - ssprove_swap_seq_rhs [:: 6 ; 5 ; 4 ; 3 ; 2 ; 1 ; 0 ]%N. + ssprove_swap_seq_rhs [:: 5 ; 4 ; 3 ; 2 ; 1 ; 0 ]%N. eapply r_get_remind_rhs. 1: exact _. - simpl. ssprove_forget. - ssprove_swap_seq_rhs [:: 4 ; 3 ; 2 ; 1 ; 0 ]%N. + ssprove_swap_seq_rhs [:: 3 ; 2 ; 1 ; 0 ]%N. apply r_get_vs_get_remember. 1: ssprove_invariant. intros sk. apply r_get_remember_rhs. intro pk. eapply (r_rem_couple_lhs pk_loc sk_loc). 1,3: exact _. @@ -997,19 +977,11 @@ Section KEMDEM. ssprove_forget_all. ssprove_sync. intro skSome. ssprove_sync. intro c. - ssprove_sync. intro cSome. ssprove_sync. intro ee. destruct sk as [sk|]. 2: discriminate. simpl. - destruct c as [c|]. 2: discriminate. - simpl in ee. rewrite eek. simpl. - eapply @r_reflexivity_alt with (L := fset0). - * ssprove_valid. - * intros ℓ hℓ. eapply fromEmpty. eauto. - * intros ℓ v hℓ. eapply fromEmpty. eauto. - (* These remaining opsig are quite odd *) - Unshelve. all: exact ({sig #[ 0%N ] : 'unit → 'unit }). + apply r_ret. auto. Qed. Corollary PKE_CCA_perf_true : @@ -1093,4 +1065,4 @@ Section KEMDEM. all: fdisjoint_auto. Qed. -End KEMDEM. \ No newline at end of file +End KEMDEM. diff --git a/theories/Crypt/examples/OTP.v b/theories/Crypt/examples/OTP.v index 78e3315e..8cf2f8c5 100644 --- a/theories/Crypt/examples/OTP.v +++ b/theories/Crypt/examples/OTP.v @@ -63,9 +63,9 @@ Section OTP_example. Definition N_pos : Positive N := _. - Definition Words : finType := [finType of 'Z_N]. + Definition Words : finType := Finite.clone _ 'Z_N. - Definition Key : finType := [finType of 'Z_N]. + Definition Key : finType := Finite.clone _ 'Z_N. Definition w0 : Words := 0. diff --git a/theories/Crypt/examples/OVN.v b/theories/Crypt/examples/OVN.v new file mode 100644 index 00000000..87f1aa19 --- /dev/null +++ b/theories/Crypt/examples/OVN.v @@ -0,0 +1,2128 @@ + +From Relational Require Import OrderEnrichedCategory GenericRulesSimple. + +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool ssrnum + eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings + UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb + pkg_composition Package Prelude SigmaProtocol Schnorr DDH. + +From Coq Require Import Utf8 Lia. +From extructures Require Import ord fset fmap. + +From Equations Require Import Equations. +Require Equations.Prop.DepElim. + +Set Equations With UIP. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. + +Import Num.Def. +Import Num.Theory. +Import Order.POrderTheory. + +#[local] Open Scope ring_scope. +Import GroupScope GRing.Theory. + +Import PackageNotation. + +Module Type GroupParam. + + Parameter n : nat. + Parameter n_pos : Positive n. + + Parameter gT : finGroupType. + Definition ζ : {set gT} := [set : gT]. + Parameter g : gT. + Parameter g_gen : ζ = <[g]>. + Parameter prime_order : prime #[g]. + +End GroupParam. + +Module Type OVNParam. + + Parameter N : nat. + Parameter N_pos : Positive N. + +End OVNParam. + +Module OVN (GP : GroupParam) (OP : OVNParam). +Import GP. +Import OP. + +Set Equations Transparent. + +Lemma cyclic_zeta: cyclic ζ. +Proof. + apply /cyclicP. exists g. exact: g_gen. +Qed. + +(* order of g *) +Definition q' := Zp_trunc (pdiv #[g]). +Definition q : nat := q'.+2. + +Lemma q_order_g : q = #[g]. +Proof. + unfold q, q'. + apply Fp_cast. + apply prime_order. +Qed. + +Lemma q_field : (Zp_trunc #[g]) = q'. +Proof. + unfold q'. + rewrite pdiv_id. + 2: apply prime_order. + reflexivity. +Qed. + +Lemma expg_g : forall x, exists ix, x = g ^+ ix. +Proof. + intros. + apply /cycleP. + rewrite -g_gen. + apply: in_setT. +Qed. + +Lemma group_prodC : + @commutative gT gT mulg. +Proof. + move => x y. + destruct (expg_g x) as [ix ->]. + destruct (expg_g y) as [iy ->]. + repeat rewrite -expgD addnC. + reflexivity. +Qed. + +Definition Pid : finType := Finite.clone _ 'I_n. +Definition Secret : finType := FinRing_ComRing__to__fintype_Finite (fintype_ordinal__canonical__FinRing_ComRing (Zp_trunc #[g])). (* Zp_finComRingType (Zp_trunc #[g]). *) +Definition Public : finType := gT. +Definition s0 : Secret := 0. + +Definition Pid_pos : Positive #|Pid|. +Proof. + rewrite card_ord. + eapply PositiveInFin. + apply n_pos. +Qed. + +Definition Secret_pos : Positive #|Secret|. +Proof. + apply /card_gt0P. exists s0. auto. +Qed. + +Definition Public_pos : Positive #|Public|. +Proof. + apply /card_gt0P. exists g. auto. +Defined. + +#[local] Existing Instance Pid_pos. +#[local] Existing Instance Secret_pos. +#[local] Existing Instance Public_pos. + +Definition pid : choice_type := 'fin #|Pid|. +Definition secret : choice_type := 'fin #|Secret|. +Definition public: choice_type := 'fin #|Public|. + +Definition nat_to_pid : nat → pid. +Proof. + move=> n. + eapply give_fin. +Defined. + +Definition i_secret := #|Secret|. +Definition i_public := #|Public|. + +Module Type CDSParams <: SigmaProtocolParams. + Definition Witness : finType := Secret. + Definition Statement : finType := prod (prod Public Public) Public. + + Definition Witness_pos : Positive #|Witness| := Secret_pos. + Definition Statement_pos : Positive #|Statement|. + Proof. + unfold Statement. + rewrite !card_prod. + repeat apply Positive_prod. + all: apply Public_pos. + Qed. + + Definition R : Statement -> Witness -> bool := + λ (h : Statement) (x : Witness), + let '(gx, gy, gyxv) := h in + (gy^+x * g^+0 == gyxv) || (gy^+x * g^+1 == gyxv). + + Lemma relation_valid_left: + ∀ (x : Secret) (gy : Public), + R (g^+x, gy, gy^+x * g^+ 0) x. + Proof. + intros x gy. + unfold R. + apply /orP ; left. + done. + Qed. + + Lemma relation_valid_right: + ∀ (x : Secret) (gy : Public), + R (g^+x, gy, gy^+x * g^+ 1) x. + Proof. + intros x y. + unfold R. + apply /orP ; right. + done. + Qed. + + Parameter Message Challenge Response State : finType. + Parameter w0 : Witness. + Parameter e0 : Challenge. + Parameter z0 : Response. + + Parameter Message_pos : Positive #|Message|. + Parameter Challenge_pos : Positive #|Challenge|. + Parameter Response_pos : Positive #|Response|. + Parameter State_pos : Positive #|State|. + Parameter Bool_pos : Positive #|'bool|. +End CDSParams. + +Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). + + Module Sigma1 := Schnorr GP. + Module Sigma2 := SigmaProtocol π2 Alg2. + + Obligation Tactic := idtac. + Set Equations Transparent. + + Definition skey_loc (i : nat) : Location := (secret; (100+i)%N). + Definition ckey_loc (i : nat) : Location := (public; (101+i)%N). + + Definition P_i_locs (i : nat) : {fset Location} := fset [:: skey_loc i ; ckey_loc i]. + + Notation choiceStatement1 := Sigma1.MyAlg.choiceStatement. + Notation choiceWitness1 := Sigma1.MyAlg.choiceWitness. + Notation choiceTranscript1 := Sigma1.MyAlg.choiceTranscript. + + Notation " 'pid " := pid (in custom pack_type at level 2). + Notation " 'pids " := (chProd pid pid) (in custom pack_type at level 2). + Notation " 'public " := public (in custom pack_type at level 2). + Notation " 'public " := public (at level 2) : package_scope. + + Notation " 'chRelation1' " := (chProd choiceStatement1 choiceWitness1) (in custom pack_type at level 2). + Notation " 'chTranscript1' " := choiceTranscript1 (in custom pack_type at level 2). + Notation " 'public_key " := (chProd public choiceTranscript1) (in custom pack_type at level 2). + Notation " 'public_keys " := (chMap pid (chProd public choiceTranscript1)) (in custom pack_type at level 2). + + Notation " 'chRelation2' " := (chProd Alg2.choiceStatement Alg2.choiceWitness) (in custom pack_type at level 2). + Notation " 'chTranscript2' " := Alg2.choiceTranscript (in custom pack_type at level 2). + Notation " 'vote " := (chProd public Alg2.choiceTranscript) (in custom pack_type at level 2). + + Definition INIT : nat := 4. + Definition VOTE : nat := 5. + Definition CONSTRUCT : nat := 6. + + Definition P (i : nat) : nat := 14 + i. + Definition Exec (i : nat) : nat := 15 + i. + + Lemma not_in_domm {T S} : + ∀ i m, + i \notin @domm T S m :\ i. + Proof. + intros. + apply /negPn. + rewrite in_fsetD. + move=> /andP [H _]. + move: H => /negPn H. + apply H. + by rewrite in_fset1. + Qed. + + Lemma not_in_fsetU : + ∀ (l : Location) L0 L1, + l \notin L0 → + l \notin L1 → + l \notin L0 :|: L1. + Proof. + intros l L0 L1 h1 h2. + rewrite -fdisjoints1 fset1E. + rewrite fdisjointUl. + apply /andP ; split. + + rewrite -fdisjoints1 fset1E in h1. apply h1. + + rewrite -fdisjoints1 fset1E in h2. apply h2. + Qed. + + #[local] Hint Extern 3 (is_true (?l \notin ?L0 :|: ?L1)) => + apply not_in_fsetU : typeclass_instances ssprove_valid_db ssprove_invariant. + + Definition get_value (m : chMap pid (chProd public choiceTranscript1)) (i : pid) := + match m i with + | Some (v, _) => otf v + | _ => 1 + end. + + From HB Require Import structures. + From mathcomp Require Import ssreflect.bigop. + Import Monoid. + HB.instance Definition _ := isCommutativeLaw.Build _ _ group_prodC. + + Definition compute_key + (m : chMap pid (chProd public choiceTranscript1)) + (i : pid) + := + let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in + let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in + low * invg high. + + Definition compute_key' + (m : chMap pid (chProd public choiceTranscript1)) + (i j : pid) + (x : Secret) + := + if (j < i)%ord then + let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in + let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in + (g ^+ x) * low * invg high + else + let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in + let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in + low * invg (high * (g ^+ x)). + + Lemma compute_key'_equiv + (i j : pid) + (x : Secret) + (zk : choiceTranscript1) + (keys : chMap pid (chProd public choiceTranscript1)): + (i != j) → + compute_key (setm keys j (fto (g ^+ x), zk)) i = compute_key' (remm keys j) i j x. + Proof. + intro ij_neq. + unfold compute_key, compute_key'. + simpl. + rewrite <- setm_rem. + rewrite domm_set domm_rem. + set X := domm _. + rewrite !big_fsetU1. + 2-3: subst X; apply not_in_domm. + rewrite setm_rem. + + have set_rem_eq : forall P x, + \big[Notations_mulg__canonical__Monoid_ComLaw/1]_(k <- X :\ j | P k) + get_value (setm keys j x) k = + \prod_(k <- X :\ j | P k) + get_value (remm keys j) k. + { intros. + rewrite big_seq_cond. + rewrite [RHS] big_seq_cond. + unfold get_value. + erewrite eq_bigr. + 1: done. + intros k. + move => /andP [k_in _]. + simpl. + rewrite setmE remmE. + case (k == j) eqn:eq. + - move: eq => /eqP eq. + rewrite eq in_fsetD1 in k_in. + move: k_in => /andP [contra]. + rewrite eq_refl in contra. + discriminate. + - reflexivity. + } + + case (j < i)%ord eqn:e. + - rewrite !e. + rewrite -2!mulgA. + f_equal. + 1: unfold get_value ; by rewrite setmE eq_refl otf_fto. + f_equal. + + apply set_rem_eq. + + rewrite Ord.ltNge Ord.leq_eqVlt in e. + rewrite negb_or in e. + move: e => /andP [_ e]. + apply negbTE in e. + rewrite e. + f_equal. + apply set_rem_eq. + - rewrite e. + rewrite Ord.ltNge in e. + apply negbT in e. + apply negbNE in e. + rewrite Ord.leq_eqVlt in e. + move: e => /orP [contra|e]. + 1: by rewrite contra in ij_neq. + rewrite e !invMg. + f_equal. + { apply set_rem_eq. } + rewrite group_prodC. + f_equal. + { unfold get_value. by rewrite setmE eq_refl otf_fto. } + f_equal. + apply set_rem_eq. + Qed. + + Lemma compute_key_bij: + ∀ (m : chMap pid (chProd public choiceTranscript1)) (i j: pid), + (i != j)%ord → + exists (a b : nat), + (a != 0)%N /\ (a < q)%N /\ + (∀ (x : Secret) zk, + compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ ((a * x + b) %% q)). + Proof. + intros m i j ne. + simpl. + pose low := \prod_(k <- domm m :\ j| (k < i)%ord) get_value m k. + pose hi := \prod_(k <- domm m :\ j| (i < k)%ord) get_value m k. + have Hlow : exists ilow, low = g ^+ ilow by apply expg_g. + have Hhi : exists ihi, hi = g ^+ ihi by apply expg_g. + destruct Hlow as [ilow Hlow]. + destruct Hhi as [ihi Hhi]. + + have getv_remm_eq : forall P j m, + \prod_(k <- domm m :\ j | P k) get_value (remm m j) k = + \prod_(k <- domm m :\ j | P k) get_value m k. + { + clear low hi ilow ihi Hlow Hhi ne i j m. + intros. + rewrite big_seq_cond. + rewrite [RHS] big_seq_cond. + erewrite eq_bigr. + 1: done. + intros k. + move => /andP [k_in _]. + simpl. + unfold get_value. + rewrite remmE. + case (k == j) eqn:eq. + ++ move: eq => /eqP eq. + rewrite eq in_fsetD1 in k_in. + move: k_in => /andP [contra]. + rewrite eq_refl in contra. + discriminate. + ++ reflexivity. + } + + case (j < i)%ord eqn:ij_rel. + - exists 1%N. + exists (ilow + (ihi * #[g ^+ ihi].-1))%N. + do 2 split. + 1: rewrite q_order_g ; apply (prime_gt1 prime_order). + intros x zk. + rewrite compute_key'_equiv. + 2: assumption. + unfold compute_key'. + simpl. + rewrite ij_rel. + rewrite domm_rem. + set low' := \prod_(k0 <- _ | _) _. + set hi' := \prod_(k0 <- _ | _) _. + have -> : low' = low by apply getv_remm_eq. + have -> : hi' = hi by apply getv_remm_eq. + clear low' hi'. + rewrite Hhi Hlow. + rewrite invg_expg. + rewrite -!expgM. + rewrite -!expgD. + rewrite !addnA. + rewrite -expg_mod_order. + f_equal. + f_equal. + 2: { + unfold q. rewrite Fp_cast; + [reflexivity | apply prime_order]. + } + rewrite mul1n. + done. + - exists #[g].-1. + exists (ilow + (ihi * #[g ^+ ihi].-1))%N. + repeat split. + { unfold negb. + rewrite -leqn0. + case (#[g].-1 <= 0)%N eqn:e. + 2: done. + have Hgt1 := (prime_gt1 prime_order). + rewrite -ltn_predRL in Hgt1. + rewrite -ltnS in Hgt1. + rewrite -addn1 in Hgt1. + rewrite leq_add2l in Hgt1. + eapply leq_trans in e. + 2: apply Hgt1. + discriminate. + } + { + rewrite q_order_g. + rewrite ltn_predL. + apply (prime_gt0 prime_order). + } + intros x zk. + rewrite compute_key'_equiv. + 2: assumption. + unfold compute_key'. + simpl. + rewrite ij_rel. + rewrite domm_rem. + set low' := \prod_(k0 <- _ | _) _. + set hi' := \prod_(k0 <- _ | _) _. + have -> : low' = low by apply getv_remm_eq. + have -> : hi' = hi by apply getv_remm_eq. + clear low' hi'. + rewrite Hhi Hlow. + rewrite invMg. + rewrite -expgVn. + rewrite !invg_expg. + rewrite -!expgM. + rewrite mulgA. + rewrite -!expgD. + rewrite !addnA. + rewrite -expg_mod_order. + f_equal. + f_equal. + 2: { + unfold q. rewrite Fp_cast; + [reflexivity | apply prime_order]. + } + rewrite addnAC. + rewrite addnC. + rewrite addnA. + done. + Qed. + + Lemma compute_key_set_i + (i : pid) + (v : (chProd public choiceTranscript1)) + (m : chMap pid (chProd public choiceTranscript1)): + compute_key (setm m i v) i = compute_key m i. + Proof. + unfold compute_key. + simpl. + case (i \in domm m) eqn:i_in. + all: simpl in i_in. + - have -> : forall v, domm (setm m i v) = domm m. + { intros. + simpl. + rewrite domm_set. + rewrite -eq_fset. + intro k. + rewrite in_fsetU1. + case (eq_op) eqn:e. + + move: e => /eqP ->. + by rewrite i_in. + + done. + } + simpl. + f_equal. + + apply eq_big. + 1: done. + intros k k_lt. + unfold get_value. + rewrite setmE. + rewrite Ord.lt_neqAle in k_lt. + move: k_lt => /andP [k_lt _]. + move: k_lt => /negbTE ->. + done. + + f_equal. + apply eq_big. + 1: done. + intros k k_lt. + unfold get_value. + rewrite setmE. + rewrite Ord.lt_neqAle in k_lt. + move: k_lt => /andP [k_lt _]. + rewrite eq_sym. + move: k_lt => /negbTE ->. + done. + - have -> : domm m = domm (remm m i). + { + simpl. + rewrite -eq_fset. + intro k. + rewrite domm_rem. + rewrite in_fsetD1. + case (eq_op) eqn:e. + + simpl. + move: e => /eqP ->. + assumption. + + done. + } + simpl. + f_equal. + + rewrite -setm_rem domm_set domm_rem. + rewrite big_fsetU1. + all: simpl. + 2: by rewrite in_fsetD1 eq_refl. + rewrite Ord.ltxx. + apply eq_big. + 1: done. + intros k k_lt. + unfold get_value. + rewrite setmE remmE. + rewrite Ord.lt_neqAle in k_lt. + move: k_lt => /andP [k_lt _]. + move: k_lt => /negbTE ->. + done. + + f_equal. + rewrite -setm_rem domm_set domm_rem. + rewrite big_fsetU1. + all: simpl. + 2: by rewrite in_fsetD1 eq_refl. + rewrite Ord.ltxx. + apply eq_big. + 1: done. + intros k k_lt. + unfold get_value. + rewrite setmE remmE. + rewrite Ord.lt_neqAle in k_lt. + move: k_lt => /andP [k_lt _]. + rewrite eq_sym. + move: k_lt => /negbTE ->. + done. + Qed. + + Lemma test_bij + (i j : pid) + (m : chMap pid (chProd public choiceTranscript1)) + : + (i != j)%N → + ∃ (f : Secret → Secret), + ∀ (x : Secret), + bijective f /\ + (∀ zk, compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ (f x)). + Proof. + simpl. + intros ne. + have H := compute_key_bij m i j ne. + simpl in H. + destruct H as [a [b [a_pos [a_leq_q H]]]]. + set a_ord := @inZp ((Zp_trunc #[g]).+1) a. + set b_ord := @inZp ((Zp_trunc #[g]).+1) b. + pose f' := (fun (x : Secret) => Zp_add (Zp_mul x a_ord) b_ord). + exists f'. + unfold f'. clear f'. + intros x. + have := q_order_g. + unfold q. + intros Hq. + split. + 2: { + intro zk. + rewrite (H x zk). + apply /eqP. + rewrite eq_expg_mod_order. + apply /eqP. + simpl. + rewrite modn_small. + 2: { + rewrite q_order_g. + apply ltn_pmod. + apply (prime_gt0 prime_order). + } + repeat rewrite -> Zp_cast at 3. + 2-5: apply (prime_gt1 prime_order). + symmetry. + rewrite modn_small. + 2: { + apply ltn_pmod. + apply (prime_gt0 prime_order). + } + simpl. + unfold q, q'. + rewrite Fp_cast. + 2: apply prime_order. + rewrite modnMmr. + rewrite modnDm. + rewrite mulnC. + reflexivity. + } + assert (coprime q'.+2 a_ord) as a_ord_coprime. + { + rewrite -unitFpE. + 2: rewrite Hq ; apply prime_order. + rewrite unitfE. simpl. + rewrite Zp_cast. + 2: apply (prime_gt1 prime_order). + unfold q, q' in a_leq_q. + rewrite Fp_cast in a_leq_q. + 2: apply prime_order. + rewrite modn_small. + 2: apply a_leq_q. + erewrite <- inj_eq. + 2: apply ord_inj. + rewrite val_Zp_nat. + 2: { + rewrite pdiv_id. + 1: apply prime_gt1. + 1,2: rewrite Hq ; apply prime_order. + } + rewrite -> pdiv_id at 1. + 1,2: rewrite Hq. + 2: apply prime_order. + unfold q in a_leq_q. + rewrite modn_small. + 2: apply a_leq_q. + assumption. + } + pose f' := (fun (x : Secret) => Zp_mul (Zp_add (Zp_opp b_ord) x) (Zp_inv a_ord)). + exists f'. + - intro z. + unfold f'. clear f'. + simpl. + rewrite Zp_addC. + rewrite -Zp_addA. + have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0. + 1: by rewrite Zp_addC Zp_addNz. + rewrite Zp_addC. + rewrite Zp_add0z. + rewrite -Zp_mulA. + rewrite Zp_mulzV. + 2: { + rewrite -> q_field at 1. + assumption. + } + rewrite Zp_mulz1. + reflexivity. + - intro z. + unfold f'. clear f'. + simpl. + rewrite Zp_addC. + rewrite -Zp_mulA. + rewrite Zp_mul_addl. + have -> : (Zp_mul (Zp_inv a_ord) a_ord) = Zp1. + { + rewrite Zp_mulC. + rewrite Zp_mulzV. + + reflexivity. + + rewrite -> q_field at 1. + assumption. + } + rewrite -Zp_mul_addl. + rewrite Zp_mulz1. + rewrite Zp_addA. + have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0. + 1: by rewrite Zp_addC Zp_addNz. + rewrite Zp_add0z. + reflexivity. + Qed. + + Lemma test_bij' + (i j : pid) + (m : chMap pid (chProd public choiceTranscript1)) + : + (i != j)%N → + ∃ (f : secret → secret), + ∀ (x : secret), + bijective f /\ + (∀ zk, compute_key (setm m j (fto (g ^+ otf x), zk)) i = g ^+ (otf (f x))). + Proof. + simpl. + intros ne. + have [f H] := test_bij i j m ne. + simpl in H. + exists (fun (x : secret) => fto (f (otf x))). + intro x. + destruct (H (otf x)) as [f_bij H'] ; clear H. + split. + - exists (fun z => fto ((finv f) (otf z))). + + apply bij_inj in f_bij. + intro z. + rewrite otf_fto. + apply finv_f in f_bij. + rewrite f_bij fto_otf. + reflexivity. + + apply bij_inj in f_bij. + intro z. + rewrite otf_fto. + apply f_finv in f_bij. + rewrite f_bij fto_otf. + reflexivity. + - intro zk. + specialize (H' zk). + rewrite otf_fto. + apply H'. + Qed. + + Definition P_i_E := + [interface + #val #[ INIT ] : 'unit → 'public_key ; + #val #[ CONSTRUCT ] : 'public_keys → 'unit ; + #val #[ VOTE ] : 'bool → 'public + ]. + + Definition Sigma1_I := + [interface + #val #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool ; + #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1 + ]. + + Definition P_i (i : pid) (b : bool): + package (P_i_locs i) + Sigma1_I + P_i_E := + [package + #def #[ INIT ] (_ : 'unit) : 'public_key + { + #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;; + #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;; + x ← sample uniform i_secret ;; + #put (skey_loc i) := x ;; + let y := (fto (g ^+ (otf x))) : public in + zkp ← ZKP (y, x) ;; + ret (y, zkp) + } + ; + #def #[ CONSTRUCT ] (m : 'public_keys) : 'unit + { + #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;; + #assert (size (domm m) == n) ;; + let key := fto (compute_key m i) in + #put (ckey_loc i) := key ;; + @ret 'unit Datatypes.tt + } + ; + #def #[ VOTE ] (v : 'bool) : 'public + { + skey ← get (skey_loc i) ;; + ckey ← get (ckey_loc i) ;; + if b then + let vote := (otf ckey ^+ skey * g ^+ v) in + @ret 'public (fto vote) + else + let vote := (otf ckey ^+ skey * g ^+ (negb v)) in + @ret 'public (fto vote) + } + ]. + + Definition EXEC_i_I := + [interface + #val #[ INIT ] : 'unit → 'public_key ; + #val #[ CONSTRUCT ] : 'public_keys → 'unit ; + #val #[ VOTE ] : 'bool → 'public ; + #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1 + ]. + + Definition Exec_i_E i := [interface #val #[ Exec i ] : 'bool → 'public]. + + Definition Exec_i (i j : pid) (m : chMap pid (chProd public choiceTranscript1)): + package fset0 + EXEC_i_I + (Exec_i_E i) + := + [package + #def #[ Exec i ] (v : 'bool) : 'public + { + #import {sig #[ INIT ] : 'unit → 'public_key} as Init ;; + #import {sig #[ CONSTRUCT ] : 'public_keys → 'unit} as Construct ;; + #import {sig #[ VOTE ] : 'bool → 'public} as Vote ;; + #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;; + pk ← Init Datatypes.tt ;; + x ← sample uniform i_secret ;; + let y := (fto (g ^+ (otf x))) : public in + zkp ← ZKP (y, x) ;; + let m' := setm (setm m j (y, zkp)) i pk in + Construct m' ;; + vote ← Vote v ;; + @ret 'public vote + } + ]. + + Module DDHParams <: DDHParams. + Definition Space := Secret. + Definition Space_pos := Secret_pos. + End DDHParams. + + Module DDH := DDH DDHParams GP. + + #[tactic=notac] Equations? Aux (b : bool) (i j : pid) m f': + package DDH.DDH_locs + (DDH.DDH_E :|: + [interface #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1] + ) + [interface #val #[ Exec i ] : 'bool → 'public] + := Aux b i j m f' := + [package + #def #[ Exec i ] (v : 'bool) : 'public + { + #import {sig #[ DDH.SAMPLE ] : 'unit → 'public × 'public × 'public} as DDH ;; + #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;; + abc ← DDH Datatypes.tt ;; + x_i ← get DDH.secret_loc1 ;; + x_j ← get DDH.secret_loc2 ;; + let '(y_i, (y_j, c)) := abc in + let y_j' := fto (g ^+ ((finv f') x_j)) in + zkp1 ← ZKP (y_i, x_i) ;; + zkp2 ← ZKP (y_j', (finv f') x_j) ;; + let m' := (setm (setm m j (y_j', zkp2)) i (y_i, zkp1)) in + #assert (size (domm m') == n) ;; + @ret 'public (fto ((otf c) * g ^+ (if b then v else (negb v)))) + } + ]. + Proof. + ssprove_valid. + all: rewrite in_fsetU. + all: apply /orP. + { + left. + unfold DDH.DDH_E. + rewrite fset_cons -fset0E fsetU0. + by apply /fset1P. + } + { + right. + rewrite fset_cons -fset0E fsetU0. + by apply /fset1P. + } + { + right. + rewrite fset_cons -fset0E fsetU0. + by apply /fset1P. + } + Qed. + + Module RO1 := Sigma1.Sigma.Oracle. + Module RO2 := Sigma2.Oracle. + + Definition combined_locations := + (Sigma1.MyAlg.Sigma_locs :|: RO1.RO_locs). + + Equations? Exec_i_realised b m (i j : pid) : package (P_i_locs i :|: combined_locations) [interface] (Exec_i_E i) := + Exec_i_realised b m i j := + {package (Exec_i i j m) ∘ (par ((P_i i b) ∘ (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) + (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))}. + Proof. + ssprove_valid. + 10: apply fsub0set. + 8:{ rewrite fsetUid. apply fsubsetxx. } + 9: apply fsubsetxx. + 7:{ erewrite fsetUid. apply fsubsetxx. } + 4: apply fsubsetUr. + 3: apply fsubsetUl. + all: unfold combined_locations. + - apply fsubsetUl. + - apply fsubsetUr. + - eapply fsubset_trans. 2: eapply fsubsetUr. + apply fsubsetUl. + - eapply fsubset_trans. 2: eapply fsubsetUr. + apply fsubsetUr. + - unfold EXEC_i_I, P_i_E, Sigma1_I. + rewrite !fset_cons. + rewrite -!fsetUA. + repeat apply fsetUS. + rewrite -fset0E fsetU0 fset0U. + apply fsubsetUr. + Qed. + + + Lemma loc_helper_commit i: + Sigma1.MyAlg.commit_loc \in P_i_locs i :|: combined_locations. + Proof. + unfold combined_locations. + unfold Sigma1.MyAlg.Sigma_locs. + rewrite in_fsetU. + apply /orP ; right. + rewrite fset_cons. + rewrite in_fsetU. + apply /orP ; left. + rewrite in_fsetU1. + apply /orP ; left. + done. + Qed. + + Lemma loc_helper_queries i: + RO1.queries_loc \in P_i_locs i :|: combined_locations. + Proof. + unfold combined_locations. + unfold RO1.RO_locs. + rewrite in_fsetU. + apply /orP ; right. + rewrite fset_cons. + rewrite in_fsetU. + apply /orP ; right. + rewrite in_fsetU1. + apply /orP ; left. + done. + Qed. + + Lemma loc_helper_skey i: + skey_loc i \in P_i_locs i :|: combined_locations. + Proof. + unfold P_i_locs. + rewrite in_fsetU. + apply /orP ; left. + rewrite fset_cons. + rewrite in_fsetU1. + apply /orP ; left. + done. + Qed. + + Lemma loc_helper_ckey i: + ckey_loc i \in P_i_locs i :|: combined_locations. + Proof. + unfold P_i_locs. + rewrite in_fsetU. + apply /orP ; left. + rewrite !fset_cons. + rewrite in_fsetU1. + apply /orP ; right. + rewrite in_fsetU1. + apply /orP ; left. + done. + Qed. + + #[local] Hint Resolve loc_helper_commit : loc_db. + #[local] Hint Resolve loc_helper_queries : loc_db. + #[local] Hint Resolve loc_helper_skey: loc_db. + #[local] Hint Resolve loc_helper_ckey: loc_db. + + #[program] Definition Exec_i_realised_code m (i j : pid) (vote : 'bool): + code (P_i_locs i :|: combined_locations) [interface] 'public := + {code + x ← sample uniform i_secret ;; + #put skey_loc i := x ;; + #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;; + x1 ← sample uniform Sigma1.MyAlg.i_witness ;; + #put Sigma1.MyAlg.commit_loc := x1 ;; + x2 ← get RO1.queries_loc ;; + match x2 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) with + | Some a => + v ← get Sigma1.MyAlg.commit_loc ;; + x3 ← sample uniform i_secret ;; + #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;; + x5 ← sample uniform Sigma1.MyAlg.i_witness ;; + #put Sigma1.MyAlg.commit_loc := x5 ;; + v0 ← get RO1.queries_loc ;; + match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with + | Some a0 => + x6 ← get Sigma1.MyAlg.commit_loc ;; + let x4 := + (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) + in + #assert eqn + (size + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + #put ckey_loc i := fto + (compute_key + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; + v0 ← get skey_loc i ;; + v1 ← get ckey_loc i ;; + @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + | None => + a0 ← sample uniform RO1.i_random ;; + #put RO1.queries_loc := setm v0 + (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;; + x6 ← get Sigma1.MyAlg.commit_loc ;; + let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + #assert eqn + (size + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + #put ckey_loc i := fto + (compute_key + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; + v0 ← get skey_loc i ;; + v1 ← get ckey_loc i ;; + @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + end + | None => + a ← sample uniform RO1.i_random ;; + #put RO1.queries_loc := setm x2 + (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;; + v ← get Sigma1.MyAlg.commit_loc ;; + x3 ← sample uniform i_secret ;; + #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;; + x5 ← sample uniform Sigma1.MyAlg.i_witness ;; + #put Sigma1.MyAlg.commit_loc := x5 ;; + v0 ← get RO1.queries_loc ;; + match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with + | Some a0 => + x6 ← get Sigma1.MyAlg.commit_loc ;; + let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + #assert eqn + (size + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + #put ckey_loc i := fto + (compute_key + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; + v0 ← get skey_loc i ;; + v1 ← get ckey_loc i ;; + @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + | None => + a0 ← sample uniform RO1.i_random ;; + #put RO1.queries_loc := setm v0 + (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;; + x6 ← get Sigma1.MyAlg.commit_loc ;; + let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + #assert eqn + (size + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + #put ckey_loc i := fto + (compute_key + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; + v0 ← get skey_loc i ;; + v1 ← get ckey_loc i ;; + @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + end + end + }. + Next Obligation. + intros. + ssprove_valid ; auto with loc_db. + destruct (v1 _) ; ssprove_valid ; auto with loc_db. + - destruct (v5 _) ; ssprove_valid ; auto with loc_db. + - destruct (v6 _) ; ssprove_valid ; auto with loc_db. + Qed. + + #[program] Definition Exec_i_realised_code_runnable m (i j : pid) (vote : 'bool): + code (P_i_locs i :|: combined_locations) [interface] 'public := + {code + x ← sample uniform i_secret ;; + #put skey_loc i := x ;; + #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;; + x1 ← sample uniform Sigma1.MyAlg.i_witness ;; + #put Sigma1.MyAlg.commit_loc := x1 ;; + x2 ← get RO1.queries_loc ;; + a ← sample uniform RO1.i_random ;; + #put RO1.queries_loc := setm x2 + (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;; + v ← get Sigma1.MyAlg.commit_loc ;; + x3 ← sample uniform i_secret ;; + #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;; + x5 ← sample uniform Sigma1.MyAlg.i_witness ;; + #put Sigma1.MyAlg.commit_loc := x5 ;; + v0 ← get RO1.queries_loc ;; + a0 ← sample uniform RO1.i_random ;; + #put RO1.queries_loc := setm v0 + (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;; + x6 ← get Sigma1.MyAlg.commit_loc ;; + let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + #assert eqn + (size + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + #put ckey_loc i := fto + (compute_key + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i + (fto (expgn_rec (T:=gT) g (otf x)), + (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; + v0 ← get skey_loc i ;; + v1 ← get ckey_loc i ;; + @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + }. + Next Obligation. + intros. + ssprove_valid ; auto with loc_db. + Qed. + + Lemma code_pkg_equiv m i j (vote : 'bool): + ⊢ + ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄ + get_op_default (Exec_i_realised true m i j) ((Exec i), ('bool, 'public)) vote + ≈ + Exec_i_realised_code m i j vote + ⦃ eq ⦄. + Proof. + unfold Exec_i_realised. + rewrite get_op_default_link. + erewrite get_op_default_spec. + 2: { + cbn. + rewrite eqnE eq_refl. + done. + } + ssprove_code_simpl. + simpl. + repeat choice_type_eqP_handle. + rewrite !cast_fun_K. + ssprove_code_simpl. + simpl. + ssprove_code_simpl. + ssprove_code_simpl_more. + simpl. + ssprove_sync_eq=>x. + simpl. + ssprove_code_simpl_more. + ssprove_sync_eq. + ssprove_sync_eq=>rel1. + ssprove_sync_eq=>r1. + ssprove_sync_eq. + + (* ssprove_sync_eq=>queries. + destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ otf x), fto (g ^+ otf r1)))) eqn:e. + all: rewrite e. + - simpl. + ssprove_code_simpl. + ssprove_sync_eq=>?. *) + Admitted. + + #[tactic=notac] Equations? Aux_realised (b : bool) (i j : pid) m f' : + package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] := + Aux_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }. + Proof. + ssprove_valid. + 4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. } + 6: apply fsubsetxx. + 3:{ rewrite -fsetUA. apply fsubsetxx. } + 4:{ rewrite -fsetUA. apply fsubsetUl. } + all: unfold combined_locations. + - eapply fsubset_trans. 2: apply fsubsetUr. + apply fsubsetUl. + - eapply fsubset_trans. 2: apply fsubsetUr. + apply fsubsetUr. + - unfold DDH.DDH_E. + apply fsetUS. + rewrite !fset_cons. + apply fsubsetUr. + Qed. + + #[tactic=notac] Equations? Aux_ideal_realised (b : bool) (i j : pid) m f' : + package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] := + Aux_ideal_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }. + Proof. + ssprove_valid. + 4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. } + 6: apply fsubsetxx. + 3:{ rewrite -fsetUA. apply fsubsetxx. } + 4:{ rewrite -fsetUA. apply fsubsetUl. } + all: unfold combined_locations. + - eapply fsubset_trans. 2: apply fsubsetUr. + apply fsubsetUl. + - eapply fsubset_trans. 2: apply fsubsetUr. + apply fsubsetUr. + - unfold DDH.DDH_E. + apply fsetUS. + rewrite !fset_cons. + apply fsubsetUr. + Qed. + + Notation inv i := (heap_ignore (P_i_locs i :|: DDH.DDH_locs)). + + #[local] Hint Extern 50 (_ = code_link _ _) => + rewrite code_link_scheme + : ssprove_code_simpl. + + (** We extend swapping to schemes. + This means that the ssprove_swap tactic will be able to swap any command + with a scheme without asking a proof from the user. + *) + #[local] Hint Extern 40 (⊢ ⦃ _ ⦄ x ← ?s ;; y ← cmd _ ;; _ ≈ _ ⦃ _ ⦄) => + eapply r_swap_scheme_cmd ; ssprove_valid + : ssprove_swap. + + Lemma P_i_aux_equiv (i j : pid) m: + fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs → + i != j → + (∃ f, + bijective f ∧ + (∀ b, (Exec_i_realised b m i j) ≈₀ Aux_realised b i j m f)). + Proof. + intros Hdisj ij_neq. + have [f' Hf] := test_bij' i j m ij_neq. + simpl in Hf. + exists f'. + split. + { + assert ('I_#|'Z_#[g]|) as x. + { rewrite card_ord. + eapply Ordinal. + rewrite ltnS. + apply ltnSn. + } + specialize (Hf x). + destruct Hf. + assumption. + } + intro b. + eapply eq_rel_perf_ind with (inv := inv i). + { + ssprove_invariant. + rewrite -!fsetUA. + apply fsetUS. + do 2 (apply fsubsetU ; apply /orP ; right). + apply fsubsetUl. + } + simplify_eq_rel v. + rewrite !setmE. + rewrite !eq_refl. + ssprove_code_simpl. + repeat simplify_linking. + ssprove_sync => x_i. + + rewrite !cast_fun_K. + ssprove_code_simpl. + ssprove_code_simpl_more. + + ssprove_swap_seq_rhs [:: 4 ; 5 ; 6 ; 7]%N. + ssprove_swap_seq_rhs [:: 2 ; 3 ; 4 ; 5 ; 6]%N. + ssprove_swap_seq_rhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N. + ssprove_contract_put_get_rhs. + apply r_put_rhs. + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N. + unfold Sigma1.MyParam.R. + have Hord : ∀ x, (nat_of_ord x) = (nat_of_ord (otf x)). + { + unfold otf. + intros n x. + rewrite enum_val_ord. + done. + } + rewrite -Hord otf_fto eq_refl. + simpl. + ssprove_sync => r_i. + apply r_put_vs_put. + ssprove_restore_pre. + { ssprove_invariant. + apply preserve_update_r_ignored_heap_ignore. + - unfold DDH.DDH_locs. + rewrite in_fsetU. + apply /orP ; right. + rewrite fset_cons. + rewrite in_fsetU. + apply /orP ; left. + by apply /fset1P. + - apply preserve_update_mem_nil. + } + eapply (@rsame_head_cmd_alt _ _ (λ z, _) (λ z, _) (cmd_put _ _)) ; [eapply cmd_put_preserve_pre ; ssprove_invariant | intros ]. + ssprove_swap_seq_lhs [:: 0 ]%N. + ssprove_swap_seq_rhs [:: 2 ; 1 ; 0]%N. + ssprove_sync => queries. + destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e. + all: rewrite e; simpl. + all: ssprove_code_simpl_more. + - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N. + ssprove_swap_seq_lhs [:: 0 ; 1 ]%N. + eapply r_uniform_bij. + { apply Hf. + + rewrite card_ord. + rewrite Zp_cast. + 2: apply (prime_gt1 prime_order). + eapply Ordinal. + apply (prime_gt1 prime_order). + } + intro x. + specialize (Hf x). + destruct Hf as [bij_f Hf]. + apply bij_inj in bij_f. + apply finv_f in bij_f. + ssprove_contract_put_get_rhs. + rewrite bij_f. + rewrite -Hord !otf_fto !eq_refl. + simpl. + apply r_put_rhs. + ssprove_restore_pre. + { + apply preserve_update_r_ignored_heap_ignore. + - unfold DDH.DDH_locs. + rewrite !fset_cons. + rewrite !in_fsetU. + apply /orP ; right. + apply /orP ; right. + apply /orP ; left. + by apply /fset1P. + - apply preserve_update_mem_nil. + } + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + ssprove_sync=>r_j. + apply r_put_vs_put. + ssprove_restore_pre. + 1: ssprove_invariant. + clear e queries. + ssprove_sync. + ssprove_swap_seq_lhs [:: 0]%N. + ssprove_sync=>queries. + destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e. + all: rewrite e. + all: ssprove_code_simpl. + all: ssprove_code_simpl_more. + + ssprove_swap_seq_lhs [:: 0 ; 1]%N. + simpl. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + ssprove_swap_lhs 1%N. + { + move: H0 => /eqP. + erewrite eqn_add2r. + intros contra. + discriminate. + } + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_restore_pre. + { + repeat apply preserve_update_l_ignored_heap_ignore. + 1,2: unfold P_i_locs ; rewrite in_fsetU. + 1,2: apply /orP ; left ; rewrite !fset_cons ; + rewrite -fset0E fsetU0 ; rewrite in_fsetU. + - apply /orP ; right. + by apply /fset1P. + - apply /orP ; left. + by apply /fset1P. + - apply preserve_update_mem_nil. + } + rewrite otf_fto. + rewrite compute_key_set_i. + set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s1, fto (otf x2 + otf s1 * otf x)). + clearbody zk. + specialize (Hf zk). + rewrite !Hord. + rewrite Hf. + rewrite -!Hord. + rewrite -expgM. + rewrite mulnC. + case b; apply r_ret ; done. + + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N. + simpl. + ssprove_sync=>e_j. + apply r_put_vs_put. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + ssprove_swap_lhs 1%N. + { + move: H0 => /eqP. + erewrite eqn_add2r. + intros contra. + discriminate. + } + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_restore_pre. + { + repeat apply preserve_update_l_ignored_heap_ignore. + 1,2: unfold P_i_locs ; rewrite in_fsetU. + 1,2: apply /orP ; left ; rewrite !fset_cons ; + rewrite -fset0E fsetU0 ; rewrite in_fsetU. + - apply /orP ; right. + by apply /fset1P. + - apply /orP ; left. + by apply /fset1P. + - ssprove_invariant. + } + rewrite otf_fto. + rewrite compute_key_set_i. + set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)). + clearbody zk. + specialize (Hf zk). + rewrite !Hord. + rewrite Hf. + rewrite -!Hord. + rewrite -expgM. + rewrite mulnC. + case b; apply r_ret ; done. + - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7]%N. + ssprove_swap_seq_lhs [:: 2 ; 1 ; 0 ]%N. + eapply r_uniform_bij. + { apply Hf. + + rewrite card_ord. + rewrite Zp_cast. + 2: apply (prime_gt1 prime_order). + eapply Ordinal. + apply (prime_gt1 prime_order). + } + intro x. + specialize (Hf x). + destruct Hf as [bij_f Hf]. + apply bij_inj in bij_f. + apply finv_f in bij_f. + ssprove_contract_put_get_rhs. + rewrite bij_f. + rewrite -Hord !otf_fto !eq_refl. + simpl. + apply r_put_rhs. + ssprove_restore_pre. + { + apply preserve_update_r_ignored_heap_ignore. + - unfold DDH.DDH_locs. + rewrite !fset_cons. + rewrite !in_fsetU. + apply /orP ; right. + apply /orP ; right. + apply /orP ; left. + by apply /fset1P. + - apply preserve_update_mem_nil. + } + ssprove_sync=>e_i. + apply r_put_vs_put. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + rewrite -Hord eq_refl. + simpl. + ssprove_sync=>r_j. + apply r_put_vs_put. + ssprove_restore_pre. + 1: ssprove_invariant. + clear e queries. + ssprove_sync. + ssprove_swap_seq_lhs [:: 0]%N. + ssprove_sync=>queries. + destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e. + all: rewrite e. + all: ssprove_code_simpl. + all: ssprove_code_simpl_more. + + ssprove_swap_seq_lhs [:: 0 ; 1]%N. + simpl. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + ssprove_swap_lhs 1%N. + { + move: H0 => /eqP. + erewrite eqn_add2r. + intros contra. + discriminate. + } + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_restore_pre. + { + repeat apply preserve_update_l_ignored_heap_ignore. + 1,2: unfold P_i_locs ; rewrite in_fsetU. + 1,2: apply /orP ; left ; rewrite !fset_cons ; + rewrite -fset0E fsetU0 ; rewrite in_fsetU. + - apply /orP ; right. + by apply /fset1P. + - apply /orP ; left. + by apply /fset1P. + - apply preserve_update_mem_nil. + } + rewrite otf_fto. + rewrite compute_key_set_i. + set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s, fto (otf x2 + otf s * otf x)). + clearbody zk. + specialize (Hf zk). + rewrite !Hord. + rewrite Hf. + rewrite -!Hord. + rewrite -expgM. + rewrite mulnC. + case b; apply r_ret ; done. + + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N. + simpl. + ssprove_sync=>e_j. + apply r_put_vs_put. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + ssprove_swap_lhs 1%N. + { + move: H0 => /eqP. + erewrite eqn_add2r. + intros contra. + discriminate. + } + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_contract_put_get_lhs. + apply r_put_lhs. + ssprove_restore_pre. + { + repeat apply preserve_update_l_ignored_heap_ignore. + 1,2: unfold P_i_locs ; rewrite in_fsetU. + 1,2: apply /orP ; left ; rewrite !fset_cons ; + rewrite -fset0E fsetU0 ; rewrite in_fsetU. + - apply /orP ; right. + by apply /fset1P. + - apply /orP ; left. + by apply /fset1P. + - ssprove_invariant. + } + rewrite otf_fto. + rewrite compute_key_set_i. + set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)). + clearbody zk. + specialize (Hf zk). + rewrite !Hord. + rewrite Hf. + rewrite -!Hord. + rewrite -expgM. + rewrite mulnC. + case b; apply r_ret ; done. + Qed. + + Lemma Hord (x : secret): (nat_of_ord x) = (nat_of_ord (otf x)). + Proof. + unfold otf. + rewrite enum_val_ord. + done. + Qed. + + Lemma vote_hiding_bij (c : secret) (v : bool): + fto (otf (fto (g ^+ c)) * g ^+ v) = + fto + (otf (fto (g ^+ (if v then fto (Zp_add (otf c) Zp1) else fto (Zp_add (otf c) (Zp_opp Zp1))))) * + g ^+ (~~ v)). + Proof. + f_equal. + rewrite !otf_fto. + rewrite -!expgD. + have h' : ∀ (x : Secret), nat_of_ord x = (nat_of_ord (fto x)). + { + unfold fto. + intros k. + rewrite enum_rank_ord. + done. + } + case v. + ++ apply /eqP. + rewrite eq_expg_mod_order. + rewrite addn0. + have h : ∀ (x : secret), (((nat_of_ord x) + 1) %% q'.+2)%N = (nat_of_ord (Zp_add (otf x) Zp1)). + { + intro k. + unfold Zp_add. + simpl. + rewrite -Hord. + apply /eqP. + rewrite eq_sym. + apply /eqP. + rewrite -> Zp_cast at 2. + 2: apply (prime_gt1 prime_order). + rewrite -> Zp_cast at 1. + 2: apply (prime_gt1 prime_order). + rewrite modnDmr. + rewrite Fp_cast. + 2: apply prime_order. + reflexivity. + } + rewrite -h'. + rewrite -h. + rewrite -modn_mod. + rewrite Fp_cast. + 2: apply prime_order. + 1: apply eq_refl. + ++ apply /eqP. + rewrite eq_expg_mod_order. + rewrite addn0. + unfold Zp_add, Zp_opp, Zp1. + simpl. + repeat rewrite -> Zp_cast at 12. + 2-4: apply (prime_gt1 prime_order). + rewrite -!Hord. + have -> : (#[g] - 1 %% #[g])%N = #[g].-1. + { rewrite modn_small. + 2: apply (prime_gt1 prime_order). + by rewrite -subn1. + } + rewrite modn_small. + 2:{ + destruct c as [c Hc]. + move: Hc. + simpl. + unfold DDH.i_space, DDHParams.Space, Secret. + rewrite card_ord. + rewrite Zp_cast. + 2: apply (prime_gt1 prime_order). + done. + } + have -> : (#[g].-1 %% #[g])%N = #[g].-1. + { + rewrite modn_small. + 1: reflexivity. + apply ltnSE. + rewrite -subn1 -2!addn1. + rewrite subnK. + 2: apply (prime_gt0 prime_order). + rewrite addn1. + apply ltnSn. + } + rewrite -h'. + simpl. + rewrite -> Zp_cast at 9. + 2: apply (prime_gt1 prime_order). + rewrite modnDml. + rewrite -subn1. + rewrite -addnA. + rewrite subnK. + 2: apply (prime_gt0 prime_order). + rewrite -modnDmr. + rewrite modnn. + rewrite addn0. + rewrite modn_small. + 1: apply eq_refl. + destruct c as [h Hc]. + move: Hc. + unfold DDH.i_space, DDHParams.Space, Secret. + simpl. + rewrite card_ord. + rewrite Zp_cast. + 2: apply (prime_gt1 prime_order). + done. + Qed. + + Lemma vote_hiding (i j : pid) m: + i != j → + ∀ LA A ϵ_DDH, + ValidPackage LA [interface #val #[ Exec i ] : 'bool → 'public] A_export A → + fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs → + fdisjoint LA DDH.DDH_locs → + fdisjoint LA (P_i_locs i) → + fdisjoint LA combined_locations → + (∀ D, DDH.ϵ_DDH D <= ϵ_DDH) → + AdvantageE (Exec_i_realised true m i j) (Exec_i_realised false m i j) A <= ϵ_DDH + ϵ_DDH. + Proof. + intros ij_neq LA A ϵ_DDH Va Hdisj Hdisj2 Hdisj3 Hdisj4 Dadv. + have [f' [bij_f Hf]] := P_i_aux_equiv i j m Hdisj ij_neq. + ssprove triangle (Exec_i_realised true m i j) [:: + (Aux_realised true i j m f').(pack) ; + (Aux true i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ; + (Aux false i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ; + (Aux_realised false i j m f').(pack) + ] (Exec_i_realised false m i j) A as ineq. + eapply le_trans. + 2: { + instantiate (1 := 0 + ϵ_DDH + 0 + ϵ_DDH + 0). + by rewrite ?GRing.addr0 ?GRing.add0r. + } + eapply le_trans. 1: exact ineq. + clear ineq. + repeat eapply ler_add. + { + apply eq_ler. + specialize (Hf true LA A Va). + apply Hf. + - rewrite fdisjointUr. + apply /andP ; split ; assumption. + - rewrite fdisjointUr. + apply /andP ; split. + 2: assumption. + rewrite fdisjointUr. + apply /andP ; split ; assumption. + } + { + unfold Aux_realised. + rewrite -Advantage_link. + rewrite par_commut. + have -> : (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) = + (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_ideal). + { apply par_commut. ssprove_valid. } + erewrite Advantage_par. + 3: apply DDH.DDH_real. + 3: apply DDH.DDH_ideal. + 2: { + ssprove_valid. + - eapply fsubsetUr. + - apply fsubsetUl. + } + 1: rewrite Advantage_sym ; apply Dadv. + - ssprove_valid. + - unfold trimmed. + rewrite -link_trim_commut. + f_equal. + unfold trim. + rewrite !fset_cons -fset0E fsetU0. + rewrite !filterm_set. + simpl. + rewrite !in_fsetU !in_fset1 !eq_refl. + rewrite filterm0. + done. + - unfold trimmed. + unfold trim. + rewrite !fset_cons -fset0E fsetU0. + rewrite !filterm_set. + simpl. + rewrite !in_fset1 !eq_refl. + rewrite filterm0. + done. + - unfold trimmed. + unfold trim. + rewrite !fset_cons -fset0E fsetU0. + rewrite !filterm_set. + simpl. + rewrite !in_fset1 !eq_refl. + rewrite filterm0. + done. + } + 2:{ + unfold Aux_realised. + rewrite -Advantage_link. + rewrite par_commut. + have -> : (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) = + (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_real). + { apply par_commut. ssprove_valid. } + erewrite Advantage_par. + 3: apply DDH.DDH_ideal. + 3: apply DDH.DDH_real. + 2: { + ssprove_valid. + - eapply fsubsetUr. + - apply fsubsetUl. + } + 1: apply Dadv. + - ssprove_valid. + - unfold trimmed. + rewrite -link_trim_commut. + f_equal. + unfold trim. + rewrite !fset_cons -fset0E fsetU0. + rewrite !filterm_set. + simpl. + rewrite !in_fsetU !in_fset1 !eq_refl. + rewrite filterm0. + done. + - unfold trimmed. + unfold trim. + unfold DDH.DDH_E. + rewrite !fset_cons -fset0E fsetU0. + rewrite !filterm_set. + simpl. + rewrite !in_fset1 !eq_refl. + rewrite filterm0. + done. + - unfold trimmed. + unfold trim. + unfold DDH.DDH_E. + rewrite !fset_cons -fset0E fsetU0. + rewrite !filterm_set. + simpl. + rewrite !in_fset1 !eq_refl. + rewrite filterm0. + done. + } + 2: { + apply eq_ler. + specialize (Hf false LA A Va). + rewrite Advantage_sym. + apply Hf. + - rewrite fdisjointUr. + apply /andP ; split ; assumption. + - rewrite fdisjointUr. + apply /andP ; split. + 2: assumption. + rewrite fdisjointUr. + apply /andP ; split ; assumption. + } + apply eq_ler. + eapply eq_rel_perf_ind with (inv := inv i). + 5: apply Va. + 1,2: apply Aux_ideal_realised. + 3: { + rewrite fdisjointUr. + apply /andP ; split. + 2: assumption. + rewrite fdisjointUr. + apply /andP ; split ; assumption. + } + 3: { + rewrite fdisjointUr. + apply /andP ; split. + 2: assumption. + rewrite fdisjointUr. + apply /andP ; split ; assumption. + } + { + ssprove_invariant. + rewrite fsetUC. + rewrite -!fsetUA. + apply fsetUS. + apply fsubsetUl. + } + simplify_eq_rel v. + rewrite !setmE. + rewrite !eq_refl. + simpl. + repeat simplify_linking. + rewrite !cast_fun_K. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync=>x_i. + ssprove_sync=>x_j. + pose f_v := (fun (x : secret) => + if v then + fto (Zp_add (otf x) Zp1) + else + fto (Zp_add (otf x) (Zp_opp Zp1)) + ). + assert (bijective f_v) as bij_fv. + { + exists (fun x => + if v then + fto (Zp_add (otf x) (Zp_opp Zp1)) + else + fto (Zp_add (otf x) Zp1) + ). + - intro x. + unfold f_v. + case v. + + rewrite otf_fto. + rewrite -Zp_addA. + rewrite Zp_addC. + have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1). + { intro n. by rewrite Zp_addC. } + rewrite Zp_addNz. + rewrite Zp_add0z. + by rewrite fto_otf. + + rewrite otf_fto. + rewrite -Zp_addA. + rewrite Zp_addC. + rewrite Zp_addNz. + rewrite Zp_add0z. + by rewrite fto_otf. + - intro x. + unfold f_v. + case v. + + rewrite otf_fto. + rewrite -Zp_addA. + rewrite Zp_addNz. + rewrite Zp_addC. + rewrite Zp_add0z. + by rewrite fto_otf. + + rewrite otf_fto. + rewrite -Zp_addA. + rewrite Zp_addC. + have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1). + { intro n. by rewrite Zp_addC. } + rewrite Zp_addNz. + rewrite Zp_add0z. + by rewrite fto_otf. + } + eapply r_uniform_bij. + 1: apply bij_fv. + intro c. + ssprove_swap_seq_rhs [:: 1 ; 2]%N. + ssprove_swap_seq_rhs [:: 0 ]%N. + ssprove_swap_seq_lhs [:: 1 ; 2]%N. + ssprove_swap_seq_lhs [:: 0 ]%N. + apply r_put_vs_put. + ssprove_contract_put_get_lhs. + ssprove_contract_put_get_rhs. + apply r_put_vs_put. + ssprove_contract_put_get_lhs. + ssprove_contract_put_get_rhs. + apply r_put_vs_put. + unfold Sigma1.MyParam.R. + rewrite -Hord otf_fto eq_refl. + simpl. + ssprove_sync=>r_i. + apply r_put_vs_put. + ssprove_restore_pre. + { + ssprove_invariant. + apply preserve_update_r_ignored_heap_ignore. + { + rewrite in_fsetU. + apply /orP ; right. + unfold DDH.DDH_locs. + rewrite !fset_cons -fset0E fsetU0. + rewrite in_fsetU. + apply /orP ; right. + rewrite in_fsetU. + apply /orP ; right. + by apply /fset1P. + } + apply preserve_update_l_ignored_heap_ignore. + 2: apply preserve_update_mem_nil. + rewrite in_fsetU. + apply /orP ; right. + unfold DDH.DDH_locs. + rewrite !fset_cons -fset0E fsetU0. + rewrite in_fsetU. + apply /orP ; right. + rewrite in_fsetU. + apply /orP ; right. + by apply /fset1P. + } + ssprove_sync. + ssprove_sync=>queries. + case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e. + all: rewrite e. + all: ssprove_code_simpl ; simpl. + all: ssprove_code_simpl_more ; simpl. + - apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + rewrite -Hord otf_fto eq_refl. + simpl. + ssprove_sync=>e_j. + apply r_put_lhs. + apply r_put_rhs. + clear e queries. + ssprove_restore_pre. + 1: ssprove_invariant. + ssprove_sync. + ssprove_sync=>queries. + case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf e_j)))) eqn:e. + all: rewrite e. + all: simpl; ssprove_code_simpl. + all: ssprove_code_simpl_more. + + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + apply r_ret. + intros ???. + split. + 2: assumption. + unfold f_v. + apply vote_hiding_bij. + + ssprove_sync=>e_i. + apply r_put_vs_put. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + ssprove_restore_pre. + 1: ssprove_invariant. + apply r_ret. + intros ???. + split. + 2: assumption. + unfold f_v. + apply vote_hiding_bij. + - ssprove_sync=>e_i. + apply r_put_vs_put. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + rewrite -Hord otf_fto. + rewrite -Hord eq_refl. + simpl. + ssprove_sync=>r_j. + apply r_put_lhs. + apply r_put_rhs. + ssprove_restore_pre. + 1: ssprove_invariant. + ssprove_sync. + ssprove_sync=>queries'. + case (queries' (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf r_j)))) eqn:e'. + all: rewrite e'. + all: simpl; ssprove_code_simpl. + all: ssprove_code_simpl_more. + + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + apply r_ret. + intros ???. + split. + 2: assumption. + unfold f_v. + apply vote_hiding_bij. + + ssprove_sync=>e_j. + apply r_put_vs_put. + apply r_get_remember_lhs. + intros ?. + apply r_get_remember_rhs. + intros ?. + ssprove_forget_all. + apply r_assertD. + { + intros ??. + rewrite !domm_set. + done. + } + intros _ _. + ssprove_restore_pre. + 1: ssprove_invariant. + apply r_ret. + intros ???. + split. + 2: assumption. + unfold f_v. + apply vote_hiding_bij. + Qed. + +End OVN. +End OVN. diff --git a/theories/Crypt/examples/Schnorr.v b/theories/Crypt/examples/Schnorr.v index 56f58da7..07b30635 100644 --- a/theories/Crypt/examples/Schnorr.v +++ b/theories/Crypt/examples/Schnorr.v @@ -50,13 +50,13 @@ Definition q : nat := #[g]. Module MyParam <: SigmaProtocolParams. - Definition Witness : finType := [finType of 'Z_q]. - Definition Statement : finType := FinGroup.arg_finType gT. - Definition Message : finType := FinGroup.arg_finType gT. - Definition Challenge : finType := [finType of 'Z_q]. - Definition Response : finType := [finType of 'Z_q]. - Definition Transcript := - prod_finType (prod_finType Message Challenge) Response. + Definition Witness : finType := Finite.clone _ 'Z_q. + Definition Statement : finType := gT. + Definition Message : finType := gT. + Definition Challenge : finType := Finite.clone _ 'Z_q. + Definition Response : finType := Finite.clone _ 'Z_q. + Definition Transcript : finType := + prod (prod Message Challenge) Response. Definition w0 : Witness := 0. Definition e0 : Challenge := 0. @@ -79,7 +79,7 @@ Module MyParam <: SigmaProtocolParams. Definition Message_pos : Positive #|Message| := _. Definition Challenge_pos : Positive #|Challenge| := _. Definition Response_pos : Positive #|Response| := _. - Definition Bool_pos : Positive #|bool_choiceType|. + Definition Bool_pos : Positive #|'bool|. Proof. rewrite card_bool. done. Defined. @@ -101,7 +101,7 @@ Module MyAlg <: SigmaProtocolAlgorithms MyParam. chProd (chProd (chProd choiceStatement choiceMessage) choiceChallenge) choiceResponse. - Definition choiceBool := 'fin #|bool_choiceType|. + Definition choiceBool := 'fin #|'bool|. Definition i_witness := #|Witness|. @@ -144,6 +144,8 @@ Module MyAlg <: SigmaProtocolAlgorithms MyParam. (z : choiceResponse) (z' : choiceResponse) : 'option choiceWitness := Some (fto ((otf z - otf z') / (otf e - otf e'))). + Definition KeyGen (w : choiceWitness) := fto (g ^+ w). + End MyAlg. @@ -283,7 +285,7 @@ Proof. Qed. Lemma neq_pos : - ∀ (q : nat) (a b : Zp_finZmodType q), + ∀ (q : nat) (a b : ('Z_q:finZmodType)), a != b → a - b != 0. Proof. @@ -303,34 +305,21 @@ Qed. protocol is perfectly indistinguishable from real protocol execution. *) Lemma extractor_success: - ∀ LA A LAdv Adv, + ∀ LA A, ValidPackage LA [interface - #val #[ SOUNDNESS ] : chStatement → 'bool + #val #[ SOUNDNESS ] : chSoundness → 'bool ] A_export A → - ValidPackage LAdv [interface] [interface - #val #[ ADV ] : chStatement → chSoundness - ] Adv → - fdisjoint LA (Sigma_locs :|: LAdv) → - ɛ_soundness A Adv = 0. + ɛ_soundness A = 0. Proof. - intros LA A LAdv Adv VA VAdv Hdisj. + intros LA A VA. apply: eq_rel_perf_ind_eq. - 2,3: apply Hdisj. + 2,3: apply fdisjoints0. simplify_eq_rel h. - (* This program is composed with abstract adversarial code. *) - (* We need to ensure that the composition is valid. *) - destruct (Adv ADV) as [[? []]|]. - 2:{ apply r_ret. auto. } - repeat destruct choice_type_eqP. - 2,3: apply r_ret ; auto. - apply rsame_head. intros [s [[s0 s3] [s1 s2]]]. - ssprove_code_simpl. simpl. - match goal with - | |- context [ if ?b then _ else _ ] => case b eqn:rel - end. - 2: apply r_ret ; intuition auto. - apply r_ret. - intros. intuition auto. + destruct h as [h [s [s0 [s1 [s2 ?]]]]]. + destruct s0 as [s0 s3]. + case [&& _ & _] eqn:rel. + all: apply r_ret; auto. + intros h1 h2 ->. (* Algebraic proof that the produced witness satisfies the relation. *) unfold R. unfold "&&" in rel. @@ -343,7 +332,7 @@ Proof. rewrite otf_fto in rel. apply reflection_nonsense in rel. apply reflection_nonsense in Heqs4. - rewrite H1. + rewrite H0. rewrite otf_fto expg_mod. 2: rewrite order_ge1 ; apply expg_order. rewrite expgM expg_mod. @@ -381,8 +370,7 @@ Proof. (modn (addn (@nat_of_ord (S (S (Zp_trunc q))) (@otf Challenge s0)) (@nat_of_ord (S (S (Zp_trunc q))) - (@GRing.opp (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) - (@otf Challenge s1)))) q) = + (GRing.opp (@otf Challenge s1)))) q) = (@nat_of_ord (S (S (Zp_trunc q))) (@Zp_add (S (Zp_trunc q)) (@otf Challenge s0) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s1)))). { simpl. @@ -403,18 +391,18 @@ Proof. have -> : (modn (muln (@nat_of_ord (S (S (Zp_trunc q))) - (@GRing.inv (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q))) - (@GRing.add (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) + (GRing.inv + (GRing.add (@otf Challenge s0) - (@GRing.opp (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) + (GRing.opp (@otf Challenge s1))))) (@nat_of_ord (S (S (Zp_trunc q))) (@Zp_add (S (Zp_trunc q)) (@otf Challenge s0) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s1))))) q) = (Zp_mul - (@GRing.inv (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q))) - (@GRing.add (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) + (GRing.inv + (GRing.add (@otf Challenge s0) - (@GRing.opp (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) + (GRing.opp (@otf Challenge s1)))) (@Zp_add (S (Zp_trunc q)) (@otf Challenge s0) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s1)))). { simpl. @@ -442,111 +430,331 @@ Qed. Lemma hiding_adv : ∀ LA A, - ValidPackage LA [interface - #val #[ HIDING ] : chInput → chMessage - ] A_export A → + ValidPackage LA Hiding_E A_export (A ∘ par KEY (ID Hiding_E)) → fdisjoint LA Com_locs → - fdisjoint LA Sigma_locs → + (* fdisjoint LA Sigma_locs → *) + fdisjoint LA KEY_locs → ɛ_hiding A = 0. Proof. - intros LA A Va Hdisj0 Hdisj1. + intros LA A Va Hdisj0 Hdisj2. unfold ɛ_hiding. + apply: eq_rel_perf_ind_eq. + + (* eapply eq_rel_perf_ind_ignore. *) + (* 1,2: exact _. *) + (* 1:{ *) + (* ssprove_invariant. *) + (* unfold Sigma_locs. *) + (* rewrite !fset0U. *) + (* apply fsubsetU. *) + (* apply /orP. left. *) + (* apply fsubsetU. *) + (* apply /orP. left. *) + (* apply fsubsetU. *) + (* apply /orP. left. *) + (* apply fsubsetxx. *) + (* } *) + 2,3: rewrite ?fset0U ; unfold Sigma_locs + ; repeat rewrite fdisjointUr + ; repeat (apply /andP ; split) + ; (exact Hdisj0 || exact Hdisj2 || apply fdisjoints0). + (* 2: apply Va. *) + + simplify_eq_rel hwe. + ssprove_code_simpl. + ssprove_code_simpl_more. + simplify_linking. + destruct hwe as [h w]. + + apply r_const_sample_R. + 1: apply LosslessOp_uniform. + intros e_temp. + + apply r_const_sample_L. + 1: apply LosslessOp_uniform. + intros [ [] ? ] ; [ simpl; clear i | discriminate ]. + + simpl. + set (r := getm _ _). + destruct r ; [ | apply r_ret ; auto]. + destruct t, s. + destruct (choice_type_eqP _ _) ; [ | apply r_ret ; auto]. + destruct (choice_type_eqP _ _) ; [ | apply r_ret ; auto]. + subst. + + rewrite !cast_fun_K. + rewrite (@ord_inj #|'Z_q| h e_temp). + 2:{ + destruct h, e_temp ; simpl. + admit. + } + + replace _ with (eq : choiceMessage * heap → choiceMessage * heap → Prop). + 1:{ + apply (rreflexivity_rule (x0 ← r e_temp ;; ret x0)). + } + apply functional_extensionality. intros []. + apply functional_extensionality. intros []. + admit. +Admitted. + +(* Main theorem proving that the Schnorr protocol has perfect hiding. *) +Theorem schnorr_com_hiding : + ∀ LA A, + ValidPackage LA [interface + #val #[HIDING] : (chChallenge) × (chChallenge) → chMessage + ] A_export (A ∘ par KEY (ID Hiding_E)) -> + fdisjoint LA KEY_locs -> + fdisjoint LA Sigma_to_Com_locs -> + fdisjoint LA (fset [:: setup_loc]) -> + fdisjoint LA Sigma_locs -> + fdisjoint LA Simulator_locs -> + ɛ_hiding A <= 0. +Proof. + intros LA A VA Hd1 Hd2 Hd3 Hd4 Hd5. + eapply Order.le_trans. + 1: eapply commitment_hiding with (LA := LA). + all: try assumption. + 1: apply fdisjoint0s. + { + unfold Sigma_locs. + unfold commit_loc. + unfold statement_loc. + unfold witness_loc. + rewrite !fset_cons. + rewrite -fset0E. + rewrite fdisjointUr ; apply /andP ; split. + - rewrite fdisjoints1. + rewrite fset1E. + rewrite fsetU0. + rewrite -fset1E. + unfold "\notin". + rewrite in_fset1. + case (_ == _) eqn:e. + 2: done. + move: e => /eqP. + done. + - rewrite fdisjointUr ; apply /andP ; split. + + rewrite fdisjoints1. + rewrite fset1E. + rewrite fsetU0. + rewrite -fset1E. + unfold "\notin". + rewrite in_fset1. + case (_ == _) eqn:e. + 2: done. + move: e => /eqP. + done. + + apply fdisjoints0. + } + rewrite addr0. + rewrite add0r. + erewrite schnorr_SHVZK. + 2: { + ssprove_valid. + 1: instantiate (1 := (LA :|: (setup_loc |: Sigma_to_Com_locs))). + 3: apply fsubsetxx. + 2: apply fsub0set. + - apply fsubsetUl. + - apply fsubsetU ; apply /orP ; right. + apply fsubsetxx. + } + 2: { + (* unfold Sigma_locs. *) + unfold Sigma_to_Com_locs. + unfold Simulator_locs. + rewrite fsetU0. + rewrite fdisjointUl ; apply /andP ; split. + - assumption. + - unfold Sigma_locs. + rewrite fdisjointUl ; apply /andP ; split. + + rewrite fdisjoint1s. + unfold "\notin". + rewrite -fset1E. + rewrite in_fset1. + done. + + unfold Com_locs. + rewrite fset_cons. + rewrite fdisjointUl ; apply /andP ; split. + ++ rewrite fdisjoint1s. + rewrite -fset1E. + unfold "\notin". + rewrite in_fset1. + done. + ++ + rewrite -!fset1E. + rewrite fdisjoint1s. + unfold "\notin". + rewrite in_fset1. + done. + } + rewrite Advantage_sym. + erewrite schnorr_SHVZK. + 2: { + ssprove_valid. + 1: instantiate (1 := (LA :|: (setup_loc |: Sigma_to_Com_locs))). + 3: apply fsubsetxx. + 2: apply fsub0set. + - apply fsubsetUl. + - apply fsubsetU ; apply /orP ; right. + apply fsubsetxx. + } + 2: { + (* unfold Sigma_locs. *) + unfold Sigma_to_Com_locs. + unfold Simulator_locs. + rewrite fsetU0. + rewrite fdisjointUl ; apply /andP ; split. + - assumption. + - unfold Sigma_locs. + rewrite fdisjointUl ; apply /andP ; split. + + rewrite fdisjoint1s. + unfold "\notin". + rewrite -fset1E. + rewrite in_fset1. + done. + + unfold Com_locs. + rewrite fset_cons. + rewrite fdisjointUl ; apply /andP ; split. + ++ rewrite fdisjoint1s. + rewrite -fset1E. + unfold "\notin". + rewrite in_fset1. + done. + ++ + rewrite -!fset1E. + rewrite fdisjoint1s. + unfold "\notin". + rewrite in_fset1. + done. + } + rewrite addr0 add0r. + apply eq_ler. eapply eq_rel_perf_ind. 1,2: exact _. 1:{ instantiate (1 := (heap_ignore Com_locs)). ssprove_invariant. - unfold Sigma_locs. + unfold Sigma_to_Com_locs. rewrite !fset0U. - apply fsubsetU. - apply /orP. left. - apply fsubsetU. - apply /orP. left. + apply fsubsetU; apply /orP; left. + apply fsubsetU; apply /orP; left. + apply fsubsetU; apply /orP; right. + apply fsubsetU; apply /orP; left. apply fsubsetxx. } - 3,4: - rewrite ?fset0U ; unfold Sigma_locs; - repeat rewrite fdisjointUr ; - apply /andP ; split ; eassumption. - 2: apply Va. + 2: apply VA. + 3: { + rewrite fset0U. + rewrite fdisjointUr ; apply /andP ; split. + 2: assumption. + rewrite fdisjointUr ; apply /andP ; split. + 2: assumption. + rewrite fset1E. assumption. + } + 2: { + rewrite fset0U. + rewrite fdisjointUr ; apply /andP ; split. + 2: assumption. + rewrite fdisjointUr ; apply /andP ; split. + 2: assumption. + rewrite fset1E. assumption. + } + rewrite Sigma_to_Com_Aux_equation_1. simplify_eq_rel hwe. ssprove_code_simpl. simplify_linking. - destruct hwe as [[h w] e]. + destruct hwe as [e e']. apply r_const_sample_R. 1: apply LosslessOp_uniform. - intros e'. + intros e_rand. rewrite !cast_fun_K. ssprove_code_simpl. ssprove_code_simpl_more. - ssprove_sync_eq=> rel. - ssprove_sync=> x. - ssprove_contract_put_get_lhs. - ssprove_contract_put_get_rhs. - eapply r_put_vs_put. - eapply r_put_vs_put. - eapply r_put_vs_put. - ssprove_restore_pre. 1: ssprove_invariant. - apply r_ret. intuition auto. + apply r_const_sample_L. + 1: apply LosslessOp_uniform. + intros b. + simpl. + case (Nat.even b) eqn:hb. + - rewrite hb ; clear hb. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync=>setup. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync=> w. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync. + apply r_assertD. + 1: done. + intros _ rel. + ssprove_sync=>x. + ssprove_contract_put_get_lhs. + ssprove_contract_put_get_rhs. + eapply r_put_vs_put. + eapply r_put_vs_put. + eapply r_put_vs_put. + ssprove_restore_pre. 1: ssprove_invariant. + apply r_ret. intuition auto. + - rewrite hb ; clear hb. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync=>setup. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync=> w. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync. + apply r_assertD. + 1: done. + intros _ rel. + ssprove_sync=>x. + ssprove_contract_put_get_lhs. + ssprove_contract_put_get_rhs. + eapply r_put_vs_put. + eapply r_put_vs_put. + eapply r_put_vs_put. + ssprove_restore_pre. 1: ssprove_invariant. + apply r_ret. intuition auto. Qed. -(* Main theorem proving that the Schnorr protocol has perfect hiding. *) -Theorem schnorr_com_hiding : - ∀ LA A, - ValidPackage LA [interface - #val #[ HIDING ] : chInput → chMessage - ] A_export A → - fdisjoint LA Com_locs → - fdisjoint LA Sigma_locs → - AdvantageE (Hiding_real ∘ Sigma_to_Com ∘ SHVZK_ideal) (Hiding_ideal ∘ Sigma_to_Com ∘ SHVZK_ideal) A <= 0. -Proof. - intros LA A Va Hdisj0 Hdisj1. - have H := commitment_hiding LA A 0 Va. - rewrite !GRing.addr0 in H. - have HS := schnorr_SHVZK _ _ _. - rewrite hiding_adv in H. - 2,3: assumption. - apply AdvantageE_le_0 in H. - 1: rewrite H ; trivial. - intros B Vb. - have -> := HS _ B Vb. - 2:{ erewrite fdisjointUl. - apply /andP. - split. - - assumption. - - unfold Com_locs, Sigma_locs. - rewrite -fset1E. - rewrite fdisjoints1. - in_fset_auto. } - done. -Qed. (* Main theorem *) (* The commitment scheme instantiated from Schnorr' protocol *) (* is binding equal to the hardness of the relation *) (* (I.e. how hard is it to produce a valid witness for a fixed public input)*) Theorem schnorr_com_binding : - ∀ LA A LAdv Adv, + ∀ LA A, ValidPackage LA [interface - #val #[ SOUNDNESS ] : chStatement → 'bool + #val #[ SOUNDNESS ] : chSoundness → 'bool ] A_export A → - ValidPackage LAdv [interface] [interface - #val #[ ADV ] : chStatement → chSoundness - ] Adv → - fdisjoint LA (Sigma_locs :|: LAdv) → - AdvantageE (Com_Binding ∘ Adv) (Special_Soundness_f ∘ Adv) A <= 0. + fdisjoint LA (Sigma_to_Com_locs :|: KEY_locs) → + AdvantageE (Com_Binding ∘ Sigma_to_Com ∘ KEY) (Special_Soundness_f) A <= 0. Proof. - intros LA A LAdv Adv VA VAdv Hdisj. - have H := commitment_binding LA A LAdv Adv VA VAdv Hdisj. - rewrite extractor_success in H. 2: apply Hdisj. - apply H. + intros LA A VA Hdisj. + eapply Order.le_trans. + 1: apply Advantage_triangle. + instantiate (1 := Special_Soundness_t). + rewrite (commitment_binding LA A VA Hdisj). + setoid_rewrite (extractor_success LA A VA). + now setoid_rewrite GRing.isNmodule.add0r. Qed. End Schnorr. Module GP_Z3 <: GroupParam. - Definition gT : finGroupType := Zp_finGroupType 2. + Definition gT : finGroupType := 'Z_2. Definition ζ : {set gT} := [set : gT]. Definition g : gT := Zp1. diff --git a/theories/Crypt/examples/SigmaProtocol.v b/theories/Crypt/examples/SigmaProtocol.v index f1183cf4..186bde49 100644 --- a/theories/Crypt/examples/SigmaProtocol.v +++ b/theories/Crypt/examples/SigmaProtocol.v @@ -3,7 +3,8 @@ From Relational Require Import OrderEnrichedCategory GenericRulesSimple. Set Warnings "-notation-overridden,-ambiguous-paths". From mathcomp Require Import all_ssreflect all_algebra reals distr realsum - ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice seq. + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool ssrnum + eqtype choice seq. Set Warnings "notation-overridden,ambiguous-paths". From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings @@ -44,7 +45,7 @@ Module Type SigmaProtocolParams. Parameter Message_pos : Positive #|Message|. Parameter Challenge_pos : Positive #|Challenge|. Parameter Response_pos : Positive #|Response|. - Parameter Bool_pos : Positive #|bool_choiceType|. + Parameter Bool_pos : Positive #|'bool|. End SigmaProtocolParams. @@ -68,9 +69,10 @@ Module Type SigmaProtocolAlgorithms (π : SigmaProtocolParams). Definition choiceResponse := 'fin #|Response|. Definition choiceTranscript := chProd (chProd (chProd choiceStatement choiceMessage) choiceChallenge) choiceResponse. - Definition choiceBool := 'fin #|bool_choiceType|. + Definition choiceBool := 'fin #|'bool|. Parameter Sigma_locs : {fset Location}. + Parameter Simulator_locs : {fset Location}. Parameter Commit : @@ -97,6 +99,8 @@ Module Type SigmaProtocolAlgorithms (π : SigmaProtocolParams). (z : choiceResponse) (z' : choiceResponse), 'option choiceWitness. + Parameter KeyGen : ∀ (w : choiceWitness), choiceStatement. + End SigmaProtocolAlgorithms. Module SigmaProtocol (π : SigmaProtocolParams) @@ -107,20 +111,27 @@ Module SigmaProtocol (π : SigmaProtocolParams) Notation " 'chStatement' " := choiceStatement (in custom pack_type at level 2). + Notation " 'chWitness' " := + choiceWitness (in custom pack_type at level 2). + Notation " 'chChallenge' " := + choiceChallenge (in custom pack_type at level 2). Notation " 'chRelation' " := (chProd choiceStatement choiceWitness) (in custom pack_type at level 2). + Definition choiceInput := (chProd (chProd choiceStatement choiceWitness) choiceChallenge). Notation " 'chInput' " := - (chProd (chProd choiceStatement choiceWitness) choiceChallenge) + choiceInput (in custom pack_type at level 2). Notation " 'chMessage' " := choiceMessage (in custom pack_type at level 2). Notation " 'chTranscript' " := choiceTranscript (in custom pack_type at level 2). Definition Opening := chProd choiceChallenge choiceResponse. Notation " 'chSoundness' " := - (chProd choiceMessage (chProd Opening Opening)) + (chProd choiceStatement (chProd choiceMessage (chProd Opening Opening))) (in custom pack_type at level 2). Definition i_challenge := #|Challenge|. + Definition i_witness := #|Witness|. + Definition TRANSCRIPT : nat := 0. Definition COM : nat := 1. Definition VER : nat := 2. @@ -133,7 +144,14 @@ Module SigmaProtocol (π : SigmaProtocolParams) apply Challenge_pos. Qed. + Definition i_witness_pos : Positive i_witness. + Proof. + unfold i_witness. + apply Witness_pos. + Qed. + #[local] Existing Instance i_challenge_pos. + #[local] Existing Instance i_witness_pos. #[local] Open Scope package_scope. @@ -172,15 +190,14 @@ Module SigmaProtocol (π : SigmaProtocolParams) Definition ɛ_SHVZK A := AdvantageE SHVZK_real SHVZK_ideal A. Definition Special_Soundness_f : - package Sigma_locs - [interface #val #[ ADV ] : chStatement → chSoundness ] - [interface #val #[ SOUNDNESS ] : chStatement → 'bool ] + package fset0 + [interface] + [interface #val #[ SOUNDNESS ] : chSoundness → 'bool ] := [package - #def #[ SOUNDNESS ] (h : chStatement) : 'bool + #def #[ SOUNDNESS ] (t : chSoundness) : 'bool { - #import {sig #[ ADV ] : chStatement → chSoundness } as A ;; - '(a, ((e, z), (e', z'))) ← A h ;; + let '(h, (a, ((e, z), (e', z')))) := t in let v1 := Verify h a e z in let v2 := Verify h a e' z' in if [&& (e != e') , (otf v1) & (otf v2) ] then @@ -193,24 +210,24 @@ Module SigmaProtocol (π : SigmaProtocolParams) ]. Definition Special_Soundness_t : - package Sigma_locs - [interface #val #[ ADV ] : chStatement → chSoundness ] - [interface #val #[ SOUNDNESS ] : chStatement → 'bool ] + package fset0 + [interface] + [interface #val #[ SOUNDNESS ] : chSoundness → 'bool ] := [package - #def #[ SOUNDNESS ] (h : chStatement) : 'bool + #def #[ SOUNDNESS ] (t : chSoundness) : 'bool { - #import {sig #[ ADV ] : chStatement → chSoundness } as A ;; - '(a, ((e, z), (e', z'))) ← A(h) ;; + let '(h, (a, ((e, z), (e', z')))) := t in let v1 := Verify h a e z in let v2 := Verify h a e' z' in ret [&& (e != e') , (otf v1) & (otf v2) ] } ]. + (* Simulation Sound Extractability *) (* Main security statement for 2-special soundness. *) - Definition ɛ_soundness A Adv := - AdvantageE (Special_Soundness_t ∘ Adv) (Special_Soundness_f ∘ Adv) A. + Definition ɛ_soundness A := + AdvantageE Special_Soundness_t Special_Soundness_f A. (**************************************) (* Start of Commitment Scheme Section *) @@ -219,15 +236,24 @@ Module SigmaProtocol (π : SigmaProtocolParams) Definition HIDING : nat := 5. Definition OPEN : nat := 6. + Definition INIT : nat := 7. + Definition GET : nat := 8. Definition challenge_loc : Location := ('option choiceChallenge; 7%N). Definition response_loc : Location := ('option choiceResponse; 8%N). Definition Com_locs : {fset Location} := - fset [:: challenge_loc ; response_loc]. + fset [:: challenge_loc ; response_loc ]. + + + Definition setup_loc : Location := ('bool; 10%N). + Definition statement_loc : Location := (choiceStatement; 11%N). + Definition witness_loc : Location := (choiceWitness; 12%N). + Definition KEY_locs : {fset Location} := fset [:: setup_loc; witness_loc ; statement_loc]. Definition choiceOpen := (chProd choiceChallenge choiceResponse). Notation " 'chOpen' " := choiceOpen (in custom pack_type at level 2). + Notation " 'chKeys' " := (chProd choiceStatement choiceWitness) (in custom pack_type at level 2). Lemma in_fset_left l (L1 L2 : {fset Location}) : is_true (l \in L1) → @@ -242,24 +268,121 @@ Module SigmaProtocol (π : SigmaProtocolParams) apply in_fset_left; solve [auto_in_fset] : typeclass_instances ssprove_valid_db. - Definition Sigma_to_Com: - package Com_locs - [interface #val #[ TRANSCRIPT ] : chInput → chTranscript] + Definition KEY: + package KEY_locs + [interface] + [interface + #val #[ INIT ] : 'unit → 'unit ; + #val #[ GET ] : 'unit → chStatement + ] + := + [package + #def #[ INIT ] (_ : 'unit) : 'unit + { + b ← get setup_loc ;; + #assert (negb b) ;; + w ← sample uniform i_witness ;; + let h := KeyGen w in + #assert (R (otf h) (otf w)) ;; + #put setup_loc := true ;; + #put statement_loc := h ;; + #put witness_loc := w ;; + @ret 'unit Datatypes.tt + } + ; + #def #[ GET ] (_ : 'unit) : chStatement + { + b ← get setup_loc ;; + if b then + h ← get statement_loc ;; + w ← get witness_loc ;; + ret h + else + fail + } + ]. + + Definition Sigma_to_Com_locs := (Com_locs :|: Simulator_locs). + + #[tactic=notac] Equations? Sigma_to_Com: + package Sigma_to_Com_locs [interface - #val #[ COM ] : chInput → chMessage ; + #val #[ INIT ] : 'unit → 'unit ; + #val #[ GET ] : 'unit → chStatement + ] + [interface + #val #[ COM ] : chChallenge → chMessage ; #val #[ OPEN ] : 'unit → chOpen ; #val #[ VER ] : chTranscript → 'bool ] - := + := Sigma_to_Com := [package - #def #[ COM ] (hwe : chInput) : chMessage + #def #[ COM ] (e : chChallenge) : chMessage { - #import {sig #[ TRANSCRIPT ] : chInput → chTranscript } as run ;; - '(h,a,e,z) ← run hwe ;; + #import {sig #[ INIT ] : 'unit → 'unit } as key_gen_init ;; + #import {sig #[ GET ] : 'unit → chStatement } as key_gen_get ;; + _ ← key_gen_init Datatypes.tt ;; + h ← key_gen_get Datatypes.tt ;; + '(h,a,e,z) ← Simulate h e ;; #put challenge_loc := Some e ;; #put response_loc := Some z ;; ret a - } ; + } + ; + #def #[ OPEN ] (_ : 'unit) : chOpen + { + o_e ← get challenge_loc ;; + o_z ← get response_loc ;; + match (o_e, o_z) with + | (Some e, Some z) => @ret choiceOpen (e, z) + | _ => fail + end + } + ; + #def #[ VER ] (t : chTranscript) : 'bool + { + let '(h,a,e,z) := t in + ret (otf (Verify h a e z)) + } + ]. + Proof. + unfold Sigma_to_Com_locs. + ssprove_valid. + eapply valid_injectLocations. + 1: apply fsubsetUr. + eapply valid_injectMap. + 2: apply (Simulate x1 x). + rewrite -fset0E. + apply fsub0set. + Qed. + + #[tactic=notac] Equations? Sigma_to_Com_Aux: + package (setup_loc |: Sigma_to_Com_locs) + [interface + #val #[ TRANSCRIPT ] : chInput → chTranscript + ] + [interface + #val #[ COM ] : chChallenge → chMessage ; + #val #[ OPEN ] : 'unit → chOpen ; + #val #[ VER ] : chTranscript → 'bool + ] + := Sigma_to_Com_Aux := + [package + #def #[ COM ] (e : chChallenge) : chMessage + { + #import {sig #[ TRANSCRIPT ] : chInput → chTranscript } as RUN ;; + b ← get setup_loc ;; + #assert (negb b) ;; + w ← sample uniform i_witness ;; + let h := KeyGen w in + #assert (R (otf h) (otf w)) ;; + #put setup_loc := true ;; + '(h, a, e, z) ← RUN (h, w, e) ;; + #put challenge_loc := Some e ;; + #put response_loc := Some z ;; + @ret choiceMessage a + } + ; #def #[ OPEN ] (_ : 'unit) : chOpen { o_e ← get challenge_loc ;; @@ -276,23 +399,44 @@ Module SigmaProtocol (π : SigmaProtocolParams) ret (otf (Verify h a e z)) } ]. + Proof. + unfold Sigma_to_Com_locs, Com_locs. + ssprove_valid. + all: rewrite in_fsetU ; apply /orP ; right. + all: rewrite in_fsetU ; apply /orP ; left. + all: rewrite !fset_cons. + 1,3 : rewrite in_fsetU ; apply /orP ; left ; rewrite in_fset1 ; done. + 1,2 : rewrite in_fsetU ; apply /orP ; right ; + rewrite in_fsetU ; apply /orP ; left ; + rewrite in_fset1 ; done. + Qed. + + Notation " 'chHiding' " := (chProd choiceChallenge choiceChallenge) (in custom pack_type at level 2). + + Definition Hiding_E := [interface #val #[ HIDING ] : chHiding → chMessage ]. (* Commitment to input value*) - Definition Hiding_real : + Definition Hiding_real: package fset0 [interface - #val #[ COM ] : chInput → chMessage ; + #val #[ COM ] : chChallenge → chMessage ; #val #[ OPEN ] : 'unit → chOpen ; #val #[ VER ] : chTranscript → 'bool ] - [interface #val #[ HIDING ] : chInput → chMessage ] + Hiding_E := [package - #def #[ HIDING ] (hwe : chInput) : chMessage + #def #[ HIDING ] (ms : chHiding) : chMessage { - #import {sig #[ COM ] : chInput → chMessage } as com ;; - a ← com hwe ;; - ret a + #import {sig #[ COM ] : chChallenge → chMessage } as com ;; + let '(m1, m2) := ms in + b ← sample uniform 1 ;; + if Nat.even b then + a ← com m1 ;; + ret a + else + a ← com m2 ;; + ret a } ]. @@ -300,131 +444,362 @@ Module SigmaProtocol (π : SigmaProtocolParams) Definition Hiding_ideal : package fset0 [interface - #val #[ COM ] : chInput → chMessage ; + #val #[ COM ] : chChallenge → chMessage ; #val #[ OPEN ] : 'unit → chOpen ; #val #[ VER ] : chTranscript → 'bool ] - [interface #val #[ HIDING ] : chInput → chMessage] + Hiding_E := [package - #def #[ HIDING ] (hwe : chInput) : chMessage + #def #[ HIDING ] (_ : chHiding) : chMessage { - #import {sig #[ COM ] : chInput → chMessage } as com ;; - let '(h,w,_) := hwe in + #import {sig #[ COM ] : chChallenge → chMessage } as com ;; e ← sample uniform i_challenge ;; - t ← com (h,w,e) ;; + t ← com e ;; ret t } ]. Definition ɛ_hiding A := AdvantageE - (Hiding_real ∘ Sigma_to_Com ∘ SHVZK_real) - (Hiding_ideal ∘ Sigma_to_Com ∘ SHVZK_real) A. + (Hiding_real ∘ Sigma_to_Com ∘ KEY) + (Hiding_ideal ∘ Sigma_to_Com ∘ KEY) (A ∘ (par KEY (ID Hiding_E))). + + Notation inv := ( + heap_ignore (fset [:: statement_loc ; witness_loc]) + ). + + Instance Invariant_inv : Invariant (Sigma_to_Com_locs :|: KEY_locs) (setup_loc |: Sigma_to_Com_locs) inv. + Proof. + ssprove_invariant. + unfold KEY_locs. + apply fsubsetU ; apply /orP ; left. + apply fsubsetU ; apply /orP ; right. + rewrite !fset_cons. + apply fsubsetU ; apply /orP ; right. + rewrite fsubUset ; apply /andP ; split. + - apply fsubsetU ; apply /orP ; right. + apply fsubsetU ; apply /orP ; left. + apply fsubsetxx. + - apply fsubsetU ; apply /orP ; left. + rewrite fsubUset ; apply /andP ; split. + + apply fsubsetxx. + + rewrite -fset0E. apply fsub0set. + Qed. + + Hint Extern 50 (_ = code_link _ _) => + rewrite code_link_scheme + : ssprove_code_simpl. Theorem commitment_hiding : - ∀ LA A eps, + ∀ LA A, ValidPackage LA [interface - #val #[ HIDING ] : chInput → chMessage - ] A_export A → - (∀ B, - ValidPackage (LA :|: Com_locs) [interface - #val #[ TRANSCRIPT ] : chInput → chTranscript - ] A_export B → - ɛ_SHVZK B <= eps - ) → - AdvantageE - (Hiding_real ∘ Sigma_to_Com ∘ SHVZK_ideal) - (Hiding_ideal ∘ Sigma_to_Com ∘ SHVZK_ideal) A - <= - (ɛ_hiding A) + eps + eps. + #val #[ HIDING ] : chHiding → chMessage + ] A_export (A ∘ (par KEY (ID Hiding_E))) → + fdisjoint LA KEY_locs -> + fdisjoint LA Sigma_to_Com_locs -> + fdisjoint LA (fset [:: setup_loc]) -> + fdisjoint LA Sigma_locs -> + fdisjoint LA Simulator_locs -> + fdisjoint Simulator_locs (fset [:: statement_loc ; witness_loc]) -> + fdisjoint Sigma_locs (fset [:: statement_loc ; witness_loc]) -> + (ɛ_hiding A) <= 0 + + AdvantageE SHVZK_ideal SHVZK_real (((A ∘ par KEY (ID Hiding_E)) ∘ Hiding_real) ∘ Sigma_to_Com_Aux) + + AdvantageE (Hiding_real ∘ Sigma_to_Com_Aux ∘ SHVZK_real) + (Hiding_ideal ∘ Sigma_to_Com_Aux ∘ SHVZK_real) (A ∘ par KEY (ID Hiding_E)) + + AdvantageE SHVZK_real SHVZK_ideal (((A ∘ par KEY (ID Hiding_E)) ∘ Hiding_ideal) ∘ Sigma_to_Com_Aux) + + 0. Proof. unfold ɛ_hiding, ɛ_SHVZK. - intros LA A eps Va Hadv. - ssprove triangle (Hiding_real ∘ Sigma_to_Com ∘ SHVZK_ideal) [:: - (Hiding_real ∘ Sigma_to_Com ∘ SHVZK_real) ; - (Hiding_ideal ∘ Sigma_to_Com ∘ SHVZK_real) - ] (Hiding_ideal ∘ Sigma_to_Com ∘ SHVZK_ideal) A + intros LA A VA Hd1 Hd2 Hd3 HdSigma HdSimulator Hd4 Hd5. + ssprove triangle (Hiding_real ∘ Sigma_to_Com ∘ KEY) [:: + (Hiding_real ∘ Sigma_to_Com_Aux ∘ SHVZK_ideal) ; + (Hiding_real ∘ Sigma_to_Com_Aux ∘ SHVZK_real) ; + (Hiding_ideal ∘ Sigma_to_Com_Aux ∘ SHVZK_real) ; + (Hiding_ideal ∘ Sigma_to_Com_Aux ∘ SHVZK_ideal) + ] (Hiding_ideal ∘ Sigma_to_Com ∘ KEY) (A ∘ (par KEY (ID Hiding_E))) as ineq. eapply le_trans. 1: exact ineq. clear ineq. - rewrite <- !Advantage_link. - eapply ler_add. - - rewrite GRing.addrC. eapply ler_add. 1: apply lexx. - specialize (Hadv (A ∘ Hiding_real ∘ Sigma_to_Com)). - rewrite <- link_assoc. rewrite Advantage_sym. - apply Hadv. ssprove_valid. - + apply fsub0set. - + apply fsubsetxx. - + apply fsubsetUl. - + apply fsubsetUr. - - specialize (Hadv (A ∘ Hiding_ideal ∘ Sigma_to_Com)). - rewrite <- link_assoc. - apply Hadv. ssprove_valid. - + apply fsub0set. - + apply fsubsetxx. - + apply fsubsetUl. - + apply fsubsetUr. + repeat eapply lerD. + - apply eq_ler. + eapply eq_rel_perf_ind with (inv := inv). + 5: apply VA. + 1:{ + ssprove_valid. + 3: apply fsub0set. + 3: apply fsubsetxx. + 1: instantiate (1 := (Sigma_to_Com_locs :|: KEY_locs)). + 1: apply fsubsetUl. + 1: apply fsubsetUr. + } + 1:{ + ssprove_valid. + 1: apply fsubsetxx. + 2: apply fsub0set. + 2: apply fsubsetxx. + unfold Sigma_to_Com_locs. + apply fsubsetU ; apply /orP ; right. + apply fsubsetUr. + } + 3,4: rewrite fdisjointUr ; apply /andP ; split. + 3-4,6: assumption. + 3: rewrite fset1E ; assumption. + 1: exact _. + rewrite Sigma_to_Com_equation_1. + rewrite Sigma_to_Com_Aux_equation_1. + simplify_eq_rel h. + ssprove_code_simpl. + destruct h. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync=>b. + case (Nat.even b) eqn:Hb ; rewrite Hb. + + ssprove_sync=> setup. + ssprove_code_simpl. + ssprove_code_simpl_more. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync=> w. + apply r_assertD. + 1: done. + intros _ Rel. + ssprove_swap_seq_lhs [:: 2 ; 1]%N. + ssprove_contract_put_get_lhs. + rewrite !cast_fun_K. + rewrite Rel. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync. + ssprove_swap_lhs 1%N. + ssprove_contract_put_get_lhs. + ssprove_swap_seq_lhs [:: 0 ; 1]%N. + ssprove_contract_put_get_lhs. + apply r_put_lhs. + apply r_put_lhs. + ssprove_restore_pre. + 1: ssprove_invariant. + eapply rsame_head_alt. + 1: exact _. + { + unfold inv. + intros l lin h1 s' h2. + apply h2. + move: Hd4 => /fdisjointP Hd4. + apply Hd4. + apply lin. + } + { + unfold inv. + intros l v lin. + apply put_pre_cond_heap_ignore. + } + intros t. + destruct t. + destruct s1. + destruct s1. + ssprove_sync. + ssprove_sync. + apply r_ret. + done. + + ssprove_sync=>setup. + ssprove_code_simpl. + ssprove_code_simpl_more. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync=>w. + apply r_assertD. + 1: done. + intros _ Rel. + ssprove_swap_seq_lhs [:: 2 ; 1]%N. + ssprove_contract_put_get_lhs. + rewrite !cast_fun_K. + rewrite Rel. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync. + ssprove_swap_lhs 1%N. + ssprove_contract_put_get_lhs. + ssprove_swap_seq_lhs [:: 0 ; 1]%N. + ssprove_contract_put_get_lhs. + apply r_put_lhs. + apply r_put_lhs. + ssprove_restore_pre. + 1: ssprove_invariant. + eapply rsame_head_alt. + 1: exact _. + { + unfold inv. + intros l lin h1 s' h2. + apply h2. + move: Hd4 => /fdisjointP Hd4. + apply Hd4. + apply lin. + } + { + unfold inv. + intros l v lin. + apply put_pre_cond_heap_ignore. + } + intros t. + destruct t. + destruct s1. + destruct s1. + ssprove_sync. + ssprove_sync. + apply r_ret. + done. + - rewrite -!Advantage_link. + 1: apply eq_ler ; done. + - done. + - rewrite -!Advantage_link. + 1: apply eq_ler ; done. + - apply eq_ler. + eapply eq_rel_perf_ind with (inv := inv). + 5: apply VA. + 1:{ + ssprove_valid. + 4: apply fsubsetxx. + 3: apply fsub0set. + 2: instantiate (1 := (Simulator_locs :|: (setup_loc |: Sigma_to_Com_locs))). + - apply fsubsetUr. + - apply fsubsetUl. + } + 1:{ + ssprove_valid. + 3: apply fsub0set. + 3: apply fsubsetxx. + 1: instantiate (1 := (Sigma_to_Com_locs :|: KEY_locs)). + - apply fsubsetUl. + - apply fsubsetUr. + } + 3,4: rewrite fdisjointUr ; apply /andP ; split. + 4: rewrite fdisjointUr ; apply /andP ; split. + 3,5-7: assumption. + 3: rewrite fset1E ; assumption. + { + ssprove_invariant. + unfold KEY_locs. + apply fsubsetU ; apply /orP ; right. + apply fsubsetU ; apply /orP ; right. + rewrite !fset_cons. + apply fsubsetU ; apply /orP ; right. + rewrite fsubUset ; apply /andP ; split. + - apply fsubsetU ; apply /orP ; right. + apply fsubsetU ; apply /orP ; left. + apply fsubsetxx. + - apply fsubsetU ; apply /orP ; left. + rewrite fsubUset ; apply /andP ; split. + + apply fsubsetxx. + + rewrite -fset0E. apply fsub0set. + } + rewrite Sigma_to_Com_equation_1. + rewrite Sigma_to_Com_Aux_equation_1. + simplify_eq_rel h. + ssprove_code_simpl. + destruct h. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync=>e. + ssprove_sync=> setup. + ssprove_code_simpl. + ssprove_code_simpl_more. + apply r_assertD. + 1: done. + intros _ _. + ssprove_sync=> w. + apply r_assertD. + 1: done. + intros _ Rel. + ssprove_swap_seq_rhs [:: 2 ; 1]%N. + ssprove_contract_put_get_rhs. + rewrite !cast_fun_K. + rewrite Rel. + ssprove_code_simpl. + ssprove_code_simpl_more. + ssprove_sync. + ssprove_swap_rhs 1%N. + ssprove_contract_put_get_rhs. + ssprove_swap_seq_rhs [:: 0 ; 1]%N. + ssprove_contract_put_get_rhs. + apply r_put_rhs. + apply r_put_rhs. + ssprove_restore_pre. + 1: ssprove_invariant. + eapply rsame_head_alt. + 1: exact _. + { + unfold inv. + intros l lin h1 s' h2. + apply h2. + move: Hd4 => /fdisjointP Hd4. + apply Hd4. + apply lin. + } + { + unfold inv. + intros l v lin. + apply put_pre_cond_heap_ignore. + } + intros t. + destruct t. + destruct s1. + destruct s1. + ssprove_sync. + ssprove_sync. + apply r_ret. + done. Qed. - Definition Com_Binding : - package Sigma_locs - [interface #val #[ ADV ] : chStatement → chSoundness ] - [interface #val #[ SOUNDNESS ] : chStatement → 'bool ] + Definition Com_Binding: + package fset0 + [interface + #val #[ COM ] : chChallenge → chMessage ; + #val #[ OPEN ] : 'unit → chOpen ; + #val #[ VER ] : chTranscript → 'bool + ] + [interface #val #[ SOUNDNESS ] : chSoundness → 'bool ] := [package - #def #[ SOUNDNESS ] (h : chStatement) : 'bool + #def #[ SOUNDNESS ] (t : chSoundness) : 'bool { - #import {sig #[ ADV ] : chStatement → chSoundness} as A ;; - '(a, ((e, z), (e', z'))) ← A h ;; - let v1 := Verify h a e z in - let v2 := Verify h a e' z' in - ret [&& (e != e') , (otf v1) & (otf v2) ] + #import {sig #[ VER ] : chTranscript → 'bool } as Ver ;; + let '(h, (a, ((e, z), (e', z')))) := t in + v1 ← Ver (h, a, e, z) ;; + v2 ← Ver (h, a, e', z') ;; + ret [&& (e != e'), v1 & v2] } ]. Lemma commitment_binding : - ∀ LA A LAdv Adv, + ∀ LA A, ValidPackage LA [interface - #val #[ SOUNDNESS ] : chStatement → 'bool + #val #[ SOUNDNESS ] : chSoundness → 'bool ] A_export A → - ValidPackage LAdv [interface] [interface - #val #[ ADV ] : chStatement → chSoundness - ] Adv → - fdisjoint LA (Sigma_locs :|: LAdv) → - AdvantageE (Com_Binding ∘ Adv) (Special_Soundness_f ∘ Adv) A <= - ɛ_soundness A Adv. + fdisjoint LA (Sigma_to_Com_locs :|: KEY_locs) → + AdvantageE (Com_Binding ∘ Sigma_to_Com ∘ KEY) (Special_Soundness_t) A = 0. Proof. - intros LA A LAdv Adv VA VAdv Hdisj. - ssprove triangle (Com_Binding ∘ Adv) [:: - (Special_Soundness_t ∘ Adv) - ] (Special_Soundness_f ∘ Adv) A as ineq. - eapply le_trans. 1: exact ineq. - clear ineq. - rewrite ger_addr. - apply eq_ler. + intros LA A VA Hdisj. eapply eq_rel_perf_ind_eq. 4: apply VA. 1:{ - eapply valid_link. 2: apply VAdv. - ssprove_valid. - } - 1:{ - eapply valid_link. 2: apply VAdv. ssprove_valid. + 3: apply fsub0set. + 1: instantiate (1 := (Sigma_to_Com_locs :|: KEY_locs)). + 2: apply fsubsetUr. + 1: apply fsubsetUl. + apply fsubsetxx. } - 2,3: assumption. + 1: ssprove_valid. + 2: assumption. + 2: apply fdisjoints0. + rewrite Sigma_to_Com_equation_1. simplify_eq_rel h. - - destruct (Adv ADV) as [[? []]|]. - 2:{ apply r_ret. intuition auto. } - - repeat destruct choice_type_eqP. - 2:{ apply r_ret. intuition auto. } - 2:{ apply r_ret. intuition auto. } - ssprove_code_simpl. - apply rsame_head. intros [? [[] []]]. + simpl. + destruct h, s0, s1, s1, s2. apply r_ret. auto. Qed. @@ -432,11 +807,10 @@ Module SigmaProtocol (π : SigmaProtocolParams) (* This section aim to prove an automatic conversation between the sampling of the random challenge and a random oracle. *) (* The main difference is that the random oracle is a query parametrized by the context of the execution. *) - Import RandomOracle. Module OracleParams <: ROParams. - Definition Query := prod_finType Statement Message. + Definition Query := Datatypes_prod__canonical__fintype_Finite Statement Message. Definition Random := Challenge. Definition Query_pos : Positive #|Query|. @@ -457,8 +831,12 @@ Module SigmaProtocol (π : SigmaProtocolParams) Section FiatShamir. - Definition RUN : nat := 6. - Definition VERIFY : nat := 7. + Definition RUN : nat := 7. + Definition VERIFY : nat := 8. + Definition SIM : nat := 9. + + Context (Sim_locs : {fset Location}). + Context (Sim : choiceStatement → code Sim_locs [interface] choiceTranscript). Definition prod_assoc : chProd choiceStatement choiceMessage → chQuery. Proof. @@ -468,7 +846,7 @@ Module SigmaProtocol (π : SigmaProtocolParams) Qed. (* TW: I moved it here because it might induce back-tracking and we want to - avoid it because of time-consumption. + avoid it because of time-consumption. *) Hint Extern 20 (ValidCode ?L ?I ?c.(prog)) => eapply valid_injectMap ; [| eapply c.(prog_valid) ] @@ -507,6 +885,33 @@ Module SigmaProtocol (π : SigmaProtocolParams) } ]. + Definition Fiat_Shamir_SIM : + package Sim_locs + [interface + #val #[ QUERY ] : 'query → 'random + ] + [interface + #val #[ VERIFY ] : chTranscript → 'bool ; + #val #[ RUN ] : chRelation → chTranscript + ] + := + [package + #def #[ VERIFY ] (t : chTranscript) : 'bool + { + #import {sig #[ QUERY ] : 'query → 'random } as RO_query ;; + let '(h,a,e,z) := t in + e ← RO_query (prod_assoc (h, a)) ;; + ret (otf (Verify h a e z)) + } ; + #def #[ RUN ] (hw : chRelation) : chTranscript + { + let '(h,w) := hw in + #assert (R (otf h) (otf w)) ;; + t ← Sim h ;; + ret t + } + ]. + Definition RUN_interactive : package Sigma_locs [interface] @@ -533,7 +938,7 @@ Module SigmaProtocol (π : SigmaProtocolParams) ]. Definition SHVZK_real_aux : - package Sigma_locs + package fset0 [interface #val #[ TRANSCRIPT ] : chInput → chTranscript ] [interface #val #[ RUN ] : chRelation → chTranscript ] := @@ -562,7 +967,9 @@ Module SigmaProtocol (π : SigmaProtocolParams) 2:{ rewrite <- fsetUid. eapply valid_link. - - apply SHVZK_real_aux. + - eapply (valid_package_inject_locations). + 2: apply SHVZK_real_aux. + apply fsub0set. - apply SHVZK_real. } 1:{ diff --git a/theories/Crypt/examples/concrete_groups.v b/theories/Crypt/examples/concrete_groups.v index a7c2874e..82b50cb0 100644 --- a/theories/Crypt/examples/concrete_groups.v +++ b/theories/Crypt/examples/concrete_groups.v @@ -6,7 +6,7 @@ Set Warnings "-notation-overridden,-ambiguous-paths,-notation-incompatible-forma From mathcomp Require Import all_ssreflect fingroup.fingroup fintype eqtype choice seq. Set Warnings "notation-overridden,ambiguous-paths,notation-incompatible-format". - +From HB Require Import structures. From deriving Require Import deriving. Set Bullet Behavior "Strict Subproofs". @@ -42,29 +42,45 @@ Module Z2_manual. ltac:(move => [|] [|]; try solve [ right ; discriminate ]; try solve [ left ; reflexivity ]). +(* Definition Z2_eqMixin := EqMixin Z2_eqP. Canonical Z2_eqType : eqType := Eval hnf in EqType Z2 Z2_eqMixin. +*) + Definition Z2_hasDecEq := hasDecEq.Build Z2 Z2_eqP. + HB.instance Definition _ := Z2_hasDecEq. Definition Z2_pickle x : nat := match x with z => 0 | o => 1 end. Definition Z2_unpickle (x : nat) := match x with 0 => Some z | 1 => Some o | _ => None end. Lemma Z2_p_u_cancel : @pcancel nat Z2 Z2_pickle Z2_unpickle. Proof. move => [|] //. Qed. + (* Definition Z2_choiceMixin := PcanChoiceMixin Z2_p_u_cancel. Canonical Z2_choiceType := ChoiceType Z2 Z2_choiceMixin. + *) + HB.instance Definition _ := Choice.copy Z2 (pcan_type Z2_p_u_cancel). + (* Definition Z2_countMixin := @choice.Countable.Mixin Z2 Z2_pickle Z2_unpickle Z2_p_u_cancel. Canonical Z2_countType := Eval hnf in CountType Z2 Z2_countMixin. + *) + Definition Z2_hasCountable := isCountable.Build Z2 Z2_p_u_cancel. + HB.instance Definition _ := Z2_hasCountable. Definition Z2_enum : seq Z2 := [:: z; o]. Lemma Z2_enum_uniq : uniq Z2_enum. Proof. reflexivity. Qed. Lemma mem_Z2_enum i : i \in Z2_enum. Proof. destruct i; reflexivity. Qed. + + (* Definition Z2_finMixin := Eval hnf in UniqFinMixin Z2_enum_uniq mem_Z2_enum. Canonical Z2_finType := Eval hnf in FinType Z2 Z2_finMixin. + *) + Definition Z2_isFinite := isFinite.Build Z2 (Finite.uniq_enumP Z2_enum_uniq mem_Z2_enum). + HB.instance Definition _ := Z2_isFinite. Lemma assoc_add : associative add. Proof. move => [|] [|] [|] //. Qed. @@ -75,16 +91,26 @@ Module Z2_manual. Lemma Z2_invgM : {morph inv : a b / add a b >-> add b a}. Proof. move => [|] [|] //. Qed. + (* Definition Z2_finGroupBaseMixin := FinGroup.BaseMixin assoc_add lid inv_inv Z2_invgM. Canonical Z2_BaseFinGroupType := BaseFinGroupType Z2 Z2_finGroupBaseMixin. + *) + + Definition Z2_isMulBaseGroup := isMulBaseGroup.Build Z2 assoc_add lid inv_inv Z2_invgM. + HB.instance Definition _ := Z2_isMulBaseGroup. Definition linv : left_inverse z inv add. Proof. move => [|] //. Qed. + (* Canonical Z2_finGroup : finGroupType := FinGroupType linv. + *) + + Definition Z2_BaseFinGroup_isGroup := BaseFinGroup_isGroup.Build Z2 linv. + HB.instance Definition _ := Z2_BaseFinGroup_isGroup. End Z2_manual. @@ -104,17 +130,30 @@ Module Z2_bool. Lemma bool_invgM : {morph invb : a b / addb a b >-> addb b a}. Proof. move => [|] [|] //. Qed. + (* Definition bool_finGroupBaseMixin := FinGroup.BaseMixin assoc_addb lidb inv_invb bool_invgM. Canonical bool_BaseFinGroupType := BaseFinGroupType bool bool_finGroupBaseMixin. + *) + + Definition bool_isMulBaseGroup := isMulBaseGroup.Build bool assoc_addb lidb inv_invb bool_invgM. + HB.instance Definition _ := bool_isMulBaseGroup. + Definition linvb : left_inverse false invb addb. Proof. move => [|] //. Qed. + (* Canonical bool_finGroup : finGroupType := FinGroupType linvb. + *) + + Definition bool_BaseFinGroup_isGroup := BaseFinGroup_isGroup.Build bool linvb. + HB.instance Definition _ := bool_BaseFinGroup_isGroup. + End Z2_bool. +(* TODO Section Z3_deriving. (* Construction of Z3 using deriving but not the fingroup mixin. *) Inductive Z3 := z | o | t. @@ -159,7 +198,9 @@ Section Z3_deriving. Canonical Z3_finGroup : finGroupType := FinGroupType linv. End Z3_deriving. +*) +(* TODO Is this still needed? - Update or delete. Module Z2. (* Minimal (?) construction of Z2 using the fingroup mixin. *) Definition invb x : bool := x. @@ -172,7 +213,9 @@ Module Z2. Canonical bool_finGroup := BaseFinGroupType _ (FinGroup.Mixin assoc_xorb lidb linvb). Canonical Z2_finGroup : finGroupType := FinGroupType linvb. End Z2. +*) +(* TODO Module Z3. (* Z3 using the fingroup mixin and deriving. *) Inductive Z3 := z | o | t. @@ -208,3 +251,4 @@ Module Z3. Canonical Z3_BaseFinGroupType := BaseFinGroupType _ (FinGroup.Mixin assoc_add lid linv). Canonical Z3_finGroup : finGroupType := FinGroupType linv. End Z3. +*) diff --git a/theories/Crypt/examples/package_usage_example.v b/theories/Crypt/examples/package_usage_example.v index 152c03ac..1a5d04ce 100644 --- a/theories/Crypt/examples/package_usage_example.v +++ b/theories/Crypt/examples/package_usage_example.v @@ -59,10 +59,10 @@ Definition p1 : package fset0 [interface] I1 := } ]. -Definition foo (x : bool) : code fset0 [interface] bool_choiceType := +Definition foo (x : bool) : code fset0 [interface] bool := {code let u := x in ret u}. -Definition bar (b : bool) : code fset0 [interface] nat_choiceType := +Definition bar (b : bool) : code fset0 [interface] nat := {code if b then ret 0 else ret 1}. Definition p2 : package fset0 [interface] I2 := @@ -123,6 +123,7 @@ Definition sig := {sig #[0] : 'nat → 'nat }. ret (getm m 0) } ]. +Admit Obligations. (* Testing the #import notation *) Definition test₃ : diff --git a/theories/Crypt/jasmin_util.v b/theories/Crypt/jasmin_util.v new file mode 100644 index 00000000..eaab7e9f --- /dev/null +++ b/theories/Crypt/jasmin_util.v @@ -0,0 +1,2023 @@ +(* ** Imports and settings *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect. +From Coq.Unicode Require Import Utf8. +From Coq Require Import ZArith Zwf Setoid Morphisms CMorphisms CRelationClasses Psatz. +(* Require Import xseq oseq. *) +From mathcomp Require Import word_ssrZ. + + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Local Open Scope Z_scope. + +Lemma eq_axiom_of_scheme X (beq : X -> X -> bool) : + (forall x y : X, beq x y -> x = y) -> + (forall x y : X, x = y -> beq x y) -> + Equality.axiom beq. +Proof. move=> hbl hlb x y. apply: (iffP idP); first exact: hbl. exact: hlb. Qed. + +(* -------------------------------------------------------------------- *) +Module FinIsCount. +Section FinIsCount. +Variable (T : eqType) (enum : seq T) (A : Finite.axiom enum). + +Definition pickle (x : T) := + seq.index x enum. + +Definition unpickle (n : nat) := + nth None [seq some x | x <- enum] n. + +Definition pickleK : pcancel pickle unpickle. +Proof. +move=> x; have xE: x \in enum by apply/count_memPn; rewrite (A x). +by rewrite /pickle /unpickle (nth_map x) ?(nth_index, index_mem). +Qed. +End FinIsCount. +End FinIsCount. + +Class eqTypeC (T:Type) := + { beq : T -> T -> bool + ; ceqP: Equality.axiom beq }. + +Module EqType. +Section EqType. + +Context {T:Type} {ceqT : eqTypeC T}. +HB.instance Definition _ := hasDecEq.Build T ceqP. +Definition ceqT_eqType : eqType := T. + +End EqType. +End EqType. +Definition ceqT_eqType {T} {ceqT} := @EqType.ceqT_eqType T ceqT. + +Notation "x == y ::> T" := (@eq_op (@ceqT_eqType T _) x y) + (at level 70, y at next level) : bool_scope. + +Notation "x == y ::>" := (@eq_op (@ceqT_eqType _ _) x y) + (at level 70, y at next level) : bool_scope. + +Class finTypeC (T:Type) := + { _eqC : eqTypeC T + ; cenum : seq T + ; cenumP : @Finite.axiom ceqT_eqType cenum + }. + +#[global] +Existing Instance _eqC. + +Module FinType. +Section FinType. + +Context `{cfinT:finTypeC}. + +HB.instance Definition _ := Equality.copy T ceqT_eqType. +HB.instance Definition _ : isCountable T := + PCanIsCountable (FinIsCount.pickleK cenumP). +HB.instance Definition _ := isFinite.Build T cenumP. +Definition cfinT_finType : finType := T. + +Lemma mem_cenum : cenum =i ceqT_eqType. +Proof. + move=> x. rewrite -has_pred1 has_count. by rewrite cenumP. +Qed. + +End FinType. +End FinType. +Definition cfinT_finType {T} {cfinT} := @FinType.cfinT_finType T cfinT. +Definition mem_cenum {T} {cfinT} := @FinType.mem_cenum T cfinT. + +Module FinMap. + +Section Section. + +Context `{cfinT:finTypeC} (U:Type). + +(* Map from T -> U *) + +Definition map := @finfun_of cfinT_finType (fun _ => U) (Phant _). + +Definition of_fun := + @finfun.finfun cfinT_finType (fun _ => U). + +Definition set (m:map) (x: T) (y:U) : map := + of_fun (fun z : T => if z == x ::> then y else m z). + +End Section. + +End FinMap. + +(* -------------------------------------------------------------------- *) +Lemma reflect_inj (T:eqType) (U:Type) (f:T -> U) a b : + injective f -> reflect (a = b) (a == b) -> reflect (f a = f b) (a == b). +Proof. by move=> hinj heq; apply: (iffP heq) => [| /hinj ] ->. Qed. + +(* -------------------------------------------------------------------- *) +(* Missing Instance in ssreflect for setoid rewrite *) + +#[global] +Instance and3_impl_morphism : + Proper (Basics.impl ==> Basics.impl ==> Basics.impl ==> Basics.impl) and3 | 1. +Proof. by move=> ?? h1 ?? h2 ?? h3 [/h1 ? /h2 ? /h3 ?]. Qed. + +#[global] +Instance and3_iff_morphism : + Proper (iff ==> iff ==> iff ==> iff) and3. +Proof. by move=> ?? h1 ?? h2 ?? h3; split => -[] /h1 ? /h2 ? /h3. Qed. + +(* ** Result monad + * -------------------------------------------------------------------- *) + +Variant result (E : Type) (A : Type) : Type := +| Ok of A +| Error of E. + +Arguments Error {E} {A} s. + +Definition is_ok (E A:Type) (r:result E A) := if r is Ok a then true else false. + +Lemma is_ok_ok (E A:Type) (a:A) : is_ok (Ok E a). +Proof. done. Qed. +#[global] +Hint Resolve is_ok_ok : core. + +Lemma is_okP (E A:Type) (r:result E A) : reflect (exists (a:A), r = Ok E a) (is_ok r). +Proof. + case: r => /=; constructor; first by eauto. + by move=> []. +Qed. + +Module Result. + +Definition apply eT aT rT (f : aT -> rT) (x : rT) (u : result eT aT) := + if u is Ok y then f y else x. + +Definition bind eT aT rT (f : aT -> result eT rT) g := + match g with + | Ok x => f x + | Error s => Error s + end. + +Definition map eT aT rT (f : aT -> rT) := bind (fun x => Ok eT (f x)). +Definition default eT aT := @apply eT aT aT (fun x => x). + +End Result. + +Definition o2r eT aT (e : eT) (o : option aT) := + match o with + | None => Error e + | Some x => Ok eT x + end. + +Notation rapp := Result.apply. +Notation rdflt := Result.default. +Notation rbind := Result.bind. +Notation rmap := Result.map. +Notation ok := (@Ok _). + +Notation "m >>= f" := (rbind f m) (at level 25, left associativity). +Notation "'Let' x ':=' m 'in' body" := (m >>= (fun x => body)) (x name, at level 25). +Notation "'Let:' x ':=' m 'in' body" := (m >>= (fun x => body)) (x strict pattern, at level 25). +Notation "m >> n" := (rbind (λ _, n) m) (at level 30, right associativity, n at next level). + +Lemma bindA eT aT bT cT (f : aT -> result eT bT) (g: bT -> result eT cT) m: + m >>= f >>= g = m >>= (fun a => f a >>= g). +Proof. case:m => //=. Qed. + +Lemma bind_eq eT aT rT (f1 f2 : aT -> result eT rT) m1 m2 : + m1 = m2 -> f1 =1 f2 -> m1 >>= f1 = m2 >>= f2. +Proof. move=> <- Hf; case m1 => //=. Qed. + +Definition ok_inj {E A} {a a': A} (H: Ok E a = ok a') : a = a' := + let 'Logic.eq_refl := H in Logic.eq_refl. + +Definition Error_inj {E A} (a a': E) (H: @Error E A a = Error a') : a = a' := + let 'Logic.eq_refl := H in Logic.eq_refl. + +Definition assert E (b: bool) (e: E) : result E unit := + if b then ok tt else Error e. + +Lemma assertP E b e u : + @assert E b e = ok u → b. +Proof. by case: b. Qed. + +Arguments assertP {E b e u} _. + +Variant error := + | ErrOob | ErrAddrUndef | ErrAddrInvalid | ErrStack | ErrType | ErrArith. + +Definition exec t := result error t. + +Definition type_error {t} := @Error _ t ErrType. +Definition undef_error {t} := @Error error t ErrAddrUndef. + +Lemma bindW {T U} (v : exec T) (f : T -> exec U) r : + v >>= f = ok r -> exists2 a, v = ok a & f a = ok r. +Proof. by case E: v => [a|//] /= <-; exists a. Qed. + +Lemma rbindP eT aT rT (e:result eT aT) (body:aT -> result eT rT) v (P:Type): + (forall z, e = ok z -> body z = Ok _ v -> P) -> + e >>= body = Ok _ v -> P. +Proof. by case: e=> //= a H /H H';apply H'. Qed. + +Ltac t_rbindP := do? (apply: rbindP => ??). + +Ltac t_xrbindP := + match goal with + | [ |- Result.bind _ _ = Ok _ _ -> _ ] => + apply: rbindP; t_xrbindP + | [ |- Result.map _ _ = Ok _ _ -> _ ] => + rewrite /rmap; t_xrbindP + | [ |- assert _ _ = Ok _ _ -> _ ] => + move=> /assertP; t_xrbindP + | [ |- unit -> _ ] => + case; t_xrbindP + | [ |- ok _ = ok _ -> _ ] => + case; t_xrbindP + | [ |- forall h, _ ] => + let hh := fresh h in move=> hh; t_xrbindP; move: hh + | _ => idtac + end. + +Ltac clarify := + repeat match goal with + | H : ?a = ?b |- _ => subst a || subst b + | H : ok _ = ok _ |- _ => apply ok_inj in H + | H : Some _ = Some _ |- _ => move: H => /Some_inj H + | H : ?a = _, K : ?a = _ |- _ => rewrite H in K + end. + +Lemma Let_Let {eT A B C} (a:result eT A) (b:A -> result eT B) (c: B -> result eT C) : + ((a >>= b) >>= c) = a >>= (fun a => b a >>= c). +Proof. by case: a. Qed. + +Lemma LetK {eT T} (r : result eT T) : Let x := r in ok x = r. +Proof. by case: r. Qed. + +Definition mapM eT aT bT (f : aT -> result eT bT) : seq aT → result eT (seq bT) := + fix mapM xs := + match xs with + | [::] => + Ok eT [::] + | [:: x & xs] => + f x >>= fun y => + mapM xs >>= fun ys => + Ok eT [:: y & ys] + end. + +Lemma mapM_cons aT eT bT x xs y ys (f : aT -> result eT bT): + f x = ok y /\ mapM f xs = ok ys + <-> mapM f (x :: xs) = ok (y :: ys). +Proof. + split. + by move => [] /= -> ->. + by simpl; t_xrbindP => y0 -> h0 -> -> ->. +Qed. + +Lemma map_ext aT bT f g m : + (forall a, List.In a m -> f a = g a) -> + @map aT bT f m = map g m. +Proof. +elim: m => //= a m ih ext. +rewrite ext; [ f_equal | ]; eauto. +Qed. + +Lemma mapM_ext eT aT bT (f1 f2: aT → result eT bT) (m: seq aT) : + (∀ a, List.In a m → f1 a = f2 a) → + mapM f1 m = mapM f2 m. +Proof. + elim: m => // a m ih ext /=. + rewrite (ext a); last by left. + case: (f2 _) => //= b; rewrite ih //. + by move => ? h; apply: ext; right. +Qed. + +Lemma eq_mapM eT (aT: eqType) bT (f1 f2: aT -> result eT bT) (l:list aT) : + (forall a, a \in l -> f1 a = f2 a) -> + mapM f1 l = mapM f2 l. +Proof. + elim: l => //= a l hrec hf; rewrite hf ? hrec //. + + by move=> ? h; apply/hf; rewrite in_cons h orbT. + by apply mem_head. +Qed. + +Lemma size_mapM eT aT bT f xs ys : + @mapM eT aT bT f xs = ok ys -> + size xs = size ys. +Proof. +elim: xs ys. +- by move => ys [<-]. +move => x xs ih ys /=; case: (f _) => //= y. +by case: (mapM f xs) ih => //= ys' ih [] ?; subst; rewrite (ih _ erefl). +Qed. + +Local Close Scope Z_scope. + +Lemma mapM_nth eT aT bT f xs ys d d' n : + @mapM eT aT bT f xs = ok ys -> + n < size xs -> + f (nth d xs n) = ok (nth d' ys n). +Proof. +elim: xs ys n. +- by move => ys n [<-]. +move => x xs ih ys n /=; case h: (f _) => [ y | ] //=. +case: (mapM f xs) ih => //= ys' /(_ _ _ erefl) ih [] <- {ys}. +by case: n ih => // n /(_ n). +Qed. + +Local Open Scope Z_scope. + +(* Lemma mapM_onth eT aT bT (f: aT → result eT bT) (xs: seq aT) ys n x : *) +(* mapM f xs = ok ys → *) +(* onth xs n = Some x → *) +(* ∃ y, onth ys n = Some y ∧ f x = ok y. *) +(* Proof. *) +(* move => ok_ys. *) +(* case: (leqP (size xs) n) => hsz; first by rewrite (onth_default hsz). *) +(* elim: xs ys ok_ys n hsz. *) +(* - by move => ys [<-]. *) +(* move => y xs ih ys' /=; t_xrbindP => z ok_z ys ok_ys <- [| n ] hsz /= ok_y. *) +(* - by exists z; case: ok_y => <-. *) +(* exact: (ih _ ok_ys n hsz ok_y). *) +(* Qed. *) + +(* Lemma mapM_onth' eT aT bT (f: aT → result eT bT) (xs: seq aT) ys n y : *) +(* mapM f xs = ok ys → *) +(* onth ys n = Some y → *) +(* ∃ x, onth xs n = Some x ∧ f x = ok y. *) +(* Proof. *) +(* move => ok_ys. *) +(* case: (leqP (size ys) n) => hsz; first by rewrite (onth_default hsz). *) +(* elim: xs ys ok_ys n hsz. *) +(* - by move => ys [<-]. *) +(* move => x xs ih ys' /=; t_xrbindP => z ok_z ys ok_ys <- [| n ] hsz /= ok_y. *) +(* - by exists x; case: ok_y => <-. *) +(* exact: (ih _ ok_ys n hsz ok_y). *) +(* Qed. *) + +Lemma mapMP {eT} {aT bT: eqType} (f: aT -> result eT bT) (s: seq aT) (s': seq bT) y: + mapM f s = ok s' -> + reflect (exists2 x, x \in s & f x = ok y) (y \in s'). +Proof. +elim: s s' => /= [s' [] <-|x s IHs s']; first by right; case. +apply: rbindP=> y0 Hy0. +apply: rbindP=> ys Hys []<-. +have IHs' := (IHs _ Hys). +rewrite /= in_cons eq_sym; case Hxy: (y0 == y). + by left; exists x; [rewrite mem_head | rewrite -(eqP Hxy)]. +apply: (iffP IHs')=> [[x' Hx' <-]|[x' Hx' Dy]]. + by exists x'; first by apply: predU1r. +rewrite -Dy. +case/predU1P: Hx'=> [Hx|]. ++ exfalso. + move: Hxy=> /negP Hxy. + apply: Hxy. + rewrite Hx Hy0 in Dy. + by move: Dy=> [] ->. ++ by exists x'. +Qed. + +Lemma mapM_In {aT bT eT} (f: aT -> result eT bT) (s: seq aT) (s': seq bT) x: + mapM f s = ok s' -> + List.In x s -> exists y, List.In y s' /\ f x = ok y. +Proof. +elim: s s'=> // a l /= IH s'. +apply: rbindP=> y Hy. +apply: rbindP=> ys Hys []<-. +case. ++ by move=> <-; exists y; split=> //; left. ++ move=> Hl; move: (IH _ Hys Hl)=> [y0 [Hy0 Hy0']]. + by exists y0; split=> //; right. +Qed. + +Lemma mapM_In' {aT bT eT} (f: aT -> result eT bT) (s: seq aT) (s': seq bT) y: + mapM f s = ok s' -> + List.In y s' -> exists2 x, List.In x s & f x = ok y. +Proof. +elim: s s'. ++ by move => _ [<-]. +move => a s ih s'' /=; t_xrbindP => b ok_b s' rec <- {s''} /=. +case. ++ by move=> <-; exists a => //; left. +by move => h; case: (ih _ rec h) => x hx ok_y; eauto. +Qed. + +Lemma mapM_map {aT bT cT eT} (f: aT → bT) (g: bT → result eT cT) (xs: seq aT) : + mapM g (map f xs) = mapM (g \o f) xs. +Proof. by elim: xs => // x xs ih /=; case: (g (f x)) => // y /=; rewrite ih. Qed. + +Lemma mapM_cat {eT aT bT} (f: aT → result eT bT) (s1 s2: seq aT) : + mapM f (s1 ++ s2) = Let r1 := mapM f s1 in Let r2 := mapM f s2 in ok (r1 ++ r2). +Proof. + elim: s1 s2; first by move => s /=; case (mapM f s). + move => a s1 ih s2 /=. + case: (f _) => // b; rewrite /= ih{ih}. + case: (mapM f s1) => // bs /=. + by case: (mapM f s2). +Qed. + +Corollary mapM_rcons {eT aT bT} (f: aT → result eT bT) (s: seq aT) (a: aT) : + mapM f (rcons s a) = Let r1 := mapM f s in Let r2 := f a in ok (rcons r1 r2). +Proof. by rewrite -cats1 mapM_cat /=; case: (f a) => // b; case: (mapM _ _) => // bs; rewrite /= cats1. Qed. + +Lemma mapM_Forall2 {eT aT bT} (f: aT → result eT bT) (s: seq aT) (s': seq bT) : + mapM f s = ok s' → + List.Forall2 (λ a b, f a = ok b) s s'. +Proof. + elim: s s'. + - by move => _ [] <-; constructor. + move => a s ih s'' /=; t_xrbindP => b ok_b s' /ih{ih}ih <-{s''}. + by constructor. +Qed. + +Lemma mapM_factorization {aT bT cT eT fT} (f: aT → result fT bT) (g: aT → result eT cT) (h: bT → result eT cT) xs ys: + (∀ a b, f a = ok b → g a = h b) → + mapM f xs = ok ys → + mapM g xs = mapM h ys. +Proof. + move => E. + elim: xs ys; first by case. + by move => x xs ih ys' /=; t_xrbindP => y /E -> ys /ih -> <-. +Qed. + +(* Lemma mapM_assoc {eT} {aT:eqType} {bT cT} (f : aT * bT -> result eT (aT * cT)) l1 l2 a b : *) +(* (forall x y, f x = ok y -> x.1 = y.1) -> *) +(* mapM f l1 = ok l2 -> *) +(* assoc l1 a = Some b -> *) +(* exists2 c, f (a, b) = ok (a, c) & assoc l2 a = Some c. *) +(* Proof. *) +(* move=> hfst. *) +(* elim: l1 l2 => //. *) +(* move=> [a' b'] l1 ih /=. *) +(* t_xrbindP=> _ [a'' c] h l2 /ih{ih}ih <- /=. *) +(* have /= ? := hfst _ _ h; subst a''. *) +(* case: eqP => [->|_]; last by apply ih. *) +(* move=> [<-]. *) +(* by exists c. *) +(* Qed. *) + +(* Lemma mapM_assoc' {eT} {aT:eqType} {bT cT} (f : aT * bT -> result eT (aT * cT)) l1 l2 a c : *) +(* (forall x y, f x = ok y -> x.1 = y.1) -> *) +(* mapM f l1 = ok l2 -> *) +(* assoc l2 a = Some c -> *) +(* exists2 b, f (a, b) = ok (a, c) & assoc l1 a = Some b. *) +(* Proof. *) +(* move=> hfst. *) +(* elim: l2 l1 => //. *) +(* move=> [a' c'] l2 ih [//|[a'' b] l1] /=. *) +(* t_xrbindP=> y h l2' hmap ??; subst y l2'. *) +(* have /= ? := hfst _ _ h; subst a''. *) +(* case: eqP => [->|_]; last by apply ih. *) +(* move=> [<-]. *) +(* by exists b. *) +(* Qed. *) + +(* Lemma mapM_take eT aT bT (f: aT → result eT bT) (xs: seq aT) ys n : *) +(* mapM f xs = ok ys → *) +(* mapM f (take n xs) = ok (take n ys). *) +(* Proof. *) +(* elim: xs ys n => [ | x xs hrec] ys n /=; first by move => /ok_inj<-. *) +(* t_xrbindP => y hy ys' /hrec h ?; subst ys; case: n; first by rewrite take0. *) +(* by move => n; rewrite /= (h n) /= hy. *) +(* Qed. *) + +(* Lemma mapM_ok {eT} {A B:Type} (f: A -> B) (l:list A) : *) +(* mapM (eT:=eT) (fun x => ok (f x)) l = ok (map f l). *) +(* Proof. by elim l => //= ?? ->. Qed. *) + +Section FOLDM. + + Context (eT aT bT:Type) (f:aT -> bT -> result eT bT). + + Fixpoint foldM (acc : bT) (l : seq aT) := + match l with + | [::] => Ok eT acc + | [:: a & la ] => f a acc >>= fun acc => foldM acc la + end. + + Fixpoint foldrM (acc : bT) (l : seq aT) := + match l with + | [::] => Ok eT acc + | [:: a & la ] => foldrM acc la >>= f a + end. + + Lemma foldM_cat acc l1 l2 : + foldM acc (l1 ++ l2) = + Let acc1 := foldM acc l1 in + foldM acc1 l2. + Proof. by elim: l1 acc => //= x l hrec acc; case: f. Qed. + +End FOLDM. + +Section FOLD2. + + Variable A B E R:Type. + Variable e: E. + Variable f : A -> B -> R -> result E R. + + Fixpoint fold2 (la:seq A) (lb: seq B) r := + match la, lb with + | [::] , [::] => Ok E r + | a::la, b::lb => + f a b r >>= (fold2 la lb) + | _ , _ => Error e + end. + + Lemma size_fold2 xs ys x0 v: + fold2 xs ys x0 = ok v -> size xs = size ys. + Proof. + by elim : xs ys x0 => [|x xs ih] [|y ys] x0 //= ; t_xrbindP => // t _ /ih ->. + Qed. + + Lemma cat_fold2 ha ta hb tb x v v' : + fold2 ha hb x = ok v -> fold2 ta tb v = ok v' -> + fold2 (ha ++ ta) (hb ++ tb) x = ok v'. + Proof. + elim: ha hb x v => [[] // > [<-] | > hrec []] //= >. + by t_xrbindP => ? -> /hrec{hrec}h/h{h}. + Qed. + +End FOLD2. + +(* ---------------------------------------------------------------- *) +(* ALLM *) +Section ALLM. + Context (A E: Type) (check: A → result E unit) (m: seq A). + Definition allM := foldM (λ a _, check a) tt m. + + Lemma allMP a : List.In a m → allM = ok tt → check a = ok tt. + Proof. + rewrite /allM. + by elim: m => // a' m' ih /= [ ->{a'} | /ih ]; t_xrbindP. + Qed. + +End ALLM. +Arguments allMP {A E check m a} _ _. + +(* Forall3 *) +(* -------------------------------------------------------------- *) + +Inductive Forall3 (A B C : Type) (R : A -> B -> C -> Prop) : seq A -> seq B -> seq C -> Prop := +| Forall3_nil : Forall3 R [::] [::] [::] +| Forall3_cons : forall a b c la lb lc, R a b c -> Forall3 R la lb lc -> Forall3 R (a :: la) (b :: lb) (c :: lc). + +Section MAP2. + + Variable A B E R:Type. + Variable e: E. + + Variable f : A -> B -> result E R. + + Fixpoint mapM2 (la:seq A) (lb: seq B) := + match la, lb with + | [::] , [::] => Ok E [::] + | a::la, b::lb => + Let c := f a b in + Let lc := mapM2 la lb in + ok (c::lc) + | _ , _ => Error e + end. + + Lemma size_mapM2 ma mb mr : + mapM2 ma mb = ok mr -> + size ma = size mb /\ size ma = size mr. + Proof. + elim: ma mb mr. + + by move=> [|//] _ [<-]. + move=> a ma ih [//|b mb] /=. + t_xrbindP=> _ r hf lr /ih{ih}ih <- /=. + by Lia.lia. + Qed. + + Lemma mapM2_Forall2 (P: R → B → Prop) ma mb mr : + (∀ a b r, List.In (a, b) (zip ma mb) → f a b = ok r → P r b) → + mapM2 ma mb = ok mr → + List.Forall2 P mr mb. + Proof. + elim: ma mb mr. + + move => [] // mr _ [<-]; constructor. + move => a ma ih [] // b mb mr' h /=; t_xrbindP => r ok_r mr rec <- {mr'}. + constructor. + + by apply: (h _ _ _ _ ok_r); left. + by apply: ih => // a' b' r' h' ok_r'; apply: (h a' b' r' _ ok_r'); right. + Qed. + + Lemma mapM2_Forall3 ma mb mr : + mapM2 ma mb = ok mr -> + Forall3 (fun a b r => f a b = ok r) ma mb mr. + Proof. + elim: ma mb mr. + + by move=> [|//] [|//] _; constructor. + move=> a ma ih [//|b mb] /=. + t_xrbindP=> _ r h mr /ih{ih}ih <-. + by constructor. + Qed. + + Lemma cat_mapM2 ha ta hb tb hl tl : + mapM2 ha hb = ok hl -> mapM2 ta tb = ok tl -> + mapM2 (ha ++ ta) (hb ++ tb) = ok (hl ++ tl). + Proof. + elim: ha hb hl => [[]//?[<-]|> hrec []] //=. + by t_xrbindP=> > -> ? /hrec{hrec}hrec <- /hrec{hrec} ->. + Qed. + +End MAP2. + +Section FMAP. + + Context (A B C:Type) (f : A -> B -> A * C). + + Fixpoint fmap (a:A) (bs:seq B) : A * seq C := + match bs with + | [::] => (a, [::]) + | b::bs => + let (a, c) := f a b in + let (a, cs) := fmap a bs in + (a, c :: cs) + end. + +End FMAP. + +Definition fmapM {eT aT bT cT} (f : aT -> bT -> result eT (aT * cT)) : aT -> seq bT -> result eT (aT * seq cT) := + fix mapM a xs := + match xs with + | [::] => Ok eT (a, [::]) + | [:: x & xs] => + Let y := f a x in + Let ys := mapM y.1 xs in + Ok eT (ys.1, y.2 :: ys.2) + end. + +Definition fmapM2 {eT aT bT cT dT} (e:eT) (f : aT -> bT -> cT -> result eT (aT * dT)) : + aT -> seq bT -> seq cT -> result eT (aT * seq dT) := + fix mapM a lb lc := + match lb, lc with + | [::], [::] => Ok eT (a, [::]) + | [:: b & bs], [:: c & cs] => + Let y := f a b c in + Let ys := mapM y.1 bs cs in + Ok eT (ys.1, y.2 :: ys.2) + | _, _ => Error e + end. + +Lemma size_fmapM2 {eT aT bT cT dT} e (f : aT -> bT -> cT -> result eT (aT * dT)) a lb lc a2 ld : + fmapM2 e f a lb lc = ok (a2, ld) -> + size lb = size lc /\ size lb = size ld. +Proof. + elim: lb lc a a2 ld. + + by move=> [|//] _ _ _ [_ <-]. + move=> b lb ih [//|c lc] a /=. + t_xrbindP=> _ _ _ _ [_ ld] /ih{ih}ih _ <- /=. + by Lia.lia. +Qed. + +(* Forall and size *) +(* -------------------------------------------------------------- *) + +Lemma Forall2_size A B (R : A -> B -> Prop) la lb : + List.Forall2 R la lb -> size la = size lb. +Proof. by elim {la lb} => // a b la lb _ _ /= ->. Qed. + +Lemma Forall3_size A B C (R : A -> B -> C -> Prop) l1 l2 l3 : + Forall3 R l1 l2 l3 -> + size l1 = size l2 /\ size l1 = size l3. +Proof. by elim {l1 l2 l3} => // a b c l1 l2 l3 _ _ /= [<- <-]. Qed. + +(* Reasoning with Forall *) +(* -------------------------------------------------------------- *) + +Lemma Forall_nth A (R : A -> Prop) l : + List.Forall R l -> + forall d i, (i < size l)%nat -> R (nth d l i). +Proof. + elim {l} => // a l h _ ih d [//|i]. + by apply ih. +Qed. + +Lemma Forall2_nth A B (R : A -> B -> Prop) la lb : + List.Forall2 R la lb -> + forall a b i, (i < size la)%nat -> + R (nth a la i) (nth b lb i). +Proof. + elim {la lb} => // a b la lb h _ ih a0 b0 [//|i]. + by apply ih. +Qed. + +Lemma Forall2_forall A B (R : A -> B -> Prop) la lb : + List.Forall2 R la lb -> + forall a b, List.In (a, b) (zip la lb) -> + R a b. +Proof. + elim {la lb} => // a b la lb h _ ih a0 b0 /=. + case. + + by move=> [<- <-]. + by apply ih. +Qed. + +Lemma Forall2_impl A B (R1 R2 : A -> B -> Prop) : + (forall a b, R1 a b -> R2 a b) -> + forall la lb, + List.Forall2 R1 la lb -> + List.Forall2 R2 la lb. +Proof. by move=> himpl l1 l2; elim; eauto. Qed. + +Lemma Forall2_impl_in A B (R1 R2 : A -> B -> Prop) la lb : + (forall a b, List.In a la -> List.In b lb -> R1 a b -> R2 a b) -> + List.Forall2 R1 la lb -> + List.Forall2 R2 la lb. +Proof. + move=> himpl hforall. + elim: {la lb} hforall himpl. + + by constructor. + move=> a b la lb h _ ih himpl. + constructor. + + by apply himpl; [left; reflexivity..|]. + apply ih. + by move=> ?????; apply himpl; [right..|]. +Qed. + +Lemma Forall3_nth A B C (R : A -> B -> C -> Prop) la lb lc : + Forall3 R la lb lc -> + forall a b c i, + (i < size la)%nat -> + R (nth a la i) (nth b lb i) (nth c lc i). +Proof. + elim {la lb lc} => // a b c la lb lc hr _ ih a0 b0 c0 [//|i]. + by apply ih. +Qed. + +Lemma nth_Forall3 A B C (R : A -> B -> C -> Prop) la lb lc a b c: + size la = size lb -> size la = size lc -> + (forall i, (i < size la)%nat -> R (nth a la i) (nth b lb i) (nth c lc i)) -> + Forall3 R la lb lc. +Proof. + elim: la lb lc. + + by move=> [|//] [|//] _ _ _; constructor. + move=> a0 l1 ih [//|b0 l2] [//|c0 l3] [hsize1] [hsize2] h. + constructor. + + by apply (h 0%nat). + apply ih => //. + by move=> i; apply (h i.+1). +Qed. +Arguments nth_Forall3 [A B C R la lb lc]. + +Lemma Forall3_forall A B C (R : A -> B -> C -> Prop) la lb lc : + Forall3 R la lb lc -> + forall a b c, List.In (a, (b, c)) (zip la (zip lb lc)) -> R a b c. +Proof. + elim {la lb lc} => // a b c la lb lc h _ ih a0 b0 c0 /=. + case. + + by move=> [<- <- <-]. + by apply ih. +Qed. + +Lemma Forall3_impl A B C (R1 R2 : A -> B -> C -> Prop) : + (forall a b c, R1 a b c -> R2 a b c) -> + forall la lb lc, + Forall3 R1 la lb lc -> + Forall3 R2 la lb lc. +Proof. by move=> himpl l1 l2 l3; elim; eauto using Forall3. Qed. + +Lemma Forall3_impl_in A B C (R1 R2 : A -> B -> C -> Prop) la lb lc : + (forall a b c, List.In a la -> List.In b lb -> List.In c lc -> R1 a b c -> R2 a b c) -> + Forall3 R1 la lb lc -> + Forall3 R2 la lb lc. +Proof. + move=> himpl hforall. + elim: {la lb lc} hforall himpl. + + by constructor. + move=> a b c la lb lc h _ ih himpl. + constructor. + + by apply himpl; [left; reflexivity..|]. + apply ih. + by move=> ???????; apply himpl; [right..|]. +Qed. + +(* Inversion lemmas *) +(* -------------------------------------------------------------- *) +Lemma seq_eq_injL A (m n: seq A) (h: m = n) : + match m with + | [::] => if n is [::] then True else False + | a :: m' => if n is b :: n' then a = b ∧ m' = n' else False + end. +Proof. by subst n; case: m. Qed. + +Lemma List_Forall_inv A (P: A → Prop) m : + List.Forall P m → + match m with [::] => True | x :: m' => P x ∧ List.Forall P m' end. +Proof. by case. Qed. + +Lemma List_Forall2_refl A (R:A->A->Prop) l : (forall a, R a a) -> List.Forall2 R l l. +Proof. by move=> HR;elim: l => // a l Hrec;constructor. Qed. + +Lemma List_Forall2_inv_l A B (R: A → B → Prop) m n : + List.Forall2 R m n → + match m with + | [::] => n = [::] + | a :: m' => ∃ b n', n = b :: n' ∧ R a b ∧ List.Forall2 R m' n' + end. +Proof. case; eauto. Qed. + +Lemma List_Forall2_inv_r A B (R: A → B → Prop) m n : + List.Forall2 R m n → + match n with + | [::] => m = [::] + | b :: n' => ∃ a m', m = a :: m' ∧ R a b ∧ List.Forall2 R m' n' + end. +Proof. case; eauto. Qed. + +Lemma List_Forall2_inv A B (R: A → B → Prop) m n : + List.Forall2 R m n → + if m is a :: m' then if n is b :: n' then R a b ∧ List.Forall2 R m' n' else False else if n is [::] then True else False. +Proof. case; auto. Qed. + +Lemma List_Forall3_inv A B C (R : A -> B -> C -> Prop) l1 l2 l3 : + Forall3 R l1 l2 l3 -> + match l1, l2, l3 with + | [::], [::], [::] => True + | a :: l1, b :: l2, c :: l3 => R a b c /\ Forall3 R l1 l2 l3 + | _, _, _ => False + end. +Proof. by case. Qed. + +Section Subseq. + + Context (T : eqType). + Context (p : T -> bool). + + Lemma subseq_has s1 s2 : subseq s1 s2 -> has p s1 -> has p s2. + Proof. + move=> /mem_subseq hsub /hasP [x /hsub hin hp]. + apply /hasP. + by exists x. + Qed. + + Lemma subseq_all s1 s2 : subseq s1 s2 -> all p s2 -> all p s1. + Proof. + move=> /mem_subseq hsub /allP hall. + by apply /allP => x /hsub /hall. + Qed. + +End Subseq. + +Section All2. + +Section DifferentTypes. + + Context (S T : Type). + Context (p : S -> T -> bool). + + Lemma all2P l1 l2 : reflect (List.Forall2 p l1 l2) (all2 p l1 l2). + Proof. + elim: l1 l2 => [ | a l1 hrec] [ | b l2] /=;try constructor. + + by constructor. + + by move/List_Forall2_inv_l. + + by move/List_Forall2_inv_r. + apply: equivP;first apply /andP. + split => [[]h1 /hrec h2 |];first by constructor. + by case/List_Forall2_inv_l => b' [n] [] [-> ->] [->] /hrec. + Qed. + + Section Ind. + + Context (P : list S -> list T -> Prop). + + Lemma list_all2_ind : + P [::] [::] -> + (forall x1 l1 x2 l2, p x1 x2 -> all2 p l1 l2 -> P l1 l2 -> P (x1::l1) (x2::l2)) -> + forall l1 l2, all2 p l1 l2 -> P l1 l2. + Proof. + move=> hnil hcons; elim => /=; first by case. + move=> x1 l1 ih [//|x2 l2] /andP [hf hall2]. + by apply hcons => //; apply ih. + Qed. + + End Ind. + + Lemma all2_nth s t n ss ts : + (n < size ss)%nat || (n < size ts)%nat -> + all2 p ss ts -> + p (nth s ss n) (nth t ts n). + Proof. + move=> hn; rewrite all2E => /andP [] /eqP hsz. + move: hn; rewrite -hsz orbb => hn. + move=> /(all_nthP (s, t)) -/(_ n). + by rewrite size_zip -hsz minnn nth_zip //; apply. + Qed. + +End DifferentTypes. + +Section SameType. + + Context (T : Type). + + Section AnyRelation. + + Context (p : rel T). + + Lemma all2_refl : ssrbool.reflexive p -> ssrbool.reflexive (all2 p). + Proof. + move=> hrefl. + by elim=> //= a l ih; apply /andP. + Qed. + + Lemma all2_trans : ssrbool.transitive p -> ssrbool.transitive (all2 p). + Proof. + move=> htrans s1 s2 s3 hall2; move: hall2 s3. + elim/list_all2_ind {s1 s2} => //= x1 s1 x2 s2 hp12 _ ih [//|x3 s3] /andP [hp23 hall2]. + by apply /andP; eauto. + Qed. + + End AnyRelation. + + Section Eqb. + + Variable eqb: T -> T -> bool. + Variable Heq : forall (x y:T), reflect (x = y) (eqb x y). + + Lemma reflect_all2_eqb l1 l2 : reflect (l1 = l2) (all2 eqb l1 l2). + Proof. + elim: l1 l2 => [|e1 l1 Hrec1] [|e2 l2] /=; try by constructor. + by apply (iffP andP) => -[] /Heq -> /Hrec1 ->. + Defined. + + End Eqb. + +End SameType. + +End All2. + +Section Map2. + + Context (A B C : Type) (f : A -> B -> C). + + Fixpoint map2 la lb := + match la, lb with + | a::la, b::lb => f a b :: map2 la lb + | _, _ => [::] + end. + + Lemma map2E ma mb : + map2 ma mb = map (λ ab, f ab.1 ab.2) (zip ma mb). + Proof. + elim: ma mb; first by case. + by move => a ma ih [] // b mb /=; f_equal. + Qed. + +End Map2. + +Section Map3. + + Context (A B C D : Type) (f : A -> B -> C -> D). + + Fixpoint map3 ma mb mc := + match ma, mb, mc with + | a :: ma', b :: mb', c :: mc' => f a b c :: map3 ma' mb' mc' + | _, _, _ => [::] + end. + + Lemma map3E ma mb mc : + map3 ma mb mc = map2 (λ ab, f ab.1 ab.2) (zip ma mb) mc. + Proof. + elim: ma mb mc; first by case. + by move => a ma ih [] // b mb [] // c mc /=; f_equal. + Qed. + +End Map3. + +Section MAPI. + + Context (A : Type) (a : A) (B:Type) (b : B) (f : nat -> A -> B). + + Fixpoint mapi_aux k l := + match l with + | [::] => [::] + | a::l=> f k a :: mapi_aux k.+1 l + end. + + Definition mapi := mapi_aux 0. + + Lemma size_mapi_aux k l : size (mapi_aux k l) = size l. + Proof. + elim: l k => //= a' l ih k. + by rewrite ih. + Qed. + + Lemma size_mapi l : size (mapi l) = size l. + Proof. exact: size_mapi_aux. Qed. + + Lemma nth_mapi_aux n k l : + (n < size l)%nat -> nth b (mapi_aux k l) n = f (k+n) (nth a l n). + Proof. + elim: l n k => //= a' l ih n k hlt. + case: n hlt => /=. + + by move=> _; rewrite addn0. + by move=> n hlt; rewrite ih // addSnnS. + Qed. + + Lemma nth_mapi n l : + (n < size l)%nat -> nth b (mapi l) n = f n (nth a l n). + Proof. exact: nth_mapi_aux. Qed. + +End MAPI. + +Section FIND_MAP. + +(* The name comes from OCaml. *) +Fixpoint find_map {A B: Type} (f: A → option B) l := + match l with + | [::] => None + | a::l => + let fa := f a in + if fa is None then find_map f l else fa + end. + +Lemma find_map_correct {A: eqType} {B: Type} {f: A → option B} {l b} : + find_map f l = Some b -> exists2 a, a \in l & f a = Some b. +Proof. + elim: l => //= a l ih. + case heq: (f a) => [b'|]. + + by move=> [<-]; exists a => //; rewrite mem_head. + move=> /ih [a' h1 h2]; exists a'=> //. + by rewrite in_cons; apply /orP; right. +Qed. + +End FIND_MAP. + +(* ** Misc functions + * -------------------------------------------------------------------- *) + +Definition isSome aT (o : option aT) := + if o is Some _ then true else false. + +(* Lemma isSome_obind (aT bT: Type) (f: aT → option bT) (o: option aT) : *) +(* reflect (exists2 a, o = Some a & isSome (f a)) (isSome (o >>= f)%O). *) +(* Proof. *) +(* apply: Bool.iff_reflect; split. *) +(* - by case => a ->. *) +(* by case: o => // a h; exists a. *) +(* Qed. *) + +Definition omap_dflt {aT bT} (d : bT) (f : aT -> bT) (oa : option aT) := + if oa is Some x then f x else d. + +Fixpoint list_to_rev (ub : nat) := + match ub with + | O => [::] + | x.+1 => [:: x & list_to_rev x ] + end. + +Definition list_to ub := rev (list_to_rev ub). + +Lemma Forall2_trans (A B C:Type) l2 (R1:A->B->Prop) (R2:B->C->Prop) + l1 l3 (R3:A->C->Prop) : + (forall b a c, R1 a b -> R2 b c -> R3 a c) -> + List.Forall2 R1 l1 l2 -> + List.Forall2 R2 l2 l3 -> + List.Forall2 R3 l1 l3. +Proof. + move=> H hr1;elim: hr1 l3 => {l1 l2} [ | a b l1 l2 hr1 _ hrec] l3 /List_Forall2_inv_l. + + by move => ->. + by case => ? [?] [->] [??]; constructor; eauto. +Qed. + +Definition conc_map aT bT (f : aT -> seq bT) (l : seq aT) := + flatten (map f l). + +(* -------------------------------------------------------------------------- *) +(* Operators to build comparison *) +(* ---------------------------------------------------------------------------*) + +Section CTRANS. + + Definition ctrans c1 c2 := nosimpl ( + match c1, c2 with + | Eq, _ => Some c2 + | _ , Eq => Some c1 + | Lt, Lt => Some Lt + | Gt, Gt => Some Gt + | _ , _ => None + end). + + Lemma ctransI c : ctrans c c = Some c. + Proof. by case: c. Qed. + + Lemma ctransC c1 c2 : ctrans c1 c2 = ctrans c2 c1. + Proof. by case: c1 c2 => -[]. Qed. + + Lemma ctrans_Eq c1 c2 : ctrans Eq c1 = Some c2 <-> c1 = c2. + Proof. by rewrite /ctrans;case:c1=> //=;split=>[[]|->]. Qed. + + Lemma ctrans_Lt c1 c2 : ctrans Lt c1 = Some c2 -> Lt = c2. + Proof. by rewrite /ctrans;case:c1=> //= -[] <-. Qed. + + Lemma ctrans_Gt c1 c2 : ctrans Gt c1 = Some c2 -> Gt = c2. + Proof. by rewrite /ctrans;case:c1=> //= -[] <-. Qed. + +End CTRANS. + +Notation Lex u v := + match u with + | Lt => Lt + | Eq => v + | Gt => Gt + end. + +(* -------------------------------------------------------------------- *) + +Scheme Equality for comparison. + +Lemma comparison_beqP : Equality.axiom comparison_beq. +Proof. + exact: + (eq_axiom_of_scheme internal_comparison_dec_bl internal_comparison_dec_lb). +Qed. + +HB.instance Definition _ := hasDecEq.Build comparison comparison_beqP. + +(* -------------------------------------------------------------------- *) + +Class Cmp {T:Type} (cmp:T -> T -> comparison) := { + cmp_sym : forall x y, cmp x y = CompOpp (cmp y x); + cmp_ctrans : forall y x z c, ctrans (cmp x y) (cmp y z) = Some c -> cmp x z = c; + cmp_eq : forall {x y}, cmp x y = Eq -> x = y; + }. + +Definition gcmp {T:Type} {cmp:T -> T -> comparison} {C:Cmp cmp} := cmp. + +Section CMP. + + Context {T:Type} {cmp:T -> T -> comparison} {C:Cmp cmp}. + + Lemma cmp_trans y x z c: + cmp x y = c -> cmp y z = c -> cmp x z = c. + Proof. + by move=> H1 H2;apply (@cmp_ctrans _ _ C y);rewrite H1 H2 ctransI. + Qed. + + Lemma cmp_refl x : cmp x x = Eq. + Proof. by have := @cmp_sym _ _ C x x;case: (cmp x x). Qed. + + Definition cmp_lt x1 x2 := gcmp x1 x2 == Lt. + + Definition cmp_le x1 x2 := gcmp x2 x1 != Lt. + + Lemma cmp_le_refl x : cmp_le x x. + Proof. by rewrite /cmp_le /gcmp cmp_refl. Qed. + + Lemma cmp_lt_trans y x z : cmp_lt x y -> cmp_lt y z -> cmp_lt x z. + Proof. + rewrite /cmp_lt /gcmp => /eqP h1 /eqP h2;apply /eqP;apply (@cmp_ctrans _ _ C y). + by rewrite h1 h2. + Qed. + + Lemma cmp_le_trans y x z : cmp_le x y -> cmp_le y z -> cmp_le x z. + Proof. + rewrite /cmp_le /gcmp => h1 h2;have := (@cmp_ctrans _ _ C y z x). + by case: cmp h1 => // _;case: cmp h2 => //= _;rewrite /ctrans => /(_ _ erefl) ->. + Qed. + + Lemma cmp_nle_lt x y: ~~ (cmp_le x y) = cmp_lt y x. + Proof. by rewrite /cmp_le /cmp_lt /gcmp Bool.negb_involutive. Qed. + + Lemma cmp_nlt_le x y: ~~ (cmp_lt x y) = cmp_le y x. + Proof. done. Qed. + + Lemma cmp_lt_le_trans y x z: cmp_lt x y -> cmp_le y z -> cmp_lt x z. + Proof. + rewrite /cmp_le /cmp_lt /gcmp (cmp_sym z) => h1 h2. + have := (@cmp_ctrans _ _ C y x z). + by case: cmp h1 => // _;case: cmp h2 => //= _;rewrite /ctrans => /(_ _ erefl) ->. + Qed. + + Lemma cmp_le_lt_trans y x z: cmp_le x y -> cmp_lt y z -> cmp_lt x z. + Proof. + rewrite /cmp_le /cmp_lt /gcmp (cmp_sym y) => h1 h2. + have := (@cmp_ctrans _ _ C y x z). + by case: cmp h1 => // _;case: cmp h2 => //= _;rewrite /ctrans => /(_ _ erefl) ->. + Qed. + + Lemma cmp_lt_le x y : cmp_lt x y -> cmp_le x y. + Proof. + rewrite /cmp_lt /cmp_le /gcmp => /eqP h. + by rewrite cmp_sym h. + Qed. + + Lemma cmp_nle_le x y : ~~ (cmp_le x y) -> cmp_le y x. + Proof. by rewrite cmp_nle_lt; apply: cmp_lt_le. Qed. + +End CMP. + +Declare Scope cmp_scope. +Notation "m < n" := (cmp_lt m n) : cmp_scope. +Notation "m <= n" := (cmp_le m n) : cmp_scope. +Notation "m ≤ n" := (cmp_le m n) : cmp_scope. +Delimit Scope cmp_scope with CMP. + +#[global] +Hint Resolve cmp_le_refl : core. + +Section EqCMP. + + Context {T:eqType} {cmp:T -> T -> comparison} {C:Cmp cmp}. + + Lemma cmp_le_eq_lt (s1 s2:T): cmp_le s1 s2 = cmp_lt s1 s2 || (s1 == s2). + Proof. + rewrite /cmp_le /cmp_lt cmp_sym /gcmp. + case heq: cmp => //=. + + by rewrite (cmp_eq heq) eqxx. + case: eqP => // ?;subst. + by rewrite cmp_refl in heq. + Qed. + + Lemma cmp_le_antisym x y : + cmp_le x y → cmp_le y x → x = y. + Proof. + by rewrite -cmp_nlt_le (cmp_le_eq_lt y) => /negbTE -> /eqP. + Qed. + +End EqCMP. + +Section LEX. + + Variables (T1 T2:Type) (cmp1:T1 -> T1 -> comparison) (cmp2:T2 -> T2 -> comparison). + + Definition lex x y := Lex (cmp1 x.1 y.1) (cmp2 x.2 y.2). + + Lemma Lex_lex x1 x2 y1 y2 : Lex (cmp1 x1 y1) (cmp2 x2 y2) = lex (x1,x2) (y1,y2). + Proof. done. Qed. + + Lemma lex_sym x y : + cmp1 x.1 y.1 = CompOpp (cmp1 y.1 x.1) -> + cmp2 x.2 y.2 = CompOpp (cmp2 y.2 x.2) -> + lex x y = CompOpp (lex y x). + Proof. + by move=> H1 H2;rewrite /lex H1;case: cmp1=> //=;apply H2. + Qed. + + Lemma lex_trans y x z: + (forall c, ctrans (cmp1 x.1 y.1) (cmp1 y.1 z.1) = Some c -> cmp1 x.1 z.1 = c) -> + (forall c, ctrans (cmp2 x.2 y.2) (cmp2 y.2 z.2) = Some c -> cmp2 x.2 z.2 = c) -> + forall c, ctrans (lex x y) (lex y z) = Some c -> lex x z = c. + Proof. + rewrite /lex=> Hr1 Hr2 c;case: cmp1 Hr1. + + move=> H;rewrite (H (cmp1 y.1 z.1));last by rewrite ctrans_Eq. + (case: cmp1;first by apply Hr2); + rewrite ctransC; [apply ctrans_Lt | apply ctrans_Gt]. + + move=> H1 H2;rewrite (H1 Lt);move:H2;first by apply: ctrans_Lt. + by case: cmp1. + move=> H1 H2;rewrite (H1 Gt);move:H2;first by apply: ctrans_Gt. + by case: cmp1. + Qed. + + Lemma lex_eq x y : + lex x y = Eq -> cmp1 x.1 y.1 = Eq /\ cmp2 x.2 y.2 = Eq. + Proof. + case: x y => [x1 x2] [y1 y2] /=. + by rewrite /lex;case:cmp1 => //;case:cmp2. + Qed. + + Lemma LexO (C1:Cmp cmp1) (C2:Cmp cmp2) : Cmp lex. + Proof. + constructor=> [x y | y x z | x y]. + + by apply /lex_sym;apply /cmp_sym. + + by apply /lex_trans;apply /cmp_ctrans. + by case: x y => ?? [??] /lex_eq /= [] /(@cmp_eq _ _ C1) -> /(@cmp_eq _ _ C2) ->. + Qed. + +End LEX. + +Section MIN. + Context T (cmp: T → T → comparison) (O: Cmp cmp). + Definition cmp_min (x y: T) : T := + if (x ≤ y)%CMP then x else y. + + Lemma cmp_minP x y (P: T → Prop) : + ((x ≤ y)%CMP → P x) → + ((y < x)%CMP → P y) → + P (cmp_min x y). + Proof. + rewrite /cmp_min; case: ifP. + - by move => _ /(_ erefl). + by rewrite -cmp_nle_lt => -> _ /(_ erefl). + Qed. + + Lemma cmp_min_leL x y : + (cmp_min x y ≤ x)%CMP. + Proof. + apply: (@cmp_minP x y (λ z, z ≤ x)%CMP) => //. + apply: cmp_lt_le. + Qed. + + Lemma cmp_min_leR x y : + (cmp_min x y ≤ y)%CMP. + Proof. exact: (@cmp_minP x y (λ z, z ≤ y)%CMP). Qed. + + Lemma cmp_le_min x y : + (x ≤ y)%CMP → cmp_min x y = x. + Proof. by rewrite /cmp_min => ->. Qed. + +End MIN. + +Arguments cmp_min {T cmp O} x y. + +Section MAX. + Context T (cmp: T → T → comparison) (O: Cmp cmp). + Definition cmp_max (x y: T) : T := + if (x ≤ y)%CMP then y else x. + + Lemma cmp_maxP x y (P: T → Prop) : + ((x ≤ y)%CMP → P y) → + ((y < x)%CMP → P x) → + P (cmp_max x y). + Proof. + rewrite /cmp_max; case: ifP. + - by move => _ /(_ erefl). + by rewrite -cmp_nle_lt => -> _ /(_ erefl). + Qed. + + Lemma cmp_max_geL x y : + (x <= cmp_max x y)%CMP. + Proof. exact: (@cmp_maxP x y (λ z, x ≤ z)%CMP). Qed. + + Lemma cmp_max_geR x y : + (y <= cmp_max x y)%CMP. + Proof. + apply: (@cmp_maxP x y (λ z, y ≤ z)%CMP) => //. + apply: cmp_lt_le. + Qed. + + Lemma cmp_le_max x y : + (x ≤ y)%CMP → cmp_max x y = y. + Proof. by rewrite /cmp_max => ->. Qed. + +End MAX. + +Arguments cmp_max {T cmp O} x y. + +Definition bool_cmp b1 b2 := + match b1, b2 with + | false, true => Lt + | false, false => Eq + | true , true => Eq + | true , false => Gt + end. + +#[global] +Instance boolO : Cmp bool_cmp. +Proof. + constructor=> [[] [] | [] [] [] c | [] []] //=; apply ctrans_Eq. +Qed. + +#[global] +Polymorphic Instance subrelation_iff_flip_arrow : subrelation iffT (flip arrow). +Proof. by move=> ?? []. Qed. + +#[global] +Instance reflect_m: Proper (iff ==> (@eq bool) ==> iffT) reflect. +Proof. by move=> P1 P2 Hiff b1 b2 ->; split=> H; apply (equivP H);rewrite Hiff. Qed. + +Coercion Zpos : positive >-> Z. + +Lemma P_leP (x y:positive) : reflect (x <= y)%Z (x <=? y)%positive. +Proof. apply: (@equivP (Pos.le x y)) => //;rewrite -Pos.leb_le;apply idP. Qed. + +Lemma P_ltP (x y:positive) : reflect (x < y)%Z (x //;rewrite -Pos.ltb_lt;apply idP. Qed. + +Lemma Pos_leb_trans y x z: + (x <=? y)%positive -> (y <=? z)%positive -> (x <=? z)%positive. +Proof. move=> /P_leP ? /P_leP ?;apply /P_leP; Lia.lia. Qed. + +Lemma Pos_lt_leb_trans y x z: + (x (y <=? z)%positive -> (x /P_ltP ? /P_leP ?;apply /P_ltP; Lia.lia. Qed. + +Lemma pos_eqP : Equality.axiom Pos.eqb. +Proof. by move=> p1 p2;apply:(iffP idP);rewrite -Pos.eqb_eq. Qed. + +HB.instance Definition _ := hasDecEq.Build positive pos_eqP. + +#[global] +Instance positiveO : Cmp Pos.compare. +Proof. + constructor. + + by move=> ??;rewrite Pos.compare_antisym. + + move=> ????;case:Pos.compare_spec=> [->|H1|H1]; + case:Pos.compare_spec=> H2 //= -[] <- //;subst; + rewrite ?Pos.compare_lt_iff ?Pos.compare_gt_iff //. + + by apply: Pos.lt_trans H1 H2. + by apply: Pos.lt_trans H2 H1. + apply Pos.compare_eq. +Qed. + +#[global] +Instance ZO : Cmp Z.compare. +Proof. + constructor. + + by move=> ??;rewrite Z.compare_antisym. + + move=> ????;case:Z.compare_spec=> [->|H1|H1]; + case:Z.compare_spec=> H2 //= -[] <- //;subst; + rewrite ?Z.compare_lt_iff ?Z.compare_gt_iff //. + + by apply: Z.lt_trans H1 H2. + by apply: Z.lt_trans H2 H1. + apply Z.compare_eq. +Qed. + +Lemma Z_to_nat_le0 z : z <= 0 -> Z.to_nat z = 0%N. +Proof. by rewrite /Z.to_nat; case: z => //=; rewrite /Z.le. Qed. + +Lemma Z_odd_pow_2 n x : + (0 < n)%Z + -> Z.odd (2 ^ n * x) = false. +Proof. + move=> hn. + rewrite Z.odd_mul. + by rewrite (Z.odd_pow _ _ hn). +Qed. + +(* ** Some Extra tactics + * -------------------------------------------------------------------- *) + +(* -------------------------------------------------------------------- *) +Variant dup_spec (P : Prop) := +| Dup of P & P. + +Lemma dup (P : Prop) : P -> dup_spec P. +Proof. by move=> ?; split. Qed. + +(* -------------------------------------------------------------------- *) +Definition ZleP : ∀ x y, reflect (x <= y) (x <=? y) := Z.leb_spec0. +Definition ZltP : ∀ x y, reflect (x < y) (x /leP /Nat2Z.inj_le. + all: by constructor. +Qed. + +Lemma ZNltP x y : + reflect (Z.of_nat x < Z.of_nat y)%Z (x < y). +Proof. + case h: (x < y). + all: move: h => /ZNleP. + all: rewrite Nat2Z.inj_succ. + all: move=> /Z.le_succ_l. + all: by constructor. +Qed. + +Lemma lt_nm_n n m : + n + m < n = false. +Proof. + rewrite -{2}(addn0 n). + rewrite ltn_add2l. + exact: ltn0. +Qed. + +Lemma sub_nmn n m : + n + m - n = m. +Proof. + elim: n => //. + by rewrite add0n subn0. +Qed. + +End NAT. + +(* ------------------------------------------------------------------------- *) + +Lemma rwR1 (A:Type) (P:A->Prop) (f:A -> bool) : + (forall a, reflect (P a) (f a)) -> + forall a, (f a) <-> (P a). +Proof. by move=> h a; rewrite (rwP (h _)). Qed. + +Lemma rwR2 (A B:Type) (P:A->B->Prop) (f:A -> B -> bool) : + (forall a b, reflect (P a b) (f a b)) -> + forall a b, (f a b) <-> (P a b). +Proof. by move=> h a b; rewrite (rwP (h _ _)). Qed. + +Notation pify := + (rwR2 (@andP), rwR2 (@orP), rwR2 (@implyP), rwR1 (@forallP _), rwR1 (@negP)). + +Lemma Zcmp_le i1 i2 : (i1 <= i2)%CMP = (i1 <=? i2)%Z. +Proof. + rewrite /cmp_le /gcmp /Z.leb -Zcompare_antisym. + by case: Z.compare. +Qed. + +Lemma Zcmp_lt i1 i2 : (i1 < i2)%CMP = (i1 // p; red; Lia.lia. Qed. + +Fixpoint ziota_rec (first z: Z) (H: Acc (Zwf 0) z) : seq Z := + let: Acc_intro REC := H in + match z as z' return (∀ x : Z, Zwf 0 x z' → @Acc Z (Zwf 0) x) -> Zwf0_pred_t z' -> seq Z with + | Zpos p => λ REC h, first :: ziota_rec (Z.succ first) (REC (Z.pred p) h) + | _ => λ _ _, [::] + end REC (Zwf0_pred z). + +Definition ziota p z : seq Z := + ziota_rec p (Acc_intro_generator 2 (Zwf_well_founded 0) z). + +Fixpoint ziota_recP p z H : + @ziota_rec p z H = [seq p + Z.of_nat i | i <- iota 0 (Z.to_nat z)]. +Proof. + case: H => REC. + rewrite /ziota_rec. + case: z REC => // z' REC. + rewrite -/(@ziota_rec (Z.succ p) (Z.pred z')). + have -> : Z.to_nat z' = (Z.to_nat (Z.pred z')).+1 by Lia.lia. + rewrite map_cons -/(iota _ _) Z.add_0_r; congr (_ :: _). + rewrite (iotaDl 1) -map_comp. + rewrite ziota_recP. + apply: eq_map => i /=. + Lia.lia. +Qed. + +Lemma ziotaE p z : + ziota p z = [seq p + Z.of_nat i | i <- iota 0 (Z.to_nat z)]. +Proof. exact: ziota_recP. Qed. + +Lemma ziota0 p : ziota p 0 = [::]. +Proof. done. Qed. + +Lemma ziota_neg p z: z <= 0 -> ziota p z = [::]. +Proof. by case: z. Qed. + +Lemma ziotaS_cons p z: 0 <= z -> ziota p (Z.succ z) = p :: ziota (p+1) z. +Proof. + rewrite !ziotaE. + move=> hz;rewrite /ziota Z2Nat.inj_succ //= Z.add_0_r; f_equal. + rewrite -addn1 addnC iotaDl -map_comp. + by apply eq_map => i /=; rewrite Zpos_P_of_succ_nat; Lia.lia. +Qed. + +Lemma ziotaS_cat p z: 0 <= z -> ziota p (Z.succ z) = ziota p z ++ [:: p + z]. +Proof. + rewrite !ziotaE. + by move=> hz;rewrite Z2Nat.inj_succ // -addn1 iotaD map_cat /= add0n Z2Nat.id. +Qed. + +Lemma ziota_cat p y z: 0 <= y -> 0 <= z -> + ziota p y ++ ziota (p + y) z = ziota p (y + z). +Proof. + move=> ? /Z2Nat.id <-; elim: (Z.to_nat _). + + by rewrite Z.add_0_r /= cats0. + move=> ? hrw; rewrite Nat2Z.inj_succ Z.add_succ_r !ziotaS_cat; last 2 first. + + exact: (Ztac.add_le _ _ _ (Zle_0_nat _)). + + exact: Zle_0_nat. + by rewrite catA hrw Z.add_assoc. +Qed. + +Lemma in_ziota (p z i:Z) : (i \in ziota p z) = ((p <=? i) && (i hz. + + move: p; pattern z; apply natlike_ind => [ p | {z hz} z hz hrec p| //]. + + by rewrite ziota0 in_nil; case: andP => // -[/ZleP ? /ZltP ?]; Lia.lia. + rewrite ziotaS_cons // in_cons; case: eqP => [-> | ?] /=. + + by rewrite Z.leb_refl /=; symmetry; apply /ZltP; Lia.lia. + by rewrite hrec; apply Bool.eq_iff_eq_true;split=> /andP [/ZleP ? /ZltP ?]; + (apply /andP;split;[apply /ZleP| apply /ZltP]); Lia.lia. + rewrite ziota_neg;last Lia.lia. + rewrite in_nil;symmetry;apply /negP => /andP [/ZleP ? /ZltP ?]; Lia.lia. +Qed. + +Lemma size_ziota p z: size (ziota p z) = Z.to_nat z. +Proof. by rewrite ziotaE size_map size_iota. Qed. + +Lemma nth_ziota p (i:nat) z : leq (S i) (Z.to_nat z) -> + nth 0%Z (ziota p z) i = (p + Z.of_nat i)%Z. +Proof. + by move=> hi; rewrite ziotaE (nth_map O) ?size_iota // nth_iota. +Qed. + +Lemma list_all_ind (Q : Z -> bool) (P : list Z -> Prop): + P [::] -> + (forall i l, Q i -> all Q l -> P l -> P (i::l))-> + (forall l, all Q l -> P l). +Proof. + move=> hnil hcons; elim => //= a l hrec /andP [hQ hall]. + by apply hcons => //; apply hrec. +Qed. + +Lemma ziota_ind (P : list Z -> Prop) p1 p2: + P [::] -> + (forall i l, p1 <= i < p1 + p2 -> P l -> P (i::l))-> + P (ziota p1 p2). +Proof. + move=> hnil hcons. + have: all (fun i => (p1 <=? i) && (i i; rewrite in_ziota !zify. + by elim/list_all_ind => // i l; rewrite !zify => *;apply hcons. +Qed. + +Lemma all_ziota p1 p2 (f1 f2: Z -> bool) : + (forall i, (p1 <= i < p1 + p2)%Z -> f1 i = f2 i) -> + all f1 (ziota p1 p2) = all f2 (ziota p1 p2). +Proof. by move => h; apply ziota_ind => //= i l /h -> ->. Qed. + +Lemma ziota_shift i p : ziota i p = map (fun k => i + k)%Z (ziota 0 p). +Proof. by rewrite !ziotaE -map_comp /comp. Qed. + +Section ZNTH. + Context {A: Type} (dfl: A). + + Fixpoint pnth (m: list A) (p: positive) := + match m with + | [::] => dfl + | a :: m => + match p with + | 1 => a + | q~1 => pnth m q~0 + | q~0 => pnth m (Pos.pred_double q) + end%positive + end. + + Definition znth m (z: Z) : A := + if m is a :: m then + match z with + | Z0 => a + | Zpos p => pnth m p + | Zneg _ => dfl + end + else dfl. + +End ZNTH. + +(* Warning : this is not efficient, it should be used only for proof *) +Definition zindex (T:eqType) (t:T) l := + Z.of_nat (seq.index t l). + +Lemma znthE (A:Type) dfl (l:list A) i : + (0 <= i)%Z -> + znth dfl l i = nth dfl l (Z.to_nat i). +Proof. + case: l; first by rewrite nth_nil. + case: i => // p a m _. + elim/Pos.peano_ind: p a m; first by move => ? []. + move => p /= ih a; rewrite Pos2Nat.inj_succ /=. + case; first by rewrite nth_nil. + move => /= b m. + by case: Pos.succ (Pos.succ_not_1 p) (Pos.pred_succ p) => // _ _ /= ->. +Qed. + +Lemma mem_znth (A:eqType) dfl (l:list A) i : + [&& 0 <=? i & i + znth dfl l i \in l. +Proof. + move=> /andP []/ZleP h0i /ZltP hi. + by rewrite znthE //; apply/mem_nth/ZNltP; rewrite Z2Nat.id. +Qed. + +Lemma znth_index (T : eqType) (x0 x : T) (s : seq T): + x \in s → znth x0 s (zindex x s) = x. +Proof. + move=> hin; rewrite /zindex znthE; last by apply Zle_0_nat. + by rewrite Nat2Z.id nth_index. +Qed. + +(* ------------------------------------------------------------------------- *) +Lemma sumbool_of_boolET (b: bool) (h: b) : + Sumbool.sumbool_of_bool b = left h. +Proof. by move: h; rewrite /is_true => ?; subst. Qed. + +Lemma sumbool_of_boolEF (b: bool) (h: b = false) : + Sumbool.sumbool_of_bool b = right h. +Proof. by move: h; rewrite /is_true => ?; subst. Qed. + + +(* ------------------------------------------------------------------------- *) + +Definition lprod ts tr := + foldr (fun t tr => t -> tr) tr ts. + +Fixpoint ltuple (ts:list Type) : Type := + match ts with + | [::] => unit + | [::t1] => t1 + | t1::ts => t1 * ltuple ts + end. + +Notation "(:: x , .. , y & z )" := (pair x .. (pair y z) ..) (only parsing). + +Fixpoint merge_tuple (l1 l2: list Type) : ltuple l1 -> ltuple l2 -> ltuple (l1 ++ l2) := + match l1 return ltuple l1 -> ltuple l2 -> ltuple (l1 ++ l2) with + | [::] => fun _ p => p + | t1 :: l1 => + let rec := @merge_tuple l1 l2 in + match l1 return (ltuple l1 -> ltuple l2 -> ltuple (l1 ++ l2)) -> + ltuple (t1::l1) -> ltuple l2 -> ltuple (t1 :: l1 ++ l2) with + | [::] => fun _ (x:t1) => + match l2 return ltuple l2 -> ltuple (t1::l2) with + | [::] => fun _ => x + | t2::l2 => fun (p:ltuple (t2::l2)) => (x, p) + end + | t1' :: l1' => fun rec (x:t1 * ltuple (t1'::l1')) p => + (x.1, rec x.2 p) + end rec + end. + +(* ------------------------------------------------------------------------- *) +Lemma neq_sym (T: eqType) (x y: T) : + (x != y) = (y != x). +Proof. apply/eqP; case: eqP => //; exact: not_eq_sym. Qed. + +(* ------------------------------------------------------------------------- *) +Lemma nth_not_default T x0 (s:seq T) n x : + nth x0 s n = x -> + x0 <> x -> + (n < size s)%nat. +Proof. + move=> hnth hneq. + rewrite ltnNge; apply /negP => hle. + by rewrite nth_default in hnth. +Qed. + +Lemma all_behead {A} {p : A -> bool} {xs : seq A} : + all p xs -> all p (behead xs). +Proof. + case: xs => // x xs. + by move=> /andP [] _. +Qed. + +Lemma all2_behead {A B} {p: A -> B -> bool} {xs: seq A} {ys: seq B} : + all2 p xs ys + -> all2 p (behead xs) (behead ys). +Proof. + case: xs; case: ys => //= y ys x xs. + by move=> /andP [] _. +Qed. + +Lemma notin_cons (T : eqType) (x y : T) (s : seq T) : + (x \notin y :: s) = (x != y) && (x \notin s). +Proof. by rewrite in_cons negb_or. Qed. + +(* Convert [ C |- uniq xs -> P ] into + [ C, ? : x0 <> x1, ? : x0 <> x2, ... |- P ]. *) +Ltac t_elim_uniq := + repeat ( + move=> /andP []; + repeat (rewrite notin_cons; move=> /andP [] /eqP ?); + move=> _ + ); + move=> _. + +Variant and6 (P1 P2 P3 P4 P5 P6 : Prop) : Prop := + And6 of P1 & P2 & P3 & P4 & P5 & P6. +Variant and7 (P1 P2 P3 P4 P5 P6 P7 : Prop) : Prop := + And7 of P1 & P2 & P3 & P4 & P5 & P6 & P7. +Variant and8 (P1 P2 P3 P4 P5 P6 P7 P8 : Prop) : Prop := + And8 of P1 & P2 & P3 & P4 & P5 & P6 & P7 & P8. +Variant and9 (P1 P2 P3 P4 P5 P6 P7 P8 P9 : Prop) : Prop := + And9 of P1 & P2 & P3 & P4 & P5 & P6 & P7 & P8 & P9. +Variant and10 (P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 : Prop) : Prop := + And10 of P1 & P2 & P3 & P4 & P5 & P6 & P7 & P8 & P9 & P10. + +Notation "[ /\ P1 , P2 , P3 , P4 , P5 & P6 ]" := + (and6 P1 P2 P3 P4 P5 P6) : type_scope. +Notation "[ /\ P1 , P2 , P3 , P4 , P5 & P6 ]" := + (and6 P1 P2 P3 P4 P5 P6) : type_scope. +Notation "[ /\ P1 , P2 , P3 , P4 , P5 , P6 & P7 ]" := + (and7 P1 P2 P3 P4 P5 P6 P7) : type_scope. +Notation "[ /\ P1 , P2 , P3 , P4 , P5 , P6 , P7 & P8 ]" := + (and8 P1 P2 P3 P4 P5 P6 P7 P8) : type_scope. +Notation "[ /\ P1 , P2 , P3 , P4 , P5 , P6 , P7 , P8 & P9 ]" := + (and9 P1 P2 P3 P4 P5 P6 P7 P8 P9) : type_scope. +Notation "[ /\ P1 , P2 , P3 , P4 , P5 , P6 , P7 , P8 , P9 & P10 ]" := + (and10 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10) : type_scope. + +Tactic Notation "have!" ":= " constr(x) := + let h := fresh "h" in + (assert (h := x); move: h). + +Tactic Notation "have!" simple_intropattern(ip) ":= " constr(x) := + let h := fresh "h" in + (assert (h := x); move: h => ip). + +#[local] +Ltac t_do_rewrites tac := + repeat + match goal with + | [ h : ?lhs = ?rhs |- _ ] => tac h lhs rhs + | [ h : is_true (?lhs == ?rhs) |- _ ] => move: h => /eqP h; tac h lhs rhs + | [ h : is_true ?lhs |- _ ] => tac h lhs true + end. + +#[local] +Ltac head_term e := + match e with + | ?a _ => head_term a + | _ => e + end. + +#[local] +Ltac is_simpl e := + is_var e + || let x := head_term e in is_constructor x. + +#[local] +Ltac simpl_rewrite h lhs rhs := + (is_simpl lhs; rewrite -!h) || (is_simpl rhs; rewrite !h). + +Ltac t_simpl_rewrites := t_do_rewrites simpl_rewrite. + +#[local] +Ltac eq_rewrite h _ _ := + (rewrite !h || rewrite -!h); clear h. + +Ltac t_eq_rewrites := t_do_rewrites eq_rewrite. + +Ltac destruct_opn_args := + repeat (t_xrbindP=> -[|?]; first done); + (t_xrbindP=> -[]; last done). + +(* Attempt to prove [injective f] on [eqType]s by case analysis on the + arguments. *) +Ltac t_inj_cases := + move=> [] [] /eqP h; + apply/eqP. + +(* ------------------------------------------------------------------------- *) + +Module Option. + +Variant option_spec X A o xs xn : option A -> X -> Prop := +| OptionSpecSome : forall a, o = Some a -> option_spec o xs xn (Some a) (xs a) +| OptionSpecNone : o = None -> option_spec o xs xn None xn. + +Lemma oappP R A (f : A -> R) x u : option_spec u f x u (oapp f x u). +Proof. by case: u; constructor. Qed. + +Lemma odfltP T (x : T) u : option_spec u id x u (odflt x u). +Proof. by case: u; constructor. Qed. + +Lemma obindP A R (f : A -> option R) u : option_spec u f None u (obind f u). +Proof. by case: u; constructor. Qed. + +Lemma omapP A R (f : A -> R) u : + option_spec u (fun x => Some (f x)) None u (Option.map f u). +Proof. by case: u; constructor. Qed. + +End Option. + +Notation "'let%opt' x ':=' ox 'in' body" := + (if ox is Some x then body else None) + (x strict pattern, at level 25). + +Notation "'let%opt '_' ':=' ox 'in' body" := + (if ox is Some tt then body else None) + (at level 25). + +Lemma obindP aT bT oa (f : aT -> option bT) a (P : Type) : + (forall z, oa = Some z -> f z = Some a -> P) -> + (let%opt a' := oa in f a') = Some a -> + P. +Proof. case: oa => // a' h h'. exact: (h _ _ h'). Qed. + +Definition oassert (b : bool) : option unit := + if b then Some tt else None. + +Lemma oassertP {A b a} {oa : option A} : + (let%opt _ := oassert b in oa) = Some a -> + b /\ oa = Some a. +Proof. by case: b. Qed. + +Lemma oassertP_isSome {A b} {oa : option A} : + isSome (let%opt _ := oassert b in oa) -> + b /\ isSome oa. +Proof. by case: b. Qed. + +Lemma isSomeP {A : Type} {oa : option A} : + isSome oa -> + exists a, oa = Some a. +Proof. case: oa; by [|eexists]. Qed. + +Lemma o2rP {eT A} {err : eT} {oa : option A} {a} : + o2r err oa = ok a -> + oa = Some a. +Proof. by case: oa => //= ? [->]. Qed. + +Lemma cat_inj_head T (x y z : seq T) : x ++ y = x ++ z -> y = z. +Proof. by elim: x y z => // > hrec >; rewrite !cat_cons => -[/hrec]. Qed. + +Lemma cat_inj_tail T (x y z : seq T) : x ++ z = y ++ z -> x = y. +Proof. + elim: z x y => >; first by rewrite !cats0. + by move=> hrec >; rewrite -!cat_rcons => /hrec /rcons_inj[]. +Qed. + +Lemma map_const_nseq A B (l : list A) (c : B) : map (fun=> c) l = nseq (size l) c. +Proof. by elim: l => // > ? /=; f_equal. Qed. + + +Section RT_TRANSN. + +Context + {A : Type} + {R Rstep : A -> A -> Prop} +. + +Fixpoint transn_spec_aux (a0 an : A) (l : list A) : Prop := + match l with + | [::] => R a0 an + | an1 :: l => Rstep an an1 -> transn_spec_aux a0 an1 l + end. + +Definition transn_spec (l : list A) : Prop := + match l with + | [::] => True + | a0 :: l => transn_spec_aux a0 a0 l + end. + + Section SPEC. + + Context + (htrans : forall x y z, R x y -> R y z -> R x z) + (hstep : forall x y, Rstep x y -> R x y) + (hrefl : forall x, R x x) + . + + Lemma transn_spec_auxP a0 an l : + R a0 an -> + transn_spec_aux a0 an l. + Proof. + elim: l an => //= an1 l hrec an h0n hnn1. + apply: hrec. + apply: (htrans h0n). + exact: hstep. + Qed. + + Lemma transn_specP l : transn_spec l. + Proof. + case: l => [// | a0 [// | a1 l ?]]. + apply: transn_spec_auxP. + exact: hstep. + Qed. + + End SPEC. + +Context (hspec : forall l, transn_spec l). + +Lemma transn2 a0 a1 a2 : + Rstep a0 a1 -> + Rstep a1 a2 -> + R a0 a2. +Proof. exact: (hspec [:: _; _; _ ]). Qed. + +Lemma transn3 a0 a1 a2 a3 : + Rstep a0 a1 -> + Rstep a1 a2 -> + Rstep a2 a3 -> + R a0 a3. +Proof. exact: (hspec [:: _; _; _; _ ]). Qed. + +Lemma transn4 a0 a1 a3 a2 a4 : + Rstep a0 a1 -> + Rstep a1 a2 -> + Rstep a2 a3 -> + Rstep a3 a4 -> + R a0 a4. +Proof. exact: (hspec [:: _; _; _; _; _ ]). Qed. + +Lemma transn5 a0 a1 a3 a2 a4 a5 : + Rstep a0 a1 -> + Rstep a1 a2 -> + Rstep a2 a3 -> + Rstep a3 a4 -> + Rstep a4 a5 -> + R a0 a5. +Proof. exact: (hspec [:: _; _; _; _; _; _ ]). Qed. + +Lemma transn6 a0 a1 a3 a2 a4 a5 a6 : + Rstep a0 a1 -> + Rstep a1 a2 -> + Rstep a2 a3 -> + Rstep a3 a4 -> + Rstep a4 a5 -> + Rstep a5 a6 -> + R a0 a6. +Proof. exact: (hspec [:: _; _; _; _; _; _; _ ]). Qed. + +End RT_TRANSN. diff --git a/theories/Crypt/jasmin_word.v b/theories/Crypt/jasmin_word.v new file mode 100644 index 00000000..083add90 --- /dev/null +++ b/theories/Crypt/jasmin_word.v @@ -0,0 +1,1950 @@ +(* ** Machine word *) + +(* ** Imports and settings *) + +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word_ssrZ word. +From Crypt Require Import jasmin_util jasmin_wsize. +Require Import (* strings *) ZArith (* utils *). +(* Import Utf8. *) +(* Import word_ssrZ. *) +Export jasmin_wsize. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +(* -------------------------------------------------------------- *) +Definition nat7 : nat := 7. +Definition nat15 : nat := nat7.+4.+4. +Definition nat31 : nat := nat15.+4.+4.+4.+4. +Definition nat63 : nat := nat31.+4.+4.+4.+4.+4.+4.+4.+4. +Definition nat127 : nat := nat63.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4. +Definition nat255 : nat := nat127.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4.+4. + +Definition wsize_size_minus_1 (s: wsize) : nat := + match s with + | U8 => nat7 + | U16 => nat15 + | U32 => nat31 + | U64 => nat63 + | U128 => nat127 + | U256 => nat255 + end. + +Coercion nat_of_wsize (sz : wsize) := + (wsize_size_minus_1 sz).+1. + +Definition wsize_bits (s:wsize) : Z := + Zpos (Pos.of_succ_nat (wsize_size_minus_1 s)). + +(* -------------------------------------------------------------- *) + +Ltac elim_div := + unfold Z.div, Z.modulo; + match goal with + | H : context[ Z.div_eucl ?X ?Y ] |- _ => + generalize (Z_div_mod_full X Y) ; case: (Z.div_eucl X Y) + | |- context[ Z.div_eucl ?X ?Y ] => + generalize (Z_div_mod_full X Y) ; case: (Z.div_eucl X Y) + end; unfold Remainder. + +Definition wsize_log2 sz : nat := + match sz with + | U8 => 0 + | U16 => 1 + | U32 => 2 + | U64 => 3 + | U128 => 4 + | U256 => 5 + end. + +Definition wbase (s: wsize) : Z := + modulus (wsize_size_minus_1 s).+1. + +Coercion nat_of_pelem (pe: pelem) : nat := + match pe with + | PE1 => 1 + | PE2 => 2 + | PE4 => 4 + | PE8 => nat_of_wsize U8 + | PE16 => nat_of_wsize U16 + | PE32 => nat_of_wsize U32 + | PE64 => nat_of_wsize U64 + | PE128 => nat_of_wsize U128 + end. + +Definition word sz : comRingType := (wsize_size_minus_1 sz).+1.-word. + +Global Opaque word. + +Local Open Scope Z_scope. + + +Definition winit (ws : wsize) (f : nat -> bool) : word ws := + let bits := map f (iota 0 (wsize_size_minus_1 ws).+1) in + t2w (Tuple (tval := bits) ltac:(by rewrite size_map size_iota)). + +Definition wand {s} (x y: word s) : word s := wand x y. +Definition wor {s} (x y: word s) : word s := wor x y. +Definition wxor {s} (x y: word s) : word s := wxor x y. + +Definition wlt {sz} (sg: signedness) : word sz -> word sz -> bool := + match sg with + | Unsigned => fun x y=> (urepr x < urepr y)%R + | Signed => fun x y=> (srepr x < srepr y)%R + end. + +Definition wle sz (sg: signedness) : word sz -> word sz -> bool := + match sg with + | Unsigned => fun x y=> (urepr x <= urepr y)%R + | Signed => fun x y=> (srepr x <= srepr y)%R + end. + +Definition wnot sz (w: word sz) : word sz := + wxor w (-1)%R. + +Arguments wnot {sz} w. + +Definition wandn sz (x y: word sz) : word sz := wand (wnot x) y. + +Definition wunsigned {s} (w: word s) : Z := + urepr w. + +Definition wsigned {s} (w: word s) : Z := + srepr w. + +Definition wrepr s (z: Z) : word s := + mkword (wsize_size_minus_1 s).+1 z. + +Lemma word_ext n x y h h' : + x = y -> + @mkWord n x h = @mkWord n y h'. +Proof. by move => e; apply/val_eqP/eqP. Qed. + +Lemma wunsigned_inj sz : injective (@wunsigned sz). +Proof. by move => x y /eqP /val_eqP. Qed. + +Lemma wunsigned1 ws : + @wunsigned ws 1 = 1%Z. +Proof. by case: ws. Qed. + +Lemma wrepr_unsigned s (w: word s) : wrepr s (wunsigned w) = w. +Proof. by rewrite /wrepr /wunsigned ureprK. Qed. + +Lemma wrepr_signed s (w: word s) : wrepr s (wsigned w) = w. +Proof. by rewrite /wrepr /wsigned sreprK. Qed. + +Lemma wunsigned_repr s z : + wunsigned (wrepr s z) = z mod modulus (wsize_size_minus_1 s).+1. +Proof. done. Qed. + +Lemma wrepr0 sz : wrepr sz 0 = 0%R. +Proof. by apply/eqP. Qed. + +Lemma wrepr1 sz : wrepr sz 1 = 1%R. +Proof. by apply/eqP;case sz. Qed. + +Lemma wreprB sz : wrepr sz (wbase sz) = 0%R. +Proof. by apply/eqP;case sz. Qed. + +Lemma wunsigned_range sz (p: word sz) : + 0 <= wunsigned p < wbase sz. +Proof. by have /iswordZP := isword_word p. Qed. + +Lemma wrepr_mod ws k : wrepr ws (k mod wbase ws) = wrepr ws k. +Proof. by apply wunsigned_inj; rewrite !wunsigned_repr Zmod_mod. Qed. + +Lemma wunsigned_repr_small ws z : 0 <= z < wbase ws -> wunsigned (wrepr ws z) = z. +Proof. move=> h; rewrite wunsigned_repr; apply: Zmod_small h. Qed. + +Lemma wrepr_add sz (x y: Z) : + wrepr sz (x + y) = (wrepr sz x + wrepr sz y)%R. +Proof. by apply: word_ext; rewrite /wrepr !mkwordK Zplus_mod. Qed. + +Lemma wrepr_sub sz (x y: Z) : + wrepr sz (x - y) = (wrepr sz x - wrepr sz y)%R. +Proof. by apply: word_ext; rewrite /wrepr !mkwordK -Zminus_mod_idemp_r -Z.add_opp_r Zplus_mod. Qed. + +Lemma wrepr_mul sz (x y: Z) : + wrepr sz (x * y) = (wrepr sz x * wrepr sz y)%R. +Proof. by apply: word_ext; rewrite /wrepr !mkwordK Zmult_mod. Qed. + +Lemma wrepr_m1 sz : + wrepr sz (-1) = (-1)%R. +Proof. by apply /eqP; case sz. Qed. + +Lemma wunsigned0 ws : @wunsigned ws 0 = 0. +Proof. by rewrite -wrepr0 wunsigned_repr Zmod_0_l. Qed. + +Lemma wunsigned_add sz (p: word sz) (n: Z) : + 0 <= wunsigned p + n < wbase sz -> + wunsigned (p + wrepr sz n) = wunsigned p + n. +Proof. + move=> h. + rewrite -{1}(wrepr_unsigned p). + by rewrite -wrepr_add wunsigned_repr Z.mod_small. +Qed. + +Lemma wunsigned_add_if ws (a b : word ws) : + wunsigned (a + b) = + if wunsigned a + wunsigned b ha hb. + case: ZltP => hlt. + + by rewrite Zmod_small //;Psatz.lia. + by rewrite -(Z_mod_plus_full _ (-1)) Zmod_small;Psatz.lia. +Qed. + +Lemma wunsigned_sub (sz : wsize) (p : word sz) (n : Z): + 0 <= wunsigned p - n < wbase sz -> wunsigned (p - wrepr sz n) = wunsigned p - n. +Proof. + move=> h. + rewrite -{1}(wrepr_unsigned p). + by rewrite -wrepr_sub wunsigned_repr Z.mod_small. +Qed. + +Lemma wunsigned_sub_if ws (a b : word ws) : + wunsigned (a - b) = + if wunsigned b <=? wunsigned a then wunsigned a - wunsigned b + else wbase ws + wunsigned a - wunsigned b. +Proof. + move: (wunsigned_range a) (wunsigned_range b). + rewrite /wunsigned mathcomp.word.word.subwE -/(wbase ws) => ha hb. + have -> : (word.urepr a - word.urepr b)%R = word.urepr a - word.urepr b by done. + case: ZleP => hle. + + by rewrite Zmod_small //;Psatz.lia. + by rewrite -(Z_mod_plus_full _ 1) Zmod_small;Psatz.lia. +Qed. + +Lemma wunsigned_opp_if ws (a : word ws) : + wunsigned (-a) = if wunsigned a == 0 then 0 else wbase ws - wunsigned a. +Proof. + have ha := wunsigned_range a. + rewrite -(GRing.add0r (-a)%R) wunsigned_sub_if wunsigned0. + by case: ZleP; case: eqP => //; Psatz.lia. +Qed. + +Lemma wlt_irrefl sz sg (w: word sz) : + wlt sg w w = false. +Proof. case: sg; exact: Z.ltb_irrefl. Qed. + +Lemma wle_refl sz sg (w: word sz) : + wle sg w w = true. +Proof. case: sg; exact: Z.leb_refl. Qed. + +Definition wshr sz (x: word sz) (n: Z) : word sz := + mkword sz (Z.shiftr (wunsigned x) n). + +Definition wshl sz (x: word sz) (n: Z) : word sz := + mkword sz (Z.shiftl (wunsigned x) n). + +Definition wsar sz (x: word sz) (n: Z) : word sz := + mkword sz (Z.shiftr (wsigned x) n). + +Definition high_bits sz (n : Z) : word sz := + wrepr sz (Z.shiftr n (wsize_bits sz)). + +Definition wmulhu sz (x y: word sz) : word sz := + high_bits sz (wunsigned x * wunsigned y). + +Definition wmulhs sz (x y: word sz) : word sz := + high_bits sz (wsigned x * wsigned y). + +Definition wmulhrs sz (x y: word sz) : word sz := + let: p := Z.shiftr (wsigned x * wsigned y) (wsize_size_minus_1 sz).-1 + 1 in + wrepr sz (Z.shiftr p 1). + +Definition wmax_unsigned sz := wbase sz - 1. +Definition wmin_signed (sz: wsize) : Z := - modulus (wsize_size_minus_1 sz). +Definition wmax_signed (sz: wsize) : Z := modulus (wsize_size_minus_1 sz) - 1. + +Section wsigned_range. +Local Arguments Z.add: simpl never. +Local Arguments Z.sub: simpl never. +Local Arguments Z.opp: simpl never. + +End wsigned_range. + +Notation u8 := (word U8). +Notation u16 := (word U16). +Notation u32 := (word U32). +Notation u64 := (word U64). +Notation u128 := (word U128). +Notation u256 := (word U256). + +Definition wbit_n sz (w:word sz) (n:nat) : bool := + wbit (wunsigned w) n. + +Lemma wbit_nE ws (w : word ws) i : + wbit_n w i = Z.odd (wunsigned w / 2 ^ i)%Z. +Proof. + have [hlo _] := wunsigned_range w. + rewrite /wbit_n. + rewrite word.wbitE; last by rewrite !zify. + + rewrite -(Nat2Z.id (_ %/ _)). + + rewrite -oddZE; last first. + - rewrite !zify. exact: Zle_0_nat. + + rewrite divnZE; first last. + - apply: lt0n_neq0. by rewrite expn_gt0. + + rewrite Z2Nat.id; last done. + by rewrite Nat2Z.n2zX expZE. +Qed. + +Lemma eq_from_wbit_n s (w1 w2: word s) : + reflect (forall i : 'I_(wsize_size_minus_1 s).+1, wbit_n w1 i = wbit_n w2 i) (w1 == w2). +Proof. apply/eq_from_wbit. Qed. + +Lemma wandE s (w1 w2: word s) i : + wbit_n (wand w1 w2) i = wbit_n w1 i && wbit_n w2 i. +Proof. by rewrite /wbit_n /wand wandE. Qed. + +Lemma worE s (w1 w2 : word s) i : + wbit_n (wor w1 w2) i = wbit_n w1 i || wbit_n w2 i. +Proof. by rewrite /wbit_n /wor worE. Qed. + +Lemma wxorE s (w1 w2: word s) i : + wbit_n (wxor w1 w2) i = wbit_n w1 i (+) wbit_n w2 i. +Proof. by rewrite /wbit_n /wxor wxorE. Qed. + +Lemma wN1E sz i : + @wbit_n sz (-1)%R i = leq (S i) (wsize_size_minus_1 sz).+1. +Proof. exact: wN1E. Qed. + +Lemma w0E sz i : + @wbit_n sz 0%R i = false. +Proof. exact: Z.testbit_0_l. Qed. + +Lemma wnotE sz (w: word sz) (i: 'I_(wsize_size_minus_1 sz).+1) : + wbit_n (wnot w) i = ~~ wbit_n w i. +Proof. + rewrite /wnot wxorE wN1E. + case: i => i /= ->. + exact: addbT. +Qed. + +Lemma wshrE sz (x: word sz) c i : + 0 <= c -> + wbit_n (wshr x c) i = wbit_n x (Z.to_nat c + i). +Proof. + move/Z2Nat.id => {1}<-. + exact: wbit_lsr. +Qed. + +Lemma wunsigned_wshr sz (x: word sz) c : + wunsigned (wshr x (Z.of_nat c)) = wunsigned x / 2 ^ Z.of_nat c. +Proof. + have rhs_range : 0 <= wunsigned x / 2 ^ Z.of_nat c /\ wunsigned x / 2 ^ Z.of_nat c < modulus sz. + - have x_range := wunsigned_range x. + split. + + apply: Z.div_pos; first Lia.lia. + apply: Z.pow_pos_nonneg; Lia.lia. + change (modulus sz) with (wbase sz). + elim_div => ? ? []; last Lia.nia. + apply: Z.pow_nonzero; Lia.lia. + rewrite -(Z.mod_small (wunsigned x / 2 ^ Z.of_nat c) (modulus sz)) //. + rewrite -wunsigned_repr. + congr wunsigned. + apply/eqP/eq_from_wbit_n => i. + rewrite /wbit_n wbit_lsr wunsigned_repr /wbit. + rewrite Z.mod_small //. + rewrite Z.div_pow2_bits. + 2-3: Lia.lia. + by rewrite Nat2Z.n2zD Z.add_comm. +Qed. + +Lemma wshlE sz (w: word sz) c i : + 0 <= c -> + wbit_n (wshl w c) i = (Z.to_nat c <= i <= wsize_size_minus_1 sz)%nat && wbit_n w (i - Z.to_nat c). +Proof. + move/Z2Nat.id => {1}<-. + rewrite /wbit_n /wshl /=. + case: leP => hic /=; + last (rewrite wbit_lsl_lo //; apply/leP; Lia.lia). + have eqi : (Z.to_nat c + (i - Z.to_nat c))%nat = i. + * by rewrite /addn /addn_rec; zify; rewrite Nat2Z.inj_sub; Lia.lia. + have := wbit_lsl w (Z.to_nat c) (i - Z.to_nat c). + by rewrite eqi => ->. +Qed. + +Local Ltac lia := + rewrite /addn /addn_rec /subn /subn_rec; Psatz.lia. + +Lemma wunsigned_wshl sz (x: word sz) c : + wunsigned (wshl x (Z.of_nat c)) = (wunsigned x * 2 ^ Z.of_nat c) mod wbase sz. +Proof. + rewrite -wunsigned_repr. + congr wunsigned. + apply/eqP/eq_from_wbit_n => i. + rewrite /wbit_n wunsigned_repr /modulus two_power_nat_equiv. + rewrite {2}/wbit Z.mod_pow2_bits_low; last first. + - move/ltP: (ltn_ord i); Lia.lia. + case: (@ltP i c); last first. + - move => c_le_i. + have i_eq : nat_of_ord i = (c + (i - c))%nat by lia. + rewrite i_eq wbit_lsl -i_eq ltn_ord /wbit. + rewrite Z.mul_pow2_bits; last by lia. + congr Z.testbit. + lia. + move => l_lt_c. + rewrite wbit_lsl_lo; last by apply/ltP. + rewrite Z.mul_pow2_bits_low //; lia. +Qed. + +Lemma wshl_sem ws w n : + (0 <= n)%Z + -> wshl w n = (wrepr ws (2 ^ n) * w)%R. +Proof. + move=> hlo. + apply: wunsigned_inj. + + rewrite -(Z2Nat.id _ hlo). + rewrite wunsigned_wshl. + rewrite (Z2Nat.id _ hlo). + + rewrite -(wrepr_unsigned w). + rewrite -wrepr_mul. + rewrite !wunsigned_repr. + + rewrite Zmult_mod_idemp_l. + by rewrite Z.mul_comm. +Qed. + +Lemma wshl_ovf sz (w: word sz) c : + 0 <= c -> + (wsize_size_minus_1 sz < Z.to_nat c)%coq_nat -> + wshl w c = 0%R. +Proof. + move => c_not_neg hc; apply/eqP/eq_from_wbit_n => i. + rewrite wshlE // {2}/wbit_n wbit0. + case: i => i /= /leP /le_S_n hi. + have /leP -> := hi. + case: leP => //; lia. +Qed. + +Definition lsb {s} (w: word s) : bool := wbit_n w 0. +Definition msb {s} (w: word s) : bool := wbit_n w (wsize_size_minus_1 s). + +Lemma msb_wordE {s} (w : word s) : msb w = mathcomp.word.word.msb w. +Proof. by []. Qed. + +Definition wdwordu sz (hi lo: word sz) : Z := + wunsigned hi * wbase sz + wunsigned lo. + +Definition wdwords sz (hi lo: word sz) : Z := + wsigned hi * wbase sz + wunsigned lo. + +Definition waddcarry sz (x y: word sz) (c: bool) := + let n := wunsigned x + wunsigned y + Z.b2z c in + (wbase sz <=? n, wrepr sz n). + +Definition wdaddu sz (hi_1 lo_1 hi_2 lo_2: word sz) := + let n := (wdwordu hi_1 lo_1) + (wdwordu hi_2 lo_2) in + (wrepr sz n, high_bits sz n). + +Definition wdadds sz (hi_1 lo_1 hi_2 lo_2: word sz) := + let n := (wdwords hi_1 lo_1) + (wdwords hi_2 lo_2) in + (wrepr sz n, high_bits sz n). + +Definition wsubcarry sz (x y: word sz) (c: bool) := + let n := wunsigned x - wunsigned y - Z.b2z c in + (n exec (word s) with + | Eq => fun h => ok (ecast s (word s) (esym (cmp_eq h)) w) + | Lt => fun _ => ok (zero_extend s w) + | Gt => fun _ => type_error + end erefl. + +Variant truncate_word_spec s s' (w: word s') : exec (word s) -> Type := + | TruncateWordEq (h: s' = s) : truncate_word_spec w (ok (ecast s (word s) h w)) + | TruncateWordLt (h: (s < s')%CMP) : truncate_word_spec w (ok (zero_extend s w)) + | TruncateWordGt : (s' < s)%CMP -> truncate_word_spec w type_error + . + +Lemma truncate_wordP' s s' (w: word s') : truncate_word_spec w (truncate_word s w). +Proof. + rewrite /truncate_word/gcmp. + case: {2 3} (wsize_cmp s s') erefl. + - move => /cmp_eq ?; exact: TruncateWordEq. + - move => h; apply: TruncateWordLt. + by rewrite /cmp_lt /gcmp h. + rewrite -/(gcmp s s') => h. + apply: TruncateWordGt. + by rewrite /cmp_lt cmp_sym h. +Qed. + +Definition wbit sz (w i: word sz) : bool := + wbit_n w (Z.to_nat (wunsigned i mod wsize_bits sz)). + +Definition wror sz (w:word sz) (z:Z) := + let i := z mod wsize_bits sz in + wor (wshr w i) (wshl w (wsize_bits sz - i)). + +Definition wrol sz (w:word sz) (z:Z) := + let i := z mod wsize_bits sz in + wor (wshl w i) (wshr w (wsize_bits sz - i)). + +(* -------------------------------------------------------------------*) +Lemma wsignedE sz (w: word sz) : + wsigned w = if msb w then wunsigned w - wbase sz else wunsigned w. +Proof. done. Qed. + +(* Lemma wsigned_repr sz z : *) +(* wmin_signed sz <= z <= wmax_signed sz -> *) +(* wsigned (wrepr sz z) = z. *) +(* Proof. *) +(* rewrite wsignedE msb_wordE msbE /= wunsigned_repr -/(wbase _) => z_range. *) +(* elim_div => a b [] // ? [] b_range; last by have := wbase_pos sz; lia. *) +(* subst z. *) +(* case: ifP => /ZleP. *) +(* all: move: sz z_range b_range. *) +(* all: move: {-2} Z.mul (erefl Z.mul) => K ?. *) +(* all: rewrite /wmin_signed /wmax_signed /wbase /modulus /two_power_nat. *) +(* all: case => /=; subst K; lia. *) +(* Qed. *) + +(* (* -------------------------------------------------------------------*) *) +(* Lemma wsmulP sz (x y: word sz) : *) +(* let: (hi, lo) := wsmul x y in *) +(* wdwords hi lo = wsigned x * wsigned y. *) +(* Proof. *) +(* have x_range := wsigned_range x. *) +(* have y_range := wsigned_range y. *) +(* rewrite /wsmul /wdwords high_bits_wbase. *) +(* set p := _ * wsigned _. *) +(* have p_range : wmin_signed sz * wmax_signed sz <= p <= wmin_signed sz * wmin_signed sz. *) +(* { subst p; case: sz x y x_range y_range => x y; *) +(* rewrite /wmin_signed /wmax_signed /=; *) +(* nia. } *) +(* have hi_range : wmin_signed sz <= p / wbase sz <= wmax_signed sz. *) +(* { move: sz {x y x_range y_range} p p_range => sz p p_range. *) +(* elim_div => a b [] // ? [] b_range; last by have := wbase_pos sz; lia. *) +(* subst p. *) +(* move: sz p_range b_range. *) +(* move: {-2} Z.mul (erefl Z.mul) => K ?. *) +(* rewrite /wmin_signed /wmax_signed /wbase /modulus /two_power_nat. *) +(* case => /=; subst K; lia. } *) +(* rewrite wsigned_repr; last exact: hi_range. *) +(* rewrite wunsigned_repr -/(wbase _). *) +(* have := Z_div_mod_eq_full p (wbase sz). *) +(* lia. *) +(* Qed. *) + +(* -------------------------------------------------------------------*) +Lemma msb0 sz : @msb sz 0 = false. +Proof. by case: sz. Qed. + +Lemma wshr0 sz (w: word sz) : wshr w 0 = w. +Proof. by rewrite /wshr /lsr Z.shiftr_0_r ureprK. Qed. + +Lemma wshr_full sz (w : word sz) : wshr w (wsize_bits sz) = 0%R. +Proof. + apply/eqP/eq_from_wbit_n. + move=> i. + rewrite w0E. + rewrite wshrE //. + rewrite /wsize_bits /=. + rewrite SuccNat2Pos.id_succ. + rewrite /wbit_n. + rewrite wbit_word_ovf; first done. + apply: ltn_addr. + exact: ltnSn. +Qed. + +Lemma wshl0 sz (w: word sz) : wshl w 0 = w. +Proof. by rewrite /wshl /lsl Z.shiftl_0_r ureprK. Qed. + +(* Lemma wshl_full sz (w : word sz) : wshl w (wsize_bits sz) = 0%R. *) +(* Proof. *) +(* apply/eqP/eq_from_wbit_n. *) +(* move=> i. *) +(* rewrite wshlE; last by []. *) +(* rewrite /wsize_bits /=. *) +(* rewrite SuccNat2Pos.id_succ. *) +(* case hi: (_ <= _ <= _)%N; last by rewrite w0E. *) +(* by move: hi => /andP [] /ltn_geF ->. *) +(* Qed. *) + +Lemma wsar0 sz (w: word sz) : wsar w 0 = w. +Proof. by rewrite /wsar /asr Z.shiftr_0_r sreprK. Qed. + +(* -------------------------------------------------------------------*) +Lemma zero_extend0 sz sz' : + @zero_extend sz sz' 0%R = 0%R. +Proof. by apply/eqP/eq_from_wbit. Qed. + +Lemma zero_extend_u sz (w:word sz) : zero_extend sz w = w. +Proof. by rewrite /zero_extend wrepr_unsigned. Qed. + +(* Lemma zero_extend_sign_extend sz sz' s (w: word s) : *) +(* (sz ≤ sz')%CMP -> *) +(* zero_extend sz (sign_extend sz' w) = sign_extend sz w. *) +(* Proof. *) +(* move => hsz; rewrite /sign_extend; apply: word_ext. *) +(* move: (wsigned w) => {w} z. *) +(* rewrite wunsigned_repr. *) +(* case: (modulus_m (wsize_size_m hsz)) => n hn. *) +(* by rewrite hn mod_pq_mod_q. *) +(* Qed. *) + +(* Lemma zero_extend_wrepr sz sz' z : *) +(* (sz <= sz')%CMP -> *) +(* zero_extend sz (wrepr sz' z) = wrepr sz z. *) +(* Proof. *) +(* move/wsize_size_m => hle. *) +(* apply: word_ext. *) +(* rewrite /wunsigned /urepr /wrepr /=. *) +(* case: (modulus_m hle) => n -> {hle}. *) +(* exact: mod_pq_mod_q. *) +(* Qed. *) + +(* Lemma zero_extend_idem s s1 s2 (w:word s) : *) +(* (s1 <= s2)%CMP -> zero_extend s1 (zero_extend s2 w) = zero_extend s1 w. *) +(* Proof. *) +(* by move=> hle;rewrite [X in (zero_extend _ X) = _]/zero_extend zero_extend_wrepr. *) +(* Qed. *) + +(* Lemma zero_extend_cut (s1 s2 s3: wsize) (w: word s3) : *) +(* (s3 ≤ s2)%CMP -> *) +(* zero_extend s1 (zero_extend s2 w) = zero_extend s1 w. *) +(* Proof. *) +(* move => /wbase_m hle. *) +(* rewrite /zero_extend wunsigned_repr_small //. *) +(* have := wunsigned_range w. *) +(* lia. *) +(* Qed. *) + +Lemma wbit_zero_extend s s' (w: word s') i : + wbit_n (zero_extend s w) i = (i <= wsize_size_minus_1 s)%nat && wbit_n w i. +Proof. +rewrite /zero_extend /wbit_n /wunsigned /wrepr. +move: (urepr w) => {w} z. +rewrite mkwordK. +set m := wsize_size_minus_1 _. +rewrite /mathcomp.word.word.wbit /=. +rewrite /modulus two_power_nat_equiv. +case: leP => hi. ++ rewrite Z.mod_pow2_bits_low //; lia. +rewrite Z.mod_pow2_bits_high //; lia. +Qed. + +Lemma zero_extend1 sz sz' : + @zero_extend sz sz' 1%R = 1%R. +Proof. + apply/eqP/eq_from_wbit => -[i hi]. + have := @wbit_zero_extend sz sz' 1%R i. + by rewrite /wbit_n => ->; rewrite -ltnS hi. +Qed. + +(* Lemma sign_extend_truncate s s' (w: word s') : *) +(* (s ≤ s')%CMP -> *) +(* sign_extend s w = zero_extend s w. *) +(* Proof. *) +(* rewrite /sign_extend /zero_extend /wsigned /wunsigned. *) +(* rewrite mathcomp.word.word.sreprE /= /wrepr. *) +(* move: (mathcomp.word.word.urepr w) => z hle. *) +(* apply/word_ext. *) +(* have [n ->] := modulus_m (wsize_size_m hle). *) +(* case: word_ssrZ.ltzP => // hgt. *) +(* by rewrite Zminus_mod Z_mod_mult Z.sub_0_r Zmod_mod. *) +(* Qed. *) + +Lemma sign_extend_u sz (w: word sz) : sign_extend sz w = w. +Proof. exact: sreprK. Qed. + +Lemma truncate_word_le s s' (w: word s') : + (s ≤ s')%CMP -> + truncate_word s w = ok (zero_extend s w). + case: truncate_wordP' => //. + - by move => ?; subst; rewrite zero_extend_u. + by rewrite -cmp_nle_lt => /negbTE ->. +Qed. + +Lemma truncate_wordP s1 s2 (w1:word s1) (w2:word s2) : + truncate_word s1 w2 = ok w1 -> (s1 <= s2)%CMP /\ w1 = zero_extend s1 w2. +Proof. + case: truncate_wordP'; last by []. + - move => ?; subst => /ok_inj ->{w2}. + by rewrite cmp_le_refl zero_extend_u. + by move => /(@cmp_lt_le _ _ _ _ _) -> /ok_inj ->. +Qed. + +(* Lemma truncate_word_errP s1 s2 (w: word s2) e : *) +(* truncate_word s1 w = Error e -> e = ErrType ∧ (s2 < s1)%CMP. *) +(* Proof. by case: truncate_wordP' => // -> [] <-. Qed. *) + +Global Opaque truncate_word. + +Lemma truncate_word_u s (a : word s) : truncate_word s a = ok a. +Proof. by rewrite truncate_word_le ?zero_extend_u ?cmp_refl. Qed. + +Lemma wbase_n0 sz : wbase sz <> 0%Z. +Proof. by case sz. Qed. + +Lemma wsigned0 sz : @wsigned sz 0%R = 0%Z. +Proof. by case: sz. Qed. + +Lemma wsigned1 sz : @wsigned sz 1%R = 1%Z. +Proof. by case: sz. Qed. + +Lemma wsignedN1 sz : @wsigned sz (-1)%R = (-1)%Z. +Proof. by case: sz. Qed. + +Lemma sign_extend0 sz sz' : + @sign_extend sz sz' 0%R = 0%R. +Proof. by rewrite /sign_extend wsigned0 wrepr0. Qed. + +Lemma wandC sz : commutative (@wand sz). +Proof. + by move => x y; apply/eqP/eq_from_wbit => i; + rewrite /wand !mathcomp.word.word.wandE andbC. +Qed. + +Lemma wandA sz : associative (@wand sz). +Proof. + by move => x y z; apply/eqP/eq_from_wbit_n => i; + rewrite !wandE andbA. +Qed. + +Lemma wand0 sz (x: word sz) : wand 0 x = 0%R. +Proof. by apply/eqP. Qed. + +Lemma wand_xx sz (x: word sz) : wand x x = x. +Proof. by apply/eqP/eq_from_wbit; rewrite /= Z.land_diag. Qed. + +Lemma wandN1 sz (x: word sz) : wand (-1) x = x. +Proof. + apply/eqP/eq_from_wbit_n => i. + by rewrite wandE wN1E ltn_ord. +Qed. + +(* Lemma wand_small n : *) +(* (0 <= n < wbase U16) *) +(* -> wand (wrepr U32 n) (zero_extend U32 (wrepr U16 (-1))) = wrepr U32 n. *) +(* Proof. *) +(* move=> [hlo hhi]. *) +(* apply/eqP/eq_from_wbit_n. *) +(* move=> [i hrangei] /=. *) + +(* case hi: (i < 16)%nat. *) + +(* - rewrite wandE. *) +(* rewrite wrepr_m1 wbit_zero_extend. *) +(* rewrite wN1E. *) + +(* have -> : (i <= wsize_size_minus_1 U32)%nat. *) +(* - by apply: (ltnSE hrangei). *) +(* rewrite andTb. *) + +(* rewrite hi. *) +(* by rewrite andbT. *) + +(* have -> : wbit_n (wrepr U32 n) i = false. *) +(* - rewrite -(Nat2Z.id i). *) +(* apply: (wbit_higher_bits_0 (n := 16) _ _) => //=. *) +(* move: hi => /ZNltP hi. *) +(* move: hrangei => /ZNleP /= h. *) +(* lia. *) + +(* rewrite wandE. *) +(* rewrite wrepr_m1 wbit_zero_extend. *) +(* rewrite wN1E. *) +(* rewrite hi /=. *) +(* by rewrite !andbF. *) +(* Qed. *) + +Lemma worC sz : commutative (@wor sz). +Proof. + by move => x y; apply/eqP/eq_from_wbit => i; + rewrite /wor !mathcomp.word.word.worE orbC. +Qed. + +Lemma wor0 sz (x: word sz) : wor 0 x = x. +Proof. by apply/eqP/eq_from_wbit. Qed. + +Lemma wor_xx sz (x: word sz) : wor x x = x. +Proof. by apply/eqP/eq_from_wbit; rewrite /= Z.lor_diag. Qed. + +Lemma wxor0 sz (x: word sz) : wxor 0 x = x. +Proof. by apply/eqP/eq_from_wbit. Qed. + +Lemma wxor_xx sz (x: word sz) : wxor x x = 0%R. +Proof. by apply/eqP/eq_from_wbit; rewrite /= Z.lxor_nilpotent. Qed. + +Lemma wmulE sz (x y: word sz) : (x * y)%R = wrepr sz (wunsigned x * wunsigned y). +Proof. by rewrite /wunsigned /wrepr; apply: word_ext. Qed. + +(* Lemma wror0 sz (w : word sz) : wror w 0 = w. *) +(* Proof. *) +(* rewrite /wror. *) +(* rewrite wshr0. *) +(* rewrite Zmod_0_l Z.sub_0_r. *) +(* rewrite wshl_full. *) +(* by rewrite worC wor0. *) +(* Qed. *) + +Lemma wrol0 sz (w : word sz) : wrol w 0 = w. +Proof. + rewrite /wrol. + rewrite wshl0. + rewrite Zmod_0_l Z.sub_0_r. + rewrite wshr_full. + by rewrite worC wor0. +Qed. + +(* Lemma wadd_zero_extend sz sz' (x y: word sz') : *) +(* (sz ≤ sz')%CMP -> *) +(* zero_extend sz (x + y) = (zero_extend sz x + zero_extend sz y)%R. *) +(* Proof. *) +(* move => hle; apply: word_ext. *) +(* rewrite /wrepr !mkwordK -Zplus_mod. *) +(* rewrite /wunsigned /urepr /=. *) +(* change (x + y)%R with (add_word x y). *) +(* rewrite /add_word /= /urepr /=. *) +(* case: (modulus_m (wsize_size_m hle)) => n -> {hle}. *) +(* by rewrite mod_pq_mod_q. *) +(* Qed. *) + +(* Lemma wmul_zero_extend sz sz' (x y: word sz') : *) +(* (sz ≤ sz')%CMP -> *) +(* zero_extend sz (x * y) = (zero_extend sz x * zero_extend sz y)%R. *) +(* Proof. *) +(* move => hle; apply: word_ext. *) +(* rewrite /wrepr !mkwordK -Zmult_mod. *) +(* rewrite /wunsigned /urepr /=. *) +(* change (x * y)%R with (mul_word x y). *) +(* rewrite /mul_word /= /urepr /=. *) +(* case: (modulus_m (wsize_size_m hle)) => n -> {hle}. *) +(* by rewrite mod_pq_mod_q. *) +(* Qed. *) + +(* Lemma zero_extend_m1 sz sz' : *) +(* (sz ≤ sz')%CMP -> *) +(* @zero_extend sz sz' (-1) = (-1)%R. *) +(* Proof. exact: zero_extend_wrepr. Qed. *) + +(* Lemma wopp_zero_extend sz sz' (x: word sz') : *) +(* (sz ≤ sz')%CMP -> *) +(* zero_extend sz (-x) = (- zero_extend sz x)%R. *) +(* Proof. *) +(* by move=> hsz; rewrite -(mulN1r x) wmul_zero_extend // zero_extend_m1 // mulN1r. *) +(* Qed. *) + +(* Lemma wsub_zero_extend sz sz' (x y : word sz'): *) +(* (sz ≤ sz')%CMP -> *) +(* zero_extend sz (x - y) = (zero_extend sz x - zero_extend sz y)%R. *) +(* Proof. *) +(* by move=> hsz; rewrite wadd_zero_extend // wopp_zero_extend. *) +(* Qed. *) + +(* Lemma zero_extend_wshl sz sz' (x: word sz') c : *) +(* (sz ≤ sz')%CMP -> *) +(* 0 <= c -> *) +(* zero_extend sz (wshl x c) = wshl (zero_extend sz x) c. *) +(* Proof. *) +(* move => hle hc; apply/eqP/eq_from_wbit_n => i. *) +(* rewrite !(wbit_zero_extend, wshlE) //. *) +(* have := wsize_size_m hle. *) +(* move: i. *) +(* set m := wsize_size_minus_1 _. *) +(* set m' := wsize_size_minus_1 _. *) +(* case => i /= /leP hi hm. *) +(* have him : (i <= m)%nat by apply/leP; lia. *) +(* rewrite him andbT /=. *) +(* have him' : (i <= m')%nat by apply/leP; lia. *) +(* rewrite him' andbT. *) +(* case: leP => //= hci. *) +(* have -> // : (i - Z.to_nat c <= m)%nat. *) +(* apply/leP; rewrite /subn /subn_rec; lia. *) +(* Qed. *) + +Lemma wand_zero_extend sz sz' (x y: word sz') : + (sz ≤ sz')%CMP -> + wand (zero_extend sz x) (zero_extend sz y) = zero_extend sz (wand x y). +Proof. +move => hle. +apply/eqP/eq_from_wbit_n => i. +rewrite !(wbit_zero_extend, wandE). +by case: (_ <= _)%nat. +Qed. + +Lemma wor_zero_extend sz sz' (x y : word sz') : + (sz <= sz')%CMP + -> wor (zero_extend sz x) (zero_extend sz y) = zero_extend sz (wor x y). +Proof. + move=> hws. + apply/eqP. + apply/eq_from_wbit_n. + move=> i. + rewrite !(wbit_zero_extend, worE). + by case: (_ <= _)%nat. +Qed. + +Lemma wxor_zero_extend sz sz' (x y: word sz') : + (sz ≤ sz')%CMP -> + wxor (zero_extend sz x) (zero_extend sz y) = zero_extend sz (wxor x y). +Proof. +move => hle. +apply/eqP/eq_from_wbit_n => i. +rewrite !(wbit_zero_extend, wxorE). +by case: (_ <= _)%nat. +Qed. + +(* Lemma wnot_zero_extend sz sz' (x : word sz') : *) +(* (sz ≤ sz')%CMP -> *) +(* wnot (zero_extend sz x) = zero_extend sz (wnot x). *) +(* Proof. *) +(* move => hle. *) +(* apply/eqP/eq_from_wbit_n => i. *) +(* rewrite !(wbit_zero_extend, wnotE). *) +(* have := wsize_size_m hle. *) +(* move: i. *) +(* set m := wsize_size_minus_1 _. *) +(* set m' := wsize_size_minus_1 _. *) +(* case => i /= /leP hi hm. *) +(* have him : (i <= m)%nat. by apply/leP; lia. *) +(* rewrite him /=. *) +(* have hi' : (i < m'.+1)%nat. apply /ltP. lia. *) +(* by have /= -> := @wnotE sz' x (Ordinal hi') . *) +(* Qed. *) + + +(* -------------------------------------------------------------------*) + +(* Lemma wleuE sz (w1 w2: word sz) : *) +(* (wunsigned (w2 - w1) == (wunsigned w2 - wunsigned w1))%Z = wle Unsigned w1 w2. *) +(* Proof. by rewrite /= leNgt wltuE negbK. Qed. *) + +(* Lemma wleuE' sz (w1 w2 : word sz) : *) +(* (wunsigned (w1 - w2) != (wunsigned w1 - wunsigned w2)%Z) || (w1 == w2) *) +(* = wle Unsigned w1 w2. *) +(* Proof. by rewrite -wltuE /= le_eqVlt orbC. Qed. *) + +(* Lemma wltsE_aux sz (α β: word sz) : α <> β -> *) +(* wlt Signed α β = (msb (α - β) != (wsigned (α - β) != (wsigned α - wsigned β)%Z)). *) +(* Proof. *) +(* move=> ne_ab; rewrite /= !msb_wordE /wsigned /srepr. *) +(* rewrite !mathcomp.word.word.msbE /= !subZE; set w := (_ sz); *) +(* case: (lerP (modulus _) (val α)) => ha; *) +(* case: (lerP (modulus _) (val β)) => hb; *) +(* case: (lerP (modulus _) (val _)) => hab. *) +(* + rewrite ltrD2r eq_sym eqb_id negbK opprB !addrA subrK. *) +(* rewrite [val (α - β)%R]subw_modE /urepr /= -/w. *) +(* case: ltrP; first by rewrite addrK eqxx. *) +(* by rewrite addr0 lt_eqF // ltrBlDr ltrDl modulus_gt0. *) +(* + rewrite ltrD2r opprB !addrA subrK eq_sym eqbF_neg negbK. *) +(* rewrite [val (α - β)%R]subw_modE /urepr -/w /=; case: ltrP. *) +(* + by rewrite mulr1n gt_eqF // ltrDl modulus_gt0. *) +(* + by rewrite addr0 eqxx. *) +(* + rewrite ltrBlDr (lt_le_trans (urepr_ltmod _)); last first. *) +(* by rewrite lerDr urepr_ge0. *) +(* rewrite eq_sym eqb_id negbK; apply/esym. *) +(* rewrite [val _]subw_modE /urepr -/w /= ltNge ltW /=. *) +(* * by rewrite addr0 addrAC eqxx. *) +(* * by rewrite (lt_le_trans hb). *) +(* + rewrite ltrBlDr (lt_le_trans (urepr_ltmod _)); last first. *) +(* by rewrite lerDr urepr_ge0. *) +(* rewrite eq_sym eqbF_neg negbK [val _]subw_modE /urepr -/w /=. *) +(* rewrite ltNge ltW ?addr0; last first. *) +(* by rewrite (lt_le_trans hb). *) +(* by rewrite addrAC gt_eqF // ltrBlDr ltrDl modulus_gt0. *) +(* + rewrite ltrBrDl ltNge ltW /=; last first. *) +(* by rewrite (lt_le_trans (urepr_ltmod _)) // lerDl urepr_ge0. *) +(* apply/esym/negbTE; rewrite negbK; apply/eqP/esym. *) +(* rewrite [val _]subw_modE /urepr /= -/w; have ->/=: (val α < val β)%R. *) +(* by have := ltr_leD ha hb; rewrite addrC ltrD2l. *) +(* rewrite mulr1n addrK opprD addrA lt_eqF //= opprK. *) +(* by rewrite ltrDl modulus_gt0. *) +(* + rewrite ltrBrDl ltNge ltW /=; last first. *) +(* by rewrite (lt_le_trans (urepr_ltmod _)) // lerDl urepr_ge0. *) +(* apply/esym/negbTE; rewrite negbK eq_sym eqbF_neg negbK. *) +(* rewrite [val _]subw_modE /urepr -/w /= opprD addrA opprK. *) +(* by have ->//: (val α < val β)%R; apply/(lt_le_trans ha). *) +(* + rewrite [val (α - β)%R](subw_modE α β) -/w /urepr /=. *) +(* rewrite eq_sym eqb_id negbK; case: ltrP. *) +(* * by rewrite mulr1n addrK eqxx. *) +(* * by rewrite addr0 lt_eqF // ltrBlDr ltrDl modulus_gt0. *) +(* + rewrite [val (α - β)%R](subw_modE α β) -/w /urepr /=. *) +(* rewrite eq_sym eqbF_neg negbK; case: ltrP. *) +(* * by rewrite mulr1n gt_eqF // ltrDl modulus_gt0. *) +(* * by rewrite addr0 eqxx. *) +(* Qed. *) + +Section WCMPE. + +#[local] +Notation wle_msb x y := + (msb (x - y) == (wsigned (x - y) != (wsigned x - wsigned y)%Z)) + (only parsing, x in scope ring_scope, y in scope ring_scope). + +#[local] +Notation wlt_msb x y := (~~ wle_msb x y) (only parsing). + +(* Lemma wltsE ws (x y : word ws) : *) +(* wlt_msb x y = wlt Signed x y. *) +(* Proof. *) +(* case: (x =P y) => [<- | ?]; last by rewrite wltsE_aux. *) +(* by rewrite /= ltxx GRing.subrr Z.sub_diag wsigned0 msb0. *) +(* Qed. *) + +(* Lemma wlesE ws (x y : word ws) : *) +(* wle_msb x y = wle Signed y x. *) +(* Proof. by rewrite -[_ == _]negbK wltsE /= leNgt. Qed. *) + +(* Lemma wltsE' ws (x y : word ws): *) +(* ((x != y) && wle_msb x y) = wlt Signed y x. *) +(* Proof. *) +(* by rewrite wlesE /= lt_def eqtype.inj_eq; last exact: word.srepr_inj. *) +(* Qed. *) + +(* Lemma wlesE' ws (x y : word ws) : *) +(* ((x == y) || wlt_msb x y) = wle Signed x y. *) +(* Proof. by rewrite -[_ || _]negbK negb_or negbK wltsE' /= leNgt. Qed. *) + +End WCMPE. + +(* -------------------------------------------------------------------*) +Lemma wdwordu0 sz (w:word sz) : wdwordu 0 w = wunsigned w. +Proof. done. Qed. + +Lemma wdwords0 sz (w:word sz) : + wdwords (if msb w then (-1)%R else 0%R) w = wsigned w. +Proof. + rewrite wsignedE /wdwords; case: msb; rewrite ?wsigned0 ?wsignedN1; ring. +Qed. + +(* -------------------------------------------------------------------*) +Lemma lsr0 n (w: n.-word) : lsr w 0 = w. +Proof. by rewrite /lsr Z.shiftr_0_r ureprK. Qed. + +Lemma subword0 (ws ws' :wsize) (w: word ws') : + mathcomp.word.word.subword 0 ws w = zero_extend ws w. +Proof. + apply/eqP/eq_from_wbit_n => i. + rewrite wbit_zero_extend. + have := ltn_ord i. + rewrite ltnS => -> /=. + rewrite /subword lsr0. + rewrite {1}/wbit_n /wunsigned mkwordK. + rewrite /mathcomp.word.word.wbit /modulus two_power_nat_equiv. + rewrite Z.mod_pow2_bits_low //. + have /leP := ltn_ord i. + lia. +Qed. + +(* -------------------------------------------------------------------*) +Definition check_scale (s:Z) := + (s == 1%Z) || (s == 2%Z) || (s == 4%Z) || (s == 8%Z). + +(* -------------------------------------------------------------------*) +Definition mask_word (sz:wsize) : u64 := + match sz with + | U8 | U16 => wshl (-1)%R (wsize_bits sz) + | _ => 0%R + end. + +Definition merge_word (wr: u64) (sz:wsize) (w:word sz) := + wxor (wand (mask_word sz) wr) (zero_extend U64 w). + +(* -------------------------------------------------------------------*) +Definition split_vec {sz} ve (w : word sz) := + let wsz := (sz %/ ve + sz %% ve)%nat in + [seq subword (i * ve)%nat ve w | i <- iota 0 wsz]. + +Definition make_vec {sz} sz' (s : seq (word sz)) := + wrepr sz' (wcat_r s). + +Lemma make_vec_split_vec sz w : + make_vec sz (split_vec U8 w) = w. +Proof. +have mod0: sz %% U8 = 0%nat by case: {+}sz. +have sz_even: sz = (U8 * (sz %/ U8))%nat :> nat. ++ by rewrite [LHS](divn_eq _ U8) mod0 addn0 mulnC. +rewrite /make_vec /split_vec mod0 addn0; set s := map _ _. +pose wt := (ecast ws (ws.-word) sz_even w). +pose t := [tuple subword (i * U8) U8 wt | i < sz %/ U8]. +have eq_st: wcat_r s = wcat t. ++ rewrite {}/s {}/t /=; pose F i := subword (i * U8) U8 wt. + rewrite (map_comp F val) val_enum_ord {}/F. + congr wcat_r; apply/eq_map => i; apply/eqP/eq_from_wbit. + move=> j; rewrite !subwordE; congr (mathcomp.word.word.wbit (t2w _) _). + apply/val_eqP/eqP => /=; apply/eq_map=> k. + suff ->: val wt = val w by done. + by rewrite {}/wt; case: _ / sz_even. +rewrite {}eq_st wcat_subwordK {s t}/wt; case: _ / sz_even. +by rewrite /wrepr /= ureprK. +Qed. + +Lemma mkwordI n x y : + (0 <= x < modulus n)%R -> + (0 <= y < modulus n)%R -> + mkword n x = mkword n y -> x = y. +Proof. +by case/andP => /ZleP ? /ZltP ? /andP[] /ZleP ? /ZltP ? []; + rewrite !Z.mod_small. +Qed. + +(* -------------------------------------------------------------------*) +Definition lift1_vec' ve ve' (op : word ve -> word ve') + (sz sz': wsize) (w: word sz) : word sz' := + make_vec sz' (map op (split_vec ve w)). + +Definition lift1_vec ve (op : word ve -> word ve) + (sz:wsize) (w:word sz) : word sz := + lift1_vec' op sz w. +Arguments lift1_vec : clear implicits. + +Definition lift2_vec ve (op : word ve -> word ve -> word ve) + (sz:wsize) (w1 w2:word sz) : word sz := + make_vec sz (map2 op (split_vec ve w1) (split_vec ve w2)). +Arguments lift2_vec : clear implicits. + +(* -------------------------------------------------------------------*) +Definition wbswap sz (w: word sz) : word sz := + make_vec sz (rev (split_vec U8 w)). + +(* -------------------------------------------------------------------*) +Definition popcnt sz (w: word sz) := + wrepr sz (count id (w2t w)). + +(* -------------------------------------------------------------------*) +Definition pextr sz (w1 w2: word sz) := + wrepr sz (t2w (in_tuple (mask (w2t w2) (w2t w1)))). + +(* -------------------------------------------------------------------*) + +Fixpoint bitpdep sz (w:word sz) (i:nat) (mask:bitseq) := + match mask with + | [::] => [::] + | b :: mask => + if b then wbit_n w i :: bitpdep w (i.+1) mask + else false :: bitpdep w i mask + end. + +Definition pdep sz (w1 w2: word sz) := + wrepr sz (t2w (in_tuple (bitpdep w1 0 (w2t w2)))). + +(* -------------------------------------------------------------------*) + +Fixpoint leading_zero_aux (n : Z) (res sz : nat) : nat := + if (n O + | S res' => leading_zero_aux n res' sz + end. + +Definition leading_zero (sz : wsize) (w : word sz) : word sz := + wrepr sz (leading_zero_aux (wunsigned w) sz sz). + +(* -------------------------------------------------------------------*) +Definition halve_list A : seq A -> seq A := + fix loop m := if m is a :: _ :: m' then a :: loop m' else m. + +Definition wpmul sz (x y: word sz) : word sz := + let xs := halve_list (split_vec U32 x) in + let ys := halve_list (split_vec U32 y) in + let f (a b: u32) : u64 := wrepr U64 (wsigned a * wsigned b) in + make_vec sz (map2 f xs ys). + +Definition wpmulu sz (x y: word sz) : word sz := + let xs := halve_list (split_vec U32 x) in + let ys := halve_list (split_vec U32 y) in + let f (a b: u32) : u64 := wrepr U64 (wunsigned a * wunsigned b) in + make_vec sz (map2 f xs ys). + +(* -------------------------------------------------------------------*) +Definition wpshufb1 (s : seq u8) (idx : u8) := + if msb idx then 0%R else + let off := wunsigned (wand idx (wshl 1 4%Z - 1)) in + (s`_(Z.to_nat off))%R. + +Definition wpshufb (sz: wsize) (w idx: word sz) : word sz := + let s := split_vec 8 w in + let i := split_vec 8 idx in + let r := map (wpshufb1 s) i in + make_vec sz r. + +(* -------------------------------------------------------------------*) +Definition wpshufd1 (s : u128) (o : u8) (i : nat) := + subword 0 32 (wshr s (32 * urepr (subword (2 * i) 2 o))). + +Definition wpshufd_128 (s : u128) (o : Z) : u128 := + let o := wrepr U8 o in + let d := [seq wpshufd1 s o i | i <- iota 0 4] in + wrepr U128 (wcat_r d). + +Definition wpshufd_256 (s : u256) (o : Z) : u256 := + make_vec U256 (map (fun w => wpshufd_128 w o) (split_vec U128 s)). + +Definition wpshufd sz : word sz -> Z -> word sz := + match sz with + | U128 => wpshufd_128 + | U256 => wpshufd_256 + | _ => fun w _ => w end. + +(* -------------------------------------------------------------------*) + +Definition wpshufl_u64 (w:u64) (z:Z) : u64 := + let v := split_vec U16 w in + let j := split_vec 2 (wrepr U8 z) in + make_vec U64 (map (fun n => v`_(Z.to_nat (urepr n)))%R j). + +Definition wpshufl_u128 (w:u128) (z:Z) := + match split_vec 64 w with + | [::l;h] => make_vec U128 [::wpshufl_u64 l z; (h:u64)] + | _ => w + end. + +Definition wpshufh_u128 (w:u128) (z:Z) := + match split_vec 64 w with + | [::l;h] => make_vec U128 [::(l:u64); wpshufl_u64 h z] + | _ => w + end. + +Definition wpshufl_u256 (s:u256) (z:Z) := + make_vec U256 (map (fun w => wpshufl_u128 w z) (split_vec U128 s)). + +Definition wpshufh_u256 (s:u256) (z:Z) := + make_vec U256 (map (fun w => wpshufh_u128 w z) (split_vec U128 s)). + +Definition wpshuflw sz : word sz -> Z -> word sz := + match sz with + | U128 => wpshufl_u128 + | U256 => wpshufl_u256 + | _ => fun w _ => w end. + +Definition wpshufhw sz : word sz -> Z -> word sz := + match sz with + | U128 => wpshufh_u128 + | U256 => wpshufh_u256 + | _ => fun w _ => w end. + +(* -------------------------------------------------------------------*) + +(*Section UNPCK. + (* Interleaves two even-sized lists. *) + Context (T: Type). + Fixpoint unpck (qs xs ys: seq T) : seq T := + match xs, ys with + | [::], _ | _, [::] + | [:: _], _ | _, [:: _] + => qs + | x :: _ :: xs', y :: _ :: ys' => unpck (x :: y :: qs) xs' ys' + end. +End UNPCK. + +Definition wpunpckl sz (ve: velem) (x y: word sz) : word sz := + let xv := split_vec ve x in + let yv := split_vec ve y in + let zv := unpck [::] xv yv in + make_vec sz (rev zv). + +Definition wpunpckh sz (ve: velem) (x y: word sz) : word sz := + let xv := split_vec ve x in + let yv := split_vec ve y in + let zv := unpck [::] (rev xv) (rev yv) in + make_vec sz zv. +*) + +Fixpoint interleave {A:Type} (l1 l2: list A) := + match l1, l2 with + | [::], _ => l2 + | _, [::] => l1 + | a1::l1, a2::l2 => a1::a2::interleave l1 l2 + end. + +Definition interleave_gen (get:u128 -> u64) (ve:velem) (src1 src2: u128) := + let ve : nat := wsize_of_velem ve in + let l1 := split_vec ve (get src1) in + let l2 := split_vec ve (get src2) in + make_vec U128 (interleave l1 l2). + +Definition wpunpckl_128 := interleave_gen (subword 0 64). + +Definition wpunpckl_256 ve (src1 src2 : u256) := + make_vec U256 + (map2 (wpunpckl_128 ve) (split_vec U128 src1) (split_vec U128 src2)). + +Definition wpunpckh_128 := interleave_gen (subword 64 64). + +Definition wpunpckh_256 ve (src1 src2 : u256) := + make_vec U256 + (map2 (wpunpckh_128 ve) (split_vec U128 src1) (split_vec U128 src2)). + +Definition wpunpckl (sz:wsize) : velem -> word sz -> word sz -> word sz := + match sz with + | U128 => wpunpckl_128 + | U256 => wpunpckl_256 + | _ => fun ve w1 w2 => w1 + end. + +Definition wpunpckh (sz:wsize) : velem -> word sz -> word sz -> word sz := + match sz with + | U128 => wpunpckh_128 + | U256 => wpunpckh_256 + | _ => fun ve w1 w2 => w1 + end. + +(* -------------------------------------------------------------------*) +Section UPDATE_AT. + Context (T: Type) (t: T). + + Fixpoint update_at (xs: seq T) (i: nat) : seq T := + match xs with + | [::] => [::] + | x :: xs' => if i is S i' then x :: update_at xs' i' else t :: xs' + end. + +End UPDATE_AT. + +Definition wpinsr ve (v: u128) (w: word ve) (i: u8) : u128 := + let v := split_vec ve v in + let i := Z.to_nat (wunsigned i) in + make_vec U128 (update_at w v i). + +(* -------------------------------------------------------------------*) +Definition winserti128 (v: u256) (w: u128) (i: u8) : u256 := + let v := split_vec U128 v in + make_vec U256 (if lsb i then [:: v`_0 ; w ] else [:: w ; v`_1 ])%R. + +(* -------------------------------------------------------------------*) +Definition wpblendd sz (w1 w2: word sz) (m: u8) : word sz := + let v1 := split_vec U32 w1 in + let v2 := split_vec U32 w2 in + let b := split_vec 1 m in + let r := map3 (fun b v1 v2 => if b == 1%R then v2 else v1) b v1 v2 in + make_vec sz r. + +(* -------------------------------------------------------------------*) +Definition wpbroadcast ve sz (w: word ve) : word sz := + let r := nseq (sz %/ ve) w in + make_vec sz r. + +Lemma wpbroadcast0 ve sz : + @wpbroadcast ve sz 0%R = 0%R. +Proof. + rewrite /wpbroadcast/make_vec. + suff -> : wcat_r (nseq _ 0%R) = 0. + - by rewrite wrepr0. + by move => q; elim => // n /= ->; rewrite Z.shiftl_0_l. +Qed. + +(* -------------------------------------------------------------------*) +Fixpoint seq_dup_hi T (m: seq T) : seq T := + if m is _ :: a :: m' then a :: a :: seq_dup_hi m' else [::]. + +Fixpoint seq_dup_lo T (m: seq T) : seq T := + if m is a :: _ :: m' then a :: a :: seq_dup_lo m' else [::]. + +Definition wdup_hi ve sz (w: word sz) : word sz := + let v : seq (word ve) := split_vec ve w in + make_vec sz (seq_dup_hi v). + +Definition wdup_lo ve sz (w: word sz) : word sz := + let v : seq (word ve) := split_vec ve w in + make_vec sz (seq_dup_lo v). + +(* -------------------------------------------------------------------*) +Definition wperm2i128 (w1 w2: u256) (i: u8) : u256 := + let choose (n: nat) := + match urepr (subword n 2 i) with + | 0 => subword 0 U128 w1 + | 1 => subword U128 U128 w1 + | 2 => subword 0 U128 w2 + | _ => subword U128 U128 w2 + end in + let lo := if wbit_n i 3 then 0%R else choose 0%nat in + let hi := if wbit_n i 7 then 0%R else choose 4%nat in + make_vec U256 [:: lo ; hi ]. + +(* -------------------------------------------------------------------*) +Definition wpermd1 (v: seq u32) (idx: u32) := + let off := wunsigned idx mod 8 in + (v`_(Z.to_nat off))%R. + +Definition wpermd sz (idx w: word sz) : word sz := + let v := split_vec U32 w in + let i := split_vec U32 idx in + make_vec sz (map (wpermd1 v) i). + +(* -------------------------------------------------------------------*) +Definition wpermq (w: u256) (i: u8) : u256 := + let v := split_vec U64 w in + let j := split_vec 2 i in + make_vec U256 (map (fun n => v`_(Z.to_nat (urepr n)))%R j). + +(* -------------------------------------------------------------------*) +Definition wpsxldq op sz (w: word sz) (i: u8) : word sz := + let n : Z := (Z.min 16 (wunsigned i)) * 8 in + lift1_vec U128 (fun w => op w n) sz w. + +Definition wpslldq := wpsxldq (@wshl _). +Definition wpsrldq := wpsxldq (@wshr _). + +(* -------------------------------------------------------------------*) +Definition wpcmps1 (cmp: Z -> Z -> bool) ve (x y: word ve) : word ve := + if cmp (wsigned x) (wsigned y) then (-1)%R else 0%R. +Arguments wpcmps1 cmp {ve} _ _. + +Definition wpcmpeq ve sz (w1 w2: word sz) : word sz := + lift2_vec ve (wpcmps1 Z.eqb) sz w1 w2. + +Definition wpcmpgt ve sz (w1 w2: word sz) : word sz := + lift2_vec ve (wpcmps1 Z.gtb) sz w1 w2. + +(* -------------------------------------------------------------------*) +Definition wminmax1 ve (cmp : word ve -> word ve -> bool) (x y : word ve) : word ve := + if cmp x y then x else y. + +Definition wmin sg ve sz (x y : word sz) := + lift2_vec ve (wminmax1 (wlt sg)) sz x y. + +Definition wmax sg ve sz (x y : word sz) := + lift2_vec ve (wminmax1 (fun u v => wlt sg v u)) sz x y. + +(* -------------------------------------------------------------------*) +Definition saturated_signed (sz: wsize) (x: Z): Z := + Z.max (wmin_signed sz) (Z.min (wmax_signed sz) x). + +Definition wrepr_saturated_signed (sz: wsize) (x: Z) : word sz := + wrepr sz (saturated_signed sz x). + +Fixpoint add_pairs (m: seq Z) : seq Z := + if m is x :: y :: z then x + y :: add_pairs z + else [::]. + +Definition wpmaddubsw sz (v1 v2: word sz) : word sz := + let w1 := map wunsigned (split_vec U8 v1) in + let w2 := map wsigned (split_vec U8 v2) in + let result := [seq wrepr_saturated_signed U16 z | z <- add_pairs (map2 *%R w1 w2) ] in + make_vec sz result. + +Definition wpmaddwd sz (v1 v2: word sz) : word sz := + let w1 := map wsigned (split_vec U16 v1) in + let w2 := map wsigned (split_vec U16 v2) in + let result := [seq wrepr U32 z | z <- add_pairs (map2 *%R w1 w2) ] in + make_vec sz result. + +(* Test case from the documentation: VPMADDWD wraps when all inputs are min-signed *) +Local Lemma test_wpmaddwd_wraps : + let: s16 := wrepr U16 (wmin_signed U16) in + let: s32 := make_vec U32 [:: s16 ; s16 ] in + let: res := wpmaddwd s32 s32 in + let: expected := wrepr U32 (wmin_signed U32) in + res = expected. +Proof. vm_compute. by apply/eqP. Qed. + +(* -------------------------------------------------------------------*) +Definition wpack sz pe (arg: seq Z) : word sz := + let w := map (mathcomp.word.word.mkword pe) arg in + wrepr sz (word.wcat_r w). + +(* -------------------------------------------------------------------*) +Definition wpmovmskb (dsz ssz: wsize) (w : word ssz) : word dsz := + wrepr dsz (t2w_def [tuple of map msb (split_vec U8 w)]). + +(* -------------------------------------------------------------------*) +Definition wpblendvb sz (w1 w2 m: word sz): word sz := + let v1 := split_vec U8 w1 in + let v2 := split_vec U8 w2 in + let b := map msb (split_vec U8 m) in + let r := map3 (fun bi v1i v2i => if bi then v2i else v1i) b v1 v2 in + make_vec sz r. + +(* -------------------------------------------------------------------*) +Lemma pow2pos q : 0 < 2 ^ Z.of_nat q. +Proof. by rewrite -two_power_nat_equiv. Qed. + +Lemma pow2nz q : 2 ^ Z.of_nat q <> 0. +Proof. have := pow2pos q; lia. Qed. + +Lemma wbit_n_pow2m1 sz (n i: nat) : + wbit_n (wrepr sz (2 ^ Z.of_nat n - 1)) i = (i < Nat.min n (wsize_size_minus_1 sz).+1)%nat. +Proof. + rewrite /wbit_n /mathcomp.word.word.wbit wunsigned_repr /modulus two_power_nat_equiv. + case: (le_lt_dec (wsize_size_minus_1 sz).+1 i) => hi. + - rewrite Z.mod_pow2_bits_high; last lia. + symmetry; apply/negbTE/negP => /ltP. + lia. + rewrite Z.mod_pow2_bits_low; last lia. + rewrite /Z.sub -/(Z.pred (2 ^ Z.of_nat n)) -Z.ones_equiv. + case: ltP => i_n. + - apply: Z.ones_spec_low; lia. + apply: Z.ones_spec_high; lia. +Qed. + +Lemma wand_pow2nm1 sz (x: word sz) n : + let: k := ((wsize_size_minus_1 sz).+1 - n)%nat in + wand x (wrepr sz (2 ^ Z.of_nat n - 1)) = wshr (wshl x (Z.of_nat k)) (Z.of_nat k). +Proof. + set k := (_ - _)%nat. + have k_ge0 := Nat2Z.is_nonneg k. + apply/eqP/eq_from_wbit_n => i. + rewrite wandE wshrE // wshlE // wbit_n_pow2m1. + have := ltn_ord i. + move: (nat_of_ord i) => {i} i i_bounded. + replace (i < _)%nat with (i < n)%nat; last first. + - apply Nat.min_case_strong => // n_large. + rewrite i_bounded. + apply/ltP. + move/ltP: i_bounded. + Psatz.lia. + move: i_bounded. + subst k. + move: (wsize_size_minus_1 _) => w. + rewrite ltnS => /leP i_bounded. + rewrite Nat2Z.id. + case: ltP => i_n. + - rewrite (andbC (_ && _)); congr andb. + + congr (wbit_n x); lia. + symmetry; apply/andP; split; apply/leP; lia. + rewrite andbF. + replace (w.+1 - n + i <= w)%nat with false; first by rewrite andbF. + symmetry; apply/leP. + lia. +Qed. + +Section FORALL_NAT_BELOW. + Context (P: nat -> bool). + + Fixpoint forallnat_below (n: nat) : bool := + if n is S n' then if P n' then forallnat_below n' else false else true. + + Lemma forallnat_belowP n : + reflect (forall i, (i < n)%coq_nat -> P i) (forallnat_below n). + Proof. + elim: n. + - by constructor => i /Nat.nlt_0_r. + move => n ih /=; case hn: P; last first. + - constructor => /(_ n (Nat.lt_succ_diag_r n)). + by rewrite hn. + case: ih => ih; constructor. + - move => i i_le_n. + case: (i =P n); first by move => ->. + move => i_neq_n; apply: ih; lia. + move => K; apply: ih => i i_lt_n; apply: K; lia. + Qed. + +End FORALL_NAT_BELOW. + +(* Lemma wbit_n_Npow2n sz n (i: 'I_(wsize_size_minus_1 sz).+1) : *) +(* wbit_n (wrepr sz (-2 ^ Z.of_nat n)) i = (n <= i)%nat. *) +(* Proof. *) +(* move: (i: nat) (ltn_ord i) => {i} i /ltP i_bounded. *) +(* case: (@ltP n (wsize_size_minus_1 sz).+1) => hn. *) +(* + apply/eqP. *) +(* apply/forallnat_belowP: i i_bounded. *) +(* change ( *) +(* let k := wrepr sz (- 2 ^ Z.of_nat n) in *) +(* forallnat_below (fun i : nat => wbit_n k i == (n <= i)%nat) (wsize_size_minus_1 sz).+1 *) +(* ). *) +(* apply/forallnat_belowP: n hn. *) +(* by case: sz; vm_cast_no_check (erefl true). *) +(* replace (wrepr _ _) with (0%R : word sz). *) +(* rewrite w0E; symmetry; apply/leP; lia. *) +(* rewrite wrepr_opp -oppr0. *) +(* congr (-_)%R. *) +(* apply/word_eqP. *) +(* rewrite mkword_valK. *) +(* apply/eqP; symmetry. *) +(* rewrite /modulus two_power_nat_equiv. *) +(* apply/Z.mod_divide; first exact: pow2nz. *) +(* exists (2 ^ (Z.of_nat (n - (wsize_size_minus_1 sz).+1))). *) +(* rewrite -Z.pow_add_r; *) +(* first congr (2 ^ _). *) +(* all: lia. *) +(* Qed. *) + +(* Lemma wand_Npow2n sz (x: word sz) n : *) +(* wand x (wrepr sz (- 2 ^ Z.of_nat n)) = wshl (wshr x (Z.of_nat n)) (Z.of_nat n). *) +(* Proof. *) +(* apply/eqP/eq_from_wbit_n => i. *) +(* have n_ge0 := Nat2Z.is_nonneg n. *) +(* rewrite wandE wshlE // wshrE // Nat2Z.id wbit_n_Npow2n. *) +(* move: (nat_of_ord i) (ltn_ord i) => {i} i. *) +(* rewrite ltnS => i_bounded. *) +(* rewrite i_bounded andbT andbC. *) +(* case: (@leP n i) => hni //=. *) +(* congr (wbit_n x). *) +(* lia. *) +(* Qed. *) + +Lemma an_mod_bn_divn (a b n: Z) : + n <> 0 -> + a * n mod (b * n) / n = a mod b. +Proof. + by move => nnz; rewrite Zmult_mod_distr_r Z.div_mul. +Qed. + +Lemma wand_modulo sz (x: word sz) n : + wunsigned (wand x (wrepr sz (2 ^ Z.of_nat n - 1))) = wunsigned x mod 2 ^ Z.of_nat n. +Proof. + rewrite wand_pow2nm1 wunsigned_wshr wunsigned_wshl /wbase /modulus two_power_nat_equiv. + case: (@leP n (wsize_size_minus_1 sz).+1); last first. + - move => k_lt_n. + replace (_.+1 - n)%nat with 0%nat by lia. + have [ x_pos x_bounded ] := wunsigned_range x. + rewrite Z.mul_1_r Z.div_1_r !Z.mod_small //; split. + 1, 3: lia. + + apply: Z.lt_trans; first exact: x_bounded. + rewrite /wbase /modulus two_power_nat_equiv. + apply: Z.pow_lt_mono_r; lia. + by rewrite -two_power_nat_equiv. + set k := _.+1. + move => n_le_k. + have := an_mod_bn_divn (wunsigned x) (2 ^ Z.of_nat n) (@pow2nz (k - n)%nat). + rewrite -Z.pow_add_r. + 2-3: lia. + replace (Z.of_nat n + Z.of_nat (k - n)) with (Z.of_nat k) by lia. + done. +Qed. + +Lemma div_mul_in_range a b m : + 0 < b -> + 0 <= a < m -> + 0 <= a / b * b < m. +Proof. + move => b_pos a_range; split. + * suff : 0 <= a / b by Lia.nia. + apply: Z.div_pos; lia. + elim_div; lia. +Qed. + +(* Lemma wand_align sz (x: word sz) n : *) +(* wunsigned (wand x (wrepr sz (-2 ^ Z.of_nat n))) = wunsigned x / 2 ^ Z.of_nat n * 2 ^ Z.of_nat n. *) +(* Proof. *) +(* rewrite wand_Npow2n wunsigned_wshl wunsigned_wshr. *) +(* apply: Z.mod_small. *) +(* apply: div_mul_in_range. *) +(* - exact: pow2pos. *) +(* exact: wunsigned_range. *) +(* Qed. *) + +(* (** Round to the multiple of [sz'] below. *) *) +(* Definition align_word (sz sz': wsize) (p: word sz) : word sz := *) +(* wand p (wrepr sz (-wsize_size sz')). *) + +(* Lemma align_word_U8 sz (p: word sz) : *) +(* align_word U8 p = p. *) +(* Proof. by rewrite /align_word wandC wandN1. Qed. *) + +(* Lemma align_word_aligned (sz sz': wsize) (p: word sz) : *) +(* wunsigned (align_word sz' p) mod wsize_size sz' == 0. *) +(* Proof. *) +(* rewrite /align_word wsize_size_is_pow2 wand_align Z.mod_mul //. *) +(* exact: pow2nz. *) +(* Qed. *) + +(* Lemma align_word_range sz sz' (p: word sz) : *) +(* wunsigned p - wsize_size sz' < wunsigned (align_word sz' p) <= wunsigned p. *) +(* Proof. *) +(* rewrite /align_word wsize_size_is_pow2 wand_align. *) +(* have ? := wunsigned_range p. *) +(* have ? := pow2pos (wsize_log2 sz'). *) +(* elim_div; Psatz.lia. *) +(* Qed. *) + +(* Lemma align_wordE sz sz' (p: word sz) : *) +(* wunsigned (align_word sz' p) = wunsigned p - (wunsigned p mod wsize_size sz'). *) +(* Proof. *) +(* have nz := wsize_size_pos sz'. *) +(* rewrite {1}(Z.div_mod (wunsigned p) (wsize_size sz')); last lia. *) +(* rewrite /align_word wsize_size_is_pow2 wand_align. *) +(* lia. *) +(* Qed. *) + +(* (* ------------------------------------------------------------------------- *) *) +(* Lemma wror_opp sz (x: word sz) c : *) +(* wror x (wsize_bits sz - c) = wrol x c. *) +(* Proof. *) +(* rewrite /wror /wrol. *) +(* have : 0 < wsize_bits sz by []. *) +(* move: (wsize_bits _) (wshr_full x) (wshl_full x) => n R L n_pos. *) +(* have nnz : n ≠ 0 by lia. *) +(* rewrite Zminus_mod Z_mod_same_full Z.sub_0_l. *) +(* have : c mod n = 0 ∨ 0 < c mod n < n. *) +(* - move: (Z.mod_pos_bound c n n_pos); lia. *) +(* case => c_mod_n. *) +(* - by rewrite c_mod_n Z.sub_0_r Zmod_0_l wshr0 wshl0 R L. *) +(* rewrite !Z.mod_opp_l_nz // Zmod_mod; last lia. *) +(* rewrite worC; do 2 f_equal. *) +(* lia. *) +(* Qed. *) + +Lemma wror_m sz (x: word sz) y y' : + y mod wsize_bits sz = y' mod wsize_bits sz -> + wror x y = wror x y'. +Proof. by rewrite /wror => ->. Qed. + +(* ------------------------------------------------------------------------- *) + +Definition word_uincl sz1 sz2 (w1:word sz1) (w2:word sz2) := + (sz1 <= sz2)%CMP && (w1 == zero_extend sz1 w2). + +Lemma word_uincl_refl s (w : word s): word_uincl w w. +Proof. by rewrite /word_uincl zero_extend_u cmp_le_refl eqxx. Qed. +#[global] +Hint Resolve word_uincl_refl : core. + +Lemma word_uincl_eq s (w w': word s): + word_uincl w w' -> w = w'. +Proof. by move=> /andP [] _ /eqP; rewrite zero_extend_u. Qed. + +(* Lemma word_uincl_trans s2 w2 s1 s3 w1 w3 : *) +(* @word_uincl s1 s2 w1 w2 -> @word_uincl s2 s3 w2 w3 -> word_uincl w1 w3. *) +(* Proof. *) +(* rewrite /word_uincl => /andP [hle1 /eqP ->] /andP [hle2 /eqP ->]. *) +(* by rewrite (cmp_le_trans hle1 hle2) zero_extend_idem // eqxx. *) +(* Qed. *) + +Lemma word_uincl_zero_ext sz sz' (w':word sz') : (sz ≤ sz')%CMP -> word_uincl (zero_extend sz w') w'. +Proof. by move=> ?;apply /andP. Qed. + +(* Lemma word_uincl_zero_extR sz sz' (w: word sz) : *) +(* (sz ≤ sz')%CMP -> *) +(* word_uincl w (zero_extend sz' w). *) +(* Proof. *) +(* move => hle; apply /andP; split; first exact: hle. *) +(* by rewrite zero_extend_idem // zero_extend_u. *) +(* Qed. *) + +Lemma truncate_word_uincl sz1 sz2 w1 (w2: word sz2) : + truncate_word sz1 w2 = ok w1 -> word_uincl w1 w2. +Proof. by move=> /truncate_wordP[? ->]; exact: word_uincl_zero_ext. Qed. + +(* Lemma word_uincl_truncate sz1 (w1: word sz1) sz2 (w2: word sz2) sz w: *) +(* word_uincl w1 w2 -> truncate_word sz w1 = ok w -> truncate_word sz w2 = ok w. *) +(* Proof. *) +(* rewrite /word_uincl => /andP[hc1 /eqP ->] /truncate_wordP[hc2 ->]. *) +(* rewrite (zero_extend_idem _ hc2) truncate_word_le //. *) +(* exact: (cmp_le_trans hc2 hc1). *) +(* Qed. *) + +(* -------------------------------------------------------------------- *) +(* TODO_ARM: Move? *) + +Lemma ZlnotE (x : Z) : + Z.lnot x = (- (x + 1))%Z. +Proof. have := Z.add_lnot_diag x. lia. Qed. + +Lemma Zlxor_mod (a b n : Z) : + (0 <= n)%Z + -> ((Z.lxor a b) mod 2^n)%Z = (Z.lxor (a mod 2^n) (b mod 2^n))%Z. +Proof. + move=> hn. + apply: Z.bits_inj'. + move=> i _. + rewrite Z.lxor_spec. + + case: (Z.lt_ge_cases i n) => [hlt | hge]. + - rewrite 3!(Z.mod_pow2_bits_low _ _ _ hlt). exact: Z.lxor_spec. + + have hrange: (0 <= n <= i)%Z. + - by split. + by rewrite 3!(Z.mod_pow2_bits_high _ _ _ hrange). +Qed. + +(* -------------------------------------------------------------------- *) + +Lemma wrepr_xor ws (x y : Z) : + wxor (wrepr ws x) (wrepr ws y) = wrepr ws (Z.lxor x y). +Proof. + apply: word_ext. + rewrite /wrepr /=. + set wsz := (wsize_size_minus_1 ws).+1. + change (word.modulus wsz) with (two_power_nat wsz). + rewrite two_power_nat_equiv. + by rewrite Zlxor_mod. +Qed. + +Lemma wrepr_wnot ws z : + wnot (wrepr ws z) = wrepr ws (Z.lnot z). +Proof. by rewrite /wnot wrepr_xor Z.lxor_m1_r. Qed. + +Lemma wnot_wnot ws (x : word ws) : + wnot (wnot x) = x. +Proof. by rewrite -(wrepr_unsigned x) 2!wrepr_wnot Z.lnot_involutive. Qed. + +Lemma wnotP ws (x : word ws) : + wnot x = wrepr ws (Z.lnot (wunsigned x)). +Proof. by rewrite -{1}(wrepr_unsigned x) wrepr_wnot. Qed. + +Lemma msb_wnot ws (x : word ws) : + msb (wnot x) = ~~ msb x. +Proof. rewrite /msb. by have /= -> := wnotE x (Ordinal (ltnSn _)). Qed. + +(* Lemma wnot1_wopp ws (x : word ws) : *) +(* (wnot x + 1)%R = (- x)%R. *) +(* Proof. *) +(* rewrite wnotP. *) +(* rewrite wrepr_add. *) +(* rewrite wrepr_opp. *) +(* rewrite wrepr_unsigned. *) +(* rewrite wrepr_m1. *) +(* exact: GRing.Theory.addrNK. *) +(* Qed. *) + +(* Lemma wsub_wnot1 ws (x y : word ws) : *) +(* (x + wnot y + 1)%R = (x - y)%R . *) +(* Proof. by rewrite -GRing.Theory.addrA wnot1_wopp. Qed. *) + +Lemma wunsigned_wnot ws (x : word ws) : + wunsigned (wnot x) = (wbase ws - wunsigned x - 1)%Z. +Proof. + rewrite wnotP wunsigned_repr. + change (word.modulus (wsize_size_minus_1 ws).+1) with (wbase ws). + rewrite ZlnotE. + rewrite -(Z.mod_add _ 1 _); last exact: wbase_n0. + rewrite Zmod_small; first lia. + have := wunsigned_range x. + lia. +Qed. + +Lemma wsigned_wnot ws (x : word ws) : + (wsigned (wnot x))%Z = (- wsigned x - 1)%Z. +Proof. + rewrite 2!wsignedE. + rewrite msb_wnot. + case: msb => /=; + rewrite wunsigned_wnot; + lia. +Qed. + +Lemma wsigned_wsub_wnot1 ws (x y : word ws) : + (wsigned x + wsigned (wnot y) + 1)%Z = (wsigned x - wsigned y)%Z. +Proof. rewrite -Z.add_assoc wsigned_wnot. lia. Qed. + +Lemma unsigned_overflow sz (z: Z): + (0 <= z)%Z -> + (wunsigned (wrepr sz z) != z) = (wbase sz <=? z)%Z. +Proof. + move => hz. + rewrite wunsigned_repr; apply/idP/idP. + * apply: contraR => /negbTE /Z.leb_gt lt; apply/eqP. + by rewrite Z.mod_small //; lia. + * apply: contraL => /eqP <-; apply/negbT/Z.leb_gt. + by case: (Z_mod_lt z (wbase sz)). +Qed. + +Lemma add_overflow sz (w1 w2: word sz) : + (wbase sz <=? wunsigned w1 + wunsigned w2)%Z = + (wunsigned (w1 + w2) != (wunsigned w1 + wunsigned w2)%Z). +Proof. + rewrite unsigned_overflow //; rewrite -!/(wunsigned _). + have := wunsigned_range w1; have := wunsigned_range w2. + lia. +Qed. + +Lemma wbit_pow_2 ws n x (i : nat) : + 0 <= n + -> (Z.to_nat n <= i <= wsize_size_minus_1 ws)%nat + -> wbit_n (wrepr ws (2 ^ n * x)) i = wbit_n (wrepr ws x) (i - Z.to_nat n). +Proof. + move=> h0n hrange. + rewrite wrepr_mul. + rewrite -(wshl_sem _ h0n). + rewrite wshlE //. + by rewrite hrange. +Qed. + +(* Notation pointer := (word Uptr) (only parsing). *) + +Lemma subword_make_vec_bits_low (n m : nat) x y : + (n < m)%Z -> + word.subword 0 n (word.mkword m (wcat_r [:: x; y ])) = x. +Proof. + move=> h. + apply/eqP/word.eq_from_wbit => i. + rewrite subwordE wbit_t2wE /word.word.wbit /=. + rewrite (nth_map i); last by rewrite size_enum_ord. + rewrite addn0 nth_ord_enum modulusZE. + rewrite Z.shiftl_0_l Z.lor_0_r. + rewrite Z.mod_pow2_bits_low. + - rewrite Z.lor_spec Z.shiftl_spec_low; first by rewrite orbF. + by apply/ZNltP. + apply: (Z.lt_trans _ _ _ _ h). + by apply/ZNltP. +Qed. + +Lemma Z_lor_le x y ws : + (0 <= x < wbase ws)%Z -> + (0 <= y < wbase ws)%Z -> + (0 <= Z.lor x y < wbase ws)%Z. +Proof. + move=> /iswordZP hx /iswordZP hy. + rewrite -[x]/(urepr (mkWord hx)) -[y]/(urepr (mkWord hy)). + apply/iswordZP. + exact: word.wor_subproof. +Qed. + +(* Lemma make_vec_4x64 (w : word.word U64) : *) +(* make_vec U256 [:: make_vec U128 [:: w; w ]; make_vec U128 [:: w; w ]] *) +(* = make_vec U256 [:: w; w; w; w ]. *) +(* Proof. *) +(* rewrite /make_vec /wcat_r. *) +(* rewrite !Z.shiftl_0_l !Z.lor_0_r. *) +(* f_equal. *) +(* rewrite Z.shiftl_lor. *) +(* rewrite Z.lor_assoc. *) +(* rewrite Z.shiftl_shiftl; last done. *) +(* rewrite -![urepr _]/(wunsigned _). *) +(* rewrite wunsigned_repr_small; first done. *) + +(* have [hw0 hwn] := wunsigned_range w. *) + +(* apply: Z_lor_le. *) +(* - have := @wbase_m U64 U128 refl_equal. Psatz.lia. *) + +(* rewrite Z.shiftl_mul_pow2; last done. *) +(* split; first Psatz.lia. *) +(* rewrite /wbase (modulusD 64 64) modulusE -expZE. *) +(* apply: ltZE; rewrite mulZE !rmorphM/= ltr_pM2r//. *) +(* by rewrite -[ltRHS]/(Z_to_int 18446744073709551616); apply/ltZE. *) +(* Qed. *) + +(******************************) diff --git a/theories/Crypt/jasmin_wsize.v b/theories/Crypt/jasmin_wsize.v new file mode 100644 index 00000000..e31ff2d6 --- /dev/null +++ b/theories/Crypt/jasmin_wsize.v @@ -0,0 +1,107 @@ +(* ** Machine word *) + +(* ** Imports and settings *) + +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra. +From Crypt Require Import jasmin_util. +Require Import (* strings *) ZArith (* utils *). +(* Import Utf8. *) +(* Import word_ssrZ. *) +From mathcomp Require Import word_ssrZ word. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +(* -------------------------------------------------------------- *) +Variant wsize := + | U8 + | U16 + | U32 + | U64 + | U128 + | U256. + +(* Size in bits of the elements of a vector. *) +Variant velem := VE8 | VE16 | VE32 | VE64. + +Coercion wsize_of_velem (ve: velem) : wsize := + match ve with + | VE8 => U8 + | VE16 => U16 + | VE32 => U32 + | VE64 => U64 + end. + +(* Size in bits of the elements of a pack. *) +Variant pelem := +| PE1 | PE2 | PE4 | PE8 | PE16 | PE32 | PE64 | PE128. + +Variant signedness := + | Signed + | Unsigned. + +(* -------------------------------------------------------------------- *) +Scheme Equality for wsize. + +Lemma wsize_axiom : Equality.axiom wsize_beq. +Proof. + exact: (eq_axiom_of_scheme internal_wsize_dec_bl internal_wsize_dec_lb). +Qed. + +HB.instance Definition _ := hasDecEq.Build wsize wsize_axiom. + +Definition wsizes := + [:: U8 ; U16 ; U32 ; U64 ; U128 ; U256 ]. + +Lemma wsize_fin_axiom : Finite.axiom wsizes. +Proof. by case. Qed. + +(* ** Comparison + * -------------------------------------------------------------------- *) +Definition wsize_cmp s s' := + match s, s' with + | U8, U8 => Eq + | U8, (U16 | U32 | U64 | U128 | U256) => Lt + | U16, U8 => Gt + | U16, U16 => Eq + | U16, (U32 | U64 | U128 | U256) => Lt + | U32, (U8 | U16) => Gt + | U32, U32 => Eq + | U32, (U64 | U128 | U256) => Lt + | U64, (U8 | U16 | U32) => Gt + | U64, U64 => Eq + | U64, ( U128 | U256) => Lt + | U128, (U8 | U16 | U32 | U64) => Gt + | U128, U128 => Eq + | U128, U256 => Lt + | U256, (U8 | U16 | U32 | U64 | U128) => Gt + | U256, U256 => Eq + end. + +#[export] +Instance wsizeO : Cmp wsize_cmp. +Proof. + constructor. + + by move=> [] []. + + by move=> [] [] [] //= ? []. + by move=> [] []. +Qed. + +Lemma wsize_le_U8 s: (U8 <= s)%CMP. +Proof. by case: s. Qed. + +Lemma wsize_ge_U256 s: (s <= U256)%CMP. +Proof. by case s. Qed. + +#[global]Hint Resolve wsize_le_U8 wsize_ge_U256: core. + +(* -------------------------------------------------------------------- *) +Definition check_size_8_64 sz := assert (sz ≤ U64)%CMP ErrType. +Definition check_size_8_32 sz := assert (sz ≤ U32)%CMP ErrType. +Definition check_size_16_32 sz := assert ((U16 ≤ sz) && (sz ≤ U32))%CMP ErrType. +Definition check_size_16_64 sz := assert ((U16 ≤ sz) && (sz ≤ U64))%CMP ErrType. +Definition check_size_32_64 sz := assert ((U32 ≤ sz) && (sz ≤ U64))%CMP ErrType. +Definition check_size_128_256 sz := assert ((U128 ≤ sz) && (sz ≤ U256))%CMP ErrType. + diff --git a/theories/Crypt/package/pkg_advantage.v b/theories/Crypt/package/pkg_advantage.v index eab271fd..2914d74c 100644 --- a/theories/Crypt/package/pkg_advantage.v +++ b/theories/Crypt/package/pkg_advantage.v @@ -83,7 +83,7 @@ Definition Pr_op (p : raw_package) (o : opsig) (x : src o) : Arguments SDistr_bind {_ _}. Definition Pr (p : raw_package) : - SDistr (bool_choiceType) := + SDistr (Datatypes_bool__canonical__choice_Choice) := SDistr_bind (λ '(b, _), SDistr_unit _ b) (Pr_op p RUN Datatypes.tt empty_heap). @@ -152,7 +152,7 @@ Qed. *) : package_scope. *) Definition state_pass_ {A} (p : raw_code A) : - heap_choiceType → raw_code (prod_choiceType A heap_choiceType). + heap_choiceType → raw_code (Datatypes_prod__canonical__choice_Choice A heap_choiceType). Proof. induction p; intros h. - constructor. @@ -274,6 +274,75 @@ Proof. unfold AdvantageE. rewrite !link_assoc. reflexivity. Qed. +Lemma Advantage_par_empty : + ∀ G₀ G₁ A, + AdvantageE (par emptym G₀) (par emptym G₁) A = AdvantageE G₀ G₁ A. +Proof. + intros G₀ G₁ A. + unfold AdvantageE. + rewrite distrC. + reflexivity. +Qed. + +Lemma Advantage_par : + ∀ G₀ G₁ G₁' A L₀ L₁ L₁' E₀ E₁, + ValidPackage L₀ Game_import E₀ G₀ → + ValidPackage L₁ Game_import E₁ G₁ → + ValidPackage L₁' Game_import E₁ G₁' → + flat E₁ → + trimmed E₀ G₀ → + trimmed E₁ G₁ → + trimmed E₁ G₁' → + AdvantageE (par G₀ G₁) (par G₀ G₁') A = + AdvantageE G₁ G₁' (A ∘ par G₀ (ID E₁)). +Proof. + intros G₀ G₁ G₁' A L₀ L₁ L₁' E₀ E₁. + intros Va0 Va1 Va1' Fe0 Te0 Te1 Te1'. + replace (par G₀ G₁) with ((par G₀ (ID E₁)) ∘ (par (ID Game_import) G₁)). + 2:{ + erewrite <- interchange. + all: ssprove_valid. + 4:{ + ssprove_valid. + rewrite domm_ID_fset. + rewrite -fset0E. + apply fdisjoint0s. + } + 2:{ unfold Game_import. rewrite -fset0E. discriminate. } + 2: apply trimmed_ID. + rewrite link_id. + 2:{ unfold Game_import. rewrite -fset0E. discriminate. } + 2: assumption. + rewrite id_link. + 2: assumption. + reflexivity. + } + replace (par G₀ G₁') with ((par G₀ (ID E₁)) ∘ (par (ID Game_import) G₁')). + 2:{ + erewrite <- interchange. + all: ssprove_valid. + 4:{ + ssprove_valid. + rewrite domm_ID_fset. + rewrite -fset0E. + apply fdisjoint0s. + } + 2:{ unfold Game_import. rewrite -fset0E. discriminate. } + 2: apply trimmed_ID. + rewrite link_id. + 2:{ unfold Game_import. rewrite -fset0E. discriminate. } + 2: assumption. + rewrite id_link. + 2: assumption. + reflexivity. + } + rewrite -Advantage_link. + unfold Game_import. rewrite -fset0E. + rewrite Advantage_par_empty. + reflexivity. + Unshelve. all: auto. +Qed. + Lemma Advantage_sym : ∀ P Q A, AdvantageE P Q A = AdvantageE Q P A. @@ -397,4 +466,4 @@ Ltac ssprove_triangle_as p₀ l p₁ A ineq := Tactic Notation "ssprove" "triangle" constr(p₀) constr(l) constr(p₁) constr(A) "as" ident(ineq) := - ssprove_triangle_as p₀ l p₁ A ineq. \ No newline at end of file + ssprove_triangle_as p₀ l p₁ A ineq. diff --git a/theories/Crypt/package/pkg_composition.v b/theories/Crypt/package/pkg_composition.v index aef005cf..9dcaecec 100644 --- a/theories/Crypt/package/pkg_composition.v +++ b/theories/Crypt/package/pkg_composition.v @@ -431,7 +431,7 @@ Section fset_par_facts. - cbn. symmetry. apply h. auto. - cbn. reflexivity. } - rewrite h1. reflexivity. + rewrite h1. rewrite eqseqE. now rewrite eq_refl. Qed. End fset_par_facts. @@ -912,7 +912,7 @@ Proof. Qed. Lemma getm_def_in : - ∀ {A : eqType} n (x : A) (s : seq (nat_eqType * A)), + ∀ {A : eqType} n (x : A) (s : seq (Datatypes_nat__canonical__eqtype_Equality * A)), getm_def s n = Some x → (n,x) \in s. Proof. @@ -1106,4 +1106,4 @@ Proof. intro h. apply e. destruct h as [? h ?]. rewrite in_fset in h. eexists. all: eauto. -Qed. \ No newline at end of file +Qed. diff --git a/theories/Crypt/package/pkg_core_definition.v b/theories/Crypt/package/pkg_core_definition.v index c6070358..865c4191 100644 --- a/theories/Crypt/package/pkg_core_definition.v +++ b/theories/Crypt/package/pkg_core_definition.v @@ -54,6 +54,7 @@ Definition loc_type (l : Location) := l.π1. Coercion loc_type : Location >-> choice_type. Definition Value (t : choice_type) := chElement t. +From HB Require Import structures. Definition Interface := {fset opsig}. @@ -258,7 +259,7 @@ Section FreeModule. Inductive command : choiceType → Type := | cmd_op o (x : src o) : command (tgt o) | cmd_get (ℓ : Location) : command (Value ℓ.π1) - | cmd_put (ℓ : Location) (v : Value ℓ.π1) : command unit_choiceType + | cmd_put (ℓ : Location) (v : Value ℓ.π1) : command Datatypes_unit__canonical__choice_Choice | cmd_sample op : command (Arit op). Definition cmd_bind {A B} (c : command A) (k : A → raw_code B) := diff --git a/theories/Crypt/package/pkg_distr.v b/theories/Crypt/package/pkg_distr.v index ebbd1e59..8add5b29 100644 --- a/theories/Crypt/package/pkg_distr.v +++ b/theories/Crypt/package/pkg_distr.v @@ -87,7 +87,7 @@ Qed. Lemma card_prod_iprod : ∀ i j, - #|prod_finType (ordinal_finType i) (ordinal_finType j)| = (i * j)%N. + #|Datatypes_prod__canonical__fintype_Finite (fintype_ordinal__canonical__fintype_Finite i) (fintype_ordinal__canonical__fintype_Finite j)| = (i * j)%N. Proof. intros i j. rewrite card_prod. simpl. rewrite !card_ord. reflexivity. @@ -95,7 +95,7 @@ Qed. Definition ch2prod {i j} `{Positive i} `{Positive j} (x : Arit (uniform (i * j))) : - prod_choiceType (Arit (uniform i)) (Arit (uniform j)). + Datatypes_prod__canonical__fintype_Finite (Arit (uniform i)) (Arit (uniform j)). Proof. simpl in *. eapply otf. rewrite card_prod_iprod. @@ -103,7 +103,7 @@ Proof. Defined. Definition prod2ch {i j} `{Positive i} `{Positive j} - (x : prod_choiceType (Arit (uniform i)) (Arit (uniform j))) : + (x : Datatypes_prod__canonical__fintype_Finite (Arit (uniform i)) (Arit (uniform j))) : Arit (uniform (i * j)). Proof. simpl in *. @@ -114,7 +114,7 @@ Defined. Definition ch2prod_prod2ch : ∀ {i j} `{Positive i} `{Positive j} - (x : prod_choiceType (Arit (uniform i)) (Arit (uniform j))), + (x : Datatypes_prod__canonical__fintype_Finite (Arit (uniform i)) (Arit (uniform j))), ch2prod (prod2ch x) = x. Proof. intros i j hi hj x. @@ -148,7 +148,7 @@ Proof. Qed. Lemma ordinal_finType_inhabited : - ∀ i `{Positive i}, ordinal_finType i. + ∀ i `{Positive i}, fintype_ordinal__canonical__fintype_Finite i. Proof. intros i hi. exists 0%N. auto. diff --git a/theories/Crypt/package/pkg_heap.v b/theories/Crypt/package/pkg_heap.v index ed71ab8e..80b1b909 100644 --- a/theories/Crypt/package/pkg_heap.v +++ b/theories/Crypt/package/pkg_heap.v @@ -5,6 +5,7 @@ From Coq Require Import Utf8. +Require Import ZArith. From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". @@ -19,6 +20,7 @@ From Crypt Require Import Prelude Axioms ChoiceAsOrd SubDistr Couplings pkg_tactics pkg_composition. Require Import Equations.Prop.DepElim. From Equations Require Import Equations. +From mathcomp Require Import word. (* Must come after importing Equations.Equations, who knows why. *) From Crypt Require Import FreeProbProg. @@ -58,11 +60,15 @@ Proof. intros a. induction a. - exact tt. - exact 0. + - exact Z0. - exact false. - exact (IHa1, IHa2). - exact emptym. - exact None. - exact (fintype.Ordinal n.(cond_pos)). + - exact word0. + - exact [::]. + - exact (inl IHa1). Defined. Definition heap := { h : raw_heap | valid_heap h }. @@ -264,4 +270,4 @@ Proof. intros s ℓ v ℓ' v' ne. apply heap_ext. destruct s as [h vh]. simpl. apply setmC. auto. -Qed. \ No newline at end of file +Qed. diff --git a/theories/Crypt/package/pkg_interpreter.v b/theories/Crypt/package/pkg_interpreter.v index bcb4f058..1786f32e 100644 --- a/theories/Crypt/package/pkg_interpreter.v +++ b/theories/Crypt/package/pkg_interpreter.v @@ -1,6 +1,7 @@ Set Warnings "-notation-overridden,-ambiguous-paths". From mathcomp Require Import all_ssreflect. Set Warnings "notation-overridden,ambiguous-paths". +Require Arith ZArith. From Crypt Require Import Prelude choice_type pkg_core_definition pkg_tactics pkg_distr pkg_notation. @@ -8,6 +9,9 @@ From Crypt Require Import Prelude choice_type From Coq Require Import Utf8. From extructures Require Import ord fset fmap. +(* From Jasmin Require Import word. *) +From Crypt Require Import jasmin_word. + From Equations Require Import Equations. Set Equations With UIP. @@ -38,12 +42,15 @@ Section Interpreter. nat_ch_aux (NSProd a b) (l1 × l2) (Some v1, Some v2) := Some (v1, v2) ; nat_ch_aux (NSProd a b) (l1 × l2) _ := None ; } ; + nat_ch_aux (NSNat n) ('word u) := Some _ ; nat_ch_aux _ _ := None. Proof. - eapply @Ordinal. instantiate (1 := n %% n'). apply ltn_pmod. apply cond_pos0. + - apply wrepr. + apply (BinInt.Z.of_nat n). Defined. Definition nat_ch (x : option NatState) (l : choice_type) : option (Value l) := @@ -68,6 +75,7 @@ Section Interpreter. | _ => None end ; ch_nat 'option l None := Some (NSOption None) ; + ch_nat 'word u x := Some (NSNat (BinInt.Z.to_nat (wunsigned x))) ; ch_nat _ _ := None. Lemma ch_nat_ch l v: @@ -76,51 +84,14 @@ Section Interpreter. | _ => true end. Proof. - induction l. - - rewrite ch_nat_equation_1. - simpl. - rewrite nat_ch_aux_equation_1. - by destruct v. - - rewrite ch_nat_equation_2. - simpl. - rewrite nat_ch_aux_equation_9. - reflexivity. - - rewrite ch_nat_equation_3. - simpl. - rewrite nat_ch_aux_equation_10. - destruct v ; reflexivity. - - destruct v. - rewrite ch_nat_equation_4. - simpl. - specialize (IHl1 s). - specialize (IHl2 s0). - move: IHl1 IHl2. - case (ch_nat l1 s) ; - case (ch_nat l2 s0). - + simpl. - intros. - rewrite nat_ch_aux_equation_32. - by rewrite IHl1 IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - - rewrite ch_nat_equation_5. - done. - - destruct v eqn:e ; simpl. - + rewrite ch_nat_equation_6. - specialize (IHl s). - case (ch_nat l s) eqn:e'. - ++ simpl. - intros. - rewrite nat_ch_aux_equation_20. - f_equal. - done. - ++ done. - + rewrite ch_nat_equation_7. - done. - - rewrite ch_nat_equation_8. - simpl. - rewrite nat_ch_aux_equation_14. + funelim (ch_nat l v). all: try easy. + - simpl. by destruct v. + - simp ch_nat. simpl. simp nat_ch_aux. by destruct v. + - simp ch_nat. destruct (ch_nat l1 v1), (ch_nat l2 v2); try easy. + cbn. simp nat_ch_aux. simpl in *. now rewrite H H0. + - simp ch_nat. destruct ch_nat; try easy. + simpl in *. simp nat_ch_aux. now f_equal. + - simp ch_nat. simpl. simp nat_ch_aux. f_equal. unfold nat_ch_aux_obligation_1. have lv := ltn_ord v. @@ -131,6 +102,13 @@ Section Interpreter. rewrite modn_small. 2: assumption. done. + - simp ch_nat. simpl. simp nat_ch_aux. + f_equal. + unfold nat_ch_aux_obligation_2. + rewrite @Znat.Z2Nat.id. + + rewrite wrepr_unsigned. + reflexivity. + + apply (@wunsigned_range u). Qed. Definition new_state @@ -163,12 +141,12 @@ Section Interpreter. Definition Run {A} := (fun c seed => @Run_aux A c seed (fun (l : Location) => Some NSUnit)). - #[program] Fixpoint sampler (e : choice_type) seed : option (nat * e):= match e with - chUnit => Some (seed, Datatypes.tt) - | chNat => Some ((seed + 1)%N, seed) - | chBool => Some ((seed + 1)%N, Nat.even seed) + | chUnit => Some (seed, Datatypes.tt) + | chNat => Some ((seed + 1)%nat, seed) + | chInt => Some ((seed + 1)%nat, BinInt.Z.of_nat seed) (* FIXME: also generate negative numbers *) + | chBool => Some ((seed + 1)%nat, Nat.even seed) | chProd A B => match sampler A seed with | Some (seed' , x) => match sampler B seed' with @@ -184,6 +162,25 @@ Section Interpreter. | _ => None end | chFin n => Some ((seed + 1)%N, _) + | chWord n => Some ((seed + 1)%N, _) + | chList A => + match sampler A seed with + | Some (seed', x) => Some (seed', [:: x]) + | _ => None + end + | chSum A B => + let '(seed', b) := ((seed + 1)%nat, Nat.even seed) in + if b + then + match sampler A seed' with + | Some (seed'' , x) => Some (seed'', inl x) + | _ => None + end + else + match sampler B seed' with + | Some (seed'' , y) => Some (seed'', inr y) + | _ => None + end end. Next Obligation. eapply Ordinal. @@ -192,4 +189,23 @@ Section Interpreter. apply n. Defined. + Set Warnings "-notation-overridden,-ambiguous-paths". + Import ZArith. + Import all_algebra. + Set Warnings "notation-overridden,ambiguous-paths". + Local Open Scope Z_scope. + Local Open Scope ring_scope. + + Next Obligation. + eapply word.mkWord. + instantiate (1 := ((Z.of_nat seed) mod (word.modulus (nat_of_wsize n) ))%Z). + pose (Z.mod_bound_pos (Z.of_nat seed) (word.modulus n) + (Zle_0_nat seed)). + pose (word.modulus_gt0 (nat_of_wsize n)). + apply / word.iswordZP. + apply a. + move : i => / word_ssrZ.ltzP. + auto. + Defined. + End Interpreter. diff --git a/theories/Crypt/package/pkg_invariants.v b/theories/Crypt/package/pkg_invariants.v index aba4a0ff..7f503c6a 100644 --- a/theories/Crypt/package/pkg_invariants.v +++ b/theories/Crypt/package/pkg_invariants.v @@ -62,6 +62,43 @@ Definition INV' (L1 L2 : {fset Location}) (I (s1, s2) → ∀ l v, l \notin L1 → l \notin L2 → I (set_heap s1 l v, set_heap s2 l v)). +Definition pINV' (P1 P2 : Location -> Prop) + (I : heap_choiceType * heap_choiceType → Prop) + := + ∀ s1 s2, + (I (s1, s2) → ∀ l, ~ P1 l → ~ P2 l → + get_heap s1 l = get_heap s2 l) ∧ + (I (s1, s2) → ∀ l v, ~ P1 l -> ~ P2 l → + I (set_heap s1 l v, set_heap s2 l v)). + +(* TODO: move? *) +Definition pdisjoint (L : {fset Location}) (P : Location -> Prop) := forall l, ~ (l \in L /\ P l). + +Lemma pINV'_to_INV (L : {fset Location}) P1 P2 + (I : heap_choiceType * heap_choiceType → Prop) + (HpINV' : pINV' P1 P2 I) + (Hdisjoint1 : pdisjoint L P1) + (Hdisjoint2 : pdisjoint L P2) : + INV L I. +Proof. + unfold INV. + intros s1 s2. split. + - intros hi l hin. + apply HpINV'. + + assumption. + + intros contra. + eapply Hdisjoint1. eauto. + + intros contra. + eapply Hdisjoint2. eauto. + - intros hi l v hin. + apply HpINV'. + + assumption. + + intros contra. + eapply Hdisjoint1. eauto. + + intros contra. + eapply Hdisjoint2. eauto. +Qed. + Lemma INV'_to_INV (L L1 L2 : {fset Location}) (I : heap_choiceType * heap_choiceType → Prop) (HINV' : INV' L1 L2 I) @@ -86,6 +123,12 @@ Proof. apply Hdisjoint2. assumption. Qed. +(* TODO: add automation? *) +Class pInvariant P₀ P₁ pinv := { + pinv_pINV' : pINV' P₀ P₁ pinv ; + pinv_empty : pinv (empty_heap, empty_heap) +}. + Class Invariant L₀ L₁ inv := { inv_INV' : INV' L₀ L₁ inv ; inv_empty : inv (empty_heap, empty_heap) @@ -119,7 +162,12 @@ Definition heap_ignore (L : {fset Location}) : precond := λ '(h₀, h₁), ∀ (ℓ : Location), ℓ \notin L → get_heap h₀ ℓ = get_heap h₁ ℓ. +Definition heap_ignore_pred (P : Location -> Prop) : precond := + λ '(h₀, h₁), + forall (ℓ : Location), ~ P ℓ -> get_heap h₀ ℓ = get_heap h₁ ℓ. + Arguments heap_ignore : simpl never. +Arguments heap_ignore_pred : simpl never. Lemma heap_ignore_empty : ∀ L, @@ -128,6 +176,35 @@ Proof. intros L ℓ hℓ. reflexivity. Qed. +Lemma heap_ignore_pred_empty : + ∀ P, + heap_ignore_pred P (empty_heap, empty_heap). +Proof. + intros P ℓ hℓ. reflexivity. +Qed. + +Lemma INV'_heap_ignore_pred (P : Location -> Prop) : + ∀ L0 L1 : {fset Location}, + (forall ℓ : Location, P ℓ -> ℓ \in L0 :|: L1) -> + INV' L0 L1 (heap_ignore_pred P). +Proof. + intros L0 L1 hP h0 h1. split. + - intros hh l nin0 nin1. + eapply hh. + intros contra. + apply hP in contra as h. + rewrite in_fsetU in h. move: h => /orP [h | h]. + + rewrite h in nin0. discriminate. + + rewrite h in nin1. discriminate. + - intros h ℓ v n₀ n₁ ℓ' n. + destruct (ℓ' != ℓ) eqn:e. + + rewrite get_set_heap_neq. 2: auto. + rewrite get_set_heap_neq. 2: auto. + apply h. auto. + + move: e => /eqP e. subst. + rewrite !get_set_heap_eq. reflexivity. +Qed. + Lemma INV'_heap_ignore : ∀ L L₀ L₁, fsubset L (L₀ :|: L₁) → @@ -150,6 +227,16 @@ Proof. rewrite !get_set_heap_eq. reflexivity. Qed. +Lemma Invariant_heap_ignore_pred : + ∀ L0 L1 (P : Location -> Prop), + (forall ℓ : Location, P ℓ -> ℓ \in L0 :|: L1) -> + Invariant L0 L1 (heap_ignore_pred P). +Proof. + intros L P h. split. + - apply INV'_heap_ignore_pred. auto. + - apply heap_ignore_pred_empty. +Qed. + Lemma Invariant_heap_ignore : ∀ L L₀ L₁, fsubset L (L₀ :|: L₁) → @@ -164,6 +251,45 @@ Qed. eapply Invariant_heap_ignore : (* typeclass_instances *) ssprove_invariant. +(* TODO: naming? This doesn't seem to correspond to heap_ignore, due to the missing negation, but I use it that way *) +Definition pheap_ignore (P : Location -> Prop) : precond := + λ '(h₀, h₁), + forall (ℓ : Location), P ℓ -> get_heap h₀ ℓ = get_heap h₁ ℓ. + +Lemma pheap_ignore_empty : + ∀ P, + pheap_ignore P (empty_heap, empty_heap). +Proof. intros P ℓ hℓ. reflexivity. Qed. + +Lemma pINV'_pheap_ignore (P : Location -> Prop) : + ∀ P0 P1 : Location -> Prop, + (forall ℓ : Location, ~ P0 ℓ /\ ~ P1 ℓ -> P ℓ) -> + pINV' P0 P1 (pheap_ignore P). +Proof. + intros P0 P1 hP h0 h1. split. + - intros hh l nin1 nin2. + eapply hh. + apply hP. + eauto. + - intros h ℓ v nin0 nin1 ℓ' n. + destruct (ℓ' != ℓ) eqn:e. + + rewrite get_set_heap_neq. 2: auto. + rewrite get_set_heap_neq. 2: auto. + apply h. auto. + + move: e => /eqP e. subst. + rewrite !get_set_heap_eq. reflexivity. +Qed. + +Lemma pInvariant_pheap_ignore : + ∀ P0 P1 (P : Location -> Prop), + (forall ℓ : Location, ~ P0 ℓ /\ ~ P1 ℓ -> P ℓ) -> + pInvariant P0 P1 (pheap_ignore P). +Proof. + intros L P h. split. + - apply pINV'_pheap_ignore. auto. + - apply pheap_ignore_empty. +Qed. + (* Not-really-symmetric (in use) conjunction of invariants *) Definition inv_conj (inv inv' : precond) := λ s, inv s ∧ inv' s. @@ -905,9 +1031,8 @@ Proof. all: intro h. all: inversion h. all: contradiction. Qed. -Canonical heap_val_eqMixin := EqMixin heap_val_eqP. -Canonical heap_val_eqType := - Eval hnf in EqType heap_val heap_val_eqMixin. +From HB Require Import structures. +HB.instance Definition _ := hasDecEq.Build heap_val heap_val_eqP. Derive NoConfusion for heap_val. @@ -1598,4 +1723,4 @@ Proof. specialize ih with (1 := h). specialize ih with (1 := hh). rewrite e in ih. apply ih. -Qed. \ No newline at end of file +Qed. diff --git a/theories/Crypt/package/pkg_notation.v b/theories/Crypt/package/pkg_notation.v index bfae7fac..9d565839 100644 --- a/theories/Crypt/package/pkg_notation.v +++ b/theories/Crypt/package/pkg_notation.v @@ -121,8 +121,10 @@ Module PackageNotation. *) Notation " 'nat " := (chNat) (in custom pack_type at level 2). + Notation " 'int " := (chInt) (in custom pack_type at level 2). Notation " 'bool " := (chBool) (in custom pack_type at level 2). Notation " 'unit " := (chUnit) (in custom pack_type at level 2). + Notation " 'word n " := (chWord n) (in custom pack_type at level 2). Notation " 'option x " := (chOption x) (in custom pack_type at level 2). Notation " 'fin n " := @@ -134,13 +136,16 @@ Module PackageNotation. (in custom pack_type at level 2, format "{map x → y }"). Notation " x × y " := (chProd x y) (in custom pack_type at level 2). + Notation " x ∐ y " := (chSum x y) (in custom pack_type at level 2). Notation "( x )" := x (in custom pack_type, x at level 2). (** Repeat the above notations here for package_scope. *) Notation " 'nat " := (chNat) (at level 2) : package_scope. + Notation " 'int " := (chInt) (at level 2) : package_scope. Notation " 'bool " := (chBool) (at level 2) : package_scope. Notation " 'unit " := (chUnit) (at level 2) : package_scope. + Notation " 'word n " := (chWord n) (at level 2) : package_scope. Notation " 'option x " := (chOption x) (at level 2) : package_scope. Notation " 'fin x " := @@ -153,6 +158,7 @@ Module PackageNotation. (at level 80, format "{map x → y }") : package_scope. *) Notation " x × y " := (chProd x y) (at level 80) : package_scope. + Notation " x ∐ y " := (chSum x y) (at level 80) : package_scope. Notation "[ 'interface' ]" := (fset [::]) diff --git a/theories/Crypt/package/pkg_rhl.v b/theories/Crypt/package/pkg_rhl.v index d04b2de4..42e0078e 100644 --- a/theories/Crypt/package/pkg_rhl.v +++ b/theories/Crypt/package/pkg_rhl.v @@ -4,7 +4,6 @@ basic crypto-style reasoning notions. *) - From Coq Require Import Utf8. From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. @@ -166,7 +165,7 @@ Proof. match goal with | |- realsum.summable ?f => eassert (f = _) as Hf end. { extensionality x. - apply (destruct_pair_eq (a:= f1 x) (b:=f3 x) (c:= f2 x) (d := f4 x)). } + exact (destruct_pair_eq (a:= f1 x) (b:=f3 x) (c:= f2 x) (d := f4 x)). } rewrite Hf. apply realsum.summableM. all: assumption. Qed. @@ -413,6 +412,105 @@ Proof. * cbn. intros s₀' s₁' [? ?]. subst. auto. Qed. +(* TODO: generalize, this proof is the same as for eq_upto_inv_perf_ind*) +Lemma eq_upto_pinv_perf_ind : + ∀ {P0 P1 L₀ L₁ LA E} (p₀ p₁ : raw_package) (I : precond) (A : raw_package) + `{ValidPackage L₀ Game_import E p₀} + `{ValidPackage L₁ Game_import E p₁} + `{ValidPackage LA E A_export A}, + pINV' P0 P1 I → + I (empty_heap, empty_heap) → + pdisjoint LA P0 → + pdisjoint LA P1 → + eq_up_to_inv E I p₀ p₁ → + AdvantageE p₀ p₁ A = 0. +Proof. + intros P0 P1 L₀ L₁ LA E p₀ p₁ I A vp₀ vp₁ vA hI' hIe hd₀ hd₁ hp. + unfold AdvantageE, Pr. + pose r := get_op_default A RUN tt. + assert (hI : INV LA I). 1: eapply pINV'_to_INV; eauto. + unshelve epose proof (eq_up_to_inv_adversary_link p₀ p₁ I r hI hp) as h. + 1:{ + eapply valid_get_op_default. + - eauto. + - auto_in_fset. + } + assert ( + ∀ x y : tgt RUN * heap_choiceType, + (let '(b₀, s₀) := x in λ '(b₁, s₁), b₀ = b₁ ∧ I (s₀, s₁)) y → + (fst x == true) ↔ (fst y == true) + ) as Ha. + { intros [b₀ s₀] [b₁ s₁]. simpl. + intros [e ?]. rewrite e. intuition auto. + } + unfold Pr_op. + unshelve epose (rhs := thetaFstd _ (repr (code_link r p₀)) empty_heap). + simpl in rhs. + epose (lhs := Pr_op (A ∘ p₀) RUN tt empty_heap). + assert (lhs = rhs) as he. + { subst lhs rhs. + unfold Pr_op. unfold Pr_code. + unfold thetaFstd. simpl. apply f_equal2. 2: reflexivity. + apply f_equal. apply f_equal. + rewrite get_op_default_link. reflexivity. + } + unfold lhs in he. unfold Pr_op in he. + rewrite he. + unshelve epose (rhs' := thetaFstd _ (repr (code_link r p₁)) empty_heap). + simpl in rhs'. + epose (lhs' := Pr_op (A ∘ p₁) RUN tt empty_heap). + assert (lhs' = rhs') as e'. + { subst lhs' rhs'. + unfold Pr_op. unfold Pr_code. + unfold thetaFstd. simpl. apply f_equal2. 2: reflexivity. + apply f_equal. apply f_equal. + rewrite get_op_default_link. reflexivity. + } + unfold lhs' in e'. unfold Pr_op in e'. + rewrite e'. + unfold rhs', rhs. + unfold SDistr_bind. unfold SDistr_unit. + rewrite !dletE. + assert ( + ∀ x : Datatypes_bool__canonical__choice_Choice * heap_choiceType, + ((let '(b, _) := x in dunit (R:=R) (T:=Datatypes_bool__canonical__choice_Choice) b) true) == + (x.1 == true)%:R + ) as h1. + { intros [b s]. + simpl. rewrite dunit1E. apply/eqP. reflexivity. + } + assert ( + ∀ y, + (λ x : Datatypes_prod__canonical__choice_Choice (tgt RUN) heap_choiceType, (y x) * (let '(b, _) := x in dunit (R:=R) (T:=tgt RUN) b) true) = + (λ x : Datatypes_prod__canonical__choice_Choice (tgt RUN) heap_choiceType, (x.1 == true)%:R * (y x)) + ) as Hrew. + + { intros y. extensionality x. + destruct x as [x1 x2]. + rewrite dunit1E. + simpl. rewrite GRing.mulrC. reflexivity. + } + rewrite !Hrew. + unfold TransformingLaxMorph.rlmm_from_lmla_obligation_1. simpl. + unfold SubDistr.SDistr_obligation_2. simpl. + unfold OrderEnrichedRelativeAdjunctionsExamples.ToTheS_obligation_1. + rewrite !SDistr_rightneutral. simpl. + pose proof (Pr_eq_empty _ _ _ _ h hIe Ha) as Heq. + simpl in Heq. + unfold θ_dens in Heq. + simpl in Heq. unfold pr in Heq. + simpl in Heq. + rewrite Heq. + rewrite /StateTransfThetaDens.unaryStateBeta'_obligation_1. + assert (∀ (x : R), `|x - x| = 0) as Hzero. + { intros x. + assert (x - x = 0) as H3. + { apply /eqP. rewrite GRing.subr_eq0. intuition. } + rewrite H3. apply normr0. + } + apply Hzero. +Qed. + Lemma eq_upto_inv_perf_ind : ∀ {L₀ L₁ LA E} (p₀ p₁ : raw_package) (I : precond) (A : raw_package) `{ValidPackage L₀ Game_import E p₀} @@ -482,8 +580,8 @@ Proof. unfold SDistr_bind. unfold SDistr_unit. rewrite !dletE. assert ( - ∀ x : bool_choiceType * heap_choiceType, - ((let '(b, _) := x in dunit (R:=R) (T:=bool_choiceType) b) true) == + ∀ x : Datatypes_bool__canonical__choice_Choice * heap_choiceType, + ((let '(b, _) := x in dunit (R:=R) (T:=Datatypes_bool__canonical__choice_Choice) b) true) == (x.1 == true)%:R ) as h1. { intros [b s]. @@ -491,8 +589,8 @@ Proof. } assert ( ∀ y, - (λ x : prod_choiceType (tgt RUN) heap_choiceType, (y x) * (let '(b, _) := x in dunit (R:=R) (T:=tgt RUN) b) true) = - (λ x : prod_choiceType (tgt RUN) heap_choiceType, (x.1 == true)%:R * (y x)) + (λ x : Datatypes_prod__canonical__choice_Choice (tgt RUN) heap_choiceType, (y x) * (let '(b, _) := x in dunit (R:=R) (T:=tgt RUN) b) true) = + (λ x : Datatypes_prod__canonical__choice_Choice (tgt RUN) heap_choiceType, (x.1 == true)%:R * (y x)) ) as Hrew. { intros y. extensionality x. destruct x as [x1 x2]. @@ -520,6 +618,29 @@ Proof. apply Hzero. Qed. +(* TODO: move? to pkg_advantage *) +Definition padv_equiv P₀ P₁ {L₀ L₁ E} (G₀ G₁ : raw_package) + `{ValidPackage L₀ Game_import E G₀} `{ValidPackage L₁ Game_import E G₁} ε := + ∀ LA A, + ValidPackage LA E A_export A → + pdisjoint LA P₀ → + pdisjoint LA P₁ → + AdvantageE G₀ G₁ A = ε A. + +Lemma eq_rel_perf_ind' : + ∀ {P0 P1 L₀ L₁ E} (p₀ p₁ : raw_package) (inv : precond) + `{ValidPackage L₀ Game_import E p₀} + `{ValidPackage L₁ Game_import E p₁}, + pInvariant P0 P1 inv → + eq_up_to_inv E inv p₀ p₁ → + padv_equiv P0 P1 p₀ p₁ (λ _ : raw_package, 0%R). + (* p₀ ≈₀ p₁. *) +Proof. + intros P0 P1 L₀ L₁ E p₀ p₁ inv v₀ v₁ [? ?] he. + intros LA A vA hd₀ hd₁. + eapply eq_upto_pinv_perf_ind. all: eauto. +Qed. + Lemma eq_rel_perf_ind : ∀ {L₀ L₁ E} (p₀ p₁ : raw_package) (inv : precond) `{ValidPackage L₀ Game_import E p₀} @@ -863,6 +984,29 @@ Proof. eapply swap_ruleL. all: eauto. Qed. +Lemma rswap_helper : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : raw_code A₀) (c₁ : raw_code A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr c₀;; + a2 ∈ choice_incl A₁ <<- repr c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr c₀) (λ a : A₀, repr (a₁ ← c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + Theorem rswap_ruleR : ∀ {A₀ A₁ B : ord_choiceType} {post : postcond B B} (c₀ : raw_code A₀) (c₁ : raw_code A₁) (r : A₀ → A₁ → raw_code B), @@ -880,13 +1024,18 @@ Proof. intros A₀ A₁ B post c₀ c₁ r postr hr h. eapply from_sem_jdg. repeat setoid_rewrite repr_bind. simpl. - eapply (swap_ruleR (λ a₀ a₁, repr (r a₀ a₁)) (repr c₀) (repr c₁)). + rewrite <- rswap_helper. + rewrite <- rswap_helper. + apply (@swap_ruleR A₀ A₁ B _ post (λ a₀ a₁, repr (r a₀ a₁)) (repr c₀) (repr c₁)). - intros. eapply to_sem_jdg. apply hr. - apply postr. - - intro s. + - clear -h. + intro s. unshelve eapply coupling_eq. + exact (λ '(h₀, h₁), h₀ = h₁). + eapply to_sem_jdg in h. repeat setoid_rewrite repr_bind in h. + rewrite <- rswap_helper in h. + rewrite <- rswap_helper in h. apply h. + reflexivity. Qed. @@ -1056,6 +1205,134 @@ Proof. cbn. reflexivity. Qed. +(* Simpler semantics for deterministic programs *) + +Inductive deterministic {A : choiceType} : raw_code A → Type := +| deterministic_ret : + ∀ x, deterministic (ret x) +| deterministic_get : + ∀ ℓ k, (∀ x, deterministic (k x)) → deterministic (getr ℓ k) +| deterministic_put : + ∀ ℓ v k, deterministic k → deterministic (putr ℓ v k). + +Fixpoint det_run {A : choiceType} c [h : @deterministic A c] s : A * heap := + match h with + | deterministic_ret x => (x, s) + | deterministic_get ℓ k hk => det_run (k (get_heap s ℓ)) (h := hk _) s + | deterministic_put ℓ v k hk => det_run k (h := hk) (set_heap s ℓ v) + end. + +Lemma det_run_sem : + ∀ {A : choiceType} (c : raw_code A) (hd : deterministic c) s, + θ_dens (θ0 (repr c) s) = dunit (det_run c (h := hd) s). +Proof. + intros A c hd s. + induction hd as [x | ℓ k hk ihk | ℓ v k hk ihk] in s |- *. + - reflexivity. + - simpl. rewrite <- ihk. reflexivity. + - simpl. rewrite <- ihk. reflexivity. +Qed. + +Definition det_jdg {A B : choiceType} (pre : precond) (post : postcond A B) + (p : raw_code A) (q : raw_code B) hp hq := + ∀ (s₀ s₁ : heap), + pre (s₀, s₁) → + post (det_run p (h := hp) s₀) (det_run q (h := hq) s₁). + +Lemma det_to_sem : + ∀ {A₀ A₁ : ord_choiceType} pre post (c₀ : raw_code A₀) (c₁ : raw_code A₁) + (hd₀ : deterministic c₀) + (hd₁ : deterministic c₁), + det_jdg pre post c₀ c₁ hd₀ hd₁ → + ⊢ ⦃ pre ⦄ c₀ ≈ c₁ ⦃ post ⦄. +Proof. + intros A₀ A₁ pre post c₀ c₁ dc₀ dc₁ h. + eapply from_sem_jdg. intros [s₀ s₁]. hnf. intro P. hnf. + intros [hpre hpost]. simpl. + unfold SDistr_carrier. unfold F_choice_prod_obj. simpl. + + unfold det_jdg in h. specialize (h s₀ s₁ hpre). + set (u := det_run c₀ _) in *. + set (v := det_run c₁ _) in *. + + eexists (dunit (u, v)). + split. + - unfold coupling. split. + + unfold lmg. unfold dfst. + apply distr_ext. intro. + rewrite dlet_unit. simpl. + rewrite - det_run_sem. reflexivity. + + unfold rmg. unfold dsnd. + apply distr_ext. intro. + rewrite dlet_unit. simpl. + rewrite - det_run_sem. reflexivity. + - intros [] [] hh. + eapply hpost. + rewrite dunit1E in hh. + lazymatch type of hh with + | context [ ?x == ?y ] => + destruct (x == y) eqn:e + end. + 2:{ + rewrite e in hh. simpl in hh. + rewrite order.Order.POrderTheory.ltxx in hh. discriminate. + } + move: e => /eqP e. inversion e. + subst. assumption. +Qed. + +Lemma sem_to_det : + ∀ {A₀ A₁ : ord_choiceType} pre post (c₀ : raw_code A₀) (c₁ : raw_code A₁) + (hd₀ : deterministic c₀) + (hd₁ : deterministic c₁), + ⊢ ⦃ pre ⦄ c₀ ≈ c₁ ⦃ post ⦄ → + det_jdg pre post c₀ c₁ hd₀ hd₁. +Proof. + intros A₀ A₁ pre post c₀ c₁ hd₀ hd₁ h. + intros s₀ s₁ hpre. + eapply to_sem_jdg in h. specialize (h (s₀, s₁)). hnf in h. simpl in h. + specialize (h (λ '(v₀, s₀', (v₁, s₁')), post (v₀, s₀') (v₁, s₁'))). + destruct h as [c [hc h]]. + - split. 1: assumption. + intros [] []. tauto. + - set (u := det_run c₀ _) in *. + set (v := det_run c₁ _) in *. + specialize (h u v). + assert (hc' : coupling c (dunit u) (dunit v)). + { rewrite - !det_run_sem. exact hc. } + destruct u, v. + apply h. + apply coupling_SDistr_unit_F_choice_prod in hc'. subst. + unfold SDistr_unit. rewrite dunit1E. rewrite eq_refl. simpl. + apply ltr0n. +Qed. + +(* Similar to r_transL but relaxed for deterministic programs and for + stateless conditions. +*) +Lemma r_transL_val : + ∀ {A₀ A₁ : ord_choiceType} {P Q} + (c₀ c₀' : raw_code A₀) (c₁ : raw_code A₁), + deterministic c₀' → + deterministic c₀ → + deterministic c₁ → + ⊢ ⦃ λ '(_, _), P ⦄ c₀ ≈ c₀' ⦃ λ '(v₀, _) '(v₁, _), v₀ = v₁ ⦄ → + ⊢ ⦃ λ '(_, _), P ⦄ c₀ ≈ c₁ ⦃ λ '(v₀, _) '(v₁, _), Q v₀ v₁ ⦄ → + ⊢ ⦃ λ '(_, _), P ⦄ c₀' ≈ c₁ ⦃ λ '(v₀, _) '(v₁, _), Q v₀ v₁ ⦄. +Proof. + intros A₀ A₁ P Q c₀ c₀' c₁ hd₀' hd₀ hd₁ he h. + unshelve eapply det_to_sem. 1,2: assumption. + unshelve eapply sem_to_det in he. 1,2: assumption. + unshelve eapply sem_to_det in h. 1,2: assumption. + intros s₀ s₁ hP. + specialize (h s₀ s₁ hP). specialize (he s₀ s₀ hP). + destruct (det_run c₀ _). + destruct (det_run c₀' _). + destruct (det_run c₁ _). + subst. + assumption. +Qed. + (* Rules using commands instead of bind *) Theorem rsame_head_cmd : @@ -1709,6 +1986,30 @@ Proof. eapply restore_update_mem. all: eauto. Qed. +Lemma rswap_cmd_helper : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : command A₀) (c₁ : command A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr_cmd c₀;; + a2 ∈ choice_incl A₁ <<- repr_cmd c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr_cmd c₀) (λ a : A₀, repr (a₁ ← cmd c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr_cmd c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← cmd c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_cmd_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + + Lemma rswap_cmd : ∀ (A₀ A₁ B : choiceType) (post : postcond B B) (c₀ : command A₀) (c₁ : command A₁) @@ -1727,6 +2028,8 @@ Proof. intros A₀ A₁ B post c₀ c₁ r hpost hr h. eapply from_sem_jdg. repeat setoid_rewrite repr_cmd_bind. + rewrite <- rswap_cmd_helper. + rewrite <- rswap_cmd_helper. eapply (swap_ruleR (λ a₀ a₁, repr (r a₀ a₁)) (repr_cmd c₀) (repr_cmd c₁)). - intros a₀ a₁. eapply to_sem_jdg. eapply hr. - intros ? ? []. eauto. @@ -1734,7 +2037,9 @@ Proof. + exact: (λ '(h1, h2), h1 = h2). + eapply to_sem_jdg in h. repeat (setoid_rewrite repr_cmd_bind in h). - auto. + rewrite <- rswap_cmd_helper in h. + rewrite <- rswap_cmd_helper in h. + apply h. + reflexivity. Qed. @@ -1760,6 +2065,53 @@ Proof. - auto. Qed. + +Lemma rswap_helper_cmd : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : command A₀) (c₁ : raw_code A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr_cmd c₀;; + a2 ∈ choice_incl A₁ <<- repr c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr_cmd c₀) (λ a : A₀, repr (a₁ ← c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + +Lemma rswap_repr_cmd_helper : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : raw_code A₀) (c₁ : command A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr c₀;; + a2 ∈ choice_incl A₁ <<- repr_cmd c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr c₀) (λ a : A₀, repr (a₁ ← cmd c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr_cmd c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← cmd c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_cmd_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + Lemma rswap_cmd_bind_eq : ∀ {A₀ A₁ B : choiceType} c₀ c₁ (r : A₀ → A₁ → raw_code B), ⊢ ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄ @@ -1773,8 +2125,10 @@ Lemma rswap_cmd_bind_eq : Proof. intros A₀ A₁ B c₀ c₁ r h. eapply from_sem_jdg. simpl. - setoid_rewrite repr_cmd_bind. setoid_rewrite repr_bind. - simpl. setoid_rewrite repr_cmd_bind. + setoid_rewrite repr_cmd_bind. rewrite repr_bind. + rewrite <- rswap_helper_cmd. + rewrite <- rswap_repr_cmd_helper. + simpl. eapply (swap_ruleR (λ a₀ a₁, repr (r a₀ a₁)) (repr_cmd c₀) (repr c₁)). - intros a₀ a₁. eapply to_sem_jdg. apply rsym_pre. 1: auto. @@ -1784,8 +2138,10 @@ Proof. + exact: (λ '(h₀, h₁), h₀ = h₁). + eapply to_sem_jdg in h. setoid_rewrite repr_cmd_bind in h. simpl in h. + rewrite <- rswap_helper_cmd in h. setoid_rewrite repr_bind in h. simpl in h. - setoid_rewrite repr_cmd_bind in h. simpl in h. + rewrite <- rswap_repr_cmd_helper in h. + simpl in h. auto. + reflexivity. Qed. @@ -1815,7 +2171,18 @@ Proof. rewrite bind_assoc in h. rewrite bind_cmd_bind in h. setoid_rewrite bind_cmd_bind in h. - setoid_rewrite bind_assoc in h. + simpl in h. + replace + (x ← cmd _ ;; + pat ← (a₀ ← c₀ ;; + ret (a₀, x)) ;; + (let '(x0, y) := pat in ret (y, x0))) + with + (x ← cmd c₁ ;; + a₀ ← c₀ ;; + pat ← ret (a₀, x) ;; + (let '(x0, y) := pat in ret (y, x0))) in h by (f_equal ; extensionality x ; now rewrite bind_assoc). + (* setoid_rewrite bind_assoc in h. *) simpl in h. apply rsymmetry. apply rsym_pre. 1: auto. eapply rpost_weaken_rule. 1: eauto. @@ -1840,6 +2207,8 @@ Proof. intros A₀ A₁ B post c₀ c₁ r postr hr h. eapply from_sem_jdg. repeat setoid_rewrite repr_cmd_bind. simpl. + rewrite <- rswap_cmd_helper. + rewrite <- rswap_cmd_helper. eapply (swap_ruleR (λ a₀ a₁, repr (r a₀ a₁)) (repr_cmd c₀) (repr_cmd c₁)). - intros. eapply to_sem_jdg. apply hr. - apply postr. @@ -1847,6 +2216,8 @@ Proof. unshelve eapply coupling_eq. + exact (λ '(h₀, h₁), h₀ = h₁). + eapply to_sem_jdg in h. repeat setoid_rewrite repr_cmd_bind in h. + rewrite <- rswap_cmd_helper in h. + rewrite <- rswap_cmd_helper in h. apply h. + reflexivity. Qed. @@ -2133,7 +2504,7 @@ Section Uniform_prod. destruct (ch2prod u == (a,b)) eqn:e. 2:{ exfalso. - move: hu => /negP hu. apply hu. apply eqxx. + move: hu => /negP hu. apply hu. rewrite e. apply eqxx. } move: e => /eqP e. rewrite -e. rewrite inE. apply /eqP. symmetry. apply prod2ch_ch2prod. @@ -2366,7 +2737,7 @@ Proof. eapply r_transR. - unfold fail. eapply rswap_cmd_eq with (c₀ := cmd_sample _) (c₁ := c). - eapply rsamplerC'_cmd with (c0 := c). + eapply rsamplerC'_cmd with (c := c). - simpl. unfold fail. eapply from_sem_jdg. intros [s₀ s₁]. hnf. intro P. hnf. intros [hpre hpost]. simpl. diff --git a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v index 97ce586c..0dd21495 100644 --- a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v +++ b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v @@ -3,7 +3,7 @@ From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadE Set Warnings "-notation-overridden". From mathcomp Require Import all_ssreflect. Set Warnings "notation-overridden". -From mathcomp Require boolp. +From mathcomp Require classical.boolp. Import SPropNotations. @@ -42,7 +42,7 @@ Section Prod_of_choiceTypes. Obj ord_choiceType. Proof. rewrite /prod_cat /=. move => [C1 C2]. - exact (prod_choiceType C1 C2). + exact (C1 * C2)%type. Defined. Definition F_choice_prod_morph : forall T1 T2 : (prod_cat ord_choiceType ord_choiceType), diff --git a/theories/Crypt/rhl_semantics/free_monad/FreeProbProg.v b/theories/Crypt/rhl_semantics/free_monad/FreeProbProg.v index 9c4cfb43..2f470398 100644 --- a/theories/Crypt/rhl_semantics/free_monad/FreeProbProg.v +++ b/theories/Crypt/rhl_semantics/free_monad/FreeProbProg.v @@ -1,5 +1,5 @@ Set Warnings "-notation-overridden". -From mathcomp Require Import all_ssreflect boolp. +From mathcomp Require Import all_ssreflect classical.boolp. Set Warnings "notation-overridden". From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. From Crypt Require Import ChoiceAsOrd choice_type. diff --git a/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v b/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v index 9e4f59ad..bb763159 100644 --- a/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v +++ b/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v @@ -2,7 +2,7 @@ From Coq Require Import Morphisms. From Relational Require Import OrderEnrichedCategory. From Mon Require Import SPropBase. Set Warnings "-notation-overridden". -From mathcomp Require Import all_ssreflect boolp. +From mathcomp Require Import all_ssreflect classical.boolp. Set Warnings "notation-overridden". From Crypt Require Import Axioms. diff --git a/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v b/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v index 73cb3bb8..2881f328 100644 --- a/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v +++ b/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v @@ -1,7 +1,7 @@ From Relational Require Import OrderEnrichedCategory. From Mon Require Import SPropBase. Set Warnings "-notation-overridden,-ambiguous-paths". -From mathcomp Require Import all_ssreflect boolp. +From mathcomp Require Import all_ssreflect classical.boolp. Set Warnings "notation-overridden,ambiguous-paths". From Crypt Require Import Axioms OrderEnrichedRelativeAdjunctions LaxFunctorsAndTransf. diff --git a/theories/Crypt/rhl_semantics/more_categories/OrderEnrichedRelativeAdjunctions.v b/theories/Crypt/rhl_semantics/more_categories/OrderEnrichedRelativeAdjunctions.v index cf86188b..adad635a 100644 --- a/theories/Crypt/rhl_semantics/more_categories/OrderEnrichedRelativeAdjunctions.v +++ b/theories/Crypt/rhl_semantics/more_categories/OrderEnrichedRelativeAdjunctions.v @@ -2,7 +2,7 @@ From Coq Require Import Relation_Definitions Morphisms. From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. From Mon Require Import SPropBase. Set Warnings "-notation-overridden". -From mathcomp Require Import all_ssreflect boolp. +From mathcomp Require Import all_ssreflect classical.boolp. Set Warnings "notation-overridden". Import SPropNotations. diff --git a/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v b/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v index 2f01d5ba..24c31bac 100644 --- a/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v +++ b/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v @@ -2,7 +2,7 @@ From Coq Require Import Relation_Definitions. From Relational Require Import OrderEnrichedCategory. From Mon Require Import SPropBase. Set Warnings "-notation-overridden,-ambiguous-paths". -From mathcomp Require Import all_ssreflect boolp. +From mathcomp Require Import all_ssreflect classical.boolp. Set Warnings "notation-overridden,ambiguous-paths". From Crypt Require Import Axioms OrderEnrichedRelativeAdjunctions LaxFunctorsAndTransf LaxMorphismOfRelAdjunctions. diff --git a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v index fd4a705e..ef91e423 100644 --- a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v +++ b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v @@ -1,5 +1,5 @@ Set Warnings "-notation-overridden,-ambiguous-paths". -From mathcomp Require Import all_ssreflect all_algebra boolp distr reals realsum. +From mathcomp Require Import all_ssreflect all_algebra classical.boolp distr reals realsum. Set Warnings "notation-overridden,ambiguous-paths". From Mon Require Import SpecificationMonads SPropBase SPropMonadicStructures. From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. @@ -90,11 +90,9 @@ Proof. apply: sig_eq. rewrite /=. apply: boolp.funext. by move => [c1 c2] /=. Defined. - - - -Definition θ0 (A1 A2 : Type) (ch1 : Choice.class_of A1) (ch2 : Choice.class_of A2): - (SDistr_carrier (Choice.Pack ch1)) × (SDistr_carrier (Choice.Pack ch2)) -> + +Definition θ0 (A1 A2 : Type) (ch1 : Choice A1 (* Choice.class_of A1 *)) (ch2 : Choice A2 (* Choice.class_of A2 *)): + (SDistr_carrier (Choice.Pack ch1) ) × (SDistr_carrier (Choice.Pack ch2)) -> WProp (A1 * A2)%type. Proof. rewrite /SDistr_carrier. move => [d1 d2]. @@ -116,8 +114,8 @@ Proof. inversion leq12. by subst. Defined. -Definition kd {A1 A2 B1 B2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} - {chB1 : Choice.class_of B1} {chB2 : Choice.class_of B2} +Definition kd {A1 A2 B1 B2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} + {chB1 : Choice(* .class_of *) B1} {chB2 : Choice(* .class_of *) B2} {f1 : TypeCat ⦅ nfst (prod_functor choice_incl choice_incl ⟨ Choice.Pack chA1, Choice.Pack chA2 ⟩); nfst (SDistr_squ ⟨Choice.Pack chB1, Choice.Pack chB2 ⟩) ⦆} @@ -151,7 +149,7 @@ Proof. - exists dnull. intro. inversion H. Defined. -Lemma extract_positive : forall {A1 A2 B1 B2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} {chB1 : Choice.class_of B1} {chB2 : Choice.class_of B2} (dA : SDistr_carrier (F_choice_prod_obj ⟨ Choice.Pack chA1, Choice.Pack chA2 ⟩)) (FF1 : _ -> SDistr (F_choice_prod ⟨ Choice.Pack chB1, Choice.Pack chB2 ⟩)) b1 b2, 0 < (\dlet_(i <- dA) (FF1 i)) (b1, b2) -> exists (a1 : Choice.Pack chA1) (a2 : Choice.Pack chA2), 0 < dA (a1, a2) /\ 0 < FF1 (a1, a2) (b1, b2). +Lemma extract_positive : forall {A1 A2 B1 B2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {chB1 : Choice(* .class_of *) B1} {chB2 : Choice(* .class_of *) B2} (dA : SDistr_carrier (F_choice_prod_obj ⟨ Choice.Pack chA1, Choice.Pack chA2 ⟩)) (FF1 : _ -> SDistr (F_choice_prod ⟨ Choice.Pack chB1, Choice.Pack chB2 ⟩)) b1 b2, 0 < (\dlet_(i <- dA) (FF1 i)) (b1, b2) -> exists (a1 : Choice.Pack chA1) (a2 : Choice.Pack chA2), 0 < dA (a1, a2) /\ 0 < FF1 (a1, a2) (b1, b2). Proof. intuition. rewrite /(\dlet_(i <- _) _) in H. unlock in H. simpl in H. rewrite /mlet in H. @@ -174,7 +172,7 @@ Proof. apply FF1z. Qed. -Lemma distr_get : forall {A : Type} {chA : Choice.class_of A} x y, 0 < SDistr_unit (Choice.Pack chA) x y -> x = y. +Lemma distr_get : forall {A : Type} {chA : Choice(* .class_of *) A} x y, 0 < SDistr_unit (Choice.Pack chA) x y -> x = y. Proof. intuition. rewrite /SDistr_unit in H. rewrite dunit1E in H. case Hxy: (x==y). @@ -266,7 +264,7 @@ End SemanticNotation. Import SemanticNotation. #[local] Open Scope semantic_scope. -Definition flip (r : R) : SDistr (bool_choiceType). +Definition flip (r : R) : SDistr (bool). rewrite /SDistr_carrier. apply mkdistrd. intros b. destruct b. @@ -274,7 +272,7 @@ Definition flip (r : R) : SDistr (bool_choiceType). - exact (1 - r). Defined. -Lemma sample_rule : forall {A1 A2} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Lemma sample_rule : forall {A1 A2} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice A2} (pre : Prop) (post : A1 -> A2 -> Prop) (d1 : SDistr (Choice.Pack chA1)) (d2 : SDistr (Choice.Pack chA2)) d (Hd : coupling d d1 d2) @@ -298,7 +296,7 @@ Qed. (* GENERIC MONADIC RULES *) -Theorem ret_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem ret_rule {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2} (a1 : A1) (a2 : A2) : ⊨ (ord_relmon_unit SDistr (Choice.Pack chA1) a1) ≈ @@ -317,7 +315,7 @@ Proof. by rewrite -(distr_get _ _ Hb1b2). Qed. -Theorem weaken_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem weaken_rule {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2} {d1 : SDistr (Choice.Pack chA1)} {d2 : SDistr (Choice.Pack chA2)} : forall w w', (⊨ d1 ≈ d2 [{ w }]) -> w ≤ w' -> (⊨ d1 ≈ d2 [{ w' }] ). diff --git a/theories/Crypt/rhl_semantics/state_prob/OrderEnrichedRelativeAdjunctionsExamples.v b/theories/Crypt/rhl_semantics/state_prob/OrderEnrichedRelativeAdjunctionsExamples.v index 0092f529..7fdde957 100644 --- a/theories/Crypt/rhl_semantics/state_prob/OrderEnrichedRelativeAdjunctionsExamples.v +++ b/theories/Crypt/rhl_semantics/state_prob/OrderEnrichedRelativeAdjunctionsExamples.v @@ -1,6 +1,6 @@ From Coq Require Import Morphisms. Set Warnings "-notation-overridden,-ambiguous-paths". -From mathcomp Require Import all_algebra all_ssreflect boolp. +From mathcomp Require Import all_algebra all_ssreflect classical.boolp. Set Warnings "notation-overridden,ambiguous-paths". From Mon Require Import SPropBase Base. From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. diff --git a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v index d3082192..667aca43 100644 --- a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v +++ b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v @@ -215,8 +215,8 @@ Section UnaryInterpretState. Definition getStP : stT_Frp S := fun s : S => retrFree_filled (F_choice_prod_obj ⟨ S, S ⟩) (s, s). - Definition putStP : S -> stT_Frp unit_choiceType := fun new_s old_s => - retrFree_filled (F_choice_prod ⟨ unit_choiceType, S ⟩) (tt, new_s). + Definition putStP : S -> stT_Frp Datatypes_unit__canonical__choice_Choice := fun new_s old_s => + retrFree_filled (F_choice_prod ⟨ Datatypes_unit__canonical__choice_Choice, S ⟩) (tt, new_s). Definition probopStP {T : choice_type} (sd: SDistr T) : stT_Frp (chElement T). diff --git a/theories/Crypt/rules/RulesProb.v b/theories/Crypt/rules/RulesProb.v index f5bf3a76..5ca34b40 100644 --- a/theories/Crypt/rules/RulesProb.v +++ b/theories/Crypt/rules/RulesProb.v @@ -150,7 +150,7 @@ End RulesNotation. Import RulesNotation. Open Scope Rules_scope. -Definition flip (r : R) : SDistr (bool_choiceType). +Definition flip (r : R) : SDistr (bool). rewrite /SDistr_carrier. apply mkdistrd. intros b. destruct b. @@ -162,7 +162,7 @@ Definition get_d { A : choiceType} (c : MFreePr A):= (Theta_dens.unary_theta_dens_obligation_1 A c). Lemma sample_rule : - ∀ {A1 A2} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} + ∀ {A1 A2} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} (pre : Prop) (post : A1 -> A2 -> Prop) (c1 : MFreePr (Choice.Pack chA1)) (c2 : MFreePr (Choice.Pack chA2)) @@ -205,7 +205,7 @@ Qed. (* GENERIC MONADIC RULES *) Theorem ret_ule {A1 A2 : Type} - {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} + {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} (a1 : A1) (a2 : A2) : ⊨ (ord_relmon_unit MFreePr (Choice.Pack chA1) a1) ≈ (ord_relmon_unit MFreePr (Choice.Pack chA2) a2) @@ -229,7 +229,7 @@ Proof. by apply: ret_rule. Qed. -Theorem weaken_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem weaken_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {d1 : MFreePr (Choice.Pack chA1)} {d2 : MFreePr (Choice.Pack chA2)} : forall w w', (⊨ d1 ≈ d2 [{ w }]) -> w ≤ w' -> (⊨ d1 ≈ d2 [{ w' }] ). @@ -243,8 +243,8 @@ Proof. Qed. -Theorem bind_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} - {B1 B2 : Type} {chB1 : Choice.class_of B1} {chB2 : Choice.class_of B2} +Theorem bind_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} + {B1 B2 : Type} {chB1 : Choice(* .class_of *) B1} {chB2 : Choice(* .class_of *) B2} {f1 : A1 -> MFreePr (Choice.Pack chB1)} {f2 : A2 -> MFreePr (Choice.Pack chB2)} (m1 : MFreePr (Choice.Pack chA1)) @@ -278,7 +278,7 @@ Qed. (* Pre-condition manipulating rules *) -Theorem pre_weaken_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem pre_weaken_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {d1 : MFreePr (Choice.Pack chA1)} {d2 : MFreePr (Choice.Pack chA2)} : forall (pre pre' : Prop) post, (⊨ ⦃ pre ⦄ d1 ≈ d2 ⦃ post ⦄) -> (pre' -> pre) -> (⊨ ⦃ pre' ⦄ d1 ≈ d2 ⦃ post ⦄). @@ -291,7 +291,7 @@ Proof. simpl; intuition. Qed. -Theorem pre_hypothesis_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem pre_hypothesis_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {d1 : MFreePr (Choice.Pack chA1)} {d2 : MFreePr (Choice.Pack chA2)} : forall (pre : Prop) post, (pre -> ⊨ ⦃ True ⦄ d1 ≈ d2 ⦃ post ⦄) -> (⊨ ⦃ pre ⦄ d1 ≈ d2 ⦃ post ⦄). @@ -323,7 +323,7 @@ Qed. (* post-condition manipulating rules *) -Theorem post_weaken_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem post_weaken_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {d1 : MFreePr (Choice.Pack chA1)} {d2 : MFreePr (Choice.Pack chA2)} : forall (pre : Prop) (post1 post2 : A1 -> A2 -> Prop), @@ -438,7 +438,7 @@ Proof. by apply: (seq_rule_ch m1 m2 P (fun _ _ => True) Q judge1 judge2). Qed. (* *) -Theorem if_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem if_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} (c1 c2 : MFreePr (Choice.Pack chA1)) (c1' c2' : MFreePr (Choice.Pack chA2)) {b1 b2 : bool} @@ -463,7 +463,7 @@ Proof. - intuition. Qed. -Theorem if_rule_weak {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Theorem if_rule_weak {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} (c1 c2 : MFreePr (Choice.Pack chA1)) (c1' c2' : MFreePr (Choice.Pack chA2)) {b : bool} @@ -485,7 +485,7 @@ Axiom s_indefinite_description : -Definition judgement_d {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} +Definition judgement_d {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {c1 : MFreePr (Choice.Pack chA1)} {c2 : MFreePr (Choice.Pack chA2)} {pre : Prop} {post : A1 -> A2 -> Prop} @@ -516,8 +516,8 @@ Fixpoint for_loop {A : choiceType} (c : A -> MFreePr A) (n : nat) (a : A) := end. (* Rem.: this is a bounded version of the iteration operator found in monads with iteration *) -Fixpoint bounded_iter {A B : choiceType} (n : nat) (c : A -> MFreePr (sum_choiceType A B)) (a : A) : - MFreePr (sum_choiceType unit_choiceType B) := +Fixpoint bounded_iter {A B : choiceType} (n : nat) (c : A -> MFreePr (A + B)%type) (a : A) : + MFreePr (Datatypes_unit__canonical__choice_Choice + B)%type := match n with | 0 => ord_relmon_unit MFreePr _ (inl Datatypes.tt) | S m => (ord_relmon_bind MFreePr) (fun v => match v with @@ -526,16 +526,16 @@ Fixpoint bounded_iter {A B : choiceType} (n : nat) (c : A -> MFreePr (sum_choice end) (c a) end. -Definition bounded_loop {A B : choiceType} (n : nat) (b : A -> MFreePr bool_choiceType) (c : A -> MFreePr A) (a : A) : - MFreePr (sum_choiceType unit_choiceType A) := +Definition bounded_loop {A B : choiceType} (n : nat) (b : A -> MFreePr bool) (c : A -> MFreePr A) (a : A) : + MFreePr (Datatypes_unit__canonical__choice_Choice + A)%type := bounded_iter n (fun a' => ord_relmon_bind MFreePr (fun b => match b with | true => ord_relmon_bind MFreePr (fun a2 => ord_relmon_unit MFreePr _ (inr a2)) (c a') | false => ord_relmon_unit MFreePr _ (inl a') end) (b a')) a. (* Rem.: this a variant following what's in The next 700... *) -Fixpoint bounded_do_while (n : nat) (c : MFreePr bool_choiceType) : - MFreePr bool_choiceType := +Fixpoint bounded_do_while (n : nat) (c : MFreePr bool) : + MFreePr bool := (* false means fuel emptied, true means execution finished *) match n with | 0 => ord_relmon_unit MFreePr _ false @@ -548,8 +548,8 @@ Fixpoint bounded_do_while (n : nat) (c : MFreePr bool_choiceType) : (* Rem.: maybe something like the rule in the paper can be proven? yes... but I do not have intuition of how it could be used... examples needed! *) -Theorem bounded_do_while_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} {n : nat} - (c1 c2 : MFreePr bool_choiceType) +Theorem bounded_do_while_rule {A1 A2 : Type} {chA1 : Choice(* .class_of *) A1} {chA2 : Choice(* .class_of *) A2} {n : nat} + (c1 c2 : MFreePr bool) {inv : bool -> bool -> Prop} {H : ⊨ ⦃ inv true true ⦄ c1 ≈ c2 ⦃ fun b1 b2 => inv b1 b2 /\ b1 = b2 ⦄ } : ⊨ ⦃ inv true true ⦄ bounded_do_while n c1 ≈ bounded_do_while n c2 ⦃ fun l r => (l = false /\ r = false) \/ inv false false ⦄. @@ -614,7 +614,7 @@ Proof. rewrite HeqH11. assert ((fun x : X => (A x)%:R * psum (fun w : Choice.Pack chY => d (x, w))) = (fun x : X => psum (fun w : Choice.Pack chY => (A x)%:R * d (x, w)))) as H4. { extensionality k. rewrite -psumZ. reflexivity. - case (A k); intuition. by rewrite ler01. } + case (A k); intuition. (* by rewrite ler01. *) } rewrite H4. assert ((fun x : Y => (B x)%:R * dsnd d x) = (fun y : Y => (B y)%:R * psum (fun w => d (w, y)))) as HeqH12. { extensionality K. rewrite dsndE. reflexivity. } @@ -651,23 +651,23 @@ Proof. move: H. move/idP. intuition. by rewrite H !GRing.mulr0. (* summable B*) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ( (Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(_, y) := x in B y))%:R * d x) = (fun '(x, y) => (B y)%:R * d (x, y))) as Heq1. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable A *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY))%type => (nat_of_bool (let '(x, _) := x in A x))%:R * d x) = (fun '(x, y) => (A x)%:R * d (x, y))) as Heq2. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq2. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => A x) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. Qed. @@ -722,7 +722,7 @@ Proof. rewrite HeqH11. assert ((fun x : X => (A x)%:R * psum (fun w : Choice.Pack chY => d (x, w))) = (fun x : X => psum (fun w : Choice.Pack chY => (A x)%:R * d (x, w)))) as H4. { extensionality k. rewrite -psumZ. reflexivity. - case (A k); intuition. by rewrite ler01. } + case (A k); intuition. (* by rewrite ler01. *) } rewrite H4. assert ((fun x : Y => (B x)%:R * dsnd d x) = (fun y : Y => (B y)%:R * psum (fun w => d (w, y)))) as HeqH12. { extensionality K. rewrite dsndE. reflexivity. } @@ -739,7 +739,7 @@ Proof. - move => [x1 x2] /=. apply /andP. split. -- apply: mulr_ge0. - --- case: (A x1); rewrite //=. exact ler01. + --- case: (A x1); rewrite //=. (* exact ler01. *) --- by inversion d. -- have Hd0 : 0 <= d(x1,x2) by inversion d. have [Hdor1 | Hdor2]: 0 == d(x1,x2) \/ 0 < d(x1,x2). @@ -748,42 +748,42 @@ Proof. --- move/eqP : Hdor1 => Hdor1. by rewrite -Hdor1 !GRing.mulr0. --- apply: ler_pmul. - + case: (A x1); rewrite //=. exact ler01. + + case: (A x1); rewrite //=. (* exact ler01. *) + by inversion d. + move: (H2 x1 x2 Hdor2) => HAB. destruct (A x1) eqn: Ax1; rewrite //=; destruct (B x2) eqn : Bx2; rewrite //=. exfalso. by apply: true_false_False. - exact ler01. + (* exact ler01. *) auto. (* summable B *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(_, y) := x in B y))%:R * d x) = (fun '(x, y) => (B y)%:R * d (x, y))) as Heq1. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable B *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(_, y) := x in B y))%:R * d x) = (fun '(x, y) => (B y)%:R * d (x, y))) as Heq1. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable A *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(x, _) := x in A x))%:R * d x) = (fun '(x, y) => (A x)%:R * d (x, y))) as Heq2. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq2. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => A x) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. Qed. diff --git a/theories/Crypt/rules/RulesStateProb.v b/theories/Crypt/rules/RulesStateProb.v index 7f3b3a00..b039e698 100644 --- a/theories/Crypt/rules/RulesStateProb.v +++ b/theories/Crypt/rules/RulesStateProb.v @@ -8,7 +8,7 @@ From Relational Require Import OrderEnrichedCategory Set Warnings "-notation-overridden,-ambiguous-paths". From mathcomp Require Import all_ssreflect all_algebra reals distr realsum - finmap.set finmap.finmap xfinmap. + (* finmap.set *) finmap.finmap xfinmap. Set Warnings "notation-overridden,ambiguous-paths". From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings Theta_dens @@ -126,7 +126,7 @@ End RSemanticNotation. Import RSemanticNotation. #[local] Open Scope rsemantic_scope. -Import finmap.set finmap.finmap xfinmap. +Import finmap(* .set *) finmap.finmap xfinmap. Open Scope fset_scope. @@ -174,7 +174,7 @@ Proof. rewrite /semantic_judgement /θ. unfold "≤". simpl. rewrite /MonoCont_order //=. move => [ss1 ss2] πa1a2 /=. - exists (SDistr_unit (F_choice_prod (npair (prod_choiceType A1 S1) (prod_choiceType A2 S2))) + exists (SDistr_unit (F_choice_prod (npair (Datatypes_prod__canonical__choice_Choice A1 S1) (Datatypes_prod__canonical__choice_Choice A2 S2))) ((a1, ss1), (a2, ss2))). split. - rewrite /SubDistr.SDistr_obligation_1 /=. @@ -548,8 +548,8 @@ Qed. (* TODO: asymmetric variants of if_rule: if_ruleL and if_ruleR *) -Fixpoint bounded_do_while {S : choiceType} (n : nat) (c : FrStP S bool_choiceType) : - FrStP S bool_choiceType := +Fixpoint bounded_do_while {S : choiceType} (n : nat) (c : FrStP S bool) : + FrStP S bool := (* false means fuel emptied, true means execution finished *) match n with | 0 => retF false @@ -562,8 +562,8 @@ Fixpoint bounded_do_while {S : choiceType} (n : nat) (c : FrStP S bool_choiceTy Theorem bounded_do_while_rule {A1 A2 : ord_choiceType} {S1 S2 : choiceType} {n : nat} - (c1 : FrStP S1 bool_choiceType) - (c2 : FrStP S2 bool_choiceType) + (c1 : FrStP S1 bool) + (c2 : FrStP S2 bool) {inv : bool -> bool -> (S1 * S2) -> Prop} {H : ⊨ ⦃ inv true true ⦄ c1 ≈ c2 ⦃ fun bs1 bs2 => (inv bs1.1 bs2.1) (bs1.2, bs2.2) /\ bs1.1 = bs2.1 ⦄ } : ⊨ ⦃ inv true true ⦄ @@ -623,7 +623,7 @@ Proof. rewrite HeqH11. simpl in HeqH11. assert ((fun x : X * S1 => (A x)%:R * psum (fun w => d (x, w))) = (fun x : X * S1 => psum (fun w => (A x)%:R * d (x, w)))) as H4. { extensionality k. rewrite -psumZ. reflexivity. - case (A k); intuition. by rewrite ler01. } + case (A k); intuition. (* by rewrite ler01. *) } rewrite H4. assert ((fun x : Y * S2 => (B x)%:R * dsnd d x) = (fun y : Y * S2 => (B y)%:R * psum (fun w => d (w, y)))) as HeqH12. { extensionality K. rewrite dsndE. reflexivity. } @@ -665,8 +665,7 @@ Proof. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (prod_choiceType X S1) - (prod_choiceType Y S2)) + pose (@summable_pr R (Datatypes_prod__canonical__choice_Choice (Datatypes_prod__canonical__choice_Choice X S1) (Datatypes_prod__canonical__choice_Choice Y S2)) (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable A *) @@ -676,8 +675,7 @@ Proof. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq2. - pose (@summable_pr R (prod_choiceType (prod_choiceType X S1) - (prod_choiceType Y S2)) + pose (@summable_pr R ((X * S1) *(Y * S2))%type (fun '(x, y) => A x) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. Qed. @@ -783,7 +781,7 @@ Proof. clear Hpsum. eapply neq0_psum in Hpsum'. destruct Hpsum'. apply aux_domain in H. - destruct (eqType_lem bool_eqType ((x,x) == (a1,a2)) true) as [Houi | Hnon]. + destruct (eqType_lem bool ((x,x) == (a1,a2)) true) as [Houi | Hnon]. move: Houi => /eqP Houi. move: Houi => [H1 H2]. rewrite -H1 -H2. reflexivity. have Hnon' : (x,x) == (a1,a2) = false. destruct ((x,x) == (a1,a2)). contradiction. reflexivity. @@ -806,19 +804,19 @@ Qed. Definition dsym { A B : ord_choiceType } { S1 S2 : choiceType } (d : SDistr_carrier (F_choice_prod_obj - ⟨ Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |}, - Choice.Pack {| Choice.base := prod_eqMixin A S1; Choice.mixin := prod_choiceMixin A S1 |} ⟩)) : + ⟨ Choice.Pack (Choice.class (Datatypes_prod__canonical__choice_Choice B S2)), + Choice.Pack (Choice.class (Datatypes_prod__canonical__choice_Choice A S1)) ⟩)) : SDistr_carrier (F_choice_prod_obj - ⟨ Choice.Pack {| Choice.base := prod_eqMixin A S1; Choice.mixin := prod_choiceMixin A S1 |}, - Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |} ⟩) := + ⟨ Choice.Pack (Choice.class (Datatypes_prod__canonical__choice_Choice A S1)), + Choice.Pack (Choice.class (Datatypes_prod__canonical__choice_Choice B S2)) ⟩) := dswap d. Lemma dsym_coupling { A B : ord_choiceType } { S1 S2 : choiceType } { d : SDistr_carrier (F_choice_prod_obj - ⟨ Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |}, - Choice.Pack {| Choice.base := prod_eqMixin A S1; Choice.mixin := prod_choiceMixin A S1 |} ⟩) } + ⟨ Choice.Pack (Choice.class (Datatypes_prod__canonical__choice_Choice B S2)), + Choice.Pack (Choice.class (Datatypes_prod__canonical__choice_Choice A S1)) ⟩) } {d1 d2 } (Hcoupling : coupling d d1 d2) : coupling (dsym d) d2 d1. Proof. @@ -899,7 +897,7 @@ Lemma smMonEqu1 (r : A1 -> A2 -> FrStP S B) (c1 : FrStP S A1) (c2 : FrStP S A2) : (a2 ∈ choice_incl A2 <<- c2;; a1 ∈ choice_incl A1 <<- c1;; (r a1 a2)) = -(a ∈ choice_incl (prod_choiceType A1 A2) <<- +(a ∈ choice_incl (Datatypes_prod__canonical__choice_Choice A1 A2) <<- (a2 ∈ choice_incl A2 <<- c2;; a1 ∈ choice_incl A1 <<- c1;; retF (a1, a2));; r a.1 a.2). Proof. @@ -929,7 +927,7 @@ Lemma smMonEqu2 (r : A1 -> A2 -> FrStP S B) (c1 : FrStP S A1) (c2 : FrStP S A2) : (a1 ∈ choice_incl A1 <<- c1;; a2 ∈ choice_incl A2 <<- c2;; (r a1 a2)) = -(a ∈ choice_incl (prod_choiceType A1 A2) <<- +(a ∈ choice_incl (Datatypes_prod__canonical__choice_Choice A1 A2) <<- (a1 ∈ choice_incl A1 <<- c1;; a2 ∈ choice_incl A2 <<- c2;; retF (a1, a2));; r a.1 a.2). Proof. @@ -990,12 +988,12 @@ Lemma some_commutativity (s : S) : θ_dens (θ0 - (a ∈ choice_incl (prod_choiceType A1 A2) <<- + (a ∈ choice_incl (Datatypes_prod__canonical__choice_Choice A1 A2) <<- (a1 ∈ choice_incl A1 <<- c1;; a2 ∈ choice_incl A2 <<- c2;; retF (a1, a2));; r a.1 a.2) s) = θ_dens (θ0 - (a ∈ choice_incl (prod_choiceType A1 A2) <<- + (a ∈ choice_incl (Datatypes_prod__canonical__choice_Choice A1 A2) <<- (a2 ∈ choice_incl A2 <<- c2;; a1 ∈ choice_incl A1 <<- c1;; retF (a1, a2));; r a.1 a.2) s). Proof. @@ -1003,7 +1001,7 @@ Proof. pose ( p12 := (a1 ∈ choice_incl A1 <<- c1;; a2 ∈ choice_incl A2 <<- c2;; retF (a1, a2)) ). assert (θ0_comm : -(θ0 (a ∈ choice_incl (prod_choiceType A1 A2) <<- p12 ;; r a.1 a.2) s) +(θ0 (a ∈ choice_incl (Datatypes_prod__canonical__choice_Choice A1 A2) <<- p12 ;; r a.1 a.2) s) = (ord_relmon_bind Frp_fld)^~(θ0 p12 s) (fun xs' => let (x,s'):= xs' in θ0 (r x.1 x.2) s') ). @@ -1024,7 +1022,7 @@ Proof. pose ( p21 := (a2 ∈ choice_incl A2 <<- c2;; a1 ∈ choice_incl A1 <<- c1;; retF (a1, a2)) ). assert (θ0_comm : -(θ0 (a ∈ choice_incl (prod_choiceType A1 A2) <<- p21 ;; r a.1 a.2) s) +(θ0 (a ∈ choice_incl (Datatypes_prod__canonical__choice_Choice A1 A2) <<- p21 ;; r a.1 a.2) s) = (ord_relmon_bind Frp_fld)^~(θ0 p21 s) (fun xs' => let (x,s'):= xs' in θ0 (r x.1 x.2) s') ). @@ -1045,7 +1043,7 @@ Proof. (*next we apply bind preservation of θ_dens*) unshelve etransitivity. cbn. unshelve eapply (ord_relmon_bind SDistr). - - exact ( prod_choiceType (prod_choiceType A1 A2 ) S ). + - exact ( Datatypes_prod__canonical__choice_Choice (Datatypes_prod__canonical__choice_Choice A1 A2 ) S ). - move=> [x s']. exact ( θ_dens (θ0 (r x.1 x.2) s' ) ). - exact (θ_dens (θ0 p12 s)). unfold θ_dens at 1. @@ -1131,6 +1129,7 @@ Proof. apply Hcomm. - rewrite (@smMonEqu2 A1 A2 B S r c1 c2). move=> s. + pose some_commutativity. unshelve erewrite <- some_commutativity. exact post. reflexivity. apply HR. @@ -1428,7 +1427,7 @@ Qed. Lemma θ_dens_vs_bind' {X Y : choiceType} (m : Frp X ) -(k : X -> Frp (prod_choiceType Y S)) : +(k : X -> Frp (Datatypes_prod__canonical__choice_Choice Y S)) : θ_dens (bindrFree m k) = (dnib SDistr) (fun xs => θ_dens (k xs)) (utheta_dens_fld _ m). Proof. @@ -1439,7 +1438,7 @@ Proof. pose bla := rmm_law2 _ _ _ _ (@Theta_dens.unary_theta_dens) -X (prod_choiceType Y S) k. +X (Datatypes_prod__canonical__choice_Choice Y S) k. rewrite /= in bla. unshelve eapply equal_f in bla. exact m. rewrite /=. assumption. @@ -1500,9 +1499,9 @@ unshelve eassert (eq_cont : (OrderEnrichedRelativeAdjunctions.KleisliLeftAdjoint Frp) A), utheta_dens_fld (F_choice_prod_obj - ⟨ ord_functor_id ord_choiceType (prod_choiceType A (Arst (op_iota o))), + ⟨ ord_functor_id ord_choiceType (Datatypes_prod__canonical__choice_Choice A (Arst (op_iota o))), OrderEnrichedRelativeAdjunctionsExamples.mkConstFunc ord_choiceType ord_choiceType S - (prod_choiceType A (Arst (op_iota o))) ⟩) + (Datatypes_prod__canonical__choice_Choice A (Arst (op_iota o))) ⟩) (let (a, sc) := x in bindrFree sploP (λ r : choice_incl (Ar o), retrFree (a, r, sc)))) = fun x => let (a,sc) := x in @@ -1534,7 +1533,7 @@ Proof. rewrite /mlet /=. transitivity (psum - (fun x0 : X => psum (fun x1 : Y => p x0 * q x1 * dunit (T:=prod_choiceType X Y) (x0, x1) (x, y)))). + (fun x0 : X => psum (fun x1 : Y => p x0 * q x1 * dunit (T:=Datatypes_prod__canonical__choice_Choice X Y) (x0, x1) (x, y)))). { apply eq_psum. move=> x0. rewrite -psumZ /=. apply eq_psum. move=> y0 /=. @@ -1544,7 +1543,7 @@ Proof. symmetry. transitivity (psum - (fun x0 : Y => psum (fun x1 : X => p x1 * q x0 * dunit (T:=prod_choiceType X Y) (x1, x0) (x, y)))). + (fun x0 : Y => psum (fun x1 : X => p x1 * q x0 * dunit (T:=Datatypes_prod__canonical__choice_Choice X Y) (x1, x0) (x, y)))). { apply eq_psum. move=> y0. rewrite -psumZ /=. apply eq_psum. move=> x0 /=. @@ -1586,7 +1585,7 @@ Proof. destruct p as [pmap p_0 p_sum p_1]. apply p_0. apply ( summable_mu_wgtd (T:=X) - (f:=fun x0 => psum (fun y0 : Y => q y0 * dunit (T:=prod_choiceType X Y) (x0, y0) (x, y))) p). + (f:=fun x0 => psum (fun y0 : Y => q y0 * dunit (T:=Datatypes_prod__canonical__choice_Choice X Y) (x0, y0) (x, y))) p). move=> x0. apply /andP. split. apply ge0_psum. unshelve eapply Order.POrderTheory.le_trans. diff --git a/theories/Crypt/rules/UniformDistrLemmas.v b/theories/Crypt/rules/UniformDistrLemmas.v index a051ac4a..27a15422 100644 --- a/theories/Crypt/rules/UniformDistrLemmas.v +++ b/theories/Crypt/rules/UniformDistrLemmas.v @@ -61,9 +61,9 @@ Qed. (* Rem.: TODO: generalize this *) Lemma sum_const_seq_finType { T : finType } ( J : seq T) (k : R) (Huniq : uniq J) : - \sum_(j <- J) k = \sum_(j in (seq_sub_finType J)) k. + \sum_(j <- J) k = \sum_(j in (fintype_seq_sub__canonical__fintype_Finite J)) k. Proof. - rewrite /seq_sub_finType. simpl. + rewrite /fintype_seq_sub__canonical__fintype_Finite. simpl. rewrite big_const. rewrite big_const_seq. rewrite card_seq_sub. @@ -81,11 +81,11 @@ Proof. rewrite sum_const_seq_finType. 2: { exact Huniq. } rewrite GRing.sumr_const pmulrn /=. - have hfoo' : k *~ #|seq_sub_finType (T:=T) J| = k * #|seq_sub_finType (T:=T) J|%:~R. + have hfoo' : k *~ #|fintype_seq_sub__canonical__fintype_Finite (T:=T) J| = k * #|fintype_seq_sub__canonical__fintype_Finite (T:=T) J|%:~R. { by rewrite mulrzr. } rewrite hfoo' /=. apply: ler_pmul; auto. - - rewrite ler0z. rewrite lez_nat. reflexivity. + (* - rewrite ler0z. rewrite lez_nat. reflexivity. *) - rewrite card_seq_sub. 2: eauto. rewrite cardT. rewrite ler_int. rewrite lez_nat. @@ -161,12 +161,12 @@ Qed. (* TODO RENAME *) Lemma sum_prod_bij {T : finType} {f : T -> T} - (π : (prod_finType T T) -> R) + (π : ( Datatypes_prod__canonical__fintype_Finite T T : finType) -> R) (π_geq0 : forall t, 0 <= π t) : - \sum_(jj <- enum (prod_finType T T)) (if f jj.1 == jj.2 then π jj else 0) = + \sum_(jj <- enum (Datatypes_prod__canonical__fintype_Finite T T)) (if f jj.1 == jj.2 then π jj else 0) = \sum_(j <- enum T) (π (j, f j)). Proof. - rewrite [X in X=_](bigID [pred jj : prod_finType T T | f jj.1 == jj.2]) /=. + rewrite [X in X=_](bigID [pred jj : Datatypes_prod__canonical__fintype_Finite T T | f jj.1 == jj.2]) /=. match goal with | |- _ + ?x = _ => assert (e : x == 0) @@ -300,7 +300,7 @@ Proof. Qed. Lemma support_sub_diag_mgs { A : choiceType } - ( d : SDistr (prod_choiceType A A) ) + ( d : SDistr (A * A)%type ) (Hsupp : forall a1 a2, 0 < d (a1, a2) -> a1 = a2) : forall a : A, lmg d a = d (a, a) /\ rmg d a = d (a, a). Proof. @@ -350,7 +350,7 @@ Section prod_uniform. Arguments r _ {_}. Lemma prod_uniform : - @uniform_F (prod_finType X Y) (x0,y0) = + @uniform_F (Datatypes_prod__canonical__fintype_Finite X Y) (x0,y0) = SD_bind (@uniform_F X x0) (fun x => SD_bind (@uniform_F Y y0) (fun y => SD_ret (x,y))). @@ -372,9 +372,9 @@ Section prod_uniform. { rewrite /SD_ret. pose hlp := ( @psum_pair _ X Y - (fun (x12 : prod_finType X Y) => + (fun (x12 : Datatypes_prod__canonical__fintype_Finite X Y) => let (x1,x2) := x12 in - SDistr_unit (prod_choiceType X Y) (x1,x2) (x,y)) + SDistr_unit (X * Y)%type (x1,x2) (x,y)) ). rewrite -hlp. - unshelve erewrite eq_psum. diff --git a/theories/Crypt/rules/UniformStateProb.v b/theories/Crypt/rules/UniformStateProb.v index caa9c1b8..635e5fe8 100644 --- a/theories/Crypt/rules/UniformStateProb.v +++ b/theories/Crypt/rules/UniformStateProb.v @@ -117,7 +117,7 @@ Proof. rewrite Heq'. rewrite GRing.mulr1. reflexivity. - have Heq' : st == s = false. apply /eqP. move /eqP: Heq. congruence. rewrite Heq'. rewrite GRing.mulr0. reflexivity. - Unshelve. exact (Real.ringType R). + Unshelve. exact (reals_Real__to__GRing_SemiRing R). Qed. Definition f_dprod { F1 F2: finType } { S1 S2 : choiceType } { w0 : F1 } { w0' : F2 } {s1 : S1 } {s2 : S2} @@ -221,18 +221,18 @@ Proof. rewrite ler_pmul2l. * rewrite ler_int. auto. * unfold r. apply mulr_gt0. - -- cbn. rewrite posnum.one_pos_gt0. reflexivity. + -- cbn. exact ltr01. -- rewrite -(@pmulr_rgt0 _ #|F1|%:~R). ++ rewrite -(GRing.mul1r (#|F1|%:~R / #|F1|%:~R)). rewrite GRing.mulrA. rewrite GRing.Theory.mulfK. - ** rewrite posnum.one_pos_gt0. reflexivity. + ** exact ltr01. ** unshelve eapply card_non_zero. auto. ++ eapply fintype0 in w0 as h. destruct #|F1| eqn:e. 1: contradiction. rewrite ltr0n. reflexivity. + unfold r. rewrite -[X in X <= _]mulrzr. rewrite GRing.div1r. - erewrite <- GRing.mulr1. rewrite -GRing.mulrA. + set (#|F1|%:~R) at 2 ; erewrite <- (GRing.mulr1 s) ; subst s. rewrite GRing.Theory.mulKf. * auto. * unshelve eapply card_non_zero. auto. @@ -241,8 +241,8 @@ Qed. Definition UniformFsq_f { F1 F2 : finType} { w0 : F1 } { w0' : F2 } { S1 S2 : choiceType } { s1 : S1 } { s2 : S2 } {f : F1 -> F2} (f_bij : bijective f): - SDistr (ChoiceAsOrd.F_choice_prod ⟨ ChoiceAsOrd.F_choice_prod ⟨ Finite.choiceType F1 , S1 ⟩ , - ChoiceAsOrd.F_choice_prod ⟨ Finite.choiceType F2 , S2 ⟩ ⟩ ). + SDistr (ChoiceAsOrd.F_choice_prod ⟨ ChoiceAsOrd.F_choice_prod ⟨ fintype_Finite__to__choice_Choice F1 , S1 ⟩ , + ChoiceAsOrd.F_choice_prod ⟨ fintype_Finite__to__choice_Choice F2 , S2 ⟩ ⟩ ). Proof. unshelve eapply mkdistr. 1:{ diff --git a/theories/Jasmin/examples/add1.cprog b/theories/Jasmin/examples/add1.cprog new file mode 100644 index 00000000..0bc34613 --- /dev/null +++ b/theories/Jasmin/examples/add1.cprog @@ -0,0 +1,81 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = arg.141}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (4, 0); + loc_end = (4, 9); loc_bchar = 52; loc_echar = 61}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (4, 0); + loc_end = (4, 1); loc_bchar = 52; loc_echar = 53}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = arg.141}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (4, 5); + loc_end = (4, 8); loc_bchar = 57; loc_echar = 60}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (5, 0); + loc_end = (5, 7); loc_bchar = 62; loc_echar = 69}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (5, 0); + loc_end = (5, 1); loc_bchar = 62; loc_echar = 63}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; + loc_start = (5, 0); loc_end = (5, 1); loc_bchar = 62; + loc_echar = 63}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (6, 7); + loc_end = (6, 8); loc_bchar = 77; loc_echar = 78}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/add1.jazz b/theories/Jasmin/examples/add1.jazz new file mode 100644 index 00000000..7086214c --- /dev/null +++ b/theories/Jasmin/examples/add1.jazz @@ -0,0 +1,7 @@ +export +fn add1(reg u64 arg) -> reg u64 { +reg u64 z; +z = arg; +z += 1; +return z; +} diff --git a/theories/Jasmin/examples/add1.v b/theories/Jasmin/examples/add1.v new file mode 100644 index 00000000..997f0be2 --- /dev/null +++ b/theories/Jasmin/examples/add1.v @@ -0,0 +1,69 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add1 *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "arg.139" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "arg.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD1 := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/aes.jazz b/theories/Jasmin/examples/aes.jazz new file mode 100644 index 00000000..08cf1c30 --- /dev/null +++ b/theories/Jasmin/examples/aes.jazz @@ -0,0 +1,20 @@ +from AES require "aes.jinc" + +/* We typically pack all functions that may be used + by other jasmin programs in jinc files. + Then we create jazz files just for entry-point + specific code */ + +export +fn aes_jazz(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + out = aes(key,in); + return out; +} + +export +fn invaes_jazz(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + out = invaes(key,in); + return out; +} diff --git a/theories/Jasmin/examples/aes.jinc b/theories/Jasmin/examples/aes.jinc new file mode 100644 index 00000000..30e8742c --- /dev/null +++ b/theories/Jasmin/examples/aes.jinc @@ -0,0 +1,124 @@ +/* Jasmin implementation of AES using AES-NI */ +/* This can be reused without change wherever + AES-NI is needed to compute vanilla AES or + its inverse */ + +inline fn RCON (inline int i) -> inline int { + inline int c; + c = (i == 1) ? 1 : + ((i == 2) ? 2 : + ((i == 3) ? 4 : + ((i == 4) ? 8 : + ((i == 5) ? 16 : + ((i == 6) ? 32 : + ((i == 7) ? 64 : + ((i == 8) ? 128 : + ((i == 9) ? 27 : + /* i == 10 */ 54)))))))); + return c; +} + +inline fn key_combine(reg u128 rkey, reg u128 temp1, reg u128 temp2) + -> reg u128, reg u128 { + temp1 = #VPSHUFD(temp1, (4u2)[3,3,3,3]); + temp2 = #VSHUFPS(temp2, rkey, (4u2)[0,1,0,0]); + rkey ^= temp2; + temp2 = #VSHUFPS(temp2, rkey, (4u2)[2,0,3,0]); + rkey ^= temp2; + rkey ^= temp1; + return rkey, temp2; +} + +inline fn key_expand(inline int rcon, reg u128 rkey, reg u128 temp2) + -> reg u128, reg u128 { + reg u128 temp1; + temp1 = #VAESKEYGENASSIST(rkey, rcon); + rkey, temp2 = key_combine(rkey, temp1, temp2); + return rkey, temp2; +} + +inline fn keys_expand(reg u128 key) -> reg u128[11] { + reg u128[11] rkeys; + reg u128 temp2; + inline int round, rcon; + rkeys[0] = key; + temp2 = #set0_128(); + for round = 1 to 11 { + rcon = RCON(round); + (key, temp2) = key_expand(rcon, key, temp2); + rkeys[round] = key; + } + return rkeys; +} + +inline fn keys_expand_inv(reg u128 key) -> reg u128[11] { + reg u128[11] rkeys; + reg u128 temp2; + inline int round, rcon; + rkeys[0] = key; + temp2 = #set0_128(); + for round = 1 to 11 { + rcon = RCON(round); + (key, temp2) = key_expand(rcon, key, temp2); + if (round != 10) { + rkeys[round] = #AESIMC(key); + } else { + rkeys[round] = key; + } + } + return rkeys; +} + +inline fn aes_rounds (reg u128[11] rkeys, reg u128 in) -> reg u128 { + reg u128 state; + inline int round; + state = in; + state ^= rkeys[0]; + for round = 1 to 10 { + state = #AESENC(state, rkeys[round]); + } + state = #AESENCLAST(state, rkeys[10]); + return state; +} + +inline fn AddRoundKey(reg u128 state, stack u128 rk) -> reg u128 { + state = state ^ rk; + return state; +} + +inline fn invaes_rounds (reg u128[11] rkeys, reg u128 in) -> reg u128 { + reg u128 state; + inline int round; + stack u128 rk; + state = in; + rk = rkeys[10]; + state = AddRoundKey(state,rk); + for round = 9 downto 0 { + state = #AESDEC(state, rkeys[round]); + } + state = #AESDECLAST(state, rkeys[0]); + return state; +} + +/* Functions typically called from other Jasmin programs. + Note they always compute key expansion, and this may + not be a good in terms of performance. */ +inline +fn aes(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + reg u128[11] rkeys; + + rkeys = keys_expand(key); + out = aes_rounds(rkeys, in); + return out; +} + +inline +fn invaes(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + reg u128[11] rkeys; + + rkeys = keys_expand_inv(key); + out = invaes_rounds(rkeys, in); + return out; +} diff --git a/theories/Jasmin/examples/aes.v b/theories/Jasmin/examples/aes.v new file mode 100644 index 00000000..5af98609 --- /dev/null +++ b/theories/Jasmin/examples/aes.v @@ -0,0 +1,1043 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* invaes_jazz *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.278" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.279" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.280" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.279" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.280" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes_jazz *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.281" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.282" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.283" |} + ; v_info := dummy_var_info |}] + (xO (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.281" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.282" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.283" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.284" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.285" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.287" |} + ; v_info := dummy_var_info |}] + (xO (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.284" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.286" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.287" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.285" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.286" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes *) xO (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.288" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.289" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.291" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.288" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.290" |} + ; v_info := dummy_var_info |}] + (xI (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.289" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.290" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes_rounds *) xI (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.293" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.293" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rk.295" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH)))))))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.295" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.296" |} + ; v_info := dummy_var_info |}) + ((DownTo, (Pconst (Z0))), (Pconst (Zpos (xI (xO (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDEC *) (BaseOp (None, AESDEC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.296" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDECLAST *) (BaseOp (None, AESDECLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* AddRoundKey *) xI (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rk.298" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes_rounds *) xI (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.300" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.300" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.302" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENC *) (BaseOp (None, AESENC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.302" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENCLAST *) (BaseOp (None, AESENCLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH))))))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand_inv *) xO (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.305" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.307" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.305" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.307" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.305" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oneq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep + (Oasm (* AESIMC *) (BaseOp (None, AESIMC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand *) xO (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.309" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.310" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.311" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.312" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.310" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.312" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.309" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.309" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_expand *) xO (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint; (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "rcon.313" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.316" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VAESKEYGENASSIST *) + (BaseOp (None, VAESKEYGENASSIST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.316" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_combine *) xO (xO (xI xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VPSHUFD_128 *) (BaseOp (None, (VPSHUFD U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH))); + (Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH)))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Z0)); (Pconst (Zpos (xH))); (Pconst (Z0)); + (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xO xH))); (Pconst (Z0)); + (Pconst (Zpos (xI xH))); (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* RCON *) xI (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "c.321" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xO xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH)))) + (Pconst (Zpos (xO (xO xH)))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO xH))))) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xO xH))))) + (Pconst (Zpos (xO (xO (xO (xO xH)))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI xH))))) + (Pconst (Zpos (xO (xO (xO (xO (xO xH))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.320" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.320" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO (xO xH)))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO (xO xH))))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := + sint + ; vname := + "i.320" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst + (Zpos (xI (xO (xO xH)))))) + (Pconst + (Zpos (xI (xI (xO (xI xH)))))) + (Pconst + (Zpos (xO (xI (xI (xO (xI xH)))))))))))))))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "c.321" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation INVAES_JAZZ := ( xH ). +Notation AES_JAZZ := ( xI xH ). +Notation INVAES := ( xO xH ). +Notation AES := ( xO (xO xH) ). +Notation INVAES_ROUNDS := ( xI (xO xH) ). +Notation ADDROUNDKEY := ( xI (xO (xO xH)) ). +Notation AES_ROUNDS := ( xI (xI xH) ). +Notation KEYS_EXPAND_INV := ( xO (xI xH) ). +Notation KEYS_EXPAND := ( xO (xO (xO xH)) ). +Notation KEY_EXPAND := ( xO (xI (xO xH)) ). +Notation KEY_COMBINE := ( xO (xO (xI xH)) ). +Notation RCON := ( xI (xI (xO xH)) ). \ No newline at end of file diff --git a/theories/Jasmin/examples/aes/aes.v b/theories/Jasmin/examples/aes/aes.v new file mode 100644 index 00000000..39e06e55 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes.v @@ -0,0 +1,672 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra zify. +From mathcomp Require Import word_ssrZ word. +Set Warnings "notation-overridden,ambiguous-paths". + +From Coq Require Import Utf8 ZArith micromega.Lia List. + +From Jasmin Require Import expr xseq waes word x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_utils jasmin_translate word aes_jazz aes_utils aes_spec. + +From Relational Require Import OrderEnrichedCategory. +From Crypt Require Import Prelude Package ChoiceAsOrd choice_type. + +From extructures Require Import ord fset fmap. + +Import ListNotations. +Import JasminNotation JasminCodeNotation. +Import PackageNotation. +Import AesNotation. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Local Open Scope Z. + +Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. + +Lemma rcon_E (id0 : p_id) pre (i : Z) : + (pdisj pre id0 fset0) -> + (forall s0 s1, pre (s0, s1) -> (1 <= i < 11)%Z) -> + ⊢ ⦃ fun '(s0, s1) => pre (s0, s1) ⦄ JRCON id0 i + ≈ ret tt + ⦃ fun '(v0, s0) '(v1, s1) => pre (s0, s1) /\ exists (o : (λ i0 : Choice.sort choice_type_choiceType, Choice.sort (chElement i0)) 'int), v0 = [('int ; o)] /\ o = wunsigned (rcon i) ⦄. +Proof. + unfold JRCON. + unfold get_translated_static_fun. + intros Hpdisj H. + simpl_fun. + repeat setjvars. + repeat match goal with + | |- context[(?a =? ?b)%Z] => let E := fresh in destruct (a =? b)%Z eqn:E; [rewrite ?Z.eqb_eq in E; subst|] + | |- _ => simpl; ssprove_contract_put_get_lhs; rewrite !coerce_to_choice_type_K + end. + all: ssprove_code_simpl; rewrite !coerce_to_choice_type_K; eapply r_put_lhs; ssprove_contract_put_get_lhs; eapply r_put_lhs; eapply r_ret. + all: intros; destruct_pre; split_post; [ pdisj_apply Hpdisj | rewrite coerce_to_choice_type_K; eexists; split; eauto ]. + destruct (i =? 10)%Z eqn:E. + - rewrite Z.eqb_eq in E. subst. reflexivity. + - apply H in H13. lia. +Qed. + +Arguments nat_of_wsize : simpl never. +Arguments wsize_size_minus_1 : simpl never. + +Lemma key_expand_aux rcon rkey temp2 rcon_ : + word.toword rcon_ = rcon -> + word.subword 0 U32 temp2 = word.word0 -> + ((rkey ⊕ lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey) + ⊕ lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 3; 0; 2])) U128 (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey) + (rkey ⊕ lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey)) ⊕ wpshufd_128 (wAESKEYGENASSIST rkey (wrepr U8 rcon)) (wunsigned (wpack U8 2 [3; 3; 3; 3])) = + key_expand rkey rcon_. +Proof. + Set Printing Implicit. + intros. + subst. + unfold key_expand. + apply (wcat_eq U32 4). + intros [[ | [ | [ | [ | i]]]] j]; simpl; unfold tnth; simpl. + - rewrite !subword_xor; auto. + rewrite mul0n. + unfold lift2_vec. + rewrite !make_vec_ws. + simpl. + rewrite !subword_u. + simpl. + rewrite !subword_make_vec_32_0_32_128. + unfold wpack. + simpl. + unfold wpshufd1. + simpl. + rewrite !wshr0. + rewrite !subword_make_vec_32_0_32_128. + simpl. + unfold wAESKEYGENASSIST. + rewrite subword_wshr; auto. + rewrite subword_make_vec_32_3_32_128. + simpl. + rewrite !wxorA. + f_equal. + unfold wpshufd1. + simpl. + rewrite wshr0. + rewrite -wxorA. + rewrite wxor_involutive. + rewrite wxor_0_l. + rewrite RotWord_SubWord. + unfold word.wxor. + f_equal. + rewrite wreprI. + reflexivity. + - simpl. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite mul1n. + unfold wpack. + simpl. + rewrite mul0n. + rewrite !subword_u. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_1_32_128. + simpl. + unfold wpshufd1. + simpl. + rewrite !subword_wshr; auto. + rewrite !addn0. + rewrite !subword_make_vec_32_3_32_128. + simpl. + unfold wpshufd1. + rewrite subword_wshr; auto. + simpl. + rewrite addn0. + rewrite !wxorA. + f_equal. + rewrite H0. + rewrite wxor_0_l. + f_equal. + rewrite RotWord_SubWord. + unfold word.wxor. + f_equal. + rewrite wreprI. + reflexivity. + - simpl. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite mul1n. + unfold wpack. + simpl. + rewrite mul0n. + rewrite !subword_u. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_2_32_128. + simpl. + unfold wpshufd1. + simpl. + rewrite !subword_wshr; auto. + rewrite !addn0. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_3_32_128. + simpl. + rewrite !subword_make_vec_32_0_32_128. + unfold wpshufd1. + rewrite subword_wshr; auto. + simpl. + rewrite addn0. + rewrite !wxorA. + f_equal. + rewrite H0. + rewrite wxor_0_l. + f_equal. + f_equal. + rewrite RotWord_SubWord. + unfold word.wxor. + f_equal. + rewrite wreprI. + reflexivity. + - simpl. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite mul1n. + unfold wpack. + simpl. + rewrite mul0n. + rewrite !subword_u. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_3_32_128. + simpl. + unfold wpshufd1. + simpl. + rewrite !subword_wshr; auto. + rewrite !addn0. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_3_32_128. + simpl. + rewrite !subword_make_vec_32_2_32_128. + unfold wpshufd1. + rewrite subword_wshr; auto. + simpl. + rewrite !wxorA. + f_equal. + rewrite wxorC. + rewrite !wxorA. + f_equal. + rewrite subword_wshr; auto. + rewrite addn0. + f_equal. + rewrite RotWord_SubWord. + rewrite wxorC. + rewrite wxorA. + f_equal. + f_equal. + rewrite wreprI. + reflexivity. + all: auto. + - lia. +Qed. + +Lemma key_expand_aux2 rkey temp2 : + word.subword 0 U32 temp2 = word.word0 -> + word.subword 0 U32 + (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 3; 0; 2])) U128 (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey) + (word.wxor rkey (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey))) = word.word0. +Proof. + intros. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite subword_make_vec_32_0_32_128. simpl. + unfold wpshufd1. simpl. + rewrite subword_wshr; auto. simpl. + rewrite addn0. + rewrite subword_u. + rewrite subword_make_vec_32_0_32_128. simpl. + rewrite subword_u. + unfold wpshufd1. simpl. + rewrite subword_wshr; auto. +Qed. + +Lemma key_expand_E pre id0 rcon rkey temp2 rcon_ : + pdisj pre id0 fset0 → + word.toword rcon_ = rcon → + (forall s0 s1, pre (s0, s1) -> word.subword 0 U32 temp2 = word.word0) → + ⊢ ⦃ λ '(s0, s1), pre (s0, s1) ⦄ + JKEY_EXPAND id0 rcon rkey temp2 + ≈ ret tt + ⦃ λ '(v0, s0) '(v1, s1), + pre (s0, s1) ∧ + ∃ o1 o2, + v0 = [ ('word U128 ; o1) ; ('word U128 ; o2) ] ∧ + o1 = key_expand rkey rcon_ ∧ + word.subword 0 U32 o2 = word.word0 + ⦄. +Proof. + unfold JKEY_EXPAND, get_translated_static_fun. + intros disj Hrcon Htemp2. + simpl_fun. simpl. + repeat setjvars. + repeat clear_get. + unfold sopn_sem, tr_app_sopn_tuple, tr_app_sopn_single. + simpl. + rewrite !zero_extend_u. + rewrite !coerce_to_choice_type_K. + repeat eapply r_put_lhs. + eapply r_ret. + intros s0 s1 Hpre. + destruct_pre; split_post. + - pdisj_apply disj. + - eexists _, _. intuition auto. + + apply key_expand_aux; eauto. + + apply key_expand_aux2; eauto. +Qed. + +Lemma keyExpansion_E pre id0 rkey : + (pdisj pre id0 (fset [rkeys])) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JKEYS_EXPAND id0 rkey + ≈ + keyExpansion rkey + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ exists o, v0 = [( 'array ; o)] /\ to_arr U128 (Zpos 11) o = v1 ⦄. +Proof. + intros disj. + unfold JKEYS_EXPAND, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_call. + Opaque wrange. + Opaque for_loop. + + simpl. simpl_fun. + repeat setjvars. + repeat clear_get. + ssprove_code_simpl. + ssprove_code_simpl_more. + + eapply r_put_lhs. + eapply r_get_remember_lhs. intros v. + eapply r_put_lhs. + eapply r_put_lhs. + + unfold keyExpansion. + eapply r_put_rhs. + eapply r_get_remember_rhs. intros v0. + eapply r_put_rhs. + + eapply r_bind. + - simpl. + eapply rpre_weaken_rule. + + eapply translate_for_rule with + (I := fun i => fun '(h0, h1) => pre (h0, h1) + /\ word.subword 0 U32 (get_heap h0 temp2) = word.word0 + /\ (get_heap h0 key = chArray_get U128 (get_heap h0 rkeys) (i - 1) 16) + /\ (forall j, (0 <= j < i) -> (to_arr U128 (Zpos 11) (get_heap h0 rkeys)) j = (get_heap h1 aes_spec.rkeys) j) + /\ (forall j, (j < 0) \/ (11 <= j) -> get_heap h1 aes_spec.rkeys j = None)). + + (* the two following bullets are small assumptions of the translate_for rule *) + * intros. simpl. solve_preceq. + * lia. + (* Inductive step of the for loop rule, we have to prove the bodies are equivalent and imply the successor predicate *) + * intros i s_id Hs_id ile. + ssprove_code_simpl. + + eapply r_get_remember_lhs. intros. + + (* Now we apply the correctnes of rcon *) + eapply r_bind with (m₁ := ret _) (f₁ := fun _ => _). + ** eapply rcon_E with (id0 := (s_id~1)%positive) (i:=x). + (* We have to prove the precond is disjoint from the variables of rcon, i.e. any variables stored locally in rcon does not change the precond *) + *** split. + (* rcon_correct does not use any variables on the rhs *) + 2: { easy. } + intros s0 s1 l a vr s_id' Hl Hs_id' H. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_I. etransitivity. 1: eassumption. etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: eapply preceq_prec_trans. 1: etransitivity. 1: eapply preceq_I. 1: eassumption. 1: eapply prec_I. assumption. + } + intros. destruct_pre. split_post. + { eapply disj; eauto. } + { sheap. assumption. } + { sheap. assumption. } + { sheap. assumption. } + { assumption. } + { rewrite set_heap_commut; auto. + apply injective_translate_var2. assumption. } + { simpl. sheap. reflexivity. } + (* this is an assumption of rcon_correct *) + *** intros; destruct_pre. fold round. sheap. rewrite coerce_to_choice_type_K. lia. + (* we continue after the rcon call *) + ** intros a0 a1. + simpl; ssprove_code_simpl. + (* we need to know the value of a0 here *) + eapply rpre_weak_hypothesis_rule; intros. + destruct_pre; simpl. + fold rcon. + repeat clear_get. + eapply r_put_lhs with (pre := λ '(s0',s1'), _ ). + eapply r_get_remember_lhs. intros x1. + eapply r_get_remember_lhs. intros x2. + sheap. + + eapply r_bind with (m₁ := ret _) (f₁ := fun _ => _). + + (* First we apply correctness of key_expandP *) + *** (* Here the rewrite is necessary. How should correctness be phrased in general such that this is not important? *) + rewrite !coerce_to_choice_type_K. + eapply key_expand_E with (id0 := (s_id~0~1)%positive) (rcon := (wunsigned (aes_spec.rcon i))) (rkey := x1) (temp2 := x2) (rcon_ := aes_spec.rcon i). + (* again, we have to prove that our precond does not depend key_expand locations *) + { split. + (* key_expandP also does not use variables on the rhs *) + 2: { easy. } + intros s0 s1 l a vr s_id' Hl Hs_id' H1. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_I. etransitivity. 1: eassumption. etransitivity. 1: eapply preceq_O. etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: eapply preceq_prec_trans. 1: etransitivity. 1: eapply preceq_I. 1: eassumption. 1: eapply prec_O. etransitivity. 1: eapply prec_I. assumption. + } + destruct_pre. sheap. split_post. + { eapply disj; eauto. } + { sheap; assumption. } + { sheap; assumption. } + { sheap; assumption. } + { assumption. } + { reflexivity. } + { simpl. sheap. reflexivity. } + { eexists. eauto. } + { rewrite set_heap_commut; [ | neq_loc_auto ]. + rewrite [set_heap _ _ a](set_heap_commut); [ | neq_loc_auto ]. + reflexivity. } + { simpl. sheap. reflexivity. } + { simpl. sheap. reflexivity. } + } + (* this is an assumption of key_expandP, true by definition of rcon *) + { reflexivity. } + { intros. destruct_pre. sheap. assumption. } + (* we continue after the call *) + *** intros. + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. simpl. + rewrite !zero_extend_u. + + eapply r_put_lhs with (pre := λ '(s0',s1'), _). + eapply r_put_lhs. + eapply r_get_remember_lhs. intros x2. + eapply r_get_remember_lhs. intros x3. + eapply r_get_remember_lhs. intros x4. + eapply r_put_lhs. + eapply r_get_remember_rhs. intros x5. + eapply r_put_rhs. + eapply r_ret. + + sheap. + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + intros s6 s7 H24. + + destruct_pre. + sheap. + + split_post. + (* here we prove that the invariant is preserved after a single loop, assuming it holds before *) + { pdisj_apply disj. auto_in_fset. } + { assumption. } + { replace (Z.succ i - 1) with i by lia. + rewrite chArray_get_set_eq. + reflexivity. } + { intros j Hj. + destruct (Z.eq_dec i j). + + (* i = j *) + - subst. simpl. + pose proof to_arr_set_eq. + simpl. + rewrite to_arr_set_eq. 2: lia. + rewrite setmE. rewrite eq_refl. + + f_equal. unfold getmd. rewrite -H41. 2: lia. rewrite getm_to_arr. 2: lia. + f_equal. rewrite !get_set_heap_neq in H33. 2-3: neq_loc_auto. rewrite -H33. assumption. + + (* i <> j *) + - rewrite to_arr_set_neq. 2-3: lia. + rewrite setmE. + assert (@eq bool (@eq_op Z_ordType j i) false). 1: apply/eqP; auto. + rewrite H3. + apply H41. lia. } + { intros j Hj. + + rewrite setmE. + (* why do I have to set printing off to realize this? Shouldn't j == i always mean the same on the same type? *) + assert (@eq_op (Ord.eqType Z_ordType) j i = false). 1: apply/eqP; lia. + rewrite H3. + apply H43. + assumption. } + (* the next bullet is the proof that the invariant of the for loop is true at the beginning (this goal is generated by pre_weaken rule and translate_for) *) + + intros s0 s1 H. + destruct_pre. + sheap. + + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + + split_post. + (* prove that pre is preserved *) + * pdisj_apply disj. all: auto_in_fset. + (* first invariant *) + * simpl. unfold tr_app_sopn_tuple. simpl. rewrite subword_word0. reflexivity. + (* second invariant *) + * rewrite chArray_get_set_eq. reflexivity. + (* third invariant *) + * intros j Hj. assert (j = 0) by lia. subst. + rewrite to_arr_set_eq. 1: rewrite setmE; rewrite eq_refl; reflexivity. lia. + * intros. rewrite setmE. + (* Set Printing All. *) + replace (_ == _) with false. + 1: apply emptymE. symmetry. apply/eqP. lia. + (* after for loop *) + - intros a0 a1. + simpl. + eapply r_get_remember_lhs with (pre := fun '(s0, s1) => _). intros x. + eapply r_get_remember_rhs. intros x0. + eapply r_ret. + intros s0 s1 H. + destruct_pre. split_post. + (* prove the final post conditions: pre and that the values of rkeys agree *) + + assumption. + + eexists. split. 1: reflexivity. + eapply eq_fmap. intros j. + simpl. + destruct ((0 <=? j) && (j getm_to_arr_None' by lia. + rewrite H6; auto. + lia. +Qed. + +Lemma aes_rounds_E pre id0 rkeys msg : + (pdisj pre id0 (fset [state])) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JAES_ROUNDS id0 rkeys msg + ≈ + aes_rounds (to_arr U128 (Zpos 11) rkeys) msg + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ exists o, v0 = [ ('word U128 ; o) ] /\ o = v1 ⦄. +Proof. + unfold JAES_ROUNDS, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + intros disj. + + Opaque translate_call. + Opaque wrange. + Opaque for_loop. + + simpl. simpl_fun. + repeat setjvars. + ssprove_code_simpl. + ssprove_code_simpl_more. + unfold aes_rounds. + + repeat clear_get. + do 4 eapply r_put_lhs. + eapply r_put_rhs. + + eapply r_bind. + - eapply translate_for_rule_weaken with + (I := fun i => fun '(h0, h1) => pre (h0, h1) + /\ get_heap h0 state = get_heap h1 aes_spec.state + /\ get_heap h0 rkeys0 = rkeys). + + intros; destruct_pre. + rewrite !zero_extend_u. + rewrite !coerce_to_choice_type_K. + sheap. + split_post. + * pdisj_apply disj. auto_in_fset. + * rewrite getmd_to_arr; auto. lia. + * reflexivity. + + intros. simpl. auto with preceq. + + lia. + + intros. + repeat (eapply r_get_remember_lhs; intros). + eapply r_put_lhs. + eapply r_get_remember_rhs; intros. + eapply r_put_rhs. + eapply r_ret. + intros s0 s1 Hpre; destruct_pre. + unfold tr_app_sopn_tuple. + simpl. + rewrite !zero_extend_u. + rewrite !coerce_to_choice_type_K. + sheap. + split_post. + * pdisj_apply disj. auto_in_fset. + * rewrite -> H12. + rewrite wAESENC_wAESENC_. + rewrite getmd_to_arr; auto. + lia. + * reflexivity. + - intros a0 a. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x. + eapply r_get_remember_lhs. intros x0. + eapply r_put_lhs. + eapply r_get_remember_lhs. intros x1. + + eapply r_get_remember_rhs. intros x2. + eapply r_put_rhs. + eapply r_get_remember_rhs. intros x3. + eapply r_ret. + + intros s0 s1 Hpre; destruct_pre. + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + sheap. + split_post. + + pdisj_apply disj. auto_in_fset. + + unfold tr_app_sopn_tuple. + simpl. + rewrite !zero_extend_u. + rewrite -> H6. + rewrite getmd_to_arr; try lia. + rewrite wAESENCLAST_wAESENCLAST_. + eexists. split. + * reflexivity. + * simpl. + rewrite zero_extend_u. + reflexivity. +Qed. + +Lemma aes_E pre id0 k m : + (pdisj pre id0 (fset Cenc_locs)) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JAES id0 k m + ≈ + Caes k m + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ exists o, v0 = [ ('word U128 ; o )] /\ v1 = o ⦄. +Proof. + unfold JAES, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + intros disj. + + simpl. simpl_fun. + repeat setjvars. + ssprove_code_simpl. + repeat clear_get. + unfold Caes. + + eapply r_put_lhs. + eapply r_put_lhs. + eapply r_bind. + - rewrite !zero_extend_u. + eapply keyExpansion_E. + split. + + intros s0 s1 l a vr s_id' Hl Hs_id' H. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: eapply prec_I. eassumption. + } + destruct_pre. split_post. + * eapply disj; eauto. + * reflexivity. + * rewrite set_heap_commut. 2: neq_loc_auto. rewrite [set_heap (set_heap H2 _ _) _ _]set_heap_commut. 1: reflexivity. + neq_loc_auto. + + intros; destruct_pre; split_post. + * eapply disj. + ** move: H. rewrite !in_fset !in_cons=>/orP [] ;[|easy] => /eqP ->. simpl. apply/orP; auto. + ** eassumption. + * reflexivity. + * reflexivity. + - intros. + eapply rpre_weak_hypothesis_rule. + Opaque aes_rounds. + intros; destruct_pre. + simpl. + rewrite !coerce_to_choice_type_K. + fold rkeys. clear_get. + + eapply r_put_lhs with (pre := fun _ => _). + eapply r_get_remember_lhs. intros. + (* this is a very brute force way of remembering the value of 'in', should be done differently *) + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. sheap. + eapply r_bind. + + eapply aes_rounds_E. + split. + * intros s0 s1 l a vr s_id' Hl Hs_id' H. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_O. etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: etransitivity. 1: eapply prec_O. 1: eapply prec_I. eassumption. + } + destruct_pre. sheap. split_post. + ** eapply disj; eauto. + ** reflexivity. + ** reflexivity. + ** eexists. eauto. + ** rewrite set_heap_commut. + 1: rewrite [set_heap (set_heap _ _ _) _ a]set_heap_commut. + 1: rewrite [set_heap (set_heap _ _ _) _ a]set_heap_commut. + 1: reflexivity. + all: neq_loc_auto. + ** simpl. sheap. reflexivity. + * intros; destruct_pre; split_post. + ** eapply disj. + *** move: H. rewrite [l \in @fset _ [state]]in_fset in_cons =>/orP []. 1: move=> /eqP ->; solve_in. + 1: unfold Cenc_locs; auto_in_fset. + simpl. clear -l. easy. + *** eassumption. + ** reflexivity. + ** reflexivity. + ** eexists. eauto. + ** reflexivity. + ** simpl. sheap. reflexivity. + + intros. + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. + simpl. fold out. clear_get. + eapply r_put_lhs with (pre := fun _ => _). + eapply r_ret. + intros. + destruct_pre; sheap; split_post. + * pdisj_apply disj. + * eexists. + split; [reflexivity|]. + simpl. + rewrite !zero_extend_u. + reflexivity. +Qed. diff --git a/theories/Jasmin/examples/aes/aes_jazz.v b/theories/Jasmin/examples/aes/aes_jazz.v new file mode 100644 index 00000000..324be0ad --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_jazz.v @@ -0,0 +1,1158 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr sem. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate jasmin_utils. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Import JasminNotation JasminCodeNotation. +Import PackageNotation. +Local Open Scope string. + +Set Bullet Behavior "Strict Subproofs". +(* Set Default Goal Selector "!". *) (* I give up on this for now. *) + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* dec *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "k.297" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "n.298" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "c.299" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "mask.301" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "k.297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "n.298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "p.300" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "mask.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "c.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "p.300" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* enc *) xO (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "k.302" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "n.303" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "p.304" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "mask.306" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "k.302" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "n.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "c.305" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "mask.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "p.304" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "c.305" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* xor *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "a.307" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "b.308" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "r.309" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "a.307" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "b.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "r.309" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes *) xI (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.310" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.311" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.313" |} + ; v_info := dummy_var_info |}] + (xI (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.312" |} + ; v_info := dummy_var_info |}] + (xO (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.312" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.314" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.315" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.317" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.314" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.316" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.315" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.316" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes_rounds *) xO (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.319" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rk.321" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH)))))))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.321" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.322" |} + ; v_info := dummy_var_info |}) + ((DownTo, (Pconst (Z0))), (Pconst (Zpos (xI (xO (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDEC *) (BaseOp (None, AESDEC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.322" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDECLAST *) (BaseOp (None, AESDECLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* AddRoundKey *) xO (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rk.324" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.324" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes_rounds *) xO (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.326" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.326" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.328" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENC *) (BaseOp (None, AESENC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.328" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENCLAST *) (BaseOp (None, AESENCLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH))))))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand_inv *) xI (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.331" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.333" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.331" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.333" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.331" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oneq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep + (Oasm (* AESIMC *) (BaseOp (None, AESIMC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand *) xI (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.335" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.336" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.337" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.338" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.337" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.336" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.338" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.336" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.335" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.337" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.335" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_expand *) xI (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint; (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "rcon.339" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.342" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VAESKEYGENASSIST *) + (BaseOp (None, VAESKEYGENASSIST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.339" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.342" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_combine *) xI (xO (xI xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VPSHUFD_128 *) (BaseOp (None, (VPSHUFD U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH))); + (Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH)))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Z0)); (Pconst (Zpos (xH))); (Pconst (Z0)); + (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xO xH))); (Pconst (Z0)); + (Pconst (Zpos (xI xH))); (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* RCON *) xO (xO (xI xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "c.347" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xO xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH)))) + (Pconst (Zpos (xO (xO xH)))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO xH))))) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xO xH))))) + (Pconst (Zpos (xO (xO (xO (xO xH)))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI xH))))) + (Pconst (Zpos (xO (xO (xO (xO (xO xH))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.346" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.346" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO (xO xH)))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO (xO xH))))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := + sint + ; vname := + "i.346" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst + (Zpos (xI (xO (xO xH)))))) + (Pconst + (Zpos (xI (xI (xO (xI xH)))))) + (Pconst + (Zpos (xO (xI (xI (xO (xI xH)))))))))))))))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "c.347" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation DEC := ( xH ). +Notation ENC := ( xO (xO xH) ). +Notation XOR := ( xO xH ). +Notation INVAES := ( xI (xO xH) ). +Notation AES := ( xI xH ). +Notation INVAES_ROUNDS := ( xO (xI xH) ). +Notation ADDROUNDKEY := ( xO (xI (xO xH)) ). +Notation AES_ROUNDS := ( xO (xO (xO xH)) ). +Notation KEYS_EXPAND_INV := ( xI (xI xH) ). +Notation KEYS_EXPAND := ( xI (xO (xO xH)) ). +Notation KEY_EXPAND := ( xI (xI (xO xH)) ). +Notation KEY_COMBINE := ( xI (xO (xI xH)) ). +Notation RCON := ( xO (xO (xI xH)) ). + +Notation trp := (translate_prog' ssprove_jasmin_prog).1. +Notation trc := (fun fn i => translate_call ssprove_jasmin_prog fn trp i). +Notation funlist := [seq f.1 | f <- p_funcs ssprove_jasmin_prog]. + +Definition static_fun fn := (fn, match assoc trp fn with Some c => c | None => fun _ => ret tt end). + +Definition static_funs := [seq static_fun f | f <- funlist]. + +Definition strp := (translate_prog_static ssprove_jasmin_prog static_funs). +Opaque strp. + +Definition call fn i := (get_translated_static_fun ssprove_jasmin_prog fn static_funs i). + +Notation JRCON i j := (call RCON i [('int ; j)]). + +Notation JKEY_COMBINE i rkey temp1 temp2 := (call KEY_COMBINE i [('word U128 ; rkey) ; ('word U128 ; temp1) ; ('word U128 ; temp2)]). +Notation JKEY_EXPAND i rcon rkey temp2 := (call KEY_EXPAND i [ ('int ; rcon) ; ('word U128 ; rkey) ; ('word U128 ; temp2) ]). +Notation JKEYS_EXPAND i rkey := (call KEYS_EXPAND i [('word U128 ; rkey)]). +Notation JKEYS_EXPAND_INV i key := (call KEYS_EXPAND_INV i [('word U128 ; key)]). + +Notation JADDROUNDKEY i state rk := (call KEYS_EXPAND i [('word U128 ; state) ; ('word U128 ; rk)]). + +Notation JAES_ROUNDS i rkeys m := (call AES_ROUNDS i [('array ; rkeys) ; ('word U128 ; m)]). +Notation JINVAES_ROUNDS i rkeys m := (call INVAES_ROUNDS i [('array ; rkeys) ; ('word U128 ; m)]). + +Notation JAES i key m := (call AES i [('word U128 ; key) ; ('word U128 ; m)]). +Notation JINVAES i key m := (call INVAES i [('word U128 ; key) ; ('word U128 ; m)]). + +Notation JXOR i a1 a2 := (call XOR i [('word U128 ; a1) ; ('word U128 ; a2)]). +Notation JENC i n k m := (call ENC i [('word U128 ; n) ; ('word U128 ; k) ; ('word U128 ; m)]). +Notation JDEC i n k m := (call DEC i [('word U128 ; n) ; ('word U128 ; k) ; ('word U128 ; m)]). diff --git a/theories/Jasmin/examples/aes/aes_prf.v b/theories/Jasmin/examples/aes/aes_prf.v new file mode 100644 index 00000000..034d9676 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_prf.v @@ -0,0 +1,789 @@ +(** PRF Example + + Inspired by "State Separation for Code-Based Game-Playing Proofs" + by Brzuska et al. + + Appendix A. + + "Given a pseudorandom function (PRF) we construct a symmetric encryption + scheme that is indistinguishable under chosen plaintext attacks (IND-CPA)." + +*) +From JasminSSProve Require Import jasmin_translate aes_valid aes_spec aes.aes word aes_utils. + +From Relational Require Import OrderEnrichedCategory GenericRulesSimple. + +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice seq word word_ssrZ. +Set Warnings "notation-overridden,ambiguous-paths". + +From Mon Require Import SPropBase. +From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings + UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb + pkg_core_definition choice_type pkg_composition pkg_rhl Package Prelude. + +From Coq Require Import Utf8. +From extructures Require Import ord fset fmap. + +Import SPropNotations. + +Import PackageNotation. + +From Equations Require Import Equations. +Require Equations.Prop.DepElim. + +Set Equations With UIP. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. + +Import Num.Def. +Import Num.Theory. +Import Order.POrderTheory. + +From Jasmin Require Import word. + +Section PRF_example. + + Context (n : wsize). + + Notation key := 'word n. + Notation pt := 'word n. + Notation ct := 'word n. + + Notation " 'word " := ('word n) (in custom pack_type at level 2). + Notation " 'key " := ('word n) (in custom pack_type at level 2). + + Context (f : key -> pt -> ct). + + Notation N := ((expn 2 n).-1.+1). + + #[export] Instance : Positive N. + Proof. red; by rewrite prednK_modulus expn_gt0. Qed. + + #[export] Instance word_pos (i : wsize.wsize) : Positive i. + Proof. by case i. Qed. + + #[local] Open Scope package_scope. + + Definition key_location : Location := ('option key ; 0). + + Definition i0 : nat := 3. + Definition i1 : nat := 4. + + Definition table_location : Location := + (chMap 'nat ('word n) ; 7). + + Definition enc (m : pt) (k : key) : + code fset0 [interface] ('fin N × 'word n) := + {code + r ← sample uniform N ;; + let pad := f (word_of_ord r) k in + let c := m ⊕ pad in + ret (r, c) + }. + + Definition kgen : code (fset [:: key_location]) [interface] 'word n := + {code + k ← get key_location ;; + match k with + | None => + k_val ← sample uniform N ;; + #put key_location := Some (word_of_ord k_val) ;; + ret (word_of_ord k_val) + | Some k_val => + ret k_val + end + }. + + Definition EVAL_location_tt := (fset [:: key_location]). + Definition EVAL_location_ff := (fset [:: table_location]). + + Definition EVAL_pkg_tt : + package EVAL_location_tt [interface] + [interface #val #[i0] : 'word → 'key ] := + [package + #def #[i0] (r : 'word) : 'key + { + k_val ← kgen ;; + ret (f r k_val) + } + ]. + + Definition EVAL_pkg_ff : + package EVAL_location_ff [interface] + [interface #val #[i0] : 'word → 'key ] := + [package + #def #[i0] (r : 'word) : 'key + { + T ← get table_location ;; + match getm T (ord_of_word r) with + | None => + T_key ← sample uniform N ;; + #put table_location := (setm T (ord_of_word r) (word_of_ord T_key)) ;; + ret (word_of_ord T_key) + | Some T_key => ret T_key + end + } + ]. + + Definition EVAL : loc_GamePair [interface #val #[i0] : 'word → 'key ] := + λ b, if b then {locpackage EVAL_pkg_tt } else {locpackage EVAL_pkg_ff }. + + Definition MOD_CPA_location : {fset Location} := fset0. + + Definition MOD_CPA_tt_pkg : + package MOD_CPA_location + [interface #val #[i0] : 'word → 'key ] + [interface #val #[i1] : 'word → ('fin N) × 'word ] := + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + #import {sig #[i0] : 'word → 'key } as eval ;; + r ← sample uniform N ;; + pad ← eval (word_of_ord r) ;; + let c := m ⊕ pad in + ret (r, c) + } + ]. + + Definition MOD_CPA_ff_pkg : + package MOD_CPA_location + [interface #val #[i0] : 'word → 'key] + [interface #val #[i1] : 'word → ('fin N) × 'word ]:= + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + #import {sig #[i0] : 'word → 'key } as eval ;; + r ← sample uniform N ;; + m' ← sample uniform N ;; + pad ← eval (word_of_ord r) ;; + let c := (word_of_ord m' ⊕ pad) in + ret (r, c) + } + ]. + + Definition IND_CPA_location : {fset Location} := fset [:: key_location]. + + Program Definition IND_CPA_pkg_tt : + package IND_CPA_location + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word ] := + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + enc m k_val + } + ]. + (* why is this not inferred? *) + Next Obligation. + repeat constructor. red. + intros []. + rewrite in_fset in_cons. move=>/orP []. 2: easy. move=>/eqP H. noconf H. simpl. + eexists. + split. + 1: reflexivity. + intros. repeat constructor. + 1: auto_in_fset. destruct v. + 1: intros; repeat constructor. + 1: intros; repeat constructor. + auto_in_fset. + Defined. + + Program Definition IND_CPA_pkg_ff : + package IND_CPA_location + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word ] := + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + m' ← sample uniform N ;; + enc (word_of_ord m') k_val + } + ]. + (* TODO: infer this *) + Next Obligation. + repeat constructor. red. + intros []. + rewrite in_fset in_cons. move=>/orP []. 2: easy. move=>/eqP H. noconf H. simpl. + eexists. + split. + 1: reflexivity. + intros. repeat constructor. + 1: auto_in_fset. destruct v. + 1: intros; repeat constructor. + 1: intros; repeat constructor. + auto_in_fset. + Defined. + + Program Definition IND_CPA : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_tt } else {locpackage IND_CPA_pkg_ff }. + + Local Open Scope ring_scope. + + Definition prf_epsilon A := Advantage EVAL A. + + Definition statistical_gap := + AdvantageE (MOD_CPA_ff_pkg ∘ EVAL false) (MOD_CPA_tt_pkg ∘ EVAL false). + + Lemma IND_CPA_equiv_false : + IND_CPA false ≈₀ MOD_CPA_ff_pkg ∘ (EVAL true). + Proof. + (* We go to the relation logic using equality as invariant. *) + eapply eq_rel_perf_ind_eq. + simplify_eq_rel m. + simplify_linking. + (* We now conduct the proof in relational logic. *) + ssprove_swap_rhs 1%N. + ssprove_swap_rhs 0%N. + ssprove_sync_eq. cbn -[expn]. intros [k|]. + - cbn -[expn]. ssprove_swap_rhs 0%N. + eapply rpost_weaken_rule. + 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + - cbn -[expn]. + ssprove_swap_rhs 0%N. + ssprove_swap_rhs 1%N. + ssprove_swap_rhs 0%N. + ssprove_swap_rhs 2%N. + ssprove_swap_rhs 1%N. + eapply rpost_weaken_rule. 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + Qed. + + Lemma IND_CPA_equiv_true : + MOD_CPA_tt_pkg ∘ (EVAL true) ≈₀ IND_CPA true. + Proof. + (* We go to the relation logic using equality as invariant. *) + eapply eq_rel_perf_ind_eq. + simplify_eq_rel m. + simplify_linking. + (* We now conduct the proof in relational logic. *) + ssprove_swap_lhs 0%N. + ssprove_sync_eq. cbn -[expn]. intros [k|]. + - cbn -[expn]. eapply rpost_weaken_rule. 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + - cbn -[expn]. + ssprove_swap_rhs 1%N. + ssprove_swap_rhs 0%N. + eapply rpost_weaken_rule. 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + Qed. + + (** Security of PRF + + The bound is given by using the triangle inequality several times, + using the following chain of computational indistinguishabilities: + IND_CPA false ≈ MOD_CPA_ff_pkg ∘ EVAL true + ≈ MOD_CPA_ff_pkg ∘ EVAL false + ≈ MOD_CPA_tt_pkg ∘ EVAL false + ≈ MOD_CPA_tt_pkg ∘ EVAL true + ≈ IND_CPA true + + *) + Theorem security_based_on_prf : + ∀ LA A, + ValidPackage LA + [interface #val #[i1] : 'word → ('fin N) × 'word ] A_export A → + fdisjoint LA (IND_CPA false).(locs) → + fdisjoint LA (IND_CPA true).(locs) → + Advantage IND_CPA A <= + prf_epsilon (A ∘ MOD_CPA_ff_pkg) + + statistical_gap A + + prf_epsilon (A ∘ MOD_CPA_tt_pkg). + Proof. + intros LA A vA hd₀ hd₁. unfold prf_epsilon, statistical_gap. + rewrite !Advantage_E. + ssprove triangle (IND_CPA false) [:: + MOD_CPA_ff_pkg ∘ EVAL true ; + MOD_CPA_ff_pkg ∘ EVAL false ; + MOD_CPA_tt_pkg ∘ EVAL false ; + MOD_CPA_tt_pkg ∘ EVAL true + ] (IND_CPA true) A + as ineq. + eapply le_trans. 1: exact ineq. + clear ineq. + erewrite IND_CPA_equiv_false. all: eauto. + 2:{ simpl. unfold MOD_CPA_location. rewrite fset0U. auto. } + erewrite IND_CPA_equiv_true. all: eauto. + 2:{ simpl. unfold MOD_CPA_location. rewrite fset0U. auto. } + rewrite GRing.add0r GRing.addr0. + rewrite !Advantage_link. rewrite Advantage_sym. auto. + Qed. +End PRF_example. + +From JasminSSProve Require Import aes.aes aes_jazz jasmin_utils aes_valid. +From Jasmin Require Import expr sem. + +Import JasminNotation JasminCodeNotation. + +(* From Jasmin Require Import expr. *) +Require Import String. +Local Open Scope string. + +Section JasminPRF. + + Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. + + Notation n := U128. + + Definition key := 'word n. + Definition pt := 'word n. + Definition ct := 'word n. + + Notation " 'word " := ('word n) (in custom pack_type at level 2). + Notation " 'key " := ('word n) (in custom pack_type at level 2). + Notation N := ((expn 2 n).-1.+1). + + Notation enc := (enc U128 aes). + Notation kgen := (kgen U128). + Notation key_location := (key_location U128). + + Definition Cenc (m : pt) (k : key) : + code (fset [:: state ; rkeys]) [interface] (('fin N) × 'word n). + Proof. + refine + {code + r ← sample uniform N ;; + pad ← Caes (word_of_ord r) k ;; + ret (r, (m ⊕ pad)) + }. + repeat constructor. + all: auto_in_fset. + Defined. + + Opaque wrange. + Opaque expn. + + Definition IND_CPA_pkg_Cenc : + package (fset (key_location :: Cenc_locs)) + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word]. + Proof. + refine + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + Cenc m k_val + } + ]. + (* infer this *) + repeat constructor. red. + intros []. + rewrite in_fset in_cons. move=>/orP []. 2: easy. move=>/eqP H. noconf H. simpl. + eexists. + split. + 1: reflexivity. + intros. repeat constructor. + all: auto_in_fset. + intros. destruct v. + 1: repeat constructor; auto_in_fset. + 1: repeat constructor; auto_in_fset. + Defined. + + Notation hdtc128 l := (coerce_to_choice_type ('word U128) (head ( 'word U128 ; word0 ) l).π2). + + Definition IND_CPA_pkg_JENC (id0 : p_id) : + package (fset (key_location :: (JENC_valid id0).π1)) + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word ]. + Proof. + refine + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + r ← sample uniform N ;; + res ← JENC id0 (word_of_ord r) k_val m ;; + ret (r, hdtc128 res) + } + ]. + repeat constructor. + intros []. + rewrite in_fset in_cons => /orP []; [|easy]; move=> /eqP H; noconf H. + cbv zeta match. + eexists. + split. + 1: reflexivity. + intros x. + constructor. + 1: auto_in_fset. + intros. destruct v. + - constructor. intros. + eapply valid_bind. + + red. eapply valid_code_cons. + 1: eapply (JENC_valid id0).π2. + + constructor. + - constructor. + intros. + constructor. + 1: auto_in_fset. + constructor. intros. + eapply valid_bind. + + red. eapply valid_code_cons. + 1: eapply (JENC_valid id0).π2. + + constructor. + Unshelve. all: exact _. + Defined. + + (* Notation KG_pkg := (KG_pkg U128). *) + Notation IND_CPA_pkg_ff := (IND_CPA_pkg_ff U128 aes). + Notation IND_CPA_pkg_tt := (IND_CPA_pkg_tt U128 aes). + Notation MOD_CPA_ff_pkg := (MOD_CPA_ff_pkg U128). + Notation MOD_CPA_tt_pkg := (MOD_CPA_tt_pkg U128). + Notation IND_CPA := (IND_CPA U128 aes). + Notation EVAL := (EVAL U128 aes). + + Lemma fsubset_ext2 : ∀ [T : ordType] (s1 s2 : {fset T}), fsubset s1 s2 -> (forall x, x \in s1 -> x \in s2). + Proof. + intros. + rewrite -fsub1set. + eapply fsubset_trans. 2: eassumption. + rewrite fsub1set. assumption. + Qed. + + Lemma fsubset_cons : ∀ [T : ordType] a (s1 s2 : {fset T}), fsubset s1 s2 -> fsubset s1 (a |: s2). + Proof. + intros. + apply fsubset_ext. + intros. rewrite in_fset in_cons. + apply/orP. right. + eapply fsubset_ext2. + 1: eassumption. + assumption. + Qed. + + Definition IND_CPA_Cenc : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_Cenc } else (IND_CPA true). + + Definition IND_CPA_JENC id0 : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_JENC id0} else {locpackage IND_CPA_pkg_Cenc}. + + (* TODO: move *) + Lemma JXOR_E pre id0 x y : + (pdisj pre id0 fset0) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JXOR id0 x y + ≈ + ret (chCanonical chUnit) + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ (exists o, (v0 = cons ('word U128 ; o ) nil ) /\ (o = x ⊕ y)) ⦄. + Proof. + unfold JXOR, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + intros disj. + simpl. simpl_fun. + repeat setjvars. + ssprove_code_simpl. + repeat clear_get. + repeat eapply r_put_lhs. + eapply r_ret. + rewrite !zero_extend_u. + intros. destruct_pre; split_post. + 1: pdisj_apply disj. + eexists; split; [reflexivity|]. reflexivity. + Qed. + + (* TODO: move *) + Arguments pheap_ignore : simpl never. + + Lemma translate_var_option {A} s_id v i : ( 'option A ; i ) != translate_var s_id v. + Proof. + unfold translate_var. + apply/eqP => contra. + apply EqdepFacts.eq_sigT_fst in contra. + destruct v. + destruct vtype0; simpl in contra; noconf contra. + Qed. + + (* NOTE: the next 5 lemmas are not used, but might useful. Move *) + Lemma nat_of_stype_bound s : 5 <= nat_of_stype s. + Proof. + destruct s. 1-2: simpl; try micromega.Lia.lia. + - simpl. pose proof Pos2Nat.is_succ p as []. rewrite H. + pose proof Nat.pow_le_mono_r 11 1 (x.+1) ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). simpl in *. micromega.Lia.lia. + - cbn [nat_of_stype]. + assert (0 < nat_of_wsize w). 1: destruct w; unfold nat_of_wsize; simpl; try micromega.Lia.lia. + pose proof Nat.pow_le_mono_r 13 1 w ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). simpl in *. micromega.Lia.lia. + Qed. + + Lemma nat_of_p_id_ident_bound s_id v : 2 <= nat_of_p_id_ident s_id v. + Proof. + unfold nat_of_p_id_ident. + pose proof nat_of_p_id_pos s_id. + pose proof nat_of_ident_pos v. + pose proof Nat.pow_le_mono_r 3 1 (nat_of_p_id s_id) ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). + pose proof Nat.pow_le_mono_r 2 1 (nat_of_ident v) ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). + simpl in *; micromega.Lia.lia. + Qed. + + Lemma nat_of_p_id_var_bound s_id v : 10 <= nat_of_p_id_var s_id v. + Proof. + unfold nat_of_p_id_var. + pose proof nat_of_stype_bound (vtype v). + pose proof nat_of_p_id_ident_bound s_id (vname v). + micromega.Lia.nia. + Qed. + + Lemma translate_var_bound {A} s_id v i : i < 10 -> ( A ; i ) != translate_var s_id v. + Proof. + intros. + apply/eqP => contra. + inversion contra. + pose proof nat_of_p_id_var_bound s_id v. + micromega.Lia.lia. + Qed. + + Lemma IND_CPA_JENC_equiv_false id0 : + padv_equiv (fun l => exists s_id v, id0 ⪯ s_id /\ l = translate_var s_id v) (fun l => l \in fset Cenc_locs) (IND_CPA_JENC id0 true) (IND_CPA_JENC id0 false) (λ _ : raw_package, 0%R). + Proof. + eapply eq_rel_perf_ind'. + (* invariant *) + { eapply pInvariant_pheap_ignore with + (P := fun l => (forall s_id v, id0 ⪯ s_id -> l != translate_var s_id v) /\ l \notin fset Cenc_locs). + { intros. + split. + - intros. apply/eqP. intros contra. + destruct H. apply H. + exists s_id, v. split; auto. + - apply/negP; easy. } } + unfold eq_up_to_inv, get_op_default, lookup_op, IND_CPA_JENC, IND_CPA_pkg_JENC. + Opaque Caes. + Opaque translate_call. + Opaque wrange. + Opaque expn. + simpl. + simplify_eq_rel m. + simplify_linking. + rewrite !cast_fun_K. + ssprove_sync. + { intros h0 h1 hpre. apply hpre. split. + - intros. apply translate_var_option. + - unfold Cenc_locs. rewrite in_fset in_cons; auto. } + intros. + eapply r_bind with (mid := fun '(a₀, s₀) '(a₁, s₁) => pheap_ignore (λ l : ∑ _ : choice_type, nat, (∀ (s_id : p_id) (v : var), id0 ⪯ s_id → l != translate_var s_id v) /\ l \notin fset Cenc_locs) (s₀, s₁) /\ a₀ = a₁). + { destruct a. + - eapply r_ret. easy. + - ssprove_sync. intros. + ssprove_sync. + { intros h0 h1 Hh l H. + destruct (l == key_location) eqn:E. + - move: E => /eqP heq. subst. rewrite !get_set_heap_eq. reflexivity. + - move: E => /negP Hneq. rewrite !get_set_heap_neq; auto. 1-2: apply /negP; auto. } + eapply r_ret. easy. } + intros. + (* TODO: find easier way to do next three lines *) + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. + eapply rpre_weaken_rule with (pre:= fun '(s₀, s₁) => pheap_ignore (λ l : ∑ _ : choice_type, nat, (∀ (s_id : p_id) (v : var), id0 ⪯ s_id → l != translate_var s_id v) /\ l \notin fset Cenc_locs) (s₀, s₁)); try easy. + ssprove_code_simpl. + simpl. + ssprove_sync. intros. + rewrite !zero_extend_u. + repeat clear_get. + do 3 eapply r_put_lhs. + eapply r_bind. + - eapply aes_E; split. + + intros. + destruct_pre. + do 2 eexists. + 1: do 2 eexists. + 1: do 2 eexists. + 1: instantiate (1 := set_heap H7 (translate_var s_id' v) a1). + all: try reflexivity. + { intros l lnin. rewrite get_set_heap_neq. 1: eapply H8; auto. + apply lnin. + etransitivity. + 2: eassumption. + solve_preceq. } + { repeat rewrite [set_heap _ _ a1]set_heap_commut; auto. + 1-3: apply injective_translate_var2; apply prec_neq; eapply prec_preceq_trans; try eassumption; apply prec_I. } + + intros. + destruct_pre. + do 2 eexists. + 1: do 2 eexists. + 1: do 2 eexists. + 1: instantiate (1 := H6). + all: try reflexivity. + intros l2 lnin. + rewrite get_set_heap_neq. + 1: eapply H7. 1: assumption. + unfold Cenc_locs in lnin. + destruct lnin. apply /eqP => contra; subst. + rewrite H in H2. easy. + - simpl. intros. + eapply rpre_weak_hypothesis_rule; intros. + destruct_pre. + simpl. + clear_get. + eapply r_put_lhs with (pre := fun _ => _). + eapply r_get_remember_lhs. intros. + eapply r_bind with (m₁ := ret (chCanonical chUnit)) (f₁ := fun _ => _). + 1: eapply JXOR_E; split. + + intros. + destruct_pre. + 1: do 1 eexists. + 1: do 2 eexists. + 1: do 7 eexists. + 1: instantiate (1:= (set_heap H14 (translate_var s_id' v) a1)). + all: try reflexivity. + { intros l hl. rewrite get_set_heap_neq. 1: eapply H15. 1: assumption. apply hl. + etransitivity. 2: eauto. + solve_preceq. } + { repeat rewrite [set_heap _ _ a1]set_heap_commut; auto. + 1-4: apply injective_translate_var2; apply prec_neq; eapply prec_preceq_trans; try eassumption; solve_prec. } + { sheap. simpl. rewrite get_set_heap_neq. 1: sheap. 1: reflexivity. + apply injective_translate_var2; apply prec_neq; eapply prec_preceq_trans; try eassumption; solve_prec. } + + intros. easy. + + intros. + eapply rpre_weak_hypothesis_rule; intros. + destruct_pre; simpl. + clear_get. + eapply r_put_lhs with (pre := fun _ => _). + eapply r_ret. + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + intros. + destruct_pre; simpl; split_post. + { sheap. by rewrite wxorC. } + { intros l s_id. + rewrite !get_set_heap_neq. + 1: eapply H19; auto. + 1-5: apply s_id; reflexivity. } + Qed. + + Lemma IND_CPA_jazz_equiv_false : + (IND_CPA_Cenc) true ≈₀ (IND_CPA_Cenc) false. + Proof. + eapply eq_rel_perf_ind_ignore with (L := fset Cenc_locs). + { eapply fsubsetU. apply/orP; left. simpl. + rewrite [fset (key_location :: _)]fset_cons. + eapply fsubset_cons. + eapply fsubsetxx. } + unfold eq_up_to_inv. + Opaque Caes. + Opaque wrange. + Opaque expn. + simplify_eq_rel m. + ssprove_sync. intros. + eapply r_bind with (mid := fun '(a0, s0) '(a1, s1) => a0 = a1 /\ heap_ignore (fset Cenc_locs) (s0, s1)). + { destruct a. + - eapply r_ret. easy. + - ssprove_sync. intros. + ssprove_sync. + eapply r_ret. easy. } + intros. simpl. + (* TODO: find easier way to do next three lines *) + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. + eapply rpre_weaken_rule with (pre:= fun '(s₀, s₁) => heap_ignore (fset Cenc_locs) (s₀, s₁)); try easy. + ssprove_sync. intros. + eapply r_bind with (m₁ := ret (chCanonical chUnit)) (f₁ := fun _ => _). + - 1: eapply aes_h. + intros h1 h2 l a2 lin h. + intros l2 lnin. + unfold Cenc_locs in *. + rewrite get_set_heap_neq. + 1: apply h; auto. + apply/eqP=>contra; subst. + move: lnin => /negP. easy. + - intros. eapply r_ret. + intros. destruct_pre; split_post; auto. + Qed. + + Definition JIND_CPA id0 : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_JENC id0 } else (IND_CPA true). + + Theorem jasmin_security_based_on_prf id0 : + ∀ LA A, + ValidPackage LA + [interface #val #[i1] : 'word → ('fin N) × 'word ] A_export A → + pdisjoint LA (λ l : Location, ∃ (s_id : p_id) (v : var), id0 ⪯ s_id ∧ l = translate_var s_id v) -> + pdisjoint LA (λ l : Location, l \in fset Cenc_locs) -> + fdisjoint LA (IND_CPA_Cenc false).(locs) → + fdisjoint LA (IND_CPA_Cenc true).(locs) → + Advantage (JIND_CPA id0) A = 0%R. + Proof. + intros LA A vA hd₀ hd₁ hd2 hd3. + rewrite !Advantage_E. + eapply AdvantageE_le_0. + ssprove triangle (JIND_CPA id0 false) [:: + IND_CPA_pkg_Cenc : raw_package + ] (JIND_CPA id0 true) A + as ineq. + eapply Order.POrderTheory.le_trans. + 1: exact ineq. + clear ineq. + rewrite Advantage_sym. + erewrite IND_CPA_jazz_equiv_false. all: eauto. + rewrite Advantage_sym. + pose proof IND_CPA_JENC_equiv_false id0. + unfold padv_equiv in H. + specialize (H LA A vA hd₀ hd₁). + rewrite H. + rewrite GRing.addr0. + apply Order.POrderTheory.le_refl. + Qed. + + Notation prf_epsilon := (prf_epsilon U128 aes). + Notation statistical_gap := (statistical_gap U128 aes). + + Local Open Scope ring_scope. + + Program Definition JIND_CPA' id0 : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_JENC id0 } else (IND_CPA false). + + Theorem jsecurity_based_on_prf (id0 : p_id) : + ∀ LA A, + ValidPackage LA + [interface #val #[i1] : 'word → ('fin N) × 'word ] A_export A → + pdisjoint LA (λ l : Location, ∃ (s_id : p_id) (v : var), id0 ⪯ s_id ∧ l = translate_var s_id v) -> + pdisjoint LA (λ l : Location, l \in fset Cenc_locs) -> + fdisjoint LA (IND_CPA_Cenc false).(locs) → + fdisjoint LA (IND_CPA_Cenc true).(locs) → + Advantage (JIND_CPA' id0) A <= + prf_epsilon (A ∘ MOD_CPA_ff_pkg) + + statistical_gap A + + prf_epsilon (A ∘ MOD_CPA_tt_pkg). + Proof. + intros LA A vA hd₀ hd₁ hd2 hd3. + rewrite !Advantage_E. + ssprove triangle (JIND_CPA' id0 true) [:: + IND_CPA_pkg_Cenc : raw_package ; + IND_CPA true : raw_package + ] (JIND_CPA' id0 false) A + as ineq. + rewrite Advantage_sym. + + eapply Order.POrderTheory.le_trans. 1: eapply ineq. + + erewrite IND_CPA_jazz_equiv_false. all: eauto. + rewrite IND_CPA_JENC_equiv_false. all: eauto. + + rewrite GRing.add0r. + rewrite GRing.add0r. + + unshelve epose proof security_based_on_prf n aes LA A vA hd2 _. + 1: { simpl. simpl in hd2. eauto. } + rewrite Advantage_E in H. + + rewrite Advantage_sym. + eapply H. + Qed. + + Print Assumptions jsecurity_based_on_prf. + +End JasminPRF. diff --git a/theories/Jasmin/examples/aes/aes_spec.v b/theories/Jasmin/examples/aes/aes_spec.v new file mode 100644 index 00000000..a7a7c017 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_spec.v @@ -0,0 +1,244 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra zify. +From mathcomp Require Import word_ssrZ word. +Set Warnings "notation-overridden,ambiguous-paths". + +From Coq Require Import Utf8 ZArith micromega.Lia List. + +From Jasmin Require Import expr xseq waes word. +From JasminSSProve Require Import jasmin_translate word aes_utils. + +From Relational Require Import OrderEnrichedCategory. +From Crypt Require Import Prelude Package ChoiceAsOrd choice_type. + +From extructures Require Import ord fset fmap. + +Import ListNotations. +Import JasminNotation. +Import PackageNotation. +Import AesNotation. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Local Open Scope Z. + +(** Specs *) + +Definition rcon (i : Z) : u8 := nth (wrepr U8 54%Z) [:: (wrepr U8 1%Z); (wrepr U8 2%Z); (wrepr U8 4%Z); (wrepr U8 8%Z); (wrepr U8 16%Z); (wrepr U8 32%Z); (wrepr U8 64%Z); (wrepr U8 128%Z); (wrepr U8 27%Z); (wrepr U8 54%Z)]%Z ((Z.to_nat i) - 1). + +Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. + +Definition key_expand (wn1 : u128) (rcon : u8) : 'word U128 := + let rcon := zero_extend U32 rcon in + let w0 := subword 0 U32 wn1 in + let w1 := subword (1 * U32) U32 wn1 in + let w2 := subword (2 * U32) U32 wn1 in + let w3 := subword (3 * U32) U32 wn1 in + let tmp := w3 in + let tmp := SubWord (RotWord tmp) ⊕ rcon in + let w4 := w0 ⊕ tmp in + let w5 := w1 ⊕ w4 in + let w6 := w2 ⊕ w5 in + let w7 := w3 ⊕ w6 in + wcat [tuple w4; w5; w6; w7]. + +Definition key_i (k : u128) i := + iteri i (fun i ki => key_expand ki (rcon ((Z_of_nat i) + 1))) k. + +Definition aes (key msg : u128) := + let state := wxor msg (key_i key 0) in + let state := iteri 9 (fun i state => wAESENC_ state (key_i key (i + 1))) state in + wAESENCLAST_ state (key_i key 10). + +Definition invaes (key cipher : u128) := + let state := wxor cipher (key_i key 10) in + let state := iteri 9 (fun i state => wAESDEC_ state (key_i key (10 -(i + 1)))) state in + wAESDECLAST state (key_i key 0). + +Definition rkeys : Location := ( 'arr U128 ; 0%nat ). +Definition state : Location := ( 'word U128 ; 0%nat). +Definition Cenc_locs := [:: state ; rkeys]. + +Definition keyExpansion (key : u128) : raw_code ('arr U128) := + #put rkeys := @emptym (chElement_ordType 'int) u128 ;; + rkeys0 ← get rkeys ;; + #put rkeys := setm rkeys0 0 key ;; + lfor_loop (fun i => + rkeys0 ← get rkeys ;; + #put rkeys := setm rkeys0 i (key_expand (zero_extend _ (getmd rkeys0 word0 (i - 1))) (rcon i)) ;; + ret tt) 1 11 ;; + rkeys0 ← get rkeys ;; + ret rkeys0. + +Definition aes_rounds (rkeys : 'arr U128) (msg : 'word U128) : raw_code u128 := + #put state := wxor msg (getmd rkeys word0 0) ;; + lfor_loop (fun i => + state0 ← get state ;; + #put state := wAESENC_ state0 (getmd rkeys word0 i) ;; + ret tt + ) 1 10 ;; + state0 ← get state ;; + #put state := wAESENCLAST_ state0 (getmd rkeys word0 10) ;; + state0 ← get state ;; + ret state0. + +Definition Caes (key msg : u128) := + rkeys ← keyExpansion key ;; + cipher ← aes_rounds rkeys msg ;; + ret cipher. + +(** Correctness proofs *) + +Lemma keyExpansion_h (pre : precond) k : + u_pdisj pre [fset rkeys] -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + keyExpansion k + ≈ + ret tt + ⦃ fun '(v0, h0) '(_, h1) => pre (h0, h1) /\ forall i, 0 <= i < 11 -> (getmd v0 word0 i) = key_i k (Z.to_nat i) ⦄. +Proof. + intros Hdisj. + unfold keyExpansion. + eapply r_put_lhs with (pre := fun '(_, _) => _). + eapply r_get_remember_lhs. intros x. + eapply r_put_lhs. + eapply r_bind with (m₁ := ret _). + { eapply u_lfor_loop_rule_weaken with + (I:= fun i => fun h0 h1 => pre (h0, h1) /\ forall j, 0 <= j < i -> getmd (get_heap h0 rkeys) word0 j = key_i k (Z.to_nat j)). + { lia. } + - intros h1 h2 Hset. + destruct_pre. + split_post. + + u_pdisj_apply Hdisj. + + intros j Hj. + sheap. + unfold getmd. + rewrite setmE. + assert (@eq_op (Ord.eqType Z_ordType) j Z0) by (apply/eqP; lia). + rewrite H. + move: H=>/eqP ->. + simpl. + reflexivity. + - intros i ile. + ssprove_code_simpl. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x0. + eapply r_put_lhs. + eapply r_ret. + intros s0 s1 Hpre. + destruct_pre. split_post. + + u_pdisj_apply Hdisj. + + intros j Hj. + rewrite get_set_heap_eq. + rewrite -> H6 by lia. + unfold getmd in *. + rewrite setmE. + destruct (Z.eq_dec j i). + * subst. + rewrite eq_refl. + rewrite zero_extend_u. + replace (Z.to_nat i) with (Z.to_nat (i - 1)).+1 by lia. + unfold key_i at 2. + rewrite iteriS. + f_equal. f_equal. simpl. lia. + * assert (@eq_op (Ord.eqType Z_ordType) j i = false). + { apply/eqP. assumption. } + rewrite H1; auto. + rewrite H6; auto. + lia. } + intros s0 s1. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x0. + eapply r_ret. + intros s2 s3 Hpre. + destruct_pre. + split. + - easy. + - apply H2. +Qed. + +Lemma aes_rounds_h rkeys k m pre : + u_pdisj pre [fset state] -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) /\ (forall i, 0 <= i < 11 -> getmd rkeys word0 i = key_i k (Z.to_nat i)) ⦄ + aes_rounds rkeys m + ≈ + ret tt + ⦃ fun '(v0, h0) '(_, h1) => pre (h0, h1) /\ v0 = aes k m ⦄. +Proof. + unfold aes_rounds. + intros Hdisj. + set (st0 := m ⊕ (key_i k 0%nat)). + eapply r_put_lhs with (pre := fun '(_, _) => _). + eapply r_bind with (m₁ := ret _). + { eapply u_lfor_loop_rule_weaken with + (I := fun i => fun h0 h1 => pre (h0, h1) /\ get_heap h0 state = iteri (Z.to_nat i - 1) (fun i state => wAESENC_ state (key_i k (i + 1))) st0 + /\ (forall i, 0 <= i < 11 -> getmd rkeys word0 i = key_i k (Z.to_nat i))). + - lia. + - intros. + simpl. + destruct_pre. sheap. split_post. + + u_pdisj_apply Hdisj. + + rewrite H3; auto. lia. + + assumption. + - intros i Hi. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x. + eapply r_put_lhs. eapply r_ret. + intros s0 s1 Hpre. + destruct_pre; sheap; split_post. + + u_pdisj_apply Hdisj. + + replace (Z.to_nat (Z.succ i) - 1)%nat with ((Z.to_nat i - 1).+1) by lia. + rewrite iteriS. + rewrite H4. + rewrite H7. 2: lia. repeat f_equal. lia. + + assumption. } + intros a0 a1. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x. + eapply r_put_lhs. + eapply r_get_remember_lhs. intros x0. + eapply r_ret. + intros s0 s1 Hpre. + destruct Hpre as [[s2 [[[H5 [H4 H6]] H3] H2]] H1]. + simpl in H3, H1. subst. + sheap. + split; [u_pdisj_apply Hdisj|]. + unfold aes. + rewrite H4. + rewrite H6. 2: lia. + replace ((Z.to_nat 10) - 1)%nat with 9%nat by reflexivity. + reflexivity. +Qed. + +Lemma aes_h k m pre : + (u_pdisj pre (fset Cenc_locs)) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + Caes k m + ≈ + ret tt + ⦃ fun '(v0, h0) '(_, h1) => pre (h0, h1) /\ v0 = aes k m ⦄. +Proof. + unfold Caes. + intros Hdisj. + eapply r_bind with (m₁ := ret _). + { eapply keyExpansion_h. + u_pdisj_apply Hdisj. + intros h1 h2 l a lin Hpre. + eapply Hdisj; auto. + rewrite in_fset in lin. + simpl in lin. + unfold Cenc_locs. + move: lin => /InP []; [move=> ->|by []]. + auto_in_fset. } + intros a0 []. + eapply r_bind with (m₁ := ret _). + { eapply aes_rounds_h. + intros h1 h2 l a lin Hpre. + eapply Hdisj; auto. + rewrite in_fset in lin. + simpl in lin. + unfold Cenc_locs. + move: lin => /InP []; [move=> ->|by []]. + auto_in_fset. } + intros a1 []. + eapply r_ret. + intros. + assumption. +Qed. diff --git a/theories/Jasmin/examples/aes/aes_utils.v b/theories/Jasmin/examples/aes/aes_utils.v new file mode 100644 index 00000000..fde3b376 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_utils.v @@ -0,0 +1,646 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra zify. +From mathcomp Require Import word_ssrZ word. +Set Warnings "notation-overridden,ambiguous-paths". + +From Coq Require Import Utf8 ZArith micromega.Lia List. + +From Jasmin Require Import expr xseq. +From JasminSSProve Require Import jasmin_translate. + +From Relational Require Import OrderEnrichedCategory. +From Crypt Require Import Prelude Package ChoiceAsOrd. + +From extructures Require Import ord fset fmap. + +Import ListNotations. +Import JasminNotation. +Import PackageNotation. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +(** Notations *) + +Module AesNotation. + Notation " 'arr ws " := (chMap 'int ('word ws)) (at level 2) : package_scope. +End AesNotation. + +(** For loops *) + +Local Open Scope Z. + +Fixpoint for_list (c : Z → raw_code 'unit) (vs : seq Z) : raw_code 'unit := + match vs with + | [::] => ret tt + | v :: vs => c v ;; for_list c vs + end. + +Definition lfor_loop (c : Z -> raw_code 'unit) lo hi := for_list c (wrange UpTo lo hi). + +Lemma iota_aux {A} k c n (f : nat -> A) g : + (forall a, a \in (iota k n) -> f a = g (a + c)%nat) -> + [seq f i | i <- iota k n] = [seq g i | i <- iota (k + c) n]. +Proof. + revert k c. + induction n. + - reflexivity. + - intros k c ex. + simpl. rewrite -addSn -IHn. + + f_equal. + apply ex. + rewrite in_cons eq_refl => //=. + + intros a ain. apply ex. + simpl. rewrite in_cons. + apply/orP. right. assumption. +Qed. + +Lemma u_lfor_loop_rule I c lo hi : + lo <= hi -> + (∀ i, (lo <= i < hi)%Z -> + ⊢ ⦃ λ '(s₀, s₁), I i s₀ s₁ ⦄ + c i ≈ ret tt + ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) s₀ s₁ ⦄) → + ⊢ ⦃ λ '(s₀, s₁), I lo s₀ s₁ ⦄ + lfor_loop c lo hi ≈ ret tt + ⦃ λ '(_,s₀) '(_,s₁), I hi s₀ s₁ ⦄. +Proof. + intros hle h. + remember (Z.to_nat (hi - lo)). + revert hle h Heqn. revert lo hi. + induction n as [| n ih]; intros. + - assert (hi = lo) by lia. + unfold lfor_loop=>/=. + rewrite -Heqn. + subst. + apply r_ret. easy. + - unfold lfor_loop=>/=. + rewrite -Heqn. simpl. rewrite Z.add_0_r. + eapply r_bind with (m₁ := ret tt) (f₁ := fun _ => _). + + eapply h. lia. + + intros a1 a2. + destruct a1, a2. + replace [seq lo + Z.of_nat i | i <- iota 1 n] with [seq (Z.succ lo) + Z.of_nat i | i <- iota 0 n]. + 2: { replace (iota 1 n) with (iota (0 + 1) n) by f_equal. apply iota_aux. intros. lia. } + replace n with (Z.to_nat (hi - Z.succ lo)) by lia. + eapply ih. + all: try lia. + intros i hi2. apply h. lia. +Qed. + +Lemma u_lfor_loop_rule_weaken (I : Z -> heap -> heap -> Prop) c lo hi (pre : precond) : + lo <= hi -> + (forall h1 h2, pre (h1, h2) -> I lo h1 h2) -> + (∀ i, (lo <= i < hi)%Z -> + ⊢ ⦃ λ '(s₀, s₁), I i s₀ s₁ ⦄ + c i ≈ ret tt + ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) s₀ s₁ ⦄) → + ⊢ ⦃ pre ⦄ + lfor_loop c lo hi ≈ ret tt + ⦃ λ '(_,s₀) '(_,s₁), I hi s₀ s₁ ⦄. +Proof. + intros. + eapply rpre_weaken_rule. + 1: eapply u_lfor_loop_rule; eauto. + assumption. +Qed. + +Lemma lfor_loop_rule I c₀ c₁ lo hi : + lo <= hi -> + (∀ i, (lo <= i < hi)%Z -> ⊢ ⦃ λ '(s₀, s₁), I i (s₀, s₁) ⦄ c₀ i ≈ c₁ i ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) (s₀,s₁) ⦄) → + ⊢ ⦃ λ '(s₀, s₁), I lo (s₀, s₁) ⦄ + lfor_loop c₀ lo hi ≈ lfor_loop c₁ lo hi + ⦃ λ '(_,s₀) '(_,s₁), I hi (s₀,s₁) ⦄. +Proof. + intros hle h. + remember (Z.to_nat (hi - lo)). + revert hle h Heqn. revert lo hi. + induction n as [| n ih]; intros. + - assert (hi = lo) by lia. + unfold lfor_loop=>/=. + rewrite -Heqn. + subst. + apply r_ret. easy. + - unfold lfor_loop=>/=. + rewrite -Heqn. simpl. rewrite Z.add_0_r. + eapply r_bind. + + eapply h. lia. + + intros a1 a2. + destruct a1, a2. + replace [seq lo + Z.of_nat i | i <- iota 1 n] with [seq (Z.succ lo) + Z.of_nat i | i <- iota 0 n]. + 2: { replace (iota 1 n) with (iota (0 + 1) n) by f_equal. apply iota_aux. intros. lia. } + replace n with (Z.to_nat (hi - Z.succ lo)) by lia. + eapply ih. + all: try lia. + intros i hi2. apply h. lia. +Qed. + +Lemma translate_for_rule I lo hi (v : var_i) m_id s_id (body1 : p_id -> p_id * raw_code 'unit) body2 : + (* it is annoying that this is a proof obligation, since its true for all translated programs, but I don't know how to prove the theorem without it *) + (forall s_id', s_id' ⪯ (body1 s_id').1) -> + lo <= hi -> + (forall i s_id', (s_id ⪯ s_id') -> (lo <= i < hi) -> + ⊢ ⦃ λ '(s₀, s₁), set_lhs (translate_var m_id v) (truncate_el (vtype v) (i : chInt)) (I i) (s₀, s₁) ⦄ + let (_, body1') := body1 s_id' in + body1' ≈ body2 i + ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) (s₀,s₁) ⦄) → + ⊢ ⦃ λ '(s₀,s₁), I lo (s₀, s₁)⦄ + translate_for v (wrange UpTo lo hi) m_id body1 s_id + ≈ lfor_loop body2 lo hi + ⦃ λ '(_,s₀) '(_,s₁), I hi (s₀,s₁) ⦄. +Proof. + intros Hbody1 Hle ih. + remember (Z.to_nat (hi - lo)). + revert Heqn Hle ih. revert n lo hi s_id. + induction n as [|n ih2]; intros. + - assert (hi = lo). { zify. lia. } + subst. + unfold translate_for, lfor_loop. simpl. + rewrite -Heqn. + simpl. + apply r_ret. + easy. + - unfold translate_for, lfor_loop. + unfold wrange. + rewrite -Heqn. + simpl. + specialize (ih lo s_id) as ih''. + specialize (Hbody1 s_id). + destruct (body1 s_id). + eapply r_put_lhs. + eapply r_bind. + + eapply r_transL. + 2: rewrite Z.add_0_r; eapply ih''; [ reflexivity | lia ]. + eapply rreflexivity_rule. + + intros a0 a1. + replace (iota 1 n) with (iota (0 + 1) n) by f_equal. + rewrite <- iota_aux with (f := fun i => Z.succ lo + Z.of_nat i) by lia. + replace n with (Z.to_nat (hi - Z.succ lo)) by lia. + specialize (ih2 (Z.succ lo) hi p ltac:(lia) ltac:(lia)). + eapply ih2. + intros i s_id' Hs_id' ile. + specialize (ih i s_id'). + destruct (body1 s_id'). apply ih. + 1: etransitivity; eauto. + lia. +Qed. + +Lemma translate_for_rule_weaken (pre : precond) (I : Z -> heap * heap -> Prop) lo hi (v : var_i) m_id s_id (body1 : p_id -> p_id * raw_code 'unit) body2 : + (forall h0 h1, pre (h0, h1) -> I lo (h0, h1)) -> + (* it is annoying that this is a proof obligation, since its true for all translated programs, but I don't know how to prove the theorem without it *) + (forall s_id', s_id' ⪯ (body1 s_id').1) -> + lo <= hi -> + (forall i s_id', (s_id ⪯ s_id') -> (lo <= i < hi) -> + ⊢ ⦃ λ '(s₀, s₁), set_lhs (translate_var m_id v) (truncate_el (vtype v) (i : chInt)) (I i) (s₀, s₁) ⦄ + let (_, body1') := body1 s_id' in + body1' + ≈ body2 i ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) (s₀,s₁) ⦄) → + ⊢ ⦃ pre ⦄ + translate_for v (wrange UpTo lo hi) m_id body1 s_id + ≈ lfor_loop body2 lo hi + ⦃ λ '(_,s₀) '(_,s₁), I hi (s₀,s₁) ⦄. +Proof. + intros. + eapply rpre_weaken_rule. + 1: eapply translate_for_rule. + all: easy. +Qed. + +(** Arrays *) + +Definition getmd {T S} m d i := match @getm T S m i with Some a => a | _ => d end. + +Definition to_oarr ws len (a : 'array) : (chMap (chFin len) ('word ws)) := + mkfmapf (fun (i : 'I_len) => chArray_get ws a (Z.of_nat i) (wsize_size ws)) (ord_enum len). +Definition to_arr ws len (a : 'array) := + mkfmapf (fun i => chArray_get ws a i (wsize_size ws)) (ziota 0 len). + +Lemma wsize_size_aux (ws : wsize.wsize) : + (ws %/ U8 + ws %% U8)%nat = Z.to_nat (wsize_size ws). +Proof. destruct ws; reflexivity. Qed. + +Lemma encode_aux {ws} (w : word.word ws) : + LE.encode w = [seq word.subword ((Z.to_nat i0) * U8) U8 w | i0 <- ziota 0 (wsize_size ws)]. +Proof. + unfold LE.encode. + unfold split_vec. + unfold ziota. + rewrite -wsize_size_aux. + simpl. + rewrite -map_comp. + unfold comp. + apply map_ext. + intros a Ha. + rewrite Nat2Z.id. + reflexivity. +Qed. + +Lemma wsize_size_bits ws: + wsize_size ws < wsize_bits ws. +Proof. + unfold wsize_size, wsize_bits. + destruct ws; simpl; lia. +Qed. + +Lemma chArray_get_set_eq ws a i w : + chArray_get ws (chArray_set a AAscale i w) i (wsize_size ws) = w. +Proof. + unfold chArray_get. + unfold chArray_set. + rewrite <- LE.decodeK. + f_equal. + rewrite encode_aux. + apply map_ext. + intros j Hj. + unfold chArray_get8. + rewrite chArray_write_get. + assert ((0 <=? i * wsize_size ws + j - i * mk_scale AAscale ws) && (i * wsize_size ws + j - i * mk_scale AAscale ws /InP. rewrite in_ziota=>/andP [] H1 h2. lia. } + rewrite H. + unfold LE.wread8. + unfold LE.encode. + unfold split_vec. + unshelve erewrite nth_map. 1: exact 0%nat. + { simpl. + rewrite nth_iota. + 1: f_equal; lia. + simpl. move: Hj=>/InP. rewrite in_ziota=>/andP [] H1 h2. + replace (ws %/ U8 + ws %% U8)%nat with (Z.to_nat (wsize_size ws)); [lia|]. + destruct ws; simpl; reflexivity. } + rewrite size_iota. + simpl. move: Hj=>/InP. rewrite in_ziota=>/andP [] H1 h2. + replace (ws %/ U8 + ws %% U8)%nat with (Z.to_nat (wsize_size ws)); [lia|]. + destruct ws; simpl; reflexivity. +Qed. + +Lemma chArray_get_set_neq ws a i j (w : 'word ws) : + i <> j -> + chArray_get ws (chArray_set a AAscale i w) j (wsize_size ws) = chArray_get ws a j (wsize_size ws). +Proof. + intros H. + unfold chArray_get. + unfold chArray_set. + f_equal. + apply map_ext. + intros a0 Ha0. + unfold chArray_get8. + rewrite chArray_write_get. + assert ((0 <=? j * wsize_size ws + a0 - i * mk_scale AAscale ws) && (j * wsize_size ws + a0 - i * mk_scale AAscale ws /InP. rewrite in_ziota=>/andP [] H1 h2. nia. } + rewrite H0. + reflexivity. +Qed. + +Lemma in_ziota' i p z : + @in_mem (Ord.sort Z_ordType) i (@mem (Equality.sort (Ord.eqType Z_ordType)) (seq_predType (Ord.eqType Z_ordType)) (ziota p z)) = (p <=? i) && (i ∀ p : Z, @in_mem (Ord.sort Z_ordType) i (@mem (Equality.sort (Ord.eqType Z_ordType)) (seq_predType (Ord.eqType Z_ordType)) (ziota p z)) = (p <=? i) && (i P z). + 1: { apply natlike_ind. + - unfold P. intros. rewrite in_nil. lia. + - unfold P. intros. + rewrite ziotaS_cons. 2: auto. + destruct (Z.eq_dec x i). + + subst. + simpl. + unfold in_mem. + simpl. + unfold in_mem in H0. + simpl in H0. + rewrite H0. + destruct (Z.eq_dec i p). + * subst. rewrite eq_refl. lia. + * assert ((@eq_op (Ord.eqType Z_ordType) i p) = false). + 1: { apply/eqP. intros contra. subst. easy. } + rewrite H1. lia. + + simpl. + unfold in_mem. + simpl. + unfold in_mem in H0. + simpl in H0. + rewrite H0. + destruct (Z.eq_dec i p). + * subst. rewrite eq_refl. lia. + * assert ((@eq_op (Ord.eqType Z_ordType) i p) = false). + 1: { apply/eqP. intros contra. subst. easy. } + rewrite H1. lia. } + assumption. +Qed. + +Lemma getm_to_arr_None' ws len a (i: Z) : + ((len <=? i) || (i + to_arr ws len a i = None. +Proof. + intros. unfold to_arr. + rewrite mkfmapfE. + rewrite in_ziota'. + assert ((0 <=? i) && (i + to_arr ws len a i = Some (chArray_get ws a i (wsize_size ws)). +Proof. + unfold to_arr. + rewrite mkfmapfE. + intros H. + rewrite in_ziota'. + assert ((0 <=? i) && (i + getmd (to_arr ws len a) x i = chArray_get ws a i (wsize_size ws). +Proof. + intros. + unfold getmd. + rewrite getm_to_arr; auto. +Qed. + +Lemma to_oarr_set_eq ws len a (i : 'I_(pos len)) w : + (to_oarr ws len (chArray_set a AAscale (Z.of_nat (nat_of_ord i)) w)) i = Some w. +Proof. + rewrite getm_to_oarr. + rewrite chArray_get_set_eq. + reflexivity. +Qed. + +Lemma to_arr_set_eq ws len a i w : + (0 <= i < len) -> + (to_arr ws len (chArray_set a AAscale i w)) i = Some w. +Proof. + intros H. + rewrite getm_to_arr; auto. + rewrite chArray_get_set_eq; auto. +Qed. + +Lemma to_arr_set_neq' ws len a i j (w : 'word ws) : + (i <> j) -> + (0 <= j < len) -> + (to_arr ws len (chArray_set a AAscale i w)) j = Some (chArray_get ws a j (wsize_size ws)). +Proof. + intros Hneq H. + rewrite getm_to_arr; auto. + rewrite chArray_get_set_neq; auto. +Qed. + +Lemma to_arr_set_neq ws len a i j (w : 'word ws) : + (i <> j) -> + (0 <= j < len) -> + (to_arr ws len (chArray_set a AAscale i w)) j = (to_arr ws len a) j. +Proof. + intros Hneq H. + rewrite !getm_to_arr; auto. + rewrite chArray_get_set_neq; auto. +Qed. + +(** Additional rules *) + +Theorem rpre_weak_hypothesis_rule : + ∀ {A₀ A₁ : ord_choiceType} {p₀ : raw_code A₀} {p₁ : raw_code A₁} + (pre : precond) post, + (∀ s₀ s₁, + pre (s₀, s₁) → ⊢ ⦃ λ '(s0, s1), pre (s0, s1) ⦄ p₀ ≈ p₁ ⦃ post ⦄ + ) → + ⊢ ⦃ pre ⦄ p₀ ≈ p₁ ⦃ post ⦄. +Proof. + intros A₀ A₁ p₀ p₁ pre post h. + eapply rpre_hypothesis_rule. + intros. eapply rpre_weaken_rule. + 1: eapply h; eauto. + intros s0' s1' [H0 H1]. + subst. + assumption. +Qed. + +(** Valid code *) + +Lemma valid_code_cons {A} a l I (c : raw_code A) : + valid_code (fset l) I c -> valid_code (fset (a :: l)) I c. +Proof. + intros. + induction c; econstructor. + - apply inversion_valid_opr in H as []. easy. + - intros. apply H0. apply inversion_valid_opr in H as []. easy. + - apply inversion_valid_getr in H as []. rewrite in_fset in_cons. apply/orP; right. rewrite -in_fset. easy. + - intros. apply H0. apply inversion_valid_getr in H as []. easy. + - apply inversion_valid_putr in H as []. rewrite in_fset in_cons. apply/orP; right. rewrite -in_fset. easy. + - apply inversion_valid_putr in H as []. apply IHc. easy. + - intros. apply H0. eapply inversion_valid_sampler. easy. +Qed. + +Lemma valid_code_catC {A} l1 l2 I (c : raw_code A) : + valid_code (fset (l1 ++ l2)) I c -> valid_code (fset (l2 ++ l1)) I c. +Proof. by rewrite !fset_cat fsetUC. Qed. + +Lemma valid_code_cat_r {A} l1 l2 I (c : raw_code A) : + valid_code (fset l1) I c -> valid_code (fset (l1 ++ l2)) I c. +Proof. + intros. + induction l2. + - rewrite cats0. easy. + - apply valid_code_catC. simpl. apply valid_code_cons. apply valid_code_catC. easy. +Qed. + +Lemma valid_code_cat_l {A} l1 l2 I (c : raw_code A) : + valid_code (fset l2) I c -> valid_code (fset (l1 ++ l2)) I c. +Proof. intros; apply valid_code_catC. apply valid_code_cat_r. easy. Qed. + +Lemma valid_translate_write_lvals1 I id0 (v : var_i) vs : + valid_code (fset [:: translate_var id0 v]) I (translate_write_lvals [::] id0 [:: (Lvar v)] vs) . +Proof. + destruct vs. + - constructor. + - constructor. + 1: auto_in_fset. + constructor. +Qed. + +Lemma valid_translate_write_lvals2 I id0 (v1 v2 : var_i) vs : + valid_code (fset [:: translate_var id0 v1 ; translate_var id0 v2]) I (translate_write_lvals [::] id0 [:: (Lvar v1) ; (Lvar v2)] vs) . +Proof. + destruct vs. + - constructor. + - constructor. + 1: auto_in_fset. + destruct vs. + + constructor. + + constructor. + 1: auto_in_fset. + constructor. +Qed. + +(** Invariants and tactics *) + +Definition pdisj (P : precond) (s_id : p_id) (rhs : {fset Location}) := + (forall h1 h2 l a v s_id', l = translate_var s_id' v -> (s_id ⪯ s_id') -> (P (h1, h2) -> P (set_heap h1 l a, h2))) /\ + (forall h1 h2 l a, l \in rhs -> (P (h1, h2) -> P (h1, set_heap h2 l a))). + +Definition u_pdisj (P : precond) (lhs : {fset Location}) := + (forall h1 h2 l a, l \in lhs -> (P (h1, h2) -> P (set_heap h1 l a, h2))). + +Definition pdisj' (P : precond) (s_id : p_id) (lhs : {fset Location}) (rhs : {fset Location}) := + (forall h1 h2 l a, l \in lhs -> (P (h1, h2) -> P (set_heap h1 l a, h2))) /\ + (forall h1 h2 l a, l \in rhs -> (P (h1, h2) -> P (h1, set_heap h2 l a))). + +Ltac solve_in := + repeat match goal with + | |- is_true (?v \in fset1 ?v :|: _) => apply/fsetU1P; left; auto + | |- is_true (_ \in fsetU _ _) => apply/fsetU1P; right + end. + +Ltac destruct_pre := + repeat + match goal with + | [ H : set_lhs _ _ _ _ |- _ ] => + let sn := fresh in + let Hsn := fresh in + destruct H as [sn [Hsn]] + | [ H : set_rhs _ _ _ _ |- _ ] => + let sn := fresh in + let Hsn := fresh in + destruct H as [sn [Hsn]] + | [ H : _ /\ _ |- _ ] => + let H1 := fresh in + let H2 := fresh in + destruct H as [H1 H2] + | [ H : (_ ⋊ _) _ |- _ ] => + let H1 := fresh in + let H2 := fresh in + destruct H as [H1 H2] + | [ H : exists _, _ |- _ ] => + let o := fresh in + destruct H as [o] + end; simpl in *; subst. + +(* I don't know what rewrite * means, but this is much faster than regular rewrite, which also sometimes overflows the stack *) +Ltac sheap := + repeat first [ rewrite * get_set_heap_neq; [| neq_loc_auto ] | + rewrite * get_set_heap_eq ]. + +(* This works sometimes, but might be very slow *) +Ltac simpl_heap := + repeat lazymatch goal with + | |- context [ get_heap (set_heap _ ?l _) ?l ] => rewrite -> get_set_heap_eq + | |- context [ get_heap (set_heap (translate_var ?s_id _) (translate_var ?s_id _ ) _ ) _ ] => (rewrite -> get_set_heap_neq by (apply injective_translate_var3; auto)) + | |- context [ get_heap (set_heap _ (translate_var _ _ ) _ ) _ ] => (rewrite -> get_set_heap_neq by (apply injective_translate_var2; assumption)) + end. + +Ltac split_post := + repeat + match goal with + | |- (_ ⋊ _) _ => split + | |- _ /\ _ => split + | |- set_lhs _ _ _ _ => eexists + end. + +(* NB: this redefines neq_loc_auto, which helps some tactics, since checking for inequality by computation is not feasible for translated variables *) +(* Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. *) + +#[global] Hint Resolve preceq_I preceq_O preceq_refl : preceq. +Ltac solve_preceq := + repeat lazymatch goal with + | |- ?a ⪯ ?a => reflexivity + | |- ?a ⪯ ?b~1 => etransitivity; [|apply preceq_I] + | |- ?a ⪯ ?b~0 => etransitivity; [|apply preceq_O] + end. + +Ltac esolve_in := + rewrite in_fset; apply/xseq.InP; + repeat lazymatch goal with + | |- List.In _ (_ :: _) => eapply List.in_cons + | |- _ => eapply List.in_eq + end. + +Ltac tr_inseq_try := + apply/orP ; first [ left ; rewrite translate_var_eq eq_refl ; reflexivity + | right ; tr_inseq_try ]. + +Ltac tr_inset_try := + rewrite in_fset ; tr_inseq_try. + +Ltac tr_auto_in_fset := + eauto ; + try tr_inset_try. + +Ltac until_call := + simpl; repeat match goal with + | |- ValidCode _ _ _ => red + | |- valid_code _ _ (_ ← translate_call _ _ _ _ _ ;; _) => eapply valid_bind + | |- valid_code _ _ (_ ← (x ← _ ;; _) ;; _) => rewrite bind_assoc + | |- _ => constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]; intros + | |- _ -> _ => intros + end. + +Ltac pdisj_apply h := + lazymatch goal with + | |- ?pre (set_heap _ _ _, set_heap _ _ _) => eapply h; [ solve_in | pdisj_apply h ] + | |- ?pre (set_heap _ _ _, _) => + eapply h ; [ reflexivity | auto with preceq | pdisj_apply h ] + | |- _ => try assumption + end. + +Ltac pdisj'_apply h := + lazymatch goal with + | |- ?pre (set_heap _ _ _, _) => eapply h; [ tr_auto_in_fset | pdisj'_apply h ] + | |- ?pre (_, set_heap _ _ _) => eapply h; [ auto_in_fset | pdisj'_apply h ] + | |- _ => try assumption + end. + +Ltac u_pdisj_apply h := + lazymatch goal with + | |- ?pre (set_heap _ _ _, _) => eapply h; [ solve_in | u_pdisj_apply h ] + | |- _ => try assumption + end. + +Ltac clear_fset := + repeat match goal with + | |- ValidCode _ _ _ => red + | |- valid_code (fset (_ :: _)) _ _ => eapply valid_code_cons + | |- valid_code (fset (_ ++ _)) _ _ => eapply valid_code_cat_l + end; eapply valid_code_cat_r. + +(** Misc (TODO: move these) *) + +(* TODO: move these, note they are the same as fresh1 and fresh2 *) +Lemma prec_O : + forall i, i ≺ i~0. +Proof. + simpl; split. + - apply preceq_O. + - apply nesym. apply xO_neq. +Qed. + +Lemma prec_I : + forall i, i ≺ i~1. +Proof. + simpl; split. + - apply preceq_I. + - apply nesym. apply xI_neq. +Qed. + +Ltac solve_prec := + repeat lazymatch goal with + | |- ?a ≺ ?a~1 => apply prec_I + | |- ?a ≺ ?a~0 => apply prec_O + | |- ?a ≺ ?b~1 => etransitivity; [|apply prec_I] + | |- ?a ≺ ?b~0 => etransitivity; [|apply prec_O] + end. + +(** *) diff --git a/theories/Jasmin/examples/aes/aes_valid.v b/theories/Jasmin/examples/aes/aes_valid.v new file mode 100644 index 00000000..aa11ae61 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_valid.v @@ -0,0 +1,279 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect seq. +Set Warnings "notation-overridden,ambiguous-paths". + +From JasminSSProve Require Import jasmin_translate aes_utils aes_jazz. +From Relational Require Import OrderEnrichedCategory GenericRulesSimple. +From Crypt Require Import Axioms ChoiceAsOrd pkg_core_definition choice_type Prelude. + +From extructures Require Import fset ord. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Local Open Scope positive_scope. + +Ltac fix_lvals1 := clear_fset; eapply valid_translate_write_lvals1. +Ltac fix_lvals2 := clear_fset; eapply valid_translate_write_lvals2. + +Lemma JRCON_valid id0 : + ∑ L, forall I j, ValidCode (fset L) I (JRCON id0 j). +Proof. + eexists. + intros I j. + unfold JRCON. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + simpl. unfold ValidCode. + repeat match goal with + | |- context[BinInt.Z.eqb _ _] => rewrite ?coerce_to_choice_type_K; destruct (BinInt.Z.eqb _ _) + | |- valid_code _ _ _ => constructor + | |- is_true (_ \in _) => solve [ tr_auto_in_fset | esolve_in ] + | _ => intros + end. + Unshelve. exact [::]. +Defined. + +Definition JRCON_locs id0 : {fset Location} := fset (JRCON_valid id0).π1. + +Lemma JKEY_EXPAND_valid id0 : + ∑ L, forall I rcon rkey temp2, ValidCode (fset L) I (JKEY_EXPAND id0 rcon rkey temp2). +Proof. + eexists. + intros rcon rkey temp2. + unfold JRCON. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + simpl. unfold ValidCode. + repeat match goal with + | |- valid_code _ _ _ => constructor + | |- is_true (_ \in _) => solve [ tr_auto_in_fset | esolve_in ] + | _ => intros + end. + Unshelve. exact [::]. +Defined. + +Definition JKEY_EXPAND_locs id0 : {fset Location} := fset (JKEY_EXPAND_valid id0).π1. + +Lemma JKEYS_EXPAND_valid id0 : + ∑ L, forall I rkey, ValidCode (fset L) I (JKEYS_EXPAND id0 rkey). +Proof. + eexists. + intros. + unfold JAES. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + (* Opaque translate_for. *) + Opaque translate_call. + simpl. + unfold translate_for. + rewrite !coerce_typed_code_K. + + Ltac fix_rcon := clear_fset; eapply (JRCON_valid _).π2. + Ltac fix_key_expand := clear_fset; eapply (JKEY_EXPAND_valid _).π2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JKEYS_EXPAND_locs id0 : {fset Location} := fset (JKEYS_EXPAND_valid id0).π1. + +Lemma JAES_ROUNDS_valid id0 : + ∑ L, forall I rkeys m, ValidCode (fset L) I (JAES_ROUNDS id0 rkeys m). +Proof. + eexists. + intros. + unfold JAES. + unfold get_translated_static_fun. + unfold translate_prog_static. + unfold translate_funs_static. + unfold translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + rewrite !coerce_typed_code_K. + until_call. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JAES_ROUNDS_locs id0 : {fset Location} := fset (JAES_ROUNDS_valid id0).π1. + +Lemma JAES_valid id0 : + ∑ L, forall I key m, ValidCode (fset L) I (JAES id0 key m). +Proof. + eexists. + unfold JAES. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + until_call. + 1: clear_fset. + 1: eapply (JKEYS_EXPAND_valid _).π2. + eapply valid_bind. + 1: clear_fset. + 1: eapply valid_translate_write_lvals1. + until_call. + + 1: clear_fset. + 1: eapply (JAES_ROUNDS_valid _).π2. + eapply valid_bind. + 1: clear_fset. + 1: eapply valid_translate_write_lvals1. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JAES_locs id0 : {fset Location} := fset (JAES_valid id0).π1. + +Lemma JXOR_valid id0 : + ∑ L, forall I a1 a2, ValidCode (fset L) I (JXOR id0 a1 a2). +Proof. + eexists. + unfold JXOR. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + until_call. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JXOR_locs id0 : {fset Location} := fset (JXOR_valid id0).π1. + +Lemma JENC_valid id0 : + ∑ L, forall I n k m, ValidCode (fset L) I (JENC id0 n k m). +Proof. + + unfold JENC. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + eexists. + intros. + until_call. + + 1: clear_fset. + 1: eapply (JAES_valid _).π2. + eapply valid_bind. + 1: clear_fset; eapply valid_translate_write_lvals1. + until_call. + 1: clear_fset; eapply (JXOR_valid _).π2. + eapply valid_bind. + 1: clear_fset; eapply valid_translate_write_lvals1. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JENC_locs id0 : {fset Location} := fset (JENC_valid id0).π1. diff --git a/theories/Jasmin/examples/bigadd.cprog b/theories/Jasmin/examples/bigadd.cprog new file mode 100644 index 00000000..1ffa67f5 --- /dev/null +++ b/theories/Jasmin/examples/bigadd.cprog @@ -0,0 +1,435 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; loc_start = (8, 2); + loc_end = (8, 12); loc_bchar = 123; loc_echar = 133}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (8, 2); loc_end = (8, 4); loc_bchar = 123; + loc_echar = 125}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (8, 7); loc_end = (8, 8); loc_bchar = 128; + loc_echar = 129}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; loc_start = (9, 2); + loc_end = (9, 12); loc_bchar = 136; loc_echar = 146}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (9, 2); loc_end = (9, 4); loc_bchar = 136; + loc_echar = 138}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (9, 7); loc_end = (9, 8); loc_bchar = 141; + loc_echar = 142}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 2); loc_end = (10, 15); loc_bchar = 149; + loc_echar = 162}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.156}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 2); loc_end = (10, 4); loc_bchar = 149; + loc_echar = 151}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 6); loc_end = (10, 8); loc_bchar = 153; + loc_echar = 155}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 6); loc_end = (10, 8); loc_bchar = 153; + loc_echar = 155}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 12); loc_end = (10, 14); loc_bchar = 159; + loc_echar = 161}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pbool false])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (12, 2); loc_end = (12, 14); loc_bchar = 166; + loc_echar = 178}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = res.153}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (12, 2); loc_end = (12, 5); loc_bchar = 166; + loc_echar = 169}}, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (12, 11); loc_end = (12, 13); loc_bchar = 175; + loc_echar = 177}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 10; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (14, 2); loc_end = (20, 3); loc_bchar = 182; + loc_echar = 273}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (14, 6); loc_end = (14, 7); loc_bchar = 186; + loc_echar = 187}}, + ((Jasmin.Expr.UpTo, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 6; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 4); loc_end = (15, 14); loc_bchar = 203; + loc_echar = 213}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 4); loc_end = (15, 6); loc_bchar = 203; + loc_echar = 205}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 9); loc_end = (15, 10); loc_bchar = 208; + loc_echar = 209}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 11); loc_end = (15, 12); + loc_bchar = 210; loc_echar = 211}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 7; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 4); loc_end = (16, 14); loc_bchar = 218; + loc_echar = 228}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 4); loc_end = (16, 6); loc_bchar = 218; + loc_echar = 220}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 9); loc_end = (16, 10); loc_bchar = 223; + loc_echar = 224}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 11); loc_end = (16, 12); + loc_bchar = 225; loc_echar = 226}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 8; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 4); loc_end = (17, 22); loc_bchar = 233; + loc_echar = 251}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.156}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 4); loc_end = (17, 6); loc_bchar = 233; + loc_echar = 235}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 8); loc_end = (17, 10); loc_bchar = 237; + loc_echar = 239}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 8); loc_end = (17, 10); + loc_bchar = 237; loc_echar = 239}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 14); loc_end = (17, 16); + loc_bchar = 243; loc_echar = 245}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.156}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 19); loc_end = (17, 21); + loc_bchar = 248; loc_echar = 250}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 9; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 4); loc_end = (19, 16); loc_bchar = 257; + loc_echar = 269}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = res.153}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 4); loc_end = (19, 7); loc_bchar = 257; + loc_echar = 260}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 8); loc_end = (19, 9); + loc_bchar = 261; loc_echar = 262}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 13); loc_end = (19, 15); + loc_bchar = 266; loc_echar = 268}}; + gs = Jasmin.Expr.Slocal}))]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = res.153}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; loc_start = (21, 9); + loc_end = (21, 12); loc_bchar = 283; loc_echar = 286}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/bigadd.jazz b/theories/Jasmin/examples/bigadd.jazz new file mode 100644 index 00000000..e3902c21 --- /dev/null +++ b/theories/Jasmin/examples/bigadd.jazz @@ -0,0 +1,22 @@ +export fn add_inline(reg u64[4] x y) -> reg u64[4] { + inline int i; + reg u64[4] res; + + reg u64 xr yr; + reg bool cf; + + xr = x[0]; + yr = y[0]; + cf, xr += yr; + + res[0] = xr; + + for i = 1 to 4 { + xr = x[i]; + yr = y[i]; + cf, xr += yr + cf; + + res[i] = xr; + } + return res; +} \ No newline at end of file diff --git a/theories/Jasmin/examples/bigadd.v b/theories/Jasmin/examples/bigadd.v new file mode 100644 index 00000000..10877094 --- /dev/null +++ b/theories/Jasmin/examples/bigadd.v @@ -0,0 +1,208 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add_inline *) xH, + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO xH)))))); + (sarr (xO (xO (xO (xO (xO xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "x.149" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "y.150" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "x.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "y.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.154" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "res.151" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xO (xO xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "x.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "y.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.154" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.154" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "res.151" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xO xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "res.151" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD_INLINE := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/deextract.pl b/theories/Jasmin/examples/deextract.pl new file mode 100755 index 00000000..2baa524b --- /dev/null +++ b/theories/Jasmin/examples/deextract.pl @@ -0,0 +1,30 @@ +#!/usr/bin/perl +use Regexp::Common; + +my $string = <>; + +# change easy stuff (remove names added by extraction, quote strings, etc.) +$string =~ s/Jasmin\.[[:graph:]]*\.//g ; +$string =~ s/Coq_//g ; +$string =~ s/=/:=/g ; +$string =~ s/{/{| /g ; +$string =~ s/}/ |}/g ; +$string =~ s/v_info :=[ \t\n]*[^{}]*{[^}]*}/v_info := dummy_var_info/g ; +$string =~ s/(MkI[^(]*\()\(([^()]*(\([^)]*\))*)*\)/$1dummy_instr_info/g ; +$string =~ s/([[:graph:]]*\.[[:graph:]]*)/"$1"/g ; +$string =~ s/\(\)/tt/g ; + +# curry functions +# pattern which matches balanced expression with either () {} or "" +my $bal = qr/$RE{balanced}{-parens=>'(){}""'}/; + +# pattern which matches an alnum (function) followed by a tuple, e.g. f (a, b) +my $pat = qr/([[:alnum:]][ \n\t]*\(([^()]|($bal))*),([ \n\t]*)(([^(),]|($bal))*)\)/; + +# propagate the final parenthesis of the tuple down and parenthesise: +# f (a, b, c) -> f (a, b) (c) -> f (a) (b) (c) +while ( $string =~ m/$pat/g ) { + $string =~ s/$pat/$1\)$5\($6\)/g; +} + +print($string); diff --git a/theories/Jasmin/examples/ex.cprog b/theories/Jasmin/examples/ex.cprog new file mode 100644 index 00000000..bdd765f1 --- /dev/null +++ b/theories/Jasmin/examples/ex.cprog @@ -0,0 +1,120 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 2); + loc_end = (5, 13); loc_bchar = 81; loc_echar = 92}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.146}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 2); + loc_end = (5, 4); loc_bchar = 81; loc_echar = 83}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 6); + loc_end = (5, 7); loc_bchar = 85; loc_echar = 86}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 6); + loc_end = (5, 7); loc_bchar = 85; loc_echar = 86}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 11); + loc_end = (5, 12); loc_bchar = 90; loc_echar = 91}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pbool false])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 2); + loc_end = (6, 13); loc_bchar = 95; loc_echar = 106}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.146}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 2); + loc_end = (6, 4); loc_bchar = 95; loc_echar = 97}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 6); + loc_end = (6, 7); loc_bchar = 99; loc_echar = 100}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 6); + loc_end = (6, 7); loc_bchar = 99; loc_echar = 100}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 11); + loc_end = (6, 12); loc_bchar = 104; loc_echar = 105}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pbool false]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (8, 9); + loc_end = (8, 10); loc_bchar = 117; loc_echar = 118}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/ex.jazz b/theories/Jasmin/examples/ex.jazz new file mode 100644 index 00000000..7d49a837 --- /dev/null +++ b/theories/Jasmin/examples/ex.jazz @@ -0,0 +1,9 @@ +param int KEYSIZE = 4; + +inline fn add(reg u64 x y) -> reg u64 { + reg bool cf; + cf, x += y; + cf, y += x; + + return y; +} diff --git a/theories/Jasmin/examples/ex.v b/theories/Jasmin/examples/ex.v new file mode 100644 index 00000000..6178c211 --- /dev/null +++ b/theories/Jasmin/examples/ex.v @@ -0,0 +1,92 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.144" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.144" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/gen_and_test.sh b/theories/Jasmin/examples/gen_and_test.sh new file mode 100755 index 00000000..7f265433 --- /dev/null +++ b/theories/Jasmin/examples/gen_and_test.sh @@ -0,0 +1,19 @@ +#!/bin/bash +# test deextraction of all .jazz in this folder, note that their corresponding .v will be overwritten + +JASMINC=${JASMINC:-$(which jasminc)} + +# assuming jasmin is in home directory +for f in *.jazz +do + echo $f + $JASMINC -I AES:../examples -coq $f > $(basename $f .jazz).v + # JASMINC=~/jasmin/compiler/jasminc.byte ./gen_ast.sh $f + cd ../../.. + coqc -Q theories/Mon Mon \ + -Q theories/Relational Relational \ + -Q theories/Crypt Crypt \ + -Q theories/Jasmin JasminSSProve \ + theories/Jasmin/examples/"$(basename $f .jazz)".v + cd - +done diff --git a/theories/Jasmin/examples/gen_ast.sh b/theories/Jasmin/examples/gen_ast.sh new file mode 100755 index 00000000..3855e607 --- /dev/null +++ b/theories/Jasmin/examples/gen_ast.sh @@ -0,0 +1,50 @@ +#!/bin/bash + +# you might have install the perl module Regexp::Common via cpan + +# set path to jasminc.byte on command line by invoking the script with +# JASMINC=... ./gen_ast.sh foo.jazz +# JASMINC=${JASMINC:-$(which jasminc.byte)} + +# use this variable to e.g. include paths +# e.g.: ./gen_ast.sh aes '-I AES:../examples' +OPTS=${2} +echo $OPTS +echo "open Format + +let print_vname (fmt : formatter) (t : Obj.t) = + let t = Obj.magic t in + ignore (List.map (pp_print_char fmt) t)" > print_vname.ml + +ocamlc -c print_vname.ml + +name=$(basename "${1}" .jazz) +echo $name + +echo -n "Require Import List. +From Jasmin Require Import expr. +From Jasmin Require Import x86_extra. + +Import ListNotations. +Local Open Scope string. + +Definition ${name} :=" > $name.v + +(ocamldebug $JASMINC < $name.cprog + +# delete all but the 12 first lines and then delete the last line +sed -i '12,$!d;$d' $name.cprog + +perl -0777 deextract.pl $name.cprog >> $name.v + +echo -n "." >> $name.v diff --git a/theories/Jasmin/examples/int_add.cprog b/theories/Jasmin/examples/int_add.cprog new file mode 100644 index 00000000..a30e666b --- /dev/null +++ b/theories/Jasmin/examples/int_add.cprog @@ -0,0 +1,173 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sint; Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = n.154}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (12, 3); loc_end = (14, 4); loc_bchar = 199; + loc_echar = 238}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.156}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (12, 7); loc_end = (12, 8); loc_bchar = 203; + loc_echar = 204}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = n.154}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (12, 16); loc_end = (12, 17); loc_bchar = 212; + loc_echar = 213}}; + gs = Jasmin.Expr.Slocal}), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (13, 7); loc_end = (13, 17); loc_bchar = 223; + loc_echar = 233}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (13, 7); loc_end = (13, 8); loc_bchar = 223; + loc_echar = 224}}, + Jasmin.Expr.AT_inline, Jasmin.Type.Coq_sint, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (13, 11); loc_end = (13, 12); + loc_bchar = 227; loc_echar = 228}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH))))]))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; loc_start = (15, 10); + loc_end = (15, 11); loc_bchar = 249; loc_echar = 250}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.157}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (3, 3); loc_end = (5, 4); loc_bchar = 63; + loc_echar = 102}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.159}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 67; + loc_echar = 68}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp1 (Jasmin.Expr.Oint_of_word Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.157}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (3, 16); loc_end = (3, 17); loc_bchar = 76; + loc_echar = 77}}; + gs = Jasmin.Expr.Slocal})), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (4, 7); loc_end = (4, 17); loc_bchar = 87; + loc_echar = 97}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (4, 7); loc_end = (4, 8); loc_bchar = 87; + loc_echar = 88}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (4, 11); loc_end = (4, 12); loc_bchar = 91; + loc_echar = 92}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; loc_start = (6, 10); + loc_end = (6, 11); loc_bchar = 113; loc_echar = 114}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_add.jazz b/theories/Jasmin/examples/int_add.jazz new file mode 100644 index 00000000..523e27e2 --- /dev/null +++ b/theories/Jasmin/examples/int_add.jazz @@ -0,0 +1,16 @@ +fn odd (reg u64 n, reg u64 m) -> reg u64 { + inline int i; + for i = 0 to n { + m = m + 1; + } + return m; +} + + +inline fn add (inline int n, inline int m) -> inline int { + inline int i; + for i = 0 to n { + m = m + 1; + } + return m; +} diff --git a/theories/Jasmin/examples/int_add.v b/theories/Jasmin/examples/int_add.v new file mode 100644 index 00000000..9826dfbb --- /dev/null +++ b/theories/Jasmin/examples/int_add.v @@ -0,0 +1,117 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint; sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "n.152" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.154" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "n.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH))))))]) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* odd *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.155" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.157" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp1 (Oint_of_word U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD := ( xH ). +Notation ODD := ( xO xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/int_incr.cprog b/theories/Jasmin/examples/int_incr.cprog new file mode 100644 index 00000000..a66edf22 --- /dev/null +++ b/theories/Jasmin/examples/int_incr.cprog @@ -0,0 +1,141 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (11, 2); loc_end = (11, 14); loc_bchar = 167; + loc_echar = 179}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.153}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (11, 2); loc_end = (11, 3); loc_bchar = 167; + loc_echar = 168}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pconst Jasmin.BinNums.Z0])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (12, 2); loc_end = (12, 9); loc_bchar = 182; + loc_echar = 189}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xx.154}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (12, 2); loc_end = (12, 4); loc_bchar = 182; + loc_echar = 184}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (12, 7); loc_end = (12, 8); loc_bchar = 187; + loc_echar = 188}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (13, 2); loc_end = (13, 15); loc_bchar = 192; + loc_echar = 205}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (13, 2); loc_end = (13, 3); loc_bchar = 192; + loc_echar = 193}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = x.153}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (13, 12); loc_end = (13, 13); loc_bchar = 202; + loc_echar = 203}}; + gs = Jasmin.Expr.Slocal})))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; loc_start = (14, 9); + loc_end = (14, 10); loc_bchar = 215; loc_echar = 216}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = n.155}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 13); loc_bchar = 65; + loc_echar = 75}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.156}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 65; + loc_echar = 66}}, + Jasmin.Expr.AT_inline, Jasmin.Type.Coq_sint, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = n.155}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (3, 8); loc_end = (3, 9); loc_bchar = 70; + loc_echar = 71}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH))))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.156}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; loc_start = (4, 10); + loc_end = (4, 11); loc_bchar = 86; loc_echar = 87}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_incr.jazz b/theories/Jasmin/examples/int_incr.jazz new file mode 100644 index 00000000..13f687e3 --- /dev/null +++ b/theories/Jasmin/examples/int_incr.jazz @@ -0,0 +1,15 @@ +inline fn incr(inline int n) -> inline int { + inline int m; + m = (n+1); + return m; + } + +export fn f() -> reg u64 { + inline int x; + reg u64 xx; + reg u64 y; + x = incr(0); + xx = y; + y = ((64u)x); + return y; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/int_incr.v b/theories/Jasmin/examples/int_incr.v new file mode 100644 index 00000000..9e37d1c8 --- /dev/null +++ b/theories/Jasmin/examples/int_incr.v @@ -0,0 +1,103 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sint + ; vname := "x.151" |} + ; v_info := dummy_var_info |}] + (xO xH) [(Pconst (Z0))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xx.152" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "y.150" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "x.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.150" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* incr *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "n.153" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "m.154" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "n.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "m.154" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation INCR := ( xO xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/int_reg.cprog b/theories/Jasmin/examples/int_reg.cprog new file mode 100644 index 00000000..b41979ef --- /dev/null +++ b/theories/Jasmin/examples/int_reg.cprog @@ -0,0 +1,46 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = k.141}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_reg.jazz"; + loc_start = (3, 3); loc_end = (3, 9); loc_bchar = 49; + loc_echar = 55}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.142}; + v_info = + {Jasmin.Location.loc_fname = "int_reg.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 49; + loc_echar = 50}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sint, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = k.141}; + v_info = + {Jasmin.Location.loc_fname = "int_reg.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 53; + loc_echar = 54}}; + gs = Jasmin.Expr.Slocal}))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.142}; + v_info = + {Jasmin.Location.loc_fname = "int_reg.jazz"; loc_start = (4, 10); + loc_end = (4, 11); loc_bchar = 66; loc_echar = 67}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_reg.jazz b/theories/Jasmin/examples/int_reg.jazz new file mode 100644 index 00000000..87981cca --- /dev/null +++ b/theories/Jasmin/examples/int_reg.jazz @@ -0,0 +1,5 @@ +fn foo (reg int k) -> reg int { + reg int x; + x = k; + return x; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/int_reg.v b/theories/Jasmin/examples/int_reg.v new file mode 100644 index 00000000..39e43755 --- /dev/null +++ b/theories/Jasmin/examples/int_reg.v @@ -0,0 +1,55 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* foo *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "k.139" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "x.140" |} + ; v_info := dummy_var_info |}) + AT_none (sint) + ((Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "x.140" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation FOO := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/int_shift.cprog b/theories/Jasmin/examples/int_shift.cprog new file mode 100644 index 00000000..4ece35fd --- /dev/null +++ b/theories/Jasmin/examples/int_shift.cprog @@ -0,0 +1,120 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (10, 2); loc_end = (10, 14); loc_bchar = 155; + loc_echar = 167}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (10, 2); loc_end = (10, 3); loc_bchar = 155; + loc_echar = 156}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pconst Jasmin.BinNums.Z0])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (11, 2); loc_end = (11, 15); loc_bchar = 170; + loc_echar = 183}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (11, 2); loc_end = (11, 3); loc_bchar = 170; + loc_echar = 171}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (11, 12); loc_end = (11, 13); loc_bchar = 180; + loc_echar = 181}}; + gs = Jasmin.Expr.Slocal})))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (12, 9); loc_end = (12, 10); loc_bchar = 193; + loc_echar = 194}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = n.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (3, 3); loc_end = (3, 15); loc_bchar = 65; + loc_echar = 77}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.153}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 65; + loc_echar = 66}}, + Jasmin.Expr.AT_inline, Jasmin.Type.Coq_sint, + Jasmin.Expr.Papp2 (Jasmin.Expr.Olsl Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = n.152}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 69; + loc_echar = 70}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))))))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.153}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (4, 10); loc_end = (4, 11); loc_bchar = 88; + loc_echar = 89}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_shift.jazz b/theories/Jasmin/examples/int_shift.jazz new file mode 100644 index 00000000..0c03c4e1 --- /dev/null +++ b/theories/Jasmin/examples/int_shift.jazz @@ -0,0 +1,13 @@ +inline fn incr(inline int n) -> inline int { + inline int m; + m = n << 65; + return m; + } + +export fn f() -> reg u64 { + inline int x; + reg u64 y; + x = incr(0); + y = ((64u)x); + return y; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/int_shift.v b/theories/Jasmin/examples/int_shift.v new file mode 100644 index 00000000..9da2625d --- /dev/null +++ b/theories/Jasmin/examples/int_shift.v @@ -0,0 +1,90 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sint + ; vname := "x.149" |} + ; v_info := dummy_var_info |}] + (xO xH) [(Pconst (Z0))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "x.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* incr *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "n.150" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "m.151" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Olsl Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "n.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xO (xO (xO (xO (xO xH))))))))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "m.151" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation INCR := ( xO xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/liveness_bork.cprog b/theories/Jasmin/examples/liveness_bork.cprog new file mode 100644 index 00000000..5e051290 --- /dev/null +++ b/theories/Jasmin/examples/liveness_bork.cprog @@ -0,0 +1,86 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (3, 3); loc_end = (5, 4); loc_bchar = 55; + loc_echar = 94}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.142}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 59; + loc_echar = 60}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp1 (Jasmin.Expr.Oint_of_word Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (3, 16); loc_end = (3, 17); loc_bchar = 68; + loc_echar = 69}}; + gs = Jasmin.Expr.Slocal})), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (4, 7); loc_end = (4, 17); loc_bchar = 79; + loc_echar = 89}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (4, 7); loc_end = (4, 8); loc_bchar = 79; + loc_echar = 80}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (4, 11); loc_end = (4, 12); loc_bchar = 83; + loc_echar = 84}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (6, 10); loc_end = (6, 11); loc_bchar = 105; + loc_echar = 106}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/liveness_bork.jazz b/theories/Jasmin/examples/liveness_bork.jazz new file mode 100644 index 00000000..0581fff6 --- /dev/null +++ b/theories/Jasmin/examples/liveness_bork.jazz @@ -0,0 +1,7 @@ +fn double (reg u64 n) -> reg u64 { + inline int i; + for i = 0 to n { + n = n + 1; + } + return n; +} diff --git a/theories/Jasmin/examples/liveness_bork.v b/theories/Jasmin/examples/liveness_bork.v new file mode 100644 index 00000000..6be4f6f2 --- /dev/null +++ b/theories/Jasmin/examples/liveness_bork.v @@ -0,0 +1,70 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* double *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.140" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp1 (Oint_of_word U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation DOUBLE := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/matrix_product.cprog b/theories/Jasmin/examples/matrix_product.cprog new file mode 100644 index 00000000..8d3ab0dd --- /dev/null +++ b/theories/Jasmin/examples/matrix_product.cprog @@ -0,0 +1,1767 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.218}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.219}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.220}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 24; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (68, 2); loc_end = (73, 3); loc_bchar = 1344; + loc_echar = 1458}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (68, 6); loc_end = (68, 7); loc_bchar = 1348; + loc_echar = 1349}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 20; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 4); loc_end = (69, 27); loc_bchar = 1369; + loc_echar = 1392}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 4); loc_end = (69, 7); loc_bchar = 1369; + loc_echar = 1372}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pload (Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.218}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 16); loc_end = (69, 17); loc_bchar = 1381; + loc_echar = 1382}}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 24); loc_end = (69, 25); + loc_bchar = 1389; loc_echar = 1390}}; + gs = Jasmin.Expr.Slocal}))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 21; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 4); loc_end = (70, 16); loc_bchar = 1397; + loc_echar = 1409}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mx.223}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 4); loc_end = (70, 6); loc_bchar = 1397; + loc_echar = 1399}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 7); loc_end = (70, 8); + loc_bchar = 1400; loc_echar = 1401}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 12); loc_end = (70, 15); + loc_bchar = 1405; loc_echar = 1408}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 22; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 4); loc_end = (71, 27); loc_bchar = 1414; + loc_echar = 1437}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 4); loc_end = (71, 7); loc_bchar = 1414; + loc_echar = 1417}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pload (Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.219}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 16); loc_end = (71, 17); loc_bchar = 1426; + loc_echar = 1427}}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 24); loc_end = (71, 25); + loc_bchar = 1434; loc_echar = 1435}}; + gs = Jasmin.Expr.Slocal}))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 23; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 4); loc_end = (72, 16); loc_bchar = 1442; + loc_echar = 1454}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = my.224}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 4); loc_end = (72, 6); loc_bchar = 1442; + loc_echar = 1444}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 7); loc_end = (72, 8); + loc_bchar = 1445; loc_echar = 1446}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 12); loc_end = (72, 15); + loc_bchar = 1450; loc_echar = 1453}}; + gs = Jasmin.Expr.Slocal}))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 25; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 2); loc_end = (74, 41); loc_bchar = 1461; + loc_echar = 1500}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mz.225}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 2); loc_end = (74, 4); loc_bchar = 1461; + loc_echar = 1463}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mx.223}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 29); loc_end = (74, 31); loc_bchar = 1488; + loc_echar = 1490}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = my.224}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 33); loc_end = (74, 35); loc_bchar = 1492; + loc_echar = 1494}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mz.225}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 37); loc_end = (74, 39); loc_bchar = 1496; + loc_echar = 1498}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 28; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (75, 2); loc_end = (78, 3); loc_bchar = 1503; + loc_echar = 1572}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (75, 6); loc_end = (75, 7); loc_bchar = 1507; + loc_echar = 1508}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 26; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 4); loc_end = (76, 16); loc_bchar = 1528; + loc_echar = 1540}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 4); loc_end = (76, 7); loc_bchar = 1528; + loc_echar = 1531}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mz.225}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 10); loc_end = (76, 12); + loc_bchar = 1534; loc_echar = 1536}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 13); loc_end = (76, 14); + loc_bchar = 1537; loc_echar = 1538}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 27; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 4); loc_end = (77, 27); loc_bchar = 1545; + loc_echar = 1568}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lmem (Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.220}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 10); loc_end = (77, 11); + loc_bchar = 1551; loc_echar = 1552}}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 18); loc_end = (77, 19); + loc_bchar = 1559; loc_echar = 1560}}; + gs = Jasmin.Expr.Slocal}))), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 23); loc_end = (77, 26); + loc_bchar = 1564; loc_echar = 1567}}; + gs = Jasmin.Expr.Slocal}))]))]; + f_tyout = []; f_res = []; f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m1.226}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m2.227}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 14; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (49, 2); loc_end = (49, 13); loc_bchar = 924; + loc_echar = 935}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = pres.229}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (49, 2); loc_end = (49, 6); loc_bchar = 924; + loc_echar = 928}}, + Jasmin.Expr.AT_none, + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (49, 9); loc_end = (49, 12); loc_bchar = 931; + loc_echar = 934}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 15; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 2); loc_end = (50, 28); loc_bchar = 938; + loc_echar = 964}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2t.230}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 2); loc_end = (50, 5); loc_bchar = 938; + loc_echar = 941}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2.227}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 19); loc_end = (50, 21); loc_bchar = 955; + loc_echar = 957}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2t.230}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 23); loc_end = (50, 26); loc_bchar = 959; + loc_echar = 962}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 17; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (51, 2); loc_end = (53, 3); loc_bchar = 967; + loc_echar = 1057}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (51, 6); loc_end = (51, 7); loc_bchar = 971; + loc_echar = 972}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 16; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 4); loc_end = (52, 69); loc_bchar = 988; + loc_echar = 1053}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lasub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = rest.232}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 4); loc_end = (52, 8); loc_bchar = 988; + loc_echar = 992}}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 9); loc_end = (52, 10); + loc_bchar = 993; loc_echar = 994}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))], + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m1.226}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 40); loc_end = (52, 42); + loc_bchar = 1024; loc_echar = 1026}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Psub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2t.230}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 44); loc_end = (52, 47); + loc_bchar = 1028; loc_echar = 1031}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 48); loc_end = (52, 49); + loc_bchar = 1032; loc_echar = 1033}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Expr.Psub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = rest.232}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 56); loc_end = (52, 60); + loc_bchar = 1040; loc_echar = 1044}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 61); loc_end = (52, 62); + loc_bchar = 1045; loc_echar = 1046}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 18; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (54, 2); loc_end = (54, 13); loc_bchar = 1060; + loc_echar = 1071}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (54, 2); loc_end = (54, 5); loc_bchar = 1060; + loc_echar = 1063}}, + Jasmin.Expr.AT_none, + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = pres.229}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (54, 8); loc_end = (54, 12); loc_bchar = 1066; + loc_echar = 1070}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 19; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 2); loc_end = (55, 30); loc_bchar = 1074; + loc_echar = 1102}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 2); loc_end = (55, 5); loc_bchar = 1074; + loc_echar = 1077}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = rest.232}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 19); loc_end = (55, 23); loc_bchar = 1091; + loc_echar = 1095}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 25); loc_end = (55, 28); loc_bchar = 1097; + loc_echar = 1100}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (57, 9); loc_end = (57, 12); loc_bchar = 1113; + loc_echar = 1116}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m.233}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.234}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 13; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (32, 2); loc_end = (37, 3); loc_bchar = 580; + loc_echar = 673}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.235}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (32, 6); loc_end = (32, 7); loc_bchar = 584; + loc_echar = 585}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 12; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (33, 4); loc_end = (36, 5); loc_bchar = 601; + loc_echar = 669}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = j.236}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (33, 8); loc_end = (33, 9); loc_bchar = 605; + loc_echar = 606}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 10; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 6); loc_end = (34, 21); + loc_bchar = 624; loc_echar = 639}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.237}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 6); loc_end = (34, 9); + loc_bchar = 624; loc_echar = 627}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m.233}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 12); loc_end = (34, 13); + loc_bchar = 630; loc_echar = 631}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = j.236}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 14); loc_end = (34, 15); + loc_bchar = 632; loc_echar = 633}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.235}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 16); loc_end = (34, 17); + loc_bchar = 634; loc_echar = 635}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 11; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 6); loc_end = (35, 23); + loc_bchar = 646; loc_echar = 663}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, + Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.234}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 6); loc_end = (35, 9); + loc_bchar = 646; loc_echar = 649}}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.235}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 10); loc_end = (35, 11); + loc_bchar = 650; loc_echar = 651}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = j.236}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 12); loc_end = (35, 13); + loc_bchar = 652; loc_echar = 653}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.237}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 19); loc_end = (35, 22); + loc_bchar = 659; loc_echar = 662}}; + gs = Jasmin.Expr.Slocal}))]))]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.234}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (39, 9); loc_end = (39, 12); loc_bchar = 684; + loc_echar = 687}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m.238}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v.239}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = res.240}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 9; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (21, 2); loc_end = (24, 3); loc_bchar = 373; + loc_echar = 447}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.241}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (21, 6); loc_end = (21, 7); loc_bchar = 377; + loc_echar = 378}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 7; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 4); loc_end = (22, 35); loc_bchar = 394; + loc_echar = 425}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.242}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 4); loc_end = (22, 7); loc_bchar = 394; + loc_echar = 397}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + [Jasmin.Expr.Psub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m.238}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 22); loc_end = (22, 23); + loc_bchar = 412; loc_echar = 413}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.241}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 24); loc_end = (22, 25); + loc_bchar = 414; loc_echar = 415}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v.239}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 32); loc_end = (22, 33); + loc_bchar = 422; loc_echar = 423}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 8; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 4); loc_end = (23, 17); loc_bchar = 430; + loc_echar = 443}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = res.240}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 4); loc_end = (23, 7); loc_bchar = 430; + loc_echar = 433}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.241}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 8); loc_end = (23, 9); + loc_bchar = 434; loc_echar = 435}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.242}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 13); loc_end = (23, 16); + loc_bchar = 439; loc_echar = 442}}; + gs = Jasmin.Expr.Slocal}))]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = res.240}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (25, 9); loc_end = (25, 12); loc_bchar = 457; + loc_echar = 460}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v1.243}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v2.244}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (8, 2); loc_end = (8, 10); loc_bchar = 135; + loc_echar = 143}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (8, 2); loc_end = (8, 5); loc_bchar = 135; + loc_echar = 138}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 6; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (9, 2); loc_end = (13, 3); loc_bchar = 146; + loc_echar = 217}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.246}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (9, 6); loc_end = (9, 7); loc_bchar = 150; + loc_echar = 151}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 4); loc_end = (10, 16); loc_bchar = 167; + loc_echar = 179}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 4); loc_end = (10, 7); loc_bchar = 167; + loc_echar = 170}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v1.243}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 10); loc_end = (10, 12); + loc_bchar = 173; loc_echar = 175}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.246}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 13); loc_end = (10, 14); + loc_bchar = 176; loc_echar = 177}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 4); loc_end = (11, 17); loc_bchar = 184; + loc_echar = 197}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 4); loc_end = (11, 7); loc_bchar = 184; + loc_echar = 187}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Omul (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 4); loc_end = (11, 7); loc_bchar = 184; + loc_echar = 187}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v2.244}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 11); loc_end = (11, 13); + loc_bchar = 191; loc_echar = 193}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.246}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 14); loc_end = (11, 15); + loc_bchar = 194; loc_echar = 195}}; + gs = Jasmin.Expr.Slocal})))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 4); loc_end = (12, 15); loc_bchar = 202; + loc_echar = 213}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 4); loc_end = (12, 7); loc_bchar = 202; + loc_echar = 205}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 4); loc_end = (12, 7); loc_bchar = 202; + loc_echar = 205}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 11); loc_end = (12, 14); + loc_bchar = 209; loc_echar = 212}}; + gs = Jasmin.Expr.Slocal})))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (14, 9); loc_end = (14, 12); loc_bchar = 227; + loc_echar = 230}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/matrix_product.jazz b/theories/Jasmin/examples/matrix_product.jazz new file mode 100644 index 00000000..bcf43377 --- /dev/null +++ b/theories/Jasmin/examples/matrix_product.jazz @@ -0,0 +1,79 @@ +param int N = 10; + +fn dot_product (reg ptr u64[N] v1, reg ptr u64[N] v2) -> reg u64 { + reg u64 res; + reg u64 tmp; + inline int i; + + res = 0; + for i = 0 to N { + tmp = v1[i]; + tmp *= v2[i]; + res += tmp; + } + return res; +} + +fn product_matrix_vector (reg ptr u64[N*N] m, reg ptr u64[N] v, reg ptr u64[N] res) -> reg ptr u64[N] { + reg u64 tmp; + inline int i; + + for i = 0 to N { + tmp = dot_product(m[i*N:N], v); + res[i] = tmp; + } + return res; +} + +fn transpose (reg ptr u64[N*N] m, reg ptr u64[N*N] res) -> reg ptr u64[N*N] { + inline int i, j; + reg u64 tmp; + + for i = 0 to N { + for j = 0 to N { + tmp = m[j+i*N]; + res[i+j*N] = tmp; + } + } + + return res; +} + +// m2 and res are transposed +fn product_matrix_matrix (reg ptr u64[N*N] m1, reg ptr u64[N*N] m2, reg ptr u64[N*N] res) -> reg ptr u64[N*N] { + inline int i; + stack u64[N*N] m2t; + stack u64[N*N] rest; + reg ptr u64[N * N] pres; + + pres = res; + m2t = transpose (m2, m2t); + for i = 0 to N { + rest[i*N:N] = product_matrix_vector(m1, m2t[i*N:N], rest[i*N:N]); + } + res = pres; + res = transpose (rest, res); + + return res; +} + +/* Multiplies row-major matrices in memory at adresses x and y and writes the result at adress z. + Regions may overlap. +*/ +export +fn productMM(reg u64 x y z) { + inline int i; + stack u64[N * N] mx my mz; + reg u64 tmp; + for i = 0 to N * N { + tmp = (u64)[x + 8 * i]; + mx[i] = tmp; + tmp = (u64)[y + 8 * i]; + my[i] = tmp; + } + mz = product_matrix_matrix(mx, my, mz); + for i = 0 to N * N { + tmp = mz[i]; + (u64)[z + 8 * i] = tmp; + } +} diff --git a/theories/Jasmin/examples/matrix_product.v b/theories/Jasmin/examples/matrix_product.v new file mode 100644 index 00000000..e8fab0bc --- /dev/null +++ b/theories/Jasmin/examples/matrix_product.v @@ -0,0 +1,647 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* productMM *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.216" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.217" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "z.218" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO (xI (xO xH))))) + (Pconst (Zpos (xO (xI (xO xH))))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "x.216" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mx.221" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "y.217" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "my.222" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mz.223" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mx.221" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "my.222" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mz.223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO (xI (xO xH))))) + (Pconst (Zpos (xO (xI (xO xH))))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mz.223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "z.218" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* product_matrix_matrix *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_params := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m1.224" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2.225" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "pres.227" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2t.228" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2.225" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2t.228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall DoNotInline + [Lasub AAscale U64 (xO (xI (xO xH))) + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "rest.230" |} + ; v_info := dummy_var_info |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH))))))] + (xO (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m1.224" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Psub AAscale U64 (xO (xI (xO xH))) + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2t.228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH))))))); + (Psub AAscale U64 (xO (xI (xO xH))) + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "rest.230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "pres.227" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "rest.230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_res := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* transpose *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_params := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.231" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.232" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.233" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "j.234" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.235" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.231" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.234" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.233" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.232" |} + ; v_info := dummy_var_info |} + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.233" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.234" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.235" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_res := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.232" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* product_matrix_vector *) xO (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xI (xO xH))))))); + (sarr (xO (xO (xO (xO (xI (xO xH)))))))] + ; f_params := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.236" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v.237" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "res.238" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.239" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.240" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Psub AAscale U64 (xO (xI (xO xH))) + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.236" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.239" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH))))))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v.237" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "res.238" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.239" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.240" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xO xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "res.238" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* dot_product *) xI (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xO xH))))))); + (sarr (xO (xO (xO (xO (xI (xO xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v1.241" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v2.242" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.244" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v1.241" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.244" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Omul (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v2.242" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.244" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation PRODUCTMM := ( xH ). +Notation PRODUCT_MATRIX_MATRIX := ( xO xH ). +Notation TRANSPOSE := ( xI xH ). +Notation PRODUCT_MATRIX_VECTOR := ( xO (xO xH) ). +Notation DOT_PRODUCT := ( xI (xO xH) ). \ No newline at end of file diff --git a/theories/Jasmin/examples/print_vname.ml b/theories/Jasmin/examples/print_vname.ml new file mode 100644 index 00000000..7e97deef --- /dev/null +++ b/theories/Jasmin/examples/print_vname.ml @@ -0,0 +1,5 @@ +open Format + +let print_vname (fmt : formatter) (t : Obj.t) = + let t = Obj.magic t in + ignore (List.map (pp_print_char fmt) t) diff --git a/theories/Jasmin/examples/retz.cprog b/theories/Jasmin/examples/retz.cprog new file mode 100644 index 00000000..e9030039 --- /dev/null +++ b/theories/Jasmin/examples/retz.cprog @@ -0,0 +1,34 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "retz.jazz"; loc_start = (4, 0); + loc_end = (4, 6); loc_bchar = 41; loc_echar = 47}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.139}; + v_info = + {Jasmin.Location.loc_fname = "retz.jazz"; loc_start = (4, 0); + loc_end = (4, 1); loc_bchar = 41; loc_echar = 42}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0)))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.139}; + v_info = + {Jasmin.Location.loc_fname = "retz.jazz"; loc_start = (5, 7); + loc_end = (5, 8); loc_bchar = 55; loc_echar = 56}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/retz.jazz b/theories/Jasmin/examples/retz.jazz new file mode 100644 index 00000000..ccfb944e --- /dev/null +++ b/theories/Jasmin/examples/retz.jazz @@ -0,0 +1,6 @@ +export +fn zero() -> reg u64 { +reg u64 z; +z = 0; +return z; +} diff --git a/theories/Jasmin/examples/retz.v b/theories/Jasmin/examples/retz.v new file mode 100644 index 00000000..e422bef2 --- /dev/null +++ b/theories/Jasmin/examples/retz.v @@ -0,0 +1,48 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* zero *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.137" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "z.137" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ZERO := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/sike434/sike434.v b/theories/Jasmin/examples/sike434/sike434.v new file mode 100644 index 00000000..2350a6ac --- /dev/null +++ b/theories/Jasmin/examples/sike434/sike434.v @@ -0,0 +1,7006 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* __bn_load *) xI (xO xH), + {| f_info := xO (xI (xI (xO (xI (xI xH))))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1377" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1379" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1380" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1377" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1379" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1378" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1379" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1380" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1378" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_store *) xI xH, + {| f_info := xI (xO (xI (xO (xI (xI xH))))) + ; f_tyin := [(sword U64); (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1373" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1374" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1375" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1376" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1374" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1375" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1373" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1375" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1376" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* _bn2_load_ *) xI (xI (xO (xO (xI (xI xH))))), + {| f_info := xO (xO (xI (xO (xI (xI xH))))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1369" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1371" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1372" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1369" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1371" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "x.1370" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1371" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1372" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "x.1370" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn2_store *) xI (xO (xI (xI xH))), + {| f_info := xO (xI (xO (xO (xI (xI xH))))) + ; f_tyin := [(sword U64); (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1365" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "b.1366" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1367" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1368" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "b.1366" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1367" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1365" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1367" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1368" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* __bn2_unpack *) xO (xO (xO (xO (xI (xI xH))))), + {| f_info := xI (xO (xO (xO (xI (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1359" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1363" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1359" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t2.1364" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1359" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Oadd Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1361" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1363" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1360" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t2.1364" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1360" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1361" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_pack2 *) xO (xI (xI (xI (xO (xI xH))))), + {| f_info := xI (xI (xI (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1354" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1355" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1354" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1356" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1355" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1356" |} + ; v_info := dummy_var_info |} + (Papp2 (Oadd Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1356" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_eq *) xO (xO (xI (xI (xO (xI xH))))), + {| f_info := xI (xO (xI (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1346" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1347" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "are_equal.1349" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1351" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1351" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olxor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1347" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1351" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))]); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lvar + {| v_var := {| vtype := sbool + ; vname := "zf.1353" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info (sword U64)] + AT_keep (Oasm (* AND_64 *) (BaseOp (None, (AND U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "zf.1353" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "are_equal.1349" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_eq *) xO (xI (xO (xI (xO (xI xH))))), + {| f_info := xI (xI (xO (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1343" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1344" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1345" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xI (xO (xI xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1344" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1345" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_eq_ *) xI (xO (xO (xO (xI xH)))), + {| f_info := xI (xO (xO (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1338" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1339" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1341" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1338" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1342" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1339" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xI (xO (xI xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1341" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1342" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_test0 *) xO (xI (xI (xI (xO xH)))), + {| f_info := xO (xO (xO (xI (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1332" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "is_zero.1334" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1336" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1336" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))]); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lvar + {| v_var := {| vtype := sbool + ; vname := "zf.1337" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info (sword U64)] + AT_keep (Oasm (* AND_64 *) (BaseOp (None, (AND U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "zf.1337" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "is_zero.1334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_test0 *) xO (xI (xI (xO (xO (xI xH))))), + {| f_info := xI (xI (xI (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1330" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1331" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1330" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1331" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_copy *) xI (xI (xO (xI (xO (xO xH))))), + {| f_info := xI (xO (xI (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1326" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1328" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1329" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1326" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1328" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1327" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1328" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1327" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_copy2 *) xI (xO (xO (xI (xI xH)))), + {| f_info := xO (xO (xI (xO (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1322" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1323" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1324" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1325" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1322" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1324" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1323" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1324" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1323" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_cmov *) xO (xI (xO (xI (xO (xO xH))))), + {| f_info := xI (xI (xO (xO (xO (xI xH))))) + ; f_tyin := + [sbool; (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := {| vtype := sbool + ; vname := "cond.1317" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1319" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cond.1317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_set0 *) xI (xO (xO (xO (xO (xI xH))))), + {| f_info := xO (xI (xO (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1314" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1315" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1316" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1314" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1316" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1315" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1314" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_add1c *) xI (xI (xI (xI (xI (xO xH))))), + {| f_info := xO (xO (xO (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH)))))); (sword U64)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "b.1311" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b.1311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1313" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})); + (Papp1 (Oword_of_int U64) (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_addc *) xI (xI (xI (xO (xO xH)))), + {| f_info := xO (xI (xI (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1306" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_addc *) xO (xO (xI (xI (xI (xO xH))))), + {| f_info := xI (xO (xI (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1303" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1304" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1304" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_subc *) xO (xO (xI (xO (xO xH)))), + {| f_info := xI (xI (xO (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1298" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Osubcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep (Osubcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_subc *) xI (xO (xO (xI (xI (xO xH))))), + {| f_info := xO (xI (xO (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1295" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1296" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1295" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1296" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __addacc3 *) xO (xO (xO (xO (xO (xO xH))))), + {| f_info := xO (xO (xO (xI (xI (xO xH))))) + ; f_tyin := + [(sword U64); (sword U64); (sarr (xO (xO (xO (xI xH))))); sint] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "b1.1289" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "b0.1290" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1290" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1289" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))); + (Papp1 (Oword_of_int U64) (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __muln_innerloop *) xI (xO (xO (xO (xO (xO xH))))), + {| f_info := xI (xI (xI (xO (xI (xO xH))))) + ; f_tyin := + [sint; sint; sint; (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI xH)))))] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "k.1279" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "istart.1280" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "iend.1281" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1282" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1283" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1285" |} + ; v_info := dummy_var_info |}) + ((UpTo, + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "istart.1280" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})), + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "iend.1281" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "j.1286" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1279" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1285" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1282" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1285" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1288" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1283" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.1286" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1288" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1279" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_muln *) xI (xO (xO (xO (xO xH)))), + {| f_info := xO (xI (xI (xO (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1276" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xH)))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1276" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xO xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pconst (Z0)); + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xI (xI xH))))), + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp2 (Oadd Op_int) + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))); + (Pconst (Zpos (xI (xI xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))))) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_muln *) xO (xO (xI (xO (xI (xO xH))))), + {| f_info := xI (xO (xI (xO (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1269" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1270" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1269" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1270" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __addacc3x2 *) xO (xI (xO (xO (xI (xO xH))))), + {| f_info := xI (xI (xO (xO (xI (xO xH))))) + ; f_tyin := + [(sword U64); (sword U64); (sarr (xO (xO (xO (xI xH))))); sint] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.1260" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.1261" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.1260" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.1261" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1266" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olsl (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U8) (Pconst (Zpos (xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* SHLD_64 *) (BaseOp (None, (SHLD U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1266" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) (Pconst (Zpos (xH))))]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* MOV_64 *) (BaseOp (None, (MOV U64)))) + [(Papp1 (Oword_of_int U64) (Pconst (Z0)))]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __sqrn_innerloop *) xO (xO (xO (xO (xI (xO xH))))), + {| f_info := xI (xO (xO (xO (xI (xO xH))))) + ; f_tyin := + [sint; sint; sint; (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI xH)))))] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "k.1251" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "istart.1252" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "iend.1253" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1254" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1256" |} + ; v_info := dummy_var_info |}) + ((UpTo, + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "istart.1252" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})), + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "iend.1253" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "j.1257" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1251" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1256" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "ti.1258" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1254" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1256" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tj.1259" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1254" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.1257" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xO (xI (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ti.1258" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tj.1259" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1251" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_sqrn *) xO (xI (xI (xI xH))), + {| f_info := xI (xI (xI (xI (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xH)))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xO xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xI (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pconst (Z0)); + (Papp2 (Odiv Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xO xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oeq Op_int) + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Z0))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Odiv Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH))))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xI (xI xH))))), + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xI (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp2 (Oadd Op_int) + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))); + (Papp2 (Odiv Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xO xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oeq Op_int) + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Z0))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Odiv Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH))))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))))) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_sqrn *) xI (xO (xI (xI (xO (xO xH))))), + {| f_info := xO (xI (xI (xI (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1243" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1243" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_caddP *) xI (xO (xI (xO (xO (xO xH))))), + {| f_info := xO (xO (xI (xI (xO (xO xH))))) + ; f_tyin := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := {| vtype := sbool + ; vname := "cf.1235" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1237" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xI (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1237" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1239" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1240" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1240" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Papp1 Onot + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1235" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1239" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1240" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1242" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1242" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_cminusP *) xI (xI (xI (xI (xI xH)))), + {| f_info := xI (xO (xO (xI (xO (xO xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1231" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xI (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1231" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mpp.1233" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mp.1069" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "_cf.1234" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mpp.1233" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xI (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "_cf.1234" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_add *) xI (xI (xI (xO (xO (xO xH))))), + {| f_info := xO (xO (xO (xI (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1229" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_add *) xO (xI (xO (xI xH))), + {| f_info := xO (xI (xI (xO (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1227" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1227" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_sub *) xI (xI (xO (xO (xO (xO xH))))), + {| f_info := xO (xO (xI (xO (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1224" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1225" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1224" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1225" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_sub *) xI (xI (xI (xO xH))), + {| f_info := xO (xI (xO (xO (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1222" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1222" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_rdcn *) xI (xO (xI (xO (xI xH)))), + {| f_info := xO (xI (xI (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI xH))))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "zero.1213" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "u0r.1214" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "glob_u0.1067" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "p0.1215" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xO xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pconst (Z0)); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "zero.1213" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info (sword U64); + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "u0r.1214" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1220" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "p0.1215" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xI (xI xH))))), + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp2 (Oadd Op_int) + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))); + (Pconst (Zpos (xI (xI xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "zero.1213" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH)))))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + [])]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pconst (Zpos (xH))))) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_mul *) xO (xO (xI (xO xH))), + {| f_info := xI (xO (xI (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1206" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1207" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1209" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1206" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1207" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_mulU *) xI (xI (xO (xO (xI xH)))), + {| f_info := xO (xO (xI (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1203" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1204" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1203" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_sqr *) xI (xO (xO (xO xH))), + {| f_info := xI (xI (xO (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1198" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1200" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1198" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_sqrU *) xO (xO (xO (xI (xI xH)))), + {| f_info := xO (xI (xO (xI (xI xH)))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1196" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_exp *) xO (xI (xI xH)), + {| f_info := xI (xI (xI (xO (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1181" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1182" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneMp.1186" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneM.1066" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1181" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneMp.1186" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "bb.1187" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1182" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "j.1190" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1189" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "bb.1187" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1191" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1189" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.1190" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Pconst (Zpos (xO (xO (xO (xO (xO (xO xH))))))))))); + MkI InstrInfo.witness + (Cwhile NoAlign [] + ((Papp2 (Oneq (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Z0))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "ss.1193" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1194" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1191" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* SHR_64 *) (BaseOp (None, (SHR U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1191" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) (Pconst (Zpos (xH))))]); + MkI InstrInfo.witness + (Cif + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1194" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))] + []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ss.1193" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Osub (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) + (Pconst (Zpos (xH)))))))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_inv *) xI (xI (xO xH)), + {| f_info := xO (xI (xI (xO (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1178" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2p.1180" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2.1068" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1178" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2p.1180" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_fromM *) xO (xO xH), + {| f_info := xO (xO (xI (xO (xI xH)))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1175" |} + ; v_info := dummy_var_info |} + (Papp2 (Oadd Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0)))))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1176" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1175" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1176" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1177" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1175" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1177" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_toM *) xO (xO (xO xH)), + {| f_info := xO (xI (xO (xO (xI xH)))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rMp.1172" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rM.1065" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rMp.1172" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* bn_eq *) xI (xI (xI (xI (xO xH)))), + {| f_info := xO (xO (xO (xO (xI xH)))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "ap.1164" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1165" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1167" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1164" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1168" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1167" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1169" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1165" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1170" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1169" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1166" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1168" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1170" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1166" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* bn_test0 *) xO (xO (xI (xI (xO xH)))), + {| f_info := xI (xO (xI (xI (xO xH)))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "ap.1160" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1162" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1160" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1163" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1162" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1163" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* bn_copy *) xO (xI (xO (xI (xO xH)))), + {| f_info := xI (xI (xO (xI (xO xH)))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1156" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1157" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1158" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1159" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1157" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1158" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1156" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1158" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1159" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_set0 *) xO (xO (xO (xI (xO xH)))), + {| f_info := xI (xO (xO (xI (xO xH)))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1154" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1155" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1154" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0)))))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_addn *) xI (xO (xI (xO (xO xH)))), + {| f_info := xO (xI (xI (xO (xO xH)))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1147" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1148" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1149" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1150" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1148" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1152" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1153" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1147" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_subn *) xO (xI (xO (xO (xO xH)))), + {| f_info := xI (xI (xO (xO (xO xH)))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1140" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1141" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1142" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1143" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1141" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1145" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1146" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1145" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1146" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1140" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_muln *) xI (xI (xI (xI xH))), + {| f_info := xO (xO (xO (xO (xO xH)))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1131" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1132" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1133" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1134" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1132" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1135" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1134" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1136" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1133" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1137" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1136" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_r.1138" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1135" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1137" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI (xO (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1131" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_sqrn *) xI (xI (xO (xI xH))), + {| f_info := xO (xO (xI (xI xH))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1125" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1126" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1127" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1126" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1128" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1127" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_r.1129" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1128" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI (xO (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1125" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_add *) xO (xO (xO (xI xH))), + {| f_info := xI (xO (xO (xI xH))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1118" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1119" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1120" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1121" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1119" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1121" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1123" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1120" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1124" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1123" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1124" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1118" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_sub *) xI (xO (xI (xO xH))), + {| f_info := xO (xI (xI (xO xH))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1111" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1112" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1113" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1114" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1112" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1114" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1116" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1113" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1117" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1116" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1117" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1111" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_mul *) xO (xI (xO (xO xH))), + {| f_info := xI (xI (xO (xO xH))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1102" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1103" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1104" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1105" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1103" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1106" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1105" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1107" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1104" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1108" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1107" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1109" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1106" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1108" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1102" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_sqr *) xI (xI (xI xH)), + {| f_info := xO (xO (xO (xO xH))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1096" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1097" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1098" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1097" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1099" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1098" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1100" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1099" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1096" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_expm_noct *) xO (xO (xI xH)), + {| f_info := xI (xO (xI xH)) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1087" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1088" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1089" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1090" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1087" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1091" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1090" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1092" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1088" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1093" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1092" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1094" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1091" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1093" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1089" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_inv *) xI (xO (xO xH)), + {| f_info := xO (xI (xO xH)) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1080" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1081" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1082" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1080" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1083" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1082" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1084" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1083" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1081" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_toM *) xO (xI xH), + {| f_info := xI (xI xH) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1075" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1076" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1077" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1076" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1077" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1075" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_fromM *) xH, + {| f_info := xO xH + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1071" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1072" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1073" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1072" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1073" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |}] + (xO (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1071" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) ] ; + p_globs := [({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rM.1065" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneM.1066" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sword U64) + ; vname := "glob_u0.1067" |}, + (@Gword U64 (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2.1068" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mp.1069" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _))] ; + p_extra := tt |}. + + set rMZ := [48 ; 155 ; 214 ; 220 ; 101 ; 91 ; 229 ; 40 ; 194 ; 152 ; 135 ; 118 ; 103 ; 115 ; 236 ; 172 ; 141 ; 104 ; 17 ; 131 ; 63 ; 151 ; 39 ; 171 ; 11 ; 124 ; 108 ; 141 ; 175 ; 198 ; 92 ; 23 ; 126 ; 52 ; 222 ; 45 ; 191 ; 146 ; 205 ; 171 ; 154 ; 109 ; 104 ; 199 ; 97 ; 106 ; 225 ; 105 ; 42 ; 209 ; 205 ; 155 ; 168 ; 37 ; 0 ; 0]%Z. + set rM := WArray.fill 56 [seq word.mkword U8 i | i <- rMZ]. + destruct rM as [rM|]; [ exact rM | exact (WArray.empty 56) ]. + + set oneMZ := [44 ; 116 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 252 ; 4 ; 244 ; 15 ; 185 ; 212 ; 172 ; 159 ; 85 ; 251 ; 164 ; 1 ; 216 ; 12 ; 65 ; 119 ; 95 ; 84 ; 84 ; 50 ; 233 ; 218 ; 46 ; 189 ; 167 ; 238 ; 236 ; 0 ; 0]%Z. + set oneM := WArray.fill 56 [seq word.mkword U8 i | i <- oneMZ]. + destruct oneM as [oneM|]; [ exact oneM | exact (WArray.empty 56) ]. + + set u0 := (word.mkword U64 1 : u64). + exact u0. + + set pm2Z := [253 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 226 ; 122 ; 118 ; 193 ; 253 ; 163 ; 174 ; 88 ; 49 ; 120 ; 92 ; 198 ; 123 ; 86 ; 32 ; 197 ; 129 ; 214 ; 95 ; 252 ; 108 ; 68 ; 115 ; 23 ; 39 ; 31 ; 52 ; 2 ; 0]%Z. + set pm2 := WArray.fill 56 [seq word.mkword U8 i | i <- pm2Z]. + destruct pm2 as [pm2|]; [ exact pm2 | exact (WArray.empty 56) ]. + + set mpZ := [ (Zpos 1) (* FIXME: 1 *) ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 29 ; 133 ; 137 ; 62 ; 2 ; 92 ; 81 ; 167 ; 206 ; 135 ; 163 ; 57 ; 132 ; 169 ; 223 ; 58 ; 126 ; 41 ; 160 ; 3 ; 147 ; 187 ; 140 ; 232 ; 216 ; 224 ; 203 ; 253 ; 255]%Z. + set mp := WArray.fill 56 [seq word.mkword U8 i | i <- mpZ]. + destruct mp as [mp|]; [ exact mp | exact (WArray.empty 56) ]. + + + set pZ := [255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 226 ; 122 ; 118 ; 193 ; 253 ; 163 ; 174 ; 88 ; 49 ; 120 ; 92 ; 198 ; 123 ; 86 ; 32 ; 197 ; 129 ; 214 ; 95 ; 252 ; 108 ; 68 ; 115 ; 23 ; 39 ; 31 ; 52 ; 2 ; 0]%Z. + set p := WArray.fill 56 [seq word.mkword U8 i | i <- pZ]. + destruct p as [p|]; [ exact p | exact (WArray.empty 56) ]. +Defined. diff --git a/theories/Jasmin/examples/test_for.cprog b/theories/Jasmin/examples/test_for.cprog new file mode 100644 index 00000000..63ac79cb --- /dev/null +++ b/theories/Jasmin/examples/test_for.cprog @@ -0,0 +1,90 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (5, 0); loc_end = (5, 6); loc_bchar = 52; + loc_echar = 58}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (5, 0); loc_end = (5, 1); loc_bchar = 52; + loc_echar = 53}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (6, 0); loc_end = (8, 1); loc_bchar = 59; + loc_echar = 89}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.142}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (6, 4); loc_end = (6, 5); loc_bchar = 63; + loc_echar = 64}}, + ((Jasmin.Expr.DownTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (7, 0); loc_end = (7, 7); loc_bchar = 80; + loc_echar = 87}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (7, 0); loc_end = (7, 1); loc_bchar = 80; + loc_echar = 81}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (7, 0); loc_end = (7, 1); loc_bchar = 80; + loc_echar = 81}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; loc_start = (9, 7); + loc_end = (9, 8); loc_bchar = 97; loc_echar = 98}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/test_for.jazz b/theories/Jasmin/examples/test_for.jazz new file mode 100644 index 00000000..6ab80164 --- /dev/null +++ b/theories/Jasmin/examples/test_for.jazz @@ -0,0 +1,10 @@ +export +fn f() -> reg u64 { +reg u64 r; +inline int i; +r = 0; +for i = 3 downto 0 { +r += 1; +} +return r; +} diff --git a/theories/Jasmin/examples/test_for.v b/theories/Jasmin/examples/test_for.v new file mode 100644 index 00000000..aac4b5ae --- /dev/null +++ b/theories/Jasmin/examples/test_for.v @@ -0,0 +1,69 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.140" |} + ; v_info := dummy_var_info |}) + ((DownTo, (Pconst (Z0))), (Pconst (Zpos (xI xH)))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/test_inline_var.cprog b/theories/Jasmin/examples/test_inline_var.cprog new file mode 100644 index 00000000..8e149b9d --- /dev/null +++ b/theories/Jasmin/examples/test_inline_var.cprog @@ -0,0 +1,286 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r1.150}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (10, 0); loc_end = (10, 7); loc_bchar = 149; + loc_echar = 156}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (10, 0); loc_end = (10, 1); loc_bchar = 149; + loc_echar = 150}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r1.150}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (10, 4); loc_end = (10, 6); loc_bchar = 153; + loc_echar = 155}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (11, 0); loc_end = (11, 16); loc_bchar = 157; + loc_echar = 173}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (11, 0); loc_end = (11, 1); loc_bchar = 157; + loc_echar = 158}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (11, 10); loc_end = (11, 11); loc_bchar = 167; + loc_echar = 168}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 6; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (12, 0); loc_end = (12, 16); loc_bchar = 174; + loc_echar = 190}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (12, 0); loc_end = (12, 1); loc_bchar = 174; + loc_echar = 175}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (12, 10); loc_end = (12, 11); loc_bchar = 184; + loc_echar = 185}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 7; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (13, 0); loc_end = (13, 16); loc_bchar = 191; + loc_echar = 207}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (13, 0); loc_end = (13, 1); loc_bchar = 191; + loc_echar = 192}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (13, 10); loc_end = (13, 11); loc_bchar = 201; + loc_echar = 202}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (14, 7); loc_end = (14, 8); loc_bchar = 215; + loc_echar = 216}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 2); loc_end = (3, 12); loc_bchar = 56; + loc_echar = 66}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 2); loc_end = (3, 3); loc_bchar = 56; + loc_echar = 57}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 6); loc_end = (3, 7); loc_bchar = 60; + loc_echar = 61}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 10); loc_end = (3, 11); loc_bchar = 64; + loc_echar = 65}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 2); loc_end = (4, 18); loc_bchar = 69; + loc_echar = 85}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 2); loc_end = (4, 3); loc_bchar = 69; + loc_echar = 70}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 6); loc_end = (4, 7); loc_bchar = 73; + loc_echar = 74}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 11); loc_end = (4, 12); loc_bchar = 78; + loc_echar = 79}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 15); loc_end = (4, 16); loc_bchar = 82; + loc_echar = 83}}; + gs = Jasmin.Expr.Slocal}))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (5, 9); loc_end = (5, 10); loc_bchar = 95; + loc_echar = 96}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/test_inline_var.jazz b/theories/Jasmin/examples/test_inline_var.jazz new file mode 100644 index 00000000..c07f94b8 --- /dev/null +++ b/theories/Jasmin/examples/test_inline_var.jazz @@ -0,0 +1,15 @@ +inline +fn addn (reg u64 r, inline u64 n) -> reg u64 { + r = r + n; + r = r + (n + n); + return r; +} + +export fn f(reg u64 r1) -> reg u64 { +reg u64 r; +r = r1; +r = addn(r, 6); +r = addn(r, 3); +r = addn(r, 5); +return r; +} diff --git a/theories/Jasmin/examples/test_inline_var.v b/theories/Jasmin/examples/test_inline_var.v new file mode 100644 index 00000000..aae81844 --- /dev/null +++ b/theories/Jasmin/examples/test_inline_var.v @@ -0,0 +1,155 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "r1.148" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r1.148" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xO (xI xH)))))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xI xH))))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xI (xO xH)))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* addn *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation ADDN := ( xO xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/test_shift.cprog b/theories/Jasmin/examples/test_shift.cprog new file mode 100644 index 00000000..d9e8c511 --- /dev/null +++ b/theories/Jasmin/examples/test_shift.cprog @@ -0,0 +1,53 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = a.142}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "test_shift.jazz"; + loc_start = (6, 2); loc_end = (6, 23); loc_bchar = 78; + loc_echar = 99}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = u.143}; + v_info = + {Jasmin.Location.loc_fname = "test_shift.jazz"; + loc_start = (6, 2); loc_end = (6, 3); loc_bchar = 78; + loc_echar = 79}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Osub Jasmin.Expr.Op_int, + Jasmin.Expr.Papp2 (Jasmin.Expr.Olsl Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))), + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = u.143}; + v_info = + {Jasmin.Location.loc_fname = "test_shift.jazz"; + loc_start = (7, 9); loc_end = (7, 10); loc_bchar = 109; + loc_echar = 110}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/test_shift.jazz b/theories/Jasmin/examples/test_shift.jazz new file mode 100644 index 00000000..8eb53c35 --- /dev/null +++ b/theories/Jasmin/examples/test_shift.jazz @@ -0,0 +1,9 @@ +param int rlog = 18; + +export fn reduce(reg u64 a) -> reg u64 +{ + reg u64 u; + u = (1 << rlog) - 1 ; + return u; +} + diff --git a/theories/Jasmin/examples/test_shift.v b/theories/Jasmin/examples/test_shift.v new file mode 100644 index 00000000..37274da0 --- /dev/null +++ b/theories/Jasmin/examples/test_shift.v @@ -0,0 +1,55 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* reduce *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.140" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "u.141" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Papp2 (Osub Op_int) + (Papp2 (Olsl Op_int) (Pconst (Zpos (xH))) + (Pconst (Zpos (xO (xI (xO (xO xH))))))) + (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "u.141" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation REDUCE := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/three_functions.cprog b/theories/Jasmin/examples/three_functions.cprog new file mode 100644 index 00000000..1c863b6a --- /dev/null +++ b/theories/Jasmin/examples/three_functions.cprog @@ -0,0 +1,202 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (15, 2); loc_end = (15, 10); loc_bchar = 212; + loc_echar = 220}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (15, 2); loc_end = (15, 3); loc_bchar = 212; + loc_echar = 213}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (15, 2); loc_end = (15, 3); loc_bchar = 212; + loc_echar = 213}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (16, 2); loc_end = (16, 15); loc_bchar = 223; + loc_echar = 236}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_z.160}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (16, 2); loc_end = (16, 7); loc_bchar = 223; + loc_echar = 228}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (16, 12); loc_end = (16, 13); loc_bchar = 233; + loc_echar = 234}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_z.160}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (17, 9); loc_end = (17, 14); loc_bchar = 246; + loc_echar = 251}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.161}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 15); loc_bchar = 130; + loc_echar = 143}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.162}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 7); loc_bchar = 130; + loc_echar = 135}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.161}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (9, 12); loc_end = (9, 13); loc_bchar = 140; + loc_echar = 141}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.162}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (10, 9); loc_end = (10, 14); loc_bchar = 153; + loc_echar = 158}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.163}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 14); loc_bchar = 49; + loc_echar = 61}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.164}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 7); loc_bchar = 49; + loc_echar = 54}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.163}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (3, 10); loc_end = (3, 11); loc_bchar = 57; + loc_echar = 58}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.164}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (4, 9); loc_end = (4, 14); loc_bchar = 71; + loc_echar = 76}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/three_functions.jazz b/theories/Jasmin/examples/three_functions.jazz new file mode 100644 index 00000000..f2fe9611 --- /dev/null +++ b/theories/Jasmin/examples/three_functions.jazz @@ -0,0 +1,18 @@ +fn f (reg u64 x) -> reg u64 { + reg u64 res_x; + res_x = x+1; + return res_x; +} + +fn g (reg u64 y) -> reg u64 { + reg u64 res_y; + res_y = f(y); + return res_y; +} + +fn h (reg u64 z) -> reg u64 { + reg u64 res_z; + z += 42; + res_z = g(z); + return res_z; +} diff --git a/theories/Jasmin/examples/three_functions.v b/theories/Jasmin/examples/three_functions.v new file mode 100644 index 00000000..9f665d5f --- /dev/null +++ b/theories/Jasmin/examples/three_functions.v @@ -0,0 +1,131 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* h *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) + (Pconst (Zpos (xO (xI (xO (xI (xO xH))))))))))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_z.158" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_z.158" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* g *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.159" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_y.160" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.159" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_y.160" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* f *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.161" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_x.162" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.161" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_x.162" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation H := ( xH ). +Notation G := ( xO xH ). +Notation F := ( xI xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/two_functions.cprog b/theories/Jasmin/examples/two_functions.cprog new file mode 100644 index 00000000..4188c0fc --- /dev/null +++ b/theories/Jasmin/examples/two_functions.cprog @@ -0,0 +1,109 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 15); loc_bchar = 130; + loc_echar = 143}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.151}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 7); loc_bchar = 130; + loc_echar = 135}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (9, 12); loc_end = (9, 13); loc_bchar = 140; + loc_echar = 141}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.151}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (10, 9); loc_end = (10, 14); loc_bchar = 153; + loc_echar = 158}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 14); loc_bchar = 49; + loc_echar = 61}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.153}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 7); loc_bchar = 49; + loc_echar = 54}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.152}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (3, 10); loc_end = (3, 11); loc_bchar = 57; + loc_echar = 58}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.153}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (4, 9); loc_end = (4, 14); loc_bchar = 71; + loc_echar = 76}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/two_functions.jazz b/theories/Jasmin/examples/two_functions.jazz new file mode 100644 index 00000000..52a08250 --- /dev/null +++ b/theories/Jasmin/examples/two_functions.jazz @@ -0,0 +1,11 @@ +fn f (reg u64 x) -> reg u64 { + reg u64 res_x; + res_x = x+1; + return res_x; +} + +fn g (reg u64 y) -> reg u64 { + reg u64 res_y; + res_y = f(y); + return res_y; +} \ No newline at end of file diff --git a/theories/Jasmin/examples/two_functions.v b/theories/Jasmin/examples/two_functions.v new file mode 100644 index 00000000..b5fe8c30 --- /dev/null +++ b/theories/Jasmin/examples/two_functions.v @@ -0,0 +1,87 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* g *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_y.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_y.149" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* f *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.150" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_x.151" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_x.151" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation G := ( xH ). +Notation F := ( xO xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/u64_incr.cprog b/theories/Jasmin/examples/u64_incr.cprog new file mode 100644 index 00000000..67d68965 --- /dev/null +++ b/theories/Jasmin/examples/u64_incr.cprog @@ -0,0 +1,93 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (9, 2); loc_end = (9, 14); loc_bchar = 128; + loc_echar = 140}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.148}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (9, 2); loc_end = (9, 3); loc_bchar = 128; + loc_echar = 129}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0)]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.148}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; loc_start = (10, 9); + loc_end = (10, 10); loc_bchar = 150; loc_echar = 151}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.149}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 13); loc_bchar = 56; + loc_echar = 66}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.150}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 56; + loc_echar = 57}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.149}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (3, 8); loc_end = (3, 9); loc_bchar = 61; + loc_echar = 62}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.150}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; loc_start = (4, 10); + loc_end = (4, 11); loc_bchar = 77; loc_echar = 78}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/u64_incr.jazz b/theories/Jasmin/examples/u64_incr.jazz new file mode 100644 index 00000000..2492336e --- /dev/null +++ b/theories/Jasmin/examples/u64_incr.jazz @@ -0,0 +1,11 @@ +inline fn incr(reg u64 n) -> reg u64 { + reg u64 m; + m = (n+2); + return m; + } + +export fn f() -> reg u64 { + reg u64 x; + x = incr(0); + return x; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/u64_incr.v b/theories/Jasmin/examples/u64_incr.v new file mode 100644 index 00000000..d0770d4a --- /dev/null +++ b/theories/Jasmin/examples/u64_incr.v @@ -0,0 +1,77 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "x.146" |} + ; v_info := dummy_var_info |}] + (xO xH) [(Papp1 (Oword_of_int U64) (Pconst (Z0)))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.146" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* incr *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.147" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "m.148" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.147" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xO xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "m.148" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation INCR := ( xO xH ). \ No newline at end of file diff --git a/theories/Jasmin/examples/xor.cprog b/theories/Jasmin/examples/xor.cprog new file mode 100644 index 00000000..b1351cdf --- /dev/null +++ b/theories/Jasmin/examples/xor.cprog @@ -0,0 +1,95 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.143}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.144}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (3, 2); + loc_end = (3, 8); loc_bchar = 64; loc_echar = 70}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (3, 2); + loc_end = (3, 3); loc_bchar = 64; loc_echar = 65}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.143}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (3, 6); + loc_end = (3, 7); loc_bchar = 68; loc_echar = 69}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 2); + loc_end = (4, 9); loc_bchar = 73; loc_echar = 80}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 2); + loc_end = (4, 3); loc_bchar = 73; loc_echar = 74}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Olxor Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 2); + loc_end = (4, 3); loc_bchar = 73; loc_echar = 74}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.144}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 7); + loc_end = (4, 8); loc_bchar = 78; loc_echar = 79}}; + gs = Jasmin.Expr.Slocal})))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (5, 9); + loc_end = (5, 10); loc_bchar = 90; loc_echar = 91}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/xor.jazz b/theories/Jasmin/examples/xor.jazz new file mode 100644 index 00000000..c7b9a8ce --- /dev/null +++ b/theories/Jasmin/examples/xor.jazz @@ -0,0 +1,6 @@ +export fn xor(reg u64 x, reg u64 y) -> reg u64 { + reg u64 r; + r = x; + r ^= y; + return r; +} diff --git a/theories/Jasmin/examples/xor.v b/theories/Jasmin/examples/xor.v new file mode 100644 index 00000000..1397e78b --- /dev/null +++ b/theories/Jasmin/examples/xor.v @@ -0,0 +1,76 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From JasminSSProve Require Import jasmin_translate. +From Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* xor *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.141" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.142" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.141" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olxor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation XOR := ( xH ). \ No newline at end of file diff --git a/theories/Jasmin/jasmin_asm.v b/theories/Jasmin/jasmin_asm.v new file mode 100644 index 00000000..5e318332 --- /dev/null +++ b/theories/Jasmin/jasmin_asm.v @@ -0,0 +1,79 @@ +(* From mathcomp Require Import all_ssreflect all_algebra. *) + +(* From Jasmin Require Import *) +(* arch_params_proof *) +(* compiler *) +(* compiler_proof. *) + +(* From Jasmin Require Import *) +(* arch_decl *) +(* arch_extra *) +(* arch_sem *) +(* asm_gen_proof. *) + +(* From Jasmin Require Import sem. *) + +(* From JasminSSProve Require Import jasmin_translate. *) +(* From Crypt Require Import Prelude Package. *) + +(* Import PackageNotation. *) +(* Import JasminNotation. *) +(* Import Utf8. *) + +(* Local Open Scope positive. *) + +(* Set Implicit Arguments. *) +(* Unset Strict Implicit. *) +(* Unset Printing Implicit Defensive. *) + +(* Section __. *) + +(* Context *) +(* {syscall_state : Type} {sc_sem : syscall.syscall_sem syscall_state} {gf : glob_decls} *) +(* `{asm_e : asm_extra} {call_conv : calling_convention} {asm_scsem : asm_syscall_sem} *) +(* {fresh_vars lowering_options : Type} *) +(* (aparams : architecture_params fresh_vars lowering_options) *) +(* (haparams : h_architecture_params aparams) *) +(* (cparams : compiler_params fresh_vars lowering_options). *) + +(* Hypothesis print_uprogP : forall s p, cparams.(print_uprog) s p = p. *) +(* Hypothesis print_sprogP : forall s p, cparams.(print_sprog) s p = p. *) +(* Hypothesis print_linearP : forall s p, cparams.(print_linear) s p = p. *) + +(* Context `(asm_correct : ∀ o, sem_correct (tin (get_instr_desc (Oasm o))) (sopn_sem (Oasm o))). *) + +(* Theorem equiv_to_asm subroutine p xp entries scs vm m fn scs' m' va vr xm m_id s_id s_st st : *) +(* compile_prog_to_asm aparams cparams entries subroutine p = ok xp *) +(* -> fn \in entries *) +(* -> sem.sem_call p scs m fn va scs' m' vr *) +(* -> handled_program p *) +(* -> mem_agreement m (asm_mem xm) (asm_rip xm) (asm_globs xp) *) +(* -> enough_stack_space xp fn (top_stack m) (asm_mem xm) *) +(* -> ⊢ ⦃ rel_estate (sem.Estate scs m vm) m_id s_id s_st st ⦄ *) +(* get_translated_fun p fn s_id~1 [seq totce (translate_value v) | v <- va] *) +(* ⇓ [seq totce (translate_value v) | v <- vr] *) +(* ⦃ rel_estate (sem.Estate scs' m' vm) m_id s_id~0 s_st st ⦄ *) +(* /\ exists xd : asm_fundef, *) +(* get_fundef (asm_funcs xp) fn = Some xd *) +(* /\ forall args', *) +(* asm_scs xm = scs *) +(* -> asm_reg xm ad_rsp = top_stack m *) +(* -> get_typed_reg_values xm (asm_fd_arg xd) = ok args' *) +(* -> List.Forall2 value_uincl va args' *) +(* -> exists xm' res', *) +(* get_typed_reg_values xm' (asm_fd_res xd) = ok res' *) +(* /\ List.Forall2 value_uincl vr res'. *) +(* Proof. *) +(* intros cmp fn_in sc hp mem ss. *) +(* split. *) +(* unshelve eapply translate_prog_correct; try eauto. *) +(* unshelve epose proof compile_prog_to_asmP haparams _ _ _ cmp fn_in sc mem ss as [xd [get_fd _ cmp_correct]]; eauto. *) +(* exists xd. split; eauto. *) +(* intros args'. *) +(* specialize (cmp_correct args'). *) +(* intros asm_scs asm_reg reg_args' args'_va. *) +(* specialize (cmp_correct asm_scs asm_reg reg_args' args'_va) as [xm' [res' []]]. *) +(* exists xm', res'; eauto. *) +(* Qed. *) + +(* End __. *) diff --git a/theories/Jasmin/jasmin_translate.v b/theories/Jasmin/jasmin_translate.v new file mode 100644 index 00000000..31567252 --- /dev/null +++ b/theories/Jasmin/jasmin_translate.v @@ -0,0 +1,5409 @@ +Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word word_ssrZ. +From Jasmin Require Import expr compiler_util values sem_params flag_combination sem_op_typed sopn low_memory psem_of_sem_proof varmap psem. +(* From Jasmin Require Import sem_one_varmap. *) +(* From Jasmin Require Import sem_one_varmap_facts. *) +(* From Jasmin Require Import sem_op_typed sem_params sem_params_of_arch_extra sem_type. *) +Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". + +From extructures Require Import ord fset fmap. +Set Warnings "-ambiguous-paths". +(* Silencing the following warning: *) +(* New coercion path [Pbool] : bool >-> pexpr is ambiguous with existing *) +(* [nat_of_bool; Posz; int_to_Z; Pconst] : bool >-> pexpr. *) +From Jasmin Require Import expr_facts. +Set Warnings "ambiguous-paths". + +From Coq Require Import Utf8. + +From Crypt Require Import Prelude Package. +Import PackageNotation. + +From Equations Require Import Equations. +Set Equations With UIP. +Set Equations Transparent. + +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. +Set Default Proof Using "Type". + +Derive NoConfusion for result. +Derive NoConfusion for value. +Derive NoConfusion for wsize. +(* Derive NoConfusion for (word wsize). *) +Derive EqDec for wsize. + +Local Open Scope positive_scope. + +Notation p_id := BinNums.positive. + +Lemma nat_of_pos_nonzero : + ∀ p, + nat_of_pos p ≠ 0%nat. +Proof. + intros p. induction p as [p ih | p ih |]. + - simpl. micromega.Lia.lia. + - simpl. rewrite NatTrec.doubleE. + move => /eqP. rewrite double_eq0. move /eqP. assumption. + - simpl. micromega.Lia.lia. +Qed. + +Lemma injective_nat_of_pos : + forall p1 p2, nat_of_pos p1 = nat_of_pos p2 -> p1 = p2. +Proof. + intros p1. induction p1 as [p1 ih | p1 ih |]; intros. + - destruct p2. + + inversion H. + f_equal. apply ih. + apply double_inj. + rewrite -!NatTrec.doubleE. + assumption. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + + inversion H. + move: H1 => /eqP. + rewrite NatTrec.doubleE double_eq0 => /eqP H1. + apply nat_of_pos_nonzero in H1 as []. + - destruct p2. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + + inversion H. + f_equal. apply ih. + apply double_inj. + rewrite -!NatTrec.doubleE. + assumption. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + - destruct p2. + + inversion H. + move: H1 => /eqP. + rewrite eq_sym NatTrec.doubleE double_eq0 => /eqP H1. + apply nat_of_pos_nonzero in H1 as []. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + + reflexivity. +Qed. + +Definition nat_of_p_id : p_id -> nat := nat_of_pos. +Definition nat_of_p_id_nonzero : forall p, nat_of_p_id p <> 0%nat := nat_of_pos_nonzero. +Definition nat_of_p_id_injective : injective nat_of_p_id := injective_nat_of_pos. + +Inductive preceq : p_id -> p_id -> Prop := +| preceqEq : forall i, preceq i i +| preceqI : forall i1 i2, preceq i1 i2 -> preceq i1 i2~1 +| preceqO : forall i1 i2, preceq i1 i2 -> preceq i1 i2~0. +Infix "⪯" := preceq (at level 70). + +Definition prec i1 i2 := i1 ⪯ i2 /\ i1 <> i2. +Infix "≺" := prec (at level 70). + +#[export] Instance preceq_trans : Transitive preceq. +Proof. + intros i1 i2 i3 hi1 hi2. + induction hi2. + - assumption. + - constructor. + apply IHhi2. + assumption. + - constructor. + apply IHhi2. + assumption. +Qed. + +#[export] Instance preceq_refl : Reflexive preceq. +Proof. + intros i. induction i; constructor; assumption. +Qed. + +Lemma preceq_size : + forall i j, i ⪯ j -> Pos.size i <= Pos.size j. +Proof. + intros i j h. + induction h. + - reflexivity. + - simpl; micromega.Lia.lia. + - simpl; micromega.Lia.lia. +Qed. + +Lemma preceq_I : + forall i, i ⪯ i~1. +Proof. + intros. constructor. reflexivity. +Qed. + +Lemma preceq_O : + forall i, i ⪯ i~0. +Proof. + intros. constructor. reflexivity. +Qed. + +Lemma xO_neq : + forall i, i~0 <> i. +Proof. + induction i; congruence. +Qed. + +Lemma xI_neq : + forall i, i~1 <> i. +Proof. + induction i; congruence. +Qed. + +Lemma precneq_O : + forall i, ~ i~0 ⪯ i. +Proof. + intros i contra. + apply preceq_size in contra. + simpl in contra. + micromega.Lia.lia. +Qed. + +Lemma precneq_I : + forall i, ~ i~1 ⪯ i. +Proof. + intros i contra. + apply preceq_size in contra. + simpl in contra. + micromega.Lia.lia. +Qed. + +Lemma size_1 : + forall i, Pos.size i = 1 -> i = 1. +Proof. + intros i h. + induction i. + - simpl in *. + micromega.Lia.lia. + - simpl in *. + micromega.Lia.lia. + - reflexivity. +Qed. + +Lemma preceq_size_eq_eq : + forall i j, Pos.size i = Pos.size j -> i ⪯ j -> i = j. +Proof. + intros i j; revert i; induction j; intros i hsize hprec. + - simpl in *. + inversion hprec; subst. + + reflexivity. + + destruct i. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + etransitivity. + 1: eapply preceq_I. + assumption. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + 1: apply precneq_O in H1; easy. + etransitivity. + 1: eapply preceq_O. + assumption. + * simpl in hsize. + micromega.Lia.lia. + - simpl in *. + inversion hprec; subst. + + reflexivity. + + destruct i. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + 1: apply precneq_I in H1; easy. + etransitivity. + 1: eapply preceq_I. + assumption. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + etransitivity. + 1: eapply preceq_O. + assumption. + * simpl in hsize. + micromega.Lia.lia. + - simpl in hsize. + apply size_1. + assumption. +Qed. + +#[export] Instance preceq_antisym : Antisymmetric _ _ preceq. +Proof. + intros i1 i2 h1 h2. + apply preceq_size in h1 as hsize1. + apply preceq_size in h2 as hsize2. + apply preceq_size_eq_eq. + 1: micromega.Lia.lia. + assumption. +Qed. + +Lemma preceq_prefix : forall i1 i2 i3, i1 ⪯ i3 -> i2 ⪯ i3 -> i1 ⪯ i2 \/ i2 ⪯ i1. +Proof. + intros i1 i2 i3. revert i1 i2. + induction i3; intros. + - inversion H; subst. + + right. assumption. + + inversion H0; subst. + * left; assumption. + * apply IHi3; assumption. + - inversion H; subst. + + right. assumption. + + inversion H0; subst. + * left; assumption. + * apply IHi3; assumption. + - inversion H; subst. + inversion H0; subst. + left; constructor. +Qed. + +Definition fresh_id i := + (i~0, i~1). + +Lemma prec_neq p fp : p ≺ fp -> p <> fp. +Proof. unfold prec. easy. Qed. + +Lemma prec_precneq i1 i2 : i1 ≺ i2 -> ~ i2 ⪯ i1. +Proof. + intros H contra. + eapply prec_neq. + 1: exact H. + apply antisymmetry; auto. + apply H. +Qed. + +#[export] Instance prec_trans : Transitive prec. +Proof. + intros i1 i2 i3. + intros [hpre1 hneq1] [hpre2 hneq2]. + split. + - etransitivity; eauto. + - intro contra; subst. + apply hneq2. + apply antisymmetry; assumption. +Qed. + +Lemma fresh1 i : i ≺ (fresh_id i).1. +Proof. + simpl; split. + - apply preceq_O. + - apply nesym. apply xO_neq. +Qed. + +Lemma fresh2 i : i ≺ (fresh_id i).2. +Proof. + simpl; split. + - apply preceq_I. + - apply nesym. apply xI_neq. +Qed. + +Lemma preceq_prec_trans : forall p1 p2 p3, p1 ⪯ p2 -> p2 ≺ p3 -> p1 ≺ p3. +Proof. + intros p1 p2 p3 h1 [h2 h3]. + split. + - etransitivity; eauto. + - intros contra; subst. + apply h3. apply antisymmetry; assumption. +Qed. + +Lemma prec_preceq_trans : forall p1 p2 p3, p1 ≺ p2 -> p2 ⪯ p3 -> p1 ≺ p3. +Proof. + intros p1 p2 p3 [h1 h2] h3. + split. + - etransitivity; eauto. + - intros contra; subst. + apply h2. apply antisymmetry; assumption. +Qed. + +Lemma fresh1_weak s_id : s_id ⪯ s_id~0. +Proof. apply fresh1. Qed. + +Lemma fresh2_weak s_id : s_id ⪯ s_id~1. +Proof. apply fresh2. Qed. + +Definition disj i1 i2 := + forall i3, i1 ⪯ i3 -> ~ i2 ⪯ i3. + +Lemma disj_antirefl i : ~ disj i i. +Proof. + intros contra. + unfold disj in contra. + specialize (contra i ltac:(reflexivity)). + apply contra. reflexivity. +Qed. + +#[export] Instance disj_sym : Symmetric disj. +Proof. + intros i1 i2 hi1 i3 hi2. + intros contra. + apply hi1 in contra. + contradiction. +Qed. + +Lemma fresh_disj i : + disj (fresh_id i).1 (fresh_id i).2. +Proof. + intros i' h contra. + simpl in *. + pose proof preceq_prefix i~0 i~1 i' h contra. + destruct H. + - inversion H; subst. + eapply precneq_O; eassumption. + - inversion H; subst. + eapply precneq_I; eassumption. +Qed. + +Lemma disj_prec_l : forall id1 id2 id3, id1 ⪯ id2 -> disj id1 id3 -> disj id2 id3. +Proof. + intros id1 id2 id3 hpre hdisj. + intros id' hprec. + apply hdisj. + etransitivity; eauto. +Qed. + +Lemma disj_prec_r : forall id1 id2 id3, id1 ⪯ id2 -> disj id3 id1 -> disj id3 id2. +Proof. + intros id1 id2 id3 hpre hdisj. + apply disj_sym. + eapply disj_prec_l; eauto. + apply disj_sym; assumption. +Qed. + +Lemma disj_prec : forall id1 id2 id3 id4, id1 ⪯ id2 -> id3 ⪯ id4 -> disj id1 id3 -> disj id2 id4. +Proof. + intros. + eapply disj_prec_l; eauto. + eapply disj_prec_r; eauto. +Qed. + +#[export] Hint Resolve fresh1 fresh2 fresh1_weak fresh2_weak preceq_refl preceq_trans prec_trans : prefix. + +(* Unary judgment concluding on evaluation of program *) + +Definition eval_jdg {A : choiceType} + (pre : heap → Prop) (post : heap → Prop) + (c : raw_code A) (v : A) := + ⊢ ⦃ λ '(h₀, h₁), pre h₀ ⦄ + c ≈ ret v + ⦃ λ '(a₀, h₀) '(a₁, h₁), post h₀ ∧ a₀ = a₁ ∧ a₁ = v ⦄. + +Notation "⊢ ⦃ pre ⦄ c ⇓ v ⦃ post ⦄" := + (eval_jdg pre post c v) + (format "⊢ ⦃ pre ⦄ '/ ' '[' c ']' '/' ⇓ '/ ' '[' v ']' '/' ⦃ post ⦄") + : package_scope. + +Lemma u_ret : + ∀ {A : choiceType} (v v' : A) (p q : heap → Prop), + (∀ hp, p hp → q hp ∧ v = v') → + ⊢ ⦃ p ⦄ ret v ⇓ v' ⦃ q ⦄. +Proof. + intros A v v' p q h. + unfold eval_jdg. + apply r_ret. + intros hp hp' hhp. + specialize (h hp). + intuition eauto. +Qed. + +Lemma u_ret_eq : + ∀ {A : choiceType} (v : A) (p q : heap → Prop), + (∀ hp, p hp → q hp) → + ⊢ ⦃ p ⦄ ret v ⇓ v ⦃ q ⦄. +Proof. + intros A v p q h. + apply u_ret. intuition eauto. +Qed. + +Lemma u_bind : + ∀ {A B : choiceType} m f v₁ v₂ (p q r : heap → Prop), + ⊢ ⦃ p ⦄ m ⇓ v₁ ⦃ q ⦄ → + ⊢ ⦃ q ⦄ f v₁ ⇓ v₂ ⦃ r ⦄ → + ⊢ ⦃ p ⦄ @bind A B m f ⇓ v₂ ⦃ r ⦄. +Proof. + intros A B m f v₁ v₂ p q r hm hf. + unfold eval_jdg. + change (ret v₂) with (ret v₁ ;; ret v₂). + eapply r_bind. + - exact hm. + - intros a₀ a₁. + eapply rpre_hypothesis_rule. + intuition subst. + eapply rpre_weaken_rule. + 1: apply hf. + simpl. intuition subst. assumption. +Qed. + +(* Unary variant of set_lhs *) +Definition u_set_pre (ℓ : Location) (v : ℓ) (pre : heap → Prop): heap → Prop := + λ m, ∃ m', pre m' ∧ m = set_heap m' ℓ v. + +Lemma u_put : + ∀ {A : choiceType} (ℓ : Location) (v : ℓ) (r : raw_code A) (v' : A) p q, + ⊢ ⦃ u_set_pre ℓ v p ⦄ r ⇓ v' ⦃ q ⦄ → + ⊢ ⦃ p ⦄ #put ℓ := v ;; r ⇓ v' ⦃ q ⦄. +Proof. + intros A ℓ v r v' p q h. + eapply r_put_lhs with (pre := λ '(_,_), _). + eapply rpre_weaken_rule. 1: eapply h. + intros m₀ m₁ hm. simpl. + destruct hm as [m' hm]. + exists m'. exact hm. +Qed. + +(* Unary variant of inv_conj (⋊) *) +Definition u_pre_conj (p q : heap → Prop) : heap → Prop := + λ m, p m ∧ q m. + +Notation "p ≪ q" := + (u_pre_conj p q) (at level 19, left associativity) : package_scope. + +(* Unary variant of rem_lhs *) +Definition u_get (ℓ : Location) (v : ℓ) : heap → Prop := + λ m, get_heap m ℓ = v. + +Lemma u_get_remember : + ∀ (A : choiceType) (ℓ : Location) (k : ℓ → raw_code A) (v : A) p q, + (∀ x, ⊢ ⦃ p ≪ u_get ℓ x ⦄ k x ⇓ v ⦃ q ⦄) → + ⊢ ⦃ p ⦄ x ← get ℓ ;; k x ⇓ v ⦃ q ⦄. +Proof. + intros A ℓ k v p q h. + eapply r_get_remember_lhs with (pre := λ '(_,_), _). + intro x. + eapply rpre_weaken_rule. 1: eapply h. + simpl. intuition eauto. +Qed. + +(* Unary rpre_weaken_rule *) +Lemma u_pre_weaken_rule : + ∀ A (r : raw_code A) v (p1 p2 : heap → Prop) q, + ⊢ ⦃ p1 ⦄ r ⇓ v ⦃ q ⦄ → + (∀ h, p2 h → p1 h) → + ⊢ ⦃ p2 ⦄ r ⇓ v ⦃ q ⦄. +Proof. + intros A r v p1 p2 q h hp. + eapply rpre_weaken_rule. + - eapply h. + - intros. apply hp. assumption. +Qed. + +(* Unary rpost_weaken_rule *) +Lemma u_post_weaken_rule : + ∀ A (r : raw_code A) v p (q1 q2 : heap → Prop), + ⊢ ⦃ p ⦄ r ⇓ v ⦃ q1 ⦄ → + (∀ h, q1 h → q2 h) → + ⊢ ⦃ p ⦄ r ⇓ v ⦃ q2 ⦄. +Proof. + intros A r v p q1 q2 h hq. + eapply rpost_weaken_rule. + - eapply h. + - intros [] []. intuition eauto. +Qed. + +Definition typed_chElement := + pointed_value. + +Definition to_typed_chElement {t : choice_type} (v : t) : typed_chElement := + (t ; v). + +Definition typed_code := + ∑ (a : choice_type), raw_code a. + +Definition encode (t : stype) : choice_type := + match t with + | sbool => 'bool + | sint => 'int + | sarr n => (chMap 'int ('word U8)) + | sword n => 'word n + end. + +Definition embed_array {len} (a : WArray.array len) : (chMap 'int ('word U8)) := + Mz.fold (λ k v m, setm m k v) a.(WArray.arr_data) emptym. + +Definition embed {t} : sem_t t → encode t := + match t with + | sbool => λ x, x + | sint => λ x, x + | sarr n => embed_array + | sword n => λ x, x + end. + +(* from pkg_invariants *) +Definition cast_ct_val {t t' : choice_type} (e : t = t') (v : t) : t'. +Proof. + subst. auto. +Defined. + +Lemma cast_ct_val_K : + ∀ t e v, + @cast_ct_val t t e v = v. +Proof. + intros t e v. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. +Qed. + +Equations? coerce_to_choice_type (t : choice_type) {tv : choice_type} (v : tv) : t := + @coerce_to_choice_type t tv v with inspect (tv == t) := { + | @exist true e => cast_ct_val _ v + | @exist false e => chCanonical t + }. +Proof. + symmetry in e. + move: e => /eqP e. subst. reflexivity. +Qed. + +Definition cast_typed_code (t' : choice_type) (c : typed_code) (e : c.π1 = t') : + raw_code t'. +Proof. + subst. exact (projT2 c). +Defined. + +Lemma cast_typed_code_K : + ∀ t c e, + @cast_typed_code t (t ; c) e = c. +Proof. + intros t c e. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. +Qed. + +Equations? coerce_typed_code (ty : choice_type) (tc : typed_code) : raw_code ty := + @coerce_typed_code ty tc with inspect (tc.π1 == ty) := { + | @exist true e => @cast_typed_code ty tc _ + | @exist false e => ret (chCanonical ty) + }. +Proof. + symmetry in e. + move: e => /eqP e. subst. reflexivity. +Qed. + +Lemma coerce_typed_code_neq : + ∀ (ty ty' : choice_type) c, + ty ≠ ty' → + coerce_typed_code ty' (ty ; c) = ret (chCanonical _). +Proof. + intros ty ty' c ne. + funelim (coerce_typed_code ty' (ty ; c)). + 1:{ + clear - e ne. symmetry in e. move: e => /eqP e. simpl in e. contradiction. + } + symmetry. assumption. +Qed. + +Lemma coerce_typed_code_K : + ∀ (ty : choice_type) c, + coerce_typed_code ty (ty ; c) = c. +Proof. + intros ty c. + funelim (coerce_typed_code ty (ty ; c)). + 2:{ + clear - e. symmetry in e. move: e => /eqP e. simpl in e. contradiction. + } + rewrite <- Heqcall. + apply cast_typed_code_K. +Qed. + +Definition choice_type_of_val (val : value) : choice_type := + encode (type_of_val val). + +(* Tactic to deal with Let _ := _ in _ = ok _ in assumption h *) +(* x and hx are introduced names for the value and its property *) +Ltac jbind h x hx := + eapply rbindP ; [| exact h ] ; + clear h ; intros x hx h ; + cbn beta in h. + +Module JasminNotation. + Notation " 'array " := (chMap 'int ('word U8)) (at level 2) : package_scope. + Notation " 'array " := (chMap 'int ('word U8)) (in custom pack_type at level 2). + Notation " 'mem " := (chMap ('word Uptr) ('word U8)) (at level 2) : package_scope. + Notation " 'mem " := (chMap ('word Uptr) ('word U8)) (in custom pack_type at level 2). + Notation totce := to_typed_chElement. + Notation coe_cht := coerce_to_choice_type. + Notation coe_tyc := coerce_typed_code. + +End JasminNotation. + +Import JasminNotation. + +Section Translation. + +Context `{asmop : asmOp}. + +Context {pd : PointerData}. + +Context (gd : glob_decls). + +Context `{sc_sem : syscall_sem }. + +Definition mem_index : nat := 0. +Definition mem_loc : Location := ('mem ; mem_index). + +Lemma elementsNIn : + ∀ (T : Type) (k : Z) (v : T) (m : Mz.Map.t T), + Mz.get m k = None → + ¬ List.In (k, v) (Mz.elements m). +Proof. + intros S k v m H contra. + apply Mz.elementsIn in contra. + rewrite H in contra. + discriminate. +Qed. + +Lemma foldl_In_uniq {S : eqType} (k : Mz.K.t) (v : S) (data : seq (Mz.K.t * S)) : + List.In (k, v) data → + @uniq Mz.K.t [seq i.1 | i <- data] → + foldr (λ (kv : Mz.K.t * S) (a : {fmap Mz.K.t → S}), setm a kv.1 kv.2) emptym data k = Some v. +Proof. + intros. + induction data. + - easy. + - simpl in H. + simpl. + destruct H. + + subst. simpl. + rewrite setmE. + rewrite eq_refl. + reflexivity. + + move: H0 => /andP [H1 H2]. + move: H1 => /in_map H3. + assert (negb (@eq_op BinNums_Z__canonical__Ord_Ord k a.1)). { + apply /eqP => contra; case: H3; exists (a.1, v); by move: contra <-. + } + rewrite setmE. + rewrite <- negbK. + rewrite H0. + simpl. + apply IHdata; assumption. +Qed. + +Lemma foldl_NIn {S : eqType} (k : Mz.K.t) (data : seq (Mz.K.t * S)) : + (∀ w, ¬ List.In (k, w) data) → + foldr (λ (kv : Mz.K.t * S) (a : {fmap Mz.K.t → S}), setm a kv.1 kv.2) emptym data k = None. +Proof. + intros. + induction data. + - easy. + - specialize (H a.2) as H0. + simpl. apply List.not_in_cons in H0 as [H0 H1]. + assert (negb (@eq_op BinNums_Z__canonical__Ord_Ord k a.1)). { + apply /eqP => contra. apply H0. move: contra ->. symmetry. apply surjective_pairing. } + rewrite setmE. + rewrite <- negbK. + rewrite H2. + simpl. + apply IHdata. + intros. + specialize (H w). + apply List.not_in_cons in H. easy. +Qed. + +Lemma rev_list_rev {S} : + ∀ (l : seq S), List.rev l = rev l. +Proof. + induction l; intuition subst; simpl. + rewrite rev_cons. rewrite IHl. rewrite <- cats1. reflexivity. +Qed. + +Lemma fold_get {S : eqType} (data : Mz.Map.t S) i : + Mz.fold (λ k v m, setm m k v) data emptym i = Mz.get data i. +Proof. + rewrite Mz.foldP. + replace (Mz.elements data) with (rev (rev (Mz.elements data))). 2: by rewrite revK. + rewrite foldl_rev. + destruct Mz.get eqn:E. + - set (kv := (i, s)). + replace i with kv.1 in * by reflexivity. + replace s with kv.2 in * by reflexivity. + apply Mz.elementsIn in E. subst kv. + apply foldl_In_uniq. + + rewrite <- rev_list_rev. apply -> List.in_rev. assumption. + + rewrite map_rev. rewrite rev_uniq. apply Mz.elementsU. + - apply foldl_NIn. + intros. + rewrite <- rev_list_rev. + rewrite <- List.in_rev. + apply elementsNIn. + assumption. +Qed. + +Lemma embed_array_get : + ∀ len (a : WArray.array len) (k : Z), + embed_array a k = Mz.get a.(WArray.arr_data) k. +Proof. + intros len a k. + unfold embed_array. + rewrite fold_get. reflexivity. +Qed. + +Lemma eq_op_MzK : + ∀ (k x : BinNums_Z__canonical__Ord_Ord), + @eq_op Mz.K.t k x = (k == x). +Proof. + intros k x. + destruct (k == x) eqn: e. + - apply /eqP. move: e => /eqP. auto. + - apply /eqP. move: e => /eqP. auto. +Qed. + +Lemma fold_set {S : eqType} (data : Mz.Map.t S) k v : + setm (Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) data emptym) k v = + Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) (Mz.set data k v) emptym. +Proof. + apply eq_fmap. + intros x. + rewrite fold_get. + rewrite setmE Mz.setP. + rewrite eq_sym. + rewrite eq_op_MzK. + destruct (k == x). + - reflexivity. + - rewrite fold_get. reflexivity. +Qed. + +Lemma embed_array_set : + ∀ len (a : WArray.array len) (k : Z) v, + setm (embed_array a) k v = + embed_array (WArray.Build_array len (Mz.set a.(WArray.arr_data) k v)). +Proof. + intros len a k v. + unfold embed_array. + rewrite fold_set. reflexivity. +Qed. + +Lemma fold_rem {S : eqType} (data : Mz.Map.t S) k : + remm (Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) data emptym) k = + Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) (Mz.remove data k) emptym. +Proof. + apply eq_fmap. + intros x. + rewrite fold_get. + rewrite remmE Mz.removeP. + rewrite eq_sym. + rewrite eq_op_MzK. + destruct (k == x). + - reflexivity. + - rewrite fold_get. reflexivity. +Qed. + +Lemma embed_array_rem : + ∀ len (a : WArray.array len) (k : Z), + remm (embed_array a) k = + embed_array (WArray.Build_array len (Mz.remove a.(WArray.arr_data) k)). +Proof. + intros len a k. + unfold embed_array. + rewrite fold_rem. reflexivity. +Qed. + +Definition unembed {t : stype} : encode t → sem_t t := + match t return encode t → sem_t t with + | sbool => λ x, x + | sint => λ x, x + | sarr n => λ x, + foldr (λ kv m, + {| WArray.arr_data := Mz.set m.(WArray.arr_data) kv.1 kv.2 |} + ) (WArray.empty _) x + (* (λ kv m, Let m' := m in WArray.set8 m' kv.1 kv.2) *) + (* (Ok _ (WArray.empty _)) x *) + | sword n => λ x, x + end. + +Fixpoint nat_of_string_name (s : string) : nat := + match s with + | EmptyString => 1 + | String a s => 256 * nat_of_string_name s + (Ascii.nat_of_ascii a) + end. + +Definition nat_of_ident (id : Ident.ident) : nat := + nat_of_string_name (Ident.string_of_name (Ident.id_name id)). + +Definition nat_of_stype t : nat := + match t with + | sbool => 5 + | sint => 7 + | sarr len => 11 ^ (Pos.to_nat len) + | sword ws => 13 ^ ws + end. + +(* injection *) +Definition nat_of_p_id_ident (p : p_id) (id : Ident.ident) : nat := + 3^(nat_of_p_id p) * 2^(nat_of_ident id). + +Definition nat_of_p_id_var (p : p_id) (x : var) : nat := + (nat_of_stype x.(vtype) * (nat_of_p_id_ident p x.(vname)))%coq_nat. + +Definition translate_var (p : p_id) (x : var) : Location := + (encode x.(vtype) ; nat_of_p_id_var p x). + +Lemma Natpow_expn : + ∀ (n m : nat), + (n ^ m)%nat = expn n m. +Proof. + intros n m. + induction m as [| m ih] in n |- *. + - cbn. reflexivity. + - simpl. rewrite expnS. rewrite -ih. reflexivity. +Qed. + +Lemma Mpowmodn : + ∀ d n, + n ≠ 0%nat → + d ^ n %% d = 0%nat. +Proof. + intros d n hn. + destruct n as [| n]. 1: contradiction. + simpl. apply modnMr. +Qed. + +Lemma nat_of_ident_pos : + ∀ x, (0 < nat_of_ident x)%coq_nat. +Proof. + intros x. + unfold nat_of_ident. + induction (Ident.string_of_name (Ident.id_name x)) as [| a s ih]. + - auto. + - simpl. + rewrite -word_ssrZ.mulP. rewrite -plusE. + micromega.Lia.lia. +Qed. + +Lemma injective_nat_of_ident : + ∀ x y, + nat_of_ident x = nat_of_ident y → + x = y. +Proof. + intros x y e. + unfold nat_of_ident in e. + destruct ident_eqType. + destruct class. + destruct eqtype_hasDecEq_mixin. + + admit. + (* induction (Ident.string_of_name (Ident.id_name x)) as [| a x_] in y, e |- *. *) + (* (* induction x as [| a x] in y, e |- *. *) *) + (* all: destruct (Ident.string_of_name (Ident.id_name y)) as [| b y_]. *) + (* all: simpl in e. *) + (* - reflexivity. *) + (* - rewrite -word_ssrZ.mulP in e. rewrite -plusE in e. *) + (* pose proof (nat_of_ident_pos y). *) + (* micromega.Lia.lia. *) + (* - rewrite -word_ssrZ.mulP in e. rewrite -plusE in e. *) + (* pose proof (nat_of_ident_pos x). *) + (* micromega.Lia.lia. *) + (* - apply (f_equal (λ a, Nat.modulo a 256)) in e as xy_eq. *) + (* rewrite -Nat.add_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite -Nat.mul_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mod_same in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mul_0_l in xy_eq. *) + (* rewrite Nat.mod_0_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.add_0_l in xy_eq. *) + (* rewrite -Nat.add_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite -Nat.mul_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mod_same in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mul_0_l in xy_eq. *) + (* rewrite Nat.mod_0_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.add_0_l in xy_eq. *) + (* rewrite !Nat.mod_small in xy_eq. 2,3: apply Ascii.nat_ascii_bounded. *) + (* apply OrderedTypeEx.String_as_OT.nat_of_ascii_inverse in xy_eq. *) + (* subst. f_equal. *) + (* apply IHx. *) + (* rewrite -!word_ssrZ.addP in e. *) + (* rewrite -!word_ssrZ.mulP in e. *) + (* micromega.Lia.lia. *) +(* Qed. *) +Admitted. + +Lemma injective_nat_of_p_id_ident : + ∀ p x y, + nat_of_p_id_ident p x = nat_of_p_id_ident p y → + x = y. +Proof. + intros p x y e. + unfold nat_of_p_id_ident in e. + apply Nat.mul_cancel_l in e. 2: apply Nat.pow_nonzero ; auto. + eapply Nat.pow_inj_r in e. 2: auto. + apply injective_nat_of_ident. assumption. +Qed. + +Lemma coprime_mul_inj a b c d : + coprime a d → + coprime a b → + coprime c b → + coprime c d → + (a * b = c * d)%nat → + a = c ∧ b = d. +Proof. + intros ad ab cb cd e. + move: e => /eqP. rewrite eqn_dvd. move=> /andP [d1 d2]. + rewrite Gauss_dvd in d1. 2: assumption. + rewrite Gauss_dvd in d2. 2: assumption. + move: d1 d2 => /andP [d11 d12] /andP [d21 d22]. + rewrite Gauss_dvdl in d11. 2: assumption. + rewrite Gauss_dvdr in d12. 2: rewrite coprime_sym; assumption. + rewrite Gauss_dvdl in d21. 2: assumption. + rewrite Gauss_dvdr in d22. 2: rewrite coprime_sym; assumption. + split. + - apply /eqP. rewrite eqn_dvd. by apply /andP. + - apply /eqP. rewrite eqn_dvd. by apply /andP. +Qed. + +Lemma coprime_nat_of_stype_nat_of_fun_ident t p v : + coprime (nat_of_stype t) (nat_of_p_id_ident p v). +Proof. + unfold nat_of_p_id_ident. + unfold nat_of_stype. + rewrite coprimeMr. + apply /andP. + destruct t. + - rewrite !Natpow_expn. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. + - rewrite !Natpow_expn. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2,3: apply/ltP; micromega.Lia.lia. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2,3: auto. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. +Qed. + +Lemma nat_of_p_id_pos : forall p, (0 < nat_of_p_id p)%coq_nat. +Proof. + intros. pose proof nat_of_p_id_nonzero p. micromega.Lia.lia. +Qed. + +Lemma injective2_nat_of_p_id_ident : + injective2 nat_of_p_id_ident. +Proof. + intros p gn x y e. + unfold nat_of_p_id_ident in e. + apply coprime_mul_inj in e as [p1_p2 x_y]. + - apply Nat.pow_inj_r in p1_p2; [|micromega.Lia.lia]. + apply Nat.pow_inj_r in x_y; [|micromega.Lia.lia]. + split. + + apply injective_nat_of_pos. assumption. + + apply injective_nat_of_ident. assumption. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. +Qed. + +Lemma injective_translate_var : + ∀ p, injective (translate_var p). +Proof. + intros p u v e. + unfold translate_var in e. + destruct u as [uty u], v as [vty v]. + simpl in e. noconf e. + unfold nat_of_p_id_var in H0. + simpl in H0. + apply coprime_mul_inj in H0 as [e1 e2]. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + f_equal. + - destruct uty, vty; auto; try discriminate. + + apply Nat.pow_inj_r in e1. 2: auto. + 2: micromega.Lia.lia. + apply Pos2Nat.inj in e1. + subst; reflexivity. + + noconf H. reflexivity. + - eapply injective_nat_of_p_id_ident. + eassumption. +Qed. + +Lemma injective_translate_var2 : + forall (p1 p2 : p_id) v1 v2, p1 <> p2 -> translate_var p1 v1 != translate_var p2 v2. +Proof. + intros. + apply /eqP => contra. + unfold translate_var in contra. + noconf contra. + unfold nat_of_p_id_var in H1. + apply coprime_mul_inj in H1 as [e1 e2]. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + apply injective2_nat_of_p_id_ident in e2 as [p_gn _]. + easy. +Qed. + +Lemma injective_translate_var3 : + forall (p1 p2 : p_id) v1 v2, vname v1 != vname v2 -> translate_var p1 v1 != translate_var p2 v2. +Proof. + intros. + apply /eqP => contra. + unfold translate_var in contra. + noconf contra. + unfold nat_of_p_id_var in H1. + apply coprime_mul_inj in H1 as [e1 e2]. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + apply injective2_nat_of_p_id_ident in e2 as [p_gn ?]. + move: H => /eqP contra. + easy. +Qed. + +Lemma coprimenn n : (coprime n n) = (n == 1%nat). +Proof. by unfold coprime; rewrite gcdnn. Qed. + +Lemma coprime_neq p q : p != 1%nat -> coprime p q -> p <> q. +Proof. + intros. + move=>contra; subst. + move: H=>/eqP H; apply H; apply/eqP. + by rewrite -coprimenn. +Qed. + +Lemma nat_of_wsize_inj : injective nat_of_wsize. +Proof. intros ws1 ws2. by case ws1; case ws2. Qed. + +Lemma nat_of_stype_injective : injective nat_of_stype. +Proof. + intros s t. + case s; case t; try by []. + - intros p H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr ; [ | apply is_positive ]. + - intros. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr. + - intros l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr ; [ | apply is_positive ]. + - intros ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr ; [ | apply is_positive ]. + - intros l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + all: micromega.Lia.lia. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl ; [ | apply is_positive ]. + - intros l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + all: micromega.Lia.lia. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl ; [ | apply is_positive ]. + - intros l1 l2 H. + destruct (l2 == l1) eqn:E. + + by move: E=>/eqP ->. + + exfalso. + move: E=>/eqP=>contra; apply contra. + eapply Pos2Nat.inj. eapply Nat.pow_inj_r. + 2: eapply H. micromega.Lia.lia. + - intros ws l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + all: micromega.Lia.lia. + + unfold nat_of_stype. rewrite !Natpow_expn coprime_pexpl; [ | apply is_positive ]. + by rewrite coprime_pexpr. + - intros ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + 1: micromega.Lia.lia. + apply/eqP. by case ws. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl. + - intros ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + 1: micromega.Lia.lia. + apply/eqP. by case ws. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl. + - intros l ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + 1: micromega.Lia.lia. + apply/eqP. by case ws. + + unfold nat_of_stype. rewrite !Natpow_expn coprime_pexpl; [ | apply is_positive ]. + by rewrite coprime_pexpr; [ | apply is_positive ]. + - intros ws1 ws2 H. + destruct (ws2 == ws1) eqn:E. + + by move: E=>/eqP ->. + + exfalso. + move: E=>/eqP=>contra; apply contra. + eapply nat_of_wsize_inj. + eapply Nat.pow_inj_r. + 2: eapply H. micromega.Lia.lia. +Qed. + +Lemma nat_of_p_id_var_injective2 : + injective2 nat_of_p_id_var. +Proof. + intros i1 i2 v1 v2. + unfold nat_of_p_id_var. + intros H. + apply coprime_mul_inj in H as []. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + apply nat_of_stype_injective in H. + apply injective2_nat_of_p_id_ident in H0 as [? ?]. + destruct v1, v2. simpl in *; subst. + easy. +Qed. + +Lemma translate_var_injective2 : + injective2 translate_var. +Proof. + intros i1 i2 v1 v2. + unfold translate_var. + move=> H. + noconf H. + apply nat_of_p_id_var_injective2 in H0. + assumption. +Qed. + +Lemma translate_var_eq i1 i2 v1 v2 : + (translate_var i1 v1 == translate_var i2 v2) = (i1 == i2) && (v1 == v2). +Proof. + apply/eqP. + destruct (_ && _) eqn:E. + - by move: E=>/andP [] /eqP -> /eqP ->. + - move=>contra. + apply translate_var_injective2 in contra as [? ?]. + subst. + move: E=>/andP []. split; by apply/eqP. +Qed. + +Lemma mem_loc_translate_var_neq : + ∀ p x, + mem_loc != translate_var p x. +Proof. + intros p x. + unfold mem_loc, translate_var. + apply /eqP. intro e. + destruct x as [ty i]. simpl in e. noconf e. + destruct ty. all: discriminate. +Qed. + +#[local] Definition unsupported : typed_code := + ('unit ; assert false). + +Lemma truncate_val_type : + ∀ ty v v', + truncate_val ty v = ok v' → + type_of_val v' = ty. +Proof. + intros ty v v' e. + unfold truncate_val in e. + jbind e x ev. noconf e. + apply type_of_to_val. +Qed. + +Definition truncate_chWord {t : choice_type} (n : wsize) : t → 'word n := + match t with + | chWord m => + λ w, + match truncate_word n w with + | Ok w' => w' + | _ => chCanonical _ + end + | _ => λ x, chCanonical _ + end. + +Definition truncate_el {t : choice_type} (s : stype) : t → encode s := + match s return t → encode s with + | sbool => λ b, coerce_to_choice_type 'bool b + | sint => λ i, coerce_to_choice_type 'int i + | sarr n => + (* Here we do not perform the check on the length of the array as + performed by to_arr n. + *) + λ a, coerce_to_choice_type 'array a + | sword n => + λ w, truncate_chWord n w + end. + +Definition translate_to_pointer {t : choice_type} (c : t) : 'word Uptr := + truncate_el (sword Uptr) c. + +Definition truncate_code (s : stype) (c : typed_code) : typed_code := + (encode s ; x ← c.π2 ;; ret (truncate_el s x)). + +Definition translate_value (v : value) : choice_type_of_val v. +Proof. + destruct v as [b | z | size a | size wd | undef_ty]. + - apply embed. exact b. + - apply embed. exact z. + - apply embed. exact a. + - apply embed. exact wd. + - apply chCanonical. + (* It shouldn't matter which value we pick, because when coercing an undef + value at type ty back to ty via to_{bool,int,word,arr} (defined in + values.v), all of these functions raise an error on Vundef. *) +Defined. + +Definition translate_write_var (p : p_id) (x : var_i) (v : typed_chElement) := + let l := translate_var p (v_var x) in + #put l := truncate_el x.(vtype) v.π2 ;; + ret tt. + +Definition translate_get_var (p : p_id) (x : var) : raw_code (encode x.(vtype)) := + x ← get (translate_var p x) ;; ret x. + +Fixpoint satisfies_globs (globs : glob_decls) : heap * heap → Prop. +Proof. + exact (λ '(x, y), False). (* TODO *) +Defined. + +Program Definition translate_gvar (p : p_id) (x : gvar) : raw_code (encode x.(gv).(vtype)) := + if is_lvar x + then translate_get_var p x.(gv).(v_var) + else + match get_global gd x.(gv).(v_var) with + | Ok v => ret (coerce_to_choice_type _ (translate_value v)) + | _ => ret (chCanonical _) + end. + +Definition chArray_get8 (a : 'array) ptr := + match a ptr with + | None => chCanonical ('word U8) + | Some x => x + end. + +Lemma chArray_get8_correct len (a : WArray.array len) s ptr : + WArray.get8 a ptr = ok s → + chArray_get8 (embed_array a) ptr = translate_value (Vword s). +Proof. + intros H. simpl. + unfold WArray.get8 in H. + jbind H x Hx. + jbind H y Hy. + noconf H. + unfold chArray_get8, odflt, oapp, embed_array. + rewrite fold_get. + reflexivity. +Qed. + +Definition chArray_get ws (a : 'array) ptr scale := + (* Jasmin fails if ptr is not aligned; we may not need it. *) + (* if negb (is_align ptr sz) then chCanonical ws else *) + let f k := chArray_get8 a (ptr * scale + k)%Z in + let l := map f (ziota 0 (wsize_size ws)) in + Jasmin.memory_model.LE.decode ws l. + +Definition chArray_get_sub ws len (a : 'array) ptr scale := + let size := arr_size ws len in + let start := (ptr * scale)%Z in + if (0 <=? start)%Z (* && (start + size <=? ) *) + then ( + foldr (λ (i : Z) (data : 'array), + match a (start + i)%Z with + | Some w => setm data i w + | None => remm data i + end + ) emptym (ziota 0 size) + ) + else chCanonical 'array. + +Definition totc (ty : choice_type) (c : raw_code ty) : typed_code := + (ty ; c). + +(* Almost chArray_get but with a different key type *) +Definition read_mem (m : 'mem) ptr ws : 'word ws := + let f k := + match m (ptr + (wrepr Uptr k))%R with + | None => chCanonical ('word U8) + | Some x => x + end + in + let l := map f (ziota 0 (wsize_size ws)) in + Jasmin.memory_model.LE.decode ws l. + +Definition chRead ptr ws : raw_code ('word ws) := + (* memory as array *) + mem ← get mem_loc ;; + ret (read_mem mem ptr ws). + +Definition chArray_set8 (a : 'array) ptr w := + setm a ptr w. + +Lemma chArray_set8_correct {len} (a : WArray.array len) ptr w s : + WArray.set8 a ptr w = ok s → + chArray_set8 (embed_array a) ptr w = embed_array s. +Proof. + intros H. simpl. + unfold WArray.set8 in H. + jbind H x Hx. + noconf H. + unfold chArray_set8, embed_array. + simpl. + rewrite <- fold_set. + reflexivity. +Qed. + +(* Jasmin's write on 'array *) +Definition chArray_write {sz} (a : 'array) ptr (w : word sz) : 'array := + (* For now we do not worry about alignment *) + foldr (λ (k : Z) (a' : 'array), + chArray_set8 a' (ptr + k)%Z (LE.wread8 w k) + ) a (ziota 0 (wsize_size sz)). + +Definition chArray_write_foldl {sz} (a : 'array) ptr (w : word sz) : 'array := + foldl (λ (a' : 'array) (k : Z), + chArray_set8 a' (ptr + k)%Z (LE.wread8 w k) + ) a (ziota 0 (wsize_size sz)). + +Lemma foldr_set_not_eq {K : ordType} {K' : eqType} {V : eqType} m f g (k : K) (v : V) (l : seq K') : + (forall k', k' \in l -> k <> f k') -> + setm (foldr (λ k m, setm m (f k) (g k)) m l) k v = foldr (λ k m, setm m (f k) (g k)) (setm m k v) l. +Proof. + intros. + apply eq_fmap. + intros z. revert z. + induction l. + - reflexivity. + - simpl. + intros. + assert (k <> f a). + { apply H. unfold in_mem. simpl. rewrite eq_refl. auto. } + rewrite !setmE. + destruct (_ == _) eqn:E. + + move: E => /eqP. intros. subst. + assert (k == f a = false). + { apply /eqP. assumption. } + rewrite H1. rewrite <- IHl. + { + rewrite setmE. + rewrite eq_refl. + reflexivity. + } + intros. apply H. + rewrite in_cons. + rewrite H2. + rewrite Bool.orb_true_r. auto. + + + destruct (_ == f a). 1: reflexivity. + rewrite <- IHl. + { rewrite setmE. + rewrite E. + reflexivity. + } + intros. + apply H. + rewrite in_cons. + rewrite H1. + rewrite Bool.orb_true_r. auto. +Qed. + +Lemma foldl_set_not_eq {K : ordType} {K' : eqType} {V : eqType} m f g (k : K) (v : V) (l : seq K') : + (∀ k', k' \in l -> k ≠ f k') → + setm (foldl (λ m k, setm m (f k) (g k)) m l) k v = foldl (λ m k, setm m (f k) (g k)) (setm m k v) l. +Proof. + intros h. + rewrite <- revK. + rewrite !foldl_rev. + apply foldr_set_not_eq. + intros k' hk'. + rewrite <- rev_list_rev in hk'. + move: hk' => /InP hk'. + apply List.in_rev in hk'. + apply h. + apply /InP. assumption. +Qed. + +Lemma foldl_foldr_setm + {K : ordType} {K' : eqType} {V : eqType} m (f : K' → K) (g : K' → V) (l : seq K') : + uniq [seq f i | i <- l] → + foldl (λ m k, setm m (f k) (g k)) m l = foldr (λ k m, setm m (f k) (g k)) m l. +Proof. + intros. + induction l. + - reflexivity. + - simpl. + rewrite <- foldl_set_not_eq. + 1: rewrite IHl. + 1: reflexivity. + { intros. simpl in H. move: H => /andP. easy. } + { intros. simpl in H. move: H => /andP [] H _. + clear -H0 H. + induction l. + { simpl in *. inversion H0. } + { simpl in *. rewrite in_cons in H0. + rewrite notin_cons in H. + move: H => /andP [] H1 H2. + move: H0 => /orP [/eqP -> | H0 ]. + { apply /eqP. assumption. } + { apply IHl; assumption. } } } +Qed. + +Lemma chArray_write_aux {sz} (a : 'array) ptr (w : word sz) : + chArray_write a ptr w = chArray_write_foldl a ptr w. +Proof. + unfold chArray_write_foldl, chArray_write, chArray_set8. + rewrite foldl_foldr_setm. 1: reflexivity. + rewrite map_inj_uniq. + - unfold ziota. + admit. + (* rewrite map_inj_uniq. *) + (* + apply iota_uniq. *) + (* + intros n m H. *) + (* micromega.Lia.lia. *) + (* - intros n m H. *) + (* micromega.Lia.lia. *) + (* Qed. *) +Admitted. + +(* From WArray.set *) +Definition chArray_set {ws} (a : 'array) (aa : arr_access) (p : Z) (w : word ws) := + chArray_write a (p * mk_scale aa ws)%Z w. + +(* WArray.set_sub *) +Definition chArray_set_sub (ws : wsize) (len : BinNums.positive) (aa : arr_access) (a : 'array) (p : Z) (b : 'array) : 'array := + let size := arr_size ws len in + let start := (p * mk_scale aa ws)%Z in + foldr (λ i data, + match b i with + | Some w => setm data (start + i)%Z w + | None => remm data (start + i)%Z + end + ) a (ziota 0 size). + +(* Jasmin's write on 'mem *) +Definition write_mem {sz} (m : 'mem) (ptr : word Uptr) (w : word sz) : 'mem := + (* For now we do not worry about alignment *) + foldr (λ (k : Z) (m' : 'mem), + setm m' (ptr + (wrepr Uptr k))%R (LE.wread8 w k) + ) m (ziota 0 (wsize_size sz)). + +Definition translate_write {sz} (p : word Uptr) (w : word sz) : raw_code 'unit := + m ← get mem_loc ;; #put mem_loc := write_mem m p w ;; ret tt. + +Fixpoint lchtuple (ts : seq choice_type) : choice_type := + match ts with + | [::] => 'unit + | [:: t1 ] => t1 + | t1 :: ts => t1 × (lchtuple ts) + end. + +(* Unpack `t : lchtuple stys` into a list `xs` s.t. `nth i xs = (nth i sty, t.i)`. *) +Definition coerce_chtuple_to_list (ty : choice_type) (stys : seq stype) (t : ty) + : list typed_chElement. +Proof. + pose (lchtuple (map encode stys)) as ty'. + destruct (ty == ty') eqn:E. + 2: exact [::]. + move: E. move /eqP => E. + subst. unfold ty' in t. clear ty'. + move: t. induction stys. + - move => _. exact [::]. + - intros. + destruct stys in IHstys, t |- *. + + simpl in *. apply cons. 2: exact [::]. + econstructor. exact t. + + destruct t as [t1 ts]. + pose (IHstys ts) as tl. + pose ((encode a; t1) : typed_chElement) as hd. + exact (hd :: tl). +Defined. + +Fixpoint bind_list (cs : list typed_code) {struct cs} : raw_code ([choiceType of list typed_chElement]) := + match cs with + | [::] => ret [::] + | c :: cs => + v ← c.π2 ;; + vs ← bind_list cs ;; + ret (to_typed_chElement v :: vs) + end. + +Fixpoint type_of_values vs : choice_type := + match vs with + | [::] => 'unit + | [:: v ] => choice_type_of_val v + | hd :: tl => choice_type_of_val hd × type_of_values tl + end. + +(* lchtuple (map choice_type_of_val vs) *) +Definition translate_values (vs : seq value) : + lchtuple (map choice_type_of_val vs). +Proof. + induction vs as [| v vs tr_vs]. + - exact tt. + - destruct vs as [| v' vs']. + + exact (translate_value v). + + exact (translate_value v, tr_vs). +Defined. + +Fixpoint tr_app_sopn {S R} (can : R) (emb : S → R) (ts : list stype) := + match ts as ts' + return (sem_prod ts' (exec S) → [choiceType of list typed_chElement] → R) + with + | [::] => + λ (o : exec S) (vs : list typed_chElement), + match vs with + | [::] => + match o with + | Ok o => emb o + | _ => can + end + | _ :: _ => can + end + | t :: ts' => + λ (o : sem_t t → sem_prod ts' (exec S)) (vs : list typed_chElement), + match vs with + | [::] => can + | v :: vs' => tr_app_sopn can emb ts' (o (unembed (truncate_el t v.π2))) vs' + end + end. + +Section bind_list_alt. + + Definition bind_typed_list (cs : list typed_code) + : raw_code (lchtuple ([seq tc.π1 | tc <- cs])). + Proof. + induction cs as [| c cs bind_cs]. + - exact (ret tt). + - destruct cs as [|c' cs']. + + exact c.π2. + + exact ( vs ← bind_cs ;; + v ← c.π2 ;; + ret (v, vs) ). + Defined. + + Definition bind_list_truncate (l : list (stype * typed_code)) + : raw_code (lchtuple ([seq encode ttc.1 | ttc <- l])). + Proof. + induction l as [| [t c] tcs bind_tcs]. + - exact (ret tt). + - destruct tcs as [| [t' c'] tcs']. + + pose (truncate_code t c) as c'. + exact c'.π2. + + exact ( vs ← bind_tcs ;; + v ← (truncate_code t c).π2 ;; + ret (v, vs) ). + Defined. + + Lemma map_fst {A B C} (xs : seq A) (ys : seq B) (f : A -> C) (H : size xs = size ys) + : [seq f xy.1 | xy <- zip xs ys] = [seq f x | x <- xs]. + Proof. + set (f' := fun xy => f (fst xy)). + assert ([seq f' i | i <- zip xs ys] = map f (unzip1 (zip xs ys))) as mc by apply map_comp. + rewrite mc. + rewrite unzip1_zip. + 1: reflexivity. + now rewrite H. + Qed. + + Definition bind_list_trunc_aux (ts : list stype) (cs : list typed_code) + (H : size ts = size cs) + : raw_code (lchtuple ([seq encode t | t <- ts])). + Proof. + erewrite <- map_fst. + 1: exact (bind_list_truncate (zip ts cs)). + assumption. + Defined. + + Definition bind_list' (ts : list stype) (cs : list typed_code) + : raw_code (lchtuple ([seq encode t | t <- ts])). + Proof. + destruct (size ts == size cs) eqn:e. + - eapply bind_list_trunc_aux. + apply: eqP e. + - exact (ret (chCanonical _)). + Defined. + +End bind_list_alt. +Context {fcp : FlagCombinationParams}. +Definition embed_ot {t} : sem_ot t → encode t := + match t with + | sbool => λ x, + match x with + | Some b => b + | None => false + end + | sint => λ x, x + | sarr n => embed_array + | sword n => λ x, x + end. + +Definition encode_tuple (ts : list stype) : choice_type := + lchtuple [seq encode t | t <- ts]. + +(* takes a tuple of jasmin values and embeds each component *) +Fixpoint embed_tuple {ts} : sem_tuple ts → encode_tuple ts := + match ts as ts0 + return sem_tuple ts0 -> lchtuple [seq encode t | t <- ts0] + with + | [::] => λ (_ : unit), tt + | t' :: ts' => + let rec := @embed_tuple ts' in + match ts' as ts'0 + return + (sem_tuple ts'0 -> lchtuple [seq encode t | t <- ts'0]) → + sem_tuple (t'::ts'0) -> lchtuple [seq encode t | t <- (t'::ts'0)] + with + | [::] => λ _ (v : sem_ot t'), embed_ot v + | t'' :: ts'' => λ rec (p : (sem_ot t') * (sem_tuple (t''::ts''))), (embed_ot p.1, rec p.2) + end rec + end. + +(* tr_app_sopn specialized to when there is only one return value *) +Definition tr_app_sopn_single {t} := + tr_app_sopn (chCanonical (encode t)) embed. + +(* tr_app_sopn specialized to when there is several return values *) +Definition tr_app_sopn_tuple {ts} := + tr_app_sopn (chCanonical (encode_tuple ts)) embed_tuple. + +(* Following sem_pexpr *) +Fixpoint translate_pexpr (p : p_id) (e : pexpr) {struct e} : typed_code := + match e with + | Pconst z => totc 'int (@ret 'int z) (* Why do we need to give 'int twice? *) + | Pbool b => totc 'bool (ret b) + | Parr_init n => + (* Parr_init only gets produced by ArrayInit() in jasmin source. *) + (* The EC export asserts false on it. *) + totc 'array (ret emptym) + | Pvar v => totc _ (translate_gvar p v) + | Pget aa ws x e => + totc ('word ws) ( + arr ← translate_gvar p x ;; (* Performs the lookup in gd *) + let a := coerce_to_choice_type 'array arr in + i ← (truncate_code sint (translate_pexpr p e)).π2 ;; (* to_int *) + let scale := mk_scale aa ws in + ret (chArray_get ws a i scale) + ) + | Psub aa ws len x e => + totc 'array ( + arr ← translate_gvar p x ;; (* Performs the lookup in gd *) + let a := coerce_to_choice_type 'array arr in + i ← (truncate_code sint (translate_pexpr p e)).π2 ;; (* to_int *) + let scale := mk_scale aa ws in + ret (chArray_get_sub ws len a i scale) + ) + | Pload sz x e => + totc ('word sz) ( + w ← translate_get_var p x ;; + let w1 : word _ := truncate_el (sword Uptr) w in + w2 ← (truncate_code (sword Uptr) (translate_pexpr p e)).π2 ;; + chRead (w1 + w2)%R sz + ) + | Papp1 o e => + totc _ ( + (* We truncate and call sem_sop1_typed instead of calling sem_sop1 + which does the truncation and then calls sem_sop1_typed. + *) + x ← (truncate_code (type_of_op1 o).1 (translate_pexpr p e)).π2 ;; + ret (embed (sem_sop1_typed o (unembed x))) + ) + | Papp2 o e1 e2 => + totc _ ( + (* Same here *) + r1 ← (truncate_code (type_of_op2 o).1.1 (translate_pexpr p e1)).π2 ;; + r2 ← (truncate_code (type_of_op2 o).1.2 (translate_pexpr p e2)).π2 ;; + ret match sem_sop2_typed o (unembed r1) (unembed r2) with + | Ok y => embed y + | _ => chCanonical _ + end + ) + | PappN op es => + (* note that this is sligtly different from Papp2 and Papp1, in that + we don't truncate when we bind, but when we apply (in app_sopn_list). + This made the proof easier, but is also more faithful to + how it is done in jasmin. + *) + totc _ ( + vs ← bind_list [seq translate_pexpr p e | e <- es] ;; + ret (tr_app_sopn_single (type_of_opN op).1 (sem_opN_typed op) vs) + ) + | Pif t eb e1 e2 => + totc _ ( + b ← (truncate_code sbool (translate_pexpr p eb)).π2 ;; (* to_bool *) + if b + then (truncate_code t (translate_pexpr p e1)).π2 + else (truncate_code t (translate_pexpr p e2)).π2 + ) + end. + + +Definition translate_write_lval (p : p_id) (l : lval) (v : typed_chElement) + : raw_code 'unit + := + match l with + | Lnone _ ty => ret tt + | Lvar x => translate_write_var p x v + | Lmem sz x e => + vx' ← translate_get_var p x ;; + let vx : word _ := translate_to_pointer vx' in + ve' ← (translate_pexpr p e).π2 ;; + let ve := translate_to_pointer ve' in + let p := (vx + ve)%R in + let w := truncate_chWord sz v.π2 in + translate_write p w + | Laset aa ws x i => + (* Let (n,t) := s.[x] in is a notation calling on_arr_varr on get_var *) + (* We just cast it since we do not track lengths *) + t' ← translate_get_var p x ;; + let t := coerce_to_choice_type 'array t' in + i ← (truncate_code sint (translate_pexpr p i)).π2 ;; (* to_int *) + let v := truncate_chWord ws v.π2 in + let t := chArray_set t aa i v in + translate_write_var p x (totce t) + | Lasub aa ws len x i => + (* Same observation as Laset *) + t ← translate_get_var p x ;; + let t := coerce_to_choice_type 'array t in + i ← (truncate_code sint (translate_pexpr p i)).π2 ;; (* to_int *) + let t' := truncate_el (sarr (Z.to_pos (arr_size ws len))) v.π2 in + let t := chArray_set_sub ws len aa t i t' in + translate_write_var p x (totce t) + end. + +(* the argument to c is its (valid) sub id, the return is the resulting (valid) sub id *) +Fixpoint translate_for (v : var_i) (ws : seq Z) (m_id : p_id) (c : p_id -> p_id * raw_code 'unit) (s_id : p_id) : raw_code 'unit := + match ws with + | [::] => ret tt + | w :: ws => + let (s_id', c') := c s_id in + translate_write_var m_id v (totce (translate_value w)) ;; + c' ;; + translate_for v ws m_id c s_id' + end. + +(* list_ltuple *) +Fixpoint list_lchtuple {ts} : lchtuple ([seq encode t | t <- ts]) → [choiceType of list typed_chElement] := + match ts as ts0 + return + lchtuple ([seq encode t | t <- ts0]) → + [choiceType of list typed_chElement] + with + | [::] => λ _, [::] + | t' :: ts' => + let rec := @list_lchtuple ts' in + match ts' as ts'0 + return + (lchtuple ([seq encode t | t <- ts'0]) → + [choiceType of list typed_chElement]) → + lchtuple [seq encode t | t <- (t'::ts'0)] → + [choiceType of list typed_chElement] + with + | [::] => λ _ (v : encode t'), [:: totce v] + | t'' :: ts'' => λ rec (p : (encode t') × (lchtuple [seq encode t | t <- (t''::ts'')])), totce p.1 :: rec p.2 + end rec + end. + +(* corresponds to exec_sopn *) +Definition translate_exec_sopn (o : sopn) (vs : seq typed_chElement) := + list_lchtuple (tr_app_sopn_tuple _ (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ o) vs). + +Fixpoint foldl2 {A B R} (f : R → A → B → R) (la : seq A) (lb : seq B) r := + match la with + | [::] => r + | a :: la' => + match lb with + | [::] => r + | b :: lb' => foldl2 f la' lb' (f r a b) + end + end. + +Fixpoint foldr2 {A B R} (f : A → B → R → R) (la : seq A) (lb : seq B) r := + match la with + | [::] => r + | a :: la' => + match lb with + | [::] => r + | b :: lb' => f a b (foldr2 f la' lb' r) + end + end. + +Definition translate_write_lvals p ls vs := + foldr2 (λ l v c, translate_write_lval p l v ;; c) ls vs (ret tt). + +Definition translate_write_vars p xs vs := + foldr2 (λ x v c, translate_write_var p x v ;; c) xs vs (ret tt). + +Lemma eq_rect_K : + ∀ (A : eqType) (x : A) (P : A -> Type) h e, + @eq_rect A x P h x e = h. +Proof. + intros A x P' h e. + replace e with (@erefl A x) by apply eq_irrelevance. + reflexivity. +Qed. + +Lemma eq_rect_r_K : + ∀ (A : eqType) (x : A) (P : A → Type) h e, + @eq_rect_r A x P h x e = h. +Proof. + intros A x P' h e. + replace e with (@erefl A x) by apply eq_irrelevance. + reflexivity. +Qed. + +Lemma translate_value_to_val : + ∀ (s : stype) (v : sem_t s), + translate_value (to_val v) = eq_rect_r encode (embed v) (type_of_to_val v). +Proof. + intros s v. + destruct s as [| | size | size]. + all: simpl ; rewrite eq_rect_r_K ; reflexivity. +Qed. + +Definition nat_of_ptr (ptr : pointer) := + (7 ^ Z.to_nat (wunsigned ptr))%nat. + +Definition translate_ptr (ptr : pointer) : Location := + ('word U8 ; nat_of_ptr ptr). + +Lemma ptr_var_nat_neq (ptr : pointer) (p : p_id) (v : var) : + nat_of_ptr ptr != nat_of_p_id_var p v. +Proof. + unfold nat_of_ptr. + unfold nat_of_p_id_var. + apply /eqP. intro e. + apply (f_equal (λ n, n %% 3)) in e. + rewrite -modnMm in e. + rewrite -(modnMm (3 ^ _)) in e. + rewrite Mpowmodn in e. 2: apply nat_of_p_id_nonzero. + rewrite mul0n in e. + rewrite mod0n in e. + rewrite muln0 in e. + move: e => /eqP e. rewrite eqn_mod_dvd in e. 2: auto. + rewrite subn0 in e. + rewrite Natpow_expn in e. rewrite Euclid_dvdX in e. 2: auto. + move: e => /andP [e _]. + rewrite dvdn_prime2 in e. 2,3: auto. + move: e => /eqP e. micromega.Lia.lia. +Qed. + +Lemma ptr_var_neq (ptr : pointer) (p : p_id) (v : var) : + translate_ptr ptr != translate_var p v. +Proof. + unfold translate_ptr. + unfold translate_var. + unfold nat_of_p_id_ident. + apply /eqP. intro e. + noconf e. + move: (ptr_var_nat_neq ptr p v) => /eqP. contradiction. +Qed. + +Definition rel_mem (m : mem) (h : heap) := + ∀ (ptr : pointer) (v : (word U8)), + (* mem as array model: *) + read m ptr U8 = ok v → + (get_heap h mem_loc) ptr = Some v. + +Lemma translate_read : + ∀ s ptr sz w m, + rel_mem s m → + read s ptr sz = ok w → + read_mem (get_heap m mem_loc) ptr sz = w. +Proof. + intros s ptr sz w m hm h. + rewrite readE in h. + jbind h _u eb. apply assertP in eb. + jbind h l hl. noconf h. + unfold read_mem. f_equal. + revert l hl. apply ziota_ind. + - simpl. intros l h. noconf h. reflexivity. + - simpl. intros i l' hi ih l h. + jbind h y hy. jbind h ys hys. noconf h. + erewrite ih. 2: exact hys. + eapply hm in hy. rewrite hy. reflexivity. +Qed. + +Lemma get_mem_read8 : + ∀ m p, + read_mem m p U8 = + match m p with + | Some w => w + | None => chCanonical _ + end. +Proof. + intros m p. + unfold read_mem. simpl. + rewrite <- addE. + rewrite add_0. + destruct (m p) eqn:E. + all: rewrite E; rewrite <- LE.encode8E; apply LE.decodeK. +Qed. + +Lemma write_mem_get ws m p (w : word ws) p' : + write_mem m p w p' = + if (0 <=? sub p' p)%Z && (sub p' p /eqP <-. + rewrite setmE. + rewrite add_sub. + rewrite !eq_refl. + reflexivity. + + move: eb => /eqP. + rewrite setmE. + destruct (p' == add p i) eqn:E. + * rewrite E. + move: E => /eqP E eb. + rewrite E in eb. + rewrite sub_add in eb. + 2:{ destruct ws. all: unfold wsize_size. all: micromega.Lia.lia. } + contradiction. + * rewrite E. intros. apply Ih. +Qed. + +(* Copy of write_read8 *) +Lemma write_read_mem8 : + ∀ m p ws w p', + read_mem (write_mem (sz := ws) m p w) p' U8 = + (let i := sub p' p in + if (0 <=? i)%Z && (i m_id' -> rel_vmap vm m_id h -> rel_vmap vm m_id (set_heap h (translate_var m_id' i) v). +Proof. + intros hneq hrel i' v' H. + rewrite get_set_heap_neq. + 1: apply hrel; auto. + apply injective_translate_var2. + assumption. +Qed. + +(* empty stack/valid *) +Definition empty_stack stack h : Prop := forall i, get_heap h (translate_var stack i) = chCanonical _. + +Lemma coerce_to_choice_type_K : + ∀ (t : choice_type) (v : t), + coerce_to_choice_type t v = v. +Proof. + intros t v. + funelim (coerce_to_choice_type t v). + 2:{ clear - e. rewrite eqxx in e. discriminate. } + rewrite <- Heqcall. + apply cast_ct_val_K. +Qed. + +Lemma empty_stack_spec m_id : + forall h, empty_stack m_id h -> rel_vmap Vm.init m_id h. +Proof. + intros h emp i v hv. + rewrite coerce_to_choice_type_K. + rewrite Vm.initP in hv. + rewrite emp. + unfold translate_var. + destruct (vtype i); now inversion hv. +Qed. + +Definition valid (sid : p_id) (h : heap) := + forall i, sid ≺ i -> empty_stack i h. + +Lemma valid_prec : forall id1 id2 m, id1 ⪯ id2 -> valid id1 m -> valid id2 m. +Proof. + intros id1 id2 m hpre hvalid. + intros id' hprec. + apply hvalid. + eapply preceq_prec_trans; eauto. +Qed. + +Lemma valid_set_heap_disj m_id s_id i v h : + valid m_id h -> disj m_id s_id -> valid m_id (set_heap h (translate_var s_id i) v). +Proof. + intros hvalid hdisj s_id' hpre i'. + rewrite get_set_heap_neq. + 1: apply hvalid; assumption. + apply injective_translate_var2. + intros contra; subst. + eapply disj_antirefl. + eapply disj_prec_l. + 1: eapply hpre. + assumption. +Qed. + +Lemma valid_set_heap_prec m_id s_id i v h : + valid s_id h -> m_id ⪯ s_id -> valid s_id (set_heap h (translate_var m_id i) v). +Proof. + intros hvalid hpre s_id' hpre' i'. + rewrite get_set_heap_neq. + 1: apply hvalid; auto. + apply injective_translate_var2. + apply nesym. + apply prec_neq. + eapply preceq_prec_trans; eauto. +Qed. + +Hint Resolve valid_prec : prefix. + +(* stack *) +Definition stack_frame := (Vm.t (wsw := nosubword) (* TODO: nosubword or withsubword *) * p_id * p_id * list p_id)%type. + +Definition stack := list stack_frame. + +Definition stack_cons s_id (stf : stack_frame) : stack_frame := + (stf.1.1.1, stf.1.1.2, s_id, stf.1.2 :: stf.2). +Notation "s_id ⊔ stf" := (stack_cons s_id stf) (at level 60). + +Definition stf_disjoint m_id s_id s_st := disj m_id s_id /\ forall s_id', List.In s_id' s_st -> disj m_id s_id'. + +Definition valid_stack_frame '(vm, m_id, s_id, s_st) (h : heap) := + rel_vmap vm m_id h /\ + m_id ⪯ s_id /\ + valid s_id h /\ + ~ List.In s_id s_st /\ + List.NoDup s_st /\ + (forall s_id', List.In s_id' s_st -> valid s_id' h) /\ + (forall s_id', List.In s_id' s_st -> m_id ⪯ s_id') /\ + (forall s_id', List.In s_id' s_st -> disj s_id s_id') /\ + (forall s_id' s_id'', List.In s_id' s_st -> List.In s_id'' s_st -> s_id' <> s_id'' -> disj s_id' s_id''). + +Inductive valid_stack' : stack -> heap -> Prop := +| valid_stack'_nil : forall h, valid_stack' [::] h +| valid_stack'_cons : + forall h stf st, + valid_stack' st h -> + (forall stf' : stack_frame, List.In stf' st -> stf_disjoint stf.1.1.2 stf'.1.2 stf'.2) -> + valid_stack_frame stf h -> + valid_stack' (stf :: st) h. + +Inductive valid_stack : stack -> heap -> Prop := +| valid_stack_nil : forall h, valid_stack [::] h +| valid_stack_new : forall st vm m_id s_id h, + valid_stack st h -> + rel_vmap vm m_id h -> + m_id ⪯ s_id -> + valid s_id h -> + (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id') -> + valid_stack ((vm, m_id, s_id, [::]) :: st) h +| valid_stack_sub : forall st vm m_id s_id s_id' s_st h, + valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + m_id ⪯ s_id' -> + valid s_id' h -> + ~ List.In s_id' s_st -> + disj s_id s_id' -> + (forall s_id'', List.In s_id'' s_st -> disj s_id' s_id'') -> + valid_stack ((vm, m_id, s_id', s_id :: s_st) :: st) h. + +Lemma valid_stack_single vm m_id s_id s_st h : + valid_stack_frame (vm, m_id, s_id, s_st) h -> + valid_stack [::(vm, m_id, s_id, s_st)] h. +Proof. + revert s_id. + induction s_st; intros s_id [hrel [hpre1 [hvalid [hnin [hnodup [hvalid2 [hpre2 [hdisj1 hdisj2]]]]]]]]. + - constructor; auto. + + constructor. + - constructor; auto. + + eapply IHs_st; repeat split; auto. + * eapply hpre2; left; auto. + * eapply hvalid2; left; auto. + * inversion hnodup; auto. + * inversion hnodup; auto. + * intros s_id' s_in'. + apply hvalid2; right; auto. + * intros s_id' s_in'. + apply hpre2; right; auto. + * intros s_id' s_in'. + apply hdisj2. + ** left; auto. + ** right; auto. + ** inversion hnodup; subst. + intros contra; subst. + easy. + * intros s_id' s_id'' s_in' s_in'' s_neq. + apply hdisj2. + ** right; auto. + ** right; auto. + ** assumption. + + intros contra. + apply hnin. + right; auto. + + apply disj_sym. + apply hdisj1. + left; auto. + + intros s_id' s_in'. + apply hdisj1. + right; auto. +Qed. + +Lemma valid_stack_cons vm m_id s_id s_st st h : + valid_stack st h -> + (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id') -> + valid_stack_frame (vm, m_id, s_id, s_st) h -> + valid_stack ((vm, m_id, s_id, s_st) :: st) h. +Proof. + revert vm m_id s_id st h. + intros vm m_id s_id st h hvs hdisj1 [hrel [hpre1 [hvalid1 [hnin [hnodup [hvalid2 [hpre2 [hdisj2 hdisj3]]]]]]]]. + revert s_id hpre1 hvalid1 hnin hdisj2. induction s_st. + - constructor; auto. + - constructor; auto. + + eapply IHs_st. + * inversion hnodup; auto. + * intros s_id' s_in'. + apply hvalid2; right; auto. + * intros s_id' s_in'. + apply hpre2; right; auto. + * intros s_id' s_id'' s_in' s_in'' s_neq. + eapply hdisj3. + ** right; auto. + ** right; auto. + ** assumption. + * apply hpre2. + left; auto. + * apply hvalid2. + left; auto. + * inversion hnodup. + auto. + * + intros s_id' s_in'. + apply hdisj3. + ** left; auto. + ** right; auto. + ** inversion hnodup; subst. + intros contra; subst. + auto. + + intros contra. + apply hnin. + right; auto. + + apply disj_sym. + apply hdisj2. + left; auto. + + intros s_id' s_in'. + apply hdisj2. + right; auto. +Qed. + +Lemma valid_stack_valid_stack vm m_id s_id s_st st h : valid_stack ((vm, m_id, s_id, s_st) :: st) h -> valid_stack st h. +Proof. + revert vm m_id s_id. + induction s_st; intros. + - inversion H; assumption. + - inversion H. + eapply IHs_st. + eassumption. +Qed. + +Lemma valid_stack_rel_vmap vm m_id s_id s_st st h : valid_stack ((vm, m_id, s_id, s_st) :: st) h -> rel_vmap vm m_id h. +Proof. + revert vm m_id s_id. + induction s_st; intros. + - inversion H; assumption. + - inversion H. + eapply IHs_st. + eassumption. +Qed. + +Lemma valid_stack_disj vm m_id s_id s_st st h : + valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id'). + revert vm m_id s_id. + induction s_st; intros vm m_id s_id H. + - inversion H. + assumption. + - inversion H. + eapply IHs_st. + eassumption. +Qed. + +Ltac split_and := + repeat lazymatch goal with + | |- _ /\ _ => split + end. + +Lemma invert_valid_stack st vm m_id s_id s_st h : + valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + valid_stack st h + /\ (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id') + /\ valid_stack_frame (vm, m_id, s_id, s_st) h. +Proof. + intros H. unfold valid_stack_frame. + split_and; subst; auto. + - eapply valid_stack_valid_stack; eassumption. + - revert s_id H. + induction s_st. + + intros. + inversion H; subst. + eapply H10; eauto. + + intros s_id H stf. + inversion H; subst. + eapply IHs_st; eauto. + - eapply valid_stack_rel_vmap; eassumption. + - inversion H; auto. + - inversion H; auto. + - inversion H; subst; auto. + intros [contra|contra]; subst. + + eapply disj_antirefl; eauto. + + easy. + - revert s_id H. induction s_st. + + constructor. + + constructor. + * inversion H; subst; auto. + inversion H6; subst; auto. + intros [contra|contra]; subst. + ** eapply disj_antirefl; eauto. + ** eapply disj_antirefl. + eapply H17. + assumption. + * eapply IHs_st. + inversion H; eauto. + - revert s_id H. induction s_st. + + easy. + + intros s_id hvalid s_id' [|s_in']; subst. + * inversion hvalid; subst. + inversion H5; auto. + * eapply IHs_st. + ** inversion hvalid; eassumption. + ** assumption. + - revert s_id H. induction s_st. + + easy. + + intros s_id hvalid s_id' [|s_in']; subst. + * inversion hvalid; subst. + inversion H5; auto. + * eapply IHs_st. + ** inversion hvalid; eassumption. + ** assumption. + - inversion H; subst; auto. + + easy. + + intros s_id' [|s_in']; subst; auto. + inversion H; subst; auto. + apply disj_sym; auto. + - revert s_id H. induction s_st. + + easy. + + intros s_id hvalid s_id' s_id'' [|s_in'] [|s_in''] hneq; subst; auto. + * easy. + * inversion hvalid; subst; auto. + inversion H5; subst; auto. + ** easy. + ** destruct s_in'' as [|s_in'']; subst; auto. + apply disj_sym; auto. + * inversion hvalid; subst; auto. + inversion H5; subst; auto. + ** easy. + ** destruct s_in' as [|s_in']; subst; auto. + apply disj_sym; auto. + * inversion hvalid; subst. + eapply IHs_st; eauto. +Qed. + +Lemma valid_stack'_spec st h : + valid_stack' st h <-> valid_stack st h. +Proof. + split. + - intros. + induction st. + + constructor. + + inversion H; subst. + destruct a as [[[vm m_id] s_id] s_st]. + revert s_id H H3 H5. + induction s_st; intros; destruct H5 as [h1 [h2 [h3 [h4 [h5 [h6 [h7 [h8]]]]]]]]; auto. + * intros; constructor; auto; try easy. + * assert (valid_stack_frame (vm, m_id, a, s_st) h). + { repeat split; eauto. + { apply h7. left. auto. } + { apply h6; left; auto. } + { inversion h5; auto. } + { inversion h5; auto. } + { intros. eapply h6. right; auto. } + { intros; apply h7; right; auto. } + { intros. apply H0. 1: left; auto. + 1: right; auto. + inversion h5; subst. + intros contra; subst. auto. } + { intros. apply H0. 1: right; auto. + 1: right; auto. + auto. } } + constructor; auto. + ** apply IHs_st; auto. + constructor; auto. + ** intros contra. apply h4. right; auto. + ** apply disj_sym. eapply h8. + 1: left; auto. + ** intros. + apply h8. right; auto. + - intros. + induction st. + 1: constructor. + destruct a as [[[vm m_id] s_id] s_st]. + eapply invert_valid_stack in H as [H [H1]]. + constructor. + + apply IHst. easy. + + intros. + unfold stf_disjoint. + intros. + eapply H1. + easy. + + assumption. +Qed. + +Ltac invert_stack st hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2 := + apply invert_valid_stack in st as [hst [hdisj [hevm [hpre [hvalid [hnin [hnodup [hvalid1 [hpre1 [hdisj1 hdisj2]]]]]]]]]]. + +Lemma valid_stack_pop stf st : + ∀ h, valid_stack (stf :: st) h -> + valid_stack st h. +Proof. + intros h H. + destruct stf as [[[? ?] ?] ?]. + eapply valid_stack_valid_stack; eassumption. +Qed. + +Lemma valid_stack_push_sub vm m_id s_id s_st st : + ∀ h, valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + valid_stack ((vm, m_id, s_id~1, s_id~0 :: s_st) :: st) h. +Proof. + intros h vst. + invert_stack vst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + constructor; eauto with prefix. + - eapply valid_stack_cons; unfold valid_stack_frame; split_and; eauto with prefix. + + intros contra. + eapply disj_antirefl. + eapply disj_prec_l. + 1: eapply fresh1. + eapply hdisj1. + assumption. + + intros s_id' s_in'. + eapply disj_prec_l. + 1: eapply fresh1. + apply hdisj1. + assumption. + - intros contra. + eapply disj_antirefl. + eapply disj_prec_l. + 1: eapply fresh2. + eapply hdisj1. + assumption. + - apply fresh_disj. + - intros s_id' s_in'. + eapply disj_prec_l. + 1: eapply fresh2. + apply hdisj1. + assumption. +Qed. + +Lemma valid_stack_pop_sub vm m_id s_id s_id' s_st st : + ∀ h, valid_stack ((vm, m_id, s_id', s_id :: s_st) :: st) h -> + valid_stack ((vm, m_id, s_id, s_st) :: st) h. +Proof. + intros h vst. + inversion vst. + assumption. +Qed. + +Lemma valid_stack_push vm m_id s_id s_st st : + ∀ h, valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + valid_stack ((Vm.init, s_id~1, s_id~1, [::]) :: ((vm, m_id, s_id~0, s_st) :: st)) h. +Proof. + intros h vst. + assert (vst2:=vst). + invert_stack vst2 hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + eapply valid_stack_push_sub in vst. + eapply valid_stack_pop_sub in vst. + constructor; eauto with prefix. + - eapply empty_stack_spec. + eapply hvalid. + apply fresh2. + - intros stf [|stf_in]; subst; split. + + apply disj_sym. apply fresh_disj. + + intros s_id' s_in'. + eapply disj_prec_l. + 1: apply fresh2. + eapply hdisj1. + assumption. + + eapply disj_prec_l. + 1: etransitivity. + 1: eapply hpre. + 1: eapply fresh2. + eapply (proj1 (hdisj stf stf_in)). + + intros s_id' s_in'. + eapply disj_prec_l. + 1: etransitivity. + 1: eapply hpre. + 1: eapply fresh2. + eapply hdisj; eauto. +Qed. + +Lemma valid_stack_set_glob ptr sz (w : word sz) st m : + valid_stack st m -> + valid_stack st (set_heap m mem_loc (write_mem (get_heap m mem_loc) ptr w)). +Proof. + intros val. + induction val; auto. + - constructor; auto. + - constructor; auto. + + intros v hv ev. + rewrite get_set_heap_neq. + 2:{ rewrite eq_sym. apply mem_loc_translate_var_neq. } + apply H. assumption. + + intros i' hpre v. + rewrite get_set_heap_neq. + 2:{ rewrite eq_sym. apply mem_loc_translate_var_neq. } + apply H1. + assumption. + - constructor; auto. + intros i' hpre v. + rewrite get_set_heap_neq. + 2:{ rewrite eq_sym. apply mem_loc_translate_var_neq. } + apply H0. + assumption. +Qed. + +Lemma valid_stack_set_heap i v vm m_id s_id s_st st m : + valid_stack ((vm, m_id, s_id, s_st) :: st) m -> + valid_stack st (set_heap m (translate_var m_id i) v). +Proof. + intros vs. + invert_stack vs hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + induction hst as [ + |st vm' m_id' s_id' h hst IH hevm' hpre' hvalid' hdisj' + |st vm' m_id' s_id' s_id'' s_st' h hst IH hpre' hvalid' hnin' hdisj1' hdisj2']. + - constructor. + - constructor; auto. + + eapply IH; auto; simpl. + intros stf stf_in. + apply hdisj. + right; auto. + + apply rel_vmap_set_heap_neq; auto. + intros contra; subst. + eapply disj_antirefl. + eapply disj_prec_r. + 1: eapply hpre'. + apply disj_sym. + specialize (hdisj (vm', m_id, s_id', [::]) ltac:(left;auto)). + easy. + + apply valid_set_heap_disj; auto. + apply disj_sym. + specialize (hdisj (vm', m_id', s_id', [::]) ltac:(left;auto)). + easy. + - constructor; auto. + + eapply IH; auto. + intros stf [|stf_in]; subst; split. + * eapply hdisj. + 1: left; auto. + left; auto. + * intros s_id''' s_in'''. + eapply hdisj. + 1: left; auto. + right; auto. + * specialize (hdisj stf ltac:(right;auto)). + easy. + * intros s_id''' s_in'''. + eapply hdisj. + 1: right; eauto. + assumption. + + eapply valid_set_heap_disj; auto. + eapply disj_sym . + specialize (hdisj (vm', m_id', s_id'', s_id' :: s_st') ltac:(left;auto)). + easy. +Qed. + +Definition rel_estate (s : @estate (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd ; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |}) (m_id : p_id) (s_id : p_id) (s_st : list p_id) (st : stack) (h : heap) := + (rel_mem (s.(emem)) h /\ valid_stack ((s.(evm), m_id, s_id, s_st) :: st) h). + +Lemma translate_read_estate : + ∀ s ptr sz w m_id s_id s_st c_stack m, + rel_estate s m_id s_id s_st c_stack m → + read (emem s) ptr sz = ok w → + read_mem (get_heap m mem_loc) ptr sz = w. +Proof. + intros s ptr sz w m m_id s_id s_st c_stack rel h. + eapply translate_read. 2: eassumption. + apply rel. +Qed. + +Lemma translate_write_estate : + ∀ sz s cm ptr w m_id s_id s_st st m, + write s.(emem) ptr (sz := sz) w = ok cm → + rel_estate s m_id s_id s_st st m → + rel_estate {| escs := s.(escs) ; emem := cm ; evm := s.(evm) |} m_id s_id s_st st (set_heap m mem_loc (write_mem (get_heap m mem_loc) ptr w)). +Proof. + intros sz s cm ptr w m_id s_id s_st st m hw [hmem hstack]. + split. + - simpl. eapply translate_write_mem_correct. all: eassumption. + - simpl. + apply valid_stack_set_glob. + assumption. +Qed. + +Lemma coerce_cast_code (ty vty : choice_type) (v : vty) : + ret (coerce_to_choice_type ty v) = coerce_typed_code ty (vty ; ret v). +Proof. + simpl. + funelim (coerce_to_choice_type ty v) ; + funelim (coerce_typed_code t (tv ; ret v)). + - rewrite <- Heqcall, <- Heqcall0. + pose proof e as e'. symmetry in e'. + move: e' => /eqP e'. subst. + rewrite cast_ct_val_K. + rewrite cast_typed_code_K. reflexivity. + - simpl in *. congruence. + - simpl in *. congruence. + - rewrite <- Heqcall, <- Heqcall0. + reflexivity. +Qed. + +Lemma coerce_to_choice_type_neq : + ∀ (ty ty' : choice_type) (v : ty), + ty ≠ ty' → + coerce_to_choice_type ty' v = chCanonical _. +Proof. + intros ty ty' v ne. + funelim (coerce_to_choice_type ty' v). + 1:{ + clear - e ne. symmetry in e. move: e => /eqP e. simpl in e. contradiction. + } + symmetry. assumption. +Qed. + +Lemma coerce_to_choice_type_translate_value_to_val : + ∀ ty (v : sem_t ty), + coerce_to_choice_type (encode ty) (translate_value (to_val v)) = + embed v. +Proof. + intros ty v. + destruct ty. + all: simpl. all: rewrite coerce_to_choice_type_K. all: reflexivity. +Qed. + +Lemma totce_coerce t (tv : choice_type) (v : tv) : + t = tv → + totce (coerce_to_choice_type t v) = totce v. +Proof. + intro e. + rewrite e. rewrite coerce_to_choice_type_K. + reflexivity. +Qed. + +Lemma get_var_get_heap : + ∀ x (s : @estate (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |}) (v : value) m_id m, + get_var (true (* TODO: wdb *)) (evm s) x = ok v → + rel_vmap (evm s) m_id m → + get_heap m (translate_var m_id x) = + coerce_to_choice_type _ (translate_value v). +Proof. +(* intros x s v m c_stack ev hevm. *) +(* intros. *) +(* unfold get_var in ev. *) +(* rewrite (@hevm x v). *) +(* + simpl. *) +(* rewrite coerce_to_choice_type_K. *) +(* rewrite <- coerce_to_choice_type_translate_value_to_val. *) +(* reflexivity. *) +(* + destruct ((evm s).[x]) ; [ .. | discriminate ] ; now apply ok_inj in ev. *) +(* Qed. *) +Admitted. + +Lemma translate_get_var_correct : + ∀ x s (v : value) m_id s_id s_st st (cond : heap → Prop), + get_var (true (* TODO: wdb *)) (evm s) x = ok v → + (∀ m, cond m → rel_estate s m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + translate_get_var m_id x ⇓ coerce_to_choice_type _ (translate_value v) + ⦃ cond ⦄. +Proof. + intros x s v m_id s_id s_st st cond ev hcond. + unfold translate_get_var. + eapply u_get_remember. intros vx. + eapply u_ret. intros m [hm hx]. + split. 1: assumption. + unfold u_get in hx. subst. + eapply get_var_get_heap. + - eassumption. + - apply hcond in hm as [_ hst]. + invert_stack hst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. +Qed. + +Lemma translate_gvar_correct (x : gvar) (v : value) s (cond : heap → Prop) m_id s_id s_st st : + get_gvar (true (* TODO: wdb *)) gd (evm s) x = ok v → + (∀ m, cond m → rel_estate s m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + translate_gvar m_id x ⇓ coerce_to_choice_type _ (translate_value v) + ⦃ cond ⦄. +Proof. + intros ev hcond. + unfold translate_gvar. + unfold get_gvar in ev. + destruct is_lvar. + - epose (translate_get_var_correct (x.(gv))). + unfold to_val in e. + simpl in e. + + eapply translate_get_var_correct. all: eassumption. + - rewrite ev. + apply u_ret. intros m hm. + split. 1: assumption. + reflexivity. +Qed. + +Lemma translate_of_val : + ∀ ty v v', + of_val ty v = ok v' → + truncate_el ty (translate_value v) = + coerce_to_choice_type (encode ty) (translate_value (to_val v')). +Proof. + intros ty v v' e. + destruct ty, v. all: simpl in e. all: try discriminate. + all: try solve [ + lazymatch type of e with + | match ?t with _ => _ end = _ => destruct t ; discriminate + end + ]. + - noconf e. simpl. rewrite !coerce_to_choice_type_K. reflexivity. + - noconf e. simpl. rewrite !coerce_to_choice_type_K. reflexivity. + - simpl. rewrite !coerce_to_choice_type_K. + unfold WArray.cast in e. + destruct (p == len) in e. 2: discriminate. + noconf e. simpl. reflexivity. + - simpl. rewrite !coerce_to_choice_type_K. + rewrite e. reflexivity. +Qed. + +Lemma translate_truncate_val : + ∀ ty v v', + truncate_val ty v = ok v' → + truncate_el ty (translate_value v) = + coerce_to_choice_type (encode ty) (translate_value v'). +Proof. + intros ty v v' h. + unfold truncate_val in h. + jbind h vx e. noconf h. + apply translate_of_val. assumption. +Qed. + +Lemma totce_truncate_translate : + ∀ ty v v', + truncate_val ty v = ok v' → + totce (truncate_el ty (translate_value v)) = totce (translate_value v'). +Proof. + intros ty v v' h. + erewrite translate_truncate_val by eassumption. + apply totce_coerce. + unfold choice_type_of_val. + erewrite truncate_val_type by eassumption. + reflexivity. +Qed. + +Lemma bind_list_correct cond cs vs : + [seq c.π1 | c <- cs] = [seq choice_type_of_val v | v <- vs] → + List.Forall2 (λ c v, ⊢ ⦃ cond ⦄ c.π2 ⇓ coerce_to_choice_type _ (translate_value v) ⦃ cond ⦄) cs vs → + ⊢ ⦃ cond ⦄ bind_list cs ⇓ [seq to_typed_chElement (translate_value v) | v <- vs ] ⦃ cond ⦄. +Proof. + revert vs. + induction cs; intros. + - destruct vs. + 2: inversion H. + apply u_ret. + intros; auto. + - simpl. + destruct vs. + 1: inversion H0. + inversion H0; subst. + inversion H; subst. + eapply u_bind. + 1: eassumption. + eapply u_bind. + + apply IHcs; eassumption. + + apply u_ret. + intros; split; auto. + simpl. + rewrite H2. + rewrite coerce_to_choice_type_K. + reflexivity. +Qed. + +Lemma translate_truncate_word : + ∀ sz sz' (w : word sz) (w' : word sz'), + truncate_word sz' w = ok w' → + truncate_chWord sz' (@embed (sword _) w) = w'. +Proof. + intros sz sz' w w' h. + simpl. rewrite h. reflexivity. +Qed. + +Lemma translate_to_word : + ∀ sz v w, + to_word sz v = ok w → + truncate_chWord sz (translate_value v) = w. +Proof. + intros sz v w h. + destruct v as [| | | sz' w' | []]. all: try discriminate. + simpl in h. + unfold translate_value. + apply translate_truncate_word. assumption. +Qed. + +Lemma translate_to_bool : + ∀ v b, + to_bool v = ok b → + coerce_to_choice_type 'bool (translate_value v) = b. +Proof. + intros v b e. + destruct v as [| | | | t]. all: try discriminate. + 2:{ destruct t. all: discriminate. } + simpl in e. noconf e. + rewrite coerce_to_choice_type_K. reflexivity. +Qed. + +Lemma translate_to_int : + ∀ v z, + to_int v = ok z → + coerce_to_choice_type 'int (translate_value v) = z. +Proof. + intros v z e. + destruct v as [| | | | t]. all: try discriminate. + 2:{ destruct t. all: discriminate. } + simpl in e. noconf e. + rewrite coerce_to_choice_type_K. reflexivity. +Qed. + +Lemma translate_to_arr : + ∀ len v a, + to_arr len v = ok a → + coerce_to_choice_type 'array (translate_value v) = translate_value (Varr a). +Proof. + intros len v a e. + destruct v as [| | len' t' | |]. all: try discriminate. + simpl in e. unfold WArray.cast in e. + destruct (_ : bool) eqn:eb. 2: discriminate. + noconf e. simpl. + rewrite coerce_to_choice_type_K. reflexivity. +Qed. + +Lemma translate_truncate_code : + ∀ (c : typed_code) (ty : stype) v v' p q, + truncate_val ty v = ok v' → + c.π1 = choice_type_of_val v → + ⊢ ⦃ p ⦄ c.π2 ⇓ coerce_to_choice_type _ (translate_value v) ⦃ q ⦄ → + ⊢ ⦃ p ⦄ (truncate_code ty c).π2 ⇓ coerce_to_choice_type _ (translate_value v') ⦃ q ⦄. +Proof. + intros c ty v v' p q hv e h. + destruct c as [ty' c]. simpl in *. subst. + eapply u_bind. 1: eapply h. + eapply u_ret. intros m hm. + split. 1: assumption. + rewrite coerce_to_choice_type_K. + apply translate_truncate_val. assumption. +Qed. + +Lemma translate_pexpr_type p s₁ e v : + @sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s₁ e = ok v → + (translate_pexpr p e).π1 = choice_type_of_val v. +Proof. + intros. + revert v H. + destruct e; intros; simpl in *. + 1-3: noconf H; reflexivity. + - eapply type_of_get_gvar in H. + unfold choice_type_of_val. + apply (ssrbool.elimT eqP) in H. + now rewrite H. + - simpl in H. + jbind H x h1. + destruct x. all: try discriminate. + jbind H x h2. + jbind H y h3. + noconf H. + reflexivity. + - jbind H x h1. + destruct x. all: try discriminate. + jbind H x h2. + jbind H y h3. + noconf H. + reflexivity. + - jbind H x h1. + jbind H y h2. + jbind H z h3. + noconf H. + reflexivity. + - jbind H x h1. + jbind H y h2. + noconf H. + unfold choice_type_of_val. + rewrite type_of_to_val. + reflexivity. + - jbind H v1 h1. + jbind H v2 h2. + jbind H v3 h3. + jbind H v4 h4. + jbind H v5 h5. + noconf H. + unfold choice_type_of_val. + rewrite type_of_to_val. + reflexivity. + - jbind H v1 h1. + jbind H v2 h2. + noconf H. + unfold choice_type_of_val. + rewrite type_of_to_val. + reflexivity. + - jbind H v1 h1. + jbind H v2 h2. + jbind H v3 h3. + noconf H. + jbind h2 v4 h4. + jbind h3 v5 h5. + unfold choice_type_of_val. + destruct v1. + all: erewrite truncate_val_type. 1,3: reflexivity. 1,2: eassumption. +Qed. + +Lemma mapM_nil {eT aT bT} f l : + @mapM eT aT bT f l = ok [::] → + l = [::]. +Proof. + intro h. + induction l in h |- *. + - reflexivity. + - simpl in h. + jbind h y hy. jbind h ys hys. noconf h. +Qed. + +Lemma chArray_get_correct (len : BinNums.positive) (a : WArray.array len) (z : Z) ws aa s : + WArray.get aa ws a z = ok s → + chArray_get ws (translate_value (Varr a)) z (mk_scale aa ws) = translate_value (Vword s). +Proof. +Admitted. +(* intros H. *) +(* simpl. *) +(* unfold WArray.get, read in H. *) +(* destruct is_align. 2: discriminate. *) +(* cbn in H. *) +(* jbind H l E. noconf H. *) +(* unfold chArray_get. *) +(* f_equal. *) +(* revert l E. *) +(* apply ziota_ind. *) +(* - intros l E. noconf E. reflexivity. *) +(* - intros i l E IH l0 H. *) +(* destruct l0. *) +(* { apply mapM_nil in H. discriminate. } *) +(* apply mapM_cons in H as [H H0]. *) +(* simpl. *) +(* rewrite (IH l0). 2: assumption. *) +(* apply f_equal2. 2: reflexivity. *) +(* apply chArray_get8_correct. *) +(* assumption. *) +(* Qed. *) + +Lemma chArray_write_correct : + ∀ ws len (a : WArray.array len) i (w : word ws) t, + write (Pointer := WArray.PointerZ) a i w = ok t → + chArray_write (translate_value (Varr a)) i w = translate_value (Varr t). +Proof. + intros. + unfold write in H. + jbind H x Hx. + rewrite chArray_write_aux. + unfold chArray_write_foldl. + revert a H. + apply ziota_ind. + - intros. + simpl in *. + noconf H. + reflexivity. + - intros. + simpl in *. + jbind H1 y Hy. + apply chArray_set8_correct in Hy. + rewrite Hy. + eapply H0. + assumption. +Qed. + +Lemma chArray_get_sub_correct (lena len : BinNums.positive) a aa sz i t : + WArray.get_sub aa sz len a i = ok t → + chArray_get_sub sz len (translate_value (@Varr lena a)) i (mk_scale aa sz) = translate_value (Varr t). +Proof. + intros H. + unfold WArray.get_sub in H. + destruct (_ && _) eqn:E. 2: discriminate. + noconf H. + unfold chArray_get_sub. + unfold WArray.get_sub_data. + move: E => /andP []-> h2. + rewrite <- !foldl_rev. + apply ziota_ind. + - reflexivity. + - intros. + rewrite rev_cons. + rewrite !foldl_rcons. + rewrite H0. + rewrite fold_get. + destruct (Mz.get (WArray.arr_data a) (i * mk_scale aa sz + i0)%Z) eqn:E. + + rewrite E. + rewrite fold_set. + reflexivity. + + rewrite E. + rewrite fold_rem. + reflexivity. +Qed. + +Lemma chArray_set_sub_correct : + ∀ ws (lena len : BinNums.positive) a aa b p t, + @WArray.set_sub lena aa ws len a p b = ok t → + chArray_set_sub ws len aa (translate_value (Varr a)) p (translate_value (Varr b)) + = translate_value (Varr t). +Proof. + intros ws lena len a aa b p t e. + unfold WArray.set_sub in e. + destruct (_ : bool) eqn:eb. 2: discriminate. + noconf e. + unfold chArray_set_sub. unfold WArray.set_sub_data. + move: eb => /andP [e1 e2]. + rewrite <- !foldl_rev. + apply ziota_ind. + - reflexivity. + - intros i l hi ih. + rewrite rev_cons. + rewrite !foldl_rcons. + rewrite ih. + rewrite fold_get. + destruct Mz.get eqn:e. + + rewrite fold_set. + reflexivity. + + rewrite fold_rem. + reflexivity. +Qed. + +(* Like write_mem_get *) +Lemma chArray_write_get : + ∀ ws (a : 'array) (w : word ws) (i j : Z), + chArray_write a i w j = + if (0 <=? j - i)%Z && (j - i /eqP eb. subst. + unfold chArray_set8. + rewrite setmE. + replace (i + (j - i))%Z with j by micromega.Lia.lia. + rewrite eq_refl. + reflexivity. + + simpl. move: eb => /eqP eb. + rewrite setmE. + destruct (_ == _) eqn: e. + 1:{ move: e => /eqP e. subst. micromega.Lia.lia. } + apply ih. +Qed. + +Lemma embed_read8 : + ∀ len (a : WArray.array len) (z : Z) v, + read (Pointer := WArray.PointerZ) a z U8 = ok v → + chArray_get U8 (embed_array a) z 1 = translate_value (Vword v). +Proof. + intros len a z v h. + unfold read in h. jbind h _u hb. jbind h l hl. noconf h. + simpl in hl. jbind hl y hy. noconf hl. + unfold WArray.get8 in hy. jbind hy _u1 hb1. jbind hy _u2 hb2. noconf hy. + unfold odflt, oapp. rewrite <- embed_array_get. rewrite add_0. + simpl. + unfold chArray_get. simpl. + replace (z * 1 + 0)%Z with z by micromega.Lia.lia. + reflexivity. +Qed. + +Lemma chArray_set_correct : + ∀ ws len (a : WArray.array len) aa i (w : word ws) t, + WArray.set a aa i w = ok t → + chArray_set (translate_value (Varr a)) aa i w = translate_value (Varr t). +Proof. + intros ws len a aa i w t h. + unfold WArray.set in h. + unfold chArray_set. + apply chArray_write_correct. assumption. +Qed. + +Lemma sop1_unembed_embed op v : + sem_sop1_typed op (unembed (embed v)) = sem_sop1_typed op v. +Proof. + destruct op as [| | | | | | o]. 1-6: reflexivity. + destruct o. all: reflexivity. +Qed. + +Lemma sop2_unembed_embed op v1 v2 : + sem_sop2_typed op (unembed (embed v1)) (unembed (embed v2)) = + sem_sop2_typed op v1 v2. +Proof. + destruct op. + all: try reflexivity. + all: try destruct o. + all: try destruct c. + all: reflexivity. +Qed. + +Lemma translate_pexprs_types p s1 es vs : + mapM (@sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s1) es = ok vs → + [seq (translate_pexpr p e).π1 | e <- es] = [seq choice_type_of_val v | v <- vs]. +Proof. + revert vs. induction es; intros. + - destruct vs. 2: discriminate. + reflexivity. + - inversion H. + jbind H1 v Hv. + jbind H1 vs' Hvs'. + noconf H1. + simpl. + erewrite IHes by eassumption. + erewrite translate_pexpr_type by eassumption. + reflexivity. +Qed. + +(* jbind with fresh names *) +Ltac jbind_fresh h := + eapply rbindP ; [| exact h ] ; + let x := fresh in + let hx := fresh in + clear h ; intros x hx h ; + cbn beta in h. + +Lemma app_sopn_nil_ok_size {T} {of_T : forall t, T -> exec (sem_t t)} : + ∀ A ts (f : sem_prod ts (exec A)) vs v, + app_sopn of_T f vs = ok v → + size ts = size vs. +Proof. + intros A ts f vs v h. + induction ts as [| t ts ih] in f, vs, v, h |- *. + - destruct vs. 2: discriminate. + reflexivity. + - destruct vs as [| v' vs]. 1: discriminate. + simpl in *. + jbind h v1 hv. + f_equal. eapply ih. eassumption. +Qed. + +Definition WArray_ext_eq {len} (a b : WArray.array len) := + ∀ i, Mz.get a.(WArray.arr_data) i = Mz.get b.(WArray.arr_data) i. + +Notation "a =ₑ b" := (WArray_ext_eq a b) (at level 90). +Notation "(=ₑ)" := WArray_ext_eq (only parsing). + +#[export] Instance WArray_ext_eq_equiv {len} : Equivalence (@WArray_ext_eq len). +Proof. + split. + - intros x. + unfold WArray_ext_eq. + intros. + reflexivity. + - intros x y H. + unfold WArray_ext_eq. + intros. + rewrite H. + reflexivity. + - intros x y z H1 H2. + unfold WArray_ext_eq. + intros. + rewrite H1. + rewrite H2. + reflexivity. +Qed. + +Lemma embed_unembed {t} (a : encode t) : + embed (unembed a) = a. +Proof. + destruct t. 1,2,4: reflexivity. + apply eq_fmap. + intros x. + unfold embed, embed_array, unembed. + rewrite fold_get. + simpl in *. + destruct a. + cbn. + induction fmval; intros; simpl in *. + - rewrite Mz.get0. reflexivity. + - rewrite Mz.setP. + rewrite eq_sym. + destruct (_ == _)%B eqn:E. + + move: E => /eqP ->. + rewrite eq_refl. + reflexivity. + + destruct (@eq_op (BinNums_Z__canonical__Ord_Ord) _ _)%B eqn:E2. + { move: E2 E => /eqP ->. rewrite eq_refl. easy. } + apply IHfmval. + eapply path_sorted. + eassumption. +Qed. + +Lemma unembed_embed_sarr {len} (a : sem_t (sarr len)) : + unembed (embed a) =ₑ a. +Proof. + intros x. + rewrite <- embed_array_get. + change (embed_array (unembed (embed a))) with (embed (unembed (embed a))). + rewrite embed_unembed. + unfold embed, embed_array. + rewrite fold_get. + reflexivity. +Qed. + +Lemma unembed_embed t a : + match t as t0 return sem_t t0 -> Prop with + | sbool => λ a, unembed (embed a) = a + | sint => λ a, unembed (embed a) = a + | sarr p => λ a, unembed (embed a) =ₑ a + | sword s => λ a, unembed (embed a) = a + end a. +Proof. + destruct t. + - reflexivity. + - reflexivity. + - apply unembed_embed_sarr. + - reflexivity. +Qed. + +#[export] Instance unembed_embed_Proper {len} : Proper ((=ₑ) ==> (=ₑ)) (λ (a : sem_t (sarr len)), unembed (embed a)). +Proof. + intros x y H. + rewrite !(unembed_embed (sarr len)). + assumption. +Qed. + +#[export] Instance WArray_get8_Proper {len} : Proper ((=ₑ) ==> eq ==> eq) (@WArray.get8 len). + intros a b H ? ? Hi. + unfold WArray.get8, WArray.in_bound, WArray.is_init. + rewrite H Hi. + reflexivity. +Qed. + +#[export] Instance WArray_get_Proper {len ws} : Proper ((=ₑ) ==> eq ==> eq) (@WArray.get len AAscale ws). +Proof. + intros a b H i j Hij. + unfold WArray.get, read. + rewrite Hij. + destruct is_align. 2: reflexivity. + simpl. f_equal. Admitted. +(* apply eq_mapM. intros. *) +(* rewrite H. *) +(* reflexivity. *) +(* Qed. *) + +(* this should be moved to the jasmin repo *) +Lemma in_rcons_r {S : eqType} (a : S) l : + a \in rcons l a. +Proof. + induction l. + - apply mem_head. + - simpl. + rewrite in_cons IHl. + by apply /orP; right. +Qed. + +Lemma in_rcons_l {S : eqType} (a b : S) l : + a \in l → a \in rcons l b. +Proof. + induction l. + - easy. + - intros. + rewrite in_cons in H. + move: H => /orP []. + + move=> /eqP ->. + rewrite rcons_cons. + rewrite in_cons. + by apply /orP; left. + + move=> H. + rewrite rcons_cons. + rewrite in_cons. + apply /orP; right. + apply IHl; assumption. +Qed. + +Lemma foldM_rcons eT (aT: eqType) bT (f: aT → bT → result eT bT) (a:aT) (b:bT) (l:list aT) : + foldM f b (rcons l a) = Let b' := foldM f b l in f a b'. +Proof. + induction l as [| c l ih] in a, b |- *. + - simpl. destruct (f a b). all: reflexivity. + - simpl. + destruct (f c b). + + simpl. rewrite ih. reflexivity. + + reflexivity. +Qed. + +Lemma eq_foldM eT (aT: eqType) bT (f1 f2: aT → bT → result eT bT) (b:bT) (l:list aT) : + (∀ a b, a \in l → f1 a b = f2 a b) → + foldM f1 b l = foldM f2 b l. +Proof. + replace l with (rev (rev l)) by (apply revK). + set (l' := rev l). + induction l'; intros. + - reflexivity. + - rewrite rev_cons. + rewrite !foldM_rcons. + rewrite IHl'. + + destruct (foldM f2 b (rev l')). 2: reflexivity. + apply H. + rewrite rev_cons. + apply in_rcons_r. + + intros. apply H. + rewrite rev_cons. + apply in_rcons_l. + assumption. +Qed. + +#[export] Instance WArray_copy_Proper {ws p} : Proper ((=ₑ) ==> eq) (@WArray.copy ws p). +Proof. + intros a b H. + unfold WArray.copy, WArray.fcopy. + apply eq_foldM. + intros. + rewrite H. + reflexivity. +Qed. + +Lemma list_tuple_cons_cons {t1 t2 : stype} {ts : seq stype} (p : sem_tuple (t1 :: t2 :: ts)) : + list_ltuple p = (oto_val p.1) :: (list_ltuple (p.2 : sem_tuple (t2 :: ts))). +Proof. reflexivity. Qed. + +Lemma embed_tuple_cons_cons {t1 t2 : stype} {ts : seq stype} (p : sem_tuple (t1 :: t2 :: ts)) : + embed_tuple p = (embed_ot p.1, embed_tuple (p.2 : sem_tuple (t2 :: ts))). +Proof. reflexivity. Qed. + +Lemma list_lchtuple_cons_cons {t1 t2 : stype} {ts : seq stype} (p1 : encode t1) (p2 : lchtuple [seq encode t | t <- (t2 :: ts)]) : + list_lchtuple ((p1, p2) : lchtuple [seq encode t | t <- (t1 :: t2 :: ts)]) = (totce p1) :: (list_lchtuple p2). +Proof. reflexivity. Qed. + +Lemma app_sopn_cons {rT} t ts v vs sem : + @app_sopn _ of_val rT (t :: ts) sem (v :: vs) = + Let v' := of_val t v in @app_sopn _ of_val rT ts (sem v') vs. +Proof. reflexivity. Qed. + +Lemma sem_prod_cons t ts S : + sem_prod (t :: ts) S = (sem_t t → sem_prod ts S). +Proof. reflexivity. Qed. + +Inductive sem_correct {R} : ∀ (ts : seq stype), (sem_prod ts (exec R)) → Prop := +| sem_nil s : sem_correct [::] s +| sem_cons t ts s : (∀ v, (s (unembed (embed v)) = s v)) → (∀ v, sem_correct ts (s v)) → sem_correct (t :: ts) s. + +Lemma tr_app_sopn_correct {R S} (can : S) emb ts vs vs' (s : sem_prod ts (exec R)) : + sem_correct ts s → + app_sopn of_val s vs = ok vs' → + tr_app_sopn can emb ts s [seq to_typed_chElement (translate_value v) | v <- vs] + = emb vs'. +Proof. + intros hs H. + induction hs as [s | t ts s es hs ih] in vs, vs', H |- *. + - destruct vs. 2: discriminate. + simpl in *. subst. + reflexivity. + - simpl in *. + destruct vs as [| v₀ vs]. 1: discriminate. + jbind H v' hv'. + eapply ih in H. + simpl. + erewrite translate_of_val. 2: eassumption. + rewrite coerce_to_choice_type_translate_value_to_val. + rewrite es. + assumption. +Qed. + +Context `{asm_correct : ∀ o, sem_correct (tin (get_instr_desc (Oasm o))) (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ (Oasm o))}. + +Lemma app_sopn_list_tuple_correct o vs vs' : + app_sopn of_val (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ o) vs = ok vs' → + tr_app_sopn_tuple _ (sopn_sem o) [seq to_typed_chElement (translate_value v) | v <- vs] + = + embed_tuple vs'. +Proof using asm_correct. + intros. + unfold tr_app_sopn_tuple. + erewrite tr_app_sopn_correct. + - reflexivity. + - destruct o. + + destruct p ; [ repeat constructor ; + cbn -[wsize_size WArray.copy unembed embed truncate_el] in *; intros ; + rewrite (unembed_embed (sarr _)) ; + reflexivity | .. ] ; repeat constructor. + + destruct s ; try now repeat constructor. + * admit. + * admit. + + apply asm_correct. + - assumption. +Admitted. (* Qed. *) + +Lemma translate_exec_sopn_correct (o : sopn) (ins outs : values) : + @exec_sopn _ values {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} _ o ins = ok outs → + translate_exec_sopn o [seq totce (translate_value v) | v <- ins] = + [seq totce (translate_value v) | v <- outs]. +Proof using asm_correct. + intros H. + unfold translate_exec_sopn. + jbind H vs Hvs. + noconf H. + erewrite app_sopn_list_tuple_correct by eassumption. + clear Hvs. + induction tout. + - reflexivity. + - destruct l. + + destruct a; destruct vs; reflexivity. + + rewrite list_tuple_cons_cons. + rewrite embed_tuple_cons_cons. + rewrite list_lchtuple_cons_cons. + rewrite map_cons. + rewrite IHl. + f_equal. + destruct vs as [e es]. simpl. + destruct a. 2-4: reflexivity. + destruct e. all: reflexivity. +Qed. + +Lemma tr_app_sopn_single_correct (op : opN) (v : sem_t (type_of_opN op).2) (vs : values) : + app_sopn of_val (sem_opN_typed op) vs = ok v → + tr_app_sopn_single + (type_of_opN op).1 + (sem_opN_typed op) + [seq to_typed_chElement (translate_value v) | v <- vs] + = + embed v. +Proof. + intro H. + unfold tr_app_sopn_single. + destruct op as [w p | c]. + - simpl in *. + apply app_sopn_nil_ok_size in H as hl. + rewrite size_nseq in hl. rewrite hl. + rewrite hl in H. + set (f := curry _ _) in *. clearbody f. + induction vs as [| v' vs ih] in v, w, f, H |- *. + + simpl in *. rewrite H. reflexivity. + + simpl in *. jbind H v1 hv1. + eapply ih. eapply translate_to_int in hv1. + rewrite hv1. assumption. + - erewrite tr_app_sopn_correct. + + reflexivity. + + repeat constructor. + + assumption. +Qed. + +Lemma translate_pexpr_correct : + ∀ (e : pexpr) s₁ v (cond : heap → Prop) m_id s_id s_st st, + (@sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s₁ e) = ok v → + (∀ m, cond m → rel_estate s₁ m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + (translate_pexpr m_id e).π2 ⇓ + coerce_to_choice_type _ (translate_value v) + ⦃ cond ⦄. +Proof. + intros e s1 v cond m_id s_id s_st st h1 hcond. + induction e as [z|b| |x|aa ws x e| | | | | | ] in s1, v, h1, cond, hcond |- *. + - simpl in h1. noconf h1. + rewrite coerce_to_choice_type_K. + apply u_ret_eq. auto. + - simpl in h1. noconf h1. + rewrite coerce_to_choice_type_K. + apply u_ret_eq. auto. + - simpl in h1. noconf h1. + rewrite coerce_to_choice_type_K. + apply u_ret_eq. auto. + - simpl in h1. + apply type_of_get_gvar in h1 as es. + unfold translate_pexpr. + unfold translate_gvar. unfold translate_var. + unfold get_gvar in h1. + destruct is_lvar eqn:hlvar. + + destruct x as [gx gs]. simpl in *. + unfold is_lvar in hlvar. simpl in hlvar. move: hlvar => /eqP hlvar. subst. + unfold get_var in h1. + admit. + (* 2:{ destruct e. all: discriminate. } *) + (* noconf h1. *) + (* eapply u_get_remember. simpl. *) + (* intro v. apply u_ret. *) + (* intros m [hm e]. unfold u_get in e. subst. *) + (* split. 1: assumption. *) + (* apply hcond in hm. *) + (* destruct hm as [hm hst]. *) + (* invert_stack hst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. *) + (* apply hevm in e1. rewrite e1. *) + (* simpl. rewrite coerce_to_choice_type_K. *) + (* rewrite coerce_to_choice_type_translate_value_to_val. *) + (* reflexivity. *) + + simpl. + rewrite h1. + apply u_ret. auto. + - simpl in *. + jbind h1 nt ent. destruct nt. all: try discriminate. + jbind h1 j ej. jbind ej j' ej'. + jbind h1 w ew. noconf h1. + rewrite coerce_to_choice_type_K. + eapply u_bind. + + eapply translate_gvar_correct. all: eassumption. + + rewrite !bind_assoc. + eapply u_bind. + * eapply IHe. all: eassumption. + * eapply u_ret. + intros m hm. + split. 1: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + eapply type_of_get_gvar in ent as ety. admit. (* rewrite <- ety. *) + (* rewrite !coerce_to_choice_type_K. *) + (* erewrite translate_to_int. 2: eassumption. *) + (* apply chArray_get_correct. assumption. *) + - (* Psub *) + simpl. simpl in h1. + jbind h1 nt hnt. destruct nt. all: try discriminate. + jbind h1 j hj. jbind hj j' hj'. jbind h1 t ht. noconf h1. + eapply u_bind. + 1:{ eapply translate_gvar_correct. all: eauto. } + rewrite bind_assoc. + eapply u_bind. + 1:{ eapply IHe. all: eauto. } + eapply u_ret. intros m hm. + split. 1: assumption. + rewrite coerce_to_choice_type_K. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + erewrite translate_to_int. 2: eassumption. + apply type_of_get_gvar in hnt. admit. (* rewrite <- hnt. *) + (* rewrite !coerce_to_choice_type_K. *) + (* apply chArray_get_sub_correct. *) + (* assumption. *) + - (* Pload *) + simpl in h1. jbind h1 w1 hw1. jbind hw1 vx hvx. + jbind h1 w2 hw2. jbind hw2 v2 hv2. jbind h1 w hw. noconf h1. + simpl. + eapply u_get_remember. simpl. intros x'. + rewrite bind_assoc. + eapply u_bind. + 1:{ + eapply IHe. 1: eassumption. + intros ? []. eauto. + } + simpl. + eapply u_get_remember. intros mem. + eapply u_ret. unfold u_get. intros m [[hm e1] e2]. + split. 1: assumption. + subst. + rewrite coerce_to_choice_type_K. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + erewrite translate_to_word. 2: eassumption. + eapply hcond in hm. + assert (hm2:=hm). + destruct hm2 as [hm2 hst]. + invert_stack hst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + erewrite get_var_get_heap. 2-3: eassumption. + simpl. admit. (* erewrite <- type_of_get_var. 2: eassumption. *) + (* rewrite coerce_to_choice_type_K. *) + (* eapply translate_to_word in hw1 as e1. rewrite e1. clear e1. *) + (* eapply translate_read_estate. all: eassumption. *) + - (* Papp1 *) + simpl in *. + jbind h1 v' h2. + rewrite bind_assoc. simpl. + eapply u_bind. + + eapply IHe; eauto. + + apply u_ret. + intros. + split. 1: assumption. + unfold sem_sop1 in h1. + jbind h1 v'' h3. + noconf h1. + rewrite coerce_to_choice_type_translate_value_to_val. + apply translate_pexpr_type with (p:=m_id) in h2. + rewrite h2. + rewrite !coerce_to_choice_type_K. + erewrite translate_of_val. + 2: exact h3. + rewrite coerce_to_choice_type_translate_value_to_val. + f_equal. + apply sop1_unembed_embed. + - (* Papp2 *) + simpl in *. + jbind h1 v' h2. + jbind h1 v'' h3. + rewrite bind_assoc. simpl. + eapply u_bind. + 1: eapply IHe1; eauto. + rewrite bind_assoc. simpl. + eapply u_bind. + 1: eapply IHe2; eauto. + apply u_ret. + intuition subst. + unfold sem_sop2 in h1. + jbind h1 v''' h4. + jbind h1 v'''' h5. + jbind h1 v''''' h6. + noconf h1. + rewrite coerce_to_choice_type_translate_value_to_val. + apply translate_pexpr_type with (p:=m_id) in h2. + apply translate_pexpr_type with (p:=m_id) in h3. + rewrite h2 h3. + rewrite !coerce_to_choice_type_K. + erewrite translate_of_val. + 2: exact h4. + erewrite translate_of_val. + 2: exact h5. + rewrite coerce_to_choice_type_translate_value_to_val. + rewrite coerce_to_choice_type_translate_value_to_val. + rewrite sop2_unembed_embed. + rewrite h6. + reflexivity. + - (* PappN *) + simpl in *. + jbind h1 v' h2. + jbind h1 v'' h3. + noconf h1. + (* jbind h3 v''' h4. *) + eapply u_bind. + + eapply bind_list_correct with (vs := v'). + * rewrite <- map_comp. + unfold comp. + eapply translate_pexprs_types. + eassumption. + * { + clear -h2 H hcond. + revert v' h2 H. + induction es; intros. + - inversion h2. + constructor. + - inversion h2. + jbind H1 x Hx. + jbind H1 y Hy. + noconf H1. + constructor. + + eapply H. + 1: now constructor. + 1: eassumption. + assumption. + + eapply IHes. + 1: assumption. + intros. + eapply H. + { apply List.in_cons. assumption. } + 1: eassumption. + assumption. + } + + apply u_ret. + intros; split; auto. + rewrite coerce_to_choice_type_translate_value_to_val. + apply tr_app_sopn_single_correct. + assumption. + - (* Pif *) + simpl in h1. jbind h1 b eb. jbind eb b' eb'. + jbind h1 v1 ev1. jbind ev1 v1' ev1'. + jbind h1 v2 ev2. jbind ev2 v2' ev2'. + noconf h1. + simpl. rewrite bind_assoc. + eapply u_bind. + 1:{ eapply IHe1. all: eauto. } + simpl. erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + erewrite translate_to_bool. 2: eassumption. + destruct b. + + eapply u_bind. + 1:{ eapply IHe2. all: eauto. } + simpl. eapply u_ret. intros m hm. + split. 1: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + apply translate_truncate_val. assumption. + + eapply u_bind. + 1:{ eapply IHe3. all: eauto. } + simpl. eapply u_ret. intros m hm. + split. 1: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + apply translate_truncate_val. assumption. +Admitted. (* Qed. *) + +Lemma translate_pexprs_correct s m_id s_id s_st st vs es : + @sem_pexprs (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s es = ok vs → + List.Forall2 (λ c v, + ⊢ ⦃ rel_estate s m_id s_id s_st st ⦄ + c.π2 + ⇓ coerce_to_choice_type _ (translate_value v) + ⦃ rel_estate s m_id s_id s_st st ⦄ + ) [seq translate_pexpr m_id e | e <- es] vs. +Proof. + intro hvs. + induction es in vs, hvs |- *. + - destruct vs. + + constructor. + + inversion hvs. + - destruct vs. + + simpl in hvs. + jbind hvs vs' hvs'. + jbind hvs vs'' hvs''. + noconf hvs. + + simpl in hvs. + jbind hvs vs' hvs'. + jbind hvs vs'' hvs''. + noconf hvs. + rewrite map_cons. + constructor. + * eapply translate_pexpr_correct. 1: eassumption. + eauto. + * eapply IHes. + assumption. +Qed. + +Corollary bind_list_pexpr_correct + (cond : heap → Prop) (es : pexprs) (vs : list value) + (s1 : estate) m_id s_id s_st st + (hc : ∀ m : heap, cond m → rel_estate s1 m_id s_id s_st st m) + (h : @sem_pexprs (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s1 es = ok vs) : + ⊢ ⦃ cond ⦄ + bind_list [seq translate_pexpr m_id e | e <- es] ⇓ + [seq totce (translate_value v) | v <- vs] + ⦃ cond ⦄. +Proof. + eapply bind_list_correct with (vs := vs). + - rewrite <- map_comp. + unfold comp. + eapply translate_pexprs_types. + exact h. + - revert vs h. + induction es; intros. + + inversion h. + constructor. + + inversion h as [H1]. + jbind H1 x Hx. + jbind H1 y Hy. + noconf H1. + constructor. + * eapply translate_pexpr_correct. + all: eassumption. + * simpl. eapply IHes. + assumption. +Qed. + +Corollary translate_pexpr_correct_cast : + ∀ (e : pexpr) s₁ v m_id s_id s_st st (cond : heap → Prop), + @sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s₁ e = ok v → + (∀ m, cond m → rel_estate s₁ m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + coerce_typed_code _ (translate_pexpr m_id e) ⇓ + translate_value v + ⦃ cond ⦄. +Proof. + intros e s v m_id s_id s_st st cond he hcond. + eapply translate_pexpr_correct in he as h. 2: exact hcond. + eapply translate_pexpr_type with (p := m_id) in he. + unfold choice_type_of_val in he. + destruct (translate_pexpr) as [? exp] eqn:?. simpl in *. subst. + rewrite coerce_to_choice_type_K in h. + rewrite coerce_typed_code_K. assumption. +Qed. + + +Lemma translate_write_correct : + ∀ sz s ptr (w : word sz) cm m_id s_id s_st st (cond : heap → Prop), + (∀ m, cond m → write s.(emem) ptr w = ok cm ∧ rel_estate s m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ translate_write ptr w ⇓ tt ⦃ rel_estate {| escs := s.(escs) ; emem := cm ; evm := s.(evm) |} m_id s_id s_st st ⦄. +Proof. + intros sz s ptr w cm m_id s_id s_st st cond h. + unfold translate_write. + eapply u_get_remember. intros m. + eapply u_put. + eapply u_ret_eq. + intros ? [m' [[h1 h2] ?]]. subst. + unfold u_get in h2. subst. + eapply h in h1. destruct h1. + eapply translate_write_estate. all: assumption. +Qed. + +Lemma valid_stack_set_var i v vm (s : @estate (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |}) m_id s_id s_st st m : + valid_stack ((s.(evm), m_id, s_id, s_st) :: st) m -> + set_var (true (* TODO: wdb *)) (evm s) i v = ok vm -> + valid_stack ((vm, m_id, s_id, s_st) :: st) (set_heap m (translate_var m_id i) (truncate_el (vtype i) (translate_value v))). +Proof. + intros vs hsv. + assert (vs':=vs). + invert_stack vs hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + admit. +(* eapply set_varP. 3: exact hsv. *) +(* - intros v1 hv1 eyl; subst. *) +(* eapply valid_stack_cons; unfold valid_stack_frame; split_and; eauto. *) +(* + eapply valid_stack_set_heap. *) +(* eassumption. *) +(* + intros vi vt ev. *) +(* destruct (vi == i) eqn:evar. *) +(* all: move: evar => /eqP evar. *) +(* * subst. rewrite Fv.setP_eq in ev. noconf ev. *) +(* rewrite get_set_heap_eq. rewrite coerce_to_choice_type_K. *) +(* eapply translate_of_val in hv1 as e. *) +(* rewrite e. apply coerce_to_choice_type_translate_value_to_val. *) +(* * rewrite Fv.setP_neq in ev. *) +(* 2:{ apply /eqP. eauto. } *) +(* rewrite get_set_heap_neq. *) +(* 2:{ *) +(* apply /eqP. intro ee. *) +(* apply injective_translate_var in ee. *) +(* contradiction. *) +(* } *) +(* eapply hevm in ev. assumption. *) +(* + eapply valid_set_heap_prec; auto. *) +(* + intros s_id' s_in'. *) +(* eapply valid_set_heap_prec. *) +(* 1: apply hvalid1; auto. *) +(* apply hpre1. assumption. *) +(* - intros hbo hyl hset; subst. *) +(* eapply valid_stack_cons; unfold valid_stack_frame; split_and; auto. *) +(* + eapply valid_stack_set_heap. *) +(* eassumption. *) +(* + intros vi vt ev. *) +(* destruct (vi == i) eqn:evar. *) +(* all: move: evar => /eqP evar. *) +(* 1:{ *) +(* exfalso. subst. rewrite Fv.setP_eq in ev. *) +(* clear - ev hbo. destruct (vtype i). all: discriminate. *) +(* } *) +(* rewrite Fv.setP_neq in ev. *) +(* 2:{ apply /eqP. eauto. } *) +(* rewrite get_set_heap_neq. *) +(* 2:{ *) +(* apply /eqP. intro ee. *) +(* apply injective_translate_var in ee. *) +(* contradiction. *) +(* } *) +(* eapply hevm in ev. assumption. *) +(* + eapply valid_set_heap_prec; auto. *) +(* + intros s_id' s_in'. *) +(* eapply valid_set_heap_prec. *) +(* 1: apply hvalid1; auto. *) +(* apply hpre1. assumption. *) +(* Qed. *) +Admitted. + +Lemma translate_write_var_estate : + ∀ i v s1 s2 m_id s_id s_st st m, + write_var (true (* TODO: wdb *)) i v s1 = ok s2 → + rel_estate s1 m_id s_id s_st st m → + rel_estate s2 m_id s_id s_st st (set_heap m (translate_var m_id i) (truncate_el i.(vtype) (translate_value v))). +Proof using asm_correct gd. + intros i v s1 s2 m_id s_id s_st st m hw [hmem hst]. + unfold write_var in hw. jbind hw vm hvm. noconf hw. + all: simpl. + split. + - intros ptr v' er. + eapply hmem in er. + rewrite get_set_heap_neq. 2: apply mem_loc_translate_var_neq. + assumption. + - eapply valid_stack_set_var; eauto. +Qed. + +Lemma translate_write_var_correct : + ∀ es₁ es₂ m_id s_id s_st st y v, + write_var (true (* TODO: wdb *)) y v es₁ = ok es₂ → + ⊢ ⦃ rel_estate es₁ m_id s_id s_st st ⦄ + translate_write_var m_id y (totce (translate_value v)) + ⇓ tt + ⦃ rel_estate es₂ m_id s_id s_st st ⦄. +Proof using asm_correct gd. + intros es₁ es₂ m_id s_id s_st st y v hw. + simpl. unfold translate_write_var. simpl in hw. + simpl. + eapply u_put. + apply u_ret_eq. + intros m' [m [hm e]]. subst. + eapply translate_write_var_estate. all: eassumption. +Qed. + +Lemma translate_write_lval_correct : + ∀ es₁ es₂ m_id s_id s_st st y v, + @write_lval (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd y v es₁ = ok es₂ → + ⊢ ⦃ rel_estate es₁ m_id s_id s_st st ⦄ + translate_write_lval m_id y (totce (translate_value v)) + ⇓ tt + ⦃ rel_estate es₂ m_id s_id s_st st ⦄. +Proof using asm_correct. + intros es₁ es₂ m_id s_id s_st st y v hw. + destruct y as [ | yl | | aa ws x ei | ] eqn:case_lval. + - simpl. apply u_ret_eq. + intros hp hr. + simpl in hw. unfold write_none in hw. + admit. + (* destruct is_sbool eqn:eb. *) + (* + unfold on_vu in hw. destruct of_val as [| []]. *) + (* all: noconf hw. all: assumption. *) + (* + unfold on_vu in hw. destruct of_val as [| []]. *) + (* all: noconf hw. assumption. *) + - now eapply translate_write_var_correct. + - simpl. simpl in hw. + jbind hw vx hvx. jbind hvx vx' hvx'. jbind hw ve hve. + jbind hve ve' hve'. jbind hw w hw'. jbind hw m hm. + noconf hw. + eapply u_get_remember. intros tv. + eapply u_bind. + 1:{ + eapply translate_pexpr_correct. + - eassumption. + - intros ? []. eassumption. + } + simpl. + eapply translate_write_correct. intros m' [hm' em']. + unfold u_get in em'. subst. + split. 2: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite !coerce_to_choice_type_K. + eapply translate_to_word in hw' as ew. rewrite ew. clear ew. + unfold translate_to_pointer. simpl. + eapply translate_to_word in hve as ew. rewrite ew. clear ew. + erewrite get_var_get_heap. + 3: eapply invert_valid_stack; apply hm'. + 2: eassumption. + simpl. admit. (* erewrite <- type_of_get_var. 2: eassumption. *) + (* rewrite coerce_to_choice_type_K. *) + (* eapply translate_to_word in hvx as ew. rewrite ew. clear ew. *) + (* assumption. *) + - simpl. simpl in hw. + jbind hw nt hnt. destruct nt. all: try discriminate. + jbind hw i hi. jbind hi i' hi'. + jbind hw w ew. jbind hw t ht. + eapply u_get_remember. simpl. intros vx. + rewrite !bind_assoc. simpl. + eapply u_bind. + 1:{ + eapply translate_pexpr_correct. + - eassumption. + - intros ? []. eassumption. + } + simpl. unfold translate_write_var. simpl. + eapply u_put. + eapply u_ret_eq. + intros ? [m [[hs hm] ?]]. subst. + unfold u_get in hm. subst. + erewrite translate_pexpr_type. 2: eassumption. + rewrite !coerce_to_choice_type_K. + eapply translate_to_word in ew. rewrite ew. + erewrite translate_to_int. 2: eassumption. + erewrite get_var_get_heap. + 3: eapply invert_valid_stack; apply hs. + 2: eassumption. + Opaque translate_value. simpl. Transparent translate_value. + eapply type_of_get_var in hnt as ety. simpl in ety. + admit. + (* apply (f_equal encode) in ety. simpl in ety. *) + (* rewrite -ety. rewrite !coerce_to_choice_type_K. *) + (* erewrite chArray_set_correct. 2: eassumption. *) + (* eapply translate_write_var_estate in hs. *) + (* 2: eassumption. *) + (* assumption. *) + - simpl. simpl in hw. + jbind hw nt hnt. destruct nt. all: try discriminate. + jbind hw i hi. jbind hi i' hi'. + jbind hw t' ht'. jbind hw t ht. + eapply u_get_remember. simpl. intros vx. + rewrite !bind_assoc. simpl. + eapply u_bind. + 1:{ + eapply translate_pexpr_correct. + - eassumption. + - intros ? []. eassumption. + } + unfold translate_write_var. simpl. + eapply u_put. + eapply u_ret_eq. + intros ? [m [[hs hm] ?]]. subst. + unfold u_get in hm. subst. + erewrite translate_pexpr_type. 2: eassumption. + rewrite !coerce_to_choice_type_K. + erewrite translate_to_int. 2: eassumption. + erewrite translate_to_arr. 2: eassumption. + erewrite get_var_get_heap. + 3: eapply invert_valid_stack; apply hs. + 2: eassumption. + Opaque translate_value. simpl. Transparent translate_value. + eapply type_of_get_var in hnt as ety. simpl in ety. + admit. + (* apply (f_equal encode) in ety. simpl in ety. *) + (* rewrite -ety. rewrite !coerce_to_choice_type_K. *) + (* erewrite chArray_set_sub_correct. 2: eassumption. *) + (* eapply translate_write_var_estate in hs. *) + (* 2: eassumption. *) + (* assumption. *) +Admitted. (* Qed. *) + +Lemma translate_write_lvals_cons p l ls v vs : + translate_write_lvals p (l :: ls) (v :: vs) = (translate_write_lval p l v ;; translate_write_lvals p ls vs). +Proof. reflexivity. Qed. + +Lemma translate_write_lvals_correct m_id s_id s_st st s1 ls vs s2 : + @write_lvals (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s1 ls vs = ok s2 → + ⊢ ⦃ rel_estate s1 m_id s_id s_st st ⦄ + translate_write_lvals m_id ls [seq totce (translate_value v) | v <- vs] + ⇓ tt + ⦃ rel_estate s2 m_id s_id s_st st ⦄. +Proof using asm_correct. + intros h. + induction ls as [| l ls] in s1, vs, h |- *. + - destruct vs. 2: discriminate. + noconf h. + apply u_ret_eq. auto. + - destruct vs. 1: noconf h. + simpl in h. + jbind h s3 Hs3. + rewrite map_cons. + rewrite translate_write_lvals_cons. + eapply u_bind. + + eapply translate_write_lval_correct. + all: eassumption. + + apply IHls. + assumption. +Qed. + +Lemma translate_write_vars_cons p l ls v vs : + translate_write_vars p (l :: ls) (v :: vs) = + (translate_write_var p l v ;; translate_write_vars p ls vs). +Proof. + reflexivity. +Qed. + +Lemma translate_write_vars_correct m_id s_id s_st st s1 ls vs s2 : + write_vars (true (* TODO: wdb *)) ls vs s1 = ok s2 → + ⊢ ⦃ rel_estate s1 m_id s_id s_st st ⦄ + translate_write_vars m_id ls [seq totce (translate_value v) | v <- vs] + ⇓ tt + ⦃ rel_estate s2 m_id s_id s_st st ⦄. +Proof using asm_correct gd. + intros h. + induction ls as [| l ls] in s1, vs, h |- *. + - destruct vs. 2: discriminate. + noconf h. + apply u_ret_eq. auto. + - destruct vs. 1: noconf h. + simpl in h. + jbind h s3 Hs3. + rewrite map_cons. + rewrite translate_write_vars_cons. + eapply u_bind. + + simpl. + eapply translate_write_var_correct. + all: eassumption. + + apply IHls. + assumption. +Qed. + +End Translation. + +Section Translation. + +Context `{asmop : asmOp}. + +Context {pd : PointerData}. +Context {fcp : FlagCombinationParams}. + +Context (P : uprog). + +Definition instr_d (i : instr) : instr_r := + match i with MkI _ i => i end. + +Definition trunc_list := + (λ tys (vs : seq typed_chElement), + [seq let '(ty, v) := ty_v in totce (truncate_el ty v.π2) | ty_v <- zip tys vs]). + +(* The type of translated function *bodies* *) +Definition fdefs := + (* ∀ p fdef, get_fundef (p_funcs P) p = Some fdef → raw_code 'unit. *) + list (funname * (p_id -> raw_code 'unit)). + +Definition tchlist := [choiceType of seq typed_chElement]. + +(* The type of translated function "calls" *) +Definition trfun := + p_id -> tchlist → raw_code tchlist. + +Definition translate_call_body + (fn : funname) (tr_f_body : p_id -> raw_code 'unit) : trfun. +Proof using P asm_op asmop pd. + (* sem_call *) + refine (λ sid vargs', + match (get_fundef (p_funcs P) fn) with + | Some f => _ + | None => ret [::] end). + pose (trunc_list (f_tyin f) vargs') as vargs. + apply (bind (translate_write_vars sid (f_params f) vargs)) => _. + (* Perform the function body. *) + apply (bind (tr_f_body sid)) => _. + eapply bind. + - (* Look up the results in their locations... *) + exact (bind_list [seq totc _ (translate_get_var sid (v_var x)) + | x <- f_res f]). + - intros vres. + (* ...and coerce them to the codomain of f. *) + pose (trunc_list (f_tyout f) vres) as vres'. + exact (ret vres'). +Defined. + +Definition translate_call (fn : funname) (tr_f_body : fdefs) : trfun. +Proof using P asm_op asmop pd. + refine (λ sid vargs, match assoc tr_f_body fn with + | Some tr_f => _ | None => ret [::] end). + exact (translate_call_body fn tr_f sid vargs). +Defined. + +Fixpoint translate_instr_r + (tr_f_body : fdefs) + (i : instr_r) (m_id : p_id) (s_id : p_id) {struct i} + : p_id * raw_code 'unit + +with translate_instr (tr_f_body : fdefs) + (i : instr) (m_id : p_id) (s_id : p_id) {struct i} : p_id * raw_code 'unit := + translate_instr_r tr_f_body (instr_d i) m_id s_id. +Proof using P asm_op asmop pd fcp. + pose proof (translate_cmd := + (fix translate_cmd (tr_f_body : fdefs) (c : cmd) (m_id : p_id) (s_id : p_id) : p_id * raw_code 'unit := + match c with + | [::] => (s_id, ret tt) + | i :: c => + let (s_id', i') := translate_instr tr_f_body i m_id s_id in + let (s_id'', c') := translate_cmd tr_f_body c m_id s_id' in + (s_id'', i' ;; c') + end + ) + ). + refine + match i with + | Cassgn l _ s e => + let tr_p := translate_pexpr (p_globs P) m_id e in + (s_id, + v ← tr_p.π2 ;; + (translate_write_lval (p_globs P) m_id l (totce (truncate_el s v))) + ) + | Copn ls _ o es => + let cs := [seq (translate_pexpr (p_globs P) m_id e) | e <- es] in + let vs := bind_list cs in + + (s_id, + bvs ← vs ;; + translate_write_lvals (p_globs P) m_id ls (translate_exec_sopn o bvs) + ) + | Cif e c1 c2 => + let (s_id', c1') := translate_cmd tr_f_body c1 m_id s_id in + let (s_id'', c2') := translate_cmd tr_f_body c2 m_id s_id' in + let e' := translate_pexpr (p_globs P) m_id e in + let rb := coerce_typed_code 'bool e' in + (s_id'', + b ← rb ;; if b then c1' else c2' + ) + | Cfor i r c => + let '(d, lo, hi) := r in + let (s_id', fresh) := fresh_id s_id in + let loᵗ := coerce_typed_code 'int (translate_pexpr (p_globs P) m_id lo) in + let hiᵗ := coerce_typed_code 'int (translate_pexpr (p_globs P) m_id hi) in + let cᵗ := translate_cmd tr_f_body c m_id in + (s_id', + vlo ← loᵗ ;; + vhi ← hiᵗ ;; + translate_for i (wrange d vlo vhi) m_id cᵗ fresh) + | Ccall (* ii *) xs f args => + let (s_id', fresh) := fresh_id s_id in + let cs := [seq (translate_pexpr (p_globs P) m_id e) | e <- args] in + (s_id', + vargs ← bind_list cs ;; + vres ← translate_call f tr_f_body fresh vargs ;; + translate_write_lvals (p_globs P) m_id xs vres + ) + | _ => (s_id, unsupported.π2) + end. +Defined. + +(* translate_instr is blocked because it is a fixpoint *) +Lemma translate_instr_unfold : + ∀ ep i st, + translate_instr ep i st = translate_instr_r ep (instr_d i) st. +Proof. + intros ep i st. + destruct i. reflexivity. +Qed. + +(* Trick to have it expand to the same as the translate_cmd above *) +Section TranslateCMD. + +Fixpoint translate_cmd (tr_f_body : fdefs) (c : cmd) (id : p_id) (sid : p_id) : p_id * raw_code 'unit := + match c with + | [::] => (sid, ret tt) + | i :: c => + let (sid', i') := translate_instr tr_f_body i id sid in + let (sid'', c') := translate_cmd tr_f_body c id sid' in + (sid'', i' ;; c') + end. + +End TranslateCMD. + +Record fdef := { + ffun : typed_raw_function ; + locs : {fset Location} ; + imp : Interface ; +}. +#[local] Definition ty_in fd := (ffun fd).π1. +#[local] Definition ty_out fd := ((ffun fd).π2).π1. +Definition translate_fundef + (tr_f_body : fdefs) + (p : p_id) + (fd : _ufun_decl (* extra_fun_t *)) : funname * fdef. +Proof using P asm_op asmop pd fcp. + destruct fd. destruct _f. + split. 1: exact f. + constructor. + - pose (lchtuple (map encode f_tyin)) as tyin'. + pose (lchtuple (map encode f_tyout)) as tyout'. + exists tyin', tyout'. intros vargs'. + + (* NB: We coerce rather than truncating here, i.e. we expect the arguments + provided to us to be of the correct type. This differs slightly from + Jasmin where the truncation is performed in `sem_call`. However, as + explained in the translation of `Ccall` in `translate_instr_r`, we need + the types of the arguments to match the function in order to write the + function application, so we truncate at the caller side. We thus expect + the arguments to already be of the type `f_tyin` prescribed by the + function `f`. *) + apply (coerce_chtuple_to_list _ f_tyin) in vargs'. + + (* Write the arguments to their locations. *) + pose (map (λ '(x, (ty; v)), translate_write_var p x (totce v)) + (zip f_params vargs')) + as cargs. + apply (foldl (λ c k, c ;; k) (ret tt)) in cargs. + apply (bind cargs) => _. + + (* Perform the function body. *) + apply (bind (translate_cmd tr_f_body f_body p p).2) => _. + + (* Look up the results in their locations and return them. *) + pose (map (λ x, totc _ (translate_get_var p(* f *) (v_var x))) f_res) as cres. + exact (bind_list' f_tyout cres). + - exact fset0. + - exact [interface]. +Defined. + +(* Apply cast_fun or return default value, like lookup_op *) +Equations? cast_typed_raw_function {dom cod : choice_type} (rf : typed_raw_function) : dom → raw_code cod := + cast_typed_raw_function rf with inspect ((dom == rf.π1) && (cod == rf.π2.π1)) := { + | @exist true e => pkg_composition.cast_fun _ _ rf.π2.π2 ; + | @exist false e => λ _, ret (chCanonical _) + }. +Proof. + all: symmetry in e. + all: move: e => /andP [/eqP e1 /eqP e2]. + all: eauto. +Defined. + +Definition get_fundef_ssp (sp : seq (funname * fdef)) (fn : funname) (dom cod : choice_type) : + option (dom → raw_code cod) := + match assoc sp fn with + | Some fd => Some (cast_typed_raw_function fd.(ffun)) + | None => None + end. + +End Translation. + +Section Translation. + +Context `{asmop : asmOp}. + +Context {pd : PointerData}. +Context {fcp : FlagCombinationParams}. + +Definition ssprove_prog := seq (funname * trfun). + +Definition translate_prog (prog : uprog) : fdefs. +Proof using asm_op asmop pd fcp. + destruct prog. + induction p_funcs. + - exact [::]. + - unfold fdefs. unfold ssprove_prog. + apply cons. 2: exact IHp_funcs. + pose a.1 as fn. + split. 1: exact fn. + destruct a. destruct _f. + intros s_id. + exact (translate_cmd (Build__prog p_funcs p_globs p_extra) IHp_funcs f_body s_id s_id).2. +Defined. + +Definition tr_p (prog : uprog) : ssprove_prog. +Proof using asm_op asmop pd fcp. + pose (fs := translate_prog prog). + induction fs as [|f fs ?]. + - constructor 1. + - constructor 2. + 2: assumption. + exact (f.1, translate_call prog f.1 (f::fs)). +Defined. + +Definition translate_funs (P : uprog) : seq _ufun_decl → fdefs * ssprove_prog := + let fix translate_funs (fs : seq _ufun_decl) : fdefs * ssprove_prog := + match fs with + | [::] => ([::], [::]) + | f :: fs' => + let '(fn, f_extra) := f in + let tr_body := fun sid => (translate_cmd P (translate_funs fs').1 (f_body f_extra) sid sid).2 in + let tr_fs := (fn, tr_body) :: (translate_funs fs').1 in + let tr_p := (fn, translate_call_body P fn tr_body) :: (translate_funs fs').2 in + (tr_fs, tr_p) + end + in translate_funs. + +Definition translate_prog' P := + translate_funs P (p_funcs P). + +Fixpoint translate_funs_static (P : uprog) (fs : seq _ufun_decl) (st_funcs : fdefs) : fdefs * ssprove_prog := + match fs with + | [::] => ([::], [::]) + | f :: fs' => + let '(tr_fs', tr_p') := translate_funs_static P fs' st_funcs in + let '(fn, f_extra) := f in + let tr_body := fun sid => (translate_cmd P st_funcs (f_body f_extra) sid sid).2 in + let tr_fs := (fn, tr_body) :: tr_fs' in + let tr_p := (fn, translate_call_body P fn tr_body) :: tr_p' in + (tr_fs, tr_p) + end. + +Definition translate_prog_static P st_funcs := + translate_funs_static P (p_funcs P) st_funcs. + +Definition get_translated_static_fun P fn st_func := + match assoc (translate_prog_static P st_func).2 fn with + | Some f => f + | None => fun _ _ => ret [::] + end. + +Lemma tr_prog_inv {P fn f} : + get_fundef (p_funcs P) fn = Some f → + ∑ fs' l, + p_funcs P = l ++ (fn, f) :: fs' ∧ + assoc (translate_prog' P).1 fn = Some (fun sid => (translate_cmd P (translate_funs P fs').1 (f_body f) sid sid).2) /\ + assoc (translate_prog' P).2 fn = Some (translate_call P fn (translate_funs P ((fn, f) :: fs')).1). +Proof. + unfold translate_prog'. + induction (p_funcs P) as [|[gn g] fs' ih_fs']. + - move => //. + - (* simpl in *. *) + move => h //. + simpl in h. + destruct (fn == gn) eqn:e. + + move /eqP in e. + subst. + noconf h. + exists fs'. + exists [::]. + simpl. + destruct (translate_funs P fs') as [f_body f_prog] eqn:E2. + simpl. + unfold translate_call. simpl. + assert (E : gn == gn) by now apply /eqP. + rewrite E. easy. + + specialize (ih_fs' h). + simpl. + destruct (translate_funs P fs') as [fdefs ctrrogs] eqn:E2. + destruct ih_fs' as [fs'0 [l0 [ihl [iha ihb]]]]. simpl. + rewrite e. + rewrite ihl. + exists fs'0. exists ((gn, g) :: l0). + subst. split; [|split]; try easy. +Qed. + +(** Handled programs + + This predicate eliminates programs that are currently not supported by the + translation. This is mainly used to disallow while loops. + It also checks programs for acyclicity and correct ordering. +*) + +Fixpoint instr_r_fs + (i : instr_r) (fs : seq _ufun_decl) {struct i} + : bool +with instr_fs (i : instr) (fs : seq _ufun_decl) {struct i} + : bool := + instr_r_fs (instr_d i) fs. +Proof. + pose proof (cmd_fs := + (fix cmd_fs (c : cmd) (fs : seq _ufun_decl) : bool := + match c with + | [::] => true + | i :: c => + cmd_fs c fs && instr_fs i fs + end + )). + refine + match i with + | Cassgn l _ s e => + true + | Copn ls _ o es => + true + | Csyscall ls sc es => + true + | Cif e c1 c2 => + cmd_fs c1 fs && cmd_fs c2 fs + | Cfor i r c => + cmd_fs c fs + | Cwhile _ c1 _ c2 => cmd_fs c1 fs && cmd_fs c2 fs + | Ccall (* ii *) xs f args => + f \in [seq p.1 | p <- fs] + end. +Defined. + +Section CmdFS. + +Fixpoint cmd_fs (c : cmd) (fs : seq _ufun_decl) : bool := + match c with + | [::] => true + | i :: c => + cmd_fs c fs && instr_fs i fs + end. + +End CmdFS. + +Fixpoint handled_instr (i : instr) := + match i with + | MkI ii i => handled_instr_r i + end + +with handled_instr_r (i : instr_r) := + match i with + | Cassgn l tag sty e => true + | Copn l tag o es => true + | Csyscall _ _ _ => false + | Cif e c₁ c₂ => List.forallb handled_instr c₁ && List.forallb handled_instr c₂ + | Cfor i r c => List.forallb handled_instr c + | Cwhile al cb e c => false + | Ccall (* ii *) l fn es => true + end. + +Definition handled_cmd (c : cmd) := + List.forallb handled_instr c. + +Definition handled_fundecl (f : _ufun_decl) := + handled_cmd f.2.(f_body). + +Lemma lemma3 suf pre : + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) (suf ++ pre)).1 -> + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) pre).1. +Proof. + intros H. + induction suf. + - easy. + - simpl in *. + apply IHsuf. + destruct foldr. + destruct b. + + easy. + + easy. +Qed. + +Lemma lemma4 pre : + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) pre).2 = pre. +Proof. + induction pre. + - reflexivity. + - simpl. + destruct foldr. + destruct b; simpl in *; congruence. +Qed. + +Lemma lemma2 g gn (pre suf : list _ufun_decl) : + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) (suf ++ (gn,g) :: pre)).1 -> + cmd_fs g.(f_body) pre. +Proof. + intros. + eapply lemma3 in H. + simpl in H. + pose proof lemma4 pre. + destruct foldr. + destruct b; simpl in *; congruence. +Qed. + +Definition handled_program (P : uprog) := + List.forallb handled_fundecl P.(p_funcs) && + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) P.(p_funcs)).1 && + uniq [seq p.1 | p <- P.(p_funcs)]. +Context `{sc_sem : syscall_sem }. + +Fact sem_call_get_some {P m1 scs1 gn vargs m2 scs2 vres} : + (@sem_call (nosubword) (* TODO: nosubword or withsubword *) direct_c (* TODO: direct? *) asm_op syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)); |} mk_spp {| + _asmop := asmop; _sc_sem := sc_sem |} _ (sCP_unit (* TODO *)) P (tt (* TODO *)) scs1 m1 gn vargs scs2 m2 vres → + ∃ f, get_fundef (p_funcs P) gn = Some f ). +Proof. intros H. inversion H. exists f. easy. +Qed. + +Definition get_translated_fun P fn : trfun := + match assoc (translate_prog' P).2 fn with + | Some f => f + | None => λ _ _, ret [::] + end. + +Lemma translate_call_head {P gn fs' f} : + assoc (translate_prog' P).1 gn = + Some (fun sid => (translate_cmd P (translate_funs P fs').1 (f_body f) sid sid).2) + → + translate_call P gn (translate_funs P (p_funcs P)).1 + = translate_call P gn (translate_funs P ((gn,f) :: fs')).1. +Proof. + intros ef. + unfold translate_call at 1. + rewrite ef. + simpl. + destruct (translate_funs P fs'). simpl. + unfold translate_call, assoc at 1. + assert (E : gn == gn) by now apply /eqP. + now rewrite E. +Qed. + +Context `{asm_correct : ∀ o, sem_correct (tin (get_instr_desc (Oasm o))) (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ (Oasm o))}. +Context (gd : glob_decls). + +Lemma translate_instr_r_if P SP e c1 c2 id sid : + translate_instr_r P SP (Cif e c1 c2) id sid = + let (sid', c1') := translate_cmd P SP c1 id sid in + let (sid'', c2') := translate_cmd P SP c2 id sid' in + let e' := translate_pexpr (p_globs P) id e in + let rb := coe_tyc 'bool e' in (sid'', b ← rb ;; + if b + then c1' + else c2'). +Proof. reflexivity. Qed. + +Lemma translate_instr_r_for P SP i r c id sid : + translate_instr_r P SP (Cfor i r c) id sid = + let '(d, lo, hi) := r in + let (sid', fresh) := fresh_id sid in + let loᵗ := coe_tyc 'int (translate_pexpr (p_globs P) id lo) in + let hiᵗ := coe_tyc 'int (translate_pexpr (p_globs P) id hi) in + let cᵗ := translate_cmd P SP c id in (sid', vlo ← loᵗ ;; + vhi ← hiᵗ ;; + translate_for i (wrange d vlo vhi) id cᵗ fresh). +Proof. reflexivity. Qed. + + +Ltac invert_stack st hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2 := + apply invert_valid_stack in st as [hst [hdisj [hevm [hpre [hvalid [hnin [hnodup [hvalid1 [hpre1 [hdisj1 hdisj2]]]]]]]]]]. + +Ltac split_and := + repeat lazymatch goal with + | |- _ /\ _ => split + end. + +Lemma valid_stack_prec vm m_id s_id1 s_id2 s_st st h : + s_id1 ⪯ s_id2 -> + valid_stack ((vm, m_id, s_id1, s_st) :: st) h -> + valid_stack ((vm, m_id, s_id2, s_st) :: st) h. +Proof. + intros hpre12 vst. + invert_stack vst hst hevm hpre hdisj hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2. + eapply valid_stack_cons; unfold valid_stack_frame; split_and; eauto with prefix. + - eapply valid_prec; eauto. + - intros contra. + eapply disj_antirefl. + eapply disj_prec_r. + 1: eapply hpre12. + apply disj_sym. + apply hdisj1. + assumption. + - intros s_id' s_in'. + eapply disj_prec_l. + 1: eapply hpre12. + apply hdisj1. + assumption. +Qed. + +Lemma rel_estate_prec : forall h s m_id s_id1 s_id2 s_st st, + s_id1 ⪯ s_id2 -> + rel_estate s m_id s_id1 s_st st h -> + rel_estate (syscall_state := syscall_state) s m_id s_id2 s_st st h. +Proof. + intros h s m_id s_id1 s_id2 s_st st hpre12 [hmem hstack]; split; auto. + eapply valid_stack_prec; eauto. +Qed. + +Lemma rel_estate_pop_sub s m_id s_id s_id' s_st st : + ∀ h, rel_estate s m_id s_id (s_id' :: s_st) st h → rel_estate (syscall_state := syscall_state) s m_id s_id' s_st st h. +Proof. + intros h [hmem hstack]. + split. + - assumption. + - eapply valid_stack_pop_sub; eassumption. +Qed. + +Lemma rel_estate_pop scs m vm vm' m_id m_id' s_id s_id' s_st s_st' st : + ∀ h, rel_estate {| escs := scs ; emem := m ; evm := vm |} m_id s_id s_st ((vm',m_id',s_id',s_st') :: st) h → + rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m ; evm := vm' |} m_id' s_id' s_st' st h. +Proof. + intros h [hmem hstack]. + split. + - assumption. + - eapply valid_stack_pop; eassumption. +Qed. + +Lemma rel_estate_push_sub s m_id s_id s_st st : + ∀ h : heap, rel_estate s m_id s_id s_st st h → + rel_estate (syscall_state := syscall_state) s m_id s_id~1 (s_id~0 :: s_st) st h. +Proof. + intros h [hmem hstack]; split. + - assumption. + - eapply valid_stack_push_sub; eassumption. +Qed. + +Lemma rel_estate_push m vm scs m_id s_id s_st st : + ∀ h : heap, rel_estate {| escs := scs ; emem := m ; evm := vm |} m_id s_id s_st st h → + rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m ; evm := Vm.init |} s_id~1 s_id~1 [::] ((vm, m_id, s_id~0, s_st) :: st) h. +Proof. + intros h [hmem hstack]; split. + - assumption. + - eapply valid_stack_push; eassumption. +Qed. + +Lemma translate_cmd_preceq P SP c m_id s_id : + let (s_id', _) := translate_cmd P SP c m_id s_id in s_id ⪯ s_id'. +Proof. + revert s_id. + set (Pr := fun (i : instr_r) => + forall s_id, let (s_id', _) := translate_instr_r P SP i m_id s_id in + s_id ⪯ s_id'). + set (Pi := fun (i : instr) => + Pr (instr_d i)). + set (Pc := fun (c : cmd) => + forall s_id, + let (s_id', _) := translate_cmd P SP c m_id s_id in + s_id ⪯ s_id'). + eapply cmd_rect with + (Pr := Pr) + (Pi := Pi) + (Pc := Pc); + try easy + . + - intros s_id. + simpl; reflexivity. + - intros i c0 ihi ihc s_id. + simpl. + rewrite translate_instr_unfold. + specialize (ihi s_id). + destruct translate_instr_r as [s_id' ?]. + specialize (ihc s_id'). + destruct translate_cmd. + etransitivity; eauto. + - intros x tg ty e i; simpl; reflexivity. + - intros xs t o es i; simpl; reflexivity. + - intros xs o es i; simpl; reflexivity. + - intros e c1 c2 ihc1 ihc2 s_id. + rewrite translate_instr_r_if. + specialize (ihc1 s_id). + destruct translate_cmd as [s_id' ?]. + specialize (ihc2 s_id'). + destruct translate_cmd as [s_id'' ?]. + simpl. + etransitivity; eauto. + - intros v dir lo hi c' ihc s_id. + rewrite translate_instr_r_for. + simpl. + apply fresh1. + - intros a c1 e c2 ihc1 ihc2 s_id. + simpl; reflexivity. + - intros ? ? ? ?. + simpl. + apply fresh1. +Qed. + +Lemma translate_instr_r_preceq P SP i id s_id : + let (s_id', _) := translate_instr_r P SP i id s_id in s_id ⪯ s_id'. +Proof. + revert s_id. + set (Pr := fun (i : instr_r) => + forall s_id, let (s_id', _) := translate_instr_r P SP i id s_id in + s_id ⪯ s_id'). + set (Pi := fun (i : instr) => + Pr (instr_d i)). + set (Pc := fun (c : cmd) => + forall s_id, + let (s_id', _) := translate_cmd P SP c id s_id in + s_id ⪯ s_id'). + eapply instr_r_Rect with + (Pr := Pr) + (Pi := Pi) + (Pc := Pc); + try easy + . + - intros s_id. + simpl; reflexivity. + - intros i' c0 ihi ihc s_id. + simpl. + rewrite translate_instr_unfold. + specialize (ihi s_id). + destruct translate_instr_r as [s_id' ?]. + specialize (ihc s_id'). + destruct translate_cmd. + etransitivity; eauto. + - intros x tg ty e i'; simpl; reflexivity. + - intros xs t o es i'; simpl; reflexivity. + - intros xs o es i'; simpl; reflexivity. + - intros e c1 c2 ihc1 ihc2 s_id. + rewrite translate_instr_r_if. + specialize (ihc1 s_id). + destruct translate_cmd as [s_id' ?]. + specialize (ihc2 s_id'). + destruct translate_cmd as [s_id'' ?]. + simpl. + etransitivity; eauto. + - intros v dir lo hi c' ihc s_id. + rewrite translate_instr_r_for. + simpl. + apply fresh1. + - intros a c1 e c2 ihc1 ihc2 s_id. + simpl; reflexivity. + - intros ? ? ? ?. + simpl. + apply fresh1. +Qed. + +Lemma translate_instr_r_pres P SP c s m_id s_id s_st st h : + let (s_id', _) := translate_instr_r P SP c m_id s_id in + rel_estate s m_id s_id s_st st h -> rel_estate (syscall_state := syscall_state) s m_id s_id' s_st st h. +Proof. + pose proof translate_instr_r_preceq P SP c m_id s_id. + destruct translate_instr_r as [s_id' ?]. + apply rel_estate_prec; assumption. +Qed. + +Lemma translate_cmd_pres P SP c s m_id s_id s_st st h : + let (s_id', _) := translate_cmd P SP c m_id s_id in + rel_estate s m_id s_id s_st st h -> rel_estate (syscall_state := syscall_state) s m_id s_id' s_st st h. +Proof. + pose proof translate_cmd_preceq P SP c m_id s_id. + destruct translate_cmd as [s_id' ?]. + apply rel_estate_prec; assumption. +Qed. + +Definition Pfun (P : uprog) (fn : funname) scs m va scs' m' vr vm m_id s_id s_st st := + ⊢ ⦃ rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m; evm := vm |} m_id s_id s_st st ⦄ + get_translated_fun P fn s_id~1 [seq totce (translate_value v) | v <- va] + ⇓ [seq totce (translate_value v) | v <- vr] + ⦃ rel_estate (syscall_state := syscall_state) {| escs := scs' ; emem := m' ; evm := vm |} m_id s_id~0 s_st st ⦄. + +Lemma hget_lemma (l : seq var_i) vm vres : + mapM (λ x : var_i, get_var (wsw := (nosubword) (* TODO: nosubword or withsubword *)) (true (* TODO: wdb *)) vm x) l = ok vres -> + [seq encode (vtype (v_var x)) | x <- l] = [seq choice_type_of_val v | v <- vres]. +Proof. + revert vres vm. + induction l; intros. + - inversion H; reflexivity. + - inversion H. + jbind H1 v Hv. + jbind H1 v' Hv'. + noconf H1. + simpl. + unfold choice_type_of_val. + admit. + (* erewrite type_of_get_var by eassumption. *) + (* erewrite IHl by eassumption. *) + (* reflexivity. *) +Admitted. (* Qed. *) + +Lemma hget_lemma2 l scs m vm vres m_id s_id s_st st : + mapM (λ x : var_i, get_var (wsw := (nosubword) (* TODO: nosubword or withsubword *)) (true (* TODO: wdb *)) vm x) l = ok vres -> + List.Forall2 + (λ (c : ∑ a : choice_type, raw_code a) (v : value), + ⊢ ⦃ rel_estate {| escs := scs ; emem := m; evm := vm |} m_id s_id s_st st ⦄ + c.π2 ⇓ coe_cht c.π1 (translate_value v) + ⦃ rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m; evm := vm |} m_id s_id s_st st ⦄) + [seq totc (encode (vtype (v_var x))) (translate_get_var m_id x) | x <- l] vres. +Proof. + revert m vm vres m_id s_id s_st st. + induction l; intros. + - inversion H. constructor. + - inversion H. + jbind H1 v Hv. + jbind H1 v' Hv'. + noconf H1. + constructor. + + simpl. + eapply translate_get_var_correct; eauto. + simpl. assumption. + + eapply IHl. assumption. +Qed. + +Lemma htrunc_lemma1 l vargs vargs': + mapM2 ErrType truncate_val l vargs' = ok vargs + -> (trunc_list l [seq totce (translate_value v) | v <- vargs']) = [seq totce (translate_value v) | v <- vargs]. +Proof. + revert vargs vargs'. + induction l; intros. + - destruct vargs'. + + inversion H; reflexivity. + + inversion H. + - destruct vargs'. + + inversion H. + + inversion H. + jbind H1 v' Hv'. + jbind H1 v'' Hv''. + noconf H1. + simpl. + unfold trunc_list. + simpl. + erewrite totce_truncate_translate by eassumption. + f_equal. + apply IHl. + assumption. +Qed. + +Lemma translate_for_ext v l m_id s_id c c' : + (forall s_id, c s_id = c' s_id) -> + translate_for v l m_id c s_id = translate_for v l m_id c' s_id. +Proof. + revert s_id. + induction l; intros s_id hext. + - reflexivity. + - simpl. + rewrite hext. + destruct c'. + rewrite IHl; auto. +Qed. + +Lemma lemma1 P pre c suf m_id : + uniq [seq p.1 | p <- suf ++ pre] -> + forall s_id, + cmd_fs c pre -> + translate_cmd P (translate_funs P (suf ++ pre)).1 c m_id s_id + = translate_cmd P (translate_funs P pre).1 c m_id s_id. +Proof. + intros huniq. + set (Pr := fun (i : instr_r) => + forall s_id, + instr_r_fs i pre -> + translate_instr_r P (translate_funs P (suf ++ pre)).1 i m_id s_id + = translate_instr_r P (translate_funs P pre).1 i m_id s_id). + set (Pi := fun (i : instr) => + Pr (instr_d i)). + set (Pc := fun (c : cmd) => + forall s_id, + cmd_fs c pre -> + translate_cmd P (translate_funs P (suf ++ pre)).1 c m_id s_id + = translate_cmd P (translate_funs P pre).1 c m_id s_id). + eapply cmd_rect with + (Pr := Pr) + (Pi := Pi) + (Pc := Pc); + try easy + . + - intros i c' ihi ihc s_id' hpre. + unfold Pc. + simpl. + unfold Pi in ihi. + red in ihi. + rewrite !translate_instr_unfold. + simpl in hpre. + move: hpre => /andP [hi hc]. + rewrite ihi. + 2: destruct i; auto. + destruct translate_instr_r as [s_id'' i']. + rewrite ihc; auto. + - intros e c1 c2 ihc1 ihc2 s_id' hpre. + rewrite !translate_instr_r_if. + simpl in hpre. + fold cmd_fs in hpre. + move: hpre => /andP [hc1 hc2]. + rewrite ihc1; auto. + destruct translate_cmd as [s_id'' c']. + rewrite ihc2; auto. + - intros v d lo hi c' ihc s_id hpre. + simpl in hpre. + fold cmd_fs in hpre. + rewrite !translate_instr_r_for. + red in ihc. + simpl. + f_equal. + f_equal. + apply functional_extensionality. + intros lb. + f_equal. + apply functional_extensionality. + intros ub. + erewrite translate_for_ext; eauto. + - intros (* i *) lvals f es s_id hpre. + simpl in hpre. + unfold translate_instr_r. + simpl. + f_equal. + unfold translate_call. + symmetry; destruct assoc eqn:E. + + assert (H2 : exists r', assoc pre f = Some r'). + * clear -E. + induction pre. 1: discriminate. + destruct a. + simpl in *. + destruct (f == s). + ** eexists. reflexivity. + ** apply IHpre; auto. + * destruct H2 as [r']. + assert (assoc (translate_funs P (suf ++ pre)).1 f = Some r). + ** eapply mem_uniq_assoc. + *** clear -E. + induction suf. + **** induction pre. + ***** discriminate. + ***** + destruct a. + simpl in *. + destruct (f==s) eqn:E2. + ****** + move: E2 => /eqP ->. left. noconf E. + reflexivity. + ****** right. + apply IHpre. assumption. + **** destruct a. + simpl. + right. + assumption. + *** clear -huniq. + induction suf. + **** induction pre. + ***** easy. + ***** destruct a. + simpl in *. + move: huniq => /andP [huniq1 huniq2]. + apply /andP; split. + ****** clear -huniq1. induction pre. + ******* easy. + ******* destruct a. + Check [eqType of BinNums.positive]. + simpl in huniq1. + admit. + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- pre] s. *) + (* rewrite H in huniq1. *) + (* move: huniq1 => /andP [huniq11 huniq12]. *) + (* simpl. *) + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- (translate_funs P pre).1] s. *) + (* rewrite H0. *) + (* apply /andP. *) + (* split; auto. *) + ****** apply IHpre. assumption. + **** destruct a. + simpl in *. + move: huniq => /andP [huniq1 huniq2]. + apply /andP. + split. + ****** clear -huniq1. induction suf. + ******* induction pre. + ******** easy. + ******** destruct a. + simpl in *. + admit. + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- pre] s. *) + (* rewrite H in huniq1. *) + (* move: huniq1 => /andP [huniq11 huniq12]. *) + (* simpl. *) + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- (translate_funs P pre).1] s. *) + (* rewrite H0. *) + (* apply /andP. *) + (* split; auto. *) + ******* + destruct a. + simpl in *. + admit. + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- suf ++ pre] s. *) + (* rewrite H in huniq1. *) + (* move: huniq1 => /andP [huniq11 huniq12]. *) + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- (translate_funs P (suf ++ pre)).1] s. *) + (* rewrite H0. *) + (* apply /andP. *) + (* split; auto. *) + ****** apply IHsuf; auto. + ** rewrite H0. reflexivity. + + exfalso. + assert (H2 : assoc pre f = None). + * clear -E. + induction pre. + ** reflexivity. + ** simpl in *. + destruct a. + simpl in *. + destruct (f == t). + *** discriminate. + *** apply IHpre; auto. + * clear -H2 hpre. + induction pre. + ** easy. + ** destruct a. + simpl in *. + rewrite in_cons in hpre. + destruct (f == s). + *** simpl in *. + discriminate. + *** simpl in *. + apply IHpre; auto. +Admitted. (* Qed. *) + +Theorem translate_prog_correct P scs m vargs scs' m' vres : + ∀ fn, + @sem_call (nosubword) (* TODO: nosubword or withsubword *) direct_c (* TODO: direct? *) asm_op syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)); |} mk_spp {| + _asmop := asmop; _sc_sem := sc_sem |} _ (sCP_unit (* TODO *)) (P : @uprog asm_op asmop) (tt (* TODO *)) scs m fn vargs scs' m' vres → + handled_program P -> + ∀ vm m_id s_id s_st st, + Pfun P fn scs m vargs scs' m' vres vm m_id s_id s_st st. +Proof using gd asm_correct. + intros fn H hP. + set (Pfun := λ (scs : syscall_state_t) (m : mem) (fn : funname) (va : seq value) (scs' : syscall_state_t) (m' : mem) (vr : seq value), + handled_program P -> forall vm m_id s_id s_st st, Pfun P fn scs m va scs' m' vr vm m_id s_id s_st st + ). + set (SP := (translate_prog' P).1). + set (Pi_r := + λ (s1 : estate) (i : instr_r) (s2 : estate), + ∀ m_id s_id s_st st, + handled_instr_r i → + let (s_id', i') := translate_instr_r P SP i m_id s_id in + ⊢ ⦃ rel_estate (syscall_state := syscall_state) s1 m_id s_id s_st st ⦄ + i' ⇓ tt + ⦃ rel_estate (syscall_state := syscall_state) s2 m_id s_id' s_st st ⦄). + set (Pi := λ s1 i s2, Pi_r s1 (instr_d i) s2). + set (Pc := + λ (s1 : estate) (c : cmd) (s2 : estate), + ∀ m_id s_id s_st st, + handled_cmd c → + let (s_id', c') := translate_cmd P SP c m_id s_id in + ⊢ ⦃ rel_estate (syscall_state := syscall_state) s1 m_id s_id s_st st ⦄ + c' ⇓ tt + ⦃ rel_estate (syscall_state := syscall_state) s2 m_id s_id' s_st st ⦄). + set (Pfor := + λ (v : var_i) (ws : seq Z) (s1 : estate) (c : cmd) (s2 : estate), + ∀ m_id s_id s_id' s_st st, + handled_cmd c → + s_id~1 ⪯ s_id' -> + exists s_id'', + ⊢ ⦃ rel_estate (syscall_state := syscall_state) s1 m_id s_id' (s_id~0 :: s_st) st ⦄ + translate_for v ws m_id (translate_cmd P SP c m_id) s_id' ⇓ tt + ⦃ rel_estate (syscall_state := syscall_state) s2 m_id s_id'' (s_id~0 :: s_st) st ⦄ + ). + + unshelve eapply (@sem_call_Ind _ _ asm_op syscall_state {| _pd := pd |} mk_spp {| + _asmop := asmop; _sc_sem := sc_sem |} _ _ _ _ Pc Pi_r Pi Pfor Pfun _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H). + - (* nil *) + intros s m_id s_id s_st st _. simpl. + eapply u_ret_eq. + intros h preh. auto. + - (* cons *) + red. + intros s1 s2 s3 i c hi ihi hc ihc m_id s_id s_st st hp. (* sp fp ctr h fp_prec. *) + inversion hp. + move: H1 => /andP [hdi hdc]. + unfold Pi in ihi. unfold Pi_r in ihi. + simpl. + rewrite translate_instr_unfold. + pose proof translate_instr_r_preceq P SP (instr_d i) m_id s_id. + specialize (ihi m_id s_id). + pose proof (translate_instr_r_pres P SP (instr_d i) s1 m_id s_id). + destruct translate_instr_r as [s_id' i'] eqn:E. + unfold Pc in ihc. + specialize (ihc m_id s_id'). + pose proof (translate_cmd_preceq P SP c m_id s_id'). + pose proof (translate_cmd_pres P SP c s1 m_id s_id'). + destruct translate_cmd as [s_id'' c'] eqn:Ec. + split. + + eapply u_bind. + * eapply ihi. + 1: destruct i; apply hdi. + * eapply ihc. + 1: assumption. + - (* mkI *) + red. intros ii i s1 s2 hi ihi. + apply ihi. + - (* assgn *) + red. intros s₁ s₂ x tag ty e v v' he hv hw m_id s_id s_st st hp. + eapply u_bind. + 1:{ eapply translate_pexpr_correct. all: eauto. } + erewrite translate_pexpr_type by eassumption. + rewrite coerce_to_choice_type_K. + erewrite totce_truncate_translate by eassumption. + eapply u_post_weaken_rule. + 1: eapply u_pre_weaken_rule. + 1: eapply translate_write_lval_correct. all: eauto. + - (* opn *) + red. + (* easy. *) + intros s1 s2 tag o xs es ho m_id s_id s_st st hp. + jbind ho vs hv. + jbind hv vs' hv'. + eapply u_bind. + + eapply bind_list_pexpr_correct. 2: eassumption. + eauto. + + unshelve erewrite translate_exec_sopn_correct by eassumption. + 1: assumption. + eapply u_post_weaken_rule. + 1: apply translate_write_lvals_correct. + all: eauto. + - (* sys_call *) + easy. + - (* if_true *) + intros s1 s2 e c1 c2 he hc1 ihc1 m_id s_id s_st st hp. + inversion hp. + move: H1 => /andP [hdc1 hdc2]. + rewrite translate_instr_r_if. + simpl. + unfold Pc in ihc1. + specialize (ihc1 m_id s_id s_st st). + pose proof translate_cmd_pres P SP c1 s1 m_id s_id s_st st. + destruct (translate_cmd P SP c1 m_id s_id) as [s_id'' c1'] eqn:E1. + pose proof translate_cmd_pres P SP c2 s2 m_id s_id'' s_st st. + destruct (translate_cmd P SP c2 m_id s_id'') as [s_id''' c2'] eqn:E2. + split. + + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in he. all: eauto. } + eapply u_post_weaken_rule. + 1: eapply ihc1. + 1: eapply hdc1. + 1: assumption. + - (* if_false *) + intros s1 s2 e c1 c2 he hc2 ihc2 m_id s_id s_st st hp. + inversion hp. + move: H1 => /andP [hdc1 hdc2]. + rewrite translate_instr_r_if. + simpl. + unfold Pc in ihc2. + pose proof translate_cmd_pres P SP c1 s1 m_id s_id s_st st. + destruct (translate_cmd P SP c1 m_id s_id) as [s_id'' c1'] eqn:E1. + specialize (ihc2 m_id s_id'' s_st st). + destruct (translate_cmd P SP c2 m_id s_id'') as [s_id''' c2'] eqn:E2. + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in he. all: eauto. } + eapply u_pre_weaken_rule. + 1: eapply u_post_weaken_rule. + 1: eapply ihc2. + 1: assumption. + 1: { intros h rel. eapply rel_estate_prec. 1:reflexivity. 1: eassumption. } + assumption. + - (* while_true *) + easy. + - (* while_false *) + easy. + - (* for *) + intros s s2 i d lo hi c vlo vhi hlo hhi hfor ihfor m_id s_id s_st st hp. + rewrite translate_instr_r_for. + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in hlo. all: eauto. } + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in hhi. all: eauto. } + unfold Pfor in ihfor. + simpl in ihfor. + specialize (ihfor m_id s_id s_id~1 s_st st ltac:(apply hp) ltac:(reflexivity)). + destruct ihfor as [s_id'']. + eapply u_pre_weaken_rule. + 1: eapply u_post_weaken_rule. + 1: exact H0. + 1: apply rel_estate_pop_sub. + apply rel_estate_push_sub. + - (* for_nil *) + intros s i c m_id s_id s_id' s_st st hdc hpre. + simpl. + exists s_id'. + apply u_ret_eq. + easy. + - (* for_cons *) + intros s1 s1' s2 s3 i w ws c hw hc ihc hfor ihfor m_id s_id s_id' s_st st hdc hpre. + simpl. + specialize (ihc m_id s_id' (s_id~0 :: s_st) st hdc). + pose proof translate_cmd_preceq P SP c m_id s_id'. + destruct translate_cmd as [s_id'' c'] eqn:E. + specialize (ihfor m_id s_id s_id'' s_st st hdc ltac:(etransitivity;eauto)) as [s_id''' ihfor]. + exists s_id'''. + eapply u_put. + eapply u_pre_weaken_rule. + 2: { + intros ? [me [hme ?]]. subst. + eapply translate_write_var_estate. all: try eassumption. + } + eapply u_bind. + 1: eapply ihc. + eapply ihfor. + - (* call *) + intros s1 scs1 m2 s2 (* ii *) xs gn args vargs' vres' hargs hgn ihgn hwr_vres m_id s_id s_st st hdi. + unfold Pfun, Translation.Pfun, get_translated_fun in ihgn. + simpl. + eapply u_bind. + 1: admit. + (* 1: eapply bind_list_pexpr_correct with (s_id:=s_id) (s_st:=s_st) (st:=st); try eassumption; easy. *) + eapply u_bind with (v₁ := [seq totce (translate_value v) | v <- vres']). + 1: specialize (ihgn hP (evm s1) m_id s_id s_st st). + 1: eapply u_pre_weaken_rule. + * destruct (sem_call_get_some hgn) as [f hf]. + destruct (tr_prog_inv hf) as [fs' [l [hl [ef ep]]]]. + simpl in ep. + rewrite ep in ihgn. + pose (translate_call_head ef) as hc. + rewrite hc. + eapply ihgn. + * admit. + * eapply translate_write_lvals_correct. + 1:assumption. + admit. + (* exact hwr_vres. *) + - (* proc *) + intros scs1 m1 scs2 m2 gn g vargs' vargs'' s1 vm2 vres' vres''. + intros hg hvars hwr hbody ihbody hget htrunc. + intros hp vm m_id s_id s_st st. + unfold Translation.Pfun. + unfold get_translated_fun. + admit. + (* destruct (tr_prog_inv hg) as [fs' [l [hl ]]]. *) + (* unfold Pc, SP, translate_prog' in ihbody. *) + (* unfold translate_prog' in *. *) + (* rewrite hl in ihbody. *) + (* rewrite hl. *) + (* destruct H0 as [ef ep]. *) + (* rewrite hl in ef. *) + (* rewrite hl in ep. *) + (* subst SP. *) + (* rewrite ep. *) + (* unfold translate_call. *) + (* simpl. *) + (* destruct (translate_funs P fs') as [tr_fs' tsp'] eqn:Efuns. *) + (* simpl. *) + (* assert (E : gn == gn) by now apply /eqP. *) + (* rewrite E; clear E. *) + (* unfold translate_call_body. *) + (* rewrite hg. *) + (* eapply u_bind. *) + (* 1: { *) + (* erewrite htrunc_lemma1 by eassumption. *) + (* eapply u_pre_weaken_rule. *) + (* 1: eapply translate_write_vars_correct; eassumption. *) + (* eapply rel_estate_push. *) + (* } *) + (* assert (handled_cmd (f_body g)) as hpbody. *) + (* { *) + (* clear -hg hp. *) + (* pose (gd := (gn, g)). *) + (* unfold handled_program in *. *) + (* move: hp => /andP [] /andP [] hp1 hp2 hp3. *) + (* pose (hh := (List.forallb_forall handled_fundecl (p_funcs P)).1 hp1 gd). *) + (* destruct g. *) + (* apply hh. simpl. *) + (* now apply (assoc_mem' hg). *) + (* } *) + (* specialize (ihbody s_id~1 s_id~1 [::] ((vm, m_id, s_id~0, s_st) :: st) hpbody). clear hpbody. *) + (* assert ((l ++ (gn,g) :: fs') = ((l ++ [:: (gn,g)]) ++ fs')) by (rewrite <- List.app_assoc; reflexivity). *) + (* assert (htr : translate_cmd P (translate_funs P (l ++ ((gn,g) :: fs'))).1 (f_body g) s_id~1 s_id~1 *) + (* = translate_cmd P (translate_funs P fs').1 (f_body g) s_id~1 s_id~1). *) + (* { rewrite H0. *) + (* eapply lemma1. *) + (* { clear -hp hl H0. *) + (* unfold handled_program in *. *) + (* move: hp => /andP [] /andP [_ _]. *) + (* now rewrite hl H0. *) + (* } *) + (* clear -hp hl. *) + (* move: hp => /andP [] /andP [_ hp2 _]. *) + (* rewrite hl in hp2. *) + (* eapply lemma2. *) + (* eassumption. *) + (* } *) + (* rewrite htr in ihbody. *) + (* rewrite Efuns in ihbody. *) + (* destruct (translate_cmd P tr_fs' (f_body g) s_id~1 s_id~1) as [s_id' c'] eqn:E. *) + (* rewrite E in ihbody. *) + (* rewrite E. *) + (* simpl. *) + + (* eapply u_bind with (v₁ := tt). *) + (* + eapply ihbody. *) + (* + eapply u_bind. *) + (* * eapply bind_list_correct. *) + (* ** rewrite <- map_comp. *) + (* unfold comp. *) + (* simpl. *) + (* eapply hget_lemma; eassumption. *) + (* ** eapply hget_lemma2. *) + (* assumption. *) + (* * clear -htrunc. *) + (* eapply u_ret. *) + (* split. *) + (* 1: eapply rel_estate_pop. *) + (* 1: eassumption. *) + (* eapply htrunc_lemma1. *) + (* eassumption. *) + - assumption. +Admitted. (* Qed. *) + +End Translation. + +From Jasmin Require Import x86_instr_decl x86_extra (* x86_gen *) (* x86_linear_sem *). +Import arch_decl. + +Lemma id_tin_instr_desc : + ∀ (a : asm_op_msb_t), + id_tin (instr_desc a) = id_tin (x86_instr_desc a.2). +Proof. + intros [[ws|] a]. + - simpl. destruct (_ == _). all: reflexivity. + - reflexivity. +Qed. + +Definition cast_sem_prod_dom {ts tr} ts' (f : sem_prod ts tr) (e : ts = ts') : + sem_prod ts' tr. +Proof. + subst. exact f. +Defined. + +Lemma cast_sem_prod_dom_K : + ∀ ts tr f e, + @cast_sem_prod_dom ts tr ts f e = f. +Proof. + intros ts tr f e. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. +Qed. + +Lemma sem_correct_rewrite : + ∀ R ts ts' f e, + sem_correct ts' (cast_sem_prod_dom ts' f e) → + @sem_correct R ts f. +Proof. + intros R ts ts' f e h. + subst. rewrite cast_sem_prod_dom_K in h. + assumption. +Qed. + +Lemma no_arr_correct {R} ts s : + List.Forall (λ t, ∀ len, t != sarr len) ts → + @sem_correct R ts s. +Proof. + intros h. + induction h as [| t ts ht h ih]. + - constructor. + - constructor. + + intros v. + pose proof unembed_embed t v as e. + destruct t as [| | len |]. + 1,2,4: rewrite e ; reflexivity. + specialize (ht len). move: ht => /eqP. contradiction. + + intros v. + apply ih. +Qed. + +Context `{asmop : asmOp}. +Lemma x86_correct : + ∀ (o : @asm_op_t asm_op _), + sem_correct (tin (sopn.get_instr_desc (Oasm o))) (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ (Oasm o)). +Proof. + intros o. + admit. + (* destruct o as [a | e]. *) + (* - Opaque instr_desc. simpl. *) + (* pose proof (id_tin_instr_desc a) as e. *) + (* eapply sem_correct_rewrite with (e := e). *) + (* destruct a as [o x]. simpl in *. *) + (* eapply no_arr_correct. *) + (* destruct x ; simpl. *) + (* all: repeat constructor. *) + (* Transparent instr_desc. *) + (* - destruct e ; simpl ; repeat constructor. *) + (* destruct w ; repeat constructor. *) + (* Qed. *) +Admitted. diff --git a/theories/Jasmin/jasmin_utils.v b/theories/Jasmin/jasmin_utils.v new file mode 100644 index 00000000..cab3bff5 --- /dev/null +++ b/theories/Jasmin/jasmin_utils.v @@ -0,0 +1,190 @@ +From Coq Require String Ascii. + +From Jasmin Require Import expr. + +From Crypt Require Import Prelude Package. +From JasminSSProve Require Import jasmin_translate. + +From Ltac2 Require Ltac2 Printf. +From Ltac2 Require String Char Fresh Ident. + + +Module JasminCodeNotation. + + Notation " ⸨ ws ⸩ a .[ ptr * scale ] " := (chArray_get ws a ptr scale) + (format " ⸨ ws ⸩ a .[ ptr * scale ] "). + Notation " a [ w / p ] " := + (chArray_set a AAscale p w) + (at level 99, no associativity, + format " a [ w / p ] "). + + Notation "$$ i" := (translate_var _ {| vtype := _; vname := i |}) + (at level 99, format "$$ i"). + + Notation "$$$ i" := ({| v_var := {| vtype := _; vname := i |}; v_info := _ |}) + (at level 99, + format "$$$ i"). + + Notation "'for var ∈ seq" := (translate_for _ ($$$var) seq) + (at level 99). +End JasminCodeNotation. + +Module jtac. + +Import JasminNotation JasminCodeNotation. + +Import Ltac2.Ltac2 Ltac2.Printf. + +Ltac2 rec ltac_int_of_pos (p : constr) : int := + let res := + lazy_match! p with + | xH => 1 + | xO ?p' => Int.mul 2 (ltac_int_of_pos p') + | xI ?p' => Int.add (Int.mul 2 (ltac_int_of_pos p')) 1 + end in + if Int.lt res 0 + then Control.throw (Out_of_bounds (Some (fprintf "ltac_int_of_pos: value is too large: %t" p))) + else res. + +Ltac2 ltac_int_of_Z (z : constr) : int := + lazy_match! z with + | Z0 => 0 + | Zpos ?p => ltac_int_of_pos p + | Zneg ?p => Int.sub 0 (ltac_int_of_pos p) + end. + +Ltac2 ltac_char_of_ascii (c : constr) : char := + let c := constr:(Z.of_nat (Ascii.nat_of_ascii $c)) in + let c := eval cbv in $c in + Char.of_int (ltac_int_of_Z c). + +Ltac2 ltac_string_of_string (s : constr) : string := + let s := eval cbv in $s in + let rec ltac_copy_to_string (s : constr) (out : string) (i : int) : unit := + lazy_match! s with + | EmptyString => () + | String ?c ?s => String.set out i (ltac_char_of_ascii c) ; + ltac_copy_to_string s out (Int.add i 1) + end + in + let len := constr:(Z.of_nat (String.length $s)) in + let len := eval cbv in $len in + let out := String.make (ltac_int_of_Z len) (Char.of_int 0) in + ltac_copy_to_string s out 0 ; + out. + +Ltac2 base_length (s : string) : int := + let full_stop := 46 in + let n := String.length s in + let rec f i len_ext := + if Int.equal i 0 + then None + else + let i := Int.sub i 1 in + let c := String.get s i in + let len_ext := Int.add 1 len_ext in + if Int.equal full_stop (Char.to_int c) + then Some len_ext + else f i len_ext + in + match f n 0 with + | None => n + | Some l => Int.sub n l end. + +Ltac2 basename (s : string) : string := + let len := base_length s in + if Int.equal len 0 then s else + let s' := String.make len (Char.of_int 0) in + let rec cp i := + if Int.equal i 0 then () else + let i := Int.sub i 1 in + String.set s' i (String.get s i) ; cp i + in cp len ; + s'. + +Ltac2 setjvars () := + lazy_match! goal with + | [ |- context [ $$ ?i ] ] => + let s := basename (ltac_string_of_string i) in + match Ident.of_string s with + | None => Control.throw (Tactic_failure (Some (fprintf "Not a valid ident: %s (was: %t)" s i))) + | Some id => + let x := Fresh.fresh (Fresh.Free.of_goal ()) id in + set ($x := $$ $i) in * + end + end. + +End jtac. + +Ltac setjvars := ltac2:(jtac.setjvars ()). + +Ltac prog_unfold := unfold translate_prog', translate_prog, + translate_call, translate_call_body, + translate_write_lvals, translate_write_var, translate_instr, + coerce_chtuple_to_list, bind_list', bind_list_trunc_aux, + wsize_size, trunc_list, + List.nth_default. + + +#[export] Hint Rewrite coerce_typed_code_K eq_rect_K eq_rect_r_K : prog_rewrite. + +Ltac simpl_fun := + repeat (match goal with + | _ => progress autorewrite with prog_rewrite + | _ => prog_unfold; simpl + end). + +Import PackageNotation. + +Ltac swap_first_occ loc := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ _ ≈ ?c1 ⦃ _ ⦄ => + lazymatch c1 with + | #put _ := _ ;; #put loc := _ ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | #put _ := _ ;; _ ← get loc ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | _ ← get _ ;; #put loc := _ ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | _ ← get _ ;; _ ← get loc ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | _ => ssprove_sync_eq ; try intro ; swap_first_occ loc + end + end. + +Ltac swap_loc loc := + eapply r_transL; [ solve [ swap_first_occ loc ] | cmd_bind_simpl ; cbn beta ]. + +Ltac swap_loc_ignore_head loc := + eapply r_transL; [ solve [ ssprove_sync_eq ; try intro ; swap_first_occ loc ] | cmd_bind_simpl ; cbn beta ]. + +Ltac set_at_head loc := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ ?c1 ≈ _ ⦃ _ ⦄ => + lazymatch c1 with + | #put loc := _ ;; _ => idtac + | _ ← get loc ;; _ => idtac + | _ => swap_loc loc; set_at_head loc + end + end. + +Ltac set_at_snd loc := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ ?c1 ≈ _ ⦃ _ ⦄ => + lazymatch c1 with + | #put _ := _ ;; #put loc := _ ;; _ => idtac + | #put _ := _ ;; _ ← get loc ;; _ => idtac + | _ ← get _ ;; #put loc := _ ;; _ => idtac + | _ ← get _ ;; _ ← get loc ;; _ => idtac + | _ => swap_loc_ignore_head loc; set_at_snd loc + end + end. + +Ltac clear_loc loc := set_at_head loc; set_at_snd loc; first [ ssprove_contract_put_get_lhs | ssprove_contract_put_lhs ]. + +Ltac clear_get_aux c1 := + lazymatch c1 with + | _ ← get ?loc ;; _ => clear_loc loc + | #put _ := _ ;; ?c2 => clear_get_aux c2 + end. + +Ltac clear_get := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ ?c1 ≈ _ ⦃ _ ⦄ => clear_get_aux c1 + end. diff --git a/theories/Jasmin/jasmin_x86.v b/theories/Jasmin/jasmin_x86.v new file mode 100644 index 00000000..1a963da4 --- /dev/null +++ b/theories/Jasmin/jasmin_x86.v @@ -0,0 +1,134 @@ +Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word_ssrZ word. +From Jasmin Require Import expr compiler_util values expr compiler_util values sem_params flag_combination sem_op_typed sopn low_memory psem_of_sem_proof varmap psem lowering. +Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". + +From extructures Require Import ord fset fmap. +Set Warnings "-ambiguous-paths". +(* Silencing the following warning: *) +(* New coercion path [Pbool] : bool >-> pexpr is ambiguous with existing *) +(* [nat_of_bool; Posz; int_to_Z; Pconst] : bool >-> pexpr. *) +From Jasmin Require Import expr_facts. +Set Warnings "ambiguous-paths". + +From Coq Require Import Utf8. + +From Crypt Require Import Prelude Package. +Import PackageNotation. + +From Equations Require Import Equations. +Set Equations With UIP. +Set Equations Transparent. + +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. +Set Default Proof Using "Type". + +From JasminSSProve Require Import jasmin_translate jasmin_asm. + +From Jasmin Require Import + x86_instr_decl + x86_extra + x86_params + x86_params_proof + x86_decl + x86_lowering + x86. + +From Jasmin Require Import + arch_sem + compiler + compiler_proof. + +Section x86_correct. + + Lemma id_tin_instr_desc : + ∀ (a : asm_op_msb_t), + id_tin (instr_desc a) = id_tin (x86_instr_desc a.2). + Proof. + intros [[ws|] a]. + - simpl. destruct (_ == _). all: reflexivity. + - reflexivity. + Qed. + + Definition cast_sem_prod_dom {ts tr} ts' (f : sem_prod ts tr) (e : ts = ts') : + sem_prod ts' tr. + Proof. + subst. exact f. + Defined. + + Lemma cast_sem_prod_dom_K : + ∀ ts tr f e, + @cast_sem_prod_dom ts tr ts f e = f. + Proof. + intros ts tr f e. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. + Qed. + + Lemma sem_correct_rewrite : + ∀ R ts ts' f e, + sem_correct ts' (cast_sem_prod_dom ts' f e) → + @sem_correct R ts f. + Proof. + intros R ts ts' f e h. + subst. rewrite cast_sem_prod_dom_K in h. + assumption. + Qed. + + Lemma no_arr_correct {R} ts s : + List.Forall (λ t, ∀ len, t != sarr len) ts → + @sem_correct R ts s. + Proof. + intros h. + induction h as [| t ts ht h ih]. + - constructor. + - constructor. + + intros v. + pose proof unembed_embed t v as e. + destruct t as [| | len |]. + 1,2,4: rewrite e ; reflexivity. + specialize (ht len). move: ht => /eqP. contradiction. + + intros v. + apply ih. + Qed. + + Lemma x86_correct : + ∀ (o : asm_op_t), + sem_correct (tin (sopn.get_instr_desc (Oasm o))) (sopn_sem (Oasm o)). + Proof. + intros o. + simpl. admit. (* destruct o as [a | e]. *) + (* - Opaque instr_desc. simpl. *) + (* pose proof (id_tin_instr_desc a) as e. *) + (* eapply sem_correct_rewrite with (e := e). *) + (* destruct a as [o x]. simpl in *. *) + (* eapply no_arr_correct. *) + (* destruct x ; simpl. *) + (* all: repeat constructor. *) + (* Transparent instr_desc. *) + (* - destruct e ; simpl ; repeat constructor. *) + (* destruct w ; repeat constructor. *) + (* Qed. *) + Admitted. + +Context + {syscall_state : Type} + {sc_sem : syscall.syscall_sem syscall_state} + {gf : glob_decls} + {asm_scsem : asm_syscall_sem (call_conv:=x86_linux_call_conv)} + (cparams : compiler_params fresh_vars (* lowering_options *)). + + Hypothesis print_uprogP : forall s p, cparams.(print_uprog) s p = p. + Hypothesis print_sprogP : forall s p, cparams.(print_sprog) s p = p. + Hypothesis print_linearP : forall s p, cparams.(print_linear) s p = p. + + (* Definition equiv_to_x86 := @equiv_to_asm syscall_state sc_sem gf _ _ _ _ _ _ _ _ x86_linux_call_conv _ _ _ _ x86_h_params cparams print_uprogP print_sprogP print_linearP x86_correct. *) + +End x86_correct. diff --git a/theories/Jasmin/word.v b/theories/Jasmin/word.v new file mode 100644 index 00000000..082f292a --- /dev/null +++ b/theories/Jasmin/word.v @@ -0,0 +1,563 @@ +From Coq Require Import Utf8 ZArith micromega.Lia. + +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word_ssrZ word. + +(* NB: This changes the behaviour of lia, making it work on goals with ssr types *) +From mathcomp Require Import zify. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Notation "m ⊕ k" := (wxor m k) (at level 20). +Notation "m ⟫ k" := (lsr m k) (at level 20). + +Lemma lsr_word0 {n} a : word0 ⟫ a = @word0 n. +Proof. + unfold lsr. + rewrite Z.shiftr_0_l. + apply val_inj. + reflexivity. +Qed. + +Lemma wxor_0_r {n} (a : word n) : a ⊕ word0 = a. +Proof. + unfold wxor. + apply val_inj. simpl. + by rewrite Z.lxor_0_r. +Qed. + +Lemma wxor_0_l {n} (a : word n) : wxor word0 a = a. +Proof. + apply val_inj. + reflexivity. +Qed. + +Lemma wxor_involutive {n} : forall k : word n, k ⊕ k = word0. +Proof. + intros k. + apply/eqP/eq_from_wbit=> i. + rewrite !wxorE addbb. + unfold wbit. + rewrite Z.testbit_0_l. + reflexivity. +Qed. + +Lemma wxorA {n} : forall m k l : word n, ((m ⊕ k) ⊕ l) = (m ⊕ (k ⊕ l)). +Proof. + intros m k l. + apply/eqP/eq_from_wbit=> i. + by rewrite !wxorE addbA. +Qed. + +Lemma wxorC {n} (a b : word n) : a ⊕ b = b ⊕ a. +Proof. + apply/eqP/eq_from_wbit=> i. rewrite !wxorE. + rewrite addbC. reflexivity. +Qed. + +Lemma subword_word0 {n} a m : @subword n a m word0 = word0. +Proof. + unfold subword. + rewrite lsr_word0. + apply val_inj. + reflexivity. +Qed. + +Lemma wcat_eq ws p a t : + (forall (i : 'I_p), subword (i * ws) ws a = tnth t i) -> a = wcat t. +Proof. + intros. + rewrite -[a]wcat_subwordK. + apply f_equal. apply eq_from_tnth. + intros i. + rewrite -H tnth_map tnth_ord_tuple. + reflexivity. +Qed. + +Lemma nth_aux {T} (a : T) l : + [seq nth a l (val i) | i <- enum 'I_(size l)] = l. +Proof. + replace [seq nth a l (val i) | i <- enum 'I_(size l)] with [seq nth a l i | i <- [seq val i | i <- enum 'I_(size l)]]. + 2: { rewrite -map_comp. reflexivity. } + rewrite val_enum_ord. + rewrite map_nth_iota0. 2: lia. + rewrite take_size. reflexivity. +Qed. + +Lemma wcat_r_wcat {n} (l : seq (word n)) : + wcat_r l = wcat [tuple nth word0 l i | i < size l]. +Proof. + rewrite/wcat=>/=. + rewrite nth_aux. + reflexivity. +Qed. + +From Coq Require Import ZArith. + +(* following three lemmas are from fiat crypto, consider importing *) +Local Open Scope Z. +Lemma mod_pow_same_base_larger a b n m : + 0 <= n <= m -> 0 < b -> + (a mod (b^n)) mod (b^m) = a mod b^n. +Proof. + intros. + pose proof Z.mod_pos_bound a (b^n) ltac:(auto with zarith). + assert (b^n <= b^m). + { eapply Z.pow_le_mono_r; lia. } + apply Z.mod_small. auto with zarith. +Qed. + +Lemma mod_pow_same_base_smaller a b n m : + 0 <= m <= n -> 0 < b -> + (a mod (b^n)) mod (b^m) = a mod b^m. +Proof. + intros. replace n with (m+(n-m)) by lia. + rewrite -> Z.pow_add_r, Z.rem_mul_r by auto with zarith. + rewrite <- Zplus_mod_idemp_r. + rewrite <- Zmult_mod_idemp_l. + rewrite Z.mod_same. 2: eapply Z.pow_nonzero ; lia. + rewrite Z.mul_0_l. + rewrite Z.mod_0_l. 2: eapply Z.pow_nonzero ; lia. + rewrite Z.add_0_r. + rewrite Z.mod_mod. 2: eapply Z.pow_nonzero ; lia. + reflexivity. +Qed. +(* end of fiat crypto lemmas *) + +Lemma larger_modulus a n m : + (n <= m)%nat -> + (a mod modulus n) mod modulus m = a mod modulus n. +Proof. + intros H. + rewrite !modulusZE. + apply mod_pow_same_base_larger. 2: lia. + zify. simpl. lia. +Qed. + +Lemma smaller_modulus a n m : + (m <= n)%nat -> + (a mod modulus n) mod modulus m = a mod modulus m. +Proof. + intros H. + rewrite !modulusZE. + apply mod_pow_same_base_smaller. 2: lia. + zify. simpl. lia. +Qed. + +Lemma wbit_subword {ws1} i ws2 (w : word ws1) (j : 'I_ws2) : + wbit (subword i ws2 w) j = wbit w (i + j)%nat. +Proof. + intros. + unfold subword. + rewrite wbit_mkword. + apply wbit_lsr. +Qed. + +Lemma subword_wshr {n} i j m (w : word n) : + subword i m (lsr w j) = subword (j + i) m w. +Proof. + intros. + apply/eqP/eq_from_wbit. + intros. + rewrite !wbit_subword. + rewrite wbit_lsr. + f_equal. + lia. +Qed. + +Lemma subword_xor {n} i ws (a b : n.-word) : + subword i ws (a ⊕ b) = (subword i ws a) ⊕ (subword i ws b). +Proof. + apply/eqP/eq_from_wbit. + intros. rewrite !wbit_subword. + rewrite !wxorE. + rewrite !wbit_subword. + reflexivity. +Qed. + +(** AES *) + +Lemma subword_subword {k} i j n m (w : k.-word) : (i + n <= m)%nat -> subword i n (subword j m w) = subword (i + j) n w. +Proof. + intros. + apply/eqP/eq_from_wbit => l. + rewrite !wbit_subword. + assert (i + l < m)%nat. 1: destruct l; simpl; lia. + change (i + l)%nat with (@Ordinal m (i + l) H0 : nat). + rewrite wbit_subword. + f_equal. + simpl. lia. +Qed. + +Locate "`_". + +Lemma divn_aux j i n : + (j < n)%nat -> + (n <= j %% n + i %% n)%nat = false -> + (j + i) %/ n = i %/ n. +Proof. + intros H1 H2. + rewrite divnD. 2: lia. + rewrite H2. + rewrite divn_small. all: lia. +Qed. + +Lemma modn_aux j i n : + (j < n)%nat -> + (n <= j %% n + i %% n)%nat = false -> + (j + i) %% n = (j + i %% n)%nat. +Proof. + intros H1 H2. + rewrite modnD. 2: lia. + rewrite H2. + rewrite modn_small. all: lia. +Qed. + +(* Local Open Scope ring_scope. *) +Lemma subword_wcat {n p} i l (s : p.-tuple n.-word) : + (* i + l does 'reach across' a single word in the tuple *) + (l <= n)%nat -> + ((l - 1) %% n + i %% n < n)%nat -> + subword i l (wcat s) = subword (i %% n) l (s`_(i %/ n))%R. +Proof. + intros H1 (* H2 *) H3. + rewrite !subwordE. + f_equal. + apply eq_mktuple => j. + rewrite wcat_wbitE. + destruct j. simpl. + f_equal. + - f_equal. f_equal. + apply divn_aux. 1:{ simpl. lia. } + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 2: lia. + lia. + - apply modn_aux. 1: lia. + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 1: lia. + lia. +Qed. + +(* Lemma nth_wsplitnec {n p} (i : 'I_p) (w : (n * p).-word) : *) +(* (* (n < n %/ l + n %% l)%nat -> *) *) +(* ((wsplitn w)`_i)%R = subword (i * n) n w. *) +(* Proof. *) +(* (* intros H. *) *) +(* (* unfold split_vec. *) *) +(* unfold wsplitn. *) +(* (* Unset Printing Notations. *) *) +(* (* pose proof nth_mktuple . *) *) +(* rewrite *) +(* rewrite (nth_map 0). *) +(* erewrite nth_map. *) +(* 1: f_equal; rewrite nth_iota; try lia. *) +(* rewrite size_iota. *) +(* assumption. *) +(* Unshelve. exact 0%nat. *) +(* Qed. *) + +Lemma mkword_word {n} (w : n.-word) : + mkword n w = w. +Proof. + apply val_inj; simpl. + rewrite Z.mod_small. + 1: reflexivity. + destruct w. simpl. lia. +Qed. + +Lemma subword_u {n} (w : n.-word) : subword 0 n w = w. +Proof. + unfold subword. unfold lsr. rewrite Z.shiftr_0_r. rewrite ureprK. + apply mkword_word. +Qed. + +From Jasmin Require Import word. + +(* Lemma make_vec_eq {ws1 ws2 : wsize} {p : nat} a t : *) +(* (p * ws1 = ws2) -> *) +(* (forall (i : 'I_p), subword (i * ws1) ws1 a = nth word0 t i) -> a = make_vec ws2 t. *) +(* Proof. *) +(* intros. *) +(* unfold make_vec. *) +(* unfold wrepr. *) +(* apply val_inj. *) +(* simpl. *) +(* rewrite wcat *) + +(* Lemma wcat_eq ws p a t : *) +(* (forall (i : 'I_p), subword (i * ws) ws a = tnth t i) -> a = wcat t. *) +(* Proof. *) +(* intros. *) +(* rewrite -[a]wcat_subwordK. *) +(* apply f_equal. apply eq_from_tnth. *) +(* intros i. *) +(* rewrite -H tnth_map tnth_ord_tuple. *) +(* reflexivity. *) +(* Qed. *) + +Lemma wbit_wrepr (ws : wsize.wsize) a i : + (i < ws)%nat -> + word.word.wbit (urepr (wrepr ws a)) i = word.word.wbit a i. +Proof. + move=>H/=. + rewrite/word.word.wbit/wrepr/urepr=>/=. + rewrite/modulus two_power_nat_equiv Z.mod_pow2_bits_low=>//. + unfold nat_of_wsize in *. lia. +Qed. + +Lemma wbit_make_vec {ws1} (ws2 : wsize) (l : seq (word.word ws1)) i : + (i < ws2)%nat -> + word.word.wbit (urepr (make_vec ws2 l)) i = word.word.wbit (nth word0 l (i %/ ws1)) (i %% ws1). +Proof. + move=> H. + rewrite /make_vec wcat_r_wcat wbit_wrepr=>//. + rewrite wcat_wbitE=>/=. + repeat f_equal. + apply nth_aux. +Qed. + +Lemma wbit_n_make_vec {ws1} (ws2 : wsize) (l : seq (word ws1)) i : + (i < ws2)%nat -> + wbit_n (make_vec ws2 l) i = wbit_n (nth word0 l (i %/ ws1)) (i %% ws1). +Proof. + move=> H. + unfold wbit_n. + rewrite /make_vec wcat_r_wcat wbit_wrepr=>//. + rewrite wcat_wbitE=>/=. + repeat f_equal. + rewrite nth_aux. + reflexivity. +Qed. + +Lemma subword_make_vec_full {ws1} i (ws2 ws3 : wsize.wsize) (l : seq (word.word ws1)) : + (* i + ws2 does 'reach across' a single word in the list *) + (ws2 <= ws1)%nat -> + (i + ws2 <= ws3)%nat -> + (ws1 <= (ws2 - 1) %% ws1 + i %% ws1)%nat = false -> + (* i think this condition is equivalent, but the others fit with other lemmas *) + (* ((i + ws2 - 1) / ws1)%nat = (i / ws1)%nat -> *) + subword i ws2 (make_vec ws3 l) = subword (i %% ws1) ws2 (nth word0 l (i %/ ws1)%nat). +Proof. + intros H1 H2 H3. + rewrite !subwordE. + f_equal. + apply eq_mktuple. + intros j. + destruct j. simpl. + rewrite wbit_make_vec. 2: lia. + f_equal. + - f_equal. f_equal. + apply divn_aux. 1:{ simpl. lia. } + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 2: lia. + lia. + - apply modn_aux. 1: lia. + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 1: lia. + lia. +Qed. + +(* Lemma subw *) + +Lemma subword_make_vec {ws1} i (ws2 : wsize.wsize) (l : seq (word.word ws1)) : + (ws1 <= ws2)%nat -> + ((i + 1) * ws1 <= ws2)%nat -> + subword (i * ws1) ws1 (make_vec ws2 l) = nth word0 l i. +Proof. + intros H1 H2. + rewrite subword_make_vec_full. + all: try lia. + { rewrite modnMl mulnK. + 2: { unfold nat_of_wsize; lia. } + apply subword_u. } + rewrite modnMl. unfold nat_of_wsize. lia. +Qed. + +Lemma make_vec_ws ws (l : seq (word ws)) : + make_vec ws l = nth word0 l 0. +Proof. + apply/eqP. apply/eq_from_wbit. + intros [i]. + rewrite wbit_make_vec=>/=. + 2: unfold nat_of_wsize in *; lia. + rewrite divn_small. + 2: unfold nat_of_wsize in *; lia. + rewrite modn_small. + 2: unfold nat_of_wsize in *; lia. + reflexivity. +Qed. + +Lemma make_vec_single {ws1} ws2 (a : word ws1) : + make_vec ws2 [:: a] = zero_extend ws2 a. +Proof. + unfold make_vec. cbn -[Z.of_nat]. + by rewrite Z.shiftl_0_l Z.lor_0_r. +Qed. + +Lemma wshr_word0 {ws} i : @wshr ws 0 i = word0. +Proof. + unfold wshr. by rewrite lsr_word0. +Qed. + +Lemma nth_split_vec {ws1} ws2 n (d : word ws2) (w : word ws1) : + (n < ws1 %/ ws2 + ws1 %% ws2)%nat -> + nth d (split_vec ws2 w) n = subword (n * ws2) ws2 w. +Proof. + intros H. + unfold split_vec. + erewrite nth_map. + 1: f_equal; rewrite nth_iota; try lia. + rewrite size_iota. + assumption. + Unshelve. exact 0%nat. +Qed. + +From Jasmin Require Import waes utils xseq. + +Lemma subword_U8_SubWord n w : + (0 <= n < 4)%nat -> + subword (n * U8) U8 (SubWord w) = Sbox (subword (n * U8) U8 w). +Proof. + intros. + unfold SubWord. + rewrite subword_make_vec. + 1: erewrite nth_map; f_equal. + all: try (unfold nat_of_wsize, wsize_size_minus_1; zify; simpl; lia). + apply nth_split_vec. + cbn. lia. + Unshelve. exact word0. +Qed. + +Lemma split_vec_make_vec {ws1} (ws2 : wsize.wsize) (l : seq (word.word ws1)) : + (ws2 %% ws1 = 0)%nat -> + (size l = ws2 %/ ws1)%nat -> + split_vec ws1 (make_vec ws2 l) = l. +Proof. + destruct l. + - intros . + unfold make_vec, split_vec. + rewrite -H0 H. + reflexivity. + - intros Hmod Hsize. + unfold split_vec. + rewrite <- take_size. + erewrite <- map_nth_iota0. + 2: easy. + rewrite Hsize Hmod addn0. + apply map_ext. + intros. + apply subword_make_vec. + 1: simpl in Hsize; nia. + move: H => /InP. rewrite mem_iota. + nia. +Qed. + +Lemma SubWord_make_vec l : + (size l = 4)%nat -> + SubWord (make_vec U32 l) = make_vec U32 [seq Sbox i | i <- l]. +Proof. + intros. + unfold SubWord. + rewrite split_vec_make_vec. + all: unfold nat_of_wsize, wsize_size_minus_1; easy. +Qed. + +Lemma SubBytes_make_vec l : + (size l = 4)%nat -> + SubBytes (make_vec U128 l) = make_vec U128 [seq SubWord i | i <- l]. +Proof. + intros. + unfold SubBytes. + rewrite split_vec_make_vec. + all: unfold nat_of_wsize, wsize_size_minus_1; easy. +Qed. + +Lemma subword_make_vec_32_0_32_128 (l : seq u32) : subword 0 U32 (make_vec U128 l) = nth word0 l 0. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + +Lemma subword_make_vec_32_1_32_128 (l : seq u32) : subword U32 U32 (make_vec U128 l) = nth word0 l 1. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + +Lemma subword_make_vec_32_2_32_128 (l : seq u32) : subword (2 * U32) U32 (make_vec U128 l) = nth word0 l 2. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + +Lemma subword_make_vec_32_3_32_128 (l : seq u32) : subword (3 * U32) U32 (make_vec U128 l) = nth word0 l 3. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + + +Lemma wreprI ws (a : word.word ws) : wrepr ws (toword a) = a. +Proof. + apply val_inj. simpl. destruct a. rewrite Z.mod_small. 1: reflexivity. + simpl in *. lia. +Qed. + +(** AES *) + +Lemma subword_SubWord n w : + (0 <= n < 4)%nat -> subword (n * U8) U8 (SubWord w) = Sbox (subword (n * U8) U8 w). +Proof. + intros. + unfold SubWord. + rewrite subword_make_vec. + 1: erewrite nth_map; f_equal. + all: try (unfold nat_of_wsize, wsize_size_minus_1; zify; simpl; lia). + apply nth_split_vec. + cbn. lia. + Unshelve. exact word0. +Qed. + +Lemma subword_SubBytes n w : (0 <= n < 4)%nat -> subword (n * U32) U32 (SubBytes w) = SubWord (subword (n * U32) U32 w). +Proof. + intros. + unfold SubBytes. + rewrite subword_make_vec. + 1: erewrite nth_map; f_equal. + all: try (unfold nat_of_wsize, wsize_size_minus_1; zify; simpl; lia). + apply nth_split_vec. + cbn. lia. + Unshelve. exact word0. +Qed. + +Lemma ShiftRows_SubBytes s : ShiftRows (SubBytes s) = SubBytes (ShiftRows s). +Proof. + unfold ShiftRows. simpl. + rewrite !subword_SubBytes; try reflexivity. + rewrite !subword_SubWord; try reflexivity. + rewrite SubBytes_make_vec; auto. simpl. + rewrite !SubWord_make_vec; auto. +Qed. + +Lemma RotWord_SubWord w : RotWord (SubWord w) = SubWord (RotWord w). +Proof. + unfold RotWord. + rewrite SubWord_make_vec; auto. + rewrite !subword_SubWord; auto. +Qed. + +Lemma wAESENC_wAESENC_ s k : wAESENC s k = wAESENC_ s k. +Proof. + unfold wAESENC, wAESENC_. + f_equal. f_equal. + rewrite ShiftRows_SubBytes. + reflexivity. +Qed. + +Lemma wAESENCLAST_wAESENCLAST_ s k : wAESENCLAST s k = wAESENCLAST_ s k. +Proof. + unfold wAESENCLAST, wAESENCLAST_. + rewrite ShiftRows_SubBytes. + reflexivity. +Qed. diff --git a/theories/Mon/SPropMonadicStructures.v b/theories/Mon/SPropMonadicStructures.v index 6b56cf7f..b24e069b 100644 --- a/theories/Mon/SPropMonadicStructures.v +++ b/theories/Mon/SPropMonadicStructures.v @@ -130,10 +130,6 @@ Section DiscreteMonad. Import SPropNotations. Program Definition DiscreteMonad (M:Monad) : OrderedMonad := @mkOrderedMonad M (fun A x y => x = y) _ _. - Next Obligation. - constructor. by cbv. - cbv. move=> *. etransitivity ; by eassumption. - Qed. Next Obligation. compute. move=> x y Exy x0 y0 pe_x0y0. rewrite Exy. apply functional_extensionality in pe_x0y0. diff --git a/theories/Relational/GenericRulesSimple.v b/theories/Relational/GenericRulesSimple.v index 9fe9d4a7..acb584e8 100644 --- a/theories/Relational/GenericRulesSimple.v +++ b/theories/Relational/GenericRulesSimple.v @@ -208,7 +208,7 @@ Section GoingPractical. move=> H1 H2 ; apply weaken_rule2. enough (c2 = skip ;; c2) as ->. enough (c1 = bind c1 ret) as ->. - apply seq_rule=> // ? ?; eapply weaken_rule2; [apply H2| cbv ;intuition]. + apply seq_rule=> // ? ?; eapply weaken_rule2. rewrite /bind monad_law2 //. rewrite /bind monad_law1 //. Qed. diff --git a/theories/Relational/OrderEnrichedRelativeMonadExamples.v b/theories/Relational/OrderEnrichedRelativeMonadExamples.v index 26ce618c..0f5ba16e 100644 --- a/theories/Relational/OrderEnrichedRelativeMonadExamples.v +++ b/theories/Relational/OrderEnrichedRelativeMonadExamples.v @@ -82,7 +82,7 @@ Section OrdCat. apply Hx. apply GX. Qed. Next Obligation. cbv ; intuition. Qed. - Next Obligation. cbv ; intuition. apply H3; apply H2 => //. Qed. + Next Obligation. cbv ; intuition. apply H0; apply H => //. Qed. Next Obligation. cbv ; intuition; etransitivity; first (apply: x∙2; apply: H0). apply: H. diff --git a/theories/Relational/Rel.v b/theories/Relational/Rel.v index 83e124ea..ae2f0578 100644 --- a/theories/Relational/Rel.v +++ b/theories/Relational/Rel.v @@ -145,7 +145,6 @@ Section RelCat. Program Definition RelCat := mkCategory Rel arrRel (fun _ _ f1 f2 => f1 = f2) _ idRel (fun _ _ _ f g => compRel g f) _ _ _ _. - Next Obligation. cbv ; intuition. induction H. induction H0=> //. Qed. Definition rel_one : Rel := ⦑unit, unit| fun _ _ => unit⦒. Definition to_rel_one X : RelCat⦅X;rel_one⦆ :=