├── package.nix ├── AUTHORS ├── .nix ├── coq-nix-toolbox.nix └── config.nix ├── CeCILL-B ├── config.nix ├── dune-project ├── dune ├── .gitignore ├── theories ├── all_real_closed.v ├── polyorder.v ├── mxtens.v ├── qe_rcf.v └── ordered_qelim.v ├── default.nix ├── _CoqProject ├── Makefile ├── .github └── workflows │ ├── docker-action.yml │ ├── nix-action-9.0.yml │ └── nix-action-9.1.yml ├── coq-mathcomp-real-closed.opam ├── index.md ├── README.md └── meta.yml /package.nix: -------------------------------------------------------------------------------- 1 | "mathcomp-real-closed" 2 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Cyril Cohen Inria 2 | Assia Mahboubi Inria 3 | -------------------------------------------------------------------------------- /.nix/coq-nix-toolbox.nix: -------------------------------------------------------------------------------- 1 | "e8e8d7c817985ee093a9b49b0e8a4b802e0ac68b" 2 | -------------------------------------------------------------------------------- /CeCILL-B: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/math-comp/real-closed/HEAD/CeCILL-B -------------------------------------------------------------------------------- /config.nix: -------------------------------------------------------------------------------- 1 | { 2 | coq = "8.11"; 3 | mathcomp = "mathcomp-1.12.0"; 4 | } 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.5) 2 | (using coq 0.2) 3 | (name real-closed) 4 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name mathcomp.real_closed) 3 | (package coq-mathcomp-real-closed) 4 | (synopsis "Mathematical Components Library on real closed fields")) 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.d 2 | *.vo 3 | *.vio 4 | *.vos 5 | *.vok 6 | *.cm* 7 | *~ 8 | *.glob 9 | *.aux 10 | *.a 11 | *.o 12 | Make*.coq 13 | Make*.coq.bak 14 | Make*.coq.conf 15 | -------------------------------------------------------------------------------- /theories/all_real_closed.v: -------------------------------------------------------------------------------- 1 | Require Export cauchyreals. 2 | Require Export complex. 3 | Require Export ordered_qelim. 4 | Require Export polyorder. 5 | Require Export polyrcf. 6 | Require Export qe_rcf_th. 7 | Require Export qe_rcf. 8 | Require Export realalg. 9 | Require Export mxtens. -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, 2 | update-nixpkgs ? false, ci-matrix ? false, 3 | override ? {}, ocaml-override ? {}, global-override ? {}, 4 | bundle ? null, job ? null, inNixShell ? null, src ? ./., 5 | }@args: 6 | let auto = fetchGit { 7 | url = "https://github.com/coq-community/coq-nix-toolbox.git"; 8 | ref = "master"; 9 | rev = import .nix/coq-nix-toolbox.nix; 10 | }; 11 | in 12 | import auto ({inherit src;} // args) 13 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | theories/all_real_closed.v 2 | theories/cauchyreals.v 3 | theories/complex.v 4 | theories/ordered_qelim.v 5 | theories/polyorder.v 6 | theories/polyrcf.v 7 | theories/qe_rcf_th.v 8 | theories/qe_rcf.v 9 | theories/realalg.v 10 | theories/mxtens.v 11 | 12 | -R theories mathcomp.real_closed 13 | -arg -w -arg -projection-no-head-constant 14 | -arg -w -arg -redundant-canonical-projection 15 | -arg -w -arg -notation-overridden 16 | -arg -w -arg +duplicate-clear 17 | -arg -w -arg +non-primitive-record 18 | -arg -w -arg +undeclared-scope 19 | -arg -w -arg -ambiguous-paths 20 | -arg -w -arg -uniform-inheritance 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # KNOWNTARGETS will not be passed along to CoqMakefile 2 | KNOWNTARGETS := Makefile.coq 3 | # KNOWNFILES will not get implicit targets from the final rule, and so 4 | # depending on them won't invoke the submake 5 | # Warning: These files get declared as PHONY, so any targets depending 6 | # on them always get rebuilt 7 | KNOWNFILES := Makefile _CoqProject 8 | 9 | .DEFAULT_GOAL := invoke-coqmakefile 10 | 11 | Makefile.coq: Makefile _CoqProject 12 | $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq 13 | 14 | invoke-coqmakefile: Makefile.coq 15 | $(MAKE) --no-print-directory -f Makefile.coq $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) 16 | 17 | .PHONY: invoke-coqmakefile $(KNOWNFILES) 18 | 19 | #################################################################### 20 | ## Your targets here ## 21 | #################################################################### 22 | 23 | # This should be the last rule, to handle any targets not declared above 24 | %: invoke-coqmakefile 25 | @true 26 | -------------------------------------------------------------------------------- /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Docker CI 4 | 5 | on: 6 | push: 7 | branches: 8 | - master 9 | pull_request: 10 | branches: 11 | - '**' 12 | 13 | jobs: 14 | build: 15 | # the OS must be GNU/Linux to be able to use the docker-coq-action 16 | runs-on: ubuntu-latest 17 | strategy: 18 | matrix: 19 | image: 20 | - 'mathcomp/mathcomp:2.4.0-rocq-prover-9.0' 21 | - 'mathcomp/mathcomp-dev:rocq-prover-dev' 22 | fail-fast: false 23 | steps: 24 | - uses: actions/checkout@v4 25 | - uses: coq-community/docker-coq-action@v1 26 | with: 27 | opam_file: 'coq-mathcomp-real-closed.opam' 28 | custom_image: ${{ matrix.image }} 29 | 30 | 31 | # See also: 32 | # https://github.com/coq-community/docker-coq-action#readme 33 | # https://github.com/erikmd/docker-coq-github-action-demo 34 | -------------------------------------------------------------------------------- /coq-mathcomp-real-closed.opam: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | 4 | opam-version: "2.0" 5 | maintainer: "Cyril Cohen " 6 | version: "dev" 7 | 8 | homepage: "https://github.com/math-comp/real-closed" 9 | dev-repo: "git+https://github.com/math-comp/real-closed.git" 10 | bug-reports: "https://github.com/math-comp/real-closed/issues" 11 | license: "CECILL-B" 12 | 13 | synopsis: "Mathematical Components Library on real closed fields" 14 | description: """ 15 | This library contains definitions and theorems about real closed 16 | fields, with a construction of the real closure and the algebraic 17 | closure (including a proof of the fundamental theorem of 18 | algebra). It also contains a proof of decidability of the first 19 | order theory of real closed field, through quantifier elimination.""" 20 | 21 | build: [make "-j%{jobs}%"] 22 | install: [make "install"] 23 | depends: [ 24 | "rocq-core" {>= "9.0"} 25 | "rocq-mathcomp-ssreflect" {>= "2.4"} 26 | "rocq-mathcomp-algebra" 27 | "rocq-mathcomp-field" 28 | "coq-mathcomp-bigenough" {>= "1.0.0"} 29 | ] 30 | 31 | tags: [ 32 | "keyword:real closed field" 33 | "logpath:mathcomp.real_closed" 34 | ] 35 | authors: [ 36 | "Cyril Cohen" 37 | "Assia Mahboubi" 38 | ] 39 | -------------------------------------------------------------------------------- /index.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Real closed fields 3 | lang: en 4 | header-includes: 5 | - | 6 | 7 | 8 | 9 | 10 | 11 | --- 12 | 13 |
14 | View the project on GitHub 15 |
16 | 17 | ## About 18 | 19 | Welcome to the Real closed fields project website! 20 | 21 | This library contains definitions and theorems about real closed 22 | fields, with a construction of the real closure and the algebraic 23 | closure (including a proof of the fundamental theorem of 24 | algebra). It also contains a proof of decidability of the first 25 | order theory of real closed field, through quantifier elimination. 26 | 27 | This is an open source project, licensed under the CeCILL-B. 28 | 29 | ## Get the code 30 | 31 | The current stable release of Real closed fields can be [downloaded from GitHub](https://github.com/math-comp/real-closed/releases). 32 | 33 | ## Documentation 34 | 35 | 36 | Related publications, if any, are listed below. 37 | 38 | - [Formal proofs in real algebraic geometry: from ordered fields to quantifier elimination](https://hal.inria.fr/inria-00593738v4) doi:[10.2168/LMCS-8(1:2)2012](https://doi.org/10.2168/LMCS-8(1:2)2012) 39 | - [Construction of real algebraic numbers in Coq](https://hal.inria.fr/hal-00671809v2) doi:[10.1007/978-3-642-32347-8_6](https://doi.org/10.1007/978-3-642-32347-8_6) 40 | 41 | ## Help and contact 42 | 43 | - Report issues on [GitHub](https://github.com/math-comp/real-closed/issues) 44 | 45 | ## Authors and contributors 46 | 47 | - Cyril Cohen 48 | - Assia Mahboubi 49 | 50 | -------------------------------------------------------------------------------- /.nix/config.nix: -------------------------------------------------------------------------------- 1 | { 2 | ## DO NOT CHANGE THIS 3 | format = "1.0.0"; 4 | ## unless you made an automated or manual update 5 | ## to another supported format. 6 | 7 | ## The attribute to build from the local sources, 8 | ## either using nixpkgs data or the overlays located in `.nix/coq-overlays` 9 | ## Will determine the default main-job of the bundles defined below 10 | attribute = "mathcomp-real-closed"; 11 | 12 | ## Set this when the package has no rocqPackages version yet 13 | ## (either in nixpkgs or in .nix/rocq-overlays) 14 | no-rocq-yet = true; 15 | 16 | ## If you want to select a different attribute (to build from the local sources as well) 17 | ## when calling `nix-shell` and `nix-build` without the `--argstr job` argument 18 | # shell-attribute = "{{nix_name}}"; 19 | 20 | ## Maybe the shortname of the library is different from 21 | ## the name of the nixpkgs attribute, if so, set it here: 22 | # pname = "{{shortname}}"; 23 | 24 | ## Lists the dependencies, phrased in terms of nix attributes. 25 | ## No need to list Coq, it is already included. 26 | ## These dependencies will systematically be added to the currently 27 | ## known dependencies, if any more than Coq. 28 | ## /!\ Remove this field as soon as the package is available on nixpkgs. 29 | ## /!\ Manual overlays in `.nix/coq-overlays` should be preferred then. 30 | # buildInputs = [ ]; 31 | 32 | ## Indicate the relative location of your _CoqProject 33 | ## If not specified, it defaults to "_CoqProject" 34 | # coqproject = "_CoqProject"; 35 | 36 | ## select an entry to build in the following `bundles` set 37 | ## defaults to "default" 38 | default-bundle = "9.0"; 39 | 40 | ## write one `bundles.name` attribute set per 41 | ## alternative configuration 42 | ## When generating GitHub Action CI, one workflow file 43 | ## will be created per bundle 44 | bundles = let 45 | master-overrides = { 46 | coqeal.override.version = "master"; 47 | mathcomp-apery.override.version = "master"; 48 | mathcomp-algebra-tactics.override.version = "master"; 49 | mathcomp-bigenough.override.version = "master"; 50 | mathcomp-finmap.override.version = "master"; 51 | mathcomp-zify.override.version = "master"; 52 | multinomials.override.version = "master"; 53 | mathcomp-abel.override.version = "master"; 54 | }; 55 | revdeps-overrides = { 56 | coqeal.override.version = "master"; 57 | mathcomp-apery.override.version = "master"; 58 | }; 59 | in { 60 | "9.0" = { rocqPackages = { 61 | rocq-core.override.version = "9.0"; 62 | }; coqPackages = revdeps-overrides // { 63 | coq.override.version = "9.0"; 64 | coq-elpi.job = true; 65 | hierarchy-builder.job = true; 66 | mathcomp.override.version = "2.3.0"; 67 | mathcomp-apery.job = false; # no longer compatible with MC 2.3 68 | }; }; 69 | "9.1" = { rocqPackages = { 70 | rocq-core.override.version = "9.1"; 71 | }; coqPackages = revdeps-overrides // { 72 | coq.override.version = "9.1"; 73 | coq-elpi.job = true; 74 | hierarchy-builder.job = true; 75 | mathcomp.override.version = "2.4.0"; 76 | }; }; 77 | "master" = { 78 | rocqPackages = { 79 | rocq-core.override.version = "master"; 80 | stdlib.override.version = "master"; 81 | bignums.override.version = "master"; 82 | rocq-elpi.override.version = "master"; 83 | rocq-elpi.override.elpi-version = "3.3.0"; 84 | hierarchy-builder.override.version = "master"; 85 | }; 86 | coqPackages = master-overrides // { 87 | coq.override.version = "master"; 88 | stdlib.override.version = "master"; 89 | bignums.override.version = "master"; 90 | coq-elpi.override.version = "master"; 91 | coq-elpi.override.elpi-version = "3.3.0"; 92 | hierarchy-builder.override.version = "master"; 93 | mathcomp.override.version = "master"; 94 | }; }; 95 | }; 96 | 97 | ## Cachix caches to use in CI 98 | ## Below we list some standard ones 99 | cachix.coq = {}; 100 | cachix.math-comp.authToken = "CACHIX_AUTH_TOKEN"; 101 | cachix.coq-community = {}; 102 | 103 | ## If you have write access to one of these caches you can 104 | ## provide the auth token or signing key through a secret 105 | ## variable on GitHub. Then, you should give the variable 106 | ## name here. For instance, coq-community projects can use 107 | ## the following line instead of the one above: 108 | # cachix.coq-community.authToken = "CACHIX_AUTH_TOKEN"; 109 | 110 | ## Or if you have a signing key for a given Cachix cache: 111 | # cachix.my-cache.signingKey = "CACHIX_SIGNING_KEY" 112 | 113 | ## Note that here, CACHIX_AUTH_TOKEN and CACHIX_SIGNING_KEY 114 | ## are the names of secret variables. They are set in 115 | ## GitHub's web interface. 116 | } 117 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 5 | # Real closed fields 6 | 7 | [![Docker CI][docker-action-shield]][docker-action-link] 8 | 9 | [docker-action-shield]: https://github.com/math-comp/real-closed/actions/workflows/docker-action.yml/badge.svg?branch=master 10 | [docker-action-link]: https://github.com/math-comp/real-closed/actions/workflows/docker-action.yml 11 | 12 | 13 | 14 | 15 | This library contains definitions and theorems about real closed 16 | fields, with a construction of the real closure and the algebraic 17 | closure (including a proof of the fundamental theorem of 18 | algebra). It also contains a proof of decidability of the first 19 | order theory of real closed field, through quantifier elimination. 20 | 21 | ## Meta 22 | 23 | - Author(s): 24 | - Cyril Cohen (initial) 25 | - Assia Mahboubi (initial) 26 | - License: [CeCILL-B](CECILL-B) 27 | - Compatible Rocq/Coq versions: Rocq 9.0 or later 28 | - Additional dependencies: 29 | - [MathComp ssreflect 2.4 or later](https://math-comp.github.io) 30 | - [MathComp algebra](https://math-comp.github.io) 31 | - [MathComp field](https://math-comp.github.io) 32 | - [MathComp bigenough 1.0.0 or later](https://github.com/math-comp/bigenough) 33 | - Rocq/Coq namespace: `mathcomp.real_closed` 34 | - Related publication(s): 35 | - [Formal proofs in real algebraic geometry: from ordered fields to quantifier elimination](https://hal.inria.fr/inria-00593738v4) doi:[10.2168/LMCS-8(1:2)2012](https://doi.org/10.2168/LMCS-8(1:2)2012) 36 | - [Construction of real algebraic numbers in Coq](https://hal.inria.fr/hal-00671809v2) doi:[10.1007/978-3-642-32347-8_6](https://doi.org/10.1007/978-3-642-32347-8_6) 37 | 38 | ## Building and installation instructions 39 | 40 | The easiest way to install the latest released version of Real closed fields 41 | is via [OPAM](https://opam.ocaml.org/doc/Install.html): 42 | 43 | ```shell 44 | opam repo add coq-released https://coq.inria.fr/opam/released 45 | opam install coq-mathcomp-real-closed 46 | ``` 47 | 48 | To instead build and install manually, do: 49 | 50 | ``` shell 51 | git clone https://github.com/math-comp/real-closed.git 52 | cd real-closed 53 | make # or make -j 54 | make install 55 | ``` 56 | 57 | 58 | 59 | ## Documentation 60 | The repository contains 61 | - the decision procedure `rcf_sat` and its corectness lemma [`rcf_satP`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/qe_rcf.v#L991) for the first order theory of real closed fields through 62 | [certified quantifier elimination](https://hal.inria.fr/inria-00593738v4) 63 | - the definition `{realclosure F}` , a [construction of the real closure of an archimedean field](https://hal.inria.fr/hal-00671809v2), which is canonically a [`rcfType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L63) when `F` is an archimedean field, and the characteristic theorems of section [`RealClosureTheory`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/realalg.v#L1477). 64 | - the definition `complex R`, a construction of the algebraic closure of a real closed field, which is canonically a [`numClosedFieldType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L73) that additionally satisfies [`complexalg_algebraic`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/complex.v#L1324). 65 | 66 | Except for the end-results listed above, one should not rely on anything. 67 | 68 | The formalization is based on the [Mathematical Components](https://github.com/math-comp/math-comp) 69 | library for the [Rocq](https://rocq-prover.org/) prover. 70 | 71 | 72 | ## Development instructions 73 | 74 | ### With nix. 75 | 76 | 1. Install nix: 77 | - To install it on a single-user unix system where you have admin 78 | rights, just type: 79 | 80 | > sh <(curl https://nixos.org/nix/install) 81 | 82 | You should run this under your usual user account, not as 83 | root. The script will invoke `sudo` as needed. 84 | 85 | For other configurations (in particular if multiple users share 86 | the machine) or for nix uninstallation, go to the [appropriate 87 | section of the nix 88 | manual](https://nixos.org/nix/manual/#ch-installing-binary). 89 | 90 | - You need to **log out of your desktop session and log in again** before you proceed to step 2. 91 | 92 | - Step 1. only need to be done once on a same machine. 93 | 94 | 2. Open a new terminal. Navigate to the root of the Abel repository. Then type: 95 | > nix-shell 96 | 97 | - This will download and build the required packages, wait until 98 | you get a shell. 99 | - You need to type this command every time you open a new terminal. 100 | - You can call `nixEnv` after you start the nix shell to see your 101 | work environemnet (or call `nix-shell` with option `--arg 102 | print-env true`). 103 | 104 | 3. You are now in the correct work environment. You can do 105 | > make 106 | 107 | and do whatever you are accustomed to do with Rocq. 108 | 109 | 4. In particular, you can edit files using `emacs` or `coqide`. 110 | 111 | - If you were already using emacs with proof general, make sure you 112 | empty your `coq-prog-name` variables and any other proof general 113 | options that used to be tied to a previous local installation of 114 | Rocq. 115 | - If you do not have emacs installed, but want to use it, you can 116 | go back to step 2. and call `nix-shell` with the following option 117 | > nix-shell --arg withEmacs true 118 | 119 | in order to get a temporary installation of emacs and 120 | proof-general. Make sure you add `(require 'proof-site)` to your 121 | `$HOME/.emacs`. 122 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | fullname: Real closed fields 2 | shortname: real-closed 3 | organization: math-comp 4 | opam_name: coq-mathcomp-real-closed 5 | community: false 6 | action: true 7 | coqdoc: false 8 | 9 | synopsis: >- 10 | Mathematical Components Library on real closed fields 11 | description: |- 12 | This library contains definitions and theorems about real closed 13 | fields, with a construction of the real closure and the algebraic 14 | closure (including a proof of the fundamental theorem of 15 | algebra). It also contains a proof of decidability of the first 16 | order theory of real closed field, through quantifier elimination. 17 | 18 | publications: 19 | - pub_url: https://hal.inria.fr/inria-00593738v4 20 | pub_title: "Formal proofs in real algebraic geometry: from ordered fields to quantifier elimination" 21 | pub_doi: 10.2168/LMCS-8(1:2)2012 22 | - pub_url: https://hal.inria.fr/hal-00671809v2 23 | pub_title: Construction of real algebraic numbers in Coq 24 | pub_doi: 10.1007/978-3-642-32347-8_6 25 | 26 | authors: 27 | - name: Cyril Cohen 28 | initial: true 29 | - name: Assia Mahboubi 30 | initial: true 31 | 32 | opam-file-maintainer: Cyril Cohen 33 | 34 | opam-file-version: dev 35 | 36 | license: 37 | fullname: CeCILL-B 38 | identifier: CECILL-B 39 | file: CECILL-B 40 | 41 | supported_coq_versions: 42 | text: Rocq 9.0 or later 43 | opam: '{>= "9.0"}' 44 | 45 | tested_coq_opam_versions: 46 | - version: '2.4.0-rocq-prover-9.0' 47 | repo: 'mathcomp/mathcomp' 48 | - version: 'rocq-prover-dev' 49 | repo: 'mathcomp/mathcomp-dev' 50 | 51 | dependencies: 52 | - opam: 53 | name: rocq-mathcomp-ssreflect 54 | version: '{>= "2.4"}' 55 | description: |- 56 | [MathComp ssreflect 2.4 or later](https://math-comp.github.io) 57 | - opam: 58 | name: rocq-mathcomp-algebra 59 | description: |- 60 | [MathComp algebra](https://math-comp.github.io) 61 | - opam: 62 | name: rocq-mathcomp-field 63 | description: |- 64 | [MathComp field](https://math-comp.github.io) 65 | - opam: 66 | name: coq-mathcomp-bigenough 67 | version: '{>= "1.0.0"}' 68 | description: |- 69 | [MathComp bigenough 1.0.0 or later](https://github.com/math-comp/bigenough) 70 | 71 | namespace: mathcomp.real_closed 72 | 73 | keywords: 74 | - name: real closed field 75 | 76 | documentation: |- 77 | 78 | ## Documentation 79 | The repository contains 80 | - the decision procedure `rcf_sat` and its corectness lemma [`rcf_satP`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/qe_rcf.v#L991) for the first order theory of real closed fields through 81 | [certified quantifier elimination](https://hal.inria.fr/inria-00593738v4) 82 | - the definition `{realclosure F}` , a [construction of the real closure of an archimedean field](https://hal.inria.fr/hal-00671809v2), which is canonically a [`rcfType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L63) when `F` is an archimedean field, and the characteristic theorems of section [`RealClosureTheory`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/realalg.v#L1477). 83 | - the definition `complex R`, a construction of the algebraic closure of a real closed field, which is canonically a [`numClosedFieldType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L73) that additionally satisfies [`complexalg_algebraic`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/complex.v#L1324). 84 | 85 | Except for the end-results listed above, one should not rely on anything. 86 | 87 | The formalization is based on the [Mathematical Components](https://github.com/math-comp/math-comp) 88 | library for the [Rocq](https://rocq-prover.org/) prover. 89 | 90 | 91 | ## Development instructions 92 | 93 | ### With nix. 94 | 95 | 1. Install nix: 96 | - To install it on a single-user unix system where you have admin 97 | rights, just type: 98 | 99 | > sh <(curl https://nixos.org/nix/install) 100 | 101 | You should run this under your usual user account, not as 102 | root. The script will invoke `sudo` as needed. 103 | 104 | For other configurations (in particular if multiple users share 105 | the machine) or for nix uninstallation, go to the [appropriate 106 | section of the nix 107 | manual](https://nixos.org/nix/manual/#ch-installing-binary). 108 | 109 | - You need to **log out of your desktop session and log in again** before you proceed to step 2. 110 | 111 | - Step 1. only need to be done once on a same machine. 112 | 113 | 2. Open a new terminal. Navigate to the root of the Abel repository. Then type: 114 | > nix-shell 115 | 116 | - This will download and build the required packages, wait until 117 | you get a shell. 118 | - You need to type this command every time you open a new terminal. 119 | - You can call `nixEnv` after you start the nix shell to see your 120 | work environemnet (or call `nix-shell` with option `--arg 121 | print-env true`). 122 | 123 | 3. You are now in the correct work environment. You can do 124 | > make 125 | 126 | and do whatever you are accustomed to do with Rocq. 127 | 128 | 4. In particular, you can edit files using `emacs` or `coqide`. 129 | 130 | - If you were already using emacs with proof general, make sure you 131 | empty your `coq-prog-name` variables and any other proof general 132 | options that used to be tied to a previous local installation of 133 | Rocq. 134 | - If you do not have emacs installed, but want to use it, you can 135 | go back to step 2. and call `nix-shell` with the following option 136 | > nix-shell --arg withEmacs true 137 | 138 | in order to get a temporary installation of emacs and 139 | proof-general. Make sure you add `(require 'proof-site)` to your 140 | `$HOME/.emacs`. 141 | -------------------------------------------------------------------------------- /theories/polyorder.v: -------------------------------------------------------------------------------- 1 | (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. 4 | From mathcomp Require Import fintype ssralg zmodp poly polydiv ssrnum interval. 5 | 6 | Import GRing.Theory Num.Theory Pdiv.Idomain. 7 | 8 | Set Implicit Arguments. 9 | Unset Strict Implicit. 10 | Unset Printing Implicit Defensive. 11 | 12 | Local Open Scope ring_scope. 13 | 14 | Section Multiplicity. 15 | 16 | Variable R : idomainType. 17 | Implicit Types x y c : R. 18 | Implicit Types p q r d : {poly R}. 19 | 20 | (* Definition multiplicity (x : R) (p : {poly R}) : nat := *) 21 | (* (odflt ord0 (pick (fun i : 'I_(size p).+1 => ((('X - x%:P) ^+ i %| p)) *) 22 | (* && (~~ (('X - x%:P) ^+ i.+1 %| p))))). *) 23 | 24 | (* Notation "'\mu_' x" := (multiplicity x) *) 25 | (* (at level 8, format "'\mu_' x") : ring_scope. *) 26 | 27 | (* Lemma mu0 : forall x, \mu_x 0 = 0%N. *) 28 | (* Proof. *) 29 | (* by move=> x; rewrite /multiplicity; case: pickP=> //= i; rewrite !dvdp0. *) 30 | (* Qed. *) 31 | 32 | (* Lemma muP : forall p x, p != 0 -> *) 33 | (* (('X - x%:P) ^+ (\mu_x p) %| p) && ~~(('X - x%:P) ^+ (\mu_x p).+1 %| p). *) 34 | (* Proof. *) 35 | (* move=> p x np0; rewrite /multiplicity; case: pickP=> //= hp. *) 36 | (* have {hp} hip: forall i, i <= size p *) 37 | (* -> (('X - x%:P) ^+ i %| p) -> (('X - x%:P) ^+ i.+1 %| p). *) 38 | (* move=> i; rewrite -ltnS=> hi; move/negbT: (hp (Ordinal hi)). *) 39 | (* by rewrite -negb_imply negbK=> /implyP. *) 40 | (* suff: forall i, i <= size p -> ('X - x%:P) ^+ i %| p. *) 41 | (* move=> /(_ _ (leqnn _)) /(size_dvdp np0). *) 42 | (* rewrite -[size _]prednK; first by rewrite size_exp size_XsubC mul1n ltnn. *) 43 | (* by rewrite lt0n size_poly_eq0 expf_eq0 polyXsubC_eq0 lt0n size_poly_eq0 np0. *) 44 | (* elim=> [|i ihi /ltnW hsp]; first by rewrite expr0 dvd1p. *) 45 | (* by rewrite hip // ihi. *) 46 | (* Qed. *) 47 | 48 | (* Lemma cofactor_XsubC : forall p a, p != 0 -> *) 49 | (* exists2 q : {poly R}, (~~ root q a) & p = q * ('X - a%:P) ^+ (\mu_a p). *) 50 | (* Proof. *) 51 | (* move=> p a np0. *) 52 | 53 | Definition multiplicity (x : R) (p : {poly R}) := 54 | if p == 0 then 0%N else sval (multiplicity_XsubC p x). 55 | 56 | Notation "'\mu_' x" := (multiplicity x) 57 | (at level 8, format "'\mu_' x") : ring_scope. 58 | 59 | Lemma mu_spec p a : p != 0 -> 60 | { q : {poly R} & (~~ root q a) 61 | & ( p = q * ('X - a%:P) ^+ (\mu_a p)) }. 62 | Proof. 63 | move=> nz_p; rewrite /multiplicity -if_neg. 64 | by case: (_ p a) => m /=/sig2_eqW[q]; rewrite nz_p; exists q. 65 | Qed. 66 | 67 | Lemma mu0 x : \mu_x 0 = 0%N. 68 | Proof. by rewrite /multiplicity {1}eqxx. Qed. 69 | 70 | Lemma root_mu p x : ('X - x%:P) ^+ (\mu_x p) %| p. 71 | Proof. 72 | case p0: (p == 0); first by rewrite (eqP p0) mu0 expr0 dvd1p. 73 | case: (@mu_spec p x); first by rewrite p0. 74 | by move=> q qn0 hp //=; rewrite {2}hp dvdp_mulIr. 75 | Qed. 76 | 77 | (* Lemma size_exp_XsubC : forall x n, size (('X - x%:P) ^+ n) = n.+1. *) 78 | (* Proof. *) 79 | (* move=> x n; rewrite -[size _]prednK ?size_exp ?size_XsubC ?mul1n //. *) 80 | (* by rewrite ltnNge leqn0 size_poly_eq0 expf_neq0 // polyXsubC_eq0. *) 81 | (* Qed. *) 82 | 83 | Lemma root_muN p x : p != 0 -> 84 | (('X - x%:P)^+(\mu_x p).+1 %| p) = false. 85 | Proof. 86 | move=> pn0; case: (mu_spec x pn0)=> q qn0 hp /=. 87 | rewrite {2}hp exprS dvdp_mul2r; last first. 88 | by rewrite expf_neq0 // polyXsubC_eq0. 89 | apply: negbTE; rewrite -eqp_div_XsubC; apply: contra qn0. 90 | by move/eqP->; rewrite rootM root_XsubC eqxx orbT. 91 | Qed. 92 | 93 | Lemma root_le_mu p x n : p != 0 -> ('X - x%:P)^+n %| p = (n <= \mu_x p)%N. 94 | Proof. 95 | move=> pn0; case: leqP=> hn; last apply/negP=> hp. 96 | apply: (@dvdp_trans _ (('X - x%:P) ^+ (\mu_x p))); last by rewrite root_mu. 97 | by rewrite dvdp_Pexp2l // size_XsubC. 98 | suff : ('X - x%:P) ^+ (\mu_x p).+1 %| p by rewrite root_muN. 99 | by apply: dvdp_trans hp; rewrite dvdp_Pexp2l // size_XsubC. 100 | Qed. 101 | 102 | Lemma muP p x n : p != 0 -> 103 | (('X - x%:P)^+n %| p) && ~~(('X - x%:P)^+n.+1 %| p) = (n == \mu_x p). 104 | Proof. 105 | by move=> hp0; rewrite !root_le_mu//; case: (ltngtP n (\mu_x p)). 106 | Qed. 107 | 108 | Lemma mu_gt0 p x : p != 0 -> (0 < \mu_x p)%N = root p x. 109 | Proof. by move=> pn0; rewrite -root_le_mu// expr1 root_factor_theorem. Qed. 110 | 111 | Lemma muNroot p x : ~~ root p x -> \mu_x p = 0%N. 112 | Proof. 113 | case p0: (p == 0); first by rewrite (eqP p0) rootC eqxx. 114 | by move=> pnx0; apply/eqP; rewrite -leqn0 leqNgt mu_gt0 ?p0. 115 | Qed. 116 | 117 | Lemma mu_polyC c x : \mu_x (c%:P) = 0%N. 118 | Proof. 119 | case c0: (c == 0); first by rewrite (eqP c0) mu0. 120 | by apply: muNroot; rewrite rootC c0. 121 | Qed. 122 | 123 | Lemma cofactor_XsubC_mu x p n : 124 | ~~ root p x -> \mu_x (p * ('X - x%:P) ^+ n) = n. 125 | Proof. 126 | move=> p0; apply/eqP; rewrite eq_sym -muP//; last first. 127 | apply: contra p0; rewrite mulf_eq0 expf_eq0 polyXsubC_eq0 andbF orbF. 128 | by move/eqP->; rewrite root0. 129 | rewrite dvdp_mulIr /= exprS dvdp_mul2r -?root_factor_theorem //. 130 | by rewrite expf_eq0 polyXsubC_eq0 andbF //. 131 | Qed. 132 | 133 | Lemma mu_mul p q x : p * q != 0 -> 134 | \mu_x (p * q) = (\mu_x p + \mu_x q)%N. 135 | Proof. 136 | move=> hpqn0; apply/eqP; rewrite eq_sym -muP//. 137 | rewrite exprD dvdp_mul ?root_mu//=. 138 | move: hpqn0; rewrite mulf_eq0 negb_or; case/andP=> hp0 hq0. 139 | move: (mu_spec x hp0)=> [qp qp0 hp]. 140 | move: (mu_spec x hq0)=> [qq qq0 hq]. 141 | rewrite {2}hp {2}hq exprS exprD !mulrA [qp * _ * _]mulrAC. 142 | rewrite !dvdp_mul2r ?expf_neq0 ?polyXsubC_eq0 // -eqp_div_XsubC. 143 | move: (mulf_neq0 qp0 qq0); rewrite -hornerM; apply: contra; move/eqP->. 144 | by rewrite hornerM hornerXsubC subrr mulr0. 145 | Qed. 146 | 147 | Lemma mu_XsubC x : \mu_x ('X - x%:P) = 1%N. 148 | Proof. 149 | apply/eqP; rewrite eq_sym -muP; last by rewrite polyXsubC_eq0. 150 | by rewrite expr1 dvdpp/= -{2}[_ - _]expr1 dvdp_Pexp2l // size_XsubC. 151 | Qed. 152 | 153 | Lemma mu_mulC c p x : c != 0 -> \mu_x (c *: p) = \mu_x p. 154 | Proof. 155 | move=> cn0; case p0: (p == 0); first by rewrite (eqP p0) scaler0. 156 | by rewrite -mul_polyC mu_mul ?mu_polyC// mulf_neq0 ?p0 ?polyC_eq0. 157 | Qed. 158 | 159 | Lemma mu_opp p x : \mu_x (-p) = \mu_x p. 160 | Proof. 161 | rewrite -mulN1r -polyC1 -polyCN mul_polyC mu_mulC //. 162 | by rewrite -oppr0 (inj_eq (inv_inj (@opprK _))) oner_eq0. 163 | Qed. 164 | 165 | Lemma mu_exp p x n : \mu_x (p ^+ n) = (\mu_x p * n)%N. 166 | Proof. 167 | elim: n p => [|n ihn] p; first by rewrite expr0 mu_polyC muln0. 168 | case p0: (p == 0); first by rewrite (eqP p0) exprS mul0r mu0 mul0n. 169 | by rewrite exprS mu_mul ?ihn ?mulnS// mulf_eq0 expf_eq0 p0 andbF. 170 | Qed. 171 | 172 | Lemma mu_addr p q x : p != 0 -> (\mu_x p < \mu_x q)%N -> 173 | \mu_x (p + q) = \mu_x p. 174 | Proof. 175 | move=> pn0 mupq. 176 | have pqn0 : p + q != 0. 177 | move: mupq; rewrite ltnNge; apply: contra. 178 | by rewrite -[q]opprK subr_eq0; move/eqP->; rewrite opprK mu_opp leqnn. 179 | have qn0: q != 0 by move: mupq; apply: contraL; move/eqP->; rewrite mu0 ltn0. 180 | case: (mu_spec x pn0)=> [qqp qqp0] hp. 181 | case: (mu_spec x qn0)=> [qqq qqq0] hq. 182 | rewrite hp hq -(subnK (ltnW mupq)). 183 | rewrite mu_mul ?mulf_eq0; last first. 184 | rewrite expf_eq0 polyXsubC_eq0 andbF orbF. 185 | by apply: contra qqp0; move/eqP->; rewrite root0. 186 | rewrite mu_exp mu_XsubC mul1n [\mu_x qqp]muNroot // add0n. 187 | rewrite exprD mulrA -mulrDl mu_mul; last first. 188 | by rewrite mulrDl -mulrA -exprD subnK 1?ltnW // -hp -hq. 189 | rewrite muNroot ?add0n ?mu_exp ?mu_XsubC ?mul1n //. 190 | rewrite rootE !hornerE ?horner_exp ?hornerXsubC subrr. 191 | (* FIXME: remove ?horner_exp ?hornerXsubC when requiring MC >= 1.16.0 *) 192 | by rewrite -subnSK // subnS exprS mul0r mulr0 addr0. 193 | Qed. 194 | 195 | Lemma mu_addl p q x : q != 0 -> (\mu_x p > \mu_x q)%N -> 196 | \mu_x (p + q) = \mu_x q. 197 | Proof. by move=> q0 hmu; rewrite addrC mu_addr. Qed. 198 | 199 | Lemma mu_div p x n : (n <= \mu_x p)%N -> 200 | \mu_x (p %/ ('X - x%:P) ^+ n) = (\mu_x p - n)%N. 201 | Proof. 202 | move=> hn. 203 | case p0: (p == 0); first by rewrite (eqP p0) div0p mu0 sub0n. 204 | case: (@mu_spec p x); rewrite ?p0 // => q hq hp. 205 | rewrite {1}hp -{1}(subnK hn) exprD mulrA. 206 | rewrite Pdiv.IdomainMonic.mulpK; last by apply: monic_exp; apply: monicXsubC. 207 | rewrite mu_mul ?mulf_eq0 ?expf_eq0 ?polyXsubC_eq0 ?andbF ?orbF; last first. 208 | by apply: contra hq; move/eqP->; rewrite root0. 209 | by rewrite mu_exp muNroot // add0n mu_XsubC mul1n. 210 | Qed. 211 | 212 | End Multiplicity. 213 | 214 | Notation "'\mu_' x" := (multiplicity x) 215 | (at level 8, format "'\mu_' x") : ring_scope. 216 | 217 | 218 | Section PolyrealIdomain. 219 | 220 | (*************************************************************************) 221 | (* This should be replaced by a 0-characteristic condition + integrality *) 222 | (* and merged into poly and polydiv *) 223 | (*************************************************************************) 224 | 225 | Variable R : realDomainType. 226 | 227 | Lemma size_deriv (p : {poly R}) : size p^`() = (size p).-1. 228 | Proof. 229 | have [lep1|lt1p] := leqP (size p) 1. 230 | by rewrite {1}[p]size1_polyC // derivC size_poly0 -subn1 (eqnP lep1). 231 | rewrite size_poly_eq // mulrn_eq0 -subn2 -subSn // subn2. 232 | by rewrite lead_coef_eq0 -size_poly_eq0 -(subnKC lt1p). 233 | Qed. 234 | 235 | Lemma derivn_poly0 : forall (p : {poly R}) n, (size p <= n)%N = (p^`(n) == 0). 236 | Proof. 237 | move=> p n; apply/idP/idP. 238 | move=> Hpn; apply/eqP; apply/polyP=>i; rewrite coef_derivn. 239 | rewrite nth_default; first by rewrite mul0rn coef0. 240 | by apply: leq_trans Hpn _; apply leq_addr. 241 | elim: n {-2}n p (leqnn n) => [m | n ihn [| m]] p. 242 | - by rewrite leqn0; move/eqP->; rewrite derivn0 leqn0 -size_poly_eq0. 243 | - by move=> _; apply: ihn; rewrite leq0n. 244 | - rewrite derivSn => hmn hder; case e: (size p) => [|sp] //. 245 | rewrite -(prednK (ltn0Sn sp)) [(_.-1)%N]lock -e -lock -size_deriv ltnS. 246 | exact: ihn. 247 | Qed. 248 | 249 | Lemma mu_deriv : forall x (p : {poly R}), root p x -> 250 | \mu_x (p^`()) = (\mu_x p - 1)%N. 251 | Proof. 252 | move=> x p px0; have [-> | nz_p] := eqVneq p 0; first by rewrite derivC mu0. 253 | have [q nz_qx Dp] := mu_spec x nz_p. 254 | case Dm: (\mu_x p) => [|m]; first by rewrite Dp Dm mulr1 (negPf nz_qx) in px0. 255 | rewrite subn1 Dp Dm !derivCE exprS mul1r mulrnAr -mulrnAl mulrA -mulrDl. 256 | rewrite cofactor_XsubC_mu // rootE !(hornerE, hornerMn) subrr mulr0 add0r. 257 | by rewrite mulrn_eq0. 258 | Qed. 259 | 260 | Lemma mu_deriv_root : forall x (p : {poly R}), p != 0 -> root p x -> 261 | \mu_x p = (\mu_x (p^`()) + 1)%N. 262 | Proof. 263 | by move=> x p p0 rpx; rewrite mu_deriv // subn1 addn1 prednK // mu_gt0. 264 | Qed. 265 | 266 | End PolyrealIdomain. 267 | 268 | 269 | 270 | -------------------------------------------------------------------------------- /theories/mxtens.v: -------------------------------------------------------------------------------- 1 | (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq div. 4 | From mathcomp Require Import choice fintype bigop ssralg zmodp matrix. 5 | 6 | Set Implicit Arguments. 7 | Unset Strict Implicit. 8 | Unset Printing Implicit Defensive. 9 | 10 | Import GRing.Theory. 11 | Local Open Scope ring_scope. 12 | 13 | Section ExtraBigOp. 14 | 15 | Lemma sumr_add : forall (R : ringType) m n (F : 'I_(m + n) -> R), 16 | \sum_(i < m + n) F i = \sum_(i < m) F (lshift _ i) 17 | + \sum_(i < n) F (rshift _ i). 18 | Proof. 19 | move=> R; elim=> [|m ihm] n F. 20 | rewrite !big_ord0 add0r; apply: congr_big=> // [[i hi]] _. 21 | by rewrite /rshift /=; congr F; apply: val_inj. 22 | rewrite !big_ord_recl ihm -addrA. 23 | congr (_ + _); first by congr F; apply: val_inj. 24 | congr (_ + _); by apply: congr_big=> // i _ /=; congr F; apply: val_inj. 25 | Qed. 26 | 27 | Lemma mxtens_index_proof m n (ij : 'I_m * 'I_n) : ij.1 * n + ij.2 < m * n. 28 | Proof. 29 | case: m ij=> [[[] //]|] m ij; rewrite mulSn addnC -addSn leq_add //. 30 | by rewrite leq_mul2r; case: n ij=> // n ij; rewrite leq_ord orbT. 31 | Qed. 32 | 33 | Definition mxtens_index m n ij := Ordinal (@mxtens_index_proof m n ij). 34 | 35 | Lemma mxtens_index_proof1 m n (k : 'I_(m * n)) : k %/ n < m. 36 | Proof. by move: m n k=> [_ [] //|m] [|n] k; rewrite ?divn0 // ltn_divLR. Qed. 37 | Lemma mxtens_index_proof2 m n (k : 'I_(m * n)) : k %% n < n. 38 | Proof. by rewrite ltn_mod; case: n k=> //; rewrite muln0=> [] []. Qed. 39 | 40 | Definition mxtens_unindex m n k := 41 | (Ordinal (@mxtens_index_proof1 m n k), Ordinal (@mxtens_index_proof2 m n k)). 42 | 43 | Arguments mxtens_index {m n}. 44 | Arguments mxtens_unindex {m n}. 45 | 46 | Lemma mxtens_indexK m n : cancel (@mxtens_index m n) (@mxtens_unindex m n). 47 | Proof. 48 | case: m=> [[[] //]|m]; case: n=> [[_ [] //]|n]. 49 | move=> [i j]; congr (_, _); apply: val_inj=> /=. 50 | by rewrite divnMDl // divn_small ?addn0. 51 | by rewrite modnMDl // modn_small. 52 | Qed. 53 | 54 | Lemma mxtens_unindexK m n : cancel (@mxtens_unindex m n) (@mxtens_index m n). 55 | Proof. 56 | case: m=> [[[] //]|m]. case: n=> [|n] k. 57 | by suff: False by []; move: k; rewrite muln0=> [] []. 58 | by apply: val_inj=> /=; rewrite -divn_eq. 59 | Qed. 60 | 61 | Variant is_mxtens_index (m n : nat) : 'I_(m * n) -> Type := 62 | IsMxtensIndex : forall (i : 'I_m) (j : 'I_n), 63 | is_mxtens_index (mxtens_index (i, j)). 64 | 65 | Lemma mxtens_indexP (m n : nat) (k : 'I_(m * n)) : is_mxtens_index k. 66 | Proof. by rewrite -[k]mxtens_unindexK; constructor. Qed. 67 | 68 | Lemma mulr_sum (R : ringType) m n (Fm : 'I_m -> R) (Fn : 'I_n -> R) : 69 | (\sum_(i < m) Fm i) * (\sum_(i < n) Fn i) 70 | = \sum_(i < m * n) ((Fm (mxtens_unindex i).1) * (Fn (mxtens_unindex i).2)). 71 | Proof. 72 | rewrite mulr_suml; transitivity (\sum_i (\sum_(j < n) Fm i * Fn j)). 73 | by apply: eq_big=> //= i _; rewrite -mulr_sumr. 74 | rewrite pair_big; apply: reindex=> //=. 75 | by exists mxtens_index=> i; rewrite (mxtens_indexK, mxtens_unindexK). 76 | Qed. 77 | 78 | End ExtraBigOp. 79 | 80 | Section ExtraMx. 81 | 82 | Lemma castmx_mul (R : ringType) 83 | (m m' n p p': nat) (em : m = m') (ep : p = p') 84 | (M : 'M[R]_(m, n)) (N : 'M[R]_(n, p)) : 85 | castmx (em, ep) (M *m N) = castmx (em, erefl _) M *m castmx (erefl _, ep) N. 86 | Proof. by case: m' / em; case: p' / ep. Qed. 87 | 88 | Lemma mulmx_cast (R : ringType) 89 | (m n n' p p' : nat) (en : n' = n) (ep : p' = p) 90 | (M : 'M[R]_(m, n)) (N : 'M[R]_(n', p')) : 91 | M *m (castmx (en, ep) N) = 92 | (castmx (erefl _, (esym en)) M) *m (castmx (erefl _, ep) N). 93 | Proof. by case: n / en in M *; case: p / ep in N *. Qed. 94 | 95 | Lemma castmx_row (R : Type) (m m' n1 n2 n1' n2' : nat) 96 | (eq_n1 : n1 = n1') (eq_n2 : n2 = n2') (eq_n12 : (n1 + n2 = n1' + n2')%N) 97 | (eq_m : m = m') (A1 : 'M[R]_(m, n1)) (A2 : 'M_(m, n2)) : 98 | castmx (eq_m, eq_n12) (row_mx A1 A2) = 99 | row_mx (castmx (eq_m, eq_n1) A1) (castmx (eq_m, eq_n2) A2). 100 | Proof. 101 | case: _ / eq_n1 in eq_n12 *; case: _ / eq_n2 in eq_n12 *. 102 | by case: _ / eq_m; rewrite castmx_id. 103 | Qed. 104 | 105 | Lemma castmx_col (R : Type) (m m' n1 n2 n1' n2' : nat) 106 | (eq_n1 : n1 = n1') (eq_n2 : n2 = n2') (eq_n12 : (n1 + n2 = n1' + n2')%N) 107 | (eq_m : m = m') (A1 : 'M[R]_(n1, m)) (A2 : 'M_(n2, m)) : 108 | castmx (eq_n12, eq_m) (col_mx A1 A2) = 109 | col_mx (castmx (eq_n1, eq_m) A1) (castmx (eq_n2, eq_m) A2). 110 | Proof. 111 | case: _ / eq_n1 in eq_n12 *; case: _ / eq_n2 in eq_n12 *. 112 | by case: _ / eq_m; rewrite castmx_id. 113 | Qed. 114 | 115 | Lemma castmx_block (R : Type) (m1 m1' m2 m2' n1 n2 n1' n2' : nat) 116 | (eq_m1 : m1 = m1') (eq_n1 : n1 = n1') (eq_m2 : m2 = m2') (eq_n2 : n2 = n2') 117 | (eq_m12 : (m1 + m2 = m1' + m2')%N) (eq_n12 : (n1 + n2 = n1' + n2')%N) 118 | (ul : 'M[R]_(m1, n1)) (ur : 'M[R]_(m1, n2)) 119 | (dl : 'M[R]_(m2, n1)) (dr : 'M[R]_(m2, n2)) : 120 | castmx (eq_m12, eq_n12) (block_mx ul ur dl dr) = 121 | block_mx (castmx (eq_m1, eq_n1) ul) (castmx (eq_m1, eq_n2) ur) 122 | (castmx (eq_m2, eq_n1) dl) (castmx (eq_m2, eq_n2) dr). 123 | Proof. 124 | case: _ / eq_m1 in eq_m12 *; case: _ / eq_m2 in eq_m12 *. 125 | case: _ / eq_n1 in eq_n12 *; case: _ / eq_n2 in eq_n12 *. 126 | by rewrite !castmx_id. 127 | Qed. 128 | 129 | End ExtraMx. 130 | 131 | Section MxTens. 132 | 133 | Variable R : ringType. 134 | 135 | Definition tensmx {m n p q : nat} 136 | (A : 'M_(m, n)) (B : 'M_(p, q)) : 'M[R]_(_,_) := nosimpl 137 | (\matrix_(i, j) (A (mxtens_unindex i).1 (mxtens_unindex j).1 138 | * B (mxtens_unindex i).2 (mxtens_unindex j).2)). 139 | 140 | Notation "A *t B" := (tensmx A B) 141 | (at level 40, left associativity, format "A *t B"). 142 | 143 | Lemma tensmxE {m n p q} (A : 'M_(m, n)) (B : 'M_(p, q)) i j k l : 144 | (A *t B) (mxtens_index (i, j)) (mxtens_index (k, l)) = A i k * B j l. 145 | Proof. by rewrite !mxE !mxtens_indexK. Qed. 146 | 147 | Lemma tens0mx {m n p q} (M : 'M[R]_(p,q)) : (0 : 'M_(m,n)) *t M = 0. 148 | Proof. by apply/matrixP=> i j; rewrite !mxE mul0r. Qed. 149 | 150 | Lemma tensmx0 {m n p q} (M : 'M[R]_(m,n)) : M *t (0 : 'M_(p,q)) = 0. 151 | Proof. by apply/matrixP=> i j; rewrite !mxE mulr0. Qed. 152 | 153 | Lemma tens_scalar_mx (m n : nat) (c : R) (M : 'M_(m,n)): 154 | c%:M *t M = castmx (esym (mul1n _), esym (mul1n _)) (c *: M). 155 | Proof. 156 | apply/matrixP=> i j. 157 | case: (mxtens_indexP i)=> i0 i1; case: (mxtens_indexP j)=> j0 j1. 158 | rewrite tensmxE [i0]ord1 [j0]ord1 !castmxE !mxE /= mulr1n. 159 | by congr (_ * M _ _); apply: val_inj. 160 | Qed. 161 | 162 | Lemma tens_scalar1mx (m n : nat) (M : 'M_(m,n)) : 163 | 1 *t M = castmx (esym (mul1n _), esym (mul1n _)) M. 164 | Proof. by rewrite tens_scalar_mx scale1r. Qed. 165 | 166 | Lemma tens_scalarN1mx (m n : nat) (M : 'M_(m,n)) : 167 | (-1) *t M = castmx (esym (mul1n _), esym (mul1n _)) (-M). 168 | Proof. by rewrite [-1]mx11_scalar /= tens_scalar_mx !mxE scaleNr scale1r. Qed. 169 | 170 | Lemma trmx_tens {m n p q} (M :'M[R]_(m,n)) (N : 'M[R]_(p,q)) : 171 | (M *t N)^T = M^T *t N^T. 172 | Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. 173 | 174 | Lemma tens_col_mx {m n p q} (r : 'rV[R]_n) 175 | (M :'M[R]_(m, n)) (N : 'M[R]_(p, q)) : 176 | (col_mx r M) *t N = 177 | castmx (esym (mulnDl _ _ _), erefl _) (col_mx (r *t N) (M *t N)). 178 | Proof. 179 | apply/matrixP=> i j. 180 | case: (mxtens_indexP i)=> i0 i1; case: (mxtens_indexP j)=> j0 j1. 181 | rewrite !tensmxE castmxE /= cast_ord_id esymK !mxE /=. 182 | case: splitP=> i0' /= hi0'; case: splitP=> k /= hk. 183 | + case: (mxtens_indexP k) hk=> k0 k1 /=; rewrite tensmxE. 184 | move=> /(f_equal (edivn^~ p)); rewrite !edivn_eq // => [] [h0 h1]. 185 | by congr (r _ _ * N _ _); apply: val_inj; rewrite /= -?h0 ?h1. 186 | + move: hk (ltn_ord i1); rewrite hi0'. 187 | by rewrite [i0']ord1 mul0n mul1n add0n ltnNge=> ->; rewrite leq_addr. 188 | + move: (ltn_ord k); rewrite -hk hi0' ltnNge {1}mul1n. 189 | by rewrite mulnDl {1}mul1n -addnA leq_addr. 190 | case: (mxtens_indexP k) hk=> k0 k1 /=; rewrite tensmxE. 191 | rewrite hi0' mulnDl -addnA=> /addnI. 192 | move=> /(f_equal (edivn^~ p)); rewrite !edivn_eq // => [] [h0 h1]. 193 | by congr (M _ _ * N _ _); apply: val_inj; rewrite /= -?h0 ?h1. 194 | Qed. 195 | 196 | Lemma tens_row_mx {m n p q} (r : 'cV[R]_m) (M :'M[R]_(m,n)) (N : 'M[R]_(p,q)) : 197 | (row_mx r M) *t N = 198 | castmx (erefl _, esym (mulnDl _ _ _)) (row_mx (r *t N) (M *t N)). 199 | Proof. 200 | rewrite -[_ *t _]trmxK trmx_tens tr_row_mx tens_col_mx. 201 | apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. 202 | by rewrite trmx_cast castmx_comp castmx_id tr_col_mx -!trmx_tens !trmxK. 203 | Qed. 204 | 205 | Lemma tens_block_mx {m n p q} 206 | (ul : 'M[R]_1) (ur : 'rV[R]_n) (dl : 'cV[R]_m) 207 | (M :'M[R]_(m,n)) (N : 'M[R]_(p,q)) : 208 | (block_mx ul ur dl M) *t N = 209 | castmx (esym (mulnDl _ _ _), esym (mulnDl _ _ _)) 210 | (block_mx (ul *t N) (ur *t N) (dl *t N) (M *t N)). 211 | Proof. 212 | rewrite !block_mxEv tens_col_mx !tens_row_mx -!cast_col_mx castmx_comp. 213 | by congr (castmx (_,_)); apply nat_irrelevance. 214 | Qed. 215 | 216 | 217 | Fixpoint ntensmx_rec {m n} (A : 'M_(m,n)) k : 'M_(m ^ k.+1,n ^ k.+1) := 218 | if k is k'.+1 then (A *t (ntensmx_rec A k')) else A. 219 | 220 | Definition ntensmx {m n} (A : 'M_(m, n)) k := nosimpl 221 | (if k is k'.+1 return 'M[R]_(m ^ k,n ^ k) then ntensmx_rec A k' else 1). 222 | 223 | Notation "A ^t k" := (ntensmx A k) 224 | (at level 39, left associativity, format "A ^t k"). 225 | 226 | Lemma ntensmx0 : forall {m n} (A : 'M_(m,n)) , A ^t 0 = 1. 227 | Proof. by []. Qed. 228 | 229 | Lemma ntensmx1 : forall {m n} (A : 'M_(m,n)) , A ^t 1 = A. 230 | Proof. by []. Qed. 231 | 232 | Lemma ntensmx2 : forall {m n} (A : 'M_(m,n)) , A ^t 2 = A *t A. 233 | Proof. by []. Qed. 234 | 235 | Lemma ntensmxSS : forall {m n} (A : 'M_(m,n)) k, A ^t k.+2 = A *t A ^t k.+1. 236 | Proof. by []. Qed. 237 | 238 | Definition ntensmxS := (@ntensmx1, @ntensmx2, @ntensmxSS). 239 | 240 | End MxTens. 241 | 242 | Notation "A *t B" := (tensmx A B) 243 | (at level 40, left associativity, format "A *t B"). 244 | 245 | Notation "A ^t k" := (ntensmx A k) 246 | (at level 39, left associativity, format "A ^t k"). 247 | 248 | Section MapMx. 249 | Variables (aR rR : ringType). 250 | Hypothesis f : {rmorphism aR -> rR}. 251 | Local Notation "A ^f" := (map_mx f A) : ring_scope. 252 | 253 | Variables m n p q: nat. 254 | Implicit Type A : 'M[aR]_(m, n). 255 | Implicit Type B : 'M[aR]_(p, q). 256 | 257 | Lemma map_mxT A B : (A *t B)^f = A^f *t B^f :> 'M_(m*p, n*q). 258 | Proof. by apply/matrixP=> i j; rewrite !mxE /= rmorphM. Qed. 259 | 260 | End MapMx. 261 | 262 | Section Misc. 263 | 264 | Lemma tensmx_mul (R : comRingType) m n p q r s 265 | (A : 'M[R]_(m,n)) (B : 'M[R]_(p,q)) (C : 'M[R]_(n, r)) (D : 'M[R]_(q, s)) : 266 | (A *t B) *m (C *t D) = (A *m C) *t (B *m D). 267 | Proof. 268 | apply/matrixP=> /= i j. 269 | case (mxtens_indexP i)=> [im ip] {i}; case (mxtens_indexP j)=> [jr js] {j}. 270 | rewrite !mxE !mxtens_indexK mulr_sum; apply: congr_big=> // k _. 271 | by rewrite !mxE !mxtens_indexK mulrCA !mulrA [C _ _ * A _ _]mulrC. 272 | Qed. 273 | 274 | (* Todo : move to div ? *) 275 | Lemma eq_addl_mul q q' m m' d : m < d -> m' < d -> 276 | (q * d + m == q' * d + m')%N = ((q, m) == (q', m')). 277 | Proof. 278 | move=> lt_md lt_m'd; apply/eqP/eqP; last by move=> [-> ->]. 279 | by move=> /(f_equal (edivn^~ d)); rewrite !edivn_eq. 280 | Qed. 281 | 282 | Lemma tensmx_unit (R : fieldType) m n (A : 'M[R]_m%N) (B : 'M[R]_n%N) : 283 | m != 0%N -> n != 0%N -> A \in unitmx -> B \in unitmx -> (A *t B) \in unitmx. 284 | Proof. 285 | move: m n A B => [|m] [|n] // A B _ _ uA uB. 286 | suff : (A^-1 *t B^-1) *m (A *t B) = 1 by case/mulmx1_unit. 287 | rewrite tensmx_mul !mulVmx //; apply/matrixP=> /= i j. 288 | rewrite !mxE /=; symmetry; rewrite -natrM -!val_eqE /=. 289 | rewrite {1}(divn_eq i n.+1) {1}(divn_eq j n.+1). 290 | by rewrite eq_addl_mul ?ltn_mod // xpair_eqE mulnb. 291 | Qed. 292 | 293 | 294 | Lemma tens_mx_scalar : forall (R : comRingType) 295 | (m n : nat) (c : R) (M : 'M[R]_(m,n)), 296 | M *t c%:M = castmx (esym (muln1 _), esym (muln1 _)) (c *: M). 297 | Proof. 298 | move=> R0 m n c M; apply/matrixP=> i j. 299 | case: (mxtens_indexP i)=> i0 i1; case: (mxtens_indexP j)=> j0 j1. 300 | rewrite tensmxE [i1]ord1 [j1]ord1 !castmxE !mxE /= mulr1n mulrC. 301 | by congr (_ * M _ _); apply: val_inj=> /=; rewrite muln1 addn0. 302 | Qed. 303 | 304 | Lemma tensmx_decr : forall (R : comRingType) m n (M :'M[R]_m) (N : 'M[R]_n), 305 | M *t N = (M *t 1%:M) *m (1%:M *t N). 306 | Proof. by move=> R0 m n M N; rewrite tensmx_mul mul1mx mulmx1. Qed. 307 | 308 | Lemma tensmx_decl : forall (R : comRingType) m n (M :'M[R]_m) (N : 'M[R]_n), 309 | M *t N = (1%:M *t N) *m (M *t 1%:M). 310 | Proof. by move=> R0 m n M N; rewrite tensmx_mul mul1mx mulmx1. Qed. 311 | 312 | End Misc. 313 | -------------------------------------------------------------------------------- /.github/workflows/nix-action-9.0.yml: -------------------------------------------------------------------------------- 1 | jobs: 2 | coq: 3 | needs: 4 | - rocq-core 5 | runs-on: ubuntu-latest 6 | steps: 7 | - name: Determine which commit to initially checkout 8 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 9 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 10 | }}\" >> $GITHUB_ENV\nfi\n" 11 | - name: Git checkout 12 | uses: actions/checkout@v4 13 | with: 14 | fetch-depth: 0 15 | ref: ${{ env.target_commit }} 16 | - name: Determine which commit to test 17 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 18 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 19 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 20 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 21 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 22 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 23 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 24 | \ fi\nfi\n" 25 | - name: Git checkout 26 | uses: actions/checkout@v4 27 | with: 28 | fetch-depth: 0 29 | ref: ${{ env.tested_commit }} 30 | - name: Cachix install 31 | uses: cachix/install-nix-action@v31 32 | with: 33 | nix_path: nixpkgs=channel:nixpkgs-unstable 34 | - name: Cachix setup math-comp 35 | uses: cachix/cachix-action@v16 36 | with: 37 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 38 | extraPullNames: coq, coq-community 39 | name: math-comp 40 | - id: stepGetDerivation 41 | name: Getting derivation for current job (coq) 42 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 43 | \"9.0\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; 44 | true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 45 | failed\"; exit 1; fi\n" 46 | - id: stepCheck 47 | name: Checking presence of CI target for current job 48 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 49 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 50 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 51 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 52 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 53 | - if: steps.stepCheck.outputs.status != 'fetched' 54 | name: 'Building/fetching previous CI target: rocq-core' 55 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 56 | --argstr job "rocq-core" 57 | - if: steps.stepCheck.outputs.status != 'fetched' 58 | name: Building/fetching current CI target 59 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 60 | --argstr job "coq" 61 | coq-elpi: 62 | needs: 63 | - rocq-core 64 | runs-on: ubuntu-latest 65 | steps: 66 | - name: Determine which commit to initially checkout 67 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 68 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 69 | }}\" >> $GITHUB_ENV\nfi\n" 70 | - name: Git checkout 71 | uses: actions/checkout@v4 72 | with: 73 | fetch-depth: 0 74 | ref: ${{ env.target_commit }} 75 | - name: Determine which commit to test 76 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 77 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 78 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 79 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 80 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 81 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 82 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 83 | \ fi\nfi\n" 84 | - name: Git checkout 85 | uses: actions/checkout@v4 86 | with: 87 | fetch-depth: 0 88 | ref: ${{ env.tested_commit }} 89 | - name: Cachix install 90 | uses: cachix/install-nix-action@v31 91 | with: 92 | nix_path: nixpkgs=channel:nixpkgs-unstable 93 | - name: Cachix setup math-comp 94 | uses: cachix/cachix-action@v16 95 | with: 96 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 97 | extraPullNames: coq, coq-community 98 | name: math-comp 99 | - id: stepGetDerivation 100 | name: Getting derivation for current job (coq-elpi) 101 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 102 | \"9.0\" --argstr job \"coq-elpi\" \\\n --dry-run 2> err > out || (touch 103 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 104 | failed\"; exit 1; fi\n" 105 | - id: stepCheck 106 | name: Checking presence of CI target for current job 107 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 108 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 109 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 110 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 111 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 112 | - if: steps.stepCheck.outputs.status != 'fetched' 113 | name: 'Building/fetching previous CI target: rocq-core' 114 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 115 | --argstr job "rocq-core" 116 | - if: steps.stepCheck.outputs.status != 'fetched' 117 | name: Building/fetching current CI target 118 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 119 | --argstr job "coq-elpi" 120 | coqeal: 121 | needs: 122 | - coq 123 | - mathcomp-real-closed 124 | runs-on: ubuntu-latest 125 | steps: 126 | - name: Determine which commit to initially checkout 127 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 128 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 129 | }}\" >> $GITHUB_ENV\nfi\n" 130 | - name: Git checkout 131 | uses: actions/checkout@v4 132 | with: 133 | fetch-depth: 0 134 | ref: ${{ env.target_commit }} 135 | - name: Determine which commit to test 136 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 137 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 138 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 139 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 140 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 141 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 142 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 143 | \ fi\nfi\n" 144 | - name: Git checkout 145 | uses: actions/checkout@v4 146 | with: 147 | fetch-depth: 0 148 | ref: ${{ env.tested_commit }} 149 | - name: Cachix install 150 | uses: cachix/install-nix-action@v31 151 | with: 152 | nix_path: nixpkgs=channel:nixpkgs-unstable 153 | - name: Cachix setup math-comp 154 | uses: cachix/cachix-action@v16 155 | with: 156 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 157 | extraPullNames: coq, coq-community 158 | name: math-comp 159 | - id: stepGetDerivation 160 | name: Getting derivation for current job (coqeal) 161 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 162 | \"9.0\" --argstr job \"coqeal\" \\\n --dry-run 2> err > out || (touch fail; 163 | true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 164 | failed\"; exit 1; fi\n" 165 | - id: stepCheck 166 | name: Checking presence of CI target for current job 167 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 168 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 169 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 170 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 171 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 172 | - if: steps.stepCheck.outputs.status != 'fetched' 173 | name: 'Building/fetching previous CI target: coq' 174 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 175 | --argstr job "coq" 176 | - if: steps.stepCheck.outputs.status != 'fetched' 177 | name: 'Building/fetching previous CI target: mathcomp-algebra' 178 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 179 | --argstr job "mathcomp-algebra" 180 | - if: steps.stepCheck.outputs.status != 'fetched' 181 | name: 'Building/fetching previous CI target: bignums' 182 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 183 | --argstr job "bignums" 184 | - if: steps.stepCheck.outputs.status != 'fetched' 185 | name: 'Building/fetching previous CI target: multinomials' 186 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 187 | --argstr job "multinomials" 188 | - if: steps.stepCheck.outputs.status != 'fetched' 189 | name: 'Building/fetching previous CI target: mathcomp-real-closed' 190 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 191 | --argstr job "mathcomp-real-closed" 192 | - if: steps.stepCheck.outputs.status != 'fetched' 193 | name: Building/fetching current CI target 194 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 195 | --argstr job "coqeal" 196 | hierarchy-builder: 197 | needs: 198 | - rocq-core 199 | - coq-elpi 200 | runs-on: ubuntu-latest 201 | steps: 202 | - name: Determine which commit to initially checkout 203 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 204 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 205 | }}\" >> $GITHUB_ENV\nfi\n" 206 | - name: Git checkout 207 | uses: actions/checkout@v4 208 | with: 209 | fetch-depth: 0 210 | ref: ${{ env.target_commit }} 211 | - name: Determine which commit to test 212 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 213 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 214 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 215 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 216 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 217 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 218 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 219 | \ fi\nfi\n" 220 | - name: Git checkout 221 | uses: actions/checkout@v4 222 | with: 223 | fetch-depth: 0 224 | ref: ${{ env.tested_commit }} 225 | - name: Cachix install 226 | uses: cachix/install-nix-action@v31 227 | with: 228 | nix_path: nixpkgs=channel:nixpkgs-unstable 229 | - name: Cachix setup math-comp 230 | uses: cachix/cachix-action@v16 231 | with: 232 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 233 | extraPullNames: coq, coq-community 234 | name: math-comp 235 | - id: stepGetDerivation 236 | name: Getting derivation for current job (hierarchy-builder) 237 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 238 | \"9.0\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2> err > out || 239 | (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting 240 | derivation failed\"; exit 1; fi\n" 241 | - id: stepCheck 242 | name: Checking presence of CI target for current job 243 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 244 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 245 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 246 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 247 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 248 | - if: steps.stepCheck.outputs.status != 'fetched' 249 | name: 'Building/fetching previous CI target: rocq-core' 250 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 251 | --argstr job "rocq-core" 252 | - if: steps.stepCheck.outputs.status != 'fetched' 253 | name: 'Building/fetching previous CI target: coq-elpi' 254 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 255 | --argstr job "coq-elpi" 256 | - if: steps.stepCheck.outputs.status != 'fetched' 257 | name: Building/fetching current CI target 258 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 259 | --argstr job "hierarchy-builder" 260 | mathcomp: 261 | needs: 262 | - coq 263 | - hierarchy-builder 264 | runs-on: ubuntu-latest 265 | steps: 266 | - name: Determine which commit to initially checkout 267 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 268 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 269 | }}\" >> $GITHUB_ENV\nfi\n" 270 | - name: Git checkout 271 | uses: actions/checkout@v4 272 | with: 273 | fetch-depth: 0 274 | ref: ${{ env.target_commit }} 275 | - name: Determine which commit to test 276 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 277 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 278 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 279 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 280 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 281 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 282 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 283 | \ fi\nfi\n" 284 | - name: Git checkout 285 | uses: actions/checkout@v4 286 | with: 287 | fetch-depth: 0 288 | ref: ${{ env.tested_commit }} 289 | - name: Cachix install 290 | uses: cachix/install-nix-action@v31 291 | with: 292 | nix_path: nixpkgs=channel:nixpkgs-unstable 293 | - name: Cachix setup math-comp 294 | uses: cachix/cachix-action@v16 295 | with: 296 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 297 | extraPullNames: coq, coq-community 298 | name: math-comp 299 | - id: stepGetDerivation 300 | name: Getting derivation for current job (mathcomp) 301 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 302 | \"9.0\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch 303 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 304 | failed\"; exit 1; fi\n" 305 | - id: stepCheck 306 | name: Checking presence of CI target for current job 307 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 308 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 309 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 310 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 311 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 312 | - if: steps.stepCheck.outputs.status != 'fetched' 313 | name: 'Building/fetching previous CI target: coq' 314 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 315 | --argstr job "coq" 316 | - if: steps.stepCheck.outputs.status != 'fetched' 317 | name: 'Building/fetching previous CI target: mathcomp-character' 318 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 319 | --argstr job "mathcomp-character" 320 | - if: steps.stepCheck.outputs.status != 'fetched' 321 | name: 'Building/fetching previous CI target: hierarchy-builder' 322 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 323 | --argstr job "hierarchy-builder" 324 | - if: steps.stepCheck.outputs.status != 'fetched' 325 | name: 'Building/fetching previous CI target: stdlib' 326 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 327 | --argstr job "stdlib" 328 | - if: steps.stepCheck.outputs.status != 'fetched' 329 | name: Building/fetching current CI target 330 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 331 | --argstr job "mathcomp" 332 | mathcomp-real-closed: 333 | needs: 334 | - coq 335 | runs-on: ubuntu-latest 336 | steps: 337 | - name: Determine which commit to initially checkout 338 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 339 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 340 | }}\" >> $GITHUB_ENV\nfi\n" 341 | - name: Git checkout 342 | uses: actions/checkout@v4 343 | with: 344 | fetch-depth: 0 345 | ref: ${{ env.target_commit }} 346 | - name: Determine which commit to test 347 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 348 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 349 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 350 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 351 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 352 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 353 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 354 | \ fi\nfi\n" 355 | - name: Git checkout 356 | uses: actions/checkout@v4 357 | with: 358 | fetch-depth: 0 359 | ref: ${{ env.tested_commit }} 360 | - name: Cachix install 361 | uses: cachix/install-nix-action@v31 362 | with: 363 | nix_path: nixpkgs=channel:nixpkgs-unstable 364 | - name: Cachix setup math-comp 365 | uses: cachix/cachix-action@v16 366 | with: 367 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 368 | extraPullNames: coq, coq-community 369 | name: math-comp 370 | - id: stepGetDerivation 371 | name: Getting derivation for current job (mathcomp-real-closed) 372 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 373 | \"9.0\" --argstr job \"mathcomp-real-closed\" \\\n --dry-run 2> err > out 374 | || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting 375 | derivation failed\"; exit 1; fi\n" 376 | - id: stepCheck 377 | name: Checking presence of CI target for current job 378 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 379 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 380 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 381 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 382 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 383 | - if: steps.stepCheck.outputs.status != 'fetched' 384 | name: 'Building/fetching previous CI target: coq' 385 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 386 | --argstr job "coq" 387 | - if: steps.stepCheck.outputs.status != 'fetched' 388 | name: 'Building/fetching previous CI target: mathcomp-ssreflect' 389 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 390 | --argstr job "mathcomp-ssreflect" 391 | - if: steps.stepCheck.outputs.status != 'fetched' 392 | name: 'Building/fetching previous CI target: mathcomp-algebra' 393 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 394 | --argstr job "mathcomp-algebra" 395 | - if: steps.stepCheck.outputs.status != 'fetched' 396 | name: 'Building/fetching previous CI target: mathcomp-field' 397 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 398 | --argstr job "mathcomp-field" 399 | - if: steps.stepCheck.outputs.status != 'fetched' 400 | name: 'Building/fetching previous CI target: mathcomp-fingroup' 401 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 402 | --argstr job "mathcomp-fingroup" 403 | - if: steps.stepCheck.outputs.status != 'fetched' 404 | name: 'Building/fetching previous CI target: mathcomp-solvable' 405 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 406 | --argstr job "mathcomp-solvable" 407 | - if: steps.stepCheck.outputs.status != 'fetched' 408 | name: 'Building/fetching previous CI target: mathcomp-bigenough' 409 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 410 | --argstr job "mathcomp-bigenough" 411 | - if: steps.stepCheck.outputs.status != 'fetched' 412 | name: Building/fetching current CI target 413 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 414 | --argstr job "mathcomp-real-closed" 415 | rocq-core: 416 | needs: [] 417 | runs-on: ubuntu-latest 418 | steps: 419 | - name: Determine which commit to initially checkout 420 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 421 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 422 | }}\" >> $GITHUB_ENV\nfi\n" 423 | - name: Git checkout 424 | uses: actions/checkout@v4 425 | with: 426 | fetch-depth: 0 427 | ref: ${{ env.target_commit }} 428 | - name: Determine which commit to test 429 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 430 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 431 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 432 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 433 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 434 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 435 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 436 | \ fi\nfi\n" 437 | - name: Git checkout 438 | uses: actions/checkout@v4 439 | with: 440 | fetch-depth: 0 441 | ref: ${{ env.tested_commit }} 442 | - name: Cachix install 443 | uses: cachix/install-nix-action@v31 444 | with: 445 | nix_path: nixpkgs=channel:nixpkgs-unstable 446 | - name: Cachix setup math-comp 447 | uses: cachix/cachix-action@v16 448 | with: 449 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 450 | extraPullNames: coq, coq-community 451 | name: math-comp 452 | - id: stepGetDerivation 453 | name: Getting derivation for current job (rocq-core) 454 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 455 | \"9.0\" --argstr job \"rocq-core\" \\\n --dry-run 2> err > out || (touch 456 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 457 | failed\"; exit 1; fi\n" 458 | - id: stepCheck 459 | name: Checking presence of CI target for current job 460 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 461 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 462 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 463 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 464 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 465 | - if: steps.stepCheck.outputs.status != 'fetched' 466 | name: Building/fetching current CI target 467 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" 468 | --argstr job "rocq-core" 469 | name: Nix CI for bundle 9.0 470 | on: 471 | pull_request: 472 | paths: 473 | - .github/workflows/nix-action-9.0.yml 474 | pull_request_target: 475 | paths-ignore: 476 | - .github/workflows/nix-action-9.0.yml 477 | types: 478 | - opened 479 | - synchronize 480 | - reopened 481 | push: 482 | branches: 483 | - master 484 | -------------------------------------------------------------------------------- /.github/workflows/nix-action-9.1.yml: -------------------------------------------------------------------------------- 1 | jobs: 2 | coq: 3 | needs: 4 | - rocq-core 5 | runs-on: ubuntu-latest 6 | steps: 7 | - name: Determine which commit to initially checkout 8 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 9 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 10 | }}\" >> $GITHUB_ENV\nfi\n" 11 | - name: Git checkout 12 | uses: actions/checkout@v4 13 | with: 14 | fetch-depth: 0 15 | ref: ${{ env.target_commit }} 16 | - name: Determine which commit to test 17 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 18 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 19 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 20 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 21 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 22 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 23 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 24 | \ fi\nfi\n" 25 | - name: Git checkout 26 | uses: actions/checkout@v4 27 | with: 28 | fetch-depth: 0 29 | ref: ${{ env.tested_commit }} 30 | - name: Cachix install 31 | uses: cachix/install-nix-action@v31 32 | with: 33 | nix_path: nixpkgs=channel:nixpkgs-unstable 34 | - name: Cachix setup math-comp 35 | uses: cachix/cachix-action@v16 36 | with: 37 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 38 | extraPullNames: coq, coq-community 39 | name: math-comp 40 | - id: stepGetDerivation 41 | name: Getting derivation for current job (coq) 42 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 43 | \"9.1\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; 44 | true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 45 | failed\"; exit 1; fi\n" 46 | - id: stepCheck 47 | name: Checking presence of CI target for current job 48 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 49 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 50 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 51 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 52 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 53 | - if: steps.stepCheck.outputs.status != 'fetched' 54 | name: 'Building/fetching previous CI target: rocq-core' 55 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 56 | --argstr job "rocq-core" 57 | - if: steps.stepCheck.outputs.status != 'fetched' 58 | name: Building/fetching current CI target 59 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 60 | --argstr job "coq" 61 | coq-elpi: 62 | needs: 63 | - rocq-core 64 | runs-on: ubuntu-latest 65 | steps: 66 | - name: Determine which commit to initially checkout 67 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 68 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 69 | }}\" >> $GITHUB_ENV\nfi\n" 70 | - name: Git checkout 71 | uses: actions/checkout@v4 72 | with: 73 | fetch-depth: 0 74 | ref: ${{ env.target_commit }} 75 | - name: Determine which commit to test 76 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 77 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 78 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 79 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 80 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 81 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 82 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 83 | \ fi\nfi\n" 84 | - name: Git checkout 85 | uses: actions/checkout@v4 86 | with: 87 | fetch-depth: 0 88 | ref: ${{ env.tested_commit }} 89 | - name: Cachix install 90 | uses: cachix/install-nix-action@v31 91 | with: 92 | nix_path: nixpkgs=channel:nixpkgs-unstable 93 | - name: Cachix setup math-comp 94 | uses: cachix/cachix-action@v16 95 | with: 96 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 97 | extraPullNames: coq, coq-community 98 | name: math-comp 99 | - id: stepGetDerivation 100 | name: Getting derivation for current job (coq-elpi) 101 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 102 | \"9.1\" --argstr job \"coq-elpi\" \\\n --dry-run 2> err > out || (touch 103 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 104 | failed\"; exit 1; fi\n" 105 | - id: stepCheck 106 | name: Checking presence of CI target for current job 107 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 108 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 109 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 110 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 111 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 112 | - if: steps.stepCheck.outputs.status != 'fetched' 113 | name: 'Building/fetching previous CI target: rocq-core' 114 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 115 | --argstr job "rocq-core" 116 | - if: steps.stepCheck.outputs.status != 'fetched' 117 | name: Building/fetching current CI target 118 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 119 | --argstr job "coq-elpi" 120 | coqeal: 121 | needs: 122 | - coq 123 | - mathcomp-real-closed 124 | runs-on: ubuntu-latest 125 | steps: 126 | - name: Determine which commit to initially checkout 127 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 128 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 129 | }}\" >> $GITHUB_ENV\nfi\n" 130 | - name: Git checkout 131 | uses: actions/checkout@v4 132 | with: 133 | fetch-depth: 0 134 | ref: ${{ env.target_commit }} 135 | - name: Determine which commit to test 136 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 137 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 138 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 139 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 140 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 141 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 142 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 143 | \ fi\nfi\n" 144 | - name: Git checkout 145 | uses: actions/checkout@v4 146 | with: 147 | fetch-depth: 0 148 | ref: ${{ env.tested_commit }} 149 | - name: Cachix install 150 | uses: cachix/install-nix-action@v31 151 | with: 152 | nix_path: nixpkgs=channel:nixpkgs-unstable 153 | - name: Cachix setup math-comp 154 | uses: cachix/cachix-action@v16 155 | with: 156 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 157 | extraPullNames: coq, coq-community 158 | name: math-comp 159 | - id: stepGetDerivation 160 | name: Getting derivation for current job (coqeal) 161 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 162 | \"9.1\" --argstr job \"coqeal\" \\\n --dry-run 2> err > out || (touch fail; 163 | true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 164 | failed\"; exit 1; fi\n" 165 | - id: stepCheck 166 | name: Checking presence of CI target for current job 167 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 168 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 169 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 170 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 171 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 172 | - if: steps.stepCheck.outputs.status != 'fetched' 173 | name: 'Building/fetching previous CI target: coq' 174 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 175 | --argstr job "coq" 176 | - if: steps.stepCheck.outputs.status != 'fetched' 177 | name: 'Building/fetching previous CI target: mathcomp-algebra' 178 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 179 | --argstr job "mathcomp-algebra" 180 | - if: steps.stepCheck.outputs.status != 'fetched' 181 | name: 'Building/fetching previous CI target: bignums' 182 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 183 | --argstr job "bignums" 184 | - if: steps.stepCheck.outputs.status != 'fetched' 185 | name: 'Building/fetching previous CI target: multinomials' 186 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 187 | --argstr job "multinomials" 188 | - if: steps.stepCheck.outputs.status != 'fetched' 189 | name: 'Building/fetching previous CI target: mathcomp-real-closed' 190 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 191 | --argstr job "mathcomp-real-closed" 192 | - if: steps.stepCheck.outputs.status != 'fetched' 193 | name: Building/fetching current CI target 194 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 195 | --argstr job "coqeal" 196 | hierarchy-builder: 197 | needs: 198 | - rocq-core 199 | - coq-elpi 200 | runs-on: ubuntu-latest 201 | steps: 202 | - name: Determine which commit to initially checkout 203 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 204 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 205 | }}\" >> $GITHUB_ENV\nfi\n" 206 | - name: Git checkout 207 | uses: actions/checkout@v4 208 | with: 209 | fetch-depth: 0 210 | ref: ${{ env.target_commit }} 211 | - name: Determine which commit to test 212 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 213 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 214 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 215 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 216 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 217 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 218 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 219 | \ fi\nfi\n" 220 | - name: Git checkout 221 | uses: actions/checkout@v4 222 | with: 223 | fetch-depth: 0 224 | ref: ${{ env.tested_commit }} 225 | - name: Cachix install 226 | uses: cachix/install-nix-action@v31 227 | with: 228 | nix_path: nixpkgs=channel:nixpkgs-unstable 229 | - name: Cachix setup math-comp 230 | uses: cachix/cachix-action@v16 231 | with: 232 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 233 | extraPullNames: coq, coq-community 234 | name: math-comp 235 | - id: stepGetDerivation 236 | name: Getting derivation for current job (hierarchy-builder) 237 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 238 | \"9.1\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2> err > out || 239 | (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting 240 | derivation failed\"; exit 1; fi\n" 241 | - id: stepCheck 242 | name: Checking presence of CI target for current job 243 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 244 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 245 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 246 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 247 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 248 | - if: steps.stepCheck.outputs.status != 'fetched' 249 | name: 'Building/fetching previous CI target: rocq-core' 250 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 251 | --argstr job "rocq-core" 252 | - if: steps.stepCheck.outputs.status != 'fetched' 253 | name: 'Building/fetching previous CI target: coq-elpi' 254 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 255 | --argstr job "coq-elpi" 256 | - if: steps.stepCheck.outputs.status != 'fetched' 257 | name: Building/fetching current CI target 258 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 259 | --argstr job "hierarchy-builder" 260 | mathcomp: 261 | needs: 262 | - coq 263 | - hierarchy-builder 264 | runs-on: ubuntu-latest 265 | steps: 266 | - name: Determine which commit to initially checkout 267 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 268 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 269 | }}\" >> $GITHUB_ENV\nfi\n" 270 | - name: Git checkout 271 | uses: actions/checkout@v4 272 | with: 273 | fetch-depth: 0 274 | ref: ${{ env.target_commit }} 275 | - name: Determine which commit to test 276 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 277 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 278 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 279 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 280 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 281 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 282 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 283 | \ fi\nfi\n" 284 | - name: Git checkout 285 | uses: actions/checkout@v4 286 | with: 287 | fetch-depth: 0 288 | ref: ${{ env.tested_commit }} 289 | - name: Cachix install 290 | uses: cachix/install-nix-action@v31 291 | with: 292 | nix_path: nixpkgs=channel:nixpkgs-unstable 293 | - name: Cachix setup math-comp 294 | uses: cachix/cachix-action@v16 295 | with: 296 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 297 | extraPullNames: coq, coq-community 298 | name: math-comp 299 | - id: stepGetDerivation 300 | name: Getting derivation for current job (mathcomp) 301 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 302 | \"9.1\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch 303 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 304 | failed\"; exit 1; fi\n" 305 | - id: stepCheck 306 | name: Checking presence of CI target for current job 307 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 308 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 309 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 310 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 311 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 312 | - if: steps.stepCheck.outputs.status != 'fetched' 313 | name: 'Building/fetching previous CI target: coq' 314 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 315 | --argstr job "coq" 316 | - if: steps.stepCheck.outputs.status != 'fetched' 317 | name: 'Building/fetching previous CI target: mathcomp-character' 318 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 319 | --argstr job "mathcomp-character" 320 | - if: steps.stepCheck.outputs.status != 'fetched' 321 | name: 'Building/fetching previous CI target: hierarchy-builder' 322 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 323 | --argstr job "hierarchy-builder" 324 | - if: steps.stepCheck.outputs.status != 'fetched' 325 | name: Building/fetching current CI target 326 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 327 | --argstr job "mathcomp" 328 | mathcomp-apery: 329 | needs: 330 | - coq 331 | - coqeal 332 | - mathcomp-real-closed 333 | runs-on: ubuntu-latest 334 | steps: 335 | - name: Determine which commit to initially checkout 336 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 337 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 338 | }}\" >> $GITHUB_ENV\nfi\n" 339 | - name: Git checkout 340 | uses: actions/checkout@v4 341 | with: 342 | fetch-depth: 0 343 | ref: ${{ env.target_commit }} 344 | - name: Determine which commit to test 345 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 346 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 347 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 348 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 349 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 350 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 351 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 352 | \ fi\nfi\n" 353 | - name: Git checkout 354 | uses: actions/checkout@v4 355 | with: 356 | fetch-depth: 0 357 | ref: ${{ env.tested_commit }} 358 | - name: Cachix install 359 | uses: cachix/install-nix-action@v31 360 | with: 361 | nix_path: nixpkgs=channel:nixpkgs-unstable 362 | - name: Cachix setup math-comp 363 | uses: cachix/cachix-action@v16 364 | with: 365 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 366 | extraPullNames: coq, coq-community 367 | name: math-comp 368 | - id: stepGetDerivation 369 | name: Getting derivation for current job (mathcomp-apery) 370 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 371 | \"9.1\" --argstr job \"mathcomp-apery\" \\\n --dry-run 2> err > out || (touch 372 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 373 | failed\"; exit 1; fi\n" 374 | - id: stepCheck 375 | name: Checking presence of CI target for current job 376 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 377 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 378 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 379 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 380 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 381 | - if: steps.stepCheck.outputs.status != 'fetched' 382 | name: 'Building/fetching previous CI target: coq' 383 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 384 | --argstr job "coq" 385 | - if: steps.stepCheck.outputs.status != 'fetched' 386 | name: 'Building/fetching previous CI target: mathcomp-field' 387 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 388 | --argstr job "mathcomp-field" 389 | - if: steps.stepCheck.outputs.status != 'fetched' 390 | name: 'Building/fetching previous CI target: coqeal' 391 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 392 | --argstr job "coqeal" 393 | - if: steps.stepCheck.outputs.status != 'fetched' 394 | name: 'Building/fetching previous CI target: mathcomp-real-closed' 395 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 396 | --argstr job "mathcomp-real-closed" 397 | - if: steps.stepCheck.outputs.status != 'fetched' 398 | name: 'Building/fetching previous CI target: mathcomp-bigenough' 399 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 400 | --argstr job "mathcomp-bigenough" 401 | - if: steps.stepCheck.outputs.status != 'fetched' 402 | name: 'Building/fetching previous CI target: mathcomp-zify' 403 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 404 | --argstr job "mathcomp-zify" 405 | - if: steps.stepCheck.outputs.status != 'fetched' 406 | name: 'Building/fetching previous CI target: mathcomp-algebra-tactics' 407 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 408 | --argstr job "mathcomp-algebra-tactics" 409 | - if: steps.stepCheck.outputs.status != 'fetched' 410 | name: Building/fetching current CI target 411 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 412 | --argstr job "mathcomp-apery" 413 | mathcomp-real-closed: 414 | needs: 415 | - coq 416 | runs-on: ubuntu-latest 417 | steps: 418 | - name: Determine which commit to initially checkout 419 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 420 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 421 | }}\" >> $GITHUB_ENV\nfi\n" 422 | - name: Git checkout 423 | uses: actions/checkout@v4 424 | with: 425 | fetch-depth: 0 426 | ref: ${{ env.target_commit }} 427 | - name: Determine which commit to test 428 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 429 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 430 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 431 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 432 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 433 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 434 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 435 | \ fi\nfi\n" 436 | - name: Git checkout 437 | uses: actions/checkout@v4 438 | with: 439 | fetch-depth: 0 440 | ref: ${{ env.tested_commit }} 441 | - name: Cachix install 442 | uses: cachix/install-nix-action@v31 443 | with: 444 | nix_path: nixpkgs=channel:nixpkgs-unstable 445 | - name: Cachix setup math-comp 446 | uses: cachix/cachix-action@v16 447 | with: 448 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 449 | extraPullNames: coq, coq-community 450 | name: math-comp 451 | - id: stepGetDerivation 452 | name: Getting derivation for current job (mathcomp-real-closed) 453 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 454 | \"9.1\" --argstr job \"mathcomp-real-closed\" \\\n --dry-run 2> err > out 455 | || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting 456 | derivation failed\"; exit 1; fi\n" 457 | - id: stepCheck 458 | name: Checking presence of CI target for current job 459 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 460 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 461 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 462 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 463 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 464 | - if: steps.stepCheck.outputs.status != 'fetched' 465 | name: 'Building/fetching previous CI target: coq' 466 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 467 | --argstr job "coq" 468 | - if: steps.stepCheck.outputs.status != 'fetched' 469 | name: 'Building/fetching previous CI target: mathcomp-ssreflect' 470 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 471 | --argstr job "mathcomp-ssreflect" 472 | - if: steps.stepCheck.outputs.status != 'fetched' 473 | name: 'Building/fetching previous CI target: mathcomp-algebra' 474 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 475 | --argstr job "mathcomp-algebra" 476 | - if: steps.stepCheck.outputs.status != 'fetched' 477 | name: 'Building/fetching previous CI target: mathcomp-field' 478 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 479 | --argstr job "mathcomp-field" 480 | - if: steps.stepCheck.outputs.status != 'fetched' 481 | name: 'Building/fetching previous CI target: mathcomp-fingroup' 482 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 483 | --argstr job "mathcomp-fingroup" 484 | - if: steps.stepCheck.outputs.status != 'fetched' 485 | name: 'Building/fetching previous CI target: mathcomp-solvable' 486 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 487 | --argstr job "mathcomp-solvable" 488 | - if: steps.stepCheck.outputs.status != 'fetched' 489 | name: 'Building/fetching previous CI target: mathcomp-bigenough' 490 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 491 | --argstr job "mathcomp-bigenough" 492 | - if: steps.stepCheck.outputs.status != 'fetched' 493 | name: Building/fetching current CI target 494 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 495 | --argstr job "mathcomp-real-closed" 496 | rocq-core: 497 | needs: [] 498 | runs-on: ubuntu-latest 499 | steps: 500 | - name: Determine which commit to initially checkout 501 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ 502 | github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha 503 | }}\" >> $GITHUB_ENV\nfi\n" 504 | - name: Git checkout 505 | uses: actions/checkout@v4 506 | with: 507 | fetch-depth: 0 508 | ref: ${{ env.target_commit }} 509 | - name: Determine which commit to test 510 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ 511 | github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url 512 | }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git 513 | merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 514 | 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ 515 | \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha 516 | }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ 517 | \ fi\nfi\n" 518 | - name: Git checkout 519 | uses: actions/checkout@v4 520 | with: 521 | fetch-depth: 0 522 | ref: ${{ env.tested_commit }} 523 | - name: Cachix install 524 | uses: cachix/install-nix-action@v31 525 | with: 526 | nix_path: nixpkgs=channel:nixpkgs-unstable 527 | - name: Cachix setup math-comp 528 | uses: cachix/cachix-action@v16 529 | with: 530 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 531 | extraPullNames: coq, coq-community 532 | name: math-comp 533 | - id: stepGetDerivation 534 | name: Getting derivation for current job (rocq-core) 535 | run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle 536 | \"9.1\" --argstr job \"rocq-core\" \\\n --dry-run 2> err > out || (touch 537 | fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation 538 | failed\"; exit 1; fi\n" 539 | - id: stepCheck 540 | name: Checking presence of CI target for current job 541 | run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs 542 | actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ 543 | ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ 544 | \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ 545 | status=fetched\" >> $GITHUB_OUTPUT\nfi\n" 546 | - if: steps.stepCheck.outputs.status != 'fetched' 547 | name: Building/fetching current CI target 548 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.1" 549 | --argstr job "rocq-core" 550 | name: Nix CI for bundle 9.1 551 | on: 552 | pull_request: 553 | paths: 554 | - .github/workflows/nix-action-9.1.yml 555 | pull_request_target: 556 | paths-ignore: 557 | - .github/workflows/nix-action-9.1.yml 558 | types: 559 | - opened 560 | - synchronize 561 | - reopened 562 | push: 563 | branches: 564 | - master 565 | -------------------------------------------------------------------------------- /theories/qe_rcf.v: -------------------------------------------------------------------------------- 1 | (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From Corelib Require Import Setoid. 4 | From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path. 5 | From mathcomp Require Import div choice fintype finfun bigop order ssralg zmodp. 6 | From mathcomp Require Import poly polydiv ssrnum ssrint interval matrix polyXY. 7 | From mathcomp Require Import polyorder polyrcf mxtens qe_rcf_th ordered_qelim. 8 | 9 | Set Implicit Arguments. 10 | Unset Strict Implicit. 11 | Unset Printing Implicit Defensive. 12 | 13 | Import Order.TTheory GRing.Theory Num.Theory. 14 | 15 | Local Open Scope ring_scope. 16 | 17 | Definition grab (X Y : Type) (pattern : Y -> Prop) (P : Prop -> Prop) 18 | (y : X) (f : X -> Y) : 19 | (let F := f in P (forall x, y = x -> pattern (F x))) 20 | -> P (forall x : X, y = x -> pattern (f x)) := id. 21 | 22 | Definition grab_eq X Y u := @grab X Y (fun v => u = v :> Y). 23 | 24 | Tactic Notation "grab_eq" ident(f) open_constr(PAT1) := 25 | let Edef := fresh "Edef" in 26 | let E := fresh "E" in 27 | move Edef: PAT1 => E; 28 | move: E Edef; 29 | elim/grab_eq: _ => f _ <-. 30 | 31 | Import ord. 32 | 33 | Section QF. 34 | 35 | Variable R : Type. 36 | 37 | Inductive term : Type := 38 | | Var of nat 39 | | Const of R 40 | | NatConst of nat 41 | | Add of term & term 42 | | Opp of term 43 | | NatMul of term & nat 44 | | Mul of term & term 45 | | Exp of term & nat. 46 | 47 | Inductive formula : Type := 48 | | Bool of bool 49 | | Equal of term & term 50 | | Lt of term & term 51 | | Le of term & term 52 | | And of formula & formula 53 | | Or of formula & formula 54 | | Implies of formula & formula 55 | | Not of formula. 56 | 57 | Coercion rterm_to_term := fix loop (t : term) : GRing.term R := 58 | match t with 59 | | Var x => GRing.Var _ x 60 | | Const x => GRing.Const x 61 | | NatConst n => GRing.NatConst _ n 62 | | Add u v => GRing.Add (loop u) (loop v) 63 | | Opp u => GRing.Opp (loop u) 64 | | NatMul u n => GRing.NatMul (loop u) n 65 | | Mul u v => GRing.Mul (loop u) (loop v) 66 | | Exp u n => GRing.Exp (loop u) n 67 | end. 68 | 69 | Coercion qfr_to_formula := fix loop (f : formula) : ord.formula R := 70 | match f with 71 | | Bool b => ord.Bool b 72 | | Equal x y => ord.Equal x y 73 | | Lt x y => ord.Lt x y 74 | | Le x y => ord.Le x y 75 | | And f g => ord.And (loop f) (loop g) 76 | | Or f g => ord.Or (loop f) (loop g) 77 | | Implies f g => ord.Implies (loop f) (loop g) 78 | | Not f => ord.Not (loop f) 79 | end. 80 | 81 | Definition to_rterm := fix loop (t : GRing.term R) : term := 82 | match t with 83 | | GRing.Var x => Var x 84 | | GRing.Const x => Const x 85 | | GRing.NatConst n => NatConst n 86 | | GRing.Add u v => Add (loop u) (loop v) 87 | | GRing.Opp u => Opp (loop u) 88 | | GRing.NatMul u n => NatMul (loop u) n 89 | | GRing.Mul u v => Mul (loop u) (loop v) 90 | | GRing.Exp u n => Exp (loop u) n 91 | | _ => NatConst 0 92 | end. 93 | 94 | End QF. 95 | 96 | Declare Scope qf_scope. 97 | Bind Scope qf_scope with term. 98 | Bind Scope qf_scope with formula. 99 | Delimit Scope qf_scope with qfT. 100 | Arguments Add _ _%qfT _%qfT. 101 | Arguments Opp _ _%qfT. 102 | Arguments NatMul _ _%qfT _%N. 103 | Arguments Mul _ _%qfT _%qfT. 104 | Arguments Mul _ _%qfT _%qfT. 105 | Arguments Exp _ _%qfT _%N. 106 | Arguments Equal _ _%qfT _%qfT. 107 | Arguments And _ _%qfT _%qfT. 108 | Arguments Or _ _%qfT _%qfT. 109 | Arguments Implies _ _%qfT _%qfT. 110 | Arguments Not _ _%qfT. 111 | 112 | Arguments Bool [R]. 113 | Prenex Implicits Const Add Opp NatMul Mul Exp Bool Unit And Or Implies Not Lt. 114 | Prenex Implicits to_rterm. 115 | 116 | Notation True := (Bool true). 117 | Notation False := (Bool false). 118 | 119 | Notation "''X_' i" := (Var _ i) : qf_scope. 120 | Notation "n %:R" := (NatConst _ n) : qf_scope. 121 | Notation "x %:T" := (Const x) : qf_scope. 122 | Notation "0" := 0%:R%qfT : qf_scope. 123 | Notation "1" := 1%:R%qfT : qf_scope. 124 | Infix "+" := Add : qf_scope. 125 | Notation "- t" := (Opp t) : qf_scope. 126 | Notation "t - u" := (Add t (- u)) : qf_scope. 127 | Infix "*" := Mul : qf_scope. 128 | Infix "*+" := NatMul : qf_scope. 129 | Infix "^+" := Exp : qf_scope. 130 | Notation "t ^- n" := (t^-1 ^+ n)%qfT : qf_scope. 131 | Infix "==" := Equal : qf_scope. 132 | Infix "<%" := Lt : qf_scope. 133 | Infix "<=%" := Le : qf_scope. 134 | Infix "/\" := And : qf_scope. 135 | Infix "\/" := Or : qf_scope. 136 | Infix "==>" := Implies : qf_scope. 137 | Notation "~ f" := (Not f) : qf_scope. 138 | Notation "x != y" := (Not (x == y)) : qf_scope. 139 | 140 | Section evaluation. 141 | 142 | Variable R : realDomainType. 143 | 144 | Fixpoint eval (e : seq R) (t : term R) {struct t} : R := 145 | match t with 146 | | ('X_i)%qfT => e`_i 147 | | (x%:T)%qfT => x 148 | | (n%:R)%qfT => n%:R 149 | | (t1 + t2)%qfT => eval e t1 + eval e t2 150 | | (- t1)%qfT => - eval e t1 151 | | (t1 *+ n)%qfT => eval e t1 *+ n 152 | | (t1 * t2)%qfT => eval e t1 * eval e t2 153 | | (t1 ^+ n)%qfT => eval e t1 ^+ n 154 | end. 155 | 156 | Lemma evalE (e : seq R) (t : term R) : eval e t = GRing.eval e t. 157 | Proof. by elim: t=> /=; do ?[move->|move=> ?]. Qed. 158 | 159 | Definition qf_eval e := fix loop (f : formula R) : bool := 160 | match f with 161 | | Bool b => b 162 | | t1 == t2 => (eval e t1 == eval e t2)%bool 163 | | t1 <% t2 => (eval e t1 < eval e t2)%bool 164 | | t1 <=% t2 => (eval e t1 <= eval e t2)%bool 165 | | f1 /\ f2 => loop f1 && loop f2 166 | | f1 \/ f2 => loop f1 || loop f2 167 | | f1 ==> f2 => (loop f1 ==> loop f2)%bool 168 | | ~ f1 => ~~ loop f1 169 | end%qfT. 170 | 171 | Lemma qf_evalE (e : seq R) (f : formula R) : qf_eval e f = ord.qf_eval e f. 172 | Proof. by elim: f=> /=; do ?[rewrite evalE|move->|move=> ?]. Qed. 173 | 174 | Lemma to_rtermE (t : GRing.term R) : 175 | GRing.rterm t -> to_rterm t = t :> GRing.term _. 176 | Proof. 177 | elim: t=> //=; do ? 178 | [ by move=> u hu v hv /andP[ru rv]; rewrite hu ?hv 179 | | by move=> u hu *; rewrite hu]. 180 | Qed. 181 | 182 | End evaluation. 183 | 184 | Import Pdiv.Ring. 185 | 186 | Definition bind_def T1 T2 T3 (f : (T1 -> T2) -> T3) (k : T1 -> T2) := f k. 187 | Notation "'bind' x <- y ; z" := 188 | (bind_def y (fun x => z)) (at level 99, x at level 0, y at level 10, z at level 99, 189 | format "'[hv' 'bind' x <- y ; '/' z ']'"). 190 | 191 | Section ProjDef. 192 | 193 | Variable F : realFieldType. 194 | 195 | Notation fF := (formula F). 196 | Notation tF := (term F). 197 | Definition polyF := seq tF. 198 | 199 | Lemma qf_formF (f : fF) : qf_form f. 200 | Proof. by elim: f=> // *; apply/andP; split. Qed. 201 | 202 | Lemma rtermF (t : tF) : GRing.rterm t. 203 | Proof. by elim: t=> //=; do ?[move->|move=> ?]. Qed. 204 | 205 | Lemma rformulaF (f : fF) : rformula f. 206 | Proof. by elim: f=> /=; do ?[rewrite rtermF|move->|move=> ?]. Qed. 207 | 208 | Section If. 209 | 210 | Implicit Types (pf tf ef : formula F). 211 | 212 | Definition If pf tf ef := (pf /\ tf \/ ~ pf /\ ef)%qfT. 213 | 214 | End If. 215 | 216 | Notation "'If' c1 'Then' c2 'Else' c3" := (If c1 c2 c3) 217 | (at level 200, right associativity, format 218 | "'[hv ' 'If' c1 '/' '[' 'Then' c2 ']' '/' '[' 'Else' c3 ']' ']'"). 219 | 220 | Notation cps T := ((T -> fF) -> fF). 221 | 222 | Section Pick. 223 | 224 | Variables (I : finType) (pred_f then_f : I -> fF) (else_f : fF). 225 | 226 | Definition Pick := 227 | \big[Or/False]_(p : {ffun pred I}) 228 | ((\big[And/True]_i (if p i then pred_f i else ~ pred_f i)) 229 | /\ (if pick p is Some i then then_f i else else_f))%qfT. 230 | 231 | Lemma eval_Pick e (qev := qf_eval e) : 232 | let P i := qev (pred_f i) in 233 | qev Pick = (if pick P is Some i then qev (then_f i) else qev else_f). 234 | Proof. 235 | move=> P; rewrite ((big_morph qev) false orb) //= big_orE /=. 236 | apply/existsP/idP=> [[p] | true_at_P]. 237 | rewrite ((big_morph qev) true andb) //= big_andE /=. 238 | case/andP=> /forallP eq_p_P. 239 | rewrite (@eq_pick _ _ P) => [|i]; first by case: pick. 240 | by move/(_ i): eq_p_P => /=; case: (p i) => //=; move/negbTE. 241 | exists [ffun i => P i] => /=; apply/andP; split. 242 | rewrite ((big_morph qev) true andb) //= big_andE /=. 243 | by apply/forallP=> i; rewrite /= ffunE; case Pi: (P i) => //=; apply: negbT. 244 | rewrite (@eq_pick _ _ P) => [|i]; first by case: pick true_at_P. 245 | by rewrite ffunE. 246 | Qed. 247 | 248 | End Pick. 249 | 250 | Fixpoint eval_poly (e : seq F) pf := 251 | if pf is c :: qf then (eval_poly e qf) * 'X + (eval e c)%:P else 0. 252 | 253 | Lemma eval_polyP e p : eval_poly e p = Poly (map (eval e) p). 254 | Proof. by elim: p=> // a p /= ->; rewrite cons_poly_def. Qed. 255 | 256 | Fixpoint Size (p : polyF) : cps nat := fun k => 257 | if p is c :: q then 258 | bind n <- Size q; 259 | if n is m.+1 then k m.+2 260 | else If c == 0 Then k 0%N Else k 1%N 261 | else k 0%N. 262 | 263 | Definition Isnull (p : polyF) : cps bool := fun k => 264 | bind n <- Size p; k (n == 0%N). 265 | 266 | Definition LtSize (p q : polyF) : cps bool := fun k => 267 | bind n <- Size p; bind m <- Size q; k (n < m)%N. 268 | 269 | Fixpoint LeadCoef p : cps tF := fun k => 270 | if p is c :: q then 271 | bind l <- LeadCoef q; If l == 0 Then k c Else k l 272 | else k (Const 0). 273 | 274 | Fixpoint AmulXn (a : tF) (n : nat) : polyF:= 275 | if n is n'.+1 then (Const 0) :: (AmulXn a n') else [::a]. 276 | 277 | Fixpoint AddPoly (p q : polyF) := 278 | if p is a::p' then 279 | if q is b::q' then (a + b)%qfT :: (AddPoly p' q') 280 | else p 281 | else q. 282 | Local Infix "++" := AddPoly : qf_scope. 283 | 284 | Definition ScalPoly (c : tF) (p : polyF) : polyF := map (Mul c) p. 285 | Local Infix "*:" := ScalPoly : qf_scope. 286 | 287 | Fixpoint MulPoly (p q : polyF) := if p is a :: p' 288 | then (a *: q ++ (0 :: (MulPoly p' q)))%qfT else [::]. 289 | Local Infix "**" := MulPoly (at level 40) : qf_scope. 290 | 291 | Lemma map_poly0 (R R' : ringType) (f : R -> R') : map_poly f 0 = 0. 292 | Proof. by rewrite map_polyE polyseq0. Qed. 293 | 294 | Definition ExpPoly p n := iterop n MulPoly p [::1%qfT]. 295 | Local Infix "^^+" := ExpPoly (at level 29) : qf_scope. 296 | 297 | Definition OppPoly := ScalPoly (@Const F (-1)). 298 | Local Notation "-- p" := (OppPoly p) (at level 35) : qf_scope. 299 | Local Notation "p -- q" := (p ++ (-- q))%qfT (at level 50) : qf_scope. 300 | 301 | Definition NatMulPoly n := ScalPoly (NatConst F n). 302 | Local Infix "+**" := NatMulPoly (at level 40) : qf_scope. 303 | 304 | Fixpoint Horner (p : polyF) (x : tF) : tF := 305 | if p is a :: p then (Horner p x * x + a)%qfT else 0%qfT. 306 | 307 | Fixpoint Deriv (p : polyF) : polyF := 308 | if p is a :: q then (q ++ (0 :: Deriv q))%qfT else [::]. 309 | 310 | Fixpoint Rediv_rec_loop (q : polyF) sq cq 311 | (c : nat) (qq r : polyF) (n : nat) {struct n} : 312 | cps (nat * polyF * polyF) := fun k => 313 | bind sr <- Size r; 314 | if (sr < sq)%N then k (c, qq, r) else 315 | bind lr <- LeadCoef r; 316 | let m := AmulXn lr (sr - sq) in 317 | let qq1 := (qq ** [::cq] ++ m)%qfT in 318 | let r1 := (r ** [::cq] -- m ** q)%qfT in 319 | if n is n1.+1 then Rediv_rec_loop q sq cq c.+1 qq1 r1 n1 k 320 | else k (c.+1, qq1, r1). 321 | 322 | Definition Rediv (p : polyF) (q : polyF) : cps (nat * polyF * polyF) := 323 | fun k => 324 | bind b <- Isnull q; 325 | if b then k (0%N, [::Const 0], p) 326 | else bind sq <- Size q; 327 | bind sp <- Size p; 328 | bind lq <- LeadCoef q; 329 | Rediv_rec_loop q sq lq 0 [::Const 0] p sp k. 330 | 331 | Definition Rmod (p : polyF) (q : polyF) (k : polyF -> fF) : fF := 332 | Rediv p q (fun d => k d.2)%PAIR. 333 | Definition Rdiv (p : polyF) (q : polyF) (k : polyF -> fF) : fF := 334 | Rediv p q (fun d => k d.1.2)%PAIR. 335 | Definition Rscal (p : polyF) (q : polyF) (k : nat -> fF) : fF := 336 | Rediv p q (fun d => k d.1.1)%PAIR. 337 | Definition Rdvd (p : polyF) (q : polyF) (k : bool -> fF) : fF := 338 | bind r <- Rmod p q; bind r_null <- Isnull r; k r_null. 339 | 340 | Fixpoint rgcdp_loop n (pp qq : {poly F}) {struct n} := 341 | if rmodp pp qq == 0 then qq 342 | else if n is n1.+1 then rgcdp_loop n1 qq (rmodp pp qq) 343 | else rmodp pp qq. 344 | 345 | Fixpoint Rgcd_loop n pp qq k {struct n} := 346 | bind r <- Rmod pp qq; bind b <- Isnull r; 347 | if b then (k qq) 348 | else if n is n1.+1 then Rgcd_loop n1 qq r k else k r. 349 | 350 | Definition Rgcd (p : polyF) (q : polyF) : cps polyF := fun k => 351 | let aux p1 q1 k := (bind b <- Isnull p1; 352 | if b then k q1 else bind n <- Size p1; Rgcd_loop n p1 q1 k) in 353 | bind b <- LtSize p q; 354 | if b then aux q p k else aux p q k. 355 | 356 | Fixpoint BigRgcd (ps : seq polyF) : cps (seq tF) := fun k => 357 | if ps is p :: pr then bind r <- BigRgcd pr; Rgcd p r k else k [::Const 0]. 358 | 359 | Fixpoint Changes (s : seq tF) : cps nat := fun k => 360 | if s is a :: q then 361 | bind v <- Changes q; 362 | If (Lt (a * head 0 q) 0)%qfT Then k (1 + v)%N Else k v 363 | else k 0%N. 364 | 365 | Fixpoint SeqPInfty (ps : seq polyF) : cps (seq tF) := fun k => 366 | if ps is p :: ps then 367 | bind lp <- LeadCoef p; 368 | bind lps <- SeqPInfty ps; 369 | k (lp :: lps) 370 | else k [::]. 371 | 372 | Fixpoint SeqMInfty (ps : seq polyF) : cps (seq tF) := fun k => 373 | if ps is p :: ps then 374 | bind lp <- LeadCoef p; 375 | bind sp <- Size p; 376 | bind lps <- SeqMInfty ps; 377 | k ((-1)%:T ^+ (~~ odd sp) * lp :: lps)%qfT 378 | else k [::]. 379 | 380 | Definition ChangesPoly ps : cps int := fun k => 381 | bind mps <- SeqMInfty ps; 382 | bind pps <- SeqPInfty ps; 383 | bind vm <- Changes mps; bind vp <- Changes pps; k (vm%:Z - vp%:Z). 384 | 385 | Definition NextMod (p q : polyF) : cps polyF := fun k => 386 | bind lq <- LeadCoef q; 387 | bind spq <- Rscal p q; 388 | bind rpq <- Rmod p q; k (- lq ^+ spq *: rpq)%qfT. 389 | 390 | Fixpoint ModsAux (p q : polyF) n : cps (seq polyF) := fun k => 391 | if n is m.+1 392 | then 393 | bind p_eq0 <- Isnull p; 394 | if p_eq0 then k [::] 395 | else 396 | bind npq <- NextMod p q; 397 | bind ps <- ModsAux q npq m; 398 | k (p :: ps) 399 | else k [::]. 400 | 401 | Definition Mods (p q : polyF) : cps (seq polyF) := fun k => 402 | bind sp <- Size p; bind sq <- Size q; 403 | ModsAux p q (maxn sp sq.+1) k. 404 | 405 | Definition PolyComb (sq : seq polyF) (sc : seq int) := 406 | reducebig [::1%qfT] (iota 0 (size sq)) 407 | (fun i => BigBody i MulPoly true (nth [::] sq i ^^+ comb_exp sc`_i)%qfT). 408 | 409 | Definition Pcq sq i := (nth [::] (map (PolyComb sq) (sg_tab (size sq))) i). 410 | 411 | Definition TaqR (p : polyF) (q : polyF) : cps int := fun k => 412 | bind r <- Mods p (Deriv p ** q)%qfT; ChangesPoly r k. 413 | 414 | Definition TaqsR (p : polyF) (sq : seq polyF) (i : nat) : cps tF := 415 | fun k => bind n <- TaqR p (Pcq sq i); k ((n%:~R) %:T)%qfT. 416 | 417 | Fixpoint ProdPoly T (s : seq T) (f : T -> cps polyF) : cps polyF := fun k => 418 | if s is a :: s then 419 | bind fa <- f a; 420 | bind fs <- ProdPoly s f; 421 | k (fa ** fs)%qfT 422 | else k [::1%qfT]. 423 | 424 | Definition BoundingPoly (sq : seq polyF) : polyF := 425 | Deriv (reducebig [::1%qfT] sq (fun i => BigBody i MulPoly true i)). 426 | 427 | Definition Coefs (n i : nat) : tF := 428 | Const (match n with 429 | | 0 => (i == 0%N)%:R 430 | | 1 => [:: 2%:R^-1; 2%:R^-1; 0]`_i 431 | | n => coefs _ n i 432 | end). 433 | 434 | Definition CcountWeak (p : polyF) (sq : seq polyF) : cps tF := fun k => 435 | let fix aux s (i : nat) k := if i is i'.+1 436 | then bind x <- TaqsR p sq i'; 437 | aux (x * (Coefs (size sq) i') + s)%qfT i' k 438 | else k s in 439 | aux 0%qfT (3 ^ size sq)%N k. 440 | 441 | Definition CcountGt0 (sp sq : seq polyF) : fF := 442 | bind p <- BigRgcd sp; bind p0 <- Isnull p; 443 | if ~~ p0 then 444 | bind c <- CcountWeak p sq; 445 | Lt 0%qfT c 446 | else 447 | let bq := BoundingPoly sq in 448 | bind cw <- CcountWeak bq sq; 449 | ((reducebig True sq (fun q => 450 | BigBody q And true (LeadCoef q (fun lq => Lt 0 lq)))) 451 | \/ ((reducebig True sq (fun q => 452 | BigBody q And true 453 | (bind sq <- Size q; 454 | bind lq <- LeadCoef q; 455 | Lt 0 ((Opp 1) ^+ (sq).-1 * lq) 456 | ))) \/ Lt 0 cw))%qfT. 457 | 458 | 459 | Fixpoint abstrX (i : nat) (t : tF) : polyF := 460 | (match t with 461 | | 'X_n => if n == i then [::0; 1] else [::t] 462 | | - x => -- abstrX i x 463 | | x + y => abstrX i x ++ abstrX i y 464 | | x * y => abstrX i x ** abstrX i y 465 | | x *+ n => n +** abstrX i x 466 | | x ^+ n => abstrX i x ^^+ n 467 | | _ => [::t] 468 | end)%qfT. 469 | 470 | Definition wproj (n : nat) (s : seq (GRing.term F) * seq (GRing.term F)) : 471 | formula F := 472 | let sp := map (abstrX n \o to_rterm) s.1%PAIR in 473 | let sq := map (abstrX n \o to_rterm) s.2%PAIR in 474 | CcountGt0 sp sq. 475 | 476 | Definition rcf_sat := proj_sat wproj. 477 | 478 | End ProjDef. 479 | 480 | Section ProjCorrect. 481 | 482 | Variable F : rcfType. 483 | Implicit Types (e : seq F). 484 | 485 | Notation fF := (formula F). 486 | Notation tF := (term F). 487 | Notation polyF := (polyF F). 488 | 489 | Notation "'If' c1 'Then' c2 'Else' c3" := (If c1 c2 c3) 490 | (at level 200, right associativity, format 491 | "'[hv ' 'If' c1 '/' '[' 'Then' c2 ']' '/' '[' 'Else' c3 ']' ']'"). 492 | 493 | Notation cps T := ((T -> fF) -> fF). 494 | 495 | Local Infix "**" := MulPoly (at level 40) : qf_scope. 496 | Local Infix "+**" := NatMulPoly (at level 40) : qf_scope. 497 | Local Notation "-- p" := (OppPoly p) (at level 35) : qf_scope. 498 | Local Notation "p -- q" := (p ++ (-- q))%qfT (at level 50) : qf_scope. 499 | Local Infix "^^+" := ExpPoly (at level 29) : qf_scope. 500 | Local Infix "**" := MulPoly (at level 40) : qf_scope. 501 | Local Infix "*:" := ScalPoly : qf_scope. 502 | Local Infix "++" := AddPoly : qf_scope. 503 | 504 | Lemma eval_If e pf tf ef (ev := qf_eval e) : 505 | ev (If pf Then tf Else ef) = (if ev pf then ev tf else ev ef). 506 | Proof. by unlock (If _ Then _ Else _)=> /=; case: ifP => _; rewrite ?orbF. Qed. 507 | 508 | Lemma eval_Size k p e : 509 | qf_eval e (Size p k) = qf_eval e (k (size (eval_poly e p))). 510 | Proof. 511 | elim: p e k=> [|c p ihp] e k; first by rewrite size_poly0. 512 | rewrite ihp /= size_MXaddC -size_poly_eq0; case: size=> //. 513 | by rewrite eval_If /=; case: (_ == _). 514 | Qed. 515 | 516 | Lemma eval_Isnull k p e : qf_eval e (Isnull p k) 517 | = qf_eval e (k (eval_poly e p == 0)). 518 | Proof. by rewrite eval_Size size_poly_eq0. Qed. 519 | 520 | Lemma eval_LeadCoef e p k k' : 521 | (forall x, qf_eval e (k x) = (k' (eval e x))) -> 522 | qf_eval e (LeadCoef p k) = k' (lead_coef (eval_poly e p)). 523 | Proof. 524 | move=> Pk; elim: p k k' Pk=> [|a p ihp] k k' Pk //=. 525 | by rewrite lead_coef0 Pk. 526 | rewrite (ihp _ (fun l => if l == 0 then qf_eval e (k a) else (k' l))); last first. 527 | by move=> x; rewrite eval_If /= !Pk. 528 | rewrite lead_coef_eq0; have [->|p_neq0] := altP (_ =P 0). 529 | by rewrite mul0r add0r lead_coefC. 530 | rewrite lead_coefDl ?lead_coefMX ?size_mulX // ltnS size_polyC. 531 | by rewrite (leq_trans (leq_b1 _)) // size_poly_gt0. 532 | Qed. 533 | 534 | Arguments eval_LeadCoef [e p k]. 535 | Prenex Implicits eval_LeadCoef. 536 | 537 | Lemma eval_AmulXn a n e : eval_poly e (AmulXn a n) = (eval e a)%:P * 'X^n. 538 | Proof. 539 | elim: n=> [|n] /=; first by rewrite expr0 mulr1 mul0r add0r. 540 | by move->; rewrite addr0 -mulrA -exprSr. 541 | Qed. 542 | 543 | Lemma eval_AddPoly p q e : 544 | eval_poly e (p ++ q)%qfT = (eval_poly e p) + (eval_poly e q). 545 | Proof. 546 | elim: p q => [|a p Hp] q /=; first by rewrite add0r. 547 | case: q => [|b q] /=; first by rewrite addr0. 548 | by rewrite Hp mulrDl rmorphD /= !addrA [X in _ = X + _]addrAC. 549 | Qed. 550 | 551 | Lemma eval_ScalPoly e t p : 552 | eval_poly e (ScalPoly t p) = (eval e t) *: (eval_poly e p). 553 | Proof. 554 | elim: p=> [|a p ihp] /=; first by rewrite scaler0. 555 | by rewrite ihp scalerDr scalerAl -!mul_polyC rmorphM. 556 | Qed. 557 | 558 | Lemma eval_MulPoly e p q : 559 | eval_poly e (p ** q)%qfT = (eval_poly e p) * (eval_poly e q). 560 | Proof. 561 | elim: p q=> [|a p Hp] q /=; first by rewrite mul0r. 562 | rewrite eval_AddPoly /= eval_ScalPoly Hp. 563 | by rewrite addr0 mulrDl addrC mulrAC mul_polyC. 564 | Qed. 565 | 566 | Lemma eval_ExpPoly e p n : eval_poly e (p ^^+ n)%qfT = (eval_poly e p) ^+ n. 567 | Proof. 568 | case: n=> [|n]; first by rewrite /= expr0 mul0r add0r. 569 | rewrite /ExpPoly iteropS exprSr; elim: n=> [|n ihn] //=. 570 | by rewrite expr0 mul1r. 571 | by rewrite eval_MulPoly ihn exprS mulrA. 572 | Qed. 573 | 574 | Lemma eval_NatMulPoly p n e : 575 | eval_poly e (n +** p)%qfT = (eval_poly e p) *+ n. 576 | Proof. 577 | elim: p; rewrite //= ?mul0rn // => c p ->. 578 | rewrite mulrnDl mulr_natl polyCMn; congr (_+_). 579 | by rewrite -mulr_natl mulrAC -mulrA mulr_natl mulrC. 580 | Qed. 581 | 582 | Lemma eval_OppPoly p e : eval_poly e (-- p)%qfT = - eval_poly e p. 583 | Proof. 584 | elim: p; rewrite //= ?oppr0 // => t ts ->. 585 | by rewrite !mulNr !opprD polyCN mul1r. 586 | Qed. 587 | 588 | Lemma eval_Horner e p x : eval e (Horner p x) = (eval_poly e p).[eval e x]. 589 | Proof. by elim: p => /= [|a p ihp]; rewrite !(horner0, hornerE) // ihp. Qed. 590 | 591 | Lemma eval_ConstPoly e c : eval_poly e [::c] = (eval e c)%:P. 592 | Proof. by rewrite /= mul0r add0r. Qed. 593 | 594 | Lemma eval_Deriv e p : eval_poly e (Deriv p) = (eval_poly e p)^`(). 595 | Proof. 596 | elim: p=> [|a p ihp] /=; first by rewrite deriv0. 597 | by rewrite eval_AddPoly /= addr0 ihp !derivE. 598 | Qed. 599 | 600 | Definition eval_OpPoly := 601 | (eval_MulPoly, eval_AmulXn, eval_AddPoly, eval_OppPoly, eval_NatMulPoly, 602 | eval_ConstPoly, eval_Horner, eval_ExpPoly, eval_Deriv, eval_ScalPoly). 603 | 604 | Lemma eval_Changes e s k : qf_eval e (Changes s k) 605 | = qf_eval e (k (changes (map (eval e) s))). 606 | Proof. 607 | elim: s k=> //= a q ihq k; rewrite ihq eval_If /= -nth0. 608 | by case: q {ihq}=> /= [|b q]; [rewrite /= mulr0 ltxx add0n | case: ltrP]. 609 | Qed. 610 | 611 | Lemma eval_SeqPInfty e ps k k' : 612 | (forall xs, qf_eval e (k xs) = k' (map (eval e) xs)) -> 613 | qf_eval e (SeqPInfty ps k) 614 | = k' (map lead_coef (map (eval_poly e) ps)). 615 | Proof. 616 | elim: ps k k' => [|p ps ihps] k k' Pk /=; first by rewrite Pk. 617 | set X := lead_coef _; grab_eq k'' X; apply: (eval_LeadCoef k'') => lp {X}. 618 | by rewrite (ihps _ (fun ps => k' (eval e lp :: ps))). 619 | Qed. 620 | 621 | Arguments eval_SeqPInfty [e ps k]. 622 | Prenex Implicits eval_SeqPInfty. 623 | 624 | Lemma eval_SeqMInfty e ps k k' : 625 | (forall xs, qf_eval e (k xs) = k' (map (eval e) xs)) -> 626 | qf_eval e (SeqMInfty ps k) 627 | = k' (map (fun p : {poly F} => (-1) ^+ (~~ odd (size p)) * lead_coef p) 628 | (map (eval_poly e) ps)). 629 | Proof. 630 | elim: ps k k' => [|p ps ihps] k k' Pk /=; first by rewrite Pk. 631 | set X := lead_coef _; grab_eq k'' X; apply: eval_LeadCoef => lp {X}. 632 | rewrite eval_Size /= /k'' {k''}. 633 | by set X := map _ _; grab_eq k'' X; apply: ihps => {X} lps; rewrite Pk. 634 | Qed. 635 | 636 | Arguments eval_SeqMInfty [e ps k]. 637 | Prenex Implicits eval_SeqMInfty. 638 | 639 | Lemma eval_ChangesPoly e ps k : qf_eval e (ChangesPoly ps k) = 640 | qf_eval e (k (changes_poly (map (eval_poly e) ps))). 641 | Proof. 642 | rewrite (eval_SeqMInfty (fun mps => 643 | qf_eval e (k ((changes mps)%:Z - 644 | (changes_pinfty [seq eval_poly e i | i <- ps])%:Z)))) => // mps. 645 | rewrite (eval_SeqPInfty (fun pps => 646 | qf_eval e (k ((changes (map (eval e) mps))%:Z - (changes pps)%:Z)))) => // pps. 647 | by rewrite !eval_Changes. 648 | Qed. 649 | 650 | Fixpoint redivp_rec_loop (q : {poly F}) sq cq 651 | (k : nat) (qq r : {poly F})(n : nat) {struct n} := 652 | if (size r < sq)%N then (k, qq, r) else 653 | let m := (lead_coef r) *: 'X^(size r - sq) in 654 | let qq1 := qq * cq%:P + m in 655 | let r1 := r * cq%:P - m * q in 656 | if n is n1.+1 then redivp_rec_loop q sq cq k.+1 qq1 r1 n1 else (k.+1, qq1, r1). 657 | 658 | Lemma redivp_rec_loopP q c qq r n : redivp_rec q c qq r n 659 | = redivp_rec_loop q (size q) (lead_coef q) c qq r n. 660 | Proof. by elim: n c qq r => [| n Pn] c qq r //=; rewrite Pn. Qed. 661 | 662 | Lemma eval_Rediv_rec_loop e q sq cq c qq r n k k' 663 | (d := redivp_rec_loop (eval_poly e q) sq (eval e cq) 664 | c (eval_poly e qq) (eval_poly e r) n) : 665 | (forall c qq r, qf_eval e (k (c, qq, r)) 666 | = k' (c, eval_poly e qq, eval_poly e r)) -> 667 | qf_eval e (Rediv_rec_loop q sq cq c qq r n k) = k' d. 668 | Proof. 669 | move=> Pk; elim: n c qq r k Pk @d=> [|n ihn] c qq r k Pk /=. 670 | rewrite eval_Size /=; have [//=|gtq] := ltnP. 671 | set X := lead_coef _; grab_eq k'' X; apply: eval_LeadCoef => {X}. 672 | by move=> x /=; rewrite Pk /= !eval_OpPoly /= !mul_polyC. 673 | rewrite eval_Size /=; have [//=|gtq] := ltnP. 674 | set X := lead_coef _; grab_eq k'' X; apply: eval_LeadCoef => {X}. 675 | by move=> x; rewrite ihn // !eval_OpPoly /= !mul_polyC. 676 | Qed. 677 | 678 | Arguments eval_Rediv_rec_loop [e q sq cq c qq r n k]. 679 | Prenex Implicits eval_Rediv_rec_loop. 680 | 681 | Lemma eval_Rediv e p q k k' (d := (redivp (eval_poly e p) (eval_poly e q))) : 682 | (forall c qq r, qf_eval e (k (c, qq, r)) = k' (c, eval_poly e qq, eval_poly e r)) -> 683 | qf_eval e (Rediv p q k) = k' d. 684 | Proof. 685 | move=> Pk; rewrite eval_Isnull /d unlock. 686 | have [_|p_neq0] /= := boolP (_ == _); first by rewrite Pk /= mul0r add0r. 687 | rewrite !eval_Size; set p' := eval_poly e p; set q' := eval_poly e q. 688 | rewrite (eval_LeadCoef (fun lq => 689 | k' (redivp_rec_loop q' (size q') lq 0 0 p' (size p')))) /=; last first. 690 | by move=> x; rewrite (eval_Rediv_rec_loop k') //= mul0r add0r. 691 | by rewrite redivp_rec_loopP. 692 | Qed. 693 | 694 | Arguments eval_Rediv [e p q k]. 695 | Prenex Implicits eval_Rediv. 696 | 697 | Lemma eval_NextMod e p q k k' : 698 | (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> 699 | qf_eval e (NextMod p q k) = 700 | k' (next_mod (eval_poly e p) (eval_poly e q)). 701 | Proof. 702 | move=> Pk; set p' := eval_poly e p; set q' := eval_poly e q. 703 | rewrite (eval_LeadCoef (fun lq => 704 | k' (- lq ^+ rscalp p' q' *: rmodp p' q'))) => // lq. 705 | rewrite (eval_Rediv (fun spq => 706 | k' (- eval e lq ^+ spq.1.1%PAIR *: rmodp p' q'))) => //= spq _ _. 707 | rewrite (eval_Rediv (fun mpq => 708 | k' (- eval e lq ^+ spq *: mpq.2%PAIR))) => //= _ _ mpq. 709 | by rewrite Pk !eval_OpPoly. 710 | Qed. 711 | 712 | Arguments eval_NextMod [e p q k]. 713 | Prenex Implicits eval_NextMod. 714 | 715 | Lemma eval_Rgcd_loop e n p q k k' : 716 | (forall p, qf_eval e (k p) = k' (eval_poly e p)) 717 | -> qf_eval e (Rgcd_loop n p q k) = 718 | k' (rgcdp_loop n (eval_poly e p) (eval_poly e q)). 719 | Proof. 720 | elim: n p q k k'=> [|n ihn] p q k k' Pk /=. 721 | rewrite (eval_Rediv (fun r => 722 | if r.2%PAIR == 0 then k' (eval_poly e q) else k' r.2%PAIR)) /=. 723 | by case: eqP. 724 | by move=> _ _ r; rewrite eval_Isnull; case: eqP. 725 | pose q' := eval_poly e q. 726 | rewrite (eval_Rediv (fun r => 727 | if r.2%PAIR == 0 then k' q' else k' (rgcdp_loop n q' r.2%PAIR))) /=. 728 | by case: eqP. 729 | move=> _ _ r; rewrite eval_Isnull; case: eqP; first by rewrite Pk. 730 | by rewrite (ihn _ _ _ k'). 731 | Qed. 732 | 733 | Lemma eval_Rgcd e p q k k' : 734 | (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> 735 | qf_eval e (Rgcd p q k) = 736 | k' (rgcdp (eval_poly e p) (eval_poly e q)). 737 | Proof. 738 | move=> Pk; rewrite /Rgcd /LtSize !eval_Size /rgcdp. 739 | case: ltnP=> _; rewrite !eval_Isnull; case: eqP=> // _; 740 | by rewrite eval_Size; apply: eval_Rgcd_loop. 741 | Qed. 742 | 743 | 744 | Lemma eval_BigRgcd e ps k k' : 745 | (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> 746 | qf_eval e (BigRgcd ps k) = 747 | k' (\big[@rgcdp _/0%:P]_(i <- ps) (eval_poly e i)). 748 | Proof. 749 | elim: ps k k'=> [|p sp ihsp] k k' Pk /=. 750 | by rewrite big_nil Pk /= mul0r add0r. 751 | rewrite big_cons (ihsp _ (fun r => k' (rgcdp (eval_poly e p) r))) //. 752 | by move=> r; apply: eval_Rgcd. 753 | Qed. 754 | 755 | Arguments eval_Rgcd [e p q k]. 756 | Prenex Implicits eval_Rgcd. 757 | 758 | 759 | Fixpoint mods_aux (p q : {poly F}) (n : nat) : seq {poly F} := 760 | if n is m.+1 761 | then if p == 0 then [::] 762 | else p :: (mods_aux q (next_mod p q) m) 763 | else [::]. 764 | 765 | Lemma eval_ModsAux e p q n k k' : 766 | (forall sp, qf_eval e (k sp) = k' (map (eval_poly e) sp)) -> 767 | qf_eval e (ModsAux p q n k) = 768 | k' (mods_aux (eval_poly e p) (eval_poly e q) n). 769 | Proof. 770 | elim: n p q k k'=> [|n ihn] p q k k' Pk; first by rewrite /= Pk. 771 | rewrite /= eval_Isnull; have [|ep_neq0] := altP (_ =P _); first by rewrite Pk. 772 | set q' := eval_poly e q; set p' := eval_poly e p. 773 | rewrite (eval_NextMod (fun npq => k' (p' :: mods_aux q' npq n))) => // npq. 774 | by rewrite (ihn _ _ _ (fun ps => k' (p' :: ps))) => // ps; rewrite Pk. 775 | Qed. 776 | 777 | Arguments eval_ModsAux [e p q n k]. 778 | Prenex Implicits eval_ModsAux. 779 | 780 | Lemma eval_Mods e p q k k' : 781 | (forall sp, qf_eval e (k sp) = k' (map (eval_poly e) sp)) -> 782 | qf_eval e (Mods p q k) = k' (mods (eval_poly e p) (eval_poly e q)). 783 | Proof. by move=> Pk; rewrite !eval_Size; apply: eval_ModsAux. Qed. 784 | 785 | Arguments eval_Mods [e p q k]. 786 | Prenex Implicits eval_Mods. 787 | 788 | Lemma eval_TaqR e p q k : 789 | qf_eval e (TaqR p q k) = 790 | qf_eval e (k (taqR (eval_poly e p) (eval_poly e q))). 791 | Proof. 792 | rewrite (eval_Mods (fun r => qf_eval e (k (changes_poly r)))). 793 | by rewrite !eval_OpPoly. 794 | by move=> sp; rewrite !eval_ChangesPoly. 795 | Qed. 796 | 797 | Lemma eval_PolyComb e sq sc : 798 | eval_poly e (PolyComb sq sc) = poly_comb (map (eval_poly e) sq) sc. 799 | Proof. 800 | rewrite /PolyComb /poly_comb size_map -bigop.unlock -val_enum_ord/= big_map. 801 | rewrite (@big_morph _ _ _ 1%R *%R _ _ (eval_MulPoly _))/= ?mul0r ?add0r//. 802 | by rewrite big_enum; under eq_bigr do rewrite eval_ExpPoly/= -(nth_map _ 0)//. 803 | Qed. 804 | 805 | Definition pcq (sq : seq {poly F}) i := 806 | (map (poly_comb sq) (sg_tab (size sq)))`_i. 807 | 808 | Lemma eval_Pcq e sq i : 809 | eval_poly e (Pcq sq i) = pcq (map (eval_poly e) sq) i. 810 | Proof. 811 | rewrite /Pcq /pcq size_map; move: (sg_tab _)=> s. 812 | have [ge_is|lt_is] := leqP (size s) i. 813 | by rewrite !nth_default ?size_map // /=. 814 | rewrite -(nth_map _ 0) ?size_map //; congr _`_i; rewrite -map_comp. 815 | by apply: eq_map=> x /=; rewrite eval_PolyComb. 816 | Qed. 817 | 818 | Lemma eval_TaqsR e p sq i k k' : 819 | (forall x, qf_eval e (k x) = k' (eval e x)) -> 820 | qf_eval e (TaqsR p sq i k) = 821 | k' (taqsR (eval_poly e p) (map (eval_poly e) sq) i). 822 | Proof. by move=> Pk; rewrite /TaqsR /taqsR eval_TaqR Pk /= eval_Pcq. Qed. 823 | 824 | Arguments eval_TaqsR [e p sq i k]. 825 | Prenex Implicits eval_TaqsR. 826 | 827 | Fact invmx_ctmat1 : invmx (map_mx (intr : int -> F) ctmat1) = 828 | \matrix_(i, j) 829 | (nth [::] [:: [:: 2%:R^-1; - 2%:R^-1; 0]; 830 | [:: 2%:R^-1; 2%:R^-1; -1]; 831 | [:: 0; 0; 1]] i)`_j :> 'M[F]_3. 832 | Proof. 833 | rewrite -[lhs in lhs = _]mul1r; apply: (canLR (mulrK _)). 834 | exact: ctmat1_unit. 835 | symmetry; rewrite /ctmat1. 836 | apply/matrixP => i j; rewrite !(big_ord_recl, big_ord0, mxE) /=. 837 | have halfP (K : numFieldType) : 2%:R^-1 + 2%:R^-1 = 1 :> K. 838 | by rewrite -mulr2n -[_ *+ 2]mulr_natl mulfV // pnatr_eq0. 839 | move: i; do ?[case=> //=]; move: j; do ?[case=> //=] => _ _; 840 | rewrite !(mulr1, mul1r, mulrN1, mulN1r, mulr0, mul0r, opprK); 841 | by rewrite !(addr0, add0r, oppr0, subrr, addrA, halfP). 842 | Qed. 843 | 844 | Lemma eval_Coefs e n i : eval e (Coefs F n i) = coefs F n i. 845 | Proof. 846 | case: n => [|[|n]] //=; rewrite /coefs /=. 847 | case: i => [|i]; last first. 848 | by rewrite nth_default // size_map size_enum_ord expn0. 849 | rewrite (nth_map 0) ?size_enum_ord //. 850 | set O := _`_0; rewrite (_ : O = ord0). 851 | by rewrite ?castmxE ?cast_ord_id map_mx1 invmx1 mxE. 852 | by apply: val_inj => /=; rewrite nth_enum_ord. 853 | have [lt_i3|le_3i] := ltnP i 3; last first. 854 | by rewrite !nth_default // size_map size_enum_ord. 855 | rewrite /ctmat /= ?ntensmx1 invmx_ctmat1 /=. 856 | rewrite (nth_map 0) ?size_enum_ord // castmxE /=. 857 | rewrite !mxE !cast_ord_id //= nth_enum_ord //=. 858 | by move: i lt_i3; do 3?case. 859 | Qed. 860 | 861 | Lemma eval_CcountWeak e p sq k k' : 862 | (forall x, qf_eval e (k x) = k' (eval e x)) -> 863 | qf_eval e (CcountWeak p sq k) = 864 | k' (ccount_weak (eval_poly e p) (map (eval_poly e) sq)). 865 | Proof. 866 | move=> Pk; rewrite /CcountWeak /ccount_weak. 867 | set Aux := (fix Aux s i k := match i with 0 => _ | _ => _ end). 868 | set aux := (fix aux s i := match i with 0 => _ | _ => _ end). 869 | rewrite size_map -[0]/(eval e 0%qfT); move: 0%qfT=> x. 870 | elim: (_ ^ _)%N k k' Pk x=> /= [|n ihn] k k' Pk x. 871 | by rewrite Pk. 872 | rewrite (eval_TaqsR 873 | (fun y => k' (aux (y * (coefs F (size sq) n) + eval e x) n))). 874 | by rewrite size_map. 875 | by move=> y; rewrite (ihn _ k') // -(eval_Coefs e). 876 | Qed. 877 | 878 | Arguments eval_CcountWeak [e p sq k]. 879 | Prenex Implicits eval_CcountWeak. 880 | 881 | Lemma eval_ProdPoly e T s f k f' k' : 882 | (forall x k k', (forall p, (qf_eval e (k p) = k' (eval_poly e p))) -> 883 | qf_eval e (f x k) = k' (f' x)) -> 884 | (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> 885 | qf_eval e (@ProdPoly _ T s f k) = k' (\prod_(x <- s) f' x). 886 | Proof. 887 | move=> Pf; elim: s k k'=> [|a s ihs] k k' Pk /=. 888 | by rewrite big_nil Pk /= !(mul0r, add0r). 889 | rewrite (Pf _ _ (fun fa => k' (fa * \prod_(x <- s) f' x))). 890 | by rewrite big_cons. 891 | move=> fa; rewrite (ihs _ (fun fs => k' (eval_poly e fa * fs))) //. 892 | by move=> fs; rewrite Pk eval_OpPoly. 893 | Qed. 894 | 895 | Arguments eval_ProdPoly [e T s f k]. 896 | Prenex Implicits eval_ProdPoly. 897 | 898 | Lemma eval_BoundingPoly e sq : 899 | eval_poly e (BoundingPoly sq) = bounding_poly (map (eval_poly e) sq). 900 | Proof. 901 | rewrite eval_Deriv -bigop.unlock; congr _^`(); rewrite big_map. 902 | by apply: big_morph => [p q | ]/=; rewrite ?eval_MulPoly // mul0r add0r. 903 | Qed. 904 | 905 | Lemma eval_CcountGt0 e sp sq : qf_eval e (CcountGt0 sp sq) = 906 | ccount_gt0 (map (eval_poly e) sp) (map (eval_poly e) sq). 907 | Proof. 908 | pose sq' := map (eval_poly e) sq; rewrite /ccount_gt0. 909 | rewrite (@eval_BigRgcd _ _ _ (fun p => if p != 0 910 | then 0 < ccount_weak p sq' 911 | else let bq := bounding_poly sq' in 912 | [|| \big[andb/true]_(q <- sq') (0 < lead_coef q), 913 | \big[andb/true]_(q <- sq') (0 < (-1) ^+ (size q).-1 * lead_coef q) 914 | | 0 < ccount_weak bq sq'])). 915 | by rewrite !big_map. 916 | move=> p; rewrite eval_Isnull; case: eqP=> _ /=; last first. 917 | by rewrite (eval_CcountWeak (> 0)). 918 | rewrite (eval_CcountWeak (fun n => 919 | [|| \big[andb/true]_(q <- sq') (0 < lead_coef q), 920 | \big[andb/true]_(q <- sq') (0 < (-1) ^+ (size q).-1 * lead_coef q) 921 | | 0 < n ])). 922 | by rewrite eval_BoundingPoly. 923 | move=> n /=; rewrite -!bigop.unlock !big_map; congr [|| _, _| _]. 924 | apply: (big_ind2 (fun u v => qf_eval e u = v))=> //=. 925 | by move=> u v u' v' -> ->. 926 | by move=> i _; rewrite (eval_LeadCoef (> 0)). 927 | apply: (big_ind2 (fun u v => qf_eval e u = v))=> //=. 928 | by move=> u v u' v' -> ->. 929 | by move=> i _; rewrite eval_Size (eval_LeadCoef (fun lq => 930 | (0 < (-1) ^+ (size (eval_poly e i)).-1 * lq))). 931 | Qed. 932 | 933 | Lemma abstrXP e i t x : 934 | (eval_poly e (abstrX i t)).[x] = eval (set_nth 0 e i x) t. 935 | Proof. 936 | elim: t. 937 | - move=> n /=; case ni: (_ == _); 938 | rewrite //= ?(mul0r,add0r,addr0,polyC1,mul1r,hornerX,hornerC); 939 | by rewrite // nth_set_nth /= ni. 940 | - by move=> r; rewrite /= mul0r add0r hornerC. 941 | - by move=> r; rewrite /= mul0r add0r hornerC. 942 | - by move=> t tP s sP; rewrite /= eval_AddPoly hornerD tP ?sP. 943 | - by move=> t tP; rewrite /= eval_OppPoly hornerN tP. 944 | - by move=> t tP n; rewrite /= eval_NatMulPoly hornerMn tP. 945 | - by move=> t tP s sP; rewrite /= eval_MulPoly hornerM tP ?sP. 946 | - by move=> t tP n; rewrite /= eval_ExpPoly horner_exp tP. 947 | Qed. 948 | 949 | Lemma wf_QE_wproj i bc (bc_i := @wproj F i bc) : 950 | dnf_rterm (w_to_oclause bc) -> qf_form bc_i && rformula bc_i. 951 | Proof. 952 | case: bc @bc_i=> sp sq /=; rewrite /dnf_rterm /= /wproj andbT=> /andP[rsp rsq]. 953 | by rewrite qf_formF rformulaF. 954 | Qed. 955 | 956 | Lemma valid_QE_wproj i bc (bc' := w_to_oclause bc) 957 | (ex_i_bc := ('exists 'X_i, odnf_to_oform [:: bc'])%oT) e : 958 | dnf_rterm bc' -> reflect (holds e ex_i_bc) (ord.qf_eval e (wproj i bc)). 959 | Proof. 960 | case: bc @bc' @ex_i_bc=> sp sq /=; rewrite /dnf_rterm /wproj /= andbT. 961 | move=> /andP[rsp rsq]; rewrite -qf_evalE. 962 | rewrite eval_CcountGt0 /=; apply: (equivP (ccount_gt0P _ _)). 963 | set P1 := (fun x => _); set P2 := (fun x => _). 964 | suff: forall x, P1 x <-> P2 x. 965 | by move=> hP; split=> [] [x Px]; exists x; rewrite (hP, =^~ hP). 966 | move=> x; rewrite /P1 /P2 {P1 P2} !big_map !(big_seq_cond xpredT) /=. 967 | rewrite (eq_bigr (fun t => GRing.eval (set_nth 0 e i x) t == 0)); last first. 968 | by move=> t /andP[t_in_sp _]; rewrite abstrXP evalE to_rtermE ?(allP rsp). 969 | rewrite [X in _ && X](eq_bigr (fun t => 0 < GRing.eval (set_nth 0 e i x) t)); 970 | last by move=> t /andP[tsq _]; rewrite abstrXP evalE to_rtermE ?(allP rsq). 971 | rewrite -!big_seq_cond !(rwP (qf_evalP _ _)); first last. 972 | + elim: sp rsp => //= p sp ihsp /andP[rp rsp]; first by rewrite ihsp. 973 | + elim: sq rsq => //= q sq ihsq /andP[rq rsq]; first by rewrite ihsq. 974 | rewrite !(rwP andP) (rwP orP) orbF !andbT /=. 975 | have unfoldr P s : foldr (fun t => ord.And (P t)) ord.True s = 976 | \big[ord.And/ord.True]_(t <- s) P t by rewrite unlock /reducebig. 977 | rewrite !unfoldr; set e' := set_nth _ _ _ _. 978 | by rewrite !(@big_morph _ _ (ord.qf_eval _) true andb). 979 | Qed. 980 | 981 | Lemma rcf_satP e f : reflect (holds e f) (rcf_sat e f). 982 | Proof. exact: (proj_satP wf_QE_wproj valid_QE_wproj). Qed. 983 | 984 | End ProjCorrect. 985 | 986 | (* Section Example. *) 987 | (* no chances it computes *) 988 | 989 | (* From mathcomp 990 | Require Import rat. *) 991 | 992 | (* Eval vm_compute in (54%:R / 289%:R + 2%:R^-1 :rat). *) 993 | 994 | (* Local Open Scope qf_scope. *) 995 | 996 | (* Notation polyF := (polyF [realFieldType of rat]). *) 997 | (* Definition p : polyF := [::'X_2; 'X_1; 'X_0]. *) 998 | (* Definition q : polyF := [:: 0; 1]. *) 999 | (* Definition sq := [::q]. *) 1000 | 1001 | (* Eval vm_compute in MulPoly p q. *) 1002 | 1003 | (* Eval vm_compute in Rediv ([:: 1] : polyF) [::1]. *) 1004 | 1005 | (* Definition fpq := Eval vm_compute in (CcountWeak p [::q]). *) 1006 | 1007 | (* End Example. *) 1008 | -------------------------------------------------------------------------------- /theories/ordered_qelim.v: -------------------------------------------------------------------------------- 1 | (* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From Corelib Require Import Setoid. 4 | From HB Require Import structures. 5 | From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq div. 6 | From mathcomp Require Import choice fintype bigop finset order fingroup. 7 | From mathcomp Require Import ssralg zmodp poly ssrnum. 8 | 9 | Set Implicit Arguments. 10 | Unset Strict Implicit. 11 | Unset Printing Implicit Defensive. 12 | 13 | Local Open Scope ring_scope. 14 | Import GRing. 15 | 16 | Reserved Notation "p <% q" (at level 70, no associativity). 17 | Reserved Notation "p <=% q" (at level 70, no associativity). 18 | 19 | (* Set Printing Width 30. *) 20 | 21 | Module ord. 22 | 23 | Section Formulas. 24 | 25 | Variable T : Type. 26 | 27 | Inductive formula : Type := 28 | | Bool of bool 29 | | Equal of (term T) & (term T) 30 | | Lt of (term T) & (term T) 31 | | Le of (term T) & (term T) 32 | | Unit of (term T) 33 | | And of formula & formula 34 | | Or of formula & formula 35 | | Implies of formula & formula 36 | | Not of formula 37 | | Exists of nat & formula 38 | | Forall of nat & formula. 39 | 40 | End Formulas. 41 | 42 | Fixpoint term_eq (T : eqType)(t1 t2 : term T) := 43 | match t1, t2 with 44 | | Var n1, Var n2 => n1 == n2 45 | | Const r1, Const r2 => r1 == r2 46 | | NatConst n1, NatConst n2 => n1 == n2 47 | | Add r1 s1, Add r2 s2 => (term_eq r1 r2) && (term_eq s1 s2) 48 | | Opp r1, Opp r2 => term_eq r1 r2 49 | | NatMul r1 n1, NatMul r2 n2 => (term_eq r1 r2) && (n1 == n2) 50 | | Mul r1 s1, Mul r2 s2 => (term_eq r1 r2) && (term_eq s1 s2) 51 | | Inv r1, Inv r2 => term_eq r1 r2 52 | | Exp r1 n1, Exp r2 n2 => (term_eq r1 r2) && (n1 == n2) 53 | |_, _ => false 54 | end. 55 | 56 | Lemma term_eqP (T : eqType) : Equality.axiom (@term_eq T). 57 | Proof. 58 | move=> t1 t2; apply: (iffP idP) => [|<-]; last first. 59 | by elim: t1 {t2} => //= t -> // n; rewrite eqxx. 60 | elim: t1 t2. 61 | - by move=> n1 /= [] // n2 /eqP ->. 62 | - by move=> r1 /= [] // r2 /eqP ->. 63 | - by move=> n1 /= [] // n2 /eqP ->. 64 | - by move=> r1 hr1 r2 hr2 [] //= s1 s2 /andP [] /hr1 -> /hr2 ->. 65 | - by move=> r1 hr1 [] //= s1 /hr1 ->. 66 | - by move=> s1 hs1 n1 [] //= s2 n2 /andP [] /hs1 -> /eqP ->. 67 | - by move=> r1 hr1 r2 hr2 [] //= s1 s2 /andP [] /hr1 -> /hr2 ->. 68 | - by move=> r1 hr1 [] //= s1 /hr1 ->. 69 | - by move=> s1 hs1 n1 [] //= s2 n2 /andP [] /hs1 -> /eqP ->. 70 | Qed. 71 | 72 | HB.instance Definition _ (T : eqType) := hasDecEq.Build (term T) (@term_eqP T). 73 | 74 | Arguments term_eqP T {x y}. 75 | Prenex Implicits term_eq. 76 | 77 | Declare Scope oterm_scope. 78 | Bind Scope oterm_scope with term. 79 | Bind Scope oterm_scope with formula. 80 | Delimit Scope oterm_scope with oT. 81 | Arguments Add _ _%oT _%oT. 82 | Arguments Opp _ _%oT. 83 | Arguments NatMul _ _%oT _%N. 84 | Arguments Mul _ _%oT _%oT. 85 | Arguments Mul _ _%oT _%oT. 86 | Arguments Inv _ _%oT. 87 | Arguments Exp _ _%oT _%N. 88 | Arguments Equal _ _%oT _%oT. 89 | Arguments Unit _ _%oT. 90 | Arguments And _ _%oT _%oT. 91 | Arguments Or _ _%oT _%oT. 92 | Arguments Implies _ _%oT _%oT. 93 | Arguments Not _ _%oT. 94 | Arguments Exists _ _%N _%oT. 95 | Arguments Forall _ _%N _%oT. 96 | 97 | Arguments Bool [T]. 98 | Prenex Implicits Const Add Opp NatMul Mul Exp Bool Unit And Or Implies Not. 99 | Prenex Implicits Exists Forall Lt. 100 | 101 | Notation True := (Bool true). 102 | Notation False := (Bool false). 103 | 104 | Notation "''X_' i" := (Var _ i) : oterm_scope. 105 | Notation "n %:R" := (NatConst _ n) : oterm_scope. 106 | Notation "x %:T" := (Const x) : oterm_scope. 107 | Notation "0" := 0%:R%oT : oterm_scope. 108 | Notation "1" := 1%:R%oT : oterm_scope. 109 | Infix "+" := Add : oterm_scope. 110 | Notation "- t" := (Opp t) : oterm_scope. 111 | Notation "t - u" := (Add t (- u)) : oterm_scope. 112 | Infix "*" := Mul : oterm_scope. 113 | Infix "*+" := NatMul : oterm_scope. 114 | Notation "t ^-1" := (Inv t) : oterm_scope. 115 | Notation "t / u" := (Mul t u^-1) : oterm_scope. 116 | Infix "^+" := Exp : oterm_scope. 117 | Notation "t ^- n" := (t^-1 ^+ n)%oT : oterm_scope. 118 | Infix "==" := Equal : oterm_scope. 119 | Infix "<%" := Lt : oterm_scope. 120 | Infix "<=%" := Le : oterm_scope. 121 | Infix "/\" := And : oterm_scope. 122 | Infix "\/" := Or : oterm_scope. 123 | Infix "==>" := Implies : oterm_scope. 124 | Notation "~ f" := (Not f) : oterm_scope. 125 | Notation "x != y" := (Not (x == y)) : oterm_scope. 126 | Notation "''exists' ''X_' i , f" := (Exists i f) : oterm_scope. 127 | Notation "''forall' ''X_' i , f" := (Forall i f) : oterm_scope. 128 | 129 | Section Substitution. 130 | 131 | Variable T : Type. 132 | 133 | 134 | Fixpoint fsubst (f : formula T) (s : nat * term T) := 135 | match f with 136 | | Bool _ => f 137 | | (t1 == t2) => (tsubst t1 s == tsubst t2 s) 138 | | (t1 <% t2) => (tsubst t1 s <% tsubst t2 s) 139 | | (t1 <=% t2) => (tsubst t1 s <=% tsubst t2 s) 140 | | (Unit t1) => Unit (tsubst t1 s) 141 | | (f1 /\ f2) => (fsubst f1 s /\ fsubst f2 s) 142 | | (f1 \/ f2) => (fsubst f1 s \/ fsubst f2 s) 143 | | (f1 ==> f2) => (fsubst f1 s ==> fsubst f2 s) 144 | | (~ f1) => (~ fsubst f1 s) 145 | | ('exists 'X_i, f1) => ('exists 'X_i, if i == s.1 then f1 else fsubst f1 s) 146 | | ('forall 'X_i, f1) => ('forall 'X_i, if i == s.1 then f1 else fsubst f1 s) 147 | end%oT. 148 | 149 | End Substitution. 150 | 151 | Section OrderedClause. 152 | 153 | Inductive oclause (R : Type) : Type := 154 | Oclause : seq (term R) -> seq (term R) -> seq (term R) -> seq (term R) -> oclause R. 155 | 156 | Definition eq_of_oclause (R : Type)(x : oclause R) := 157 | let: Oclause y _ _ _ := x in y. 158 | Definition neq_of_oclause (R : Type)(x : oclause R) := 159 | let: Oclause _ y _ _ := x in y. 160 | Definition lt_of_oclause (R : Type) (x : oclause R) := 161 | let: Oclause _ _ y _ := x in y. 162 | Definition le_of_oclause (R : Type) (x : oclause R) := 163 | let: Oclause _ _ _ y := x in y. 164 | 165 | End OrderedClause. 166 | 167 | Declare Scope oclause_scope. 168 | Delimit Scope oclause_scope with OCLAUSE. 169 | Open Scope oclause_scope. 170 | 171 | Notation "p .1" := (@eq_of_oclause _ p) : oclause_scope. 172 | Notation "p .2" := (@neq_of_oclause _ p) : oclause_scope. 173 | 174 | Notation "p .3" := (@lt_of_oclause _ p) 175 | (at level 1, left associativity, format "p .3") : oclause_scope. 176 | Notation "p .4" := (@le_of_oclause _ p) 177 | (at level 1, left associativity, format "p .4") : oclause_scope. 178 | 179 | Definition oclause_eq (T : eqType)(t1 t2 : oclause T) := 180 | let: Oclause eq_l1 neq_l1 lt_l1 leq_l1 := t1 in 181 | let: Oclause eq_l2 neq_l2 lt_l2 leq_l2 := t2 in 182 | [&& eq_l1 == eq_l2, neq_l1 == neq_l2, lt_l1 == lt_l2 & leq_l1 == leq_l2]. 183 | 184 | Lemma oclause_eqP (T : eqType) : Equality.axiom (@oclause_eq T). 185 | Proof. 186 | move=> t1 t2; apply: (iffP idP) => [|<-] /=; last first. 187 | by rewrite /oclause_eq; case: t1=> l1 l2 l3 l4; rewrite !eqxx. 188 | case: t1 => [l1 l2 l3 l4]; case: t2 => m1 m2 m3 m4 /=; case/and4P. 189 | by move/eqP=> -> /eqP -> /eqP -> /eqP ->. 190 | Qed. 191 | 192 | HB.instance Definition _ (T : eqType) := hasDecEq.Build (oclause T) 193 | (@oclause_eqP T). 194 | 195 | Arguments oclause_eqP T {x y}. 196 | Prenex Implicits oclause_eq. 197 | 198 | Section EvalTerm. 199 | 200 | Variable R : realDomainType. 201 | 202 | (* Evaluation of a reified formula *) 203 | 204 | Fixpoint holds (e : seq R) (f : ord.formula R) {struct f} : Prop := 205 | match f with 206 | | Bool b => b 207 | | (t1 == t2)%oT => eval e t1 = eval e t2 208 | | (t1 <% t2)%oT => eval e t1 < eval e t2 209 | | (t1 <=% t2)%oT => eval e t1 <= eval e t2 210 | | Unit t1 => eval e t1 \in unit 211 | | (f1 /\ f2)%oT => holds e f1 /\ holds e f2 212 | | (f1 \/ f2)%oT => holds e f1 \/ holds e f2 213 | | (f1 ==> f2)%oT => holds e f1 -> holds e f2 214 | | (~ f1)%oT => ~ holds e f1 215 | | ('exists 'X_i, f1)%oT => exists x, holds (set_nth 0 e i x) f1 216 | | ('forall 'X_i, f1)%oT => forall x, holds (set_nth 0 e i x) f1 217 | end. 218 | 219 | 220 | (* Extensionality of formula evaluation *) 221 | Lemma eq_holds e e' f : same_env e e' -> holds e f -> holds e' f. 222 | Proof. 223 | pose sv := set_nth (0 : R). 224 | have eq_i i v e1 e2: same_env e1 e2 -> same_env (sv e1 i v) (sv e2 i v). 225 | by move=> eq_e j; rewrite !nth_set_nth /= eq_e. 226 | elim: f e e' => //=. 227 | - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). 228 | - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). 229 | - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). 230 | - by move=> t e e' eq_e; rewrite (eq_eval _ eq_e). 231 | - by move=> f1 IH1 f2 IH2 e e' eq_e; move/IH2: (eq_e); move/IH1: eq_e; tauto. 232 | - by move=> f1 IH1 f2 IH2 e e' eq_e; move/IH2: (eq_e); move/IH1: eq_e; tauto. 233 | - by move=> f1 IH1 f2 IH2 e e' eq_e f12; move/IH1: (same_env_sym eq_e); eauto. 234 | - by move=> f1 IH1 e e'; move/same_env_sym; move/IH1; tauto. 235 | - by move=> i f1 IH1 e e'; move/(eq_i i)=> eq_e [x f_ex]; exists x; eauto. 236 | by move=> i f1 IH1 e e'; move/(eq_i i); eauto. 237 | Qed. 238 | 239 | (* Evaluation and substitution by a constant *) 240 | Lemma holds_fsubst e f i v : 241 | holds e (fsubst f (i, v%:T)%T) <-> holds (set_nth 0 e i v) f. 242 | Proof. 243 | elim: f e => //=; do [ 244 | by move=> *; rewrite !eval_tsubst 245 | | move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto 246 | | move=> f IHf e; move: (IHf e); tauto 247 | | move=> j f IHf e]. 248 | - case eq_ji: (j == i); first rewrite (eqP eq_ji). 249 | by split=> [] [x f_x]; exists x; rewrite set_set_nth eqxx in f_x *. 250 | split=> [] [x f_x]; exists x; move: f_x; rewrite set_set_nth eq_sym eq_ji; 251 | have:= IHf (set_nth 0 e j x); tauto. 252 | case eq_ji: (j == i); first rewrite (eqP eq_ji). 253 | by split=> [] f_ x; move: (f_ x); rewrite set_set_nth eqxx. 254 | split=> [] f_ x; move: (IHf (set_nth 0 e j x)) (f_ x); 255 | by rewrite [in X in _ -> X]set_set_nth eq_sym eq_ji; tauto. 256 | Qed. 257 | 258 | (* Boolean test selecting formulas in the theory of rings *) 259 | Fixpoint rformula (f : formula R) := 260 | match f with 261 | | Bool _ => true 262 | | t1 == t2 => rterm t1 && rterm t2 263 | | t1 <% t2 => rterm t1 && rterm t2 264 | | t1 <=% t2 => rterm t1 && rterm t2 265 | | Unit t1 => false 266 | | (f1 /\ f2) | (f1 \/ f2) | (f1 ==> f2) => rformula f1 && rformula f2 267 | | (~ f1) | ('exists 'X__, f1) | ('forall 'X__, f1) => rformula f1 268 | end%oT. 269 | 270 | (* An oformula stating that t1 is equal to 0 in the ring theory. *) 271 | Definition eq0_rform t1 := 272 | let m := @ub_var R t1 in 273 | let: (t1', r1) := to_rterm t1 [::] m in 274 | let fix loop r i := match r with 275 | | [::] => t1' == 0 276 | | t :: r' => 277 | let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 278 | 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 279 | end%oT 280 | in loop r1 m. 281 | 282 | (* An oformula stating that t1 is less than 0 in the equational ring theory. 283 | Definition leq0_rform t1 := 284 | let m := @ub_var R t1 in 285 | let: (t1', r1) := to_rterm t1 [::] m in 286 | let fix loop r i := match r with 287 | | [::] => 'exists 'X_m.+1, t1' == 'X_m.+1 * 'X_m.+1 288 | | t :: r' => 289 | let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 290 | 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 291 | end%oT 292 | in loop r1 m. 293 | *) 294 | Definition leq0_rform t1 := 295 | let m := @ub_var R t1 in 296 | let: (t1', r1) := to_rterm t1 [::] m in 297 | let fix loop r i := match r with 298 | | [::] => t1' <=% 0 299 | | t :: r' => 300 | let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 301 | 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 302 | end%oT 303 | in loop r1 m. 304 | 305 | 306 | (* Definition lt0_rform t1 := *) 307 | (* let m := @ub_var R t1 in *) 308 | (* let: (t1', r1) := to_rterm t1 [::] m in *) 309 | (* let fix loop r i := match r with *) 310 | (* | [::] => 'exists 'X_m.+1, (t1' == 'X_m.+1 * 'X_m.+1 /\ ~ ('X_m.+1 == 0)) *) 311 | (* | t :: r' => *) 312 | (* let f := ('X_i * t == 1 /\ t * 'X_i == 1) in *) 313 | (* 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 *) 314 | (* end%oT *) 315 | (* in loop r1 m. *) 316 | 317 | Definition lt0_rform t1 := 318 | let m := @ub_var R t1 in 319 | let: (t1', r1) := to_rterm t1 [::] m in 320 | let fix loop r i := match r with 321 | | [::] => t1' <% 0 322 | | t :: r' => 323 | let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 324 | 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 325 | end%oT 326 | in loop r1 m. 327 | 328 | (* Transformation of a formula in the theory of rings with units into an *) 329 | 330 | (* equivalent formula in the sub-theory of rings. *) 331 | Fixpoint to_rform f := 332 | match f with 333 | | Bool b => f 334 | | t1 == t2 => eq0_rform (t1 - t2) 335 | | t1 <% t2 => lt0_rform (t1 - t2) 336 | | t1 <=% t2 => leq0_rform (t1 - t2) 337 | | Unit t1 => eq0_rform (t1 * t1^-1 - 1) 338 | | f1 /\ f2 => to_rform f1 /\ to_rform f2 339 | | f1 \/ f2 => to_rform f1 \/ to_rform f2 340 | | f1 ==> f2 => to_rform f1 ==> to_rform f2 341 | | ~ f1 => ~ to_rform f1 342 | | ('exists 'X_i, f1) => 'exists 'X_i, to_rform f1 343 | | ('forall 'X_i, f1) => 'forall 'X_i, to_rform f1 344 | end%oT. 345 | 346 | (* The transformation gives a ring formula. *) 347 | (* the last part of the proof consists in 3 cases that are exactly the same. 348 | how to factorize ? *) 349 | Lemma to_rform_rformula f : rformula (to_rform f). 350 | Proof. 351 | suffices [h1 h2 h3]: 352 | [/\ forall t1, rformula (eq0_rform t1), 353 | forall t1, rformula (lt0_rform t1) & 354 | forall t1, rformula (leq0_rform t1)]. 355 | by elim: f => //= => f1 ->. 356 | split=> t1. 357 | - rewrite /eq0_rform; move: (ub_var t1) => m. 358 | set tr := _ m. 359 | suffices: all (@rterm R) (tr.1 :: tr.2)%PAIR. 360 | case: tr => {}t1 r /= /andP[t1_r]. 361 | by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. 362 | have: all (@rterm R) [::] by []. 363 | rewrite {}/tr; elim: t1 [::] => //=. 364 | + move=> t1 IHt1 t2 IHt2 r. 365 | move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. 366 | move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. 367 | by rewrite t1_r t2_r. 368 | + by move=> t1 IHt1 r /IHt1; case: to_rterm. 369 | + by move=> t1 IHt1 n r /IHt1; case: to_rterm. 370 | + move=> t1 IHt1 t2 IHt2 r. 371 | move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. 372 | move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. 373 | by rewrite t1_r t2_r. 374 | + move=> t1 IHt1 r. 375 | by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. 376 | + by move=> t1 IHt1 n r /IHt1; case: to_rterm. 377 | - rewrite /lt0_rform; move: (ub_var t1) => m; set tr := _ m. 378 | suffices: all (@rterm R) (tr.1 :: tr.2)%PAIR. 379 | case: tr => {}t1 r /= /andP[t1_r]. 380 | by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. 381 | have: all (@rterm R) [::] by []. 382 | rewrite {}/tr; elim: t1 [::] => //=. 383 | + move=> t1 IHt1 t2 IHt2 r. 384 | move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. 385 | move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. 386 | by rewrite t1_r t2_r. 387 | + by move=> t1 IHt1 r /IHt1; case: to_rterm. 388 | + by move=> t1 IHt1 n r /IHt1; case: to_rterm. 389 | + move=> t1 IHt1 t2 IHt2 r. 390 | move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. 391 | move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. 392 | by rewrite t1_r t2_r. 393 | + move=> t1 IHt1 r. 394 | by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. 395 | + by move=> t1 IHt1 n r /IHt1; case: to_rterm. 396 | - rewrite /leq0_rform; move: (ub_var t1) => m; set tr := _ m. 397 | suffices: all (@rterm R) (tr.1 :: tr.2)%PAIR. 398 | case: tr => {}t1 r /= /andP[t1_r]. 399 | by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. 400 | have: all (@rterm R) [::] by []. 401 | rewrite {}/tr; elim: t1 [::] => //=. 402 | + move=> t1 IHt1 t2 IHt2 r. 403 | move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. 404 | move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. 405 | by rewrite t1_r t2_r. 406 | + by move=> t1 IHt1 r /IHt1; case: to_rterm. 407 | + by move=> t1 IHt1 n r /IHt1; case: to_rterm. 408 | + move=> t1 IHt1 t2 IHt2 r. 409 | move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. 410 | move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. 411 | by rewrite t1_r t2_r. 412 | + move=> t1 IHt1 r. 413 | by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. 414 | + by move=> t1 IHt1 n r /IHt1; case: to_rterm. 415 | Qed. 416 | 417 | Import Order.TTheory Num.Theory. 418 | 419 | (* Correctness of the transformation. *) 420 | Lemma to_rformP e f : holds e (to_rform f) <-> holds e f. 421 | Proof. 422 | suffices{e f} [equal0_equiv lt0_equiv le0_equiv]: 423 | [/\ forall e t1 t2, holds e (eq0_rform (t1 - t2)) <-> (eval e t1 == eval e t2), 424 | forall e t1 t2, holds e (lt0_rform (t1 - t2)) <-> (eval e t1 < eval e t2) & 425 | forall e t1 t2, holds e (leq0_rform (t1 - t2)) <-> (eval e t1 <= eval e t2)]. 426 | - elim: f e => /=; try tauto. 427 | + move=> t1 t2 e. 428 | by split; [move/equal0_equiv/eqP | move/eqP/equal0_equiv]. 429 | + by move=> t1 t2 e; split; move/lt0_equiv. 430 | + by move=> t1 t2 e; split; move/le0_equiv. 431 | + by move=> t1 e; rewrite unitrE; apply: equal0_equiv. 432 | + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. 433 | + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. 434 | + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. 435 | + by move=> f1 IHf1 e; move: (IHf1 e); tauto. 436 | + by move=> n f1 IHf1 e; split=> [] [x] /IHf1; exists x. 437 | + by move=> n f1 IHf1 e; split=> Hx x; apply/IHf1. 438 | suffices h e t1 t2 : 439 | [/\ holds e (eq0_rform (t1 - t2)) <-> (eval e t1 == eval e t2), 440 | holds e (lt0_rform (t1 - t2)) <-> (eval e t1 < eval e t2) & 441 | holds e (leq0_rform (t1 - t2)) <-> (eval e t1 <= eval e t2)]. 442 | by split => e t1 t2; case: (h e t1 t2). 443 | rewrite -{1}(add0r (eval e t2)) -(can2_eq (subrK _) (addrK _)). 444 | rewrite -subr_lt0 -subr_le0 -/(eval e (t1 - t2)); move: {t1 t2}(t1 - t2)%T => t. 445 | have sub_var_tsubst s t0: (s.1%PAIR >= ub_var t0)%N -> tsubst t0 s = t0. 446 | elim: t0 {t} => //=. 447 | - by move=> n; case: ltngtP. 448 | - by move=> t1 IHt1 t2 IHt2; rewrite geq_max => /andP[/IHt1-> /IHt2->]. 449 | - by move=> t1 IHt1 /IHt1->. 450 | - by move=> t1 IHt1 n /IHt1->. 451 | - by move=> t1 IHt1 t2 IHt2; rewrite geq_max => /andP[/IHt1-> /IHt2->]. 452 | - by move=> t1 IHt1 /IHt1->. 453 | - by move=> t1 IHt1 n /IHt1->. 454 | pose fix rsub t' m r : term R := 455 | if r is u :: r' then tsubst (rsub t' m.+1 r') (m, u^-1)%T else t'. 456 | pose fix ub_sub m r : Prop := 457 | if r is u :: r' then (ub_var u <= m)%N /\ ub_sub m.+1 r' else true. 458 | suffices{t} rsub_to_r t r0 m: (m >= ub_var t)%N -> ub_sub _ m r0 -> 459 | let: (t', r) := to_rterm t r0 m in 460 | [/\ take (size r0) r = r0, 461 | ub_var t' <= m + size r, ub_sub _ m r & rsub t' m r = t]%N. 462 | - have:= rsub_to_r t [::] _ (leqnn _); rewrite /eq0_rform /lt0_rform /leq0_rform. 463 | case: (to_rterm _ _ _) => [t1' r1] /= [//| _ _ ub_r1 def_t]. 464 | rewrite -{2 4 6}def_t {def_t}. 465 | elim: r1 (ub_var t) e ub_r1 => [|u r1 IHr1] m e /= => [_|[ub_u ub_r1]]. 466 | by split => //; split=> /eqP. 467 | rewrite eval_tsubst /=; set y := eval e u; split; split => //= t_h0. 468 | + case: (IHr1 m.+1 (set_nth 0 e m y^-1) ub_r1) => h _ _; apply/h. 469 | apply: t_h0. 470 | rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). 471 | rewrite sub_var_tsubst //= -/y. 472 | case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. 473 | split=> [|[z]]; first by rewrite invr_out ?Uy. 474 | rewrite nth_set_nth /= eqxx. 475 | rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. 476 | by case/unitrP: Uy; exists z. 477 | + move=> x def_x. 478 | case: (IHr1 m.+1 (set_nth 0 e m x) ub_r1) => h _ _. apply/h. 479 | suff ->: x = y^-1 by []; move: def_x. 480 | rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). 481 | rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. 482 | by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. 483 | rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. 484 | rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). 485 | by rewrite !sub_var_tsubst. 486 | + case: (IHr1 m.+1 (set_nth 0 e m y^-1) ub_r1) => _ h _. apply/h. 487 | apply: t_h0. 488 | rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). 489 | rewrite sub_var_tsubst //= -/y. 490 | case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. 491 | split=> [|[z]]; first by rewrite invr_out ?Uy. 492 | rewrite nth_set_nth /= eqxx. 493 | rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. 494 | by case/unitrP: Uy; exists z. 495 | + move=> x def_x. 496 | case: (IHr1 m.+1 (set_nth 0 e m x) ub_r1) => _ h _. apply/h. 497 | suff ->: x = y^-1 by []; move: def_x. 498 | rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). 499 | rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. 500 | by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. 501 | rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. 502 | rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). 503 | by rewrite !sub_var_tsubst. 504 | + case: (IHr1 m.+1 (set_nth 0 e m y^-1) ub_r1) => _ _ h. apply/h. 505 | apply: t_h0. 506 | rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). 507 | rewrite sub_var_tsubst //= -/y. 508 | case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. 509 | split=> [|[z]]; first by rewrite invr_out ?Uy. 510 | rewrite nth_set_nth /= eqxx. 511 | rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. 512 | by case/unitrP: Uy; exists z. 513 | + move=> x def_x. 514 | case: (IHr1 m.+1 (set_nth 0 e m x) ub_r1) => _ _ h. apply/h. 515 | suff ->: x = y^-1 by []; move: def_x. 516 | rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). 517 | rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. 518 | by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. 519 | rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. 520 | rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). 521 | by rewrite !sub_var_tsubst. 522 | have rsub_id r t0 n: (ub_var t0 <= n)%N -> rsub t0 n r = t0. 523 | by elim: r n => //= t1 r IHr n let0n; rewrite IHr ?sub_var_tsubst ?leqW. 524 | have rsub_acc r s t1 m1: 525 | (ub_var t1 <= m1 + size r)%N -> rsub t1 m1 (r ++ s) = rsub t1 m1 r. 526 | elim: r t1 m1 => [|t1 r IHr] t2 m1 /=; first by rewrite addn0; apply: rsub_id. 527 | by move=> letmr; rewrite IHr ?addSnnS. 528 | elim: t r0 m => /=; try do [ 529 | by move=> n r m hlt hub; rewrite take_size (ltn_addr _ hlt) rsub_id 530 | | by move=> n r m hlt hub; rewrite leq0n take_size rsub_id 531 | | move=> t1 IHt1 t2 IHt2 r m; rewrite geq_max; case/andP=> hub1 hub2 hmr; 532 | case: to_rterm {IHt1 hub1 hmr}(IHt1 r m hub1 hmr) => t1' r1; 533 | case=> htake1 hub1' hsub1 <-; 534 | case: to_rterm {IHt2 hub2 hsub1}(IHt2 r1 m hub2 hsub1) => t2' r2 /=; 535 | rewrite geq_max; case=> htake2 -> hsub2 /= <-; 536 | rewrite -{1 2}(cat_take_drop (size r1) r2) htake2; set r3 := drop _ _; 537 | rewrite size_cat addnA (leq_trans _ (leq_addr _ _)) //; 538 | split=> {hsub2}//; 539 | first by [rewrite takel_cat // -htake1 size_take geq_minr]; 540 | rewrite -(rsub_acc r1 r3 t1') {hub1'}// -{htake1}htake2 {r3}cat_take_drop; 541 | by elim: r2 m => //= u r2 IHr2 m; rewrite IHr2 542 | | do [ move=> t1 IHt1 r m; do 2!move/IHt1=> {}IHt1 543 | | move=> t1 IHt1 n r m; do 2!move/IHt1=> {}IHt1]; 544 | case: to_rterm IHt1 => t1' r1 [-> -> hsub1 <-]; split=> {hsub1}//; 545 | by elim: r1 m => //= u r1 IHr1 m; rewrite IHr1]. 546 | move=> t1 IH r m letm /IH {IH} /(_ letm) {letm}. 547 | case: to_rterm => t1' r1 /= [def_r ub_t1' ub_r1 <-]. 548 | rewrite size_rcons addnS leqnn -{1}cats1 takel_cat ?def_r; last first. 549 | by rewrite -def_r size_take geq_minr. 550 | elim: r1 m ub_r1 ub_t1' {def_r} => /= [|u r1 IHr1] m => [_|[->]]. 551 | by rewrite addn0 eqxx. 552 | by rewrite -addSnnS => /IHr1 IH /IH[_ _ ub_r1 ->]. 553 | Qed. 554 | 555 | (* The above proof is ugly but is in fact copypaste *) 556 | 557 | (* Boolean test selecting formulas which describe a constructible set, *) 558 | (* i.e. formulas without quantifiers. *) 559 | 560 | (* The quantifier elimination check. *) 561 | Fixpoint qf_form (f : formula R) := 562 | match f with 563 | | Bool _ | _ == _ | Unit _ | Lt _ _ | Le _ _ => true 564 | | f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => qf_form f1 && qf_form f2 565 | | ~ f1 => qf_form f1 566 | | _ => false 567 | end%oT. 568 | 569 | (* Boolean holds predicate for quantifier free formulas *) 570 | Definition qf_eval e := fix loop (f : formula R) : bool := 571 | match f with 572 | | Bool b => b 573 | | t1 == t2 => (eval e t1 == eval e t2)%bool 574 | | t1 <% t2 => (eval e t1 < eval e t2)%bool 575 | | t1 <=% t2 => (eval e t1 <= eval e t2)%bool 576 | | Unit t1 => eval e t1 \in unit 577 | | f1 /\ f2 => loop f1 && loop f2 578 | | f1 \/ f2 => loop f1 || loop f2 579 | | f1 ==> f2 => (loop f1 ==> loop f2)%bool 580 | | ~ f1 => ~~ loop f1 581 | |_ => false 582 | end%oT. 583 | 584 | (* qf_eval is equivalent to holds *) 585 | Lemma qf_evalP e f : qf_form f -> reflect (holds e f) (qf_eval e f). 586 | Proof. 587 | elim: f => //=; try by move=> *; apply: idP. 588 | - by move=> t1 t2 _; apply: eqP. 589 | - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1T]; last by right; case. 590 | by case/IHf2; [left | right; case]. 591 | - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1F]; first by do 2 left. 592 | by case/IHf2; [left; right | right; case]. 593 | - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1T]; last by left. 594 | by case/IHf2; [left | right; move/(_ f1T)]. 595 | by move=> f1 IHf1 /IHf1[]; [right | left]. 596 | Qed. 597 | 598 | (* Quantifier-free formula are normalized into DNF. A DNF is *) 599 | (* represented by the type seq (seq (term R) * seq (term R)), where we *) 600 | (* separate positive and negative literals *) 601 | 602 | 603 | (* DNF preserving conjunction *) 604 | 605 | Definition and_odnf (bcs1 bcs2 : seq (oclause R)) := 606 | \big[cat/nil]_(bc1 <- bcs1) 607 | map (fun bc2 : oclause R => 608 | (Oclause (bc1.1 ++ bc2.1) (bc1.2 ++ bc2.2) (bc1.3 ++ bc2.3) (bc1.4 ++ bc2.4)))%OCLAUSE bcs2. 609 | 610 | (* Computes a DNF from a qf ring formula *) 611 | Fixpoint qf_to_odnf (f : formula R) (neg : bool) {struct f} : seq (oclause R) := 612 | match f with 613 | | Bool b => if b (+) neg then [:: (Oclause [::] [::] [::] [::])] else [::] 614 | | t1 == t2 => 615 | [:: if neg then (Oclause [::] [:: t1 - t2] [::] [::]) else (Oclause [:: t1 - t2] [::] [::] [::])] 616 | | t1 <% t2 => 617 | [:: if neg then (Oclause [::] [::] [::] [:: t1 - t2]) else (Oclause [::] [::] [:: t2 - t1] [::])] 618 | | t1 <=% t2 => 619 | [:: if neg then (Oclause [::] [::] [:: t1 - t2] [::]) else (Oclause [::] [::] [::] [:: t2 - t1])] 620 | | f1 /\ f2 => (if neg then cat else and_odnf) [rec f1, neg] [rec f2, neg] 621 | | f1 \/ f2 => (if neg then and_odnf else cat) [rec f1, neg] [rec f2, neg] 622 | | f1 ==> f2 => (if neg then and_odnf else cat) [rec f1, ~~ neg] [rec f2, neg] 623 | | ~ f1 => [rec f1, ~~ neg] 624 | | _ => if neg then [:: (Oclause [::] [::] [::] [::])] else [::] 625 | end%oT where "[ 'rec' f , neg ]" := (qf_to_odnf f neg). 626 | 627 | (* Conversely, transforms a DNF into a formula *) 628 | Definition odnf_to_oform := 629 | let pos_lit t := And (t == 0)%oT in let neg_lit t := And (t != 0)%oT in 630 | let lt_lit t := And (0 <% t)%oT in let le_lit t := And (0 <=% t)%oT in 631 | let ocls (bc : oclause R) := 632 | Or 633 | (foldr pos_lit True bc.1 /\ foldr neg_lit True bc.2 /\ 634 | foldr lt_lit True bc.3 /\ foldr le_lit True bc.4) in 635 | foldr ocls False. 636 | 637 | (* Catenation of dnf is the Or of formulas *) 638 | Lemma cat_dnfP e bcs1 bcs2 : 639 | qf_eval e (odnf_to_oform (bcs1 ++ bcs2)) 640 | = qf_eval e (odnf_to_oform bcs1 \/ odnf_to_oform bcs2). 641 | Proof. 642 | by elim: bcs1 => //= bc1 bcs1 IH1; rewrite -orbA; congr orb; rewrite IH1. 643 | Qed. 644 | 645 | 646 | 647 | (* and_dnf is the And of formulas *) 648 | Lemma and_odnfP e bcs1 bcs2 : 649 | qf_eval e (odnf_to_oform (and_odnf bcs1 bcs2)) 650 | = qf_eval e (odnf_to_oform bcs1 /\ odnf_to_oform bcs2). 651 | Proof. 652 | elim: bcs1 => [|bc1 bcs1 IH1] /=; first by rewrite /and_odnf big_nil. 653 | rewrite /and_odnf big_cons -/(and_odnf bcs1 bcs2) cat_dnfP /=. 654 | rewrite {}IH1 /= andb_orl; congr orb. 655 | elim: bcs2 bc1 {bcs1} => [|bc2 bcs2 IH] bc1 /=; first by rewrite andbF. 656 | rewrite {}IH /= andb_orr; congr orb => {bcs2}. 657 | suffices aux (l1 l2 : seq (term R)) g : let redg := foldr (And \o g) True in 658 | qf_eval e (redg (l1 ++ l2)) = qf_eval e (redg l1 /\ redg l2)%oT. 659 | + rewrite !aux /= !andbA; congr (_ && _); rewrite -!andbA; congr (_ && _). 660 | rewrite -andbCA; congr (_ && _); bool_congr; rewrite andbCA; bool_congr. 661 | by rewrite andbA andbC !andbA. 662 | by elim: l1 => [| t1 l1 IHl1] //=; rewrite -andbA IHl1. 663 | Qed. 664 | 665 | Lemma qf_to_dnfP e : 666 | let qev f b := qf_eval e (odnf_to_oform (qf_to_odnf f b)) in 667 | forall f, qf_form f && rformula f -> qev f false = qf_eval e f. 668 | Proof. 669 | move=> qev; have qevT f: qev f true = ~~ qev f false. 670 | rewrite {}/qev; elim: f => //=; do [by case | move=> f1 IH1 f2 IH2 | ]. 671 | - by move=> t1 t2; rewrite !andbT !orbF. 672 | - by move=> t1 t2; rewrite !andbT !orbF; rewrite !subr_gte0 -leNgt. 673 | - by move=> t1 t2; rewrite !andbT !orbF; rewrite !subr_gte0 -ltNge. 674 | - by rewrite and_odnfP cat_dnfP negb_and -IH1 -IH2. 675 | - by rewrite and_odnfP cat_dnfP negb_or -IH1 -IH2. 676 | - by rewrite and_odnfP cat_dnfP /= negb_or IH1 -IH2 negbK. 677 | by move=> t1 ->; rewrite negbK. 678 | rewrite /qev; elim=> //=; first by case. 679 | - by move=> t1 t2 _; rewrite subr_eq0 !andbT orbF. 680 | - by move=> t1 t2 _; rewrite orbF !andbT subr_gte0. 681 | - by move=> t1 t2 _; rewrite orbF !andbT subr_gte0. 682 | - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. 683 | by rewrite and_odnfP /= => /IH1-> /IH2->. 684 | - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. 685 | by rewrite cat_dnfP /= => /IH1-> => /IH2->. 686 | - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. 687 | by rewrite cat_dnfP /= [qf_eval _ _]qevT -implybE => /IH1 <- /IH2->. 688 | by move=> f1 IH1 /IH1 <-; rewrite -qevT. 689 | Qed. 690 | 691 | Lemma dnf_to_form_qf bcs : qf_form (odnf_to_oform bcs). 692 | Proof. 693 | elim: bcs => //= [[clT clF] clLt clLe ? ->] /=; elim: clT => //=. 694 | by rewrite andbT; elim: clF; elim: clLt => //; elim: clLe. 695 | Qed. 696 | 697 | Definition dnf_rterm (cl : oclause R) := 698 | [&& all (@rterm R) cl.1, all (@rterm R) cl.2, 699 | all (@rterm R) cl.3 & all (@rterm R) cl.4]. 700 | 701 | Lemma qf_to_dnf_rterm f b : rformula f -> all dnf_rterm (qf_to_odnf f b). 702 | Proof. 703 | set ok := all dnf_rterm. 704 | have cat_ok bcs1 bcs2: ok bcs1 -> ok bcs2 -> ok (bcs1 ++ bcs2). 705 | by move=> ok1 ok2; rewrite [ok _]all_cat; apply/andP. 706 | have and_ok bcs1 bcs2: ok bcs1 -> ok bcs2 -> ok (and_odnf bcs1 bcs2). 707 | rewrite /and_odnf unlock; elim: bcs1 => //= cl1 bcs1 IH1; rewrite -andbA. 708 | case/and3P=> ok11 ok12 ok1 ok2; rewrite cat_ok ?{}IH1 {bcs1 ok1}//. 709 | elim: bcs2 ok2 => //= cl2 bcs2 IH2 /andP[ok2 /IH2->]. 710 | by rewrite /dnf_rterm /= !all_cat andbT ok11; case/and3P: ok12=> -> -> ->. 711 | elim: f b => //=; [ by move=> [] [] 712 | | by move=> ? ? []; rewrite /dnf_rterm /= !andbT 713 | | by move=> ? ? []; rewrite /dnf_rterm /= !andbT andbC 714 | | by move=> ? ? [] /andP[]; rewrite /dnf_rterm/= => -> -> 715 | | by move=> f hf g hg [] /andP[/hf ? /hg ?]; auto 716 | | by move=> f hf g hg [] /andP[/hf ? /hg ?]; auto 717 | | by move=> f hf g hg [] /andP[/hf ? /hg ?]; auto 718 | | by move=> ? h [] /= /h 719 | | by move=> _ ? ? [] 720 | | by move=> _ ? ? [] ]. 721 | Qed. 722 | 723 | Lemma dnf_to_rform bcs : rformula (odnf_to_oform bcs) = all dnf_rterm bcs. 724 | Proof. 725 | elim: bcs => //= [[cl1 cl2 cl3 cl4] bcs ->]; rewrite {2}/dnf_rterm /=; congr (_ && _). 726 | congr andb; first by elim: cl1 => //= t cl ->; rewrite andbT. 727 | congr andb; first by elim: cl2 => //= t cl ->; rewrite andbT. 728 | congr andb; first by elim: cl3 => //= t cl ->. 729 | by elim: cl4 => //= t cl ->. 730 | Qed. 731 | 732 | Implicit Type f : formula R. 733 | 734 | Fixpoint leq_elim_aux (eq_l lt_l le_l : seq (term R)) := 735 | match le_l with 736 | [::] => [:: (eq_l, lt_l)] 737 | |le1 :: le_l' => 738 | let res := leq_elim_aux eq_l lt_l le_l' in 739 | let as_eq := map (fun x => (le1 :: x.1%PAIR, x.2%PAIR)) res in 740 | let as_lt := map (fun x => (x.1%PAIR, le1 :: x.2%PAIR)) res in 741 | as_eq ++ as_lt 742 | end. 743 | 744 | Definition oclause_leq_elim oc : seq (oclause R) := 745 | let: Oclause eq_l neq_l lt_l le_l := oc in 746 | map (fun x => Oclause x.1%PAIR neq_l x.2%PAIR [::]) 747 | (leq_elim_aux eq_l lt_l le_l). 748 | 749 | Definition terms_of_oclause (oc : oclause R) := 750 | let: Oclause eq_l neq_l lt_l le_l := oc in 751 | eq_l ++ neq_l ++ lt_l ++ le_l. 752 | 753 | Lemma terms_of_leq_elim oc1 oc2: 754 | oc2 \in (oclause_leq_elim oc1) -> 755 | (terms_of_oclause oc2) =i (terms_of_oclause oc1). 756 | case: oc1 => eq1 neq1 lt1 leq1 /=. 757 | elim: leq1 eq1 lt1 oc2 => [|t1 leq1 ih] eq1 lt1 [eq2 neq2 lt2 leq2] /=. 758 | by rewrite inE; case/eqP=> -> -> -> -> ?. 759 | rewrite map_cat /= mem_cat -!map_comp; set f := fun _ => _. 760 | rewrite -/f in ih; case/orP. 761 | case/mapP=> [[y1 y2]] yin ye. 762 | move: (ih eq1 lt1 (f (y1, y2))); rewrite mem_map //; last first. 763 | by move=> [u1 u2] [v1 v2]; rewrite /f /=; case=> -> ->. 764 | move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h. 765 | move=> u; rewrite in_cons (h u) !mem_cat in_cons. 766 | by rewrite orbC !orbA; set x := _ || (u \in lt1); rewrite orbAC. 767 | case/mapP=> [[y1 y2]] yin ye. 768 | move: (ih eq1 lt1 (f (y1, y2))); rewrite mem_map //; last first. 769 | by move=> [u1 u2] [v1 v2]; rewrite /f /=; case=> -> ->. 770 | move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h u. 771 | rewrite !mem_cat !in_cons orbA orbCA -!orbA; move: (h u); rewrite !mem_cat=> ->. 772 | by rewrite orbC !orbA; set x := _ || (u \in lt1); rewrite orbAC. 773 | Qed. 774 | 775 | Lemma odnf_to_oform_cat e c d : holds e (odnf_to_oform (c ++ d)) 776 | <-> holds e ((odnf_to_oform c) \/ (odnf_to_oform d))%oT. 777 | Proof. 778 | elim: c d => [| tc c ihc] d /=; first by split => // hd; [right | case: hd]. 779 | rewrite ihc /=; split. 780 | case; first by case=> ?; case=> ?; case=> ? ?; left; left. 781 | case; first by move=> ?; left; right. 782 | by move=> ?; right. 783 | case; last by move=> ?; right; right. 784 | case; last by move=> ?; right; left. 785 | by do 3!case=> ?; move=> ?; left. 786 | Qed. 787 | 788 | Lemma oclause_leq_elimP oc e : 789 | holds e (odnf_to_oform [:: oc]) <-> 790 | holds e (odnf_to_oform (oclause_leq_elim oc)). 791 | Proof. 792 | case: oc => eq_l neq_l lt_l le_l; rewrite /oclause_leq_elim. 793 | elim: le_l eq_l neq_l lt_l => [|t le_l ih] eq_l neq_l lt_l //=. 794 | move: (ih eq_l neq_l lt_l) => /= {ih}. 795 | set x1 := foldr _ _ _; set x2 := foldr _ _ _; set x3 := foldr _ _ _. 796 | set x4 := foldr _ _ _ => h. 797 | have -> : (holds e x1 /\ holds e x2 /\ holds e x3 /\ 0%:R <= eval e t /\ 798 | holds e x4 \/ false) <-> 799 | (0%:R <= eval e t) /\ (holds e x1 /\ holds e x2 /\ holds e x3 /\ 800 | holds e x4 \/ false). 801 | split; first by case=> //; do 4!(case=> ?); move=> ?; split => //; left. 802 | by case=> ?; case=> //; do 3!(case=> ?); move=> ?; left. 803 | rewrite h {h} /= !map_cat /= -!map_comp. 804 | set s1 := [seq _ | _ <- _]; set s2 := [seq _ | _ <- _]. 805 | set s3 := [seq _ | _ <- _]. rewrite odnf_to_oform_cat. 806 | suff {x1 x2 x3 x4} /= -> : 807 | holds e (odnf_to_oform s2) <-> eval e t == 0%:R /\ holds e (odnf_to_oform s1). 808 | suff /= -> : 809 | holds e (odnf_to_oform s3) <-> 0%:R < eval e t /\ holds e (odnf_to_oform s1). 810 | rewrite le_eqVlt eq_sym; split; first by case; case/orP=> -> ?; [left|right]. 811 | by case; [case=> -> ? /= |case=> ->; rewrite orbT]. 812 | rewrite /s1 /s3. 813 | elim: (leq_elim_aux eq_l lt_l le_l) => /= [| t1 l ih]; first by split=> // [[]]. 814 | rewrite /= ih; split. 815 | case; last by case=> -> ?; split=> //; right. 816 | by do 2!case=> ?; case; case=> -> ? _; split => //; auto. 817 | by case=> ->; case; [do 3!case=> ?; move=> _; left | right]. 818 | rewrite /s2 /s1. 819 | elim: (leq_elim_aux eq_l lt_l le_l) => /= [| t1 l ih]; first by split=> // [[]]. 820 | rewrite /= ih; split. 821 | case; last by case=> -> ?; split=> //; right. 822 | by case; case=> /eqP ? ?; do 2!case=> ?; move=> _; split=> //; left. 823 | case=> /eqP ?; case; first by do 3!case=> ?; move=> _; left. 824 | by right; split=> //; apply/eqP. 825 | Qed. 826 | 827 | Fixpoint neq_elim_aux (lt_l neq_l : seq (term R)) := 828 | match neq_l with 829 | [::] => [:: lt_l] 830 | |neq1 :: neq_l' => 831 | let res := neq_elim_aux lt_l neq_l' in 832 | let as_pos := map (fun x => neq1 :: x) res in 833 | let as_neg := map (fun x => Opp neq1 :: x) res in 834 | as_pos ++ as_neg 835 | end. 836 | 837 | Definition oclause_neq_elim oc : seq (oclause R) := 838 | let: Oclause eq_l neq_l lt_l le_l := oc in 839 | map (fun x => Oclause eq_l [::] x le_l) (neq_elim_aux lt_l neq_l). 840 | 841 | Lemma terms_of_neq_elim oc1 oc2: 842 | oc2 \in (oclause_neq_elim oc1) -> 843 | {subset (terms_of_oclause oc2) <= (terms_of_oclause oc1) ++ (map Opp oc1.2)}. 844 | Proof. 845 | case: oc1 => eq1 neq1 lt1 leq1 /=. 846 | elim: neq1 lt1 oc2 => [|t1 neq1 ih] lt1 [eq2 neq2 lt2 leq2] /=. 847 | by rewrite inE; case/eqP=> -> -> -> ->; rewrite !cats0 !cat0s. 848 | rewrite map_cat /= mem_cat -!map_comp; set f := fun _ => _. 849 | rewrite -/f in ih; case/orP. 850 | case/mapP=> y yin ye. 851 | move: (ih lt1 (f y)); rewrite mem_map //; last first. 852 | by move=> u v; rewrite /f /=; case. 853 | move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h. 854 | move=> u. rewrite !mem_cat !in_cons orbAC orbC mem_cat -!orbA. 855 | case/orP; first by move->; rewrite !orbT. 856 | rewrite !orbA [_ || (_ \in eq1)]orbC; move: (h u); rewrite !mem_cat=> hu. 857 | by move/hu; do 2!(case/orP; last by move->; rewrite !orbT); move->. 858 | case/mapP=> y yin ye. 859 | move: (ih lt1 (f y)); rewrite mem_map //; last first. 860 | by move=> u v; rewrite /f /=; case. 861 | move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h. 862 | move=> u; rewrite !mem_cat !in_cons orbAC orbC mem_cat -!orbA. 863 | case/orP; first by move->; rewrite !orbT. 864 | rewrite !orbA [_ || (_ \in eq1)]orbC; move: (h u); rewrite !mem_cat=> hu. 865 | by move/hu; do 2!(case/orP; last by move->; rewrite !orbT); move->. 866 | Qed. 867 | 868 | 869 | Lemma oclause_neq_elimP oc e : 870 | holds e (odnf_to_oform [:: oc]) <-> 871 | holds e (odnf_to_oform (oclause_neq_elim oc)). 872 | Proof. 873 | case: oc => eq_l neq_l lt_l le_l; rewrite /oclause_neq_elim. 874 | elim: neq_l lt_l => [|t neq_l ih] lt_l //=. 875 | move: (ih lt_l) => /= {ih}. 876 | set x1 := foldr _ _ _; set x2 := foldr _ _ _; set x3 := foldr _ _ _. 877 | set x4 := foldr _ _ _ => h /=. 878 | have -> : holds e x1 /\ 879 | (eval e t <> 0%:R /\ 880 | holds e x2) /\ 881 | holds e x3 /\ holds e x4 \/ 882 | false <-> 883 | (eval e t <> 0%:R) /\ (holds e x1 /\ holds e x2 /\ holds e x3 /\ 884 | holds e x4 \/ false). 885 | split; case=> //. 886 | - by case=> ?; case; case=> ? ? [] ? ?; split=> //; left. 887 | - by move=> ?; case=> //; do 3!case=> ?; move=> ?; left. 888 | rewrite h {h} /= !map_cat /= -!map_comp. 889 | set s1 := [seq _ | _ <- _]; set s2 := [seq _ | _ <- _]. 890 | set s3 := [seq _ | _ <- _]; rewrite odnf_to_oform_cat. 891 | suff {x1 x2 x3 x4} /= -> : 892 | holds e (odnf_to_oform s2) <-> 0%:R < eval e t/\ holds e (odnf_to_oform s1). 893 | suff /= -> : 894 | holds e (odnf_to_oform s3) <-> 0%:R < - eval e t /\ holds e (odnf_to_oform s1). 895 | rewrite oppr_gt0; split. 896 | by case; move/eqP; rewrite neq_lt; case/orP=> -> h1; [right | left]. 897 | by case; case=> h ?; split=> //; apply/eqP; rewrite neq_lt h ?orbT. 898 | rewrite /s1 /s3. 899 | elim: (neq_elim_aux lt_l neq_l) => /= [| t1 l ih] /=; first by split => //; case. 900 | set y1 := foldr _ _ _; set y2 := foldr _ _ _; set y3 := foldr _ _ _. 901 | rewrite ih; split. 902 | case; first by case=> ?; case=> _; case; case=> -> ? ?; split=> //; left. 903 | by case=> ? ?; split=> //; right. 904 | by case=> ->; case; [case=> ?; case=> _; case=> ? ?; left| move=> ?; right]. 905 | rewrite /s1 /s2. 906 | elim: (neq_elim_aux lt_l neq_l) => /= [| t1 l ih] /=; first by split => //; case. 907 | set y1 := foldr _ _ _; set y2 := foldr _ _ _; set y3 := foldr _ _ _. 908 | rewrite ih; split. 909 | case; first by case=> ? [] _ [] [] ? ? ?; split=> //; left. 910 | by case=> ? ?; split=> //; right. 911 | case=> ? []; last by right. 912 | by case=> ? [] _ [] ? ?; left. 913 | Qed. 914 | 915 | Definition oclause_neq_leq_elim oc := 916 | flatten (map oclause_neq_elim (oclause_leq_elim oc)). 917 | 918 | Lemma terms_of_neq_leq_elim oc1 oc2: 919 | oc2 \in (oclause_neq_leq_elim oc1) -> 920 | {subset (terms_of_oclause oc2) <= (terms_of_oclause oc1) ++ map Opp oc1.2}. 921 | Proof. 922 | rewrite /oclause_neq_leq_elim/flatten; rewrite foldr_map. 923 | suff : forall oc3, 924 | oc3 \in (oclause_leq_elim oc1) -> 925 | (terms_of_oclause oc3 =i terms_of_oclause oc1) /\ oc3.2 = oc1.2. 926 | elim: (oclause_leq_elim oc1) => [| t l ih] //= h1. 927 | rewrite mem_cat; case/orP. 928 | - move/terms_of_neq_elim=> h u; move/(h u); rewrite !mem_cat. 929 | by case: (h1 t (mem_head _ _)); move/(_ u)=> -> ->. 930 | - by move=> h; apply: (ih _ h) => ? loc3; apply: h1; rewrite in_cons loc3 orbT. 931 | move=> {oc2} oc3 hoc3; split; first exact: terms_of_leq_elim. 932 | case: oc3 hoc3=> eq2 neq2 lt2 leq2 /=; case: oc1=> eq1 neq1 lt1 leq1 /=. 933 | elim: leq1 => [| t1 le1 ih] //=; first by rewrite inE; case/eqP=> _ ->. 934 | rewrite map_cat mem_cat; move: ih. 935 | elim: (leq_elim_aux eq1 lt1 le1) => [| t2 l2 ih2] //=; rewrite !in_cons. 936 | move=> h1; case/orP=> /=. 937 | case/orP; first by case/eqP. 938 | by move=> h2; apply: ih2; rewrite ?h2 // => - h3; apply: h1; rewrite h3 orbT. 939 | case/orP; first by case/eqP. 940 | move=> h3; apply: ih2; last by rewrite h3 orbT. 941 | by move=> h2; apply: h1; rewrite h2 orbT. 942 | Qed. 943 | 944 | Lemma oclause_neq_leq_elimP oc e : 945 | holds e (odnf_to_oform [:: oc]) <-> 946 | holds e (odnf_to_oform (oclause_neq_leq_elim oc)). 947 | Proof. 948 | rewrite /oclause_neq_leq_elim. 949 | rewrite oclause_leq_elimP; elim: (oclause_leq_elim oc) => [| t l ih] //=. 950 | rewrite odnf_to_oform_cat /= ih -oclause_neq_elimP /=. 951 | suff -> : forall A, A \/ false <-> A by []. 952 | by intuition. 953 | Qed. 954 | 955 | Definition oclause_to_w oc := 956 | let s := oclause_neq_leq_elim oc in 957 | map (fun x => let: Oclause eq_l neq_l lt_l leq_l := x in (eq_l, lt_l)) s. 958 | 959 | Definition w_to_oclause (t : seq (term R) * seq (term R)) := 960 | Oclause t.1%PAIR [::] t.2%PAIR [::]. 961 | 962 | Lemma oclause_leq_elim4 bc oc : oc \in (oclause_leq_elim bc) -> oc.4 == [::]. 963 | Proof. 964 | case: bc => bc1 bc2 bc3 bc4; elim: bc4 bc1 bc3 oc => [|t bc4 ih] bc1 bc3 /= oc. 965 | by rewrite inE; move/eqP; case: oc => ? ? ? oc4 /=; case=> _ _ _ /eqP. 966 | rewrite map_cat; move: (ih bc1 bc3 oc) => /= {ih}. 967 | elim: (leq_elim_aux bc1 bc3 bc4) => [| t2 l2 ih2] //= ih1. 968 | rewrite in_cons; case/orP. 969 | by move/eqP; case: oc {ih1 ih2} => ? ? ? ? [] /= _ _ _ /eqP. 970 | rewrite mem_cat; case/orP=> [hoc1|]. 971 | apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. 972 | by rewrite mem_cat hoc1. 973 | rewrite in_cons; case/orP=> [| hoc1]. 974 | by move/eqP; case: {ih1 ih2} oc=> ? ? ? ? [] /= _ _ _ /eqP. 975 | apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. 976 | by rewrite mem_cat hoc1 orbT. 977 | Qed. 978 | 979 | Lemma oclause_neq_elim2 bc oc : 980 | oc \in (oclause_neq_elim bc) -> (oc.2 == [::]) && (oc.4 == bc.4). 981 | Proof. 982 | case: bc => bc1 bc2 bc3 bc4; elim: bc2 bc4 oc => [|t bc2 /= ih] bc4 /= oc. 983 | by rewrite inE; move/eqP; case: oc => ? ? ? oc4 /=; case=> _ /eqP -> _ /eqP. 984 | rewrite map_cat; move: (ih bc4 oc) => /= {ih}. 985 | elim: (neq_elim_aux bc3 bc2) => [| t2 l2 ih2] //= ih1. 986 | rewrite in_cons; case/orP. 987 | by move/eqP; case: oc {ih1 ih2} => ? ? ? ? [] /= _ -> _ ->; rewrite !eqxx. 988 | rewrite mem_cat; case/orP=> [hoc1|]. 989 | apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. 990 | by rewrite mem_cat hoc1. 991 | rewrite in_cons; case/orP=> [| hoc1]. 992 | by move/eqP; case: {ih1 ih2} oc=> ? ? ? ? [] /= _ -> _ ->; rewrite !eqxx. 993 | apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. 994 | by rewrite mem_cat hoc1 orbT. 995 | Qed. 996 | 997 | Lemma oclause_to_wP e bc : 998 | holds e (odnf_to_oform (oclause_neq_leq_elim bc)) <-> 999 | holds e (odnf_to_oform (map w_to_oclause (oclause_to_w bc))). 1000 | Proof. 1001 | rewrite /oclause_to_w /oclause_neq_leq_elim. 1002 | move: (@oclause_leq_elim4 bc). 1003 | elim: (oclause_leq_elim bc) => [| t1 l1 ih1] //= h4. 1004 | rewrite !map_cat !odnf_to_oform_cat. 1005 | rewrite -[holds e (_ \/ _)]/(holds e _ \/ holds e _). 1006 | suff <- : (oclause_neq_elim t1) = map w_to_oclause 1007 | [seq (let: Oclause eq_l _ lt_l _ := x in (eq_l, lt_l)) 1008 | | x <- oclause_neq_elim t1]. 1009 | by rewrite ih1 // => - oc hoc; apply: h4; rewrite in_cons hoc orbT. 1010 | have : forall oc, oc \in (oclause_neq_elim t1) -> oc.2 = [::] /\ oc.4 = [::]. 1011 | move=> oc hoc; move/oclause_neq_elim2: (hoc); case/andP=> /eqP -> /eqP ->. 1012 | by move/eqP: (h4 _ (mem_head _ _))->. 1013 | elim: (oclause_neq_elim t1) => [| [teq1 tneq1 tleq1 tlt1] l2 ih2] h24 //=. 1014 | rewrite /w_to_oclause /=; move: (h24 _ (mem_head _ _ ))=> /= [] -> ->. 1015 | by congr (_ :: _); apply: ih2 => oc hoc; apply: h24; rewrite in_cons hoc orbT. 1016 | Qed. 1017 | 1018 | Variable wproj : nat -> (seq (term R) * seq (term R)) -> formula R. 1019 | 1020 | Definition proj (n : nat)(oc : oclause R) := 1021 | foldr Or False (map (wproj n) (oclause_to_w oc)). 1022 | 1023 | Hypothesis wf_QE_wproj : forall i bc (bc_i := wproj i bc), 1024 | dnf_rterm (w_to_oclause bc) -> qf_form bc_i && rformula bc_i. 1025 | 1026 | Lemma dnf_rterm_subproof bc : dnf_rterm bc -> 1027 | all (dnf_rterm \o w_to_oclause) (oclause_to_w bc). 1028 | Proof. 1029 | case: bc => leq lneql llt lle; rewrite /dnf_rterm /=; case/and4P=> req rneq rlt rle. 1030 | rewrite /oclause_to_w /= !all_map. 1031 | apply/allP => [] [oc_eq oc_neq oc_le oc_lt] hoc; rewrite /dnf_rterm /= andbT. 1032 | rewrite -all_cat; apply/allP=> u hu; move/terms_of_neq_leq_elim: hoc => /=. 1033 | move/(_ u); rewrite !mem_cat. 1034 | have {}hu : [|| u \in oc_eq, u \in oc_neq, u \in oc_le | u \in oc_lt]. 1035 | by move: hu; rewrite mem_cat; case/orP=> ->; rewrite ?orbT. 1036 | move/(_ hu); case/orP; last first. 1037 | move: rneq. 1038 | have <- : (all (@rterm R) (map Opp lneql)) = all (@rterm R) lneql. 1039 | by elim: lneql => [| t l] //= ->. 1040 | by move/allP; apply. 1041 | case/orP; first by apply: (allP req). 1042 | case/orP; first by apply: (allP rneq). 1043 | case/orP; first by apply: (allP rlt). 1044 | exact: (allP rle). 1045 | Qed. 1046 | 1047 | 1048 | Lemma wf_QE_proj i : forall bc (bc_i := proj i bc), 1049 | dnf_rterm bc -> qf_form bc_i && rformula bc_i. 1050 | Proof. 1051 | case=> leq lneql llt lle /= hdnf; move: (hdnf). 1052 | rewrite /dnf_rterm /=; case/and4P=> req rneq rlt rle; rewrite /proj; apply/andP. 1053 | move: (dnf_rterm_subproof hdnf). 1054 | elim: (oclause_to_w _ ) => //= [a t] ih /andP [h1 h2]. 1055 | by case: (ih h2)=> -> ->; case/andP: (wf_QE_wproj i h1) => -> ->. 1056 | Qed. 1057 | 1058 | Hypothesis valid_QE_wproj : 1059 | forall i bc (bc' := w_to_oclause bc) 1060 | (ex_i_bc := ('exists 'X_i, odnf_to_oform [:: bc'])%oT) e, 1061 | dnf_rterm bc' -> 1062 | reflect (holds e ex_i_bc) (qf_eval e (wproj i bc)). 1063 | 1064 | Lemma valid_QE_proj e i : forall bc (bc_i := proj i bc) 1065 | (ex_i_bc := ('exists 'X_i, odnf_to_oform [:: bc])%oT), 1066 | dnf_rterm bc -> reflect (holds e ex_i_bc) (qf_eval e (proj i bc)). 1067 | Proof. 1068 | move=> bc; rewrite /dnf_rterm => hdnf; rewrite /proj; apply: (equivP idP). 1069 | have -> : holds e ('exists 'X_i, odnf_to_oform [:: bc]) <-> 1070 | (exists x : R, holds (set_nth 0 e i x) 1071 | (odnf_to_oform (oclause_neq_leq_elim bc))). 1072 | split; case=> x h; exists x; first by rewrite -oclause_neq_leq_elimP. 1073 | by rewrite oclause_neq_leq_elimP. 1074 | have -> : 1075 | (exists x : R, 1076 | holds (set_nth 0 e i x) (odnf_to_oform (oclause_neq_leq_elim bc))) <-> 1077 | (exists x : R, 1078 | holds (set_nth 0 e i x) (odnf_to_oform (map w_to_oclause (oclause_to_w bc)))). 1079 | by split; case=> x; move/oclause_to_wP=> h; exists x. 1080 | move: (dnf_rterm_subproof hdnf). 1081 | rewrite /oclause_to_w; elim: (oclause_neq_leq_elim bc) => /= [|a l ih]. 1082 | by split=> //; case. 1083 | case/andP=> h1 h2; have {h2} ih := (ih h2); split. 1084 | - case/orP. 1085 | move/(valid_QE_wproj i e h1)=> /= [x /=] [] // [] h2 [] _ [] h3 _; exists x. 1086 | by left. 1087 | by case/ih => x h; exists x; right. 1088 | - case=> x [] /=. 1089 | + case=> h2 [] _ h3; apply/orP; left; apply/valid_QE_wproj => //=. 1090 | by exists x; left. 1091 | + by move=> hx; apply/orP; right; apply/ih; exists x. 1092 | Qed. 1093 | 1094 | Let elim_aux f n := foldr Or False (map (proj n) (qf_to_odnf f false)). 1095 | 1096 | Fixpoint quantifier_elim f := 1097 | match f with 1098 | | f1 /\ f2 => (quantifier_elim f1) /\ (quantifier_elim f2) 1099 | | f1 \/ f2 => (quantifier_elim f1) \/ (quantifier_elim f2) 1100 | | f1 ==> f2 => (~ quantifier_elim f1) \/ (quantifier_elim f2) 1101 | | ~ f => ~ quantifier_elim f 1102 | | ('exists 'X_n, f) => elim_aux (quantifier_elim f) n 1103 | | ('forall 'X_n, f) => ~ elim_aux (~ quantifier_elim f) n 1104 | | _ => f 1105 | end%oT. 1106 | 1107 | Lemma quantifier_elim_wf f : 1108 | let qf := quantifier_elim f in rformula f -> qf_form qf && rformula qf. 1109 | Proof. 1110 | suffices aux_wf f0 n : let qf := elim_aux f0 n in 1111 | rformula f0 -> qf_form qf && rformula qf. 1112 | - by elim: f => //=; do ?[ move=> f1 IH1 f2 IH2; 1113 | case/andP=> rf1 rf2; 1114 | case/andP:(IH1 rf1)=> -> ->; 1115 | case/andP:(IH2 rf2)=> -> -> // 1116 | | move=> n f1 IH rf1; 1117 | case/andP: (IH rf1)=> qff rf; 1118 | rewrite aux_wf ]. 1119 | rewrite /elim_aux => rf. 1120 | suffices or_wf fs : let ofs := foldr Or False fs in 1121 | all qf_form fs && all rformula fs -> qf_form ofs && rformula ofs. 1122 | - apply: or_wf. 1123 | suffices map_proj_wf bcs: let mbcs := map (proj n) bcs in 1124 | all dnf_rterm bcs -> all qf_form mbcs && all rformula mbcs. 1125 | by apply: map_proj_wf; apply: qf_to_dnf_rterm. 1126 | elim: bcs => [|bc bcs ihb] bcsr //= /andP[rbc rbcs]. 1127 | by rewrite andbAC andbA wf_QE_proj //= andbC ihb. 1128 | elim: fs => //= g gs ihg; rewrite -andbA => /and4P[-> qgs -> rgs] /=. 1129 | by apply: ihg; rewrite qgs rgs. 1130 | Qed. 1131 | 1132 | Lemma quantifier_elim_rformP e f : 1133 | rformula f -> reflect (holds e f) (qf_eval e (quantifier_elim f)). 1134 | Proof. 1135 | pose rc e n f := exists x, qf_eval (set_nth 0 e n x) f. 1136 | have auxP f0 e0 n0: qf_form f0 && rformula f0 -> 1137 | reflect (rc e0 n0 f0) (qf_eval e0 (elim_aux f0 n0)). 1138 | + rewrite /elim_aux => cf; set bcs := qf_to_odnf f0 false. 1139 | apply: (@iffP (rc e0 n0 (odnf_to_oform bcs))); last first. 1140 | - by case=> x; rewrite -qf_to_dnfP //; exists x. 1141 | - by case=> x; rewrite qf_to_dnfP //; exists x. 1142 | have: all dnf_rterm bcs by case/andP: cf => _; apply: qf_to_dnf_rterm. 1143 | elim: {f0 cf}bcs => [|bc bcs IHbcs] /=; first by right; case. 1144 | case/andP=> r_bc /IHbcs {IHbcs}bcsP. 1145 | have f_qf := dnf_to_form_qf [:: bc]. 1146 | case: valid_QE_proj => //= [ex_x|no_x]. 1147 | left; case: ex_x => x /(qf_evalP _ f_qf); rewrite /= orbF => bc_x. 1148 | by exists x; rewrite /= bc_x. 1149 | apply: (iffP bcsP) => [[x bcs_x] | [x]] /=. 1150 | by exists x; rewrite /= bcs_x orbT. 1151 | case/orP => [bc_x|]; last by exists x. 1152 | by case: no_x; exists x; apply/(qf_evalP _ f_qf); rewrite /= bc_x. 1153 | elim: f e => //. 1154 | - by move=> b e _; apply: idP. 1155 | - by move=> t1 t2 e _; apply: eqP. 1156 | - by move=> t1 t2 e _; apply: idP. 1157 | - by move=> t1 t2 e _; apply: idP. 1158 | - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; last by right; case. 1159 | by case/IH2; [left | right; case]. 1160 | - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; first by do 2!left. 1161 | by case/IH2; [left; right | right; case]. 1162 | - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; last by left. 1163 | by case/IH2; [left | right; move/(_ f1e)]. 1164 | - by move=> f IHf e /= /IHf[]; [right | left]. 1165 | - move=> n f IHf e /= rf; have rqf := quantifier_elim_wf rf. 1166 | by apply: (iffP (auxP _ _ _ rqf)) => [] [x]; exists x; apply/IHf. 1167 | move=> n f IHf e /= rf; have rqf := quantifier_elim_wf rf. 1168 | case: auxP => // [f_x|no_x]; first by right=> no_x; case: f_x => x /IHf[]. 1169 | by left=> x; apply/IHf=> //; apply/idPn=> f_x; case: no_x; exists x. 1170 | Qed. 1171 | 1172 | Definition proj_sat e f := qf_eval e (quantifier_elim (to_rform f)). 1173 | 1174 | Lemma proj_satP : forall e f, reflect (holds e f) (proj_sat e f). 1175 | Proof. 1176 | move=> e f; have fP := quantifier_elim_rformP e (to_rform_rformula f). 1177 | by apply: (iffP fP); move/to_rformP. 1178 | Qed. 1179 | 1180 | End EvalTerm. 1181 | 1182 | End ord. 1183 | --------------------------------------------------------------------------------