pax_global_header00006660000000000000000000000064147442001610014511gustar00rootroot0000000000000052 comment=a9ce79ab405fd04a8db36a75667bd861da918d5f algebra-tactics-1.2.4/000077500000000000000000000000001474420016100145425ustar00rootroot00000000000000algebra-tactics-1.2.4/.gitattributes000066400000000000000000000000401474420016100174270ustar00rootroot00000000000000*.elpi linguist-language=prolog algebra-tactics-1.2.4/.github/000077500000000000000000000000001474420016100161025ustar00rootroot00000000000000algebra-tactics-1.2.4/.github/workflows/000077500000000000000000000000001474420016100201375ustar00rootroot00000000000000algebra-tactics-1.2.4/.github/workflows/docker-action.yml000066400000000000000000000033701474420016100234070ustar00rootroot00000000000000# This file was generated from `meta.yml`, please do not edit manually. # Follow the instructions on https://github.com/coq-community/templates to regenerate. name: Docker CI on: push: branches: - master pull_request: branches: - '**' jobs: build: # the OS must be GNU/Linux to be able to use the docker-coq-action runs-on: ubuntu-latest strategy: matrix: image: - 'mathcomp/mathcomp:2.0.0-coq-8.16' - 'mathcomp/mathcomp:2.0.0-coq-8.17' - 'mathcomp/mathcomp:2.0.0-coq-8.18' - 'mathcomp/mathcomp:2.1.0-coq-8.16' - 'mathcomp/mathcomp:2.1.0-coq-8.17' - 'mathcomp/mathcomp:2.1.0-coq-8.18' - 'mathcomp/mathcomp:2.2.0-coq-8.16' - 'mathcomp/mathcomp:2.2.0-coq-8.17' - 'mathcomp/mathcomp:2.2.0-coq-8.18' - 'mathcomp/mathcomp:2.2.0-coq-8.19' - 'mathcomp/mathcomp:2.2.0-coq-8.20' - 'mathcomp/mathcomp:2.2.0-coq-dev' - 'mathcomp/mathcomp:2.3.0-coq-8.18' - 'mathcomp/mathcomp:2.3.0-coq-8.19' - 'mathcomp/mathcomp:2.3.0-coq-8.20' - 'mathcomp/mathcomp:2.3.0-coq-dev' - 'mathcomp/mathcomp-dev:coq-8.18' - 'mathcomp/mathcomp-dev:coq-8.19' - 'mathcomp/mathcomp-dev:coq-8.20' - 'mathcomp/mathcomp-dev:coq-dev' fail-fast: false steps: - uses: actions/checkout@v3 - uses: coq-community/docker-coq-action@v1 with: opam_file: 'coq-mathcomp-algebra-tactics.opam' custom_image: ${{ matrix.image }} export: 'OPAMWITHTEST' env: OPAMWITHTEST: true # See also: # https://github.com/coq-community/docker-coq-action#readme # https://github.com/erikmd/docker-coq-github-action-demo algebra-tactics-1.2.4/.gitignore000066400000000000000000000003641474420016100165350ustar00rootroot00000000000000*.d *.vo *.vio *.vos *.vok *.cm* *~ *.glob *.aux *.a *.o Make*.coq Make*.coq.bak Make*.coq.conf *# .lia.cache .nia.cache .nra.cache examples/.csdp.cache examples/.nra.cache examples/trace theories/.csdp.cache theories/.nra.cache theories/trace algebra-tactics-1.2.4/.nix/000077500000000000000000000000001474420016100154165ustar00rootroot00000000000000algebra-tactics-1.2.4/.nix/config.nix000066400000000000000000000042441474420016100174070ustar00rootroot00000000000000{ ## DO NOT CHANGE THIS format = "1.0.0"; ## unless you made an automated or manual update ## to another supported format. ## The attribute to build, either from nixpkgs ## of from the overlays located in `.nix/coq-overlays` attribute = "algebra-tactics"; ## If you want to select a different attribute ## to serve as a basis for nix-shell edit this # shell-attribute = "{{nix_name}}"; ## Maybe the shortname of the library is different from ## the name of the nixpkgs attribute, if so, set it here: # pname = "{{shortname}}"; ## Lists the dependencies, phrased in terms of nix attributes. ## No need to list Coq, it is already included. ## These dependencies will systematically be added to the currently ## known dependencies, if any more than Coq. ## /!\ Remove this field as soon as the package is available on nixpkgs. ## /!\ Manual overlays in `.nix/coq-overlays` should be preferred then. # buildInputs = [ ]; ## Indicate the relative location of your _CoqProject ## If not specified, it defaults to "_CoqProject" # coqproject = "_CoqProject"; ## select an entry to build in the following `bundles` set ## defaults to "default" default-bundle = "8.13"; ## write one `bundles.name` attribute set per ## alternative configuration, the can be used to ## compute several ci jobs as well bundles = { "8.13" = { coqPackages.coq.override.version = "8.13"; }; }; ## Cachix caches to use in CI ## Below we list some standard ones cachix.coq = {}; cachix.math-comp = {}; cachix.coq-community = {}; ## If you have write access to one of these caches you can ## provide the auth token or signing key through a secret ## variable on GitHub. Then, you should give the variable ## name here. For instance, coq-community projects can use ## the following line instead of the one above: # cachix.coq-community.authToken = "CACHIX_AUTH_TOKEN"; ## Or if you have a signing key for a given Cachix cache: # cachix.my-cache.signingKey = "CACHIX_SIGNING_KEY" ## Note that here, CACHIX_AUTH_TOKEN and CACHIX_SIGNING_KEY ## are the names of secret variables. They are set in ## GitHub's web interface. } algebra-tactics-1.2.4/.nix/coq-nix-toolbox.nix000066400000000000000000000000531474420016100211760ustar00rootroot00000000000000"6bfe83b1a07fede9a0e6a7f60df554323051f8d2" algebra-tactics-1.2.4/.nix/coq-overlays/000077500000000000000000000000001474420016100200425ustar00rootroot00000000000000algebra-tactics-1.2.4/.nix/coq-overlays/algebra-tactics/000077500000000000000000000000001474420016100230675ustar00rootroot00000000000000algebra-tactics-1.2.4/.nix/coq-overlays/algebra-tactics/default.nix000066400000000000000000000006371474420016100252410ustar00rootroot00000000000000{ lib, mkCoqDerivation, coq, mathcomp-algebra, coq-elpi, mathcomp-zify, version ? null }: with lib; mkCoqDerivation rec { pname = "algebra-tactics"; owner = "math-comp"; inherit version; defaultVersion = null; propagatedBuildInputs = [ mathcomp-algebra coq-elpi mathcomp-zify ]; meta = { description = "A Library for algebra tactics"; maintainers = with maintainers; [ cohencyril ]; }; } algebra-tactics-1.2.4/.nix/coq-overlays/mathcomp-zify/000077500000000000000000000000001474420016100226315ustar00rootroot00000000000000algebra-tactics-1.2.4/.nix/coq-overlays/mathcomp-zify/default.nix000066400000000000000000000012131474420016100247720ustar00rootroot00000000000000{ lib, mkCoqDerivation, coq, mathcomp-algebra, version ? null }: with lib; mkCoqDerivation rec { pname = "mathcomp-zify"; repo = "mczify"; owner = "math-comp"; inherit version; defaultVersion = with versions; switch [ coq.coq-version mathcomp-algebra.version ] [ { cases = [ (isEq "8.13") (isEq "1.12") ]; out = "1.0.0+1.12+8.13"; } ] null; release."1.0.0+1.12+8.13".sha256 = "1j533vx6lacr89bj1bf15l1a0s7rvrx4l00wyjv99aczkfbz6h6k"; propagatedBuildInputs = [ mathcomp-algebra ]; meta = { description = "Micromega tactics for Mathematical Components"; maintainers = with maintainers; [ cohencyril ]; }; } algebra-tactics-1.2.4/CeCILL-B000066400000000000000000000526231474420016100156470ustar00rootroot00000000000000CeCILL-B FREE SOFTWARE LICENSE AGREEMENT Notice This Agreement is a Free Software license agreement that is the result of discussions between its authors in order to ensure compliance with the two main principles guiding its drafting: * firstly, compliance with the principles governing the distribution of Free Software: access to source code, broad rights granted to users, * secondly, the election of a governing law, French law, with which it is conformant, both as regards the law of torts and intellectual property law, and the protection that it offers to both authors and holders of the economic rights over software. The authors of the CeCILL-B (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre]) license are: Commissariat à l'Energie Atomique - CEA, a public scientific, technical and industrial research establishment, having its principal place of business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France. Centre National de la Recherche Scientifique - CNRS, a public scientific and technological establishment, having its principal place of business at 3 rue Michel-Ange, 75794 Paris cedex 16, France. Institut National de Recherche en Informatique et en Automatique - INRIA, a public scientific and technological establishment, having its principal place of business at Domaine de Voluceau, Rocquencourt, BP 105, 78153 Le Chesnay cedex, France. Preamble This Agreement is an open source software license intended to give users significant freedom to modify and redistribute the software licensed hereunder. The exercising of this freedom is conditional upon a strong obligation of giving credits for everybody that distributes a software incorporating a software ruled by the current license so as all contributions to be properly identified and acknowledged. In consideration of access to the source code and the rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors only have limited liability. In this respect, the risks associated with loading, using, modifying and/or developing or reproducing the software by the user are brought to the user's attention, given its Free Software status, which may make it complicated to use, with the result that its use is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the suitability of the software as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions of security. This Agreement may be freely reproduced and published, provided it is not altered, and that no provisions are either added or removed herefrom. This Agreement may apply to any or all software for which the holder of the economic rights decides to submit the use thereof to its provisions. Article 1 - DEFINITIONS For the purpose of this Agreement, when the following expressions commence with a capital letter, they shall have the following meaning: Agreement: means this license agreement, and its possible subsequent versions and annexes. Software: means the software in its Object Code and/or Source Code form and, where applicable, its documentation, "as is" when the Licensee accepts the Agreement. Initial Software: means the Software in its Source Code and possibly its Object Code form and, where applicable, its documentation, "as is" when it is first distributed under the terms and conditions of the Agreement. Modified Software: means the Software modified by at least one Contribution. Source Code: means all the Software's instructions and program lines to which access is required so as to modify the Software. Object Code: means the binary files originating from the compilation of the Source Code. Holder: means the holder(s) of the economic rights over the Initial Software. Licensee: means the Software user(s) having accepted the Agreement. Contributor: means a Licensee having made at least one Contribution. Licensor: means the Holder, or any other individual or legal entity, who distributes the Software under the Agreement. Contribution: means any or all modifications, corrections, translations, adaptations and/or new functions integrated into the Software by any or all Contributors, as well as any or all Internal Modules. Module: means a set of sources files including their documentation that enables supplementary functions or services in addition to those offered by the Software. External Module: means any or all Modules, not derived from the Software, so that this Module and the Software run in separate address spaces, with one calling the other when they are run. Internal Module: means any or all Module, connected to the Software so that they both execute in the same address space. Parties: mean both the Licensee and the Licensor. These expressions may be used both in singular and plural form. Article 2 - PURPOSE The purpose of the Agreement is the grant by the Licensor to the Licensee of a non-exclusive, transferable and worldwide license for the Software as set forth in Article 5 hereinafter for the whole term of the protection granted by the rights over said Software. Article 3 - ACCEPTANCE 3.1 The Licensee shall be deemed as having accepted the terms and conditions of this Agreement upon the occurrence of the first of the following events: * (i) loading the Software by any or all means, notably, by downloading from a remote server, or by loading from a physical medium; * (ii) the first time the Licensee exercises any of the rights granted hereunder. 3.2 One copy of the Agreement, containing a notice relating to the characteristics of the Software, to the limited warranty, and to the fact that its use is restricted to experienced users has been provided to the Licensee prior to its acceptance as set forth in Article 3.1 hereinabove, and the Licensee hereby acknowledges that it has read and understood it. Article 4 - EFFECTIVE DATE AND TERM 4.1 EFFECTIVE DATE The Agreement shall become effective on the date when it is accepted by the Licensee as set forth in Article 3.1. 4.2 TERM The Agreement shall remain in force for the entire legal term of protection of the economic rights over the Software. Article 5 - SCOPE OF RIGHTS GRANTED The Licensor hereby grants to the Licensee, who accepts, the following rights over the Software for any or all use, and for the term of the Agreement, on the basis of the terms and conditions set forth hereinafter. Besides, if the Licensor owns or comes to own one or more patents protecting all or part of the functions of the Software or of its components, the Licensor undertakes not to enforce the rights granted by these patents against successive Licensees using, exploiting or modifying the Software. If these patents are transferred, the Licensor undertakes to have the transferees subscribe to the obligations set forth in this paragraph. 5.1 RIGHT OF USE The Licensee is authorized to use the Software, without any limitation as to its fields of application, with it being hereinafter specified that this comprises: 1. permanent or temporary reproduction of all or part of the Software by any or all means and in any or all form. 2. loading, displaying, running, or storing the Software on any or all medium. 3. entitlement to observe, study or test its operation so as to determine the ideas and principles behind any or all constituent elements of said Software. This shall apply when the Licensee carries out any or all loading, displaying, running, transmission or storage operation as regards the Software, that it is entitled to carry out hereunder. 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS The right to make Contributions includes the right to translate, adapt, arrange, or make any or all modifications to the Software, and the right to reproduce the resulting software. The Licensee is authorized to make any or all Contributions to the Software provided that it includes an explicit notice that it is the author of said Contribution and indicates the date of the creation thereof. 5.3 RIGHT OF DISTRIBUTION In particular, the right of distribution includes the right to publish, transmit and communicate the Software to the general public on any or all medium, and by any or all means, and the right to market, either in consideration of a fee, or free of charge, one or more copies of the Software by any means. The Licensee is further authorized to distribute copies of the modified or unmodified Software to third parties according to the terms and conditions set forth hereinafter. 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION The Licensee is authorized to distribute true copies of the Software in Source Code or Object Code form, provided that said distribution complies with all the provisions of the Agreement and is accompanied by: 1. a copy of the Agreement, 2. a notice relating to the limitation of both the Licensor's warranty and liability as set forth in Articles 8 and 9, and that, in the event that only the Object Code of the Software is redistributed, the Licensee allows effective access to the full Source Code of the Software at a minimum during the entire period of its distribution of the Software, it being understood that the additional cost of acquiring the Source Code shall not exceed the cost of transferring the data. 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE If the Licensee makes any Contribution to the Software, the resulting Modified Software may be distributed under a license agreement other than this Agreement subject to compliance with the provisions of Article 5.3.4. 5.3.3 DISTRIBUTION OF EXTERNAL MODULES When the Licensee has developed an External Module, the terms and conditions of this Agreement do not apply to said External Module, that may be distributed under a separate license agreement. 5.3.4 CREDITS Any Licensee who may distribute a Modified Software hereby expressly agrees to: 1. indicate in the related documentation that it is based on the Software licensed hereunder, and reproduce the intellectual property notice for the Software, 2. ensure that written indications of the Software intended use, intellectual property notice and license hereunder are included in easily accessible format from the Modified Software interface, 3. mention, on a freely accessible website describing the Modified Software, at least throughout the distribution term thereof, that it is based on the Software licensed hereunder, and reproduce the Software intellectual property notice, 4. where it is distributed to a third party that may distribute a Modified Software without having to make its source code available, make its best efforts to ensure that said third party agrees to comply with the obligations set forth in this Article . If the Software, whether or not modified, is distributed with an External Module designed for use in connection with the Software, the Licensee shall submit said External Module to the foregoing obligations. 5.3.5 COMPATIBILITY WITH THE CeCILL AND CeCILL-C LICENSES Where a Modified Software contains a Contribution subject to the CeCILL license, the provisions set forth in Article 5.3.4 shall be optional. A Modified Software may be distributed under the CeCILL-C license. In such a case the provisions set forth in Article 5.3.4 shall be optional. Article 6 - INTELLECTUAL PROPERTY 6.1 OVER THE INITIAL SOFTWARE The Holder owns the economic rights over the Initial Software. Any or all use of the Initial Software is subject to compliance with the terms and conditions under which the Holder has elected to distribute its work and no one shall be entitled to modify the terms and conditions for the distribution of said Initial Software. The Holder undertakes that the Initial Software will remain ruled at least by this Agreement, for the duration set forth in Article 4.2. 6.2 OVER THE CONTRIBUTIONS The Licensee who develops a Contribution is the owner of the intellectual property rights over this Contribution as defined by applicable law. 6.3 OVER THE EXTERNAL MODULES The Licensee who develops an External Module is the owner of the intellectual property rights over this External Module as defined by applicable law and is free to choose the type of agreement that shall govern its distribution. 6.4 JOINT PROVISIONS The Licensee expressly undertakes: 1. not to remove, or modify, in any manner, the intellectual property notices attached to the Software; 2. to reproduce said notices, in an identical manner, in the copies of the Software modified or not. The Licensee undertakes not to directly or indirectly infringe the intellectual property rights of the Holder and/or Contributors on the Software and to take, where applicable, vis-à-vis its staff, any and all measures required to ensure respect of said intellectual property rights of the Holder and/or Contributors. Article 7 - RELATED SERVICES 7.1 Under no circumstances shall the Agreement oblige the Licensor to provide technical assistance or maintenance services for the Software. However, the Licensor is entitled to offer this type of services. The terms and conditions of such technical assistance, and/or such maintenance, shall be set forth in a separate instrument. Only the Licensor offering said maintenance and/or technical assistance services shall incur liability therefor. 7.2 Similarly, any Licensor is entitled to offer to its licensees, under its sole responsibility, a warranty, that shall only be binding upon itself, for the redistribution of the Software and/or the Modified Software, under terms and conditions that it is free to decide. Said warranty, and the financial terms and conditions of its application, shall be subject of a separate instrument executed between the Licensor and the Licensee. Article 8 - LIABILITY 8.1 Subject to the provisions of Article 8.2, the Licensee shall be entitled to claim compensation for any direct loss it may have suffered from the Software as a result of a fault on the part of the relevant Licensor, subject to providing evidence thereof. 8.2 The Licensor's liability is limited to the commitments made under this Agreement and shall not be incurred as a result of in particular: (i) loss due the Licensee's total or partial failure to fulfill its obligations, (ii) direct or consequential loss that is suffered by the Licensee due to the use or performance of the Software, and (iii) more generally, any consequential loss. In particular the Parties expressly agree that any or all pecuniary or business loss (i.e. loss of data, loss of profits, operating loss, loss of customers or orders, opportunity cost, any disturbance to business activities) or any or all legal proceedings instituted against the Licensee by a third party, shall constitute consequential loss and shall not provide entitlement to any or all compensation from the Licensor. Article 9 - WARRANTY 9.1 The Licensee acknowledges that the scientific and technical state-of-the-art when the Software was distributed did not enable all possible uses to be tested and verified, nor for the presence of possible defects to be detected. In this respect, the Licensee's attention has been drawn to the risks associated with loading, using, modifying and/or developing and reproducing the Software which are reserved for experienced users. The Licensee shall be responsible for verifying, by any or all means, the suitability of the product for its requirements, its good working order, and for ensuring that it shall not cause damage to either persons or properties. 9.2 The Licensor hereby represents, in good faith, that it is entitled to grant all the rights over the Software (including in particular the rights set forth in Article 5). 9.3 The Licensee acknowledges that the Software is supplied "as is" by the Licensor without any other express or tacit warranty, other than that provided for in Article 9.2 and, in particular, without any warranty as to its commercial value, its secured, safe, innovative or relevant nature. Specifically, the Licensor does not warrant that the Software is free from any error, that it will operate without interruption, that it will be compatible with the Licensee's own equipment and software configuration, nor that it will meet the Licensee's requirements. 9.4 The Licensor does not either expressly or tacitly warrant that the Software does not infringe any third party intellectual property right relating to a patent, software or any other property right. Therefore, the Licensor disclaims any and all liability towards the Licensee arising out of any or all proceedings for infringement that may be instituted in respect of the use, modification and redistribution of the Software. Nevertheless, should such proceedings be instituted against the Licensee, the Licensor shall provide it with technical and legal assistance for its defense. Such technical and legal assistance shall be decided on a case-by-case basis between the relevant Licensor and the Licensee pursuant to a memorandum of understanding. The Licensor disclaims any and all liability as regards the Licensee's use of the name of the Software. No warranty is given as regards the existence of prior rights over the name of the Software or as regards the existence of a trademark. Article 10 - TERMINATION 10.1 In the event of a breach by the Licensee of its obligations hereunder, the Licensor may automatically terminate this Agreement thirty (30) days after notice has been sent to the Licensee and has remained ineffective. 10.2 A Licensee whose Agreement is terminated shall no longer be authorized to use, modify or distribute the Software. However, any licenses that it may have granted prior to termination of the Agreement shall remain valid subject to their having been granted in compliance with the terms and conditions hereof. Article 11 - MISCELLANEOUS 11.1 EXCUSABLE EVENTS Neither Party shall be liable for any or all delay, or failure to perform the Agreement, that may be attributable to an event of force majeure, an act of God or an outside cause, such as defective functioning or interruptions of the electricity or telecommunications networks, network paralysis following a virus attack, intervention by government authorities, natural disasters, water damage, earthquakes, fire, explosions, strikes and labor unrest, war, etc. 11.2 Any failure by either Party, on one or more occasions, to invoke one or more of the provisions hereof, shall under no circumstances be interpreted as being a waiver by the interested Party of its right to invoke said provision(s) subsequently. 11.3 The Agreement cancels and replaces any or all previous agreements, whether written or oral, between the Parties and having the same purpose, and constitutes the entirety of the agreement between said Parties concerning said purpose. No supplement or modification to the terms and conditions hereof shall be effective as between the Parties unless it is made in writing and signed by their duly authorized representatives. 11.4 In the event that one or more of the provisions hereof were to conflict with a current or future applicable act or legislative text, said act or legislative text shall prevail, and the Parties shall make the necessary amendments so as to comply with said act or legislative text. All other provisions shall remain effective. Similarly, invalidity of a provision of the Agreement, for any reason whatsoever, shall not cause the Agreement as a whole to be invalid. 11.5 LANGUAGE The Agreement is drafted in both French and English and both versions are deemed authentic. Article 12 - NEW VERSIONS OF THE AGREEMENT 12.1 Any person is authorized to duplicate and distribute copies of this Agreement. 12.2 So as to ensure coherence, the wording of this Agreement is protected and may only be modified by the authors of the License, who reserve the right to periodically publish updates or new versions of the Agreement, each with a separate number. These subsequent versions may address new issues encountered by Free Software. 12.3 Any Software distributed under a given version of the Agreement may only be subsequently distributed under the same version of the Agreement or a subsequent version. Article 13 - GOVERNING LAW AND JURISDICTION 13.1 The Agreement is governed by French law. The Parties agree to endeavor to seek an amicable solution to any disagreements or disputes that may arise during the performance of the Agreement. 13.2 Failing an amicable solution within two (2) months as from their occurrence, and unless emergency proceedings are necessary, the disagreements or disputes shall be referred to the Paris Courts having jurisdiction, by the more diligent Party. Version 1.0 dated 2006-09-05. algebra-tactics-1.2.4/Make000066400000000000000000000002261474420016100153420ustar00rootroot00000000000000theories/common.v theories/lra.v theories/ring.v -R theories mathcomp.algebra_tactics -arg -w -arg -notation-overridden -arg -w -arg +elpi.typecheck algebra-tactics-1.2.4/Make.test-suite000066400000000000000000000004511474420016100174470ustar00rootroot00000000000000examples/field_examples_check.v examples/field_examples_no_check.v examples/ring_examples_check.v examples/ring_examples_no_check.v examples/from_sander.v examples/lra_examples.v -R theories mathcomp.algebra_tactics -R examples mathcomp.algebra_tactics.examples -arg -w -arg -notation-overridden algebra-tactics-1.2.4/Makefile000066400000000000000000000034641474420016100162110ustar00rootroot00000000000000# KNOWNTARGETS will not be passed along to CoqMakefile KNOWNTARGETS := Makefile.coq Makefile.test-suite.coq test-suite \ clean cleanall distclean # KNOWNFILES will not get implicit targets from the final rule, and so # depending on them won't invoke the submake # Warning: These files get declared as PHONY, so any targets depending # on them always get rebuilt KNOWNFILES := Makefile Make Make.test-suite .DEFAULT_GOAL := invoke-coqmakefile COQMAKEFILE = $(COQBIN)coq_makefile COQMAKE = $(MAKE) --no-print-directory -f Makefile.coq COQMAKE_TESTSUITE = $(MAKE) --no-print-directory -f Makefile.test-suite.coq Makefile.coq: Makefile Make $(COQMAKEFILE) -f Make -o Makefile.coq Makefile.test-suite.coq: Makefile Make.test-suite $(COQMAKEFILE) -f Make.test-suite -o Makefile.test-suite.coq invoke-coqmakefile: Makefile.coq $(COQMAKE) $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) test-suite: Makefile.test-suite.coq invoke-coqmakefile $(COQMAKE_TESTSUITE) theories/%.vo: Makefile.coq $(COQMAKE) $@ examples/%.vo: Makefile.test-suite.coq $(COQMAKE_TESTSUITE) $@ clean:: @if [ -f Makefile.coq ]; then $(COQMAKE) clean; fi @if [ -f Makefile.test-suite.coq ]; then $(COQMAKE_TESTSUITE) clean; fi cleanall:: @if [ -f Makefile.coq ]; then $(COQMAKE) cleanall; fi @if [ -f Makefile.test-suite.coq ]; then $(COQMAKE_TESTSUITE) cleanall; fi distclean:: cleanall rm -f Makefile.coq Makefile.coq.conf rm -f Makefile.test-suite.coq Makefile.test-suite.coq.conf .PHONY: invoke-coqmakefile $(KNOWNFILES) #################################################################### ## Your targets here ## #################################################################### # This should be the last rule, to handle any targets not declared above %: invoke-coqmakefile @true algebra-tactics-1.2.4/Makefile.coq.local000066400000000000000000000002701474420016100200530ustar00rootroot00000000000000theories/ring.vo : theories/common.elpi theories/ring.elpi \ theories/ring_tac.elpi theories/field_tac.elpi theories/lra.vo : theories/common.elpi theories/lra.elpi algebra-tactics-1.2.4/README.md000066400000000000000000000220661474420016100160270ustar00rootroot00000000000000 # Algebra Tactics [![Docker CI][docker-action-shield]][docker-action-link] [docker-action-shield]: https://github.com/math-comp/algebra-tactics/actions/workflows/docker-action.yml/badge.svg?branch=master [docker-action-link]: https://github.com/math-comp/algebra-tactics/actions/workflows/docker-action.yml This library provides `ring`, `field`, `lra`, `nra`, and `psatz` tactics for the Mathematical Components library. These tactics use the algebraic structures defined in the MathComp library and their canonical instances for the instance resolution, and do not require any special instance declaration, like the `Add Ring` and `Add Field` commands. Therefore, each of these tactics works with any instance of the respective structure, including concrete instances declared through Hierarchy Builder, abstract instances, and mixed concrete and abstract instances, e.g., `int * R` where `R` is an abstract commutative ring. Another key feature of Algebra Tactics is that they automatically push down ring morphisms and additive functions to leaves of ring/field expressions before applying the proof procedures. ## Meta - Author(s): - Kazuhiko Sakaguchi (initial) - Pierre Roux - License: [CeCILL-B Free Software License Agreement](CeCILL-B) - Compatible Coq versions: 8.16 or later - Additional dependencies: - [MathComp](https://math-comp.github.io) ssreflect 2.0 or later - [MathComp](https://math-comp.github.io) algebra - [Mczify](https://github.com/math-comp/mczify) 1.5.0 or later - [Coq-Elpi](https://github.com/LPCIC/coq-elpi) 1.15.0 or later (known not to work with 1.17.0) - Coq namespace: `mathcomp.algebra_tactics` - Related publication(s): - [Reflexive tactics for algebra, revisited](https://drops.dagstuhl.de/opus/volltexte/2022/16738/) doi:[10.4230/LIPIcs.ITP.2022.29](https://doi.org/10.4230/LIPIcs.ITP.2022.29) ## Building and installation instructions The easiest way to install the latest released version of Algebra Tactics is via [OPAM](https://opam.ocaml.org/doc/Install.html): ```shell opam repo add coq-released https://coq.inria.fr/opam/released opam install coq-mathcomp-algebra-tactics ``` To instead build and install manually, do: ``` shell git clone https://github.com/math-comp/algebra-tactics.git cd algebra-tactics make # or make -j make install ``` ## Documentation **Caveat: the `lra`, `nra`, and `psatz` tactics are considered experimental features and subject to change.** This Coq library provides an adaptation of the [`ring`, `field`](https://coq.inria.fr/refman/addendum/ring), [`lra`, `nra`, and `psatz`](https://coq.inria.fr/refman/addendum/micromega) tactics to the MathComp library. See the Coq reference manual for the basic functionalities of these tactics. The descriptions of these tactics below mainly focus on the differences between ones provided by Coq and ones provided by this library, including the additional features introduced by this library. ### The `ring` tactic The `ring` tactic solves a goal of the form `p = q :> R` representing a polynomial equation. The type `R` must have a canonical `comRingType` (commutative ring) or at least `comSemiRingType` (commutative semiring) instance. The `ring` tactic solves the equation by normalizing each side as a polynomial, whose coefficients are either integers `Z` (if `R` is a `comRingType`) or natural numbers `N`. The `ring` tactic can decide the given polynomial equation modulo given monomial equations. The syntax to use this feature is `ring: t_1 .. t_n` where each `t_i` is a proof of equality `m_i = p_i`, `m_i` is a monomial, and `p_i` is a polynomial. Although the `ring` tactic supports ring homomorphisms (explained below), all the monomials and polynomials `m_1, .., m_n, p_1, .., p_n, p, q` must have the same type `R` for the moment. Each tactic provided by this library has a preprocessor and supports applications of (semi)ring homomorphisms and additive functions (N-module or Z-module homomorphisms). For example, suppose `f : S -> T` and `g : R -> S` are ring homomorphisms. The preprocessor turns a ring sub-expression of the form `f (x + g (y * z))` into `f x + f (g y) * f (g z)`. A composition of homomorphisms from the initial objects `nat`, `N`, `int`, and `Z` is automatically normalized to the canonical one. For example, if `R` in the above example is `int`, the result of the preprocessing should be `f x + y%:~R * z%:~R` where `f \o g : int -> T` is replaced with `intr` (`_%:~R`). Thanks to the preprocessor, the `ring` tactic supports the following constructs apart from homomorphism applications: - `GRing.zero` (`0%R`), - `GRing.add` (`+%R`), - `addn`, - `N.add`, - `Z.add`, - `GRing.natmul`, - `GRing.opp` (`-%R`), - `Z.opp`, - `Z.sub`, - `intmul`, - `GRing.one` (`1%R`), - `GRing.mul` (`*%R`), - `muln`, - `N.mul`, - `Z.mul`, - `GRing.exp`,[^constant_exponent] - `exprz`,[^constant_exponent] - `expn`,[^constant_exponent] - `N.pow`,[^constant_exponent] - `Z.pow`,[^constant_exponent] - `S`, - `Posz`, - `Negz`, and - constants of type `nat`, `N`, or `Z`. [^constant_exponent]: The exponent must be a constant value. In addition, it must be non-negative for `exprz`. ### The `field` tactic The `field` tactic solves a goal of the form `p = q :> F` representing a rational equation. The type `F` must have a canonical `fieldType` (field) instance. The `field` tactic solves the equation by normalizing each side to a pair of two polynomials representing a fraction, whose coefficients are integers `Z`. As is the case for the `ring` tactic, the `field` tactic can decide the given rational equation modulo given monomial equations. The syntax to use this feature is the same as the `ring` tactic: `field: t_1 .. t_n`. The `field` tactic generates proof obligations that all the denominators in the equation are not zero. A proof obligation of the form `p * q != 0 :> F` is always automatically reduced to `p != 0 /\ q != 0`. If the field `F` is a `numFieldType` (partially ordered field), a proof obligation of the form `c%:~R != 0 :> F` where `c` is a non-zero integer constant is automatically resolved. The `field` tactic has a preprocessor similar to the `ring` tactic. In addition to the constructs supported by the `ring` tactic, the `field` tactic supports `GRing.inv` and `exprz` with a negative exponent. ### The `lra`, `nra`, and `psatz` tactics The `lra` tactic is a decision procedure for linear real arithmetic. The `nra` and `psatz` tactics are incomplete proof procedures for non-linear real arithmetic. The carrier type must have a canonical `realDomainType` (totally ordered integral domain) or `realFieldType` (totally ordered field) instance. The multiplicative inverse is supported only if the carrier type is a `realFieldType`. If the carrier type is not a `realFieldType` but a `realDomainType`, these three tactics use the same preprocessor as the `ring` tactic. If the carrier type is a `realFieldType`, these tactics support `GRing.inv` and `exprz` with a negative exponent. In contrast to the `field` tactic, these tactics push down the multiplicative inverse through multiplication and exponentiation, e.g., turning `(x * y)^-1` into `x^-1 * y^-1`. ## Files - `theories/` - `common.v`: provides the reflexive preprocessors (syntax, interpretation function, and normalization functions), - `common.elpi`: provides the reification procedure for (semi)ring and module expressions, except for the case that the carrier type is a `realFieldType` in the `lra`, `nra`, and `psatz` tactics, - `ring.v`: provides the Coq code specific to the `ring` and `field` tactics, including the reflection lemmas, - `ring.elpi`: provides the Elpi code specific to the `ring` and `field` tactics, - `ring_tac.elpi`: provides the entry point for the `ring` tactic, - `field_tac.elpi`: provides the entry point for the `field` tactic, - `lra.v`: provides the Coq code specific to the `lra`, `nra`, and `psatz` tactics, including the reflection lemmas, - `lra.elpi`: provides the Elpi code specific to the `lra`, `nra`, and `psatz` tactics, including the reification procedure and the entry point. ## Credits - The adaptation of the `lra`, `nra`, and `psatz` tactics is contributed by Pierre Roux. - The way we adapt the internal lemmas of Coq's `ring` and `field` tactics to algebraic structures of the Mathematical Components library is inspired by the [elliptic-curves-ssr](https://github.com/strub/elliptic-curves-ssr) library by Evmorfia-Iro Bartzia and Pierre-Yves Strub. - The example [`from_sander.v`](examples/from_sander.v) contributed by Assia Mahboubi was given to her by [Sander Dahmen](http://www.few.vu.nl/~sdn249/). It is related to a computational proof that elliptic curves are endowed with a group law. As [suggested](https://hal.inria.fr/inria-00129237v4/document) by Laurent Théry a while ago, this problem is a good benchmark for proof systems. Laurent Théry and Guillaume Hanrot [formally verified](https://doi.org/10.1007/978-3-540-74591-4_24) this property in Coq in 2007. algebra-tactics-1.2.4/_CoqProject000066400000000000000000000001441474420016100166740ustar00rootroot00000000000000-R theories mathcomp.algebra_tactics -arg -w -arg -notation-overridden -arg -w -arg +elpi.typecheck algebra-tactics-1.2.4/coq-mathcomp-algebra-tactics.opam000066400000000000000000000032771474420016100230440ustar00rootroot00000000000000# This file was generated from `meta.yml`, please do not edit manually. # Follow the instructions on https://github.com/coq-community/templates to regenerate. opam-version: "2.0" maintainer: "kazuhiko.sakaguchi@inria.fr" version: "dev" homepage: "https://github.com/math-comp/algebra-tactics" dev-repo: "git+https://github.com/math-comp/algebra-tactics.git" bug-reports: "https://github.com/math-comp/algebra-tactics/issues" license: "CECILL-B" synopsis: "Ring, field, lra, nra, and psatz tactics for Mathematical Components" description: """ This library provides `ring`, `field`, `lra`, `nra`, and `psatz` tactics for the Mathematical Components library. These tactics use the algebraic structures defined in the MathComp library and their canonical instances for the instance resolution, and do not require any special instance declaration, like the `Add Ring` and `Add Field` commands. Therefore, each of these tactics works with any instance of the respective structure, including concrete instances declared through Hierarchy Builder, abstract instances, and mixed concrete and abstract instances, e.g., `int * R` where `R` is an abstract commutative ring. Another key feature of Algebra Tactics is that they automatically push down ring morphisms and additive functions to leaves of ring/field expressions before applying the proof procedures.""" build: [make "-j%{jobs}%"] run-test: [make "-j%{jobs}%" "test-suite"] install: [make "install"] depends: [ "coq" {>= "8.16"} "coq-mathcomp-ssreflect" {>= "2.0"} "coq-mathcomp-algebra" "coq-mathcomp-zify" {>= "1.5.0"} "coq-elpi" {>= "1.15.0" & != "1.17.0"} ] tags: [ "logpath:mathcomp.algebra_tactics" ] authors: [ "Kazuhiko Sakaguchi" "Pierre Roux" ] algebra-tactics-1.2.4/default.nix000066400000000000000000000007321474420016100167100ustar00rootroot00000000000000{ config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, update-nixpkgs ? false, ci-matrix ? false, override ? {}, ocaml-override ? {}, global-override ? {}, bundle ? null, job ? null, inNixShell ? null, src ? ./., }@args: let auto = fetchGit { url = "https://github.com/coq-community/coq-nix-toolbox.git"; ref = "master"; # putting a ref here is strongly advised rev = import .nix/coq-nix-toolbox.nix; }; in import auto ({inherit src;} // args) algebra-tactics-1.2.4/examples/000077500000000000000000000000001474420016100163605ustar00rootroot00000000000000algebra-tactics-1.2.4/examples/field_examples.v000066400000000000000000000037121474420016100215330ustar00rootroot00000000000000(* This file should be tested by loaded from `field_examples_check.v` and *) (* `field_examples_no_check.v`. To edit this file, uncomment `Require *) (* Import`s below: *) (* From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. *) (* From mathcomp Require Import ring. *) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory Num.Theory. Local Open Scope ring_scope. (* Examples from the Coq Reference Manual, but for an instance of MathComp's (abstract) field. *) Goal forall (F : fieldType) (x : F), x != 0 -> (1 - 1 / x) * x - x + 1 = 0. Proof. by move=> F x x_neq0; field. Qed. Goal forall (F F' : fieldType) (f : {rmorphism F -> F'}) (x : F), f x != 0 -> f ((1 - 1 / x) * x - x + 1) = 0. Proof. by move=> F F' f x x_neq0; field. Qed. Goal forall (F : fieldType) (x y : F), y != 0 -> y = x -> x / y = 1. Proof. by move=> F x y y_neq0 y_eq_x; field: y_eq_x. Qed. Goal forall (F : fieldType) (x y : F), y != 0 -> y = 1 -> x = 1 -> x / y = 1. Proof. by move=> F x y y_neq0 y_eq1 xeq1; field: y_eq1 xeq1. Qed. (* Using the _%:R embedding from nat to F *) Goal forall (F : fieldType) (n : nat), n%:R != 0 :> F -> (2 * n)%:R / n%:R = 2%:R :> F. Proof. by move=> F n n_neq0; field. Qed. Goal forall (F : fieldType) (x : F), x * 2%:R = (2%:R : F) * x. Proof. by move=> F x; field. Qed. (* For a numFieldType, non-nullity conditions such as 2%:R != 0 should not be *) (* generated. *) Goal forall (F : numFieldType) (x : F), (x / 2%:R) * 2%:R = x. Proof. by move=> F x; field. Qed. Goal forall (F : numFieldType) (n : nat), n != 1%N -> ((n ^ 2)%:R - 1) / (n%:R - 1) = (n%:R + 1) :> F. Proof. by move=> F n n_neq0; field; rewrite subr_eq0 pnatr_eq1. Qed. Goal forall (F : numFieldType) (n : nat), n != 1%N -> (2%:R - (2 * n)%:R) / (1 - n%:R) = 2%:R :> F. Proof. by move=> F n n_neq0; field; rewrite subr_eq0 eq_sym pnatr_eq1. Qed. algebra-tactics-1.2.4/examples/field_examples_check.v000066400000000000000000000002021474420016100226570ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. From mathcomp Require Import ring. Load "field_examples.v". algebra-tactics-1.2.4/examples/field_examples_no_check.v000066400000000000000000000002701474420016100233600ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. From mathcomp Require Import ring. Ltac field_reflection ::= field_reflection_no_check. Load "field_examples.v". algebra-tactics-1.2.4/examples/from_sander.v000066400000000000000000001124071474420016100210530ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. From mathcomp Require Import ring. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Section Polynomials. Variables (R : unitRingType) (x1 x2 x3 y1 y2 y3 : R). Definition f1 := x1^3*x2 - x1*x2^3 - x1^3*x3 + x2^3*x3 + x1*x3^3 - x2*x3^3 - x2*y1^ 2 + x3*y1^2 + x1*y2^2 - x3*y2^2 - x1*y3^2 + x2*y3^2. Definition f2 := 2%:R*x1^6%:R*x2^3 - 6%:R*x1^4%:R*x2^5 + 6%:R*x1^2*x2^7 - 2%:R*x2^9 - 6%:R*x1^6%:R*x2^ 2%:R*x3 + 6%:R*x1^5*x2^3*x3 + 12%:R*x1^4%:R*x2^4%:R*x3 - 12%:R*x1^3*x2^5*x3 - 6%:R*x1^2*x2^6%:R*x3 + 6%:R*x1*x2^7%:R*x3 + 6%:R*x1^6%:R*x2*x3^2 - 18%:R*x1^5*x2^2*x3^2 + 6%:R*x1^4%:R*x2^3*x3^2 + 24%:R*x1^3*x2^4%:R*x3^2 - 18%:R*x1^2*x2^5*x3^2 - 6%:R*x1*x2^6%:R*x3^2 + 6%:R*x2^7%:R*x3^2 - 2%:R*x1^6%:R*x3^3 + 18%:R*x1^5*x2*x3^3 - 30%:R*x1^4%:R*x2^2*x3^3 + 2%:R*x1^3*x2^3*x3^3 + 24%:R*x1^2*x2^4%:R*x3^3 - 12%:R*x1*x2^5*x3^3 - 6%:R*x1^5*x3^4 + 24%:R*x1^4%:R*x2*x3^4 - 30%:R*x1^3*x2^2*x3^4 + 6%:R*x1^2*x2^3*x3^4 + 12%:R*x1*x2^4%:R*x3^4 - 6%:R*x2^5*x3^4 - 6%:R*x1^4%:R*x3^5 + 18%:R*x1^3*x2*x3^5 - 18%:R*x1^2*x2^2*x3^5 + 6%:R*x1*x2^3*x3^5 - 2%:R*x1^3*x3^6 + 6%:R*x1^2*x2*x3^6 - 6%:R*x1*x2^2*x3^6 + 2%:R*x2^3*x3^6 - 3%:R*x1^3*x2^3*y1^2 + 3%:R*x1*x2^5*y1^2 + 9%:R*x1^3*x2^2*x3*y1^2 - 6%:R*x1^2*x2^3*x3*y1^2 - 6%:R*x1*x2^4%:R*x3*y1^2 + 3%:R*x2^5*x3*y1^2 - 9%:R*x1^3*x2*x3^2*y1^2 + 18%:R*x1^2*x2^2*x3^2*y1^2 - 3%:R*x1*x2^3*x3^2*y1^2 - 6%:R*x2^4%:R*x3^2*y1^2 + 3%:R*x1^3*x3^3*y1^2 - 18%:R*x1^2*x2*x3^3*y1^2 + 15%:R*x1*x2^2*x3^3*y1^2 + 6%:R*x1^2*x3^4%:R*y1^2 - 12%:R*x1*x2*x3^4%:R*y1^2 + 6%:R*x2^2*x3^4%:R*y1^2 + 3%:R*x1*x3^5*y1^2 - 3%:R*x2*x3^5*y1^2 + x2^3*y1^4 - 3%:R*x2^2*x3*y1^4 + 3%:R*x2*x3^2*y1^4 - x3^3*y1^4 + 8%:R*x1^3*x2^3*y1*y2 - 2%:R*x1^2*x2^4%:R*y1*y2 - 8%:R*x1*x2^5*y1*y2 + 2%:R*x2^6%:R*y1*y2 - 18%:R*x1^3*x2^2*x3*y1*y2 + 14%:R*x1^2*x2^3*x3*y1*y2 + 8%:R*x1*x2^4%:R*x3*y1*y2 - 4%:R*x2^5*x3*y1*y2 + 12%:R*x1^3*x2*x3^2*y1*y2 - 30%:R*x1^2*x2^2*x3^2*y1*y2 + 12%:R*x1*x2^3*x3^2*y1*y2 + 6%:R*x2^4%:R*x3^2*y1*y2 - 2%:R*x1^3*x3^3*y1*y2 + 26%:R*x1^2*x2*x3^3*y1*y2 - 22%:R*x1*x2^2*x3^3*y1*y2 - 2%:R*x2^3*x3^3*y1*y2 - 8%:R*x1^2*x3^4%:R*y1*y2 + 16%:R*x1*x2*x3^4%:R*y1*y2 - 8%:R*x2^2*x3^4%:R*y1*y2 - 6%:R*x1*x3^5*y1*y2 + 6%:R*x2*x3^5*y1*y2 - 6%:R*x2^3*y1^3*y2 + 12%:R*x2^2*x3*y1^3*y2 - 6%:R*x2*x3^2*y1^3*y2 - 3%:R*x1^5*x2*y2^2 + 2%:R*x1^4%:R*x2^2*y2^2 + 3%:R*x1^3*x2^3*y2^2 - 4%:R*x1^2*x2^4%:R*y2^2 + 2%:R*x2^6%:R*y2^2 + 3%:R*x1^5*x3*y2^2 - 4%:R*x1^4%:R*x2*x3*y2^2 + 4%:R*x1^3*x2^2*x3*y2^2 + x1^2*x2^3*x3*y2^2 - 4%:R*x1*x2^4%:R*x3*y2^2 + 2%:R*x1^4%:R*x3^2*y2^2 - 5%:R*x1^3*x2*x3^2*y2^2 + 6%:R*x1^2*x2^2*x3^2*y2^2 + x1*x2^3*x3^2*y2^2 - 4%:R*x2^4%:R*x3^2*y2^2 - 2%:R*x1^3*x3^3*y2^2 - 5%:R*x1^2*x2*x3^3*y2^2 + 4%:R*x1*x2^2*x3^3*y2^2 + 3%:R*x2^3*x3^3*y2^2 + 2%:R*x1^2*x3^4%:R*y2^2 - 4%:R*x1*x2*x3^4%:R*y2^2 + 2%:R*x2^2*x3^4%:R*y2^2 + 3%:R*x1*x3^5*y2^2 - 3%:R*x2*x3^5*y2^2 + 3%:R*x1^2*x2*y1^2*y2^2 - x1*x2^2*y1^2*y2^2 + 10%:R*x2^3*y1^2*y2^2 - 3%:R*x1^2*x3*y1^2*y2^2 + 2%:R*x1*x2*x3*y1^2*y2^2 - 17%:R*x2^2*x3*y1^2*y2^2 - x1*x3^2*y1^2*y2^2 + x2*x3^2*y1^2*y2^2 + 6%:R*x3^3*y1^2*y2^2 - 2%:R*x1^3*y1*y2^3 - 4%:R*x1^2*x2*y1*y2^3 + 4%:R*x1*x2^2*y1*y2^3 - 8%:R*x2^3*y1*y2^3 + 4%:R*x1^2*x3*y1*y2^3 + 8%:R*x2^2*x3*y1*y2^3 + 2%:R*x1*x3^2*y1*y2^3 + 4%:R*x2*x3^2*y1*y2^3 - 8%:R*x3^3*y1*y2^3 + 2%:R*y1^3*y2^3 + 3%:R*x1^3*y2^4 - 2%:R*x1^2*x2*y2^4 + 2%:R*x2^3*y2^4 - x1^2*x3*y2^4 - 2%:R*x1*x2*x3*y2^4 - x1*x3^2*y2^4 - 2%:R*x2*x3^2*y2^4 + 3%:R*x3^3*y2^4 - 6%:R*y1^2*y2^4 + 6%:R*y1*y2^5 - 2%:R*y2^6 - 6%:R*x1^3*x2^3*y1*y3 + 6%:R*x1^2*x2^4%:R*y1*y3 + 6%:R*x1*x2^5*y1*y3 - 6%:R*x2^6%:R*y1*y3 + 12%:R*x1^3*x2^2*x3*y1*y3 - 18%:R*x1^2*x2^3*x3*y1*y3 + 6%:R*x2^5*x3*y1*y3 - 6%:R*x1^3*x2*x3^2*y1*y3 + 18%:R*x1^2*x2^2*x3^2*y1*y3 - 18%:R*x1*x2^3*x3^2*y1*y3 + 6%:R*x2^4%:R*x3^2*y1*y3 - 6%:R*x1^2*x2*x3^3*y1*y3 + 12%:R*x1*x2^2*x3^3*y1*y3 - 6%:R*x2^3*x3^3*y1*y3 + 4%:R*x2^3*y1^3*y3 - 6%:R*x2^2*x3*y1^3*y3 + 2%:R*x3^3*y1^3*y3 + 6%:R*x1^5*x2*y2*y3 - 8%:R*x1^4%:R*x2^2*y2*y3 - 2%:R*x1^3*x2^3*y2*y3 + 6%:R*x1^2*x2^4%:R*y2*y3 - 4%:R*x1*x2^5*y2*y3 + 2%:R*x2^6%:R*y2*y3 - 6%:R*x1^5*x3*y2*y3 + 16%:R*x1^4%:R*x2*x3*y2*y3 - 22%:R*x1^3*x2^2*x3*y2*y3 + 12%:R*x1^2*x2^3*x3*y2*y3 + 8%:R*x1*x2^4%:R*x3*y2*y3 - 8%:R*x2^5*x3*y2*y3 - 8%:R*x1^4%:R*x3^2*y2*y3 + 26%:R*x1^3*x2*x3^2*y2*y3 - 30%:R*x1^2*x2^2*x3^2*y2*y3 + 14%:R*x1*x2^3*x3^2*y2*y3 - 2%:R*x2^4%:R*x3^2*y2*y3 - 2%:R*x1^3*x3^3*y2*y3 + 12%:R*x1^2*x2*x3^3*y2*y3 - 18%:R*x1*x2^2*x3^3*y2*y3 + 8%:R*x2^3*x3^3*y2*y3 - 6%:R*x1^2*x2*y1^2*y2*y3 + 4%:R*x1*x2^2*y1^2*y2*y3 - 10%:R*x2^3*y1^2*y2*y3 + 6%:R*x1^2*x3*y1^2*y2*y3 - 8%:R*x1*x2*x3*y1^2*y2*y3 + 20%:R*x2^2*x3*y1^2*y2*y3 + 4%:R*x1*x3^2*y1^2*y2*y3 - 4%:R*x2*x3^2*y1^2*y2*y3 - 6%:R*x3^3*y1^2*y2*y3 + 6%:R*x1^3*y1*y2^2*y3 + 8%:R*x1^2*x2*y1*y2^2*y3 - 18%:R*x1*x2^2*y1*y2^2*y3 + 16%:R*x2^3*y1*y2^2*y3 - 8%:R*x1^2*x3*y1*y2^2*y3 + 8%:R*x1*x2*x3*y1*y2^2*y3 - 18%:R*x2^2*x3*y1*y2^2*y3 - 8%:R*x1*x3^2*y1*y2^2*y3 + 8%:R*x2*x3^2*y1*y2^2*y3 + 6%:R*x3^3*y1*y2^2*y3 - 6%:R*y1^3*y2^2*y3 - 8%:R*x1^3*y2^3*y3 + 4%:R*x1^2*x2*y2^3*y3 + 8%:R*x1*x2^2*y2^3*y3 - 8%:R*x2^3*y2^3*y3 + 2%:R*x1^2*x3*y2^3*y3 + 4%:R*x2^2*x3*y2^3*y3 + 4%:R*x1*x3^2*y2^3*y3 - 4%:R*x2*x3^2*y2^3*y3 - 2%:R*x3^3*y2^3*y3 + 18%:R*y1^2*y2^3*y3 - 18%:R*y1*y2^4%:R*y3 + 6%:R*y2^5*y3 - 3%:R*x1^5*x2*y3^2 + 6%:R*x1^4%:R*x2^2*y3^2 - 6%:R*x1^2*x2^4%:R*y3^2 + 3%:R*x1*x2^5*y3^2 + 3%:R*x1^5*x3*y3^2 - 12%:R*x1^4%:R*x2*x3*y3^2 + 15%:R*x1^3*x2^2*x3*y3^2 - 3%:R*x1^2*x2^3*x3*y3^2 - 6%:R*x1*x2^4%:R*x3*y3^2 + 3%:R*x2^5*x3*y3^2 + 6%:R*x1^4%:R*x3^2*y3^2 - 18%:R*x1^3*x2*x3^2*y3^2 + 18%:R*x1^2*x2^2*x3^2*y3^2 - 6%:R*x1*x2^3*x3^2*y3^2 + 3%:R*x1^3*x3^3*y3^2 - 9%:R*x1^2*x2*x3^3*y3^2 + 9%:R*x1*x2^2*x3^3*y3^2 - 3%:R*x2^3*x3^3*y3^2 + 3%:R*x1^2*x2*y1^2*y3^2 - 3%:R*x1*x2^2*y1^2*y3^2 - 3%:R*x1^2*x3*y1^2*y3^2 + 6%:R*x1*x2*x3*y1^2*y3^2 - 3%:R*x2^2*x3*y1^2*y3^2 - 3%:R*x1*x3^2*y1^2*y3^2 + 3%:R*x2*x3^2*y1^2*y3^2 - 6%:R*x1^3*y1*y2*y3^2 - 4%:R*x1^2*x2*y1*y2*y3^2 + 20%:R*x1*x2^2*y1*y2*y3^2 - 10%:R*x2^3*y1*y2*y3^2 + 4%:R*x1^2*x3*y1*y2*y3^2 - 8%:R*x1*x2*x3*y1*y2*y3^2 + 4%:R*x2^2*x3*y1*y2*y3^2 + 6%:R*x1*x3^2*y1*y2*y3^2 - 6%:R*x2*x3^2*y1*y2*y3^2 + 6%:R*y1^3*y2*y3^2 + 6%:R*x1^3*y2^2*y3^2 + x1^2*x2*y2^2*y3^2 - 17%:R*x1*x2^2*y2^2*y3^2 + 10%:R*x2^3*y2^2*y3^2 - x1^2*x3*y2^2*y3^2 + 2%:R*x1*x2*x3*y2^2*y3^2 - x2^2*x3*y2^2*y3^2 - 3%:R*x1*x3^2*y2^2*y3^2 + 3%:R*x2*x3^2*y2^2*y3^2 - 18%:R*y1^2*y2^2*y3^2 + 18%:R*y1*y2^3*y3^2 - 6%:R*y2^4%:R*y3^2 + 2%:R*x1^3*y1*y3^3 - 6%:R*x1*x2^2*y1*y3^3 + 4%:R*x2^3*y1*y3^3 - 2%:R*y1^3*y3^3 - 6%:R*x1^2*x2*y2*y3^3 + 12%:R*x1*x2^2*y2*y3^3 - 6%:R*x2^3*y2*y3^3 + 6%:R*y1^2*y2*y3^3 - 6%:R*y1*y2^2*y3^3 + 2%:R*y2^3*y3^3 - x1^3*y3^4 + 3%:R*x1^2*x2*y3^4 - 3%:R*x1*x2^2*y3^4 + x2^3*y3^4. Definition f3 := 2%:R*x1^9%:R*x2^4 - 8%:R*x1^7%:R*x2^6 + 12%:R*x1^5*x2^8 - 8%:R*x1^3*x2^10 + 2%:R*x1*x2^12 - 8%:R*x1^9%:R*x2^3*x3 + 6%:R*x1^ 8%:R*x2^4%:R*x3 + 24%:R*x1^7%:R*x2^5*x3 - 16%:R*x1^6%:R*x2^6%:R*x3 - 24%:R*x1^5*x2^7%:R*x3 + 12%:R*x1^4%:R*x2^ 8%:R*x3 + 8%:R*x1^3*x2^9%:R*x3 - 2%:R*x2^12%:R*x3 + 12%:R*x1^9%:R*x2^2*x3^2 - 24%:R*x1^ 8%:R*x2^3*x3^2 - 12%:R*x1^7%:R*x2^4%:R*x3^2 + 48%:R*x1^6%:R*x2^5*x3^2 - 12%:R*x1^5*x2^6%:R*x3^2 - 24%:R*x1^4%:R*x2^7%:R*x3^2 + 12%:R*x1^3*x2^ 8%:R*x3^2 - 8%:R*x1^9%:R*x2*x3^3 + 36%:R*x1^ 8%:R*x2^2*x3^3 - 32%:R*x1^7%:R*x2^3*x3^3 - 36%:R*x1^6%:R*x2^4%:R*x3^3 + 48%:R*x1^5*x2^5*x3^3 + 4%:R*x1^4%:R*x2^6%:R*x3^3 - 12%:R*x1^2*x2^ 8%:R*x3^3 - 8%:R*x1*x2^9%:R*x3^3 + 8%:R*x2^10%:R*x3^3 + 2%:R*x1^9%:R*x3^4 - 24%:R*x1^ 8%:R*x2*x3^4 + 48%:R*x1^7%:R*x2^2*x3^4 - 16%:R*x1^6%:R*x2^3*x3^4 - 18%:R*x1^5*x2^4%:R*x3^4 - 4%:R*x1^3*x2^6%:R*x3^4 + 24%:R*x1^2*x2^7%:R*x3^4 - 12%:R*x1*x2^ 8%:R*x3^4 + 6%:R*x1^ 8%:R*x3^5 - 24%:R*x1^7%:R*x2*x3^5 + 24%:R*x1^6%:R*x2^2*x3^5 + 18%:R*x1^4%:R*x2^4%:R*x3^5 - 48%:R*x1^3*x2^5*x3^5 + 12%:R*x1^2*x2^6%:R*x3^5 + 24%:R*x1*x2^7%:R*x3^5 - 12%:R*x2^ 8%:R*x3^5 + 4%:R*x1^7%:R*x3^6 - 24%:R*x1^5*x2^2*x3^6 + 16%:R*x1^4%:R*x2^3*x3^6 + 36%:R*x1^3*x2^4%:R*x3^6 - 48%:R*x1^2*x2^5*x3^6 + 16%:R*x1*x2^6%:R*x3^6 - 4%:R*x1^6%:R*x3^7 + 24%:R*x1^5*x2*x3^7 - 48%:R*x1^4%:R*x2^2*x3^7 + 32%:R*x1^3*x2^3*x3^7 + 12%:R*x1^2*x2^4%:R*x3^7 - 24%:R*x1*x2^5*x3^7 + 8%:R*x2^6%:R*x3^7 - 6%:R*x1^5*x3^8 + 24%:R*x1^4%:R*x2*x3^8 - 36%:R*x1^3*x2^2*x3^8 + 24%:R*x1^2*x2^3*x3^8 - 6%:R*x1*x2^4%:R*x3^8 - 2%:R*x1^4%:R*x3^9 + 8%:R*x1^3*x2*x3^9 - 12%:R*x1^2*x2^2*x3^9 + 8%:R*x1*x2^3*x3^9 - 2%:R*x2^4%:R*x3^9 - 5%:R*x1^6%:R*x2^4%:R*y1^2 + 12%:R*x1^4%:R*x2^6%:R*y1^2 - 9%:R*x1^2*x2^ 8%:R*y1^2 + 2%:R*x2^10%:R*y1^2 + 20%:R*x1^6%:R*x2^3*x3*y1^2 - 12%:R*x1^5*x2^4%:R*x3*y1^2 - 36%:R*x1^4%:R*x2^5*x3*y1^2 + 18%:R*x1^3*x2^6%:R*x3*y1^2 + 18%:R*x1^2*x2^7%:R*x3*y1^2 - 6%:R*x1*x2^ 8%:R*x3*y1^2 - 2%:R*x2^9%:R*x3*y1^2 - 30%:R*x1^6%:R*x2^2*x3^2*y1^2 + 48%:R*x1^5*x2^3*x3^2*y1^2 + 18%:R*x1^4%:R*x2^4%:R*x3^2*y1^2 - 54%:R*x1^3*x2^5*x3^2*y1^2 + 9%:R*x1^2*x2^6%:R*x3^2*y1^2 + 12%:R*x1*x2^7%:R*x3^2*y1^2 - 3%:R*x2^ 8%:R*x3^2*y1^2 + 20%:R*x1^6%:R*x2*x3^3*y1^2 - 72%:R*x1^5*x2^2*x3^3*y1^2 + 48%:R*x1^4%:R*x2^3*x3^3*y1^2 + 40%:R*x1^3*x2^4%:R*x3^3*y1^2 - 36%:R*x1^2*x2^5*x3^3*y1^2 - 5%:R*x1^6%:R*x3^4%:R*y1^2 + 48%:R*x1^5*x2*x3^4%:R*y1^2 - 72%:R*x1^4%:R*x2^2*x3^4%:R*y1^2 + 20%:R*x1^3*x2^3*x3^4%:R*y1^2 + 12%:R*x1^2*x2^4%:R*x3^4%:R*y1^2 - 6%:R*x1*x2^5*x3^4%:R*y1^2 + 3%:R*x2^6%:R*x3^4%:R*y1^2 - 12%:R*x1^5*x3^5*y1^2 + 36%:R*x1^4%:R*x2*x3^5*y1^2 - 30%:R*x1^3*x2^2*x3^5*y1^2 + 6%:R*x1^2*x2^3*x3^5*y1^2 - 6%:R*x1*x2^4%:R*x3^5*y1^2 + 6%:R*x2^5*x3^5*y1^2 - 6%:R*x1^4%:R*x3^6%:R*y1^2 + 2%:R*x1^3*x2*x3^6%:R*y1^2 + 9%:R*x1^2*x2^2*x3^6%:R*y1^2 - 5%:R*x2^4%:R*x3^6%:R*y1^2 + 4%:R*x1^3*x3^7%:R*y1^2 - 12%:R*x1^2*x2*x3^7%:R*y1^2 + 12%:R*x1*x2^2*x3^7%:R*y1^2 - 4%:R*x2^3*x3^7%:R*y1^2 + 3%:R*x1^2*x3^ 8%:R*y1^2 - 6%:R*x1*x2*x3^ 8%:R*y1^2 + 3%:R*x2^2*x3^ 8%:R*y1^2 + 4%:R*x1^3*x2^4%:R*y1^4 - 4%:R*x1*x2^6%:R*y1^4 - 16%:R*x1^3*x2^3*x3*y1^4 + 6%:R*x1^2*x2^4%:R*x3*y1^4 + 12%:R*x1*x2^5*x3*y1^4 - 2%:R*x2^6%:R*x3*y1^4 + 24%:R*x1^3*x2^2*x3^2*y1^4 - 24%:R*x1^2*x2^3*x3^2*y1^4 - 6%:R*x1*x2^4%:R*x3^2*y1^4 + 6%:R*x2^5*x3^2*y1^4 - 16%:R*x1^3*x2*x3^3*y1^4 + 36%:R*x1^2*x2^2*x3^3*y1^4 - 16%:R*x1*x2^3*x3^3*y1^4 - 4%:R*x2^4%:R*x3^3*y1^4 + 4%:R*x1^3*x3^4%:R*y1^4 - 24%:R*x1^2*x2*x3^4%:R*y1^4 + 24%:R*x1*x2^2*x3^4%:R*y1^4 - 4%:R*x2^3*x3^4%:R*y1^4 + 6%:R*x1^2*x3^5*y1^4 - 12%:R*x1*x2*x3^5*y1^4 + 6%:R*x2^2*x3^5*y1^4 + 2%:R*x1*x3^6%:R*y1^4 - 2%:R*x2*x3^6%:R*y1^4 - x2^4%:R*y1^6 + 4%:R*x2^3*x3*y1^6 - 6%:R*x2^2*x3^2*y1^6 + 4%:R*x2*x3^3*y1^6 - x3^4%:R*y1^6 + 8%:R*x1^6%:R*x2^4%:R*y1*y2 - 2%:R*x1^5*x2^5*y1*y2 - 16%:R*x1^4%:R*x2^6%:R*y1*y2 + 4%:R*x1^3*x2^7%:R*y1*y2 + 8%:R*x1^2*x2^ 8%:R*y1*y2 - 2%:R*x1*x2^9%:R*y1*y2 - 26%:R*x1^6%:R*x2^3*x3*y1*y2 + 16%:R*x1^5*x2^4%:R*x3*y1*y2 + 34%:R*x1^4%:R*x2^5*x3*y1*y2 - 12%:R*x1^3*x2^6%:R*x3*y1*y2 - 10%:R*x1^2*x2^7%:R*x3*y1*y2 - 4%:R*x1*x2^ 8%:R*x3*y1*y2 + 2%:R*x2^9%:R*x3*y1*y2 + 30%:R*x1^6%:R*x2^2*x3^2*y1*y2 - 44%:R*x1^5*x2^3*x3^2*y1*y2 - 8%:R*x1^4%:R*x2^4%:R*x3^2*y1*y2 + 22%:R*x1^3*x2^5*x3^2*y1*y2 + 2%:R*x1^2*x2^6%:R*x3^2*y1*y2 + 2%:R*x1*x2^7%:R*x3^2*y1*y2 - 4%:R*x2^ 8%:R*x3^2*y1*y2 - 14%:R*x1^6%:R*x2*x3^3*y1*y2 + 56%:R*x1^5*x2^2*x3^3*y1*y2 - 24%:R*x1^4%:R*x2^3*x3^3*y1*y2 - 32%:R*x1^3*x2^4%:R*x3^3*y1*y2 - 14%:R*x1^2*x2^5*x3^3*y1*y2 + 24%:R*x1*x2^6%:R*x3^3*y1*y2 + 4%:R*x2^7%:R*x3^3*y1*y2 + 2%:R*x1^6%:R*x3^4%:R*y1*y2 - 34%:R*x1^5*x2*x3^4%:R*y1*y2 + 20%:R*x1^4%:R*x2^2*x3^4%:R*y1*y2 + 32%:R*x1^3*x2^3*x3^4%:R*y1*y2 + 4%:R*x1^2*x2^4%:R*x3^4%:R*y1*y2 - 26%:R*x1*x2^5*x3^4%:R*y1*y2 + 2%:R*x2^6%:R*x3^4%:R*y1*y2 + 8%:R*x1^5*x3^5*y1*y2 - 10%:R*x1^4%:R*x2*x3^5*y1*y2 - 28%:R*x1^3*x2^2*x3^5*y1*y2 + 40%:R*x1^2*x2^3*x3^5*y1*y2 + 4%:R*x1*x2^4%:R*x3^5*y1*y2 - 14%:R*x2^5*x3^5*y1*y2 + 4%:R*x1^4%:R*x3^6%:R*y1*y2 + 22%:R*x1^3*x2*x3^6%:R*y1*y2 - 48%:R*x1^2*x2^2*x3^6%:R*y1*y2 + 14%:R*x1*x2^3*x3^6%:R*y1*y2 + 8%:R*x2^4%:R*x3^6%:R*y1*y2 - 8%:R*x1^3*x3^7%:R*y1*y2 + 24%:R*x1^2*x2*x3^7%:R*y1*y2 - 24%:R*x1*x2^2*x3^7%:R*y1*y2 + 8%:R*x2^3*x3^7%:R*y1*y2 - 6%:R*x1^2*x3^ 8%:R*y1*y2 + 12%:R*x1*x2*x3^ 8%:R*y1*y2 - 6%:R*x2^2*x3^ 8%:R*y1*y2 - 14%:R*x1^3*x2^4%:R*y1^3*y2 + 2%:R*x1^2*x2^5*y1^3*y2 + 14%:R*x1*x2^6%:R*y1^3*y2 - 2%:R*x2^7%:R*y1^3*y2 + 44%:R*x1^3*x2^3*x3*y1^3*y2 - 16%:R*x1^2*x2^4%:R*x3*y1^3*y2 - 28%:R*x1*x2^5*x3*y1^3*y2 - 48%:R*x1^3*x2^2*x3^2*y1^3*y2 + 44%:R*x1^2*x2^3*x3^2*y1^3*y2 + 2%:R*x1*x2^4%:R*x3^2*y1^3*y2 + 2%:R*x2^5*x3^2*y1^3*y2 + 20%:R*x1^3*x2*x3^3*y1^3*y2 - 56%:R*x1^2*x2^2*x3^3*y1^3*y2 + 28%:R*x1*x2^3*x3^3*y1^3*y2 + 8%:R*x2^4%:R*x3^3*y1^3*y2 - 2%:R*x1^3*x3^4%:R*y1^3*y2 + 34%:R*x1^2*x2*x3^4%:R*y1^3*y2 - 26%:R*x1*x2^2*x3^4%:R*y1^3*y2 - 6%:R*x2^3*x3^4%:R*y1^3*y2 - 8%:R*x1^2*x3^5*y1^3*y2 + 16%:R*x1*x2*x3^5*y1^3*y2 - 8%:R*x2^2*x3^5*y1^3*y2 - 6%:R*x1*x3^6%:R*y1^3*y2 + 6%:R*x2*x3^6%:R*y1^3*y2 + 6%:R*x2^4%:R*y1^5*y2 - 18%:R*x2^3*x3*y1^5*y2 + 18%:R*x2^2*x3^2*y1^5*y2 - 6%:R*x2*x3^3*y1^5*y2 - 3%:R*x1^ 8%:R*x2^2*y2^2 + 4%:R*x1^7%:R*x2^3*y2^2 + 6%:R*x1^6%:R*x2^4%:R*y2^2 - 12%:R*x1^5*x2^5*y2^2 - 3%:R*x1^4%:R*x2^6%:R*y2^2 + 12%:R*x1^3*x2^7%:R*y2^2 - 4%:R*x1*x2^9%:R*y2^2 + 6%:R*x1^ 8%:R*x2*x3*y2^2 - 12%:R*x1^7%:R*x2^2*x3*y2^2 + 2%:R*x1^6%:R*x2^3*x3*y2^2 + 18%:R*x1^5*x2^4%:R*x3*y2^2 - 12%:R*x1^4%:R*x2^5*x3*y2^2 - 6%:R*x1^3*x2^6%:R*x3*y2^2 + 4%:R*x2^9%:R*x3*y2^2 - 3%:R*x1^ 8%:R*x3^2*y2^2 + 12%:R*x1^7%:R*x2*x3^2*y2^2 - 21%:R*x1^6%:R*x2^2*x3^2*y2^2 + 6%:R*x1^5*x2^3*x3^2*y2^2 + 18%:R*x1^4%:R*x2^4%:R*x3^2*y2^2 - 12%:R*x1^3*x2^5*x3^2*y2^2 - 4%:R*x1^7%:R*x3^3*y2^2 + 12%:R*x1^6%:R*x2*x3^3*y2^2 - 18%:R*x1^5*x2^2*x3^3*y2^2 + 4%:R*x1^4%:R*x2^3*x3^3*y2^2 + 12%:R*x1^2*x2^5*x3^3*y2^2 + 6%:R*x1*x2^6%:R*x3^3*y2^2 - 12%:R*x2^7%:R*x3^3*y2^2 + x1^6%:R*x3^4%:R*y2^2 + 6%:R*x1^5*x2*x3^4%:R*y2^2 - 4%:R*x1^3*x2^3*x3^4%:R*y2^2 - 18%:R*x1^2*x2^4%:R*x3^4%:R*y2^2 + 12%:R*x1*x2^5*x3^4%:R*y2^2 + 3%:R*x2^6%:R*x3^4%:R*y2^2 - 6%:R*x1^4%:R*x2*x3^5*y2^2 + 18%:R*x1^3*x2^2*x3^5*y2^2 - 6%:R*x1^2*x2^3*x3^5*y2^2 - 18%:R*x1*x2^4%:R*x3^5*y2^2 + 12%:R*x2^5*x3^5*y2^2 - x1^4%:R*x3^6%:R*y2^2 - 12%:R*x1^3*x2*x3^6%:R*y2^2 + 21%:R*x1^2*x2^2*x3^6%:R*y2^2 - 2%:R*x1*x2^3*x3^6%:R*y2^2 - 6%:R*x2^4%:R*x3^6%:R*y2^2 + 4%:R*x1^3*x3^7%:R*y2^2 - 12%:R*x1^2*x2*x3^7%:R*y2^2 + 12%:R*x1*x2^2*x3^7%:R*y2^2 - 4%:R*x2^3*x3^7%:R*y2^2 + 3%:R*x1^2*x3^ 8%:R*y2^2 - 6%:R*x1*x2*x3^ 8%:R*y2^2 + 3%:R*x2^2*x3^ 8%:R*y2^2 + 6%:R*x1^5*x2^2*y1^2*y2^2 - 6%:R*x1^4%:R*x2^3*y1^2*y2^2 + 4%:R*x1^3*x2^4%:R*y1^2*y2^2 + 8%:R*x1^2*x2^5*y1^2*y2^2 - 10%:R*x1*x2^6%:R*y1^2*y2^2 - 2%:R*x2^7%:R*y1^2*y2^2 - 12%:R*x1^5*x2*x3*y1^2*y2^2 + 18%:R*x1^4%:R*x2^2*x3*y1^2*y2^2 - 28%:R*x1^3*x2^3*x3*y1^2*y2^2 - 10%:R*x1^2*x2^4%:R*x3*y1^2*y2^2 + 20%:R*x1*x2^5*x3*y1^2*y2^2 + 12%:R*x2^6%:R*x3*y1^2*y2^2 + 6%:R*x1^5*x3^2*y1^2*y2^2 - 18%:R*x1^4%:R*x2*x3^2*y1^2*y2^2 + 36%:R*x1^3*x2^2*x3^2*y1^2*y2^2 - 4%:R*x1^2*x2^3*x3^2*y1^2*y2^2 - 4%:R*x1*x2^4%:R*x3^2*y1^2*y2^2 - 16%:R*x2^5*x3^2*y1^2*y2^2 + 6%:R*x1^4%:R*x3^3*y1^2*y2^2 - 4%:R*x1^3*x2*x3^3*y1^2*y2^2 + 4%:R*x1^2*x2^2*x3^3*y1^2*y2^2 + 4%:R*x1*x2^3*x3^3*y1^2*y2^2 - 10%:R*x2^4%:R*x3^3*y1^2*y2^2 - 8%:R*x1^3*x3^4%:R*y1^2*y2^2 + 4%:R*x1^2*x2*x3^4%:R*y1^2*y2^2 - 20%:R*x1*x2^2*x3^4%:R*y1^2*y2^2 + 24%:R*x2^3*x3^4%:R*y1^2*y2^2 - 2%:R*x1^2*x3^5*y1^2*y2^2 + 4%:R*x1*x2*x3^5*y1^2*y2^2 - 2%:R*x2^2*x3^5*y1^2*y2^2 + 6%:R*x1*x3^6%:R*y1^2*y2^2 - 6%:R*x2*x3^6%:R*y1^2*y2^2 - 3%:R*x1^2*x2^2*y1^4%:R*y2^2 + 2%:R*x1*x2^3*y1^4%:R*y2^2 - 10%:R*x2^4%:R*y1^4%:R*y2^2 + 6%:R*x1^2*x2*x3*y1^4%:R*y2^2 - 6%:R*x1*x2^2*x3*y1^4%:R*y2^2 + 26%:R*x2^3*x3*y1^4%:R*y2^2 - 3%:R*x1^2*x3^2*y1^4%:R*y2^2 + 6%:R*x1*x2*x3^2*y1^4%:R*y2^2 - 15%:R*x2^2*x3^2*y1^4%:R*y2^2 - 2%:R*x1*x3^3*y1^4%:R*y2^2 - 8%:R*x2*x3^3*y1^4%:R*y2^2 + 7%:R*x3^4%:R*y1^4%:R*y2^2 - 2%:R*x1^6%:R*x2*y1*y2^3 - 4%:R*x1^5*x2^2*y1*y2^3 + 14%:R*x1^4%:R*x2^3*y1*y2^3 - 6%:R*x1^3*x2^4%:R*y1*y2^3 - 12%:R*x1^2*x2^5*y1*y2^3 + 10%:R*x1*x2^6%:R*y1*y2^3 + 2%:R*x1^6%:R*x3*y1*y2^3 + 8%:R*x1^5*x2*x3*y1*y2^3 - 22%:R*x1^4%:R*x2^2*x3*y1*y2^3 + 16%:R*x1^3*x2^3*x3*y1*y2^3 + 6%:R*x1^2*x2^4%:R*x3*y1*y2^3 - 10%:R*x2^6%:R*x3*y1*y2^3 - 4%:R*x1^5*x3^2*y1*y2^3 + 14%:R*x1^4%:R*x2*x3^2*y1*y2^3 - 16%:R*x1^3*x2^2*x3^2*y1*y2^3 - 6%:R*x1*x2^4%:R*x3^2*y1*y2^3 + 12%:R*x2^5*x3^2*y1*y2^3 - 6%:R*x1^4%:R*x3^3*y1*y2^3 + 16%:R*x1^2*x2^2*x3^3*y1*y2^3 - 16%:R*x1*x2^3*x3^3*y1*y2^3 + 6%:R*x2^4%:R*x3^3*y1*y2^3 + 6%:R*x1^3*x3^4%:R*y1*y2^3 - 14%:R*x1^2*x2*x3^4%:R*y1*y2^3 + 22%:R*x1*x2^2*x3^4%:R*y1*y2^3 - 14%:R*x2^3*x3^4%:R*y1*y2^3 + 4%:R*x1^2*x3^5*y1*y2^3 - 8%:R*x1*x2*x3^5*y1*y2^3 + 4%:R*x2^2*x3^5*y1*y2^3 - 2%:R*x1*x3^6%:R*y1*y2^3 + 2%:R*x2*x3^6%:R*y1*y2^3 + 4%:R*x1^3*x2*y1^3*y2^3 + 4%:R*x1^2*x2^2*y1^3*y2^3 - 12%:R*x1*x2^3*y1^3*y2^3 + 8%:R*x2^4%:R*y1^3*y2^3 - 4%:R*x1^3*x3*y1^3*y2^3 - 8%:R*x1^2*x2*x3*y1^3*y2^3 + 16%:R*x1*x2^2*x3*y1^3*y2^3 - 8%:R*x2^3*x3*y1^3*y2^3 + 4%:R*x1^2*x3^2*y1^3*y2^3 - 8%:R*x1*x2*x3^2*y1^3*y2^3 - 8%:R*x2^2*x3^2*y1^3*y2^3 + 4%:R*x1*x3^3*y1^3*y2^3 + 16%:R*x2*x3^3*y1^3*y2^3 - 8%:R*x3^4%:R*y1^3*y2^3 - 2%:R*x2*y1^5*y2^3 + 2%:R*x3*y1^5*y2^3 - 6%:R*x1^3*x2*y1^2*y2^4 + x1^2*x2^2*y1^2*y2^4 + 16%:R*x1*x2^3*y1^2*y2^4 - 2%:R*x2^4%:R*y1^2*y2^4 + 6%:R*x1^3*x3*y1^2*y2^4 - 2%:R*x1^2*x2*x3*y1^2*y2^4 - 14%:R*x1*x2^2*x3*y1^2*y2^4 - 14%:R*x2^3*x3*y1^2*y2^4 + x1^2*x3^2*y1^2*y2^4 - 2%:R*x1*x2*x3^2*y1^2*y2^4 + 19%:R*x2^2*x3^2*y1^2*y2^4 - 3%:R*x3^4%:R*y1^2*y2^4 + 6%:R*x2*y1^4%:R*y2^4 - 6%:R*x3*y1^4%:R*y2^4 - 2%:R*x1^4%:R*y1*y2^5 + 2%:R*x1^3*x2*y1*y2^5 + 4%:R*x1^2*x2^2*y1*y2^5 - 14%:R*x1*x2^3*y1*y2^5 + 4%:R*x1^2*x2*x3*y1*y2^5 + 4%:R*x1*x2^2*x3*y1*y2^5 + 14%:R*x2^3*x3*y1*y2^5 - 2%:R*x1^2*x3^2*y1*y2^5 + 4%:R*x1*x2*x3^2*y1*y2^5 - 8%:R*x2^2*x3^2*y1*y2^5 - 4%:R*x1*x3^3*y1*y2^5 - 10%:R*x2*x3^3*y1*y2^5 + 8%:R*x3^4%:R*y1*y2^5 + 2%:R*x1*y1^3*y2^5 - 6%:R*x2*y1^3*y2^5 + 4%:R*x3*y1^3*y2^5 + 3%:R*x1^4%:R*y2^6 - 4%:R*x1^3*x2*y2^6 + 4%:R*x1*x2^3*y2^6 - 2%:R*x1^3*x3*y2^6 - 4%:R*x2^3*x3*y2^6 + 2%:R*x1*x3^3*y2^6 + 4%:R*x2*x3^3*y2^6 - 3%:R*x3^4%:R*y2^6 - 6%:R*x1*y1^2*y2^6 + 2%:R*x2*y1^2*y2^6 + 4%:R*x3*y1^2*y2^6 + 6%:R*x1*y1*y2^7 - 6%:R*x3*y1*y2^7 - 2%:R*x1*y2^8 + 2%:R*x3*y2^8 - 6%:R*x1^6%:R*x2^4%:R*y1*y3 + 6%:R*x1^5*x2^5*y1*y3 + 12%:R*x1^4%:R*x2^6%:R*y1*y3 - 12%:R*x1^3*x2^7%:R*y1*y3 - 6%:R*x1^2*x2^ 8%:R*y1*y3 + 6%:R*x1*x2^9%:R*y1*y3 + 18%:R*x1^6%:R*x2^3*x3*y1*y3 - 24%:R*x1^5*x2^4%:R*x3*y1*y3 - 18%:R*x1^4%:R*x2^5*x3*y1*y3 + 24%:R*x1^3*x2^6%:R*x3*y1*y3 + 6%:R*x1^2*x2^7%:R*x3*y1*y3 - 6%:R*x2^9%:R*x3*y1*y3 - 18%:R*x1^6%:R*x2^2*x3^2*y1*y3 + 36%:R*x1^5*x2^3*x3^2*y1*y3 - 12%:R*x1^4%:R*x2^4%:R*x3^2*y1*y3 - 6%:R*x1^3*x2^5*x3^2*y1*y3 - 6%:R*x1*x2^7%:R*x3^2*y1*y3 + 6%:R*x2^ 8%:R*x3^2*y1*y3 + 6%:R*x1^6%:R*x2*x3^3*y1*y3 - 24%:R*x1^5*x2^2*x3^3*y1*y3 + 24%:R*x1^4%:R*x2^3*x3^3*y1*y3 + 6%:R*x1^2*x2^5*x3^3*y1*y3 - 24%:R*x1*x2^6%:R*x3^3*y1*y3 + 12%:R*x2^7%:R*x3^3*y1*y3 + 6%:R*x1^5*x2*x3^4%:R*y1*y3 - 24%:R*x1^3*x2^3*x3^4%:R*y1*y3 + 12%:R*x1^2*x2^4%:R*x3^4%:R*y1*y3 + 18%:R*x1*x2^5*x3^4%:R*y1*y3 - 12%:R*x2^6%:R*x3^4%:R*y1*y3 - 6%:R*x1^4%:R*x2*x3^5*y1*y3 + 24%:R*x1^3*x2^2*x3^5*y1*y3 - 36%:R*x1^2*x2^3*x3^5*y1*y3 + 24%:R*x1*x2^4%:R*x3^5*y1*y3 - 6%:R*x2^5*x3^5*y1*y3 - 6%:R*x1^3*x2*x3^6%:R*y1*y3 + 18%:R*x1^2*x2^2*x3^6%:R*y1*y3 - 18%:R*x1*x2^3*x3^6%:R*y1*y3 + 6%:R*x2^4%:R*x3^6%:R*y1*y3 + 10%:R*x1^3*x2^4%:R*y1^3*y3 - 6%:R*x1^2*x2^5*y1^3*y3 - 10%:R*x1*x2^6%:R*y1^3*y3 + 6%:R*x2^7%:R*y1^3*y3 - 28%:R*x1^3*x2^3*x3*y1^3*y3 + 24%:R*x1^2*x2^4%:R*x3*y1^3*y3 + 12%:R*x1*x2^5*x3*y1^3*y3 - 8%:R*x2^6%:R*x3*y1^3*y3 + 24%:R*x1^3*x2^2*x3^2*y1^3*y3 - 36%:R*x1^2*x2^3*x3^2*y1^3*y3 + 18%:R*x1*x2^4%:R*x3^2*y1^3*y3 - 6%:R*x2^5*x3^2*y1^3*y3 - 4%:R*x1^3*x2*x3^3*y1^3*y3 + 24%:R*x1^2*x2^2*x3^3*y1^3*y3 - 28%:R*x1*x2^3*x3^3*y1^3*y3 + 8%:R*x2^4%:R*x3^3*y1^3*y3 - 2%:R*x1^3*x3^4%:R*y1^3*y3 - 6%:R*x1^2*x2*x3^4%:R*y1^3*y3 + 6%:R*x1*x2^2*x3^4%:R*y1^3*y3 + 2%:R*x2^3*x3^4%:R*y1^3*y3 + 2%:R*x1*x3^6%:R*y1^3*y3 - 2%:R*x2*x3^6%:R*y1^3*y3 - 4%:R*x2^4%:R*y1^5*y3 + 10%:R*x2^3*x3*y1^5*y3 - 6%:R*x2^2*x3^2*y1^5*y3 - 2%:R*x2*x3^3*y1^5*y3 + 2%:R*x3^4%:R*y1^5*y3 + 6%:R*x1^ 8%:R*x2^2*y2*y3 - 8%:R*x1^7%:R*x2^3*y2*y3 - 8%:R*x1^6%:R*x2^4%:R*y2*y3 + 14%:R*x1^5*x2^5*y2*y3 - 2%:R*x1^4%:R*x2^6%:R*y2*y3 - 4%:R*x1^3*x2^7%:R*y2*y3 + 4%:R*x1^2*x2^ 8%:R*y2*y3 - 2%:R*x1*x2^9%:R*y2*y3 - 12%:R*x1^ 8%:R*x2*x3*y2*y3 + 24%:R*x1^7%:R*x2^2*x3*y2*y3 - 14%:R*x1^6%:R*x2^3*x3*y2*y3 - 4%:R*x1^5*x2^4%:R*x3*y2*y3 + 26%:R*x1^4%:R*x2^5*x3*y2*y3 - 24%:R*x1^3*x2^6%:R*x3*y2*y3 - 2%:R*x1^2*x2^7%:R*x3*y2*y3 + 4%:R*x1*x2^ 8%:R*x3*y2*y3 + 2%:R*x2^9%:R*x3*y2*y3 + 6%:R*x1^ 8%:R*x3^2*y2*y3 - 24%:R*x1^7%:R*x2*x3^2*y2*y3 + 48%:R*x1^6%:R*x2^2*x3^2*y2*y3 - 40%:R*x1^5*x2^3*x3^2*y2*y3 - 4%:R*x1^4%:R*x2^4%:R*x3^2*y2*y3 + 14%:R*x1^3*x2^5*x3^2*y2*y3 - 2%:R*x1^2*x2^6%:R*x3^2*y2*y3 + 10%:R*x1*x2^7%:R*x3^2*y2*y3 - 8%:R*x2^ 8%:R*x3^2*y2*y3 + 8%:R*x1^7%:R*x3^3*y2*y3 - 22%:R*x1^6%:R*x2*x3^3*y2*y3 + 28%:R*x1^5*x2^2*x3^3*y2*y3 - 32%:R*x1^4%:R*x2^3*x3^3*y2*y3 + 32%:R*x1^3*x2^4%:R*x3^3*y2*y3 - 22%:R*x1^2*x2^5*x3^3*y2*y3 + 12%:R*x1*x2^6%:R*x3^3*y2*y3 - 4%:R*x2^7%:R*x3^3*y2*y3 - 4%:R*x1^6%:R*x3^4%:R*y2*y3 + 10%:R*x1^5*x2*x3^4%:R*y2*y3 - 20%:R*x1^4%:R*x2^2*x3^4%:R*y2*y3 + 24%:R*x1^3*x2^3*x3^4%:R*y2*y3 + 8%:R*x1^2*x2^4%:R*x3^4%:R*y2*y3 - 34%:R*x1*x2^5*x3^4%:R*y2*y3 + 16%:R*x2^6%:R*x3^4%:R*y2*y3 - 8%:R*x1^5*x3^5*y2*y3 + 34%:R*x1^4%:R*x2*x3^5*y2*y3 - 56%:R*x1^3*x2^2*x3^5*y2*y3 + 44%:R*x1^2*x2^3*x3^5*y2*y3 - 16%:R*x1*x2^4%:R*x3^5*y2*y3 + 2%:R*x2^5*x3^5*y2*y3 - 2%:R*x1^4%:R*x3^6%:R*y2*y3 + 14%:R*x1^3*x2*x3^6%:R*y2*y3 - 30%:R*x1^2*x2^2*x3^6%:R*y2*y3 + 26%:R*x1*x2^3*x3^6%:R*y2*y3 - 8%:R*x2^4%:R*x3^6%:R*y2*y3 - 12%:R*x1^5*x2^2*y1^2*y2*y3 + 12%:R*x1^4%:R*x2^3*y1^2*y2*y3 - 2%:R*x1^3*x2^4%:R*y1^2*y2*y3 - 10%:R*x1^2*x2^5*y1^2*y2*y3 + 14%:R*x1*x2^6%:R*y1^2*y2*y3 - 2%:R*x2^7%:R*y1^2*y2*y3 + 24%:R*x1^5*x2*x3*y1^2*y2*y3 - 36%:R*x1^4%:R*x2^2*x3*y1^2*y2*y3 + 44%:R*x1^3*x2^3*x3*y1^2*y2*y3 - 4%:R*x1^2*x2^4%:R*x3*y1^2*y2*y3 - 28%:R*x1*x2^5*x3*y1^2*y2*y3 - 12%:R*x1^5*x3^2*y1^2*y2*y3 + 36%:R*x1^4%:R*x2*x3^2*y1^2*y2*y3 - 72%:R*x1^3*x2^2*x3^2*y1^2*y2*y3 + 44%:R*x1^2*x2^3*x3^2*y1^2*y2*y3 - 10%:R*x1*x2^4%:R*x3^2*y1^2*y2*y3 + 14%:R*x2^5*x3^2*y1^2*y2*y3 - 12%:R*x1^4%:R*x3^3*y1^2*y2*y3 + 20%:R*x1^3*x2*x3^3*y1^2*y2*y3 - 32%:R*x1^2*x2^2*x3^3*y1^2*y2*y3 + 28%:R*x1*x2^3*x3^3*y1^2*y2*y3 - 4%:R*x2^4%:R*x3^3*y1^2*y2*y3 + 10%:R*x1^3*x3^4%:R*y1^2*y2*y3 - 2%:R*x1^2*x2*x3^4%:R*y1^2*y2*y3 + 10%:R*x1*x2^2*x3^4%:R*y1^2*y2*y3 - 18%:R*x2^3*x3^4%:R*y1^2*y2*y3 + 4%:R*x1^2*x3^5*y1^2*y2*y3 - 8%:R*x1*x2*x3^5*y1^2*y2*y3 + 4%:R*x2^2*x3^5*y1^2*y2*y3 - 6%:R*x1*x3^6%:R*y1^2*y2*y3 + 6%:R*x2*x3^6%:R*y1^2*y2*y3 + 6%:R*x1^2*x2^2*y1^4%:R*y2*y3 - 4%:R*x1*x2^3*y1^4%:R*y2*y3 + 10%:R*x2^4%:R*y1^4%:R*y2*y3 - 12%:R*x1^2*x2*x3*y1^4%:R*y2*y3 + 12%:R*x1*x2^2*x3*y1^4%:R*y2*y3 - 30%:R*x2^3*x3*y1^4%:R*y2*y3 + 6%:R*x1^2*x3^2*y1^4%:R*y2*y3 - 12%:R*x1*x2*x3^2*y1^4%:R*y2*y3 + 24%:R*x2^2*x3^2*y1^4%:R*y2*y3 + 4%:R*x1*x3^3*y1^4%:R*y2*y3 + 2%:R*x2*x3^3*y1^4%:R*y2*y3 - 6%:R*x3^4%:R*y1^4%:R*y2*y3 + 6%:R*x1^6%:R*x2*y1*y2^2*y3 + 8%:R*x1^5*x2^2*y1*y2^2*y3 - 30%:R*x1^4%:R*x2^3*y1*y2^2*y3 + 14%:R*x1^3*x2^4%:R*y1*y2^2*y3 + 24%:R*x1^2*x2^5*y1*y2^2*y3 - 22%:R*x1*x2^6%:R*y1*y2^2*y3 - 6%:R*x1^6%:R*x3*y1*y2^2*y3 - 16%:R*x1^5*x2*x3*y1*y2^2*y3 + 38%:R*x1^4%:R*x2^2*x3*y1*y2^2*y3 - 32%:R*x1^3*x2^3*x3*y1*y2^2*y3 - 6%:R*x1^2*x2^4%:R*x3*y1*y2^2*y3 + 22%:R*x2^6%:R*x3*y1*y2^2*y3 + 8%:R*x1^5*x3^2*y1*y2^2*y3 - 22%:R*x1^4%:R*x2*x3^2*y1*y2^2*y3 + 32%:R*x1^3*x2^2*x3^2*y1*y2^2*y3 + 6%:R*x1*x2^4%:R*x3^2*y1*y2^2*y3 - 24%:R*x2^5*x3^2*y1*y2^2*y3 + 14%:R*x1^4%:R*x3^3*y1*y2^2*y3 - 32%:R*x1^2*x2^2*x3^3*y1*y2^2*y3 + 32%:R*x1*x2^3*x3^3*y1*y2^2*y3 - 14%:R*x2^4%:R*x3^3*y1*y2^2*y3 - 14%:R*x1^3*x3^4%:R*y1*y2^2*y3 + 22%:R*x1^2*x2*x3^4%:R*y1*y2^2*y3 - 38%:R*x1*x2^2*x3^4%:R*y1*y2^2*y3 + 30%:R*x2^3*x3^4%:R*y1*y2^2*y3 - 8%:R*x1^2*x3^5*y1*y2^2*y3 + 16%:R*x1*x2*x3^5*y1*y2^2*y3 - 8%:R*x2^2*x3^5*y1*y2^2*y3 + 6%:R*x1*x3^6%:R*y1*y2^2*y3 - 6%:R*x2*x3^6%:R*y1*y2^2*y3 - 12%:R*x1^3*x2*y1^3*y2^2*y3 - 8%:R*x1^2*x2^2*y1^3*y2^2*y3 + 28%:R*x1*x2^3*y1^3*y2^2*y3 - 16%:R*x2^4%:R*y1^3*y2^2*y3 + 12%:R*x1^3*x3*y1^3*y2^2*y3 + 16%:R*x1^2*x2*x3*y1^3*y2^2*y3 - 32%:R*x1*x2^2*x3*y1^3*y2^2*y3 + 24%:R*x2^3*x3*y1^3*y2^2*y3 - 8%:R*x1^2*x3^2*y1^3*y2^2*y3 + 16%:R*x1*x2*x3^2*y1^3*y2^2*y3 - 20%:R*x2^2*x3^2*y1^3*y2^2*y3 - 12%:R*x1*x3^3*y1^3*y2^2*y3 + 8%:R*x2*x3^3*y1^3*y2^2*y3 + 4%:R*x3^4%:R*y1^3*y2^2*y3 + 6%:R*x2*y1^5*y2^2*y3 - 6%:R*x3*y1^5*y2^2*y3 - 2%:R*x1^6%:R*x2*y2^3*y3 - 4%:R*x1^5*x2^2*y2^3*y3 + 14%:R*x1^4%:R*x2^3*y2^3*y3 - 6%:R*x1^3*x2^4%:R*y2^3*y3 - 12%:R*x1^2*x2^5*y2^3*y3 + 10%:R*x1*x2^6%:R*y2^3*y3 + 2%:R*x1^6%:R*x3*y2^3*y3 + 8%:R*x1^5*x2*x3*y2^3*y3 - 22%:R*x1^4%:R*x2^2*x3*y2^3*y3 + 16%:R*x1^3*x2^3*x3*y2^3*y3 + 6%:R*x1^2*x2^4%:R*x3*y2^3*y3 - 10%:R*x2^6%:R*x3*y2^3*y3 - 4%:R*x1^5*x3^2*y2^3*y3 + 14%:R*x1^4%:R*x2*x3^2*y2^3*y3 - 16%:R*x1^3*x2^2*x3^2*y2^3*y3 - 6%:R*x1*x2^4%:R*x3^2*y2^3*y3 + 12%:R*x2^5*x3^2*y2^3*y3 - 6%:R*x1^4%:R*x3^3*y2^3*y3 + 16%:R*x1^2*x2^2*x3^3*y2^3*y3 - 16%:R*x1*x2^3*x3^3*y2^3*y3 + 6%:R*x2^4%:R*x3^3*y2^3*y3 + 6%:R*x1^3*x3^4%:R*y2^3*y3 - 14%:R*x1^2*x2*x3^4%:R*y2^3*y3 + 22%:R*x1*x2^2*x3^4%:R*y2^3*y3 - 14%:R*x2^3*x3^4%:R*y2^3*y3 + 4%:R*x1^2*x3^5*y2^3*y3 - 8%:R*x1*x2*x3^5*y2^3*y3 + 4%:R*x2^2*x3^5*y2^3*y3 - 2%:R*x1*x3^6%:R*y2^3*y3 + 2%:R*x2*x3^6%:R*y2^3*y3 + 20%:R*x1^3*x2*y1^2*y2^3*y3 - 36%:R*x1*x2^3*y1^2*y2^3*y3 + 8%:R*x2^4%:R*y1^2*y2^3*y3 - 20%:R*x1^3*x3*y1^2*y2^3*y3 + 24%:R*x1*x2^2*x3*y1^2*y2^3*y3 + 16%:R*x2^3*x3*y1^2*y2^3*y3 - 12%:R*x2^2*x3^2*y1^2*y2^3*y3 + 12%:R*x1*x3^3*y1^2*y2^3*y3 - 16%:R*x2*x3^3*y1^2*y2^3*y3 + 4%:R*x3^4%:R*y1^2*y2^3*y3 - 18%:R*x2*y1^4%:R*y2^3*y3 + 18%:R*x3*y1^4%:R*y2^3*y3 + 6%:R*x1^4%:R*y1*y2^4%:R*y3 - 10%:R*x1^3*x2*y1*y2^4%:R*y3 - 18%:R*x1^2*x2^2*y1*y2^4%:R*y3 + 34%:R*x1*x2^3*y1*y2^4%:R*y3 + 4%:R*x1^3*x3*y1*y2^4%:R*y3 - 34%:R*x2^3*x3*y1*y2^4%:R*y3 + 18%:R*x2^2*x3^2*y1*y2^4%:R*y3 - 4%:R*x1*x3^3*y1*y2^4%:R*y3 + 10%:R*x2*x3^3*y1*y2^4%:R*y3 - 6%:R*x3^4%:R*y1*y2^4%:R*y3 - 6%:R*x1*y1^3*y2^4%:R*y3 + 18%:R*x2*y1^3*y2^4%:R*y3 - 12%:R*x3*y1^3*y2^4%:R*y3 - 8%:R*x1^4%:R*y2^5*y3 + 10%:R*x1^3*x2*y2^5*y3 + 8%:R*x1^2*x2^2*y2^5*y3 - 14%:R*x1*x2^3*y2^5*y3 + 4%:R*x1^3*x3*y2^5*y3 - 4%:R*x1^2*x2*x3*y2^5*y3 - 4%:R*x1*x2^2*x3*y2^5*y3 + 14%:R*x2^3*x3*y2^5*y3 + 2%:R*x1^2*x3^2*y2^5*y3 - 4%:R*x1*x2*x3^2*y2^5*y3 - 4%:R*x2^2*x3^2*y2^5*y3 - 2%:R*x2*x3^3*y2^5*y3 + 2%:R*x3^4%:R*y2^5*y3 + 18%:R*x1*y1^2*y2^5*y3 - 6%:R*x2*y1^2*y2^5*y3 - 12%:R*x3*y1^2*y2^5*y3 - 18%:R*x1*y1*y2^6%:R*y3 + 18%:R*x3*y1*y2^6%:R*y3 + 6%:R*x1*y2^7%:R*y3 - 6%:R*x3*y2^7%:R*y3 - 3%:R*x1^ 8%:R*x2^2*y3^2 + 4%:R*x1^7%:R*x2^3*y3^2 + 5%:R*x1^6%:R*x2^4%:R*y3^2 - 6%:R*x1^5*x2^5*y3^2 - 3%:R*x1^4%:R*x2^6%:R*y3^2 + 3%:R*x1^2*x2^ 8%:R*y3^2 + 2%:R*x1*x2^9%:R*y3^2 - 2%:R*x2^10%:R*y3^2 + 6%:R*x1^ 8%:R*x2*x3*y3^2 - 12%:R*x1^7%:R*x2^2*x3*y3^2 + 6%:R*x1^5*x2^4%:R*x3*y3^2 + 6%:R*x1^4%:R*x2^5*x3*y3^2 - 12%:R*x1^2*x2^7%:R*x3*y3^2 + 6%:R*x1*x2^ 8%:R*x3*y3^2 - 3%:R*x1^ 8%:R*x3^2*y3^2 + 12%:R*x1^7%:R*x2*x3^2*y3^2 - 9%:R*x1^6%:R*x2^2*x3^2*y3^2 - 6%:R*x1^5*x2^3*x3^2*y3^2 - 12%:R*x1^4%:R*x2^4%:R*x3^2*y3^2 + 36%:R*x1^3*x2^5*x3^2*y3^2 - 9%:R*x1^2*x2^6%:R*x3^2*y3^2 - 18%:R*x1*x2^7%:R*x3^2*y3^2 + 9%:R*x2^ 8%:R*x3^2*y3^2 - 4%:R*x1^7%:R*x3^3*y3^2 - 2%:R*x1^6%:R*x2*x3^3*y3^2 + 30%:R*x1^5*x2^2*x3^3*y3^2 - 20%:R*x1^4%:R*x2^3*x3^3*y3^2 - 40%:R*x1^3*x2^4%:R*x3^3*y3^2 + 54%:R*x1^2*x2^5*x3^3*y3^2 - 18%:R*x1*x2^6%:R*x3^3*y3^2 + 6%:R*x1^6%:R*x3^4%:R*y3^2 - 36%:R*x1^5*x2*x3^4%:R*y3^2 + 72%:R*x1^4%:R*x2^2*x3^4%:R*y3^2 - 48%:R*x1^3*x2^3*x3^4%:R*y3^2 - 18%:R*x1^2*x2^4%:R*x3^4%:R*y3^2 + 36%:R*x1*x2^5*x3^4%:R*y3^2 - 12%:R*x2^6%:R*x3^4%:R*y3^2 + 12%:R*x1^5*x3^5*y3^2 - 48%:R*x1^4%:R*x2*x3^5*y3^2 + 72%:R*x1^3*x2^2*x3^5*y3^2 - 48%:R*x1^2*x2^3*x3^5*y3^2 + 12%:R*x1*x2^4%:R*x3^5*y3^2 + 5%:R*x1^4%:R*x3^6%:R*y3^2 - 20%:R*x1^3*x2*x3^6%:R*y3^2 + 30%:R*x1^2*x2^2*x3^6%:R*y3^2 - 20%:R*x1*x2^3*x3^6%:R*y3^2 + 5%:R*x2^4%:R*x3^6%:R*y3^2 + 6%:R*x1^5*x2^2*y1^2*y3^2 - 6%:R*x1^4%:R*x2^3*y1^2*y3^2 - 6%:R*x1^3*x2^4%:R*y1^2*y3^2 + 6%:R*x1^2*x2^5*y1^2*y3^2 - 12%:R*x1^5*x2*x3*y1^2*y3^2 + 18%:R*x1^4%:R*x2^2*x3*y1^2*y3^2 - 6%:R*x1^2*x2^4%:R*x3*y1^2*y3^2 + 6%:R*x1^5*x3^2*y1^2*y3^2 - 18%:R*x1^4%:R*x2*x3^2*y1^2*y3^2 + 12%:R*x1^3*x2^2*x3^2*y1^2*y3^2 + 6%:R*x1*x2^4%:R*x3^2*y1^2*y3^2 - 6%:R*x2^5*x3^2*y1^2*y3^2 + 6%:R*x1^4%:R*x3^3*y1^2*y3^2 - 12%:R*x1^2*x2^2*x3^3*y1^2*y3^2 + 6%:R*x2^4%:R*x3^3*y1^2*y3^2 - 6%:R*x1^3*x3^4%:R*y1^2*y3^2 + 18%:R*x1^2*x2*x3^4%:R*y1^2*y3^2 - 18%:R*x1*x2^2*x3^4%:R*y1^2*y3^2 + 6%:R*x2^3*x3^4%:R*y1^2*y3^2 - 6%:R*x1^2*x3^5*y1^2*y3^2 + 12%:R*x1*x2*x3^5*y1^2*y3^2 - 6%:R*x2^2*x3^5*y1^2*y3^2 - 3%:R*x1^2*x2^2*y1^4%:R*y3^2 + 2%:R*x1*x2^3*y1^4%:R*y3^2 + x2^4%:R*y1^4%:R*y3^2 + 6%:R*x1^2*x2*x3*y1^4%:R*y3^2 - 6%:R*x1*x2^2*x3*y1^4%:R*y3^2 - 3%:R*x1^2*x3^2*y1^4%:R*y3^2 + 6%:R*x1*x2*x3^2*y1^4%:R*y3^2 - 3%:R*x2^2*x3^2*y1^4%:R*y3^2 - 2%:R*x1*x3^3*y1^4%:R*y3^2 + 2%:R*x2*x3^3*y1^4%:R*y3^2 - 6%:R*x1^6%:R*x2*y1*y2*y3^2 - 4%:R*x1^5*x2^2*y1*y2*y3^2 + 18%:R*x1^4%:R*x2^3*y1*y2*y3^2 + 4%:R*x1^3*x2^4%:R*y1*y2*y3^2 - 14%:R*x1^2*x2^5*y1*y2*y3^2 + 2%:R*x2^7%:R*y1*y2*y3^2 + 6%:R*x1^6%:R*x3*y1*y2*y3^2 + 8%:R*x1^5*x2*x3*y1*y2*y3^2 - 10%:R*x1^4%:R*x2^2*x3*y1*y2*y3^2 - 28%:R*x1^3*x2^3*x3*y1*y2*y3^2 + 10%:R*x1^2*x2^4%:R*x3*y1*y2*y3^2 + 28%:R*x1*x2^5*x3*y1*y2*y3^2 - 14%:R*x2^6%:R*x3*y1*y2*y3^2 - 4%:R*x1^5*x3^2*y1*y2*y3^2 + 2%:R*x1^4%:R*x2*x3^2*y1*y2*y3^2 + 32%:R*x1^3*x2^2*x3^2*y1*y2*y3^2 - 44%:R*x1^2*x2^3*x3^2*y1*y2*y3^2 + 4%:R*x1*x2^4%:R*x3^2*y1*y2*y3^2 + 10%:R*x2^5*x3^2*y1*y2*y3^2 - 10%:R*x1^4%:R*x3^3*y1*y2*y3^2 - 20%:R*x1^3*x2*x3^3*y1*y2*y3^2 + 72%:R*x1^2*x2^2*x3^3*y1*y2*y3^2 - 44%:R*x1*x2^3*x3^3*y1*y2*y3^2 + 2%:R*x2^4%:R*x3^3*y1*y2*y3^2 + 12%:R*x1^3*x3^4%:R*y1*y2*y3^2 - 36%:R*x1^2*x2*x3^4%:R*y1*y2*y3^2 + 36%:R*x1*x2^2*x3^4%:R*y1*y2*y3^2 - 12%:R*x2^3*x3^4%:R*y1*y2*y3^2 + 12%:R*x1^2*x3^5*y1*y2*y3^2 - 24%:R*x1*x2*x3^5*y1*y2*y3^2 + 12%:R*x2^2*x3^5*y1*y2*y3^2 + 12%:R*x1^3*x2*y1^3*y2*y3^2 + 4%:R*x1^2*x2^2*y1^3*y2*y3^2 - 20%:R*x1*x2^3*y1^3*y2*y3^2 + 4%:R*x2^4%:R*y1^3*y2*y3^2 - 12%:R*x1^3*x3*y1^3*y2*y3^2 - 8%:R*x1^2*x2*x3*y1^3*y2*y3^2 + 16%:R*x1*x2^2*x3*y1^3*y2*y3^2 + 4%:R*x2^3*x3*y1^3*y2*y3^2 + 4%:R*x1^2*x3^2*y1^3*y2*y3^2 - 8%:R*x1*x2*x3^2*y1^3*y2*y3^2 + 4%:R*x2^2*x3^2*y1^3*y2*y3^2 + 12%:R*x1*x3^3*y1^3*y2*y3^2 - 12%:R*x2*x3^3*y1^3*y2*y3^2 - 6%:R*x2*y1^5*y2*y3^2 + 6%:R*x3*y1^5*y2*y3^2 + 6%:R*x1^6%:R*x2*y2^2*y3^2 + 2%:R*x1^5*x2^2*y2^2*y3^2 - 24%:R*x1^4%:R*x2^3*y2^2*y3^2 + 10%:R*x1^3*x2^4%:R*y2^2*y3^2 + 16%:R*x1^2*x2^5*y2^2*y3^2 - 12%:R*x1*x2^6%:R*y2^2*y3^2 + 2%:R*x2^7%:R*y2^2*y3^2 - 6%:R*x1^6%:R*x3*y2^2*y3^2 - 4%:R*x1^5*x2*x3*y2^2*y3^2 + 20%:R*x1^4%:R*x2^2*x3*y2^2*y3^2 - 4%:R*x1^3*x2^3*x3*y2^2*y3^2 + 4%:R*x1^2*x2^4%:R*x3*y2^2*y3^2 - 20%:R*x1*x2^5*x3*y2^2*y3^2 + 10%:R*x2^6%:R*x3*y2^2*y3^2 + 2%:R*x1^5*x3^2*y2^2*y3^2 - 4%:R*x1^4%:R*x2*x3^2*y2^2*y3^2 - 4%:R*x1^3*x2^2*x3^2*y2^2*y3^2 + 4%:R*x1^2*x2^3*x3^2*y2^2*y3^2 + 10%:R*x1*x2^4%:R*x3^2*y2^2*y3^2 - 8%:R*x2^5*x3^2*y2^2*y3^2 + 8%:R*x1^4%:R*x3^3*y2^2*y3^2 + 4%:R*x1^3*x2*x3^3*y2^2*y3^2 - 36%:R*x1^2*x2^2*x3^3*y2^2*y3^2 + 28%:R*x1*x2^3*x3^3*y2^2*y3^2 - 4%:R*x2^4%:R*x3^3*y2^2*y3^2 - 6%:R*x1^3*x3^4%:R*y2^2*y3^2 + 18%:R*x1^2*x2*x3^4%:R*y2^2*y3^2 - 18%:R*x1*x2^2*x3^4%:R*y2^2*y3^2 + 6%:R*x2^3*x3^4%:R*y2^2*y3^2 - 6%:R*x1^2*x3^5*y2^2*y3^2 + 12%:R*x1*x2*x3^5*y2^2*y3^2 - 6%:R*x2^2*x3^5*y2^2*y3^2 - 24%:R*x1^3*x2*y1^2*y2^2*y3^2 + 24%:R*x1*x2^3*y1^2*y2^2*y3^2 + 24%:R*x1^3*x3*y1^2*y2^2*y3^2 - 24%:R*x2^3*x3*y1^2*y2^2*y3^2 - 24%:R*x1*x3^3*y1^2*y2^2*y3^2 + 24%:R*x2*x3^3*y1^2*y2^2*y3^2 + 18%:R*x2*y1^4%:R*y2^2*y3^2 - 18%:R*x3*y1^4%:R*y2^2*y3^2 - 4%:R*x1^4%:R*y1*y2^3*y3^2 + 16%:R*x1^3*x2*y1*y2^3*y3^2 + 12%:R*x1^2*x2^2*y1*y2^3*y3^2 - 16%:R*x1*x2^3*y1*y2^3*y3^2 - 8%:R*x2^4%:R*y1*y2^3*y3^2 - 12%:R*x1^3*x3*y1*y2^3*y3^2 - 24%:R*x1*x2^2*x3*y1*y2^3*y3^2 + 36%:R*x2^3*x3*y1*y2^3*y3^2 + 20%:R*x1*x3^3*y1*y2^3*y3^2 - 20%:R*x2*x3^3*y1*y2^3*y3^2 + 4%:R*x1*y1^3*y2^3*y3^2 - 16%:R*x2*y1^3*y2^3*y3^2 + 12%:R*x3*y1^3*y2^3*y3^2 + 3%:R*x1^4%:R*y2^4%:R*y3^2 - 19%:R*x1^2*x2^2*y2^4%:R*y3^2 + 14%:R*x1*x2^3*y2^4%:R*y3^2 + 2%:R*x2^4%:R*y2^4%:R*y3^2 + 2%:R*x1^2*x2*x3*y2^4%:R*y3^2 + 14%:R*x1*x2^2*x3*y2^4%:R*y3^2 - 16%:R*x2^3*x3*y2^4%:R*y3^2 - x1^2*x3^2*y2^4%:R*y3^2 + 2%:R*x1*x2*x3^2*y2^4%:R*y3^2 - x2^2*x3^2*y2^4%:R*y3^2 - 6%:R*x1*x3^3*y2^4%:R*y3^2 + 6%:R*x2*x3^3*y2^4%:R*y3^2 - 12%:R*x1*y1^2*y2^4%:R*y3^2 + 12%:R*x3*y1^2*y2^4%:R*y3^2 + 12%:R*x1*y1*y2^5*y3^2 + 6%:R*x2*y1*y2^5*y3^2 - 18%:R*x3*y1*y2^5*y3^2 - 4%:R*x1*y2^6%:R*y3^2 - 2%:R*x2*y2^6%:R*y3^2 + 6%:R*x3*y2^6%:R*y3^2 + 2%:R*x1^6%:R*x2*y1*y3^3 - 2%:R*x1^4%:R*x2^3*y1*y3^3 - 8%:R*x1^3*x2^4%:R*y1*y3^3 + 6%:R*x1^2*x2^5*y1*y3^3 + 8%:R*x1*x2^6%:R*y1*y3^3 - 6%:R*x2^7%:R*y1*y3^3 - 2%:R*x1^6%:R*x3*y1*y3^3 - 6%:R*x1^4%:R*x2^2*x3*y1*y3^3 + 28%:R*x1^3*x2^3*x3*y1*y3^3 - 18%:R*x1^2*x2^4%:R*x3*y1*y3^3 - 12%:R*x1*x2^5*x3*y1*y3^3 + 10%:R*x2^6%:R*x3*y1*y3^3 + 6%:R*x1^4%:R*x2*x3^2*y1*y3^3 - 24%:R*x1^3*x2^2*x3^2*y1*y3^3 + 36%:R*x1^2*x2^3*x3^2*y1*y3^3 - 24%:R*x1*x2^4%:R*x3^2*y1*y3^3 + 6%:R*x2^5*x3^2*y1*y3^3 + 2%:R*x1^4%:R*x3^3*y1*y3^3 + 4%:R*x1^3*x2*x3^3*y1*y3^3 - 24%:R*x1^2*x2^2*x3^3*y1*y3^3 + 28%:R*x1*x2^3*x3^3*y1*y3^3 - 10%:R*x2^4%:R*x3^3*y1*y3^3 - 4%:R*x1^3*x2*y1^3*y3^3 + 4%:R*x1*x2^3*y1^3*y3^3 + 4%:R*x1^3*x3*y1^3*y3^3 - 4%:R*x2^3*x3*y1^3*y3^3 - 4%:R*x1*x3^3*y1^3*y3^3 + 4%:R*x2*x3^3*y1^3*y3^3 + 2%:R*x2*y1^5*y3^3 - 2%:R*x3*y1^5*y3^3 - 6%:R*x1^6%:R*x2*y2*y3^3 + 8%:R*x1^5*x2^2*y2*y3^3 + 6%:R*x1^4%:R*x2^3*y2*y3^3 - 8%:R*x1^3*x2^4%:R*y2*y3^3 - 2%:R*x1^2*x2^5*y2*y3^3 + 2%:R*x2^7%:R*y2*y3^3 + 6%:R*x1^6%:R*x3*y2*y3^3 - 16%:R*x1^5*x2*x3*y2*y3^3 + 26%:R*x1^4%:R*x2^2*x3*y2*y3^3 - 28%:R*x1^3*x2^3*x3*y2*y3^3 - 2%:R*x1^2*x2^4%:R*x3*y2*y3^3 + 28%:R*x1*x2^5*x3*y2*y3^3 - 14%:R*x2^6%:R*x3*y2*y3^3 + 8%:R*x1^5*x3^2*y2*y3^3 - 34%:R*x1^4%:R*x2*x3^2*y2*y3^3 + 56%:R*x1^3*x2^2*x3^2*y2*y3^3 - 44%:R*x1^2*x2^3*x3^2*y2*y3^3 + 16%:R*x1*x2^4%:R*x3^2*y2*y3^3 - 2%:R*x2^5*x3^2*y2*y3^3 + 2%:R*x1^4%:R*x3^3*y2*y3^3 - 20%:R*x1^3*x2*x3^3*y2*y3^3 + 48%:R*x1^2*x2^2*x3^3*y2*y3^3 - 44%:R*x1*x2^3*x3^3*y2*y3^3 + 14%:R*x2^4%:R*x3^3*y2*y3^3 + 12%:R*x1^3*x2*y1^2*y2*y3^3 - 4%:R*x1^2*x2^2*y1^2*y2*y3^3 - 4%:R*x1*x2^3*y1^2*y2*y3^3 - 4%:R*x2^4%:R*y1^2*y2*y3^3 - 12%:R*x1^3*x3*y1^2*y2*y3^3 + 8%:R*x1^2*x2*x3*y1^2*y2*y3^3 - 16%:R*x1*x2^2*x3*y1^2*y2*y3^3 + 20%:R*x2^3*x3*y1^2*y2*y3^3 - 4%:R*x1^2*x3^2*y1^2*y2*y3^3 + 8%:R*x1*x2*x3^2*y1^2*y2*y3^3 - 4%:R*x2^2*x3^2*y1^2*y2*y3^3 + 12%:R*x1*x3^3*y1^2*y2*y3^3 - 12%:R*x2*x3^3*y1^2*y2*y3^3 - 6%:R*x2*y1^4%:R*y2*y3^3 + 6%:R*x3*y1^4%:R*y2*y3^3 - 4%:R*x1^4%:R*y1*y2^2*y3^3 - 8%:R*x1^3*x2*y1*y2^2*y3^3 + 20%:R*x1^2*x2^2*y1*y2^2*y3^3 - 24%:R*x1*x2^3*y1*y2^2*y3^3 + 16%:R*x2^4%:R*y1*y2^2*y3^3 + 12%:R*x1^3*x3*y1*y2^2*y3^3 - 16%:R*x1^2*x2*x3*y1*y2^2*y3^3 + 32%:R*x1*x2^2*x3*y1*y2^2*y3^3 - 28%:R*x2^3*x3*y1*y2^2*y3^3 + 8%:R*x1^2*x3^2*y1*y2^2*y3^3 - 16%:R*x1*x2*x3^2*y1*y2^2*y3^3 + 8%:R*x2^2*x3^2*y1*y2^2*y3^3 - 12%:R*x1*x3^3*y1*y2^2*y3^3 + 12%:R*x2*x3^3*y1*y2^2*y3^3 + 4%:R*x1*y1^3*y2^2*y3^3 - 4%:R*x3*y1^3*y2^2*y3^3 + 8%:R*x1^4%:R*y2^3*y3^3 - 16%:R*x1^3*x2*y2^3*y3^3 + 8%:R*x1^2*x2^2*y2^3*y3^3 + 8%:R*x1*x2^3*y2^3*y3^3 - 8%:R*x2^4%:R*y2^3*y3^3 - 4%:R*x1^3*x3*y2^3*y3^3 + 8%:R*x1^2*x2*x3*y2^3*y3^3 - 16%:R*x1*x2^2*x3*y2^3*y3^3 + 12%:R*x2^3*x3*y2^3*y3^3 - 4%:R*x1^2*x3^2*y2^3*y3^3 + 8%:R*x1*x2*x3^2*y2^3*y3^3 - 4%:R*x2^2*x3^2*y2^3*y3^3 + 4%:R*x1*x3^3*y2^3*y3^3 - 4%:R*x2*x3^3*y2^3*y3^3 - 12%:R*x1*y1^2*y2^3*y3^3 + 16%:R*x2*y1^2*y2^3*y3^3 - 4%:R*x3*y1^2*y2^3*y3^3 + 12%:R*x1*y1*y2^4%:R*y3^3 - 18%:R*x2*y1*y2^4%:R*y3^3 + 6%:R*x3*y1*y2^4%:R*y3^3 - 4%:R*x1*y2^5*y3^3 + 6%:R*x2*y2^5*y3^3 - 2%:R*x3*y2^5*y3^3 + 2%:R*x1^6%:R*x2*y3^4 - 6%:R*x1^5*x2^2*y3^4 + 4%:R*x1^4%:R*x2^3*y3^4 + 4%:R*x1^3*x2^4%:R*y3^4 - 6%:R*x1^2*x2^5*y3^4 + 2%:R*x1*x2^6%:R*y3^4 - 2%:R*x1^6%:R*x3*y3^4 + 12%:R*x1^5*x2*x3*y3^4 - 24%:R*x1^4%:R*x2^2*x3*y3^4 + 16%:R*x1^3*x2^3*x3*y3^4 + 6%:R*x1^2*x2^4%:R*x3*y3^4 - 12%:R*x1*x2^5*x3*y3^4 + 4%:R*x2^6%:R*x3*y3^4 - 6%:R*x1^5*x3^2*y3^4 + 24%:R*x1^4%:R*x2*x3^2*y3^4 - 36%:R*x1^3*x2^2*x3^2*y3^4 + 24%:R*x1^2*x2^3*x3^2*y3^4 - 6%:R*x1*x2^4%:R*x3^2*y3^4 - 4%:R*x1^4%:R*x3^3*y3^4 + 16%:R*x1^3*x2*x3^3*y3^4 - 24%:R*x1^2*x2^2*x3^3*y3^4 + 16%:R*x1*x2^3*x3^3*y3^4 - 4%:R*x2^4%:R*x3^3*y3^4 - 2%:R*x1^3*x2*y1^2*y3^4 + 3%:R*x1^2*x2^2*y1^2*y3^4 - x2^4%:R*y1^2*y3^4 + 2%:R*x1^3*x3*y1^2*y3^4 - 6%:R*x1^2*x2*x3*y1^2*y3^4 + 6%:R*x1*x2^2*x3*y1^2*y3^4 - 2%:R*x2^3*x3*y1^2*y3^4 + 3%:R*x1^2*x3^2*y1^2*y3^4 - 6%:R*x1*x2*x3^2*y1^2*y3^4 + 3%:R*x2^2*x3^2*y1^2*y3^4 + 6%:R*x1^4%:R*y1*y2*y3^4 - 2%:R*x1^3*x2*y1*y2*y3^4 - 24%:R*x1^2*x2^2*y1*y2*y3^4 + 30%:R*x1*x2^3*y1*y2*y3^4 - 10%:R*x2^4%:R*y1*y2*y3^4 - 4%:R*x1^3*x3*y1*y2*y3^4 + 12%:R*x1^2*x2*x3*y1*y2*y3^4 - 12%:R*x1*x2^2*x3*y1*y2*y3^4 + 4%:R*x2^3*x3*y1*y2*y3^4 - 6%:R*x1^2*x3^2*y1*y2*y3^4 + 12%:R*x1*x2*x3^2*y1*y2*y3^4 - 6%:R*x2^2*x3^2*y1*y2*y3^4 - 6%:R*x1*y1^3*y2*y3^4 + 6%:R*x2*y1^3*y2*y3^4 - 7%:R*x1^4%:R*y2^2*y3^4 + 8%:R*x1^3*x2*y2^2*y3^4 + 15%:R*x1^2*x2^2*y2^2*y3^4 - 26%:R*x1*x2^3*y2^2*y3^4 + 10%:R*x2^4%:R*y2^2*y3^4 + 2%:R*x1^3*x3*y2^2*y3^4 - 6%:R*x1^2*x2*x3*y2^2*y3^4 + 6%:R*x1*x2^2*x3*y2^2*y3^4 - 2%:R*x2^3*x3*y2^2*y3^4 + 3%:R*x1^2*x3^2*y2^2*y3^4 - 6%:R*x1*x2*x3^2*y2^2*y3^4 + 3%:R*x2^2*x3^2*y2^2*y3^4 + 18%:R*x1*y1^2*y2^2*y3^4 - 18%:R*x2*y1^2*y2^2*y3^4 - 18%:R*x1*y1*y2^3*y3^4 + 18%:R*x2*y1*y2^3*y3^4 + 6%:R*x1*y2^4%:R*y3^4 - 6%:R*x2*y2^4%:R*y3^4 - 2%:R*x1^4%:R*y1*y3^5 + 2%:R*x1^3*x2*y1*y3^5 + 6%:R*x1^2*x2^2*y1*y3^5 - 10%:R*x1*x2^3*y1*y3^5 + 4%:R*x2^4%:R*y1*y3^5 + 2%:R*x1*y1^3*y3^5 - 2%:R*x2*y1^3*y3^5 + 6%:R*x1^3*x2*y2*y3^5 - 18%:R*x1^2*x2^2*y2*y3^5 + 18%:R*x1*x2^3*y2*y3^5 - 6%:R*x2^4%:R*y2*y3^5 - 6%:R*x1*y1^2*y2*y3^5 + 6%:R*x2*y1^2*y2*y3^5 + 6%:R*x1*y1*y2^2*y3^5 - 6%:R*x2*y1*y2^2*y3^5 - 2%:R*x1*y2^3*y3^5 + 2%:R*x2*y2^3*y3^5 + x1^4%:R*y3^6 - 4%:R*x1^3*x2*y3^6 + 6%:R*x1^2*x2^2*y3^6 - 4%:R*x1*x2^3*y3^6 + x2^4%:R*y3^6. End Polynomials. Lemma from_sander_int (x1 x2 x3 y1 y2 y3 : int) : f1 x1 x2 x3 y1 y2 y3 * f2 x1 x2 x3 y1 y2 y3 = f3 x1 x2 x3 y1 y2 y3. Proof. rewrite /f1 /f2 /f3. Time ring. (* 6.881 secs *) Time Qed. (* 0.95 secs *) Lemma from_sander_rat (x1 x2 x3 y1 y2 y3 : rat) : f1 x1 x2 x3 y1 y2 y3 * f2 x1 x2 x3 y1 y2 y3 = f3 x1 x2 x3 y1 y2 y3. Proof. rewrite /f1 /f2 /f3. Time ring. (* 6.805 secs *) Time Qed. (* 0.94 secs *) Lemma from_sander_abstract (R : comUnitRingType) (x1 x2 x3 y1 y2 y3 : R) : f1 x1 x2 x3 y1 y2 y3 * f2 x1 x2 x3 y1 y2 y3 = f3 x1 x2 x3 y1 y2 y3. Proof. rewrite /f1 /f2 /f3. Time ring. (* 6.303 secs *) Time Qed. (* 0.913 secs *) Ltac ring_reflection ::= ring_reflection_no_check. Lemma from_sander_int_no_check (x1 x2 x3 y1 y2 y3 : int) : f1 x1 x2 x3 y1 y2 y3 * f2 x1 x2 x3 y1 y2 y3 = f3 x1 x2 x3 y1 y2 y3. Proof. rewrite /f1 /f2 /f3. Time ring. (* 4.93 secs *) Time Qed. (* 0.903 secs *) Lemma from_sander_rat_no_check (x1 x2 x3 y1 y2 y3 : rat) : f1 x1 x2 x3 y1 y2 y3 * f2 x1 x2 x3 y1 y2 y3 = f3 x1 x2 x3 y1 y2 y3. Proof. rewrite /f1 /f2 /f3. Time ring. (* 4.772 secs *) Time Qed. (* 0.838 secs *) Lemma from_sander_abstract_no_check (R : comUnitRingType) (x1 x2 x3 y1 y2 y3 : R) : f1 x1 x2 x3 y1 y2 y3 * f2 x1 x2 x3 y1 y2 y3 = f3 x1 x2 x3 y1 y2 y3. Proof. rewrite /f1 /f2 /f3. Time ring. (* 5.023 secs *) Time Qed. (* 1.005 secs *) algebra-tactics-1.2.4/examples/lra_examples.v000066400000000000000000000130571474420016100212310ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. From mathcomp Require Import lra. Local Open Scope ring_scope. Lemma test (F : realFieldType) (x y : F) : x + 2%:R * y <= 3%:R -> 2%:R * x + y <= 3%:R -> x + y <= 2%:R. Proof. lra. Qed. (* Print test. *) (* Print Assumptions test. (* Closed under the global context *) *) Lemma test_rat (x y : rat) : x + 2%:R * y <= 3%:R -> 2%:R * x + y <= 3%:R -> x + y <= 2%:R. Proof. lra. Qed. Lemma test_realDomain (R : realDomainType) (x y : R) : x + 2%:R * y <= 3%:R -> 2%:R * x + y <= 3%:R -> x + y <= 2%:R. Proof. lra. Qed. Lemma test_realDomain' (R : realDomainType) (x : int) (y : R) : x%:~R + 2 * y <= 3 -> (2 * x)%:~R + y <= 3 -> x%:~R + y <= 2. Proof. lra. Qed. Section Tests. Variable F : realFieldType. Implicit Types x y : F. Lemma test_cast : 0 <= 2 :> F. Proof. lra. Qed. Example test_div x y : x / 2 + y <= 3 -> x + y / 2 <= 3 -> x + y <= 4. Proof. lra. Qed. Example test_div_mul x : 1 / (2 * x) <= 1 / 2 / x + 1. Proof. lra. Qed. Example test_div_inv x : 1 / x^-1 <= x + 1. Proof. lra. Qed. Example test_div_opp x : (- x)^-1 <= - x^-1 + 1. Proof. lra. Qed. Example test_div_exp x : (x ^+ 2) ^-1 <= x ^-1 ^+ 2 + 1. Proof. lra. Qed. Lemma test_lt x y : x + 2%:R * y < 3%:R -> 2%:R * x + y <= 3%:R -> x + y < 2%:R. Proof. lra. Qed. Lemma test_eq x y : x + 2%:R * y = 3%:R -> 2%:R * x + y <= 3%:R -> x + y <= 2%:R. Proof. lra. Qed. Lemma test_eqop x y : x + 2%:R * y == 3%:R -> 2%:R * x + y <= 3%:R -> x + y <= 2%:R. Proof. lra. Qed. Lemma test_prop_in_middle (C : Prop) x : x <= 2%:R -> C -> x <= 3%:R. Proof. lra. Qed. Lemma test_opp x : x <= 2%:R -> -x >= -2%:R. Proof. lra. Qed. Lemma test_iff x : x <= 2%:R <-> -x >= -2%:R. Proof. lra. Qed. Lemma test_eq_bool x : x <= 2%:R = (-x >= -2%:R). Proof. lra. Qed. Lemma test_not x : x <= 2%:R -> ~ (x > 2%:R). Proof. lra. Qed. Lemma test_negb x : x <= 2%:R -> ~~ (x > 2%:R). Proof. lra. Qed. Lemma test_and x : x <= 2%:R -> (x <= 3%:R /\ x <= 4%:R). Proof. lra. Qed. Lemma test_andb x : x <= 2%:R -> (x <= 3%:R) && (x <= 4%:R). Proof. lra. Qed. Lemma test_or x : x <= 2%:R -> (x <= 3%:R \/ x <= 1%:R). Proof. lra. Qed. Lemma test_orb x : x <= 2%:R -> (x <= 3%:R) || (x <= 1%:R). Proof. lra. Qed. Lemma test_exfalso x (xle2 : x <= 2%:R) (xge3 : x >= 3%:R) : bool. Proof. lra. Qed. Lemma test_rat_constant x : 0 <= x -> 1 / 3%:R * x <= 2%:R^-1 * x. Proof. lra. Qed. Lemma test_rfstr (x : rat) : (x <= 2%:R) || true = true. Proof. lra. Qed. End Tests. (* Examples from the test suite of Coq *) Section TestsCoq. Variable F : realFieldType. Implicit Types x y : F. Lemma plus_minus x y : 0 = x + y -> 0 = x - y -> 0 = x /\ 0 = y. Proof. lra. Qed. Lemma plus_minus' x y : 0 = x + y -> 0 = x - y -> 0 = x /\ 0 = y. Proof. move=> *. lra. Qed. Lemma cst_test : 5%:R^+5 = 5%:R * 5%:R * 5%:R * 5%:R * 5%:R :> F. Proof. lra. Qed. Goal forall x y, x <> x -> x > y. Proof. move=> *. lra. Qed. Lemma binomial x y : (x + y)^+2 = x^+2 + 2%:R * x * y + y^+2. Proof. move=> *. lra. Qed. Lemma hol_light19 x y : 2%:R * y + x = (x + y) + y. Proof. lra. Qed. Lemma vcgen_25 (n m jt j it i : F) : 1 * it + -(2%:R) * i + -(1%:R) = 0 -> 1 * jt + -(2%:R) * j + -(1%:R) = 0 -> 1 * n + -(10%:R) = 0 -> 0 <= -(4028%:R) * i + 6222%:R * j + 705%:R * m + -(16674%:R) -> 0 <= -(418%:R) * i + 651%:R * j + 94 %:R * m + -(1866%:R) -> 0 <= -(209%:R) * i + 302%:R * j + 47%:R * m + -(839%:R) -> 0 <= -(1%:R) * i + 1 * j + -(1%:R) -> 0 <= -(1%:R) * j + 1 * m + 0 -> 0 <= 1 * j + 5%:R * m + -(27%:R) -> 0 <= 2%:R * j + -(1%:R) * m + 2%:R -> 0 <= 7%:R * j + 10%:R * m + -(74%:R) -> 0 <= 18%:R * j + -(139%:R) * m + 1188%:R -> 0 <= 1 * i + 0 -> 0 <= 121%:R * i + 810%:R * j + -(7465%:R) * m + 64350%:R -> 1 = -(2%:R) * i + it. Proof. move=> *. lra. Qed. Lemma l1 x y z : `|x - z| <= `|x - y| + `|y - z|. Proof. Fail intros; split_Rabs; lra. (* TODO should work *) Abort. Lemma l2 x y : x < `|y| -> y < 1 -> x >= 0 -> - y <= 1 -> `|x| <= 1. Proof. Fail intros; split_Rabs; lra. (* TODO should work *) Abort. (* Bug 5073 *) Lemma opp_eq_0_iff x : -x = 0 <-> x = 0. Proof. lra. Qed. (* From L. Théry *) Goal forall x y, x = 0 -> x * y = 0. Proof. move=> *. nra. Qed. Goal forall x y, 2%:R * x = 0 -> x * y = 0. Proof. move=> *. nra. Qed. Goal forall x y, - x * x >= 0 -> x * y = 0. Proof. move=> *. nra. Qed. Goal forall x, x * x >= 0. Proof. move=> *. nra. Qed. Goal forall x, -x^+2 >= 0 -> x - 1 >= 0 -> False. Proof. move=> *. (* Requires CSDP *) (* psatz 3. *) (* Qed. *) Abort. Goal forall x, -x^+2 >= 0 -> x - 1 >= 0 -> False. Proof. move=> *. nra. Qed. Lemma motzkin' x y : (x^+2 + y^+2 + 1) * (x^+2 * y^+4 + x^+4*y^+2 + 1 - 3%:R * x^+2 * y^+2) >= 0. Proof. move=> *. (* Requires CSDP *) (* psatz 3. *) (* Qed. *) Abort. Goal forall x, -x^+2 >= 0 -> x - 1 >= 0 -> False. Proof. move=> *. nra. Qed. Goal 1 / (1 - 1) = 0 :> F. Proof. Fail lra. (* division by zero *) Abort. Goal 0 / (1 - 1) = 0 :> F. Proof. lra. (* 0 * x = 0 *) Qed. Goal 10%:R ^+ 2 = 100%:R :> F. Proof. (* pow is reified as a constant *) lra. Qed. Goal ratr (1 / 2%:R) = 1 / 2%:R :> F. Proof. lra. Qed. Goal 1 ^+ (2 + 2) = 1 :> F. Proof. lra. Qed. (* Instance Dplus : DeclaredConstant addn := {}. *) (* TODO should work *) Goal 1 ^+ (2 + 2) = 1 :> F. Proof. lra. Qed. End TestsCoq. Example test_abstract_rmorphism (R : realDomainType) (f : {rmorphism R -> R}) (x y : R) : f y >= 0 -> f x + 2 * f (y + 1) <= f (3 * y + x) + 2. Proof. lra. Qed. Example test_concrete_rmorphism (R : realFieldType) (x y : rat) : ratr y >= 0 :> R -> ratr x + 2 * ratr (y + 1) <= ratr (3 * y + x) + 2 :> R. Proof. lra. Qed. algebra-tactics-1.2.4/examples/ring_error.v000066400000000000000000000007101474420016100207150ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg. From mathcomp Require Import ring. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Local Open Scope ring_scope. (* A failure to test the error message *) Goal forall (R : comRingType) (a : R), a + a = a. Proof. move=> R a. Fail ring. (* prints Not a valid ring equation. *) ring || idtac. (* elpi-tactic failure can be caught by Ltac. *) Abort. algebra-tactics-1.2.4/examples/ring_examples.v000066400000000000000000000066711474420016100214160ustar00rootroot00000000000000(* This file should be tested by loaded from `ring_examples_check.v` and *) (* `ring_examples_no_check.v`. To edit this file, uncomment `Require Import`s *) (* below: *) (* From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. *) (* From mathcomp Require Import ring ssrZ. *) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Local Open Scope ring_scope. Goal forall a b : nat, (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 2%N * a * b. Proof. move=> a b; ring. Qed. Goal forall a b : int, (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 2 * a * b. Proof. move=> a b; ring. Qed. Goal forall a b : rat, (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 2%:R * a * b. Proof. move=> a b; ring. Qed. Goal forall a b : int * rat, (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 2%:R * a * b. Proof. move=> a b; ring. Qed. Section AbstractCommutativeRing. Variables (R : comRingType) (a b c : R) (n : nat). (* Examples from the Coq Reference Manual, but for an instance of MathComp's (abstract) commutative ring. *) (* Using the _%:R embedding from nat to R *) Goal (a + b + c) ^+ 2 = a * a + b ^+ 2 + c * c + 2%:R * a * b + 2%:R * a * c + 2%:R * b * c. Proof. ring. Qed. Goal (a + b + c) ^+ 2 = a * a + b ^+ 2 + c * c + 2%:R * a * b + 2%:R * a * c + 2%:R * b * c. Proof. (#[verbose] ring). Qed. (* Using the _%:~R embedding from int to R : 2 is coerced to (Posz 2) : int *) Goal (a + b + c) ^+ 2 = a * a + b ^+ 2 + c * c + 2%:~R * a * b + 2%:~R * a * c + 2%:~R * b * c. Proof. ring. Qed. (* With an identity hypothesis *) (* Using the _%:R embedding from nat to R *) Goal 2%:R * a * b = 30%:R -> (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 30%:R. Proof. move=> H; ring: H. Qed. (* With an identity hypothesis *) (* Using the _%:~R embedding from int to R *) Goal 2%:~R * a * b = 30%:~R -> (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 30%:~R. Proof. move=> H; ring: H. Qed. Goal (n.+1)%:R = n%:R + 1 :> R. Proof. ring. Qed. Goal a * 2%:R = (2%:R : R) * a. Proof. ring. Qed. End AbstractCommutativeRing. Section AbstractRingMorphism. Variables (R : ringType) (S : comRingType) (f : {rmorphism R -> S}) (a b : R). Goal f ((a + b) ^+ 2) = f a ^+ 2 + f b ^+ 2 + 2%:R * f a * f b. Proof. ring. Qed. End AbstractRingMorphism. Section AbstractAdditiveFunction. Variables (U V : zmodType) (R : comRingType). Variables (g : {additive U -> V}) (f : {additive V -> R}) (a : U) (b : V). Goal f (g a + b) ^+ 2 = f (g a) ^+ 2 + f b ^+ 2 + f (g (a *+ 2)) * f b. Proof. ring. Qed. End AbstractAdditiveFunction. Section NumeralExamples. Variable (R : comRingType). (* With numeral constants *) Goal 20%:R * 3%:R = 60%:R :> R. Proof. ring. Qed. Goal 20%:~R * 3%:~R = 60%:~R :> R. Proof. ring. Qed. Goal 200%:~R * 30%:~R = 6000%:~R :> R. Proof. ring. Qed. Goal 2%:~R * 10%:~R ^+ 2 * 3%:~R * 10%:~R ^+ 2 = 6%:~R * 10%:~R ^+ 4:> R. Proof. ring. Qed. Goal 200%:R * 30%:R = 6000%:R :> R. Proof. Time ring. (* 0.186 secs *) Qed. Goal 200%:R * 30%:R = 6000%:R :> int. Proof. Time ring. (* 0.343 secs *) Qed. Goal 20%:R * 3%:R = 60%:R :> rat. Proof. Time ring. (* 0.018 secs *) Qed. Goal 200%:R * 30%:R = 6000%:R :> rat. Proof. Time ring. (* 0.208 secs *) Qed. End NumeralExamples. Section MoreVariables. Variables (q w e r t y u i o p a s d f g h j k l : int). Lemma test_vars : q * w * e * r * t * y * u * i * o * p * a * s * d * f * g * h * j * k * l = l * w * e * r * t * y * u * i * o * p * a * s * d * f * g * h * j * k * q. Proof. Time ring. Qed. (* 0.049 secs *) End MoreVariables. algebra-tactics-1.2.4/examples/ring_examples_check.v000066400000000000000000000002061474420016100225370ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. From mathcomp Require Import ring ssrZ. Load "ring_examples.v". algebra-tactics-1.2.4/examples/ring_examples_no_check.v000066400000000000000000000002721474420016100232360ustar00rootroot00000000000000From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. From mathcomp Require Import ring ssrZ. Ltac ring_reflection ::= ring_reflection_no_check. Load "ring_examples.v". algebra-tactics-1.2.4/meta.yml000066400000000000000000000244331474420016100162210ustar00rootroot00000000000000--- fullname: Algebra Tactics shortname: algebra-tactics opam_name: coq-mathcomp-algebra-tactics organization: math-comp action: true synopsis: >- Ring, field, lra, nra, and psatz tactics for Mathematical Components description: |- This library provides `ring`, `field`, `lra`, `nra`, and `psatz` tactics for the Mathematical Components library. These tactics use the algebraic structures defined in the MathComp library and their canonical instances for the instance resolution, and do not require any special instance declaration, like the `Add Ring` and `Add Field` commands. Therefore, each of these tactics works with any instance of the respective structure, including concrete instances declared through Hierarchy Builder, abstract instances, and mixed concrete and abstract instances, e.g., `int * R` where `R` is an abstract commutative ring. Another key feature of Algebra Tactics is that they automatically push down ring morphisms and additive functions to leaves of ring/field expressions before applying the proof procedures. publications: - pub_url: https://drops.dagstuhl.de/opus/volltexte/2022/16738/ pub_title: Reflexive tactics for algebra, revisited pub_doi: 10.4230/LIPIcs.ITP.2022.29 authors: - name: Kazuhiko Sakaguchi initial: true - name: Pierre Roux initial: false opam-file-maintainer: kazuhiko.sakaguchi@inria.fr license: fullname: CeCILL-B Free Software License Agreement identifier: CECILL-B file: CeCILL-B supported_coq_versions: text: 8.16 or later opam: '{>= "8.16"}' tested_coq_nix_versions: tested_coq_opam_versions: - version: '2.0.0-coq-8.16' repo: 'mathcomp/mathcomp' - version: '2.0.0-coq-8.17' repo: 'mathcomp/mathcomp' - version: '2.0.0-coq-8.18' repo: 'mathcomp/mathcomp' - version: '2.1.0-coq-8.16' repo: 'mathcomp/mathcomp' - version: '2.1.0-coq-8.17' repo: 'mathcomp/mathcomp' - version: '2.1.0-coq-8.18' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.16' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.17' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.18' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.19' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.20' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-dev' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-8.18' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-8.19' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-8.20' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-dev' repo: 'mathcomp/mathcomp' - version: 'coq-8.18' repo: 'mathcomp/mathcomp-dev' - version: 'coq-8.19' repo: 'mathcomp/mathcomp-dev' - version: 'coq-8.20' repo: 'mathcomp/mathcomp-dev' - version: 'coq-dev' repo: 'mathcomp/mathcomp-dev' dependencies: - opam: name: coq-mathcomp-ssreflect version: '{>= "2.0"}' description: |- [MathComp](https://math-comp.github.io) ssreflect 2.0 or later - opam: name: coq-mathcomp-algebra description: |- [MathComp](https://math-comp.github.io) algebra - opam: name: coq-mathcomp-zify version: '{>= "1.5.0"}' description: |- [Mczify](https://github.com/math-comp/mczify) 1.5.0 or later - opam: name: coq-elpi version: '{>= "1.15.0" & != "1.17.0"}' description: |- [Coq-Elpi](https://github.com/LPCIC/coq-elpi) 1.15.0 or later (known not to work with 1.17.0) test_target: test-suite namespace: mathcomp.algebra_tactics action_appendix: |2- export: 'OPAMWITHTEST' env: OPAMWITHTEST: true documentation: |- ## Documentation **Caveat: the `lra`, `nra`, and `psatz` tactics are considered experimental features and subject to change.** This Coq library provides an adaptation of the [`ring`, `field`](https://coq.inria.fr/refman/addendum/ring), [`lra`, `nra`, and `psatz`](https://coq.inria.fr/refman/addendum/micromega) tactics to the MathComp library. See the Coq reference manual for the basic functionalities of these tactics. The descriptions of these tactics below mainly focus on the differences between ones provided by Coq and ones provided by this library, including the additional features introduced by this library. ### The `ring` tactic The `ring` tactic solves a goal of the form `p = q :> R` representing a polynomial equation. The type `R` must have a canonical `comRingType` (commutative ring) or at least `comSemiRingType` (commutative semiring) instance. The `ring` tactic solves the equation by normalizing each side as a polynomial, whose coefficients are either integers `Z` (if `R` is a `comRingType`) or natural numbers `N`. The `ring` tactic can decide the given polynomial equation modulo given monomial equations. The syntax to use this feature is `ring: t_1 .. t_n` where each `t_i` is a proof of equality `m_i = p_i`, `m_i` is a monomial, and `p_i` is a polynomial. Although the `ring` tactic supports ring homomorphisms (explained below), all the monomials and polynomials `m_1, .., m_n, p_1, .., p_n, p, q` must have the same type `R` for the moment. Each tactic provided by this library has a preprocessor and supports applications of (semi)ring homomorphisms and additive functions (N-module or Z-module homomorphisms). For example, suppose `f : S -> T` and `g : R -> S` are ring homomorphisms. The preprocessor turns a ring sub-expression of the form `f (x + g (y * z))` into `f x + f (g y) * f (g z)`. A composition of homomorphisms from the initial objects `nat`, `N`, `int`, and `Z` is automatically normalized to the canonical one. For example, if `R` in the above example is `int`, the result of the preprocessing should be `f x + y%:~R * z%:~R` where `f \o g : int -> T` is replaced with `intr` (`_%:~R`). Thanks to the preprocessor, the `ring` tactic supports the following constructs apart from homomorphism applications: - `GRing.zero` (`0%R`), - `GRing.add` (`+%R`), - `addn`, - `N.add`, - `Z.add`, - `GRing.natmul`, - `GRing.opp` (`-%R`), - `Z.opp`, - `Z.sub`, - `intmul`, - `GRing.one` (`1%R`), - `GRing.mul` (`*%R`), - `muln`, - `N.mul`, - `Z.mul`, - `GRing.exp`,[^constant_exponent] - `exprz`,[^constant_exponent] - `expn`,[^constant_exponent] - `N.pow`,[^constant_exponent] - `Z.pow`,[^constant_exponent] - `S`, - `Posz`, - `Negz`, and - constants of type `nat`, `N`, or `Z`. [^constant_exponent]: The exponent must be a constant value. In addition, it must be non-negative for `exprz`. ### The `field` tactic The `field` tactic solves a goal of the form `p = q :> F` representing a rational equation. The type `F` must have a canonical `fieldType` (field) instance. The `field` tactic solves the equation by normalizing each side to a pair of two polynomials representing a fraction, whose coefficients are integers `Z`. As is the case for the `ring` tactic, the `field` tactic can decide the given rational equation modulo given monomial equations. The syntax to use this feature is the same as the `ring` tactic: `field: t_1 .. t_n`. The `field` tactic generates proof obligations that all the denominators in the equation are not zero. A proof obligation of the form `p * q != 0 :> F` is always automatically reduced to `p != 0 /\ q != 0`. If the field `F` is a `numFieldType` (partially ordered field), a proof obligation of the form `c%:~R != 0 :> F` where `c` is a non-zero integer constant is automatically resolved. The `field` tactic has a preprocessor similar to the `ring` tactic. In addition to the constructs supported by the `ring` tactic, the `field` tactic supports `GRing.inv` and `exprz` with a negative exponent. ### The `lra`, `nra`, and `psatz` tactics The `lra` tactic is a decision procedure for linear real arithmetic. The `nra` and `psatz` tactics are incomplete proof procedures for non-linear real arithmetic. The carrier type must have a canonical `realDomainType` (totally ordered integral domain) or `realFieldType` (totally ordered field) instance. The multiplicative inverse is supported only if the carrier type is a `realFieldType`. If the carrier type is not a `realFieldType` but a `realDomainType`, these three tactics use the same preprocessor as the `ring` tactic. If the carrier type is a `realFieldType`, these tactics support `GRing.inv` and `exprz` with a negative exponent. In contrast to the `field` tactic, these tactics push down the multiplicative inverse through multiplication and exponentiation, e.g., turning `(x * y)^-1` into `x^-1 * y^-1`. ## Files - `theories/` - `common.v`: provides the reflexive preprocessors (syntax, interpretation function, and normalization functions), - `common.elpi`: provides the reification procedure for (semi)ring and module expressions, except for the case that the carrier type is a `realFieldType` in the `lra`, `nra`, and `psatz` tactics, - `ring.v`: provides the Coq code specific to the `ring` and `field` tactics, including the reflection lemmas, - `ring.elpi`: provides the Elpi code specific to the `ring` and `field` tactics, - `ring_tac.elpi`: provides the entry point for the `ring` tactic, - `field_tac.elpi`: provides the entry point for the `field` tactic, - `lra.v`: provides the Coq code specific to the `lra`, `nra`, and `psatz` tactics, including the reflection lemmas, - `lra.elpi`: provides the Elpi code specific to the `lra`, `nra`, and `psatz` tactics, including the reification procedure and the entry point. ## Credits - The adaptation of the `lra`, `nra`, and `psatz` tactics is contributed by Pierre Roux. - The way we adapt the internal lemmas of Coq's `ring` and `field` tactics to algebraic structures of the Mathematical Components library is inspired by the [elliptic-curves-ssr](https://github.com/strub/elliptic-curves-ssr) library by Evmorfia-Iro Bartzia and Pierre-Yves Strub. - The example [`from_sander.v`](examples/from_sander.v) contributed by Assia Mahboubi was given to her by [Sander Dahmen](http://www.few.vu.nl/~sdn249/). It is related to a computational proof that elliptic curves are endowed with a group law. As [suggested](https://hal.inria.fr/inria-00129237v4/document) by Laurent Théry a while ago, this problem is a good benchmark for proof systems. Laurent Théry and Guillaume Hanrot [formally verified](https://doi.org/10.1007/978-3-540-74591-4_24) this property in Coq in 2007. --- algebra-tactics-1.2.4/theories/000077500000000000000000000000001474420016100163645ustar00rootroot00000000000000algebra-tactics-1.2.4/theories/common.elpi000066400000000000000000000774741474420016100205520ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Misc utils pred list-constant o:term, o:list term, o:term. list-constant T [] {{ @nil lp:T }} :- !. list-constant T [X|XS] {{ @cons lp:T lp:X lp:XS' }} :- list-constant T XS XS'. pred mem o:list term, o:term, o:int. mem [X|_] X 0 :- !. mem [Y|_] X 0 :- Y = app [H|_], X = app [H|_], coq.unify-eq X Y ok, !. mem [_|XS] X M :- !, mem XS X N, M is N + 1. % [eucldiv N D M R] N = D * M + R pred eucldiv o:int, i:int, o:int, i:int. eucldiv N D M R :- var N, var M, !, declare_constraint (eucldiv N D M R) [N, M]. eucldiv N D M R :- var N, N is D * M + R. eucldiv N D M R :- var M, M is N div D, R is N mod D. pred positive-constant o:int, o:term. positive-constant 1 {{ lib:num.pos.xH }} :- !. positive-constant N {{ lib:num.pos.xO lp:T }} :- eucldiv N 2 M 0, positive-constant M T. positive-constant N {{ lib:num.pos.xI lp:T }} :- eucldiv N 2 M 1, positive-constant M T. pred ground-pos i:term. ground-pos {{ xH }} :- !. ground-pos {{ xO lp:P }} :- !, ground-pos P. ground-pos {{ xI lp:P }} :- !, ground-pos P. pred ground-N i:term. ground-N {{ N0 }} :- !. ground-N {{ Npos lp:P }} :- !, ground-pos P. pred ground-Z i:term. ground-Z {{ Z0 }} :- !. ground-Z {{ Zpos lp:P }} :- !, ground-pos P. ground-Z {{ Zneg lp:P }} :- !, ground-pos P. pred ground-decimal i:term. ground-decimal {{ Decimal.Nil }} :- !. ground-decimal {{ Decimal.D0 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D1 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D2 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D3 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D4 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D5 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D6 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D7 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D8 lp:D }} :- !, ground-decimal D. ground-decimal {{ Decimal.D9 lp:D }} :- !, ground-decimal D. pred ground-hexadecimal i:term. ground-hexadecimal {{ Hexadecimal.Nil }} :- !. ground-hexadecimal {{ Hexadecimal.D0 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D1 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D2 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D3 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D4 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D5 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D6 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D7 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D8 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.D9 lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.Da lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.Db lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.Dc lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.Dd lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.De lp:D }} :- !, ground-hexadecimal D. ground-hexadecimal {{ Hexadecimal.Df lp:D }} :- !, ground-hexadecimal D. pred ground-uint i:term. ground-uint {{ Number.UIntDecimal lp:D }} :- !, ground-decimal D. ground-uint {{ Number.UIntHexadecimal lp:D }} :- !, ground-hexadecimal D. pred reduction-N i:term, o:term. reduction-N I O :- coq.reduction.vm.norm I {{ N }} O, ground-N O. pred reduction-Z i:term, o:term. reduction-Z I O :- coq.reduction.vm.norm I {{ Z }} O, ground-Z O. pred negb i:bool, o:bool. negb tt ff :- !. negb ff tt :- !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred register-instance i:scope, i:id, i:gref, i:gref, i:constant -> prop. register-instance Scope DbName Proj Pat Pred :- std.do! [ coq.CS.db-for Proj (cs-gref Pat) [cs-instance _ _ (const Inst)], coq.elpi.accumulate Scope DbName (clause _ _ (Pred Inst :- !)) ]. pred canonical-init i:scope, i:id. canonical-init Scope DbName :- std.do! [ register-instance Scope DbName {{:gref GRing.Nmodule.sort }} {{:gref nat }} canonical-nat-nmodule, register-instance Scope DbName {{:gref GRing.SemiRing.sort }} {{:gref nat }} canonical-nat-semiring, register-instance Scope DbName {{:gref GRing.ComSemiRing.sort }} {{:gref nat }} canonical-nat-comsemiring, register-instance Scope DbName {{:gref GRing.Nmodule.sort }} {{:gref N }} canonical-N-nmodule, register-instance Scope DbName {{:gref GRing.SemiRing.sort }} {{:gref N }} canonical-N-semiring, register-instance Scope DbName {{:gref GRing.ComSemiRing.sort }} {{:gref N }} canonical-N-comsemiring, register-instance Scope DbName {{:gref GRing.Nmodule.sort }} {{:gref int }} canonical-int-nmodule, register-instance Scope DbName {{:gref GRing.Zmodule.sort }} {{:gref int }} canonical-int-zmodule, register-instance Scope DbName {{:gref GRing.SemiRing.sort }} {{:gref int }} canonical-int-semiring, register-instance Scope DbName {{:gref GRing.Ring.sort }} {{:gref int }} canonical-int-ring, register-instance Scope DbName {{:gref GRing.ComRing.sort }} {{:gref int }} canonical-int-comring, register-instance Scope DbName {{:gref GRing.UnitRing.sort }} {{:gref int }} canonical-int-unitring, register-instance Scope DbName {{:gref GRing.Nmodule.sort }} {{:gref Z }} canonical-Z-nmodule, register-instance Scope DbName {{:gref GRing.Zmodule.sort }} {{:gref Z }} canonical-Z-zmodule, register-instance Scope DbName {{:gref GRing.SemiRing.sort }} {{:gref Z }} canonical-Z-semiring, register-instance Scope DbName {{:gref GRing.Ring.sort }} {{:gref Z }} canonical-Z-ring, register-instance Scope DbName {{:gref GRing.ComRing.sort }} {{:gref Z }} canonical-Z-comring, register-instance Scope DbName {{:gref GRing.UnitRing.sort }} {{:gref Z }} canonical-Z-unitring ]. pred coercion-init i:scope, i:id. coercion-init Scope DbName :- std.do! [ coq.typecheck {{ @GRing.zero lp:Zero }} _ ok, coq.typecheck Zero TZero ok, coq.elaborate-skeleton {{ id }} {{ nmodType -> lp:TZero }} CZero ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "zero" CZero :- !)), coq.typecheck {{ @GRing.opp lp:Opp }} _ ok, coq.typecheck Opp TOpp ok, coq.elaborate-skeleton {{ id }} {{ zmodType -> lp:TOpp }} COpp ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "opp" COpp :- !)), coq.typecheck {{ @GRing.add lp:Add }} _ ok, coq.typecheck Add TAdd ok, coq.elaborate-skeleton {{ id }} {{ nmodType -> lp:TAdd }} CAdd ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "add" CAdd :- !)), coq.typecheck {{ @GRing.one lp:One }} _ ok, coq.typecheck One TOne ok, coq.elaborate-skeleton {{ id }} {{ semiRingType -> lp:TOne }} COne ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "one" COne :- !)), coq.typecheck {{ @GRing.mul lp:Mul }} _ ok, coq.typecheck Mul TMul ok, coq.elaborate-skeleton {{ id }} {{ semiRingType -> lp:TMul }} CMul ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "mul" CMul :- !)), coq.typecheck {{ @GRing.exp lp:Exp }} _ ok, coq.typecheck Exp TExp ok, coq.elaborate-skeleton {{ id }} {{ semiRingType -> lp:TExp }} CExp ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "exp" CExp :- !)), coq.typecheck {{ @GRing.inv lp:Inv }} _ ok, coq.typecheck Inv TInv ok, coq.elaborate-skeleton {{ id }} {{ unitRingType -> lp:TInv }} CInv ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "inv" CInv :- !)), coq.typecheck {{ @GRing.natmul lp:Natmul }} _ ok, coq.typecheck Natmul TNatmul ok, coq.elaborate-skeleton {{ id }} {{ nmodType -> lp:TNatmul }} CNatmul ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "natmul" CNatmul :- !)), coq.typecheck {{ @GRing.Additive.sort lp:AdditiveDom lp:AdditiveIm }} _ ok, coq.typecheck AdditiveDom TAdditiveDom ok, coq.elaborate-skeleton {{ id }} {{ nmodType -> lp:TAdditiveDom }} CAdditiveDom ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "additive-dom" CAdditiveDom :- !)), coq.typecheck AdditiveIm TAdditiveIm ok, coq.elaborate-skeleton {{ id }} {{ nmodType -> lp:TAdditiveIm }} CAdditiveIm ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "additive-im" CAdditiveIm :- !)), coq.typecheck {{ @GRing.RMorphism.sort lp:RMorphDom lp:RMorphIm }} _ ok, coq.typecheck RMorphDom TRMorphDom ok, coq.elaborate-skeleton {{ id }} {{ semiRingType -> lp:TRMorphDom }} CRMorphDom ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "rmorph-dom" CRMorphDom :- !)), coq.typecheck RMorphIm TRMorphIm ok, coq.elaborate-skeleton {{ id }} {{ semiRingType -> lp:TRMorphIm }} CRMorphIm ok, coq.elpi.accumulate Scope DbName (clause _ _ (coercion "rmorph-im" CRMorphIm :- !)), ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Expression refifier % We use the following four predicates as global variables to store some % information about the target (semi)ring, so that we do not have to pass them % around in reification. % [target-nmodule U] and [target-semiring SR] respectively assert that the % target carrier type has the N-module and semiring instance [U] and [SR]. % These predicates should always succeed in reification. pred target-nmodule o:term. pred target-semiring o:term. % [target-zmodule U] asserts that the target carrier type has the Z-module % instance [U]. This predicate fails when the target is not a ring but semiring. pred target-zmodule o:term. % [field-mode] succeeds if the target is a field equation (field tactic) % or real field linear problem (lra). pred field-mode. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Types to collect structure instances on the current carrier type and the % homomorphism from the carrier type to the target type kind additive type. type additive term -> % nmodType option term -> % zmodType (term -> term) -> % additive morphism additive. kind rmorphism type. type rmorphism term -> % nmodType option term -> % zmodType term -> % semiRingType option term -> % ringType option term -> % unitRingType option term -> % fieldType (term -> term) -> % ring morphism rmorphism. type rmorphism-nat rmorphism. % _%:R type rmorphism-N rmorphism. % (N.to_nat _)%:R type rmorphism-int rmorphism. % _%:~R type rmorphism-Z rmorphism. % (int_of_Z _)%:~R % destructors pred rmorphism->nmod i:rmorphism, o:term. rmorphism->nmod (rmorphism U _ _ _ _ _ _) U :- !. rmorphism->nmod rmorphism-nat (global (const U)) :- !, canonical-nat-nmodule U. rmorphism->nmod rmorphism-N (global (const U)) :- !, canonical-N-nmodule U. rmorphism->nmod rmorphism-int (global (const U)) :- !, canonical-int-nmodule U. rmorphism->nmod rmorphism-Z (global (const U)) :- !, canonical-Z-nmodule U. pred rmorphism->zmod i:rmorphism, o:term. rmorphism->zmod (rmorphism _ (some U) _ _ _ _ _) U :- !. rmorphism->zmod rmorphism-int (global (const U)) :- !, canonical-int-zmodule U. rmorphism->zmod rmorphism-Z (global (const U)) :- !, canonical-Z-zmodule U. pred rmorphism->sring i:rmorphism, o:term. rmorphism->sring (rmorphism _ _ R _ _ _ _) R :- !. rmorphism->sring rmorphism-nat (global (const R)) :- !, canonical-nat-semiring R. rmorphism->sring rmorphism-N (global (const R)) :- !, canonical-N-semiring R. rmorphism->sring rmorphism-int (global (const R)) :- !, canonical-int-semiring R. rmorphism->sring rmorphism-Z (global (const R)) :- !, canonical-Z-semiring R. pred rmorphism->ring i:rmorphism, o:term. rmorphism->ring (rmorphism _ _ _ (some R) _ _ _) R :- !. rmorphism->ring rmorphism-int (global (const R)) :- !, canonical-int-ring R. rmorphism->ring rmorphism-Z (global (const R)) :- !, canonical-Z-ring R. pred rmorphism->uring i:rmorphism, o:term. rmorphism->uring (rmorphism _ _ _ _ (some UR) _ _) UR :- !. rmorphism->uring rmorphism-int (global (const R)) :- !, canonical-int-unitring R. rmorphism->uring rmorphism-Z (global (const R)) :- !, canonical-Z-unitring R. pred rmorphism->field i:rmorphism, o:term. rmorphism->field (rmorphism _ _ _ _ _ (some F) _) F :- !. pred rmorphism->morph i:rmorphism, o:term -> term. rmorphism->morph (rmorphism _ _ _ _ _ _ Morph) Morph :- !. rmorphism->morph rmorphism-nat Morph :- !, target-nmodule TU, !, target-semiring TR, !, coercion "natmul" CNatmul, !, coercion "one" COne, !, Morph = n\ {{ @GRing.natmul (lp:CNatmul lp:TU) (@GRing.one (lp:COne lp:TR)) lp:n }}. rmorphism->morph rmorphism-N Morph :- !, target-nmodule TU, !, target-semiring TR, !, coercion "natmul" CNatmul, !, coercion "one" COne, !, Morph = n\ {{ @GRing.natmul (lp:CNatmul lp:TU) (@GRing.one (lp:COne lp:TR)) (N.to_nat lp:n) }}. rmorphism->morph rmorphism-int Morph :- !, target-zmodule TU, !, target-semiring TR, !, coercion "one" COne, !, Morph = n\ {{ @intmul lp:TU (@GRing.one (lp:COne lp:TR)) lp:n }}. rmorphism->morph rmorphism-Z Morph :- !, target-zmodule TU, !, target-semiring TR, !, coercion "one" COne, !, Morph = n\ {{ @intmul lp:TU (@GRing.one (lp:COne lp:TR)) (int_of_Z lp:n) }}. pred rmorphism-rm-field i:rmorphism, o:rmorphism. rmorphism-rm-field (rmorphism U V SR R UR _ M) (rmorphism U V SR R UR none M). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% namespace quote { % Constructors for reified terms (should be instantiated by each tactic) pred build.variable i:term, o:term. pred build.zero o:term. pred build.opp i:term, o:term. pred build.add i:term, i:term, o:term. pred build.sub i:term, i:term, o:term. pred build.one o:term. pred build.mul i:term, i:term, o:term. pred build.exp i:term, i:term, o:term. pred build.inv i:term, o:term. pred build.Z-constant i:term, o:term. pred build.N-constant i:term, o:term. % [count-succ In N Out] returns the largest [N] such that [In] is % [S (S (... Out))] with [N] occurences of [S] pred count-succ i:term, o:int, o:term. count-succ {{ lib:num.nat.S lp:In }} N' Out :- !, count-succ In N Out, N' is N + 1. count-succ In 0 In :- !. % [quote.n-const In OutM Out] reifies natural number constant [In] of type [nat] % to a term [OutM] of type [large_nat] and a term [Out] of type [N]. pred n-const i:term, o:term, o:term. n-const {{ lp:In : _ }} OutM Out :- !, n-const In OutM Out. n-const {{ Nat.of_num_uint lp:In }} {{ large_nat_uint lp:In }} Out :- ground-uint In, !, coq.reduction.vm.norm {{ N.of_num_uint lp:In }} {{ N }} Out. n-const In {{ large_nat_N lp:Out }} Out :- reduction-N {{ N.of_nat lp:In }} Out. % [quote.z-const In Sign OutM Out] reifies integer constant [In] of type % [int] to a boolean [Sign], a term [OutM] of type [large_nat] % and a term [Out] of type [N] % [Sign] is [tt] iff [In] is non negative, % in which case [In] is [Out], otherwise [In] is [- Out.+1] pred z-const i:term, o:bool, o:term, o:term. z-const {{ lp:In : _ }} Sign OutM Out :- !, z-const In Sign OutM Out. z-const {{ Posz (Nat.of_num_uint lp:In) }} tt {{ large_nat_uint lp:In }} Out :- ground-uint In, !, coq.reduction.vm.norm {{ N.of_num_uint lp:In }} {{ N }} Out. z-const {{ Negz (Nat.of_num_uint lp:In) }} ff {{ large_nat_uint lp:In }} Out :- ground-uint In, !, coq.reduction.vm.norm {{ N.of_num_uint lp:In }} {{ N }} Out. z-const In Sign {{ large_nat_N lp:Out }} Out :- !, coq.reduction.vm.norm {{ quote_icstr_helper lp:In }} {{ (bool * N)%type }} {{ (lp:Sign', lp:Out) }}, !, (Sign' = {{ true }}, !, Sign = tt; Sign' = {{ false }}, !, Sign = ff), !, ground-N Out. % [quote.nmod C Input OutM Out VM] reifies an expression [Input] % under the additive morphism [C] % - [C] stores instances on the carrier type and the additive function from it, % - [Input] is a term of the carrier type, % - [OutM] is a reified terms of [Input] of type [MExpr C], % it is such that [Meval OutM] is exactly [Input], % - [Out] is a reified term of [Input] built by build.*, % it has morphisms pushed inward such that the eval of [Out] % is [{SemiRing,Ring,Field,Lra}.Mnorm OutM] % - [VM] is a variable map. pred nmod i:additive, i:term, o:term, o:term, o:list term. % _ : _ nmod C {{ lp:In : _ }} OutM Out VM :- !, nmod C In OutM Out VM. % 0%R nmod (additive U _ _) {{ @GRing.zero lp:U' }} {{ @M0 lp:U }} Out _ :- coercion "zero" CZero, coq.unify-eq (app [CZero, U]) U' ok, !, build.zero Out. % +%R nmod (additive U _ _ as C) {{ @GRing.add lp:U' lp:In1 lp:In2 }} {{ @MAdd lp:U lp:OutM1 lp:OutM2 }} Out VM :- coercion "add" CAdd, coq.unify-eq (app [CAdd, U]) U' ok, !, nmod C In1 OutM1 Out1 VM, !, nmod C In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % (_ *+ _)%R nmod (additive U _ _ as C) {{ @GRing.natmul lp:U' lp:In1 lp:In2 }} {{ @MMuln lp:U lp:OutM1 lp:OutM2 }} Out VM :- coercion "natmul" CNatmul, coq.unify-eq (app [CNatmul, U]) U' ok, !, nmod C In1 OutM1 Out1 VM, !, ring rmorphism-nat In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % -%R nmod (additive _ (some U) _ as C) {{ @GRing.opp lp:U' lp:In1 }} {{ @MOpp lp:U lp:OutM1 }} Out VM :- coercion "opp" COpp, coq.unify-eq (app [COpp, U]) U' ok, !, nmod C In1 OutM1 Out1 VM, !, build.opp Out1 Out. % (_ *~ _)%R nmod (additive _ (some U) _ as C) {{ @intmul lp:U' lp:In1 lp:In2 }} {{ @MMulz lp:U lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq U U' ok, !, nmod C In1 OutM1 Out1 VM, !, ring rmorphism-int In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % additive functions nmod (additive U _ _ as C) In OutM Out VM :- coercion "additive-im" CAdditiveIm, coercion "additive-dom" CAdditiveDom, % TODO: for concrete additive functions, should we unpack [NewMorphInst]? NewMorph = (x\ {{ @GRing.Additive.sort (lp:CAdditiveDom lp:V) (lp:CAdditiveIm lp:U) lp:NewMorphInst lp:x }}), coq.unify-eq In (NewMorph In1) ok, !, nmod.additive V C NewMorph NewMorphInst In1 OutM Out VM. % variables nmod (additive U _ Morph) In {{ @MX lp:U lp:In }} Out VM :- mem VM (Morph In) N, !, build.variable { positive-constant {calc (N + 1)} } Out. nmod _ In _ _ _ :- coq.error "Unknown" { coq.term->string In }. pred nmod.additive i:term, i:additive, i:term -> term, i:term, i:term, o:term, o:term, o:list term. nmod.additive V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MnatAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-nat-nmodule })) ok, mem VM (Morph (NewMorph {{ 1%N }})) N, !, ring rmorphism-nat In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MNAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-N-nmodule })) ok, mem VM (Morph (NewMorph {{ 1%num }})) N, !, ring rmorphism-N In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MintAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- target-zmodule _, coq.unify-eq V (global (const { canonical-int-nmodule })) ok, mem VM (Morph (NewMorph {{ 1%Z }})) N, !, ring rmorphism-int In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MZAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- target-zmodule _, coq.unify-eq V (global (const { canonical-Z-nmodule })) ok, mem VM (Morph (NewMorph {{ Zpos 1 }})) N, !, ring rmorphism-Z In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MAdditive lp:V lp:U lp:NewMorphInst lp:OutM1 }} Out1 VM :- !, if (coq.unify-eq {{ GRing.Nmodule.sort lp:V }} {{ GRing.Zmodule.sort lp:V' }} ok) (V'' = some V') (V'' = none), !, nmod (additive V V'' (x\ Morph (NewMorph x))) In1 OutM1 Out1 VM, !. % [quote.ring C Input OutM Out VM] reifies an expression [Input] % under the ring morphism [C] % - [C] stores instances on the carrier type and the (semi)ring homomorphism % from it, % - [Input] is a term of the carrier type, % - [OutM] is a reified terms of [Input] of type [RExpr C], % it is such that [Reval OutM] is exactly [Input], % - [Out] is a reified term of [Input] built by build.*, % it has morphisms pushed inward such that the eval of [Out] % is [{SemiRing,Ring,Field,Lra}.Rnorm OutM] % - [VM] is a variable map. pred ring i:rmorphism, i:term, o:term, o:term, o:list term. % _ : _ ring C {{ lp:In : _ }} OutM Out VM :- !, ring C In OutM Out VM. % 0%R ring C {{ @GRing.zero lp:U }} {{ @R0 lp:R }} Out _ :- coercion "zero" CZero, coq.unify-eq (app [CZero, { rmorphism->nmod C }]) U ok, rmorphism->sring C R, !, build.zero Out. % +%R ring C {{ @GRing.add lp:U lp:In1 lp:In2 }} {{ @RAdd lp:R lp:OutM1 lp:OutM2 }} Out VM :- coercion "add" CAdd, coq.unify-eq (app [CAdd, { rmorphism->nmod C }]) U ok, rmorphism->sring C R, !, ring C In1 OutM1 Out1 VM, !, ring C In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % addn ring rmorphism-nat {{ addn lp:In1 lp:In2 }} {{ @RnatAdd lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-nat In1 OutM1 Out1 VM, !, ring rmorphism-nat In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % N.add ring rmorphism-N {{ N.add lp:In1 lp:In2 }} {{ @RNAdd lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-N In1 OutM1 Out1 VM, !, ring rmorphism-N In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % Z.add ring rmorphism-Z {{ Z.add lp:In1 lp:In2 }} {{ @RZAdd lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-Z In1 OutM1 Out1 VM, !, ring rmorphism-Z In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % (_ *+ _)%R ring C {{ @GRing.natmul lp:U lp:In1 lp:In2 }} {{ @RMuln lp:R lp:OutM1 lp:OutM2 }} Out VM :- coercion "natmul" CNatmul, coq.unify-eq (app [CNatmul, { rmorphism->nmod C }]) U ok, rmorphism->sring C R, !, ring C In1 OutM1 Out1 VM, !, ring rmorphism-nat In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % -%R ring C {{ @GRing.opp lp:U lp:In1 }} {{ @ROpp lp:R lp:OutM1 }} Out VM :- coercion "opp" COpp, coq.unify-eq (app [COpp, { rmorphism->zmod C }]) U ok, rmorphism->ring C R, !, ring C In1 OutM1 Out1 VM, !, build.opp Out1 Out. % Z.opp ring rmorphism-Z {{ Z.opp lp:In1 }} {{ @RZOpp lp:OutM1 }} Out VM :- !, ring rmorphism-Z In1 OutM1 Out1 VM, !, build.opp Out1 Out. % Z.sub ring rmorphism-Z {{ Z.sub lp:In1 lp:In2 }} {{ @RZSub lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-Z In1 OutM1 Out1 VM, !, ring rmorphism-Z In2 OutM2 Out2 VM, !, build.sub Out1 Out2 Out. % (_ *~ _)%R ring C {{ @intmul lp:U lp:In1 lp:In2 }} {{ @RMulz lp:R lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq { rmorphism->zmod C } U ok, rmorphism->ring C R, !, ring C In1 OutM1 Out1 VM, !, ring rmorphism-int In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % 1%R ring C {{ @GRing.one lp:R' }} {{ @R1 lp:R }} Out _ :- coercion "one" COne, rmorphism->sring C R, coq.unify-eq (app [COne, R]) R' ok, !, build.one Out. % *%R ring C {{ @GRing.mul lp:R' lp:In1 lp:In2 }} {{ @RMul lp:R lp:OutM1 lp:OutM2 }} Out VM :- coercion "mul" CMul, rmorphism->sring C R, coq.unify-eq (app [CMul, R]) R' ok, !, ring C In1 OutM1 Out1 VM, !, ring C In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % muln ring rmorphism-nat {{ muln lp:In1 lp:In2 }} {{ @RnatMul lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-nat In1 OutM1 Out1 VM, !, ring rmorphism-nat In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % N.mul ring rmorphism-N {{ N.mul lp:In1 lp:In2 }} {{ @RNMul lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-N In1 OutM1 Out1 VM, !, ring rmorphism-N In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % Z.mul ring rmorphism-Z {{ Z.mul lp:In1 lp:In2 }} {{ @RZMul lp:OutM1 lp:OutM2 }} Out VM :- !, ring rmorphism-Z In1 OutM1 Out1 VM, !, ring rmorphism-Z In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % (_ ^+ _)%R ring C {{ @GRing.exp lp:R' lp:In1 lp:In2 }} {{ @RExpn lp:R lp:OutM1 lp:OutM2 }} Out VM :- coercion "exp" CExp, rmorphism->sring C R, coq.unify-eq (app [CExp, R]) R' ok, n-const In2 OutM2 Out2, !, ring C In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out. % (_ ^ _)%R ring C {{ @exprz lp:R' lp:In1 lp:In2 }} OutM Out VM :- z-const In2 Pos OutM2 Out2, rmorphism->uring C R, coq.unify-eq R R' ok, if (Pos = tt) (CONT = (!, ring C In1 OutM1 Out1 VM, !, OutM = {{ @RExpPosz lp:R lp:OutM1 lp:OutM2 }}, !, build.exp Out1 Out2 Out)) (CONT = (rmorphism->field C F, !, ring C In1 OutM1 Out1 VM, !, OutM = {{ @RExpNegz lp:F lp:OutM1 lp:OutM2 }}, !, build.inv { build.exp Out1 Out2 } Out)), CONT. % expn ring rmorphism-nat {{ expn lp:In1 lp:In2 }} {{ @RnatExpn lp:OutM1 lp:OutM2 }} Out VM :- n-const In2 OutM2 Out2, !, ring rmorphism-nat In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out. % N.pow ring rmorphism-N {{ N.pow lp:In1 lp:In2 }} {{ @RNExp lp:OutM1 lp:Out2 }} Out VM :- reduction-N In2 Out2, !, ring rmorphism-N In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out. % Z.pow ring rmorphism-Z {{ Z.pow lp:In1 lp:In2 }} {{ @RZExp lp:OutM1 lp:OutM2 }} Out VM :- reduction-Z In2 OutM2, !, ((OutM2 = {{ Z0 }}, !, Out2 = {{ N0 }}; % If [In2] is non-negative OutM2 = {{ Zpos lp:P }}, !, Out2 = {{ Npos lp:P }}), !, ring rmorphism-Z In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out; build.zero Out). % If [In2] is negative % _^-1 ring C {{ @GRing.inv lp:R lp:In1 }} {{ @RInv lp:F lp:OutM1 }} Out VM :- coercion "inv" CInv, rmorphism->field C F, coq.unify-eq (app [CInv, { rmorphism->uring C }]) R ok, !, ring C In1 OutM1 Out1 VM, build.inv Out1 Out. % S (..(S ..)..) and nat constants ring rmorphism-nat {{ lib:num.nat.S lp:In }} OutM Out VM :- !, count-succ In N In2, !, positive-constant {calc (N + 1)} Pos, !, Out1 = {{ N.pos lp:Pos }}, !, if (In2 = {{ lib:num.nat.O }}) (OutM = {{ RnatC (large_nat_N lp:Out1) }}, !, build.N-constant Out1 Out) (ring rmorphism-nat In2 OutM2 Out2 VM, !, OutM = {{ RnatS lp:Pos lp:OutM2 }}, !, build.add { build.N-constant Out1 } Out2 Out). ring rmorphism-nat {{ lib:num.nat.O }} {{ RnatC (large_nat_N N0) }} Out _ :- !, build.N-constant {{ N0 }} Out. ring rmorphism-nat {{ Nat.of_num_uint lp:In }} {{ RnatC (large_nat_uint lp:In) }} Out _ :- !, ground-uint In, !, coq.reduction.vm.norm {{ N.of_num_uint lp:In }} {{ N }} InN, !, build.N-constant InN Out. % Posz ring rmorphism-int {{ Posz lp:In }} {{ @RPosz lp:OutM }} Out VM :- !, ring rmorphism-nat In OutM Out VM. % Negz ring rmorphism-int {{ Negz lp:In }} {{ RNegz lp:OutM1 }} Out VM :- !, ring rmorphism-nat In OutM1 Out1 VM, !, build.opp { build.add { build.one } Out1 } Out. % N constants ring rmorphism-N In {{ @RNC lp:In }} Out _ :- ground-N In, !, build.N-constant In Out. % Z constants ring rmorphism-Z In {{ @RZC lp:In }} Out _ :- ground-Z In, !, build.Z-constant In Out. % morphisms ring C In OutM Out VM :- rmorphism->sring C R, coercion "rmorph-dom" CRMorphDom, coercion "rmorph-im" CRMorphIm, % TODO: for concrete additive functions, should we unpack [NewMorphInst]? NewMorph = (x\ {{ @GRing.RMorphism.sort (lp:CRMorphDom lp:S) (lp:CRMorphIm lp:R) lp:NewMorphInst lp:x }}), coq.unify-eq In (NewMorph In1) ok, !, ring.rmorphism S C NewMorph NewMorphInst In1 OutM Out VM. % additive functions ring C In OutM Out VM :- rmorphism->nmod C U, coercion "additive-dom" CAdditiveDom, coercion "additive-im" CAdditiveIm, % TODO: for concrete additive functions, should we unpack [NewMorphInst]? NewMorph = (x\ {{ @GRing.Additive.sort (lp:CAdditiveDom lp:V) (lp:CAdditiveIm lp:U) lp:NewMorphInst lp:x }}), coq.unify-eq In (NewMorph In1) ok, !, ring.additive V C NewMorph NewMorphInst In1 OutM Out VM. % variables ring C In {{ @RX lp:R lp:In }} Out VM :- !, rmorphism->sring C R, rmorphism->morph C Morph, mem VM (Morph In) N, !, build.variable { positive-constant {calc (N + 1)} } Out. ring _ In _ _ _ :- coq.error "Unknown" { coq.term->string In }. % TODO: converse ring pred ring.rmorphism.aux i:term, i:term -> term, o:rmorphism. ring.rmorphism.aux SR Morph (rmorphism U V' SR R' UR' F' Morph) :- !, Sort = {{ GRing.SemiRing.sort lp:SR }}, coq.unify-eq Sort {{ GRing.Nmodule.sort lp:U }} ok, if (target-zmodule _, coq.unify-eq Sort {{ GRing.Ring.sort lp:R }} ok, coq.unify-eq Sort {{ GRing.Zmodule.sort lp:V }} ok) (V' = some V, R' = some R, if (coq.unify-eq Sort {{ GRing.UnitRing.sort lp:UR }} ok) (UR' = some UR, if (field-mode, coq.unify-eq Sort {{ GRing.Field.sort lp:F }} ok) (F' = some F) (F' = none)) (UR' = none, F' = none)) (V' = none, R' = none, UR' = none, F' = none). pred ring.rmorphism i:term, i:rmorphism, i:term -> term, i:term, i:term, o:term, o:term, o:list term. ring.rmorphism S C _ NewMorphInst In1 {{ @RnatMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- coq.unify-eq S (global (const { canonical-nat-semiring })) ok, !, rmorphism->sring C R, !, ring rmorphism-nat In1 OutM1 Out1 VM. ring.rmorphism S C _ NewMorphInst In1 {{ @RNMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- coq.unify-eq S (global (const { canonical-N-semiring })) ok, !, rmorphism->sring C R, !, ring rmorphism-N In1 OutM1 Out1 VM. ring.rmorphism S C _ NewMorphInst In1 {{ @RintMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- target-zmodule _, coq.unify-eq S (global (const { canonical-int-semiring })) ok, !, rmorphism->sring C R, !, ring rmorphism-int In1 OutM1 Out1 VM. ring.rmorphism S C _ NewMorphInst In1 {{ @RZMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- target-zmodule _, coq.unify-eq S (global (const { canonical-Z-semiring })) ok, !, rmorphism->sring C R, !, ring rmorphism-Z In1 OutM1 Out1 VM. ring.rmorphism S C NewMorph NewMorphInst In1 {{ @RMorph lp:S lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- !, rmorphism->sring C R, !, rmorphism->morph C Morph, !, ring.rmorphism.aux S (x\ Morph (NewMorph x)) C', !, ring C' In1 OutM1 Out1 VM. pred ring.additive i:term, i:rmorphism, i:term -> term, i:term, i:term, o:term, o:term, o:list term. ring.additive V C NewMorph NewMorphInst In1 {{ @RnatAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-nat-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM (Morph (NewMorph {{ 1%N }})) N, !, ring rmorphism-nat In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive V C NewMorph NewMorphInst In1 {{ @RNAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-N-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM (Morph (NewMorph {{ 1%num }})) N, !, ring rmorphism-N In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive V C NewMorph NewMorphInst In1 {{ @RintAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- target-zmodule _, coq.unify-eq V (global (const { canonical-int-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM (Morph (NewMorph {{ 1%Z }})) N, !, ring rmorphism-int In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive V C NewMorph NewMorphInst In1 {{ @RZAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- target-zmodule _, coq.unify-eq V (global (const { canonical-Z-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM (Morph (NewMorph {{ Zpos 1 }})) N, !, ring rmorphism-Z In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive V C NewMorph NewMorphInst In1 {{ @RAdditive lp:V lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- !, rmorphism->sring C R, rmorphism->morph C Morph, if (coq.unify-eq {{ GRing.Nmodule.sort lp:V }} {{ GRing.Zmodule.sort lp:V' }} ok) (V'' = some V') (V'' = none), !, nmod (additive V V'' (x\ Morph (NewMorph x))) In1 OutM1 Out1 VM, !. } algebra-tactics-1.2.4/theories/common.v000066400000000000000000001667211474420016100200600ustar00rootroot00000000000000From elpi Require Import elpi. From Coq Require Import PeanoNat BinNat Zbool QArith. From Coq.micromega Require Import OrderedRing RingMicromega. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint. From mathcomp.zify Require Import ssrZ zify. Import Order.TTheory GRing.Theory Num.Theory. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Implicit Types (V : nmodType) (R : semiRingType) (F : fieldType). (* Some basic facts about `Decimal.uint` and `Hexadecimal.uint` *) Fixpoint N_of_uint_acc (d : Decimal.uint) (acc : N) : N := match d with | Decimal.Nil => acc | Decimal.D0 d => N_of_uint_acc d (acc * 10) | Decimal.D1 d => N_of_uint_acc d (acc * 10 + 1) | Decimal.D2 d => N_of_uint_acc d (acc * 10 + 2) | Decimal.D3 d => N_of_uint_acc d (acc * 10 + 3) | Decimal.D4 d => N_of_uint_acc d (acc * 10 + 4) | Decimal.D5 d => N_of_uint_acc d (acc * 10 + 5) | Decimal.D6 d => N_of_uint_acc d (acc * 10 + 6) | Decimal.D7 d => N_of_uint_acc d (acc * 10 + 7) | Decimal.D8 d => N_of_uint_acc d (acc * 10 + 8) | Decimal.D9 d => N_of_uint_acc d (acc * 10 + 9) end. Lemma N_of_uint_accE (d : Decimal.uint) (acc : positive) : N.pos (Pos.of_uint_acc d acc) = N_of_uint_acc d (N.pos acc). Proof. by elim: d acc => // d IHd acc; rewrite IHd 1?Pos.add_comm Pos.mul_comm. Qed. Definition N_of_uint : Decimal.uint -> N := N_of_uint_acc ^~ 0%num. Lemma N_of_uintE : N.of_uint =1 N_of_uint. Proof. rewrite /N.of_uint /Pos.of_uint /N_of_uint /=. by elim => //= d _; rewrite N_of_uint_accE. Qed. Lemma uint_N_nat (d : Decimal.uint) : nat_of_N (N.of_uint d) = Nat.of_uint d. Proof. rewrite N_of_uintE /N_of_uint /Nat.of_uint. have ->: 0%N = nat_of_N 0%num by []. by elim: d 0%num => //= d IHd acc; rewrite IHd Nat.tail_mul_spec; congr Nat.of_uint_acc; lia. Qed. Fixpoint N_of_hex_uint_acc (d : Hexadecimal.uint) (acc : N) : N := match d with | Hexadecimal.Nil => acc | Hexadecimal.D0 d => N_of_hex_uint_acc d (acc * 16) | Hexadecimal.D1 d => N_of_hex_uint_acc d (acc * 16 + 1) | Hexadecimal.D2 d => N_of_hex_uint_acc d (acc * 16 + 2) | Hexadecimal.D3 d => N_of_hex_uint_acc d (acc * 16 + 3) | Hexadecimal.D4 d => N_of_hex_uint_acc d (acc * 16 + 4) | Hexadecimal.D5 d => N_of_hex_uint_acc d (acc * 16 + 5) | Hexadecimal.D6 d => N_of_hex_uint_acc d (acc * 16 + 6) | Hexadecimal.D7 d => N_of_hex_uint_acc d (acc * 16 + 7) | Hexadecimal.D8 d => N_of_hex_uint_acc d (acc * 16 + 8) | Hexadecimal.D9 d => N_of_hex_uint_acc d (acc * 16 + 9) | Hexadecimal.Da d => N_of_hex_uint_acc d (acc * 16 + 10) | Hexadecimal.Db d => N_of_hex_uint_acc d (acc * 16 + 11) | Hexadecimal.Dc d => N_of_hex_uint_acc d (acc * 16 + 12) | Hexadecimal.Dd d => N_of_hex_uint_acc d (acc * 16 + 13) | Hexadecimal.De d => N_of_hex_uint_acc d (acc * 16 + 14) | Hexadecimal.Df d => N_of_hex_uint_acc d (acc * 16 + 15) end. Lemma N_of_hex_uint_accE (d : Hexadecimal.uint) (acc : positive) : N.pos (Pos.of_hex_uint_acc d acc) = N_of_hex_uint_acc d (N.pos acc). Proof. by elim: d acc => // d IHd acc; rewrite IHd 1?Pos.add_comm Pos.mul_comm. Qed. Definition N_of_hex_uint : Hexadecimal.uint -> N := N_of_hex_uint_acc ^~ 0%num. Lemma N_of_hex_uintE : N.of_hex_uint =1 N_of_hex_uint. Proof. rewrite /N.of_hex_uint /Pos.of_hex_uint /N_of_hex_uint /=. by elim => //= d _; rewrite N_of_hex_uint_accE. Qed. Lemma hex_uint_N_nat (d : Hexadecimal.uint) : nat_of_N (N.of_hex_uint d) = Nat.of_hex_uint d. Proof. rewrite N_of_hex_uintE /N_of_hex_uint /Nat.of_hex_uint. have ->: 0%N = nat_of_N 0%num by []. by elim: d 0%num => //= d IHd acc; rewrite IHd Nat.tail_mul_spec; congr Nat.of_hex_uint_acc; lia. Qed. (* In reified syntax trees, constants must be represented by binary integers *) (* `N` and `Z`. For the fine-grained control of conversion, we provide *) (* immediately expanding versions of `N -> nat`, `Z -> int`, and `N -> Z` *) (* conversions. *) Definition addn_expand := Eval compute in addn. Fixpoint nat_of_pos_rec_expand (p : positive) (a : nat) : nat := match p with | p0~1 => addn_expand a (nat_of_pos_rec_expand p0 (addn_expand a a)) | p0~0 => nat_of_pos_rec_expand p0 (addn_expand a a) | 1 => a end%positive. Definition nat_of_pos_expand (p : positive) : nat := nat_of_pos_rec_expand p 1. Definition nat_of_N_expand (n : N) : nat := if n is N.pos p then nat_of_pos_expand p else 0%N. Lemma nat_of_N_expandE : nat_of_N_expand = nat_of_N. Proof. by []. Qed. (* For representing input terms of the form `S (... (S n) ...)` *) Fixpoint add_pos_nat (p : positive) (n : nat) : nat := match p with | p0~1 => S (add_pos_nat p0 (add_pos_nat p0 n)) | p0~0 => add_pos_nat p0 (add_pos_nat p0 n) | 1 => S n end%positive. Lemma add_pos_natE p n : add_pos_nat p n = Pos.to_nat p + n. Proof. elim: p n => //= p IHp n; rewrite !IHp; lia. Qed. (* Data types for reifying `nat` and `int` constants, including large ones *) (* that uses `Number.uint` *) Variant large_nat := large_nat_N of N | large_nat_uint of Number.uint. Definition nat_of_large_nat (n : large_nat) : nat := match n with | large_nat_N n => nat_of_N_expand n | large_nat_uint n => Nat.of_num_uint n end. Definition N_of_large_nat (n : large_nat) : N := match n with | large_nat_N n => n | large_nat_uint n => N.of_num_uint n end. Lemma large_nat_N_nat (n : large_nat) : nat_of_N (N_of_large_nat n) = nat_of_large_nat n. Proof. case: n => [n|[d|d]] /=; first by rewrite nat_of_N_expandE; lia. by rewrite uint_N_nat. by rewrite hex_uint_N_nat. Qed. Definition Z_of_large_nat (n : large_nat) : Z := match n with | large_nat_N n => Z.of_N n | large_nat_uint n => Z.of_num_uint n end. Lemma large_nat_Z_int (n : large_nat) : int_of_Z (Z_of_large_nat n) = nat_of_large_nat n. Proof. rewrite -large_nat_N_nat; case: n => [n|[d|d]] //=; first lia. by rewrite /Z.of_uint /N.of_uint; lia. by rewrite /Z.of_hex_uint /N.of_hex_uint; lia. Qed. Definition quote_icstr_helper (n : int) : bool * N := match n with | Posz n => (true, N.of_nat n) | Negz n => (false, N.of_nat n) end. (* TODO: remove natn below when we drop support for MathComp 2.0 *) Lemma natn n : n%:R%R = n :> nat. Proof. by elim: n => // n; rewrite mulrS => ->. Qed. (* Type for reified expressions *) Inductive RExpr : semiRingType -> Type := (* 0 *) | R0 R : RExpr R (* addition *) | RAdd R : RExpr R -> RExpr R -> RExpr R | RnatAdd : RExpr nat -> RExpr nat -> RExpr nat | RNAdd : RExpr N -> RExpr N -> RExpr N | RZAdd : RExpr Z -> RExpr Z -> RExpr Z (* natmul *) | RMuln R : RExpr R -> RExpr nat -> RExpr R (* opposite and subtraction *) | ROpp (R : ringType) : RExpr R -> RExpr R | RZOpp : RExpr Z -> RExpr Z | RZSub : RExpr Z -> RExpr Z -> RExpr Z (* intmul *) | RMulz (R : ringType) : RExpr R -> RExpr int -> RExpr R (* 1 *) | R1 R : RExpr R (* multiplication *) | RMul R : RExpr R -> RExpr R -> RExpr R | RnatMul : RExpr nat -> RExpr nat -> RExpr nat | RNMul : RExpr N -> RExpr N -> RExpr N | RZMul : RExpr Z -> RExpr Z -> RExpr Z (* exponentiation *) | RExpn R : RExpr R -> large_nat -> RExpr R | RExpPosz (R : unitRingType) : RExpr R -> large_nat -> RExpr R | RExpNegz F : RExpr F -> large_nat -> RExpr F | RnatExpn : RExpr nat -> large_nat -> RExpr nat | RNExp : RExpr N -> N -> RExpr N | RZExp : RExpr Z -> Z -> RExpr Z (* multiplicative inverse *) | RInv F : RExpr F -> RExpr F (* constants *) | RnatS : positive -> RExpr nat -> RExpr nat | RnatC : large_nat -> RExpr nat | RPosz : RExpr nat -> RExpr int | RNegz : RExpr nat -> RExpr int | RNC : N -> RExpr N | RZC : Z -> RExpr Z (* homomorphism applications *) | RMorph R' R : {rmorphism R' -> R} -> RExpr R' -> RExpr R | RnatMorph R : {rmorphism nat -> R} -> RExpr nat -> RExpr R | RNMorph R : {rmorphism N -> R} -> RExpr N -> RExpr R | RintMorph R : {rmorphism int -> R} -> RExpr int -> RExpr R | RZMorph R : {rmorphism Z -> R} -> RExpr Z -> RExpr R | RAdditive V R : {additive V -> R} -> MExpr V -> RExpr R | RnatAdditive R : {additive nat -> R} -> RExpr nat -> RExpr R | RNAdditive R : {additive N -> R} -> RExpr N -> RExpr R | RintAdditive R : {additive int -> R} -> RExpr int -> RExpr R | RZAdditive R : {additive Z -> R} -> RExpr Z -> RExpr R (* variables *) | RX R : R -> RExpr R with MExpr : nmodType -> Type := | M0 V : MExpr V | MAdd V : MExpr V -> MExpr V -> MExpr V | MMuln V : MExpr V -> RExpr nat -> MExpr V | MOpp (V : zmodType) : MExpr V -> MExpr V | MMulz (V : zmodType) : MExpr V -> RExpr int -> MExpr V | MAdditive V' V : {additive V' -> V} -> MExpr V' -> MExpr V | MnatAdditive V : {additive nat -> V} -> RExpr nat -> MExpr V | MNAdditive V : {additive N -> V} -> RExpr N -> MExpr V | MintAdditive V : {additive int -> V} -> RExpr int -> MExpr V | MZAdditive V : {additive Z -> V} -> RExpr Z -> MExpr V | MX V : V -> MExpr V. Scheme RExpr_ind' := Induction for RExpr Sort Prop with MExpr_ind' := Induction for MExpr Sort Prop. (* Evaluation function for above type *) (* Evaluating result of reification should be convertible to input expr. *) Fixpoint Reval R (e : RExpr R) : R := match e with | R0 _ => 0%R | RAdd _ e1 e2 => Reval e1 + Reval e2 | RnatAdd e1 e2 => addn (Reval e1) (Reval e2) | RNAdd e1 e2 => N.add (Reval e1) (Reval e2) | RZAdd e1 e2 => Z.add (Reval e1) (Reval e2) | RMuln _ e1 e2 => Reval e1 *+ Reval e2 | ROpp _ e1 => - Reval e1 | RZOpp e1 => Z.opp (Reval e1) | RZSub e1 e2 => Z.sub (Reval e1) (Reval e2) | RMulz _ e1 e2 => Reval e1 *~ Reval e2 | R1 _ => 1%R | RMul _ e1 e2 => Reval e1 * Reval e2 | RnatMul e1 e2 => muln (Reval e1) (Reval e2) | RNMul e1 e2 => N.mul (Reval e1) (Reval e2) | RZMul e1 e2 => Z.mul (Reval e1) (Reval e2) | RExpn _ e1 n => Reval e1 ^+ nat_of_large_nat n | RExpPosz _ e1 n => Reval e1 ^ Posz (nat_of_large_nat n) | RExpNegz _ e1 n => Reval e1 ^ Negz (nat_of_large_nat n) | RnatExpn e1 n => expn (Reval e1) (nat_of_large_nat n) | RNExp e1 n => N.pow (Reval e1) n | RZExp e1 n => Z.pow (Reval e1) n | RInv _ e1 => (Reval e1)^-1 | RnatS p e => add_pos_nat p (Reval e) | RnatC n => nat_of_large_nat n | RPosz e1 => Posz (Reval e1) | RNegz e2 => Negz (Reval e2) | RMorph _ _ f e1 | RnatMorph _ f e1 | RNMorph _ f e1 | RintMorph _ f e1 | RZMorph _ f e1 | RnatAdditive _ f e1 | RNAdditive _ f e1 | RintAdditive _ f e1 | RZAdditive _ f e1 => f (Reval e1) | RAdditive _ _ f e1 => f (Meval e1) | RNC n | RZC n => n | RX _ x => x end with Meval V (e : MExpr V) : V := match e with | M0 _ => 0%R | MAdd _ e1 e2 => Meval e1 + Meval e2 | MMuln _ e1 e2 => Meval e1 *+ Reval e2 | MOpp _ e1 => - Meval e1 | MMulz _ e1 e2 => Meval e1 *~ Reval e2 | MAdditive _ _ f e1 => f (Meval e1) | MnatAdditive _ f e1 | MNAdditive _ f e1 | MintAdditive _ f e1 | MZAdditive _ f e1 => f (Reval e1) | MX _ x => x end. (* Pushing down morphisms in ring and field expressions by reflection *) (* First for semirings, then for rings and finally for fields *) Module SemiRing. Section norm. Variables (R' : semiRingType) (R_of_N : N -> R'). Variables (zero : R') (add : R' -> R' -> R'). Variables (one : R') (mul : R' -> R' -> R') (exp : R' -> N -> R'). Fixpoint Rnorm R (f : R -> R') (e : RExpr R) : R' := match e in RExpr R return (R -> R') -> R' with | R0 _ => fun => zero | RAdd _ e1 e2 | RnatAdd e1 e2 | RNAdd e1 e2 => fun f => add (Rnorm f e1) (Rnorm f e2) | RMuln _ e1 e2 => fun f => mul (Rnorm f e1) (Rnorm (GRing.natmul 1) e2) | R1 _ => fun => one | RMul _ e1 e2 | RnatMul e1 e2 | RNMul e1 e2 => fun f => mul (Rnorm f e1) (Rnorm f e2) | RExpn _ e1 n | RnatExpn e1 n => fun f => exp (Rnorm f e1) (N_of_large_nat n) | RExpPosz _ e1 n => fun f => exp (Rnorm f e1) (N_of_large_nat n) | RNExp e1 n => fun f => exp (Rnorm f e1) n | RnatS p e => fun f => add (R_of_N (Npos p)) (Rnorm f e) | RnatC n => fun => R_of_N (N_of_large_nat n) | RNC n => fun => R_of_N n | RMorph _ _ g e1 => fun f => Rnorm (fun x => f (g x)) e1 | RnatMorph _ _ e1 => fun => Rnorm (GRing.natmul 1) e1 | RNMorph _ _ e1 => fun => Rnorm (fun n => (N.to_nat n)%:R) e1 | RAdditive _ _ g e1 => fun f => Mnorm (fun x => f (g x)) e1 | RnatAdditive _ g e1 => fun f => mul (f (g 1%N)) (Rnorm (GRing.natmul 1) e1) | RNAdditive _ g e1 => fun f => mul (f (g 1%num)) (Rnorm (fun n => (N.to_nat n)%:R) e1) | RX _ x => fun f => f x | _ => fun => f (Reval e) end f with Mnorm V (f : V -> R') (e : MExpr V) : R' := match e in MExpr V return (V -> R') -> R' with | M0 _ => fun => zero | MAdd _ e1 e2 => fun f => add (Mnorm f e1) (Mnorm f e2) | MMuln _ e1 e2 => fun f => mul (Mnorm f e1) (Rnorm (GRing.natmul 1) e2) | MAdditive _ _ g e1 => fun f => Mnorm (fun x => f (g x)) e1 | MnatAdditive _ g e1 => fun f => mul (f (g 1%N)) (Rnorm (GRing.natmul 1) e1) | MNAdditive _ g e1 => fun f => mul (f (g 1%num)) (Rnorm (fun n => (N.to_nat n)%:R) e1) | MX _ x => fun f => f x | _ => fun => f (Meval e) end f. Lemma eq_Rnorm R (f f' : R -> R') (e : RExpr R) : f =1 f' -> Rnorm f e = Rnorm f' e. Proof. pose P R e := forall (f f' : R -> R'), f =1 f' -> Rnorm f e = Rnorm f' e. pose P0 V e := forall (f f' : V -> R'), f =1 f' -> Mnorm f e = Mnorm f' e. move: f f'; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> p e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> S R g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> V R g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> V e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> V e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> U V g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. Qed. End norm. Section correct. Variables (R' : semiRingType). Notation Rnorm := (Rnorm (fun n => (nat_of_N n)%:R) 0 +%R 1 *%R (fun x n => x ^+ N.to_nat n)). Notation Mnorm := (Mnorm (fun n => (nat_of_N n)%:R) 0 +%R 1 *%R (fun x n => x ^+ N.to_nat n)). Lemma Rnorm_correct_rec R (f : {rmorphism R -> R'}) (e : RExpr R) : f (Reval e) = Rnorm f e. Proof. pose P R e := forall (f : {rmorphism R -> R'}), f (Reval e) = Rnorm f e. pose P0 V e := forall (f : {additive V -> R'}), f (Meval e) = Mnorm f e. move: f; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R f; rewrite rmorph0. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphMn -mulr_natr IHe1 IHe2. - by move=> R f; rewrite rmorph1. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> R e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - by move=> R e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - by move=> e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - move=> e1 IHe1 n f. have ->: (Reval e1 ^ n)%num = Reval e1 ^+ N.to_nat n by lia. by rewrite rmorphXn IHe1. - move=> p e1 IHe1 f. by rewrite add_pos_natE rmorphD IHe1 -[Pos.to_nat p in LHS]natn rmorph_nat. - by move=> n f; rewrite -[nat_of_large_nat _]natn rmorph_nat -large_nat_N_nat. - by move=> n f; rewrite -[RHS](rmorph_nat f); congr (f _); lia. - by move=> R S g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_nat (f \o g)) natn. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_nat (f \o g)); congr (f (g _)); lia. - by move=> V R g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - by move=> R g e1 IHe1 f; rewrite -[Reval e1]natn !raddfMn -mulr_natr IHe1. - move=> R g e1 IHe1 f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. by rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) IHe1. - by move=> V f; rewrite raddf0. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfD IHe1 IHe2. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfMn -mulr_natr IHe1 IHe2. - by move=> V V' g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - by move=> V g e1 IHe1 f; rewrite -[Reval e1]natn !raddfMn -mulr_natr IHe1. - move=> v g e1 IHe1 f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. by rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) IHe1. Qed. Lemma Rnorm_correct (e : RExpr R') : Reval e = Rnorm id e. Proof. exact: Rnorm_correct_rec idfun _. Qed. End correct. End SemiRing. Module Ring. Section norm. Variables (R' : ringType) (R_of_Z : Z -> R'). Variables (zero : R') (add : R' -> R' -> R'). Variables (opp : R' -> R') (sub : R' -> R' -> R'). Variables (one : R') (mul : R' -> R' -> R') (exp : R' -> N -> R'). Fixpoint Rnorm R (f : R -> R') (e : RExpr R) : R' := match e in RExpr R return (R -> R') -> R' with | R0 _ => fun => zero | RAdd _ e1 e2 | RnatAdd e1 e2 | RNAdd e1 e2 | RZAdd e1 e2 => fun f => add (Rnorm f e1) (Rnorm f e2) | RMuln _ e1 e2 => fun f => mul (Rnorm f e1) (Rnorm (GRing.natmul 1) e2) | ROpp _ e1 | RZOpp e1 => fun f => opp (Rnorm f e1) | RZSub e1 e2 => fun f => sub (Rnorm f e1) (Rnorm f e2) | RMulz _ e1 e2 => fun f => mul (Rnorm f e1) (Rnorm intr e2) | R1 _ => fun => one | RMul _ e1 e2 | RnatMul e1 e2 | RNMul e1 e2 | RZMul e1 e2 => fun f => mul (Rnorm f e1) (Rnorm f e2) | RExpn _ e1 n | RnatExpn e1 n => fun f => exp (Rnorm f e1) (N_of_large_nat n) | RExpPosz _ e1 n => fun f => exp (Rnorm f e1) (N_of_large_nat n) | RNExp e1 n => fun f => exp (Rnorm f e1) n | RZExp e1 (Z.neg _) => fun f => zero | RZExp e1 n => fun f => exp (Rnorm f e1) (Z.to_N n) | RnatS p e => fun f => add (R_of_Z (Zpos p)) (Rnorm f e) | RnatC n => fun => R_of_Z (Z_of_large_nat n) | RPosz e1 => fun => Rnorm (GRing.natmul 1) e1 | RNegz e1 => fun => opp (add one (Rnorm (GRing.natmul 1) e1)) | RNC n => fun => R_of_Z (Z_of_N n) | RZC n => fun => R_of_Z n | RMorph _ _ g e1 => fun f => Rnorm (fun x => f (g x)) e1 | RnatMorph _ _ e1 => fun => Rnorm (GRing.natmul 1) e1 | RNMorph _ _ e1 => fun => Rnorm (fun n => (N.to_nat n)%:R) e1 | RintMorph _ _ e1 => fun => Rnorm intr e1 | RZMorph _ _ e1 => fun => Rnorm (fun n => (int_of_Z n)%:~R) e1 | RAdditive _ _ g e1 => fun f => Mnorm (fun x => f (g x)) e1 | RnatAdditive _ g e1 => fun f => mul (f (g 1%N)) (Rnorm (GRing.natmul 1) e1) | RNAdditive _ g e1 => fun f => mul (f (g 1%num)) (Rnorm (fun n => (N.to_nat n)%:R) e1) | RintAdditive _ g e1 => fun f => mul (f (g 1%Z)) (Rnorm intr e1) | RZAdditive _ g e1 => fun f => mul (f (g (Zpos 1))) (Rnorm (fun n => (int_of_Z n)%:~R) e1) | RX _ x => fun f => f x | _ => fun => f (Reval e) end f with Mnorm V (f : V -> R') (e : MExpr V) : R' := match e in MExpr V return (V -> R') -> R' with | M0 _ => fun => zero | MAdd _ e1 e2 => fun f => add (Mnorm f e1) (Mnorm f e2) | MMuln _ e1 e2 => fun f => mul (Mnorm f e1) (Rnorm (GRing.natmul 1) e2) | MOpp _ e1 => fun f => opp (Mnorm f e1) | MMulz _ e1 e2 => fun f => mul (Mnorm f e1) (Rnorm intr e2) | MAdditive _ _ g e1 => fun f => Mnorm (fun x => f (g x)) e1 | MnatAdditive _ g e1 => fun f => mul (f (g 1%N)) (Rnorm (GRing.natmul 1) e1) | MNAdditive _ g e1 => fun f => mul (f (g 1%num)) (Rnorm (fun n => (N.to_nat n)%:R) e1) | MintAdditive _ g e1 => fun f => mul (f (g 1%Z)) (Rnorm intr e1) | MZAdditive _ g e1 => fun f => mul (f (g (Zpos 1))) (Rnorm (fun n => (int_of_Z n)%:~R) e1) | MX _ x => fun f => f x end f. Lemma eq_Rnorm R (f f' : R -> R') (e : RExpr R) : f =1 f' -> Rnorm f e = Rnorm f' e. Proof. pose P R e := forall (f f' : R -> R'), f =1 f' -> Rnorm f e = Rnorm f' e. pose P0 V e := forall (f f' : V -> R'), f =1 f' -> Mnorm f e = Mnorm f' e. move: f f'; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 [|p|p] f f' feq //; rewrite (IHe1 _ _ feq). - by move=> p e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> S R g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> V R g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> V e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> V e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> V e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> V e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> U V g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. Qed. End norm. Section correct. Variables (R' : ringType). Notation Rnorm := (Rnorm (fun n : Z => (int_of_Z n)%:~R) 0 +%R -%R (fun x y => x - y) 1 *%R (fun x n => x ^+ N.to_nat n)). Notation Mnorm := (Mnorm (fun n : Z => (int_of_Z n)%:~R) 0 +%R -%R (fun x y => x - y) 1 *%R (fun x n => x ^+ N.to_nat n)). Lemma Rnorm_correct_rec R (f : {rmorphism R -> R'}) (e : RExpr R) : f (Reval e) = Rnorm f e. Proof. pose P R e := forall (f : {rmorphism R -> R'}), f (Reval e) = Rnorm f e. pose P0 V e := forall (f : {additive V -> R'}), f (Meval e) = Mnorm f e. move: f; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R f; rewrite rmorph0. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphMn -mulr_natr IHe1 IHe2. - by move=> R e1 IHe1 f; rewrite rmorphN IHe1. - by move=> e1 IHe1 f; rewrite rmorphN IHe1. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphB IHe1 IHe2. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphMz -mulrzr IHe1 IHe2. - by move=> R f; rewrite rmorph1. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> R e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - by move=> R e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - by move=> e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - move=> e1 IHe1 n f. have ->: (Reval e1 ^ n)%num = Reval e1 ^+ N.to_nat n by lia. by rewrite rmorphXn IHe1. - move=> e1 IHe1 [|p|p] f; rewrite ?(rmorph0, rmorph1) //=. by rewrite /Rnorm -/Rnorm -IHe1 -rmorphXn /=; congr (f _); lia. - move=> p e1 IHe1 f. by rewrite add_pos_natE rmorphD IHe1 -[Pos.to_nat p in LHS]natn rmorph_nat. - move=> n f. by rewrite -[nat_of_large_nat _]natn rmorph_nat pmulrn -large_nat_Z_int. - by move=> e1 IHe1 f; rewrite -[Posz _]intz rmorph_int /intmul IHe1. - by move=> e1 IHe1 f; rewrite -[Negz _]intz rmorph_int /intmul mulrS IHe1. - move=> n f; rewrite /Rnorm. have ->: int_of_Z (Z_of_N n) = nat_of_N n by lia. by rewrite -[RHS](rmorph_nat f); congr (f _); lia. - by move=> n f; rewrite -[RHS](rmorph_int f); congr (f _); lia. - by move=> R S g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_nat (f \o g)) natn. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_nat (f \o g)); congr (f (g _)); lia. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_int (f \o g)); congr (f (g _)); lia. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_int (f \o g)); congr (f (g _)); lia. - by move=> V R g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - by move=> R g e1 IHe1 f; rewrite -[Reval e1]natn !raddfMn -mulr_natr IHe1. - move=> R g e1 IHe1 f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. by rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) IHe1. - move=> R g e1 IHe1 f. by rewrite -[Reval e1]intz [LHS](raddfMz (f \o g)) -mulrzr IHe1. - move=> R g e1 IHe1 f. have ->: Reval e1 = (int_of_Z (Reval e1))%:~R by lia. by rewrite [LHS](raddfMz (f \o g)) -mulrzr -/(comp _ int_of_Z _) IHe1. - by move=> V f; rewrite raddf0. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfD IHe1 IHe2. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfMn -mulr_natr IHe1 IHe2. - by move=> V e1 IHe1 f; rewrite raddfN IHe1. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfMz -mulrzr IHe1 IHe2. - by move=> V V' g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - by move=> V g e1 IHe1 f; rewrite -[Reval e1]natn !raddfMn -mulr_natr IHe1. - move=> v g e1 IHe1 f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. by rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) IHe1. - move=> V g e1 IHe1 f. by rewrite -[Reval e1]intz [LHS](raddfMz (f \o g)) -mulrzr IHe1. - move=> V g e1 IHe1 f. have ->: Reval e1 = (int_of_Z (Reval e1))%:~R by lia. by rewrite [LHS](raddfMz (f \o g)) -mulrzr -/(comp _ int_of_Z _) IHe1. Qed. Lemma Rnorm_correct (e : RExpr R') : Reval e = Rnorm id e. Proof. exact: Rnorm_correct_rec idfun _. Qed. End correct. End Ring. Module Field. Section norm. Variables (F : ringType) (F_of_Z : Z -> F). Variables (zero : F) (add : F -> F -> F) (opp : F -> F) (sub : F -> F -> F). Variables (one : F) (mul : F -> F -> F) (exp : F -> N -> F) (inv : F -> F). Fixpoint Rnorm R (f : R -> F) (e : RExpr R) : F := match e in RExpr R return (R -> F) -> F with | R0 _ => fun => zero | RAdd _ e1 e2 | RnatAdd e1 e2 | RNAdd e1 e2 | RZAdd e1 e2 => fun f => add (Rnorm f e1) (Rnorm f e2) | RMuln _ e1 e2 => fun f => mul (Rnorm f e1) (Rnorm (GRing.natmul 1) e2) | ROpp _ e1 | RZOpp e1 => fun f => opp (Rnorm f e1) | RZSub e1 e2 => fun f => sub (Rnorm f e1) (Rnorm f e2) | RMulz _ e1 e2 => fun f => mul (Rnorm f e1) (Rnorm intr e2) | R1 _ => fun => one | RMul _ e1 e2 | RnatMul e1 e2 | RNMul e1 e2 | RZMul e1 e2 => fun f => mul (Rnorm f e1) (Rnorm f e2) | RExpn _ e1 n | RnatExpn e1 n => fun f => exp (Rnorm f e1) (N_of_large_nat n) | RExpPosz _ e1 n => fun f => exp (Rnorm f e1) (N_of_large_nat n) | RExpNegz _ e1 n => fun f => inv (exp (Rnorm f e1) (N.succ (N_of_large_nat n))) | RNExp e1 n => fun f => exp (Rnorm f e1) n | RZExp e1 (Z.neg _) => fun f => zero | RZExp e1 n => fun f => exp (Rnorm f e1) (Z.to_N n) | RInv _ e1 => fun f => inv (Rnorm f e1) | RnatS p e => fun f => add (F_of_Z (Zpos p)) (Rnorm f e) | RnatC n => fun => F_of_Z (Z_of_large_nat n) | RPosz e1 => fun => Rnorm (GRing.natmul 1) e1 | RNegz e1 => fun => opp (add one (Rnorm (GRing.natmul 1) e1)) | RNC n => fun => F_of_Z (Z_of_N n) | RZC n => fun => F_of_Z n | RMorph _ _ g e1 => fun f => Rnorm (fun x => f (g x)) e1 | RnatMorph _ _ e1 => fun => Rnorm (GRing.natmul 1) e1 | RNMorph _ _ e1 => fun => Rnorm (fun n => (N.to_nat n)%:R) e1 | RintMorph _ _ e1 => fun => Rnorm intr e1 | RZMorph _ _ e1 => fun => Rnorm (fun n => (int_of_Z n)%:~R) e1 | RAdditive _ _ g e1 => fun f => Mnorm (fun x => f (g x)) e1 | RnatAdditive _ g e1 => fun f => mul (f (g 1%N)) (Rnorm (GRing.natmul 1) e1) | RNAdditive _ g e1 => fun f => mul (f (g 1%num)) (Rnorm (fun n => (N.to_nat n)%:R) e1) | RintAdditive _ g e1 => fun f => mul (f (g 1%Z)) (Rnorm intr e1) | RZAdditive _ g e1 => fun f => mul (f (g (Zpos 1))) (Rnorm (fun n => (int_of_Z n)%:~R) e1) | RX _ x => fun f => f x end f with Mnorm V (f : V -> F) (e : MExpr V) : F := match e in MExpr V return (V -> F) -> F with | M0 _ => fun => zero | MAdd _ e1 e2 => fun f => add (Mnorm f e1) (Mnorm f e2) | MMuln _ e1 e2 => fun f => mul (Mnorm f e1) (Rnorm (GRing.natmul 1) e2) | MOpp _ e1 => fun f => opp (Mnorm f e1) | MMulz _ e1 e2 => fun f => mul (Mnorm f e1) (Rnorm intr e2) | MAdditive _ _ g e1 => fun f => Mnorm (fun x => f (g x)) e1 | MnatAdditive _ g e1 => fun f => mul (f (g 1%N)) (Rnorm (GRing.natmul 1) e1) | MNAdditive _ g e1 => fun f => mul (f (g 1%num)) (Rnorm (fun n => (N.to_nat n)%:R) e1) | MintAdditive _ g e1 => fun f => mul (f (g 1%Z)) (Rnorm intr e1) | MZAdditive _ g e1 => fun f => mul (f (g (Zpos 1))) (Rnorm (fun n => (int_of_Z n)%:~R) e1) | MX _ x => fun f => f x end f. Lemma eq_Rnorm R (f f' : R -> F) (e : RExpr R) : f =1 f' -> Rnorm f e = Rnorm f' e. Proof. pose P R e := forall (f f' : R -> F), f =1 f' -> Rnorm f e = Rnorm f' e. pose P0 V e := forall (f f' : V -> F), f =1 f' -> Mnorm f e = Mnorm f' e. move: f f'; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 n f f' feq; rewrite (IHe1 _ _ feq). - by move=> e1 IHe1 [|p|p] f f' feq //; rewrite (IHe1 _ _ feq). - by move=> R e1 IHe1 f f' feq; rewrite !(IHe1 _ _ feq). - by move=> P e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> S R g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> V R g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> R g e1 _ f f' ->. - by move=> V e1 IHe1 e2 IHe2 f f' feq; rewrite (IHe1 _ _ feq) (IHe2 _ _ feq). - by move=> V e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> V e1 IHe1 f f' feq; rewrite (IHe1 _ _ feq). - by move=> V e1 IHe1 e2 _ f f' feq; rewrite (IHe1 _ _ feq). - by move=> U V g e1 IHe1 f f' feq; apply: IHe1 => x; apply: feq. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. - by move=> V g e1 _ f f' ->. Qed. End norm. Section correct. Variables (F : fieldType). Notation Rnorm := (Rnorm (fun (n : Z) => (int_of_Z n)%:~R) 0 +%R -%R (fun x y => x - y) 1 *%R (fun x n => x ^+ N.to_nat n) GRing.inv). Notation Mnorm := (Mnorm (fun (n : Z) => (int_of_Z n)%:~R) 0 +%R -%R (fun x y => x - y) 1 *%R (fun x n => x ^+ N.to_nat n) GRing.inv). Lemma Rnorm_correct_rec R (f : {rmorphism R -> F}) (e : RExpr R) : f (Reval e) = Rnorm f e. Proof. pose P R e := forall (f : {rmorphism R -> F}), f (Reval e) = Rnorm f e. pose P0 V e := forall (f : {additive V -> F}), f (Meval e) = Mnorm f e. move: f; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R f; rewrite rmorph0. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphD IHe1 IHe2. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphMn -mulr_natr IHe1 IHe2. - by move=> R e1 IHe1 f; rewrite rmorphN IHe1. - by move=> e1 IHe1 f; rewrite rmorphN IHe1. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphB IHe1 IHe2. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphMz -mulrzr IHe1 IHe2. - by move=> R f; rewrite rmorph1. - by move=> R e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> e1 IHe1 e2 IHe2 f; rewrite rmorphM IHe1 IHe2. - by move=> R e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - by move=> R e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - move=> R e1 IHe1 n f; rewrite fmorphV rmorphXn IHe1 -large_nat_N_nat. by congr (_ ^- _); lia. - by move=> e1 IHe1 n f; rewrite rmorphXn IHe1 -large_nat_N_nat. - move=> e1 IHe1 n f. have ->: (Reval e1 ^ n)%num = Reval e1 ^+ N.to_nat n by lia. by rewrite rmorphXn IHe1. - move=> e1 IHe1 [|p|p] f; rewrite ?(rmorph0, rmorph1) //=. by rewrite /Rnorm -/Rnorm -IHe1 -rmorphXn /=; congr (f _); lia. - by move=> R e1 IHe1 f; rewrite fmorphV IHe1. - move=> p e1 IHe1 f. by rewrite add_pos_natE rmorphD IHe1 -[Pos.to_nat p in LHS]natn rmorph_nat. - move=> n f. by rewrite -[nat_of_large_nat _]natn rmorph_nat pmulrn -large_nat_Z_int. - by move=> e1 IHe1 f; rewrite -[Posz _]intz rmorph_int /intmul IHe1. - by move=> e1 IHe1 f; rewrite -[Negz _]intz rmorph_int /intmul mulrS IHe1. - move=> n f; rewrite /Rnorm. have ->: int_of_Z (Z_of_N n) = nat_of_N n by lia. by rewrite -[RHS](rmorph_nat f); congr (f _); lia. - by move=> n f; rewrite -[RHS](rmorph_int f); congr (f _); lia. - by move=> R S g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_nat (f \o g)) natn. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_nat (f \o g)); congr (f (g _)); lia. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_int (f \o g)); congr (f (g _)); lia. - move=> R g e1 IHe1 f; rewrite -/(comp f g _) IHe1; apply: eq_Rnorm => /= n. by rewrite -[RHS](rmorph_int (f \o g)); congr (f (g _)); lia. - by move=> V R g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - by move=> R g e1 IHe1 f; rewrite -[Reval e1]natn !raddfMn -mulr_natr IHe1. - move=> R g e1 IHe1 f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. by rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) IHe1. - move=> R g e1 IHe1 f. by rewrite -[Reval e1]intz [LHS](raddfMz (f \o g)) -mulrzr IHe1. - move=> R g e1 IHe1 f. have ->: Reval e1 = (int_of_Z (Reval e1))%:~R by lia. by rewrite [LHS](raddfMz (f \o g)) -mulrzr -/(comp _ int_of_Z _) IHe1. - by move=> V f; rewrite raddf0. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfD IHe1 IHe2. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfMn -mulr_natr IHe1 IHe2. - by move=> V e1 IHe1 f; rewrite raddfN IHe1. - by move=> V e1 IHe1 e2 IHe2 f; rewrite raddfMz -mulrzr IHe1 IHe2. - by move=> V V' g e1 IHe1 f; rewrite -/(comp f g _) IHe1. - by move=> V g e1 IHe1 f; rewrite -[Reval e1]natn !raddfMn -mulr_natr IHe1. - move=> v g e1 IHe1 f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. by rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) IHe1. - move=> V g e1 IHe1 f. by rewrite -[Reval e1]intz [LHS](raddfMz (f \o g)) -mulrzr IHe1. - move=> V g e1 IHe1 f. have ->: Reval e1 = (int_of_Z (Reval e1))%:~R by lia. by rewrite [LHS](raddfMz (f \o g)) -mulrzr -/(comp _ int_of_Z _) IHe1. Qed. Lemma Rnorm_correct (e : RExpr F) : Reval e = Rnorm id e. Proof. exact: Rnorm_correct_rec idfun _. Qed. End correct. End Field. Module Lra. Section norm. Variables (F : ringType) (F_of_Z : bool -> Z -> F). Variables (zero : F) (add : F -> F -> F) (opp : F -> F) (sub : F -> F -> F). Variables (one : F) (mul : F -> F -> F) (exp : F -> N -> F) (inv : F -> F). Fixpoint Rnorm invb R (f : R -> F) (e : RExpr R) : F := let invr r := if invb then inv r else r in match e in RExpr R return (R -> F) -> F with | R0 _ => fun => zero | RAdd _ e1 e2 | RnatAdd e1 e2 | RNAdd e1 e2 | RZAdd e1 e2 => fun f => invr (add (Rnorm false f e1) (Rnorm false f e2)) | RMuln _ e1 e2 => fun f => mul (Rnorm invb f e1) (Rnorm invb (GRing.natmul 1) e2) | ROpp _ e1 | RZOpp e1 => fun f => opp (Rnorm invb f e1) | RZSub e1 e2 => fun f => invr (sub (Rnorm false f e1) (Rnorm false f e2)) | RMulz _ e1 e2 => fun f => mul (Rnorm invb f e1) (Rnorm invb intr e2) | R1 _ => fun => one | RMul _ e1 e2 | RnatMul e1 e2 | RNMul e1 e2 | RZMul e1 e2 => fun f => mul (Rnorm invb f e1) (Rnorm invb f e2) | RExpn _ e1 n | RnatExpn e1 n => fun f => exp (Rnorm invb f e1) (N_of_large_nat n) | RExpPosz _ e1 n => fun f => exp (Rnorm invb f e1) (N_of_large_nat n) | RExpNegz _ e1 n => fun f => exp (Rnorm (~~ invb) f e1) (N.succ (N_of_large_nat n)) | RNExp e1 n => fun f => exp (Rnorm invb f e1) n | RZExp e1 (Z.neg _) => fun f => zero | RZExp e1 n => fun f => exp (Rnorm invb f e1) (Z.to_N n) | RInv _ e1 => fun f => Rnorm (~~ invb) f e1 | RnatS p e => fun f => invr (add (F_of_Z false (Zpos p)) (Rnorm false f e)) | RnatC n => fun => F_of_Z invb (Z_of_large_nat n) | RPosz e1 => fun => Rnorm invb (GRing.natmul 1) e1 | RNegz e1 => fun => invr (opp (add one (Rnorm false (GRing.natmul 1) e1))) | RNC n => fun => F_of_Z invb (Z_of_N n) | RZC n => fun => F_of_Z invb n | RMorph _ _ g e1 => fun f => Rnorm invb (fun x => f (g x)) e1 | RnatMorph _ _ e1 => fun => Rnorm invb (GRing.natmul 1) e1 | RNMorph _ _ e1 => fun => Rnorm invb (fun n => (N.to_nat n)%:R) e1 | RintMorph _ _ e1 => fun => Rnorm invb intr e1 | RZMorph _ _ e1 => fun => Rnorm invb (fun n => (int_of_Z n)%:~R) e1 | RAdditive _ _ g e1 => fun f => Mnorm invb (fun x => f (g x)) e1 | RnatAdditive _ g e1 => fun f => mul (invr (f (g 1%N))) (Rnorm invb (GRing.natmul 1) e1) | RNAdditive _ g e1 => fun f => mul (invr (f (g 1%num))) (Rnorm invb (fun n => (N.to_nat n)%:R) e1) | RintAdditive _ g e1 => fun f => mul (invr (f (g 1%Z))) (Rnorm invb intr e1) | RZAdditive _ g e1 => fun f => mul (invr (f (g (Zpos 1)))) (Rnorm invb (fun n => (int_of_Z n)%:~R) e1) | RX _ x => fun f => invr (f x) end f with Mnorm invb V (f : V -> F) (e : MExpr V) : F := let invr r := if invb then inv r else r in match e in MExpr V return (V -> F) -> F with | M0 _ => fun => zero | MAdd _ e1 e2 => fun f => invr (add (Mnorm false f e1) (Mnorm false f e2)) | MMuln _ e1 e2 => fun f => mul (Mnorm invb f e1) (Rnorm invb (GRing.natmul 1) e2) | MOpp _ e1 => fun f => opp (Mnorm invb f e1) | MMulz _ e1 e2 => fun f => mul (Mnorm invb f e1) (Rnorm invb intr e2) | MAdditive _ _ g e1 => fun f => Mnorm invb (fun x => f (g x)) e1 | MnatAdditive _ g e1 => fun f => mul (invr (f (g 1%N))) (Rnorm invb (GRing.natmul 1) e1) | MNAdditive _ g e1 => fun f => mul (invr (f (g 1%num))) (Rnorm invb (fun n => (N.to_nat n)%:R) e1) | MintAdditive _ g e1 => fun f => mul (invr (f (g 1%Z))) (Rnorm invb intr e1) | MZAdditive _ g e1 => fun f => mul (invr (f (g (Zpos 1)))) (Rnorm invb (fun n => (int_of_Z n)%:~R) e1) | MX _ x => fun f => invr (f x) end f. Lemma eq_Rnorm invb R (f f' : R -> F) (e : RExpr R) : f =1 f' -> Rnorm invb f e = Rnorm invb f' e. Proof. pose P R e := forall invb (f f' : R -> F), f =1 f' -> Rnorm invb f e = Rnorm invb f' e. pose P0 V e := forall invb (f f' : V -> F), f =1 f' -> Mnorm invb f e = Mnorm invb f' e. move: invb f f'; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - move=> R e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - by move=> R e1 IHe1 e2 _ invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> R e1 IHe1 invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> e1 IHe1 invb f f' feq; rewrite (IHe1 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - by move=> R e1 IHe1 e2 _ invb f f' feq; rewrite (IHe1 _ _ _ feq). - move=> R e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - move=> e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - by move=> R e1 IHe1 n invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> R e1 IHe1 n invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> R e1 IHe1 n invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> e1 IHe1 n invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> e1 IHe1 n invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> e1 IHe1 [|p|p] invb f f' feq //; rewrite (IHe1 _ _ _ feq). - by move=> R e1 IHe1 invb f f' feq; rewrite !(IHe1 _ _ _ feq). - by move=> P e1 IHe1 invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> S R g e1 IHe1 invb f f' feq; apply: IHe1 => x; apply: feq. - by move=> V R g e1 IHe1 invb f f' feq; apply: IHe1 => x; apply: feq. - by move=> R g e1 _ invb f f' ->. - by move=> R g e1 _ invb f f' ->. - by move=> R g e1 _ invb f f' ->. - by move=> R g e1 _ invb f f' ->. - by move=> R x invb f f' ->. - move=> V e1 IHe1 e2 IHe2 invb f f' feq. by rewrite (IHe1 _ _ _ feq) (IHe2 _ _ _ feq). - by move=> V e1 IHe1 e2 _ invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> V e1 IHe1 invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> V e1 IHe1 e2 _ invb f f' feq; rewrite (IHe1 _ _ _ feq). - by move=> U V g e1 IHe1 invb f f' feq; apply: IHe1 => x; apply: feq. - by move=> V g e1 _ invb f f' ->. - by move=> V g e1 _ invb f f' ->. - by move=> V g e1 _ invb f f' ->. - by move=> V g e1 _ invb f f' ->. - by move=> V x invb f f' ->. Qed. End norm. Lemma Rnorm_eq invb (F : ringType) (f f' : bool -> Z -> F) zero add opp sub one mul exp inv : f =2 f' -> forall (R : semiRingType) (env : R -> F) e, Rnorm f zero add opp sub one mul exp inv invb env e = Rnorm f' zero add opp sub one mul exp inv invb env e. Proof. move=> ff' R m e. pose P R e := forall f f' invb (m : R -> F), f =2 f' -> Rnorm f zero add opp sub one mul exp inv invb m e = Rnorm f' zero add opp sub one mul exp inv invb m e. pose P0 V e := forall f f' invb (m : V -> F), f =2 f' -> Mnorm f zero add opp sub one mul exp inv invb m e = Mnorm f' zero add opp sub one mul exp inv invb m e. move: f f' invb m ff'. elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 /=. - by []. - move=> R e1 IHe1 e2 IHe2 f f'. by case=> m ff'; [congr inv|]; (congr add; [exact: IHe1|exact: IHe2]). - move=> e1 IHe1 e2 IHe2 f f'. by case=> m ff'; [congr inv|]; (congr add; [exact: IHe1|exact: IHe2]). - move=> e1 IHe1 e2 IHe2 f f'. by case=> m ff'; [congr inv|]; (congr add; [exact: IHe1|exact: IHe2]). - move=> e1 IHe1 e2 IHe2 f f'. by case=> m ff'; [congr inv|]; (congr add; [exact: IHe1|exact: IHe2]). - move=> R e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - by move=> R e1 IHe1 f f' invb m ff'; congr opp; exact: IHe1. - by move=> e1 IHe1 f f' invb m ff'; congr opp; exact: IHe1. - move=> e1 IHe1 e2 IHe2 f f'. by case=> m ff'; [congr inv|]; (congr sub; [exact: IHe1|exact: IHe2]). - move=> R e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - by []. - move=> R e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - move=> e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - move=> e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - move=> e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - by move=> R e1 IHe1 n f f' invb m ff'; congr exp; exact: IHe1. - by move=> R e1 IHe1 n f f' invb m ff'; congr exp; exact: IHe1. - by move=> R e1 IHe1 n f f' invb m ff'; congr exp; exact: IHe1. - by move=> e1 IHe1 n f f' invb m ff'; congr exp; exact: IHe1. - by move=> e1 IHe1 n f f' invb m ff'; congr exp; exact: IHe1. - by move=> e1 IHe1 [|p|//] f f' invb m ff'; congr exp; exact: IHe1. - by move=> R e1 IHe1 f f' invb m ff'; apply: IHe1. - move=> p e IHe f f'. by case=> m ff'; [congr inv|]; congr add; rewrite ?ff'//; exact: IHe. - by move=> n f f' invb m ff'; rewrite /Rnorm ff'. - by move=> e IHe f f' invb m ff'; exact: IHe. - by move=> e IHe f f' [] m ff'; [congr inv|]; congr opp; congr add; exact: IHe. - by move=> n f f' invb m ff'; rewrite /Rnorm ff'. - by move=> n f f' invb m ff'; rewrite /Rnorm ff'. - by move=> R' R g e IHe f f' invb m ff'; exact: IHe. - by move=> R g e IHe f f' invb m ff'; exact: IHe. - by move=> R g e IHe f f' invb m ff'; exact: IHe. - by move=> R g e IHe f f' invb m ff'; exact: IHe. - by move=> R g e IHe f f' invb m ff'; exact: IHe. - by move=> V R g e IHe f f' invb m ff'; exact: IHe. - by move=> R g e IHe f f' invb m ff'; congr mul; exact: IHe. - by move=> R g e IHe f f' invb m ff'; congr mul; exact: IHe. - by move=> R g e IHe f f' invb m ff'; congr mul; exact: IHe. - by move=> R g e IHe f f' invb m ff'; congr mul; exact: IHe. - by []. - by []. - move=> V e1 IHe1 e2 IHe2 f f'. by case=> m ff'; [congr inv|]; (congr add; [exact: IHe1|exact: IHe2]). - move=> V e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - by move=> V e IHe f f' invb m ff'; congr opp; exact: IHe. - move=> V e1 IHe1 e2 IHe2 f f' invb m ff'. by congr mul; [exact: IHe1|exact: IHe2]. - by move=> V V' g e IHe f f' invb m ff'; exact: IHe. - by move=> V g e IHe f f' invb m ff'; congr mul; exact: IHe. - by move=> V g e IHe f f' invb m ff'; congr mul; exact: IHe. - by move=> V g e IHe f f' invb m ff'; congr mul; exact: IHe. - by move=> V g e IHe f f' invb m ff'; congr mul; exact: IHe. - by []. Qed. Section correct. Variables (F : fieldType). Notation F_of_Z := (fun b (n : Z) => if b then (int_of_Z n)%:~R^-1 else (int_of_Z n)%:~R). Notation Rnorm := (Rnorm F_of_Z 0 +%R -%R (fun x y => x - y) 1 *%R (fun x n => x ^+ N.to_nat n) GRing.inv). Notation Mnorm := (Mnorm F_of_Z 0 +%R -%R (fun x y => x - y) 1 *%R (fun x n => x ^+ N.to_nat n) GRing.inv). Lemma Rnorm_correct_rec (invb : bool) R (f : {rmorphism R -> F}) (e : RExpr R) : (if invb then (f (Reval e))^-1 else f (Reval e)) = Rnorm invb f e. Proof. pose P R e := forall invb (f : {rmorphism R -> F}), (if invb then (f (Reval e))^-1 else f (Reval e)) = Rnorm invb f e. pose P0 V e := forall invb (f : {additive V -> F}), (if invb then (f (Meval e))^-1 else f (Meval e)) = Mnorm invb f e. move: invb f; elim e using (@RExpr_ind' P P0); rewrite {R e}/P {}/P0 //=. - by move=> R invb f; rewrite rmorph0 invr0 if_same. - by move=> R e1 IHe1 e2 IHe2 invb f; rewrite rmorphD (IHe1 false) (IHe2 false). - by move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphD (IHe1 false) (IHe2 false). - by move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphD (IHe1 false) (IHe2 false). - by move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphD (IHe1 false) (IHe2 false). - move=> R e1 IHe1 e2 IHe2 invb f; rewrite rmorphMn -mulr_natr invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - move=> R e1 IHe1 invb f. by rewrite rmorphN invrN (IHe1 true) (IHe1 false); case: invb. - move=> e1 IHe1 invb f. by rewrite rmorphN invrN (IHe1 true) (IHe1 false); case: invb. - by move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphB (IHe1 false) (IHe2 false). - move=> R e1 IHe1 e2 IHe2 invb f; rewrite rmorphMz -mulrzr invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - by move=> R invb f; rewrite rmorph1 invr1 if_same. - move=> R e1 IHe1 e2 IHe2 invb f; rewrite rmorphM invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphM invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphM invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - move=> e1 IHe1 e2 IHe2 invb f; rewrite rmorphM invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - move=> R e1 IHe1 n invb f; rewrite rmorphXn -exprVn (IHe1 true) (IHe1 false). by rewrite -large_nat_N_nat; case: invb. - move=> R e1 IHe1 n invb f; rewrite rmorphXn -exprVn (IHe1 true) (IHe1 false). by rewrite -large_nat_N_nat; case: invb. - move=> R e1 IHe1 n invb f; rewrite fmorphV rmorphXn invrK -exprVn. rewrite (IHe1 true) (IHe1 false) -large_nat_N_nat. by case: invb; congr (_ ^+ _); lia. - move=> e1 IHe1 n invb f; rewrite rmorphXn -exprVn (IHe1 true) (IHe1 false). by rewrite -large_nat_N_nat; case: invb. - move=> e1 IHe1 n invb f. have ->: (Reval e1 ^ n)%num = Reval e1 ^+ N.to_nat n by lia. by rewrite rmorphXn -exprVn (IHe1 true) (IHe1 false); case: invb. - move=> e1 IHe1 [|p|p] invb f; rewrite ?(rmorph0, rmorph1, invr0, invr1, if_same) //=. rewrite /Rnorm /= -/(Rnorm _) -IHe1 (fun_if (fun x => GRing.exp x _)). by rewrite exprVn -rmorphXn; congr (if _ then (f _)^-1 else f _); lia. - by move=> R e1 IHe1 invb f; rewrite fmorphV invrK -if_neg IHe1. - move=> p e1 IHe1 invb f; rewrite add_pos_natE rmorphD (IHe1 false). by rewrite -[Pos.to_nat p in LHS]natn rmorph_nat. - move=> n invb f. by rewrite -[nat_of_large_nat _]natn rmorph_nat pmulrn -large_nat_Z_int. - move=> e1 IHe1 invb f; rewrite -[Posz _]intz rmorph_int -pmulrn. by rewrite (IHe1 true) (IHe1 false); case: invb. - move=> e1 IHe1 invb f. by rewrite -[Negz _]intz rmorph_int /intmul mulrS (IHe1 false). - move=> n invb f; rewrite /Rnorm. have ->: int_of_Z (Z_of_N n) = nat_of_N n by lia. rewrite -[_%:~R](rmorph_nat f). by case: invb; [congr (_ ^-1)|]; congr (f _); lia. - move=> n invb f; rewrite /Rnorm -(rmorph_int f). by case: invb; [congr (_ ^-1)|]; congr (f _); lia. - by move=> R S g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. - move=> R g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. by apply: eq_Rnorm => /= n; rewrite -[RHS](rmorph_nat (f \o g)) natn. - move=> R g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. apply: eq_Rnorm => /= n; rewrite -[RHS](rmorph_nat (f \o g)). by congr (f (g _)); lia. - move=> R g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. apply: eq_Rnorm => /= n; rewrite -[RHS](rmorph_int (f \o g)). by congr (f (g _)); lia. - move=> R g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. apply: eq_Rnorm => /= n; rewrite -[RHS](rmorph_int (f \o g)). by congr (f (g _)); lia. - by move=> V R g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. - move=> R g e1 IHe1 invb f. rewrite -[Reval e1]natn !raddfMn -mulr_natr ?invfM. by rewrite (IHe1 true) (IHe1 false); case: invb. - move=> R g e1 IHe1 invb f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. rewrite !raddfMn -mulr_natr -/(comp _ N.to_nat _) ?invfM. by rewrite (IHe1 true) (IHe1 false); case: invb. - move=> R g e1 IHe1 invb f. rewrite -[Reval e1]intz ![f _](raddfMz (f \o g)) -mulrzr ?invfM. by rewrite (IHe1 true) (IHe1 false); case:invb. - move=> R g e1 IHe1 invb f. have ->: Reval e1 = (int_of_Z (Reval e1))%:~R by lia. rewrite [f _](raddfMz (f \o g)) -mulrzr -/(comp _ int_of_Z _) ?invfM. by rewrite (IHe1 true) (IHe1 false); case:invb. - by move=> V invb f; rewrite raddf0 invr0 if_same. - by move=> V e1 IHe1 e2 IHe2 invb f; rewrite raddfD (IHe1 false) (IHe2 false). - move=> V e1 IHe1 e2 IHe2 invb f; rewrite raddfMn -mulr_natr invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - move=> V e1 IHe1 invb f. by rewrite raddfN invrN (IHe1 true) (IHe1 false); case: invb. - move=> V e1 IHe1 e2 IHe2 invb f; rewrite raddfMz -mulrzr invfM. by rewrite (IHe1 true) (IHe2 true) (IHe1 false) (IHe2 false); case: invb. - by move=> V V' g e1 IHe1 invb f; rewrite -/(comp f g _) IHe1. - move=> V g e1 IHe1 invb f; rewrite -[Reval e1]natn !raddfMn -mulr_natr invfM. by rewrite (IHe1 true) (IHe1 false); case: invb. - move=> V g e1 IHe1 invb f. have ->: Reval e1 = (N.to_nat (Reval e1))%:R by lia. rewrite !raddfMn -mulr_natr invfM -/(comp _ N.to_nat _). by rewrite (IHe1 true) (IHe1 false); case: invb. - move=> V g e1 IHe1 invb f. rewrite -[Reval e1]intz ![f _](raddfMz (f \o g)) -mulrzr invfM. by rewrite (IHe1 true) (IHe1 false); case: invb. - move=> V g e1 IHe1 invb f. have ->: Reval e1 = (int_of_Z (Reval e1))%:~R by lia. rewrite [f _](raddfMz (f \o g)) -mulrzr -/(comp _ int_of_Z _) invfM. by rewrite (IHe1 true) (IHe1 false); case: invb. Qed. Lemma Rnorm_correct (e : RExpr F) : Reval e = Rnorm false id e. Proof. by rewrite -(Rnorm_correct_rec _ idfun). Qed. End correct. End Lra. (* Embedding of rational numbers `Q` in a generic `unitRingType` *) Definition R_of_Q {R : unitRingType} (x : Q) : R := (int_of_Z (Qnum x))%:~R / (Pos.to_nat (Qden x))%:R. Lemma R_of_Q0 (R : unitRingType) : R_of_Q 0 = 0 :> R. Proof. by rewrite /R_of_Q mul0r. Qed. Lemma R_of_Q1 (R : unitRingType) : R_of_Q 1 = 1 :> R. Proof. by rewrite /R_of_Q divr1. Qed. Lemma R_of_Q_add (F : numFieldType) x y : R_of_Q (x + y) = R_of_Q x + R_of_Q y :> F. Proof. rewrite /R_of_Q /= addf_div ?pnatr_eq0; try lia. by rewrite !pmulrn -!intrM -!intrD; congr (_%:~R / _%:~R); lia. Qed. Lemma R_of_Q_opp (R : unitRingType) x : R_of_Q (- x) = - R_of_Q x :> R. Proof. by rewrite /R_of_Q !rmorphN mulNr. Qed. Lemma R_of_Q_sub (F : numFieldType) x y : R_of_Q (x - y) = R_of_Q x - R_of_Q y :> F. Proof. by rewrite R_of_Q_add R_of_Q_opp. Qed. Lemma R_of_Q_mul (F : fieldType) x y : R_of_Q (x * y) = R_of_Q x * R_of_Q y :> F. Proof. by rewrite /R_of_Q /= mulrACA -invfM -intrM -natrM; congr (_%:~R / _%:R); lia. Qed. (* Some instances required to adapt `ring`, `field`, and `lra` tactics to *) (* MathComp *) Lemma RN (SR : semiRingType) : semi_morph (0 : SR) 1 +%R *%R eq N.zero N.one N.add N.mul N.eqb (fun n => (nat_of_N n)%:R). Proof. split=> //= [x y | x y | x y]. - by rewrite -natrD; congr _%:R; lia. - by rewrite -natrM; congr _%:R; lia. - by move=> ?; congr _%:R; lia. Qed. Lemma RZ (R : ringType) : ring_morph 0 1 +%R *%R (fun x y : R => x - y) -%R eq 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (fun n => (int_of_Z n)%:~R). Proof. split=> //= [x y | x y | x y | x | x y /Z.eqb_eq -> //]. - by rewrite !rmorphD. - by rewrite !rmorphB. - by rewrite !rmorphM. - by rewrite !rmorphN. Qed. Lemma PN (SR : semiRingType) : @power_theory SR 1 *%R eq N id (fun x n => x ^+ nat_of_N n). Proof. split => r [] //=; elim=> //= p <-. - by rewrite Pos2Nat.inj_xI ?exprS -exprD addnn -mul2n. - by rewrite Pos2Nat.inj_xO ?exprS -exprD addnn -mul2n. Qed. Lemma RS (SR : comSemiRingType) : @semi_ring_theory SR 0 1 +%R *%R eq. Proof. exact/mk_srt/mulrDl/mulrA/mulrC/mul0r/mul1r/addrA/addrC/add0r. Qed. Lemma RR (R : comRingType) : @ring_theory R 0 1 +%R *%R (fun x y => x - y) -%R eq. Proof. exact/mk_rt/subrr/(fun _ _ => erefl)/mulrDl/mulrA/mulrC/mul1r/addrA/addrC/add0r. Qed. Lemma RF F : @field_theory F 0 1 +%R *%R (fun x y => x - y) -%R (fun x y => x / y) GRing.inv eq. Proof. by split=> // [||x /eqP]; [exact: RR | exact/eqP/oner_neq0 | exact: mulVf]. Qed. Section RealDomain. Variable R : realDomainType. Lemma Rsor : @SOR R 0 1 +%R *%R (fun x y => x - y) -%R eq Order.le Order.lt. Proof. apply: mk_SOR_theory. - exact: RelationClasses.eq_equivalence. - by move=> x _ <- y _ <-. - by move=> x _ <- y _ <-. - by move=> x _ <-. - by move=> x _ <- y _ <-. - by move=> x _ <- y _ <-. - exact: RR. - by []. - by move=> x y xley ylex; apply: le_anti; rewrite xley ylex. - by move=> x y z; apply: le_trans. - move=> x y; rewrite lt_neqAle; split. + by move=> /andP[/eqP yneqx ->]; split. + by move=> [-> /eqP ->]. - move=> x y; case: (ltgtP x y) => [xlty|yltx|<-]. + by left. + by right; right. + by right; left. - by move=> x y z; rewrite lerD2l. - exact: mulr_gt0. - by apply/eqP; rewrite eq_sym oner_neq0. Qed. Lemma Rpower : power_theory 1 *%R eq nat_of_N (@GRing.exp R). Proof. apply: mkpow_th => x n; case: n => [//|p]; elim: p => [p|p|//] /= IHp. - by rewrite Pos2Nat.inj_xI exprS multE mulnC exprM expr2 IHp. - by rewrite Pos2Nat.inj_xO multE mulnC exprM expr2 IHp. Qed. Lemma RSORaddon : @SORaddon R 0 1 +%R *%R (fun x y => x - y) -%R eq (fun x y => x <= y) (* ring elements *) Z Z0 (Zpos 1) Z.add Z.mul Z.sub Z.opp Z.eqb Z.leb (* coefficients *) (fun n => (int_of_Z n)%:~R) nat nat_of_N (@GRing.exp R). Proof. apply: mk_SOR_addon. - exact: RZ. - exact: Rpower. - by move=> x y ? /intr_inj; lia. - by move=> x y; rewrite ler_int; lia. Qed. End RealDomain. Section RealField. Variable F : realFieldType. Lemma R_of_Q_eq x y : Qeq_bool x y = (R_of_Q x == R_of_Q y :> F). Proof. rewrite /Qeq_bool /R_of_Q /= eqr_div ?pnatr_eq0; try lia. rewrite !pmulrn -!intrM eqr_int -!/(int_of_Z (Z.pos _)) -!rmorphM /=. by rewrite (can_eq int_of_ZK); apply/idP/eqP => /Zeq_is_eq_bool. Qed. Lemma R_of_Q_le x y : Qle_bool x y = (R_of_Q x <= R_of_Q y :> F). Proof. rewrite /Qle_bool /R_of_Q /=. rewrite ler_pdivrMr ?ltr0n; last lia. rewrite mulrAC ler_pdivlMr ?ltr0n; last lia. rewrite !pmulrn -!intrM ler_int; lia. Qed. Lemma FQ : ring_morph 0 1 +%R *%R (fun x y : F => x - y) -%R eq 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool R_of_Q. Proof. apply: mkmorph. - exact: R_of_Q0. - exact: R_of_Q1. - exact: R_of_Q_add. - exact: R_of_Q_sub. - exact: R_of_Q_mul. - exact: R_of_Q_opp. - by move=> x y; rewrite R_of_Q_eq => /eqP. Qed. Lemma FSORaddon : @SORaddon F 0 1 +%R *%R (fun x y => x - y) -%R eq (fun x y => x <= y) (* ring elements *) Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool Qle_bool (* coefficients *) R_of_Q nat nat_of_N (@GRing.exp F). Proof. apply: mk_SOR_addon. - exact: FQ. - exact: Rpower. - by move=> x y; rewrite R_of_Q_eq => /eqP. - by move=> x y; rewrite R_of_Q_le. Qed. End RealField. Elpi Db canonicals.db lp:{{ pred canonical-nat-nmodule o:constant. pred canonical-nat-semiring o:constant. pred canonical-nat-comsemiring o:constant. pred canonical-N-nmodule o:constant. pred canonical-N-semiring o:constant. pred canonical-N-comsemiring o:constant. pred canonical-int-nmodule o:constant. pred canonical-int-zmodule o:constant. pred canonical-int-semiring o:constant. pred canonical-int-ring o:constant. pred canonical-int-comring o:constant. pred canonical-int-unitring o:constant. pred canonical-Z-nmodule o:constant. pred canonical-Z-zmodule o:constant. pred canonical-Z-semiring o:constant. pred canonical-Z-ring o:constant. pred canonical-Z-comring o:constant. pred canonical-Z-unitring o:constant. pred coercion o:string o:term. }}. algebra-tactics-1.2.4/theories/field_tac.elpi000066400000000000000000000001171474420016100211500ustar00rootroot00000000000000shorten coq.ltac.{ open, all }. msolve GL SubGL :- all (open field) GL SubGL. algebra-tactics-1.2.4/theories/lra.elpi000066400000000000000000001046731474420016100200300ustar00rootroot00000000000000% [target-unitring R] asserts that the target carrier type has the unit ring % instance [R]. pred target-unitring o:term. % Type to contain the carrier type and structure instances attached to it kind carrier type. type carrier term -> % Type term -> % eqType term -> % porderType term -> % nmodType term -> % zmodType term -> % semiRingType term -> % ringType term -> % unitRingType option term -> % fieldType term -> % realDomainType option term -> % realFieldType carrier. pred carrier->rmorphism i:carrier, o:rmorphism. carrier->rmorphism (carrier _ _ _ U V SR R UR F' _ _) (rmorphism U (some V) SR (some R) (some UR) F' (x\ x)) :- !. pred carrier->type i:carrier, o:term. carrier->type (carrier Ty _ _ _ _ _ _ _ _ _ _) Ty :- !. pred carrier->eq i:carrier, o:term. carrier->eq (carrier _ EQ _ _ _ _ _ _ _ _ _) EQ :- !. pred carrier->porder i:carrier, o:term. carrier->porder (carrier _ _ PO _ _ _ _ _ _ _ _) PO :- !. pred carrier->ring i:carrier, o:term. carrier->ring (carrier _ _ _ _ _ _ R _ _ _ _) R :- !. pred carrier->realDomain i:carrier, o:term. carrier->realDomain (carrier _ _ _ _ _ _ _ _ _ RD _) RD :- !. pred carrier->realField i:carrier, o:term. carrier->realField (carrier _ _ _ _ _ _ _ _ _ _ (some RF)) RF :- !. pred mk-carrier i:term, o:carrier, o:list prop. mk-carrier Ty (carrier Ty EQ PO U V SR R UR F' RD RF') Env :- std.do! [ std.assert-ok! (coq.unify-eq Ty {{ Equality.sort lp:EQ }}) "Cannot find a declared eqType", std.assert-ok! (coq.unify-eq Ty {{ @Order.POrder.sort _ lp:PO }}) "Cannot find a declared porderType", std.assert-ok! (coq.unify-eq Ty {{ GRing.Nmodule.sort lp:U }}) "Cannot find a declared nmodType", std.assert-ok! (coq.unify-eq Ty {{ GRing.Zmodule.sort lp:V }}) "Cannot find a declared zmodType", std.assert-ok! (coq.unify-eq Ty {{ GRing.SemiRing.sort lp:SR }}) "Cannot find a declared semiRingType", std.assert-ok! (coq.unify-eq Ty {{ GRing.Ring.sort lp:R }}) "Cannot find a declared ringType", std.assert-ok! (coq.unify-eq Ty {{ GRing.UnitRing.sort lp:UR }}) "Cannot find a declared unitRingType", std.assert-ok! (coq.unify-eq Ty {{ Num.RealDomain.sort lp:RD }}) "Cannot find a declared realDomainType", if (coq.unify-eq Ty {{ GRing.Field.sort lp:F }} ok, coq.unify-eq Ty {{ Num.RealField.sort lp:RF }} ok) (F' = some F, RF' = some RF, Env = [field-mode, target-nmodule U, target-semiring SR, target-zmodule V, target-unitring UR, (pi C C' In OutM Out VM\ quote.exprw C In OutM Out VM :- !, carrier->rmorphism C C', quote.lra.ring ff C' In OutM Out VM)]) (F' = none, RF' = none, Env = [target-nmodule U, target-semiring SR, target-zmodule V, target-unitring UR, (pi C C' In OutM Out VM\ quote.exprw C In OutM Out VM :- !, carrier->rmorphism C C', quote.ring C' In OutM Out VM)]) ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Parse goal (and hypotheses) to extract a realFieldType or realDomainType % from (in)equalities it contains % carrier type from a term of type bool pred rfstr.bool i:term, o:carrier, o:list prop. rfstr.bool {{ lp:Ty1 ==> lp:Ty2 }} C Env :- !, (rfstr.bool Ty2 C Env; rfstr.bool Ty1 C Env). rfstr.bool {{ ~~ lp:Ty }} C Env :- !, rfstr.bool Ty C Env. rfstr.bool {{ lp:Ty1 && lp:Ty2 }} C Env :- !, (rfstr.bool Ty2 C Env; rfstr.bool Ty1 C Env). rfstr.bool {{ lp:Ty1 || lp:Ty2 }} C Env :- !, (rfstr.bool Ty2 C Env; rfstr.bool Ty1 C Env). rfstr.bool {{ @Order.le _ lp:Ty _ _ }} C Env :- !, mk-carrier {{ @Order.POrder.sort _ lp:Ty }} C Env. rfstr.bool {{ @Order.lt _ lp:Ty _ _ }} C Env :- !, mk-carrier {{ @Order.POrder.sort _ lp:Ty }} C Env. % carrier type from a term of type Prop pred rfstr.prop i:term, o:carrier, o:list prop. rfstr.prop {{ lp:Ty1 -> lp:Ty2 }} C Env :- !, (rfstr.prop Ty2 C Env; rfstr.prop Ty1 C Env). rfstr.prop {{ iff lp:Ty1 lp:Ty2 }} C Env :- !, (rfstr.prop Ty2 C Env; rfstr.prop Ty1 C Env). rfstr.prop {{ ~ lp:Type }} C Env :- !, rfstr.prop Type C Env. rfstr.prop {{ lp:Ty1 /\ lp:Ty2 }} C Env :- !, (rfstr.prop Ty2 C Env; rfstr.prop Ty1 C Env). rfstr.prop {{ lp:Ty1 \/ lp:Ty2 }} C Env :- !, (rfstr.prop Ty2 C Env; rfstr.prop Ty1 C Env). rfstr.prop {{ is_true lp:Ty }} C Env :- !, rfstr.bool Ty C Env. rfstr.prop {{ @eq lp:Bool lp:Ty1 lp:Ty2 }} C Env :- coq.unify-eq Bool {{ bool }} ok, !, (rfstr.bool Ty2 C Env; rfstr.bool Ty1 C Env). rfstr.prop {{ @eq lp:Ty _ _ }} C Env :- !, mk-carrier Ty C Env. pred rfstr.hyps i:list prop, o:carrier, o:list prop. rfstr.hyps [decl _ _ H|_] C Env :- rfstr.prop H C Env. rfstr.hyps [_|Ctx] C Env :- rfstr.hyps Ctx C Env. pred rfstr i:list prop, i:term, o:carrier, o:list prop. rfstr _ Type C Env :- rfstr.prop Type C Env, !. rfstr Ctx _ C Env :- rfstr.hyps {std.rev Ctx} C Env, !. rfstr _ _ _ _ :- coq.ltac.fail 0 "Cannot find a realDomainType". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Reification procedure namespace quote { % Constructors for reified terms build.variable In {{ @PEX Q lp:In }} :- !. build.zero {{ @PEc Q (Qmake Z0 1) }} :- !. build.opp In {{ @PEopp Q lp:In }} :- !. build.add In1 In2 {{ @PEadd Q lp:In1 lp:In2 }} :- !. build.sub In1 In2 {{ @PEsub Q lp:In1 lp:In2 }} :- !. build.one {{ @PEc Q (Qmake (Zpos xH) 1) }} :- !. build.mul In1 In2 {{ @PEmul Q lp:In1 lp:In2 }} :- !. build.exp In1 In2 {{ @PEpow Q lp:In1 lp:In2 }} :- !. build.Z-constant In {{ @PEc Q (Qmake lp:In 1) }} :- !. build.N-constant {{ N0 }} {{ @PEc Q (Qmake 0 1) }} :- !. build.N-constant {{ Npos lp:In }} {{ @PEc Q (Qmake (Zpos lp:In) 1) }} :- !. pred build.invZ-constant i:bool, i:term, o:term. build.invZ-constant ff In {{ @PEc Q (Qmake lp:In 1) }} :- !. build.invZ-constant tt {{ Z0 }} {{ @PEc Q (Qmake 0 1) }} :- !. build.invZ-constant tt {{ Zpos lp:In }} {{ @PEc Q (Qmake 1 lp:In) }} :- !. build.invZ-constant tt {{ Zneg lp:In }} {{ @PEc Q (Qmake (-1) lp:In) }} :- !. pred build.invN-constant i:bool, i:term, o:term. build.invN-constant _ {{ N0 }} {{ @PEc Q (Qmake Z0 1) }} :- !. build.invN-constant ff {{ Npos lp:In }} {{ @PEc Q (Qmake (Zpos lp:In) 1) }} :- ground-pos In, !. build.invN-constant tt {{ Npos lp:In }} {{ @PEc Q (Qmake 1 lp:In) }} :- ground-pos In, !. % GFormula constructors pred build.implb i:term, i:term, o:term. build.implb {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isBool (lp:In1 ==> lp:In2) }} :- !. build.implb In1 In2 {{ IMPL lp:In1 None lp:In2 }} :- !. pred build.andb i:term, i:term, o:term. build.andb {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isBool (lp:In1 && lp:In2) }} :- !. build.andb In1 In2 {{ AND lp:In1 lp:In2 }} :- !. pred build.orb i:term, i:term, o:term. build.orb {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isBool (lp:In1 || lp:In2) }} :- !. build.orb In1 In2 {{ OR lp:In1 lp:In2 }} :- !. pred build.negb i:term, o:term. build.negb {{ X _ lp:In1 }} {{ X isBool (~~ lp:In1) }} :- !. build.negb In {{ NOT lp:In }} :- !. pred build.implp i:term, i:term, o:term. build.implp {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isProp (lp:In1 -> lp:In2) }} :- !. build.implp In1 In2 {{ IMPL lp:In1 None lp:In2 }} :- !. pred build.iffp i:term, i:term, o:term. build.iffp {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isProp (iff lp:In1 lp:In2) }} :- !. build.iffp In1 In2 {{ IFF lp:In1 lp:In2 }} :- !. pred build.andp i:term, i:term, o:term. build.andp {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isProp (lp:In1 /\ lp:In2) }} :- !. build.andp In1 In2 {{ AND lp:In1 lp:In2 }} :- !. pred build.orp i:term, i:term, o:term. build.orp {{ X _ lp:In1 }} {{ X _ lp:In2 }} {{ X isProp (lp:In1 \/ lp:In2) }} :- !. build.orp In1 In2 {{ OR lp:In1 lp:In2 }} :- !. pred build.negp i:term, o:term. build.negp {{ X _ lp:In1 }} {{ X isProp (~ lp:In1) }} :- !. build.negp In {{ NOT lp:In }} :- !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% namespace lra { pred cond-inv i:bool, i:term, o:term. cond-inv ff In In :- !. cond-inv tt In {{ @GRing.inv lp:TUR lp:In }} :- !, target-unitring TUR. % [quote.lra.nmod Inv C Input OutM Out VM] reifies an expression [Input] % under the additive morphism [C] % - [Inv] if [tt] then [Out] encodes the multiplicative inverse of [Input], % - [C] stores instances on the carrier type and the additive function from it, % - [Input] is a term of the carrier type, % - [OutM] is a reified terms of [Input] of type [RExpr C], % it is such that [Meval OutM] is exactly [Input], % - [Out] is a reified term of [Input] built by build.*, % it has morphisms pushed inward such that the eval of [Out] % is [Lra.Mnorm OutM] % - [VM] is a variable map. pred nmod i:bool, i:additive, i:term, o:term, o:term, o:list term. % _ : _ nmod Inv C {{ lp:In : _ }} OutM Out VM :- !, nmod Inv C In OutM Out VM. % 0%R nmod _ (additive U _ _) {{ @GRing.zero lp:U' }} {{ @M0 lp:U }} Out _ :- coq.unify-eq U U' ok, !, build.zero Out. % +%R nmod ff (additive U _ _ as C) {{ @GRing.add lp:U' lp:In1 lp:In2 }} {{ @MAdd lp:U lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq U U' ok, !, nmod ff C In1 OutM1 Out1 VM, !, nmod ff C In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % (_ *+ _)%R nmod Inv (additive U _ _ as C) {{ @GRing.natmul lp:U' lp:In1 lp:In2 }} {{ @MMuln lp:U lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq U U' ok, !, nmod Inv C In1 OutM1 Out1 VM, !, ring Inv rmorphism-nat In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % -%R nmod Inv (additive _ (some U) _ as C) {{ @GRing.opp lp:U' lp:In1 }} {{ @MOpp lp:U lp:OutM1 }} Out VM :- coq.unify-eq U U' ok, !, nmod Inv C In1 OutM1 Out1 VM, !, build.opp Out1 Out. % (_ *~ _)%R nmod Inv (additive _ (some U) _ as C) {{ @intmul lp:U' lp:In1 lp:In2 }} {{ @MMulz lp:U lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq U U' ok, !, nmod Inv C In1 OutM1 Out1 VM, !, ring Inv rmorphism-int In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % additive functions nmod Inv (additive U _ _ as C) In OutM Out VM :- % TODO: for concrete additive functions, should we unpack [NewMorphInst]? NewMorph = (x\ {{ @GRing.Additive.sort lp:V lp:U lp:NewMorphInst lp:x }}), coq.unify-eq In (NewMorph In1) ok, !, nmod.additive Inv V C NewMorph NewMorphInst In1 OutM Out VM. % variables nmod Inv (additive U _ Morph) In {{ @MX lp:U lp:In }} Out VM :- mem VM { cond-inv Inv (Morph In) } N, !, build.variable { positive-constant {calc (N + 1)} } Out. nmod _ _ In _ _ _ :- coq.error "Unknown" {coq.term->string In}. pred nmod.additive i:bool, i:term, i:additive, i:term -> term, i:term, i:term, o:term, o:term, o:list term. nmod.additive Inv V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MnatAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-nat-nmodule })) ok, mem VM { cond-inv Inv (Morph (NewMorph {{ 1%N }})) } N, !, ring Inv rmorphism-nat In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive Inv V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MNAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-N-nmodule })) ok, mem VM { cond-inv Inv (Morph (NewMorph {{ 1%num }})) } N, !, ring Inv rmorphism-N In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive Inv V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MintAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-int-nmodule })) ok, mem VM { cond-inv Inv (Morph (NewMorph {{ 1%Z }})) } N, !, ring Inv rmorphism-int In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive Inv V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MZAdditive lp:U lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-Z-nmodule })) ok, mem VM { cond-inv Inv (Morph (NewMorph {{ Zpos 1 }})) } N, !, ring Inv rmorphism-Z In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. nmod.additive Inv V (additive U _ Morph) NewMorph NewMorphInst In1 {{ @MAdditive lp:V lp:U lp:NewMorphInst lp:OutM1 }} Out1 VM :- !, if (coq.unify-eq {{ GRing.Nmodule.sort lp:V }} {{ GRing.Zmodule.sort lp:V' }} ok) (V'' = some V') (V'' = none), !, nmod Inv (additive V V'' (x\ Morph (NewMorph x))) In1 OutM1 Out1 VM. % [quote.lra.ring Inv C Input OutM Out VM] reifies an expression [Input] % under the ring morphism [C] % - [Inv] if [tt] then [Out] encodes the multiplicative inverse of [Input], % - [C] stores instances on the carrier type and the (semi)ring homomorphism % from it, % - [Input] is a term of the carrier type, % - [OutM] is a reified terms of [Input] of type [RExpr C], % it is such that [Reval OutM] is exactly [Input], % - [Out] is a reified term of [Input] built by build.*, % it has morphisms pushed inward such that the eval of [Out] % is [Lra.Rnorm OutM] % - [VM] is a variable map. pred ring i:bool, i:rmorphism, i:term, o:term, o:term, o:list term. % _ : _ ring Inv C {{ lp:In : _ }} OutM Out VM :- !, ring Inv C In OutM Out VM. % 0%R ring _ C {{ @GRing.zero lp:U }} {{ @R0 lp:R }} Out _ :- coq.unify-eq { rmorphism->nmod C } U ok, rmorphism->sring C R, !, build.zero Out. % +%R ring ff C {{ @GRing.add lp:U lp:In1 lp:In2 }} {{ @RAdd lp:R lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq { rmorphism->nmod C } U ok, rmorphism->sring C R, !, ring ff C In1 OutM1 Out1 VM, !, ring ff C In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % addn ring ff rmorphism-nat {{ addn lp:In1 lp:In2 }} {{ @RnatAdd lp:OutM1 lp:OutM2 }} Out VM :- !, ring ff rmorphism-nat In1 OutM1 Out1 VM, !, ring ff rmorphism-nat In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % N.add ring ff rmorphism-N {{ N.add lp:In1 lp:In2 }} {{ @RNAdd lp:OutM1 lp:OutM2 }} Out VM :- !, ring ff rmorphism-N In1 OutM1 Out1 VM, !, ring ff rmorphism-N In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % Z.add ring ff rmorphism-Z {{ Z.add lp:In1 lp:In2 }} {{ @RZAdd lp:OutM1 lp:OutM2 }} Out VM :- !, ring ff rmorphism-Z In1 OutM1 Out1 VM, !, ring ff rmorphism-Z In2 OutM2 Out2 VM, !, build.add Out1 Out2 Out. % (_ *+ _)%R ring Inv C {{ @GRing.natmul lp:U lp:In1 lp:In2 }} {{ @RMuln lp:R lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq { rmorphism->nmod C } U ok, rmorphism->sring C R, !, ring Inv C In1 OutM1 Out1 VM, !, ring Inv rmorphism-nat In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % -%R ring Inv C {{ @GRing.opp lp:U lp:In1 }} {{ @ROpp lp:R lp:OutM1 }} Out VM :- coq.unify-eq { rmorphism->zmod C } U ok, rmorphism->ring C R, !, ring Inv C In1 OutM1 Out1 VM, !, build.opp Out1 Out. % Z.opp ring Inv rmorphism-Z {{ Z.opp lp:In1 }} {{ @RZOpp lp:OutM1 }} Out VM :- !, ring Inv rmorphism-Z In1 OutM1 Out1 VM, !, build.opp Out1 Out. % Z.sub ring ff rmorphism-Z {{ Z.sub lp:In1 lp:In2 }} {{ @RZSub lp:OutM1 lp:OutM2 }} Out VM :- !, ring ff rmorphism-Z In1 OutM1 Out1 VM, !, ring ff rmorphism-Z In2 OutM2 Out2 VM, !, build.sub Out1 Out2 Out. % (_ *~ _)%R ring Inv C {{ @intmul lp:U lp:In1 lp:In2 }} {{ @RMulz lp:R lp:OutM1 lp:OutM2 }} Out VM :- coq.unify-eq { rmorphism->zmod C } U ok, rmorphism->ring C R, !, ring Inv C In1 OutM1 Out1 VM, !, ring Inv rmorphism-int In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % 1%R ring _ C {{ @GRing.one lp:R' }} {{ @R1 lp:R }} Out _ :- rmorphism->sring C R, coq.unify-eq R R' ok, !, build.one Out. % *%R ring Inv C {{ @GRing.mul lp:R' lp:In1 lp:In2 }} {{ @RMul lp:R lp:OutM1 lp:OutM2 }} Out VM :- rmorphism->sring C R, coq.unify-eq R R' ok, !, ring Inv C In1 OutM1 Out1 VM, !, ring Inv C In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % muln ring Inv rmorphism-nat {{ muln lp:In1 lp:In2 }} {{ @RnatMul lp:OutM1 lp:OutM2 }} Out VM :- !, ring Inv rmorphism-nat In1 OutM1 Out1 VM, !, ring Inv rmorphism-nat In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % N.mul ring Inv rmorphism-N {{ N.mul lp:In1 lp:In2 }} {{ @RNMul lp:OutM1 lp:OutM2 }} Out VM :- !, ring Inv rmorphism-N In1 OutM1 Out1 VM, !, ring Inv rmorphism-N In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % Z.mul ring Inv rmorphism-Z {{ Z.mul lp:In1 lp:In2 }} {{ @RZMul lp:OutM1 lp:OutM2 }} Out VM :- !, ring Inv rmorphism-Z In1 OutM1 Out1 VM, !, ring Inv rmorphism-Z In2 OutM2 Out2 VM, !, build.mul Out1 Out2 Out. % (_ ^+ _)%R ring Inv C {{ @GRing.exp lp:R' lp:In1 lp:In2 }} {{ @RExpn lp:R lp:OutM1 lp:OutM2 }} Out VM :- rmorphism->sring C R, coq.unify-eq R R' ok, quote.n-const In2 OutM2 Out2, !, ring Inv C In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out. % (_ ^ _)%R ring Inv C {{ @exprz lp:R' lp:In1 lp:In2 }} OutM Out VM :- quote.z-const In2 Pos OutM2 Out2, rmorphism->uring C R, coq.unify-eq R R' ok, if (Pos = tt) (CONT = (!, ring Inv C In1 OutM1 Out1 VM, !, OutM = {{ @RExpPosz lp:R lp:OutM1 lp:OutM2 }}, !, build.exp Out1 Out2 Out)) (CONT = (rmorphism->field C F, !, ring { negb Inv } C In1 OutM1 Out1 VM, !, OutM = {{ @RExpNegz lp:F lp:OutM1 lp:OutM2 }}, !, build.exp Out1 Out2 Out)), CONT. % expn ring Inv rmorphism-nat {{ expn lp:In1 lp:In2 }} {{ @RnatExpn lp:OutM1 lp:OutM2 }} Out VM :- quote.n-const In2 OutM2 Out2, !, ring Inv rmorphism-nat In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out. % N.pow ring Inv rmorphism-N {{ N.pow lp:In1 lp:In2 }} {{ @RNExp lp:OutM1 lp:Out2 }} Out VM :- reduction-N In2 Out2, !, ring Inv rmorphism-N In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out. % Z.pow ring Inv rmorphism-Z {{ Z.pow lp:In1 lp:In2 }} {{ @RZExp lp:OutM1 lp:OutM2 }} Out VM :- reduction-Z In2 OutM2, !, ((OutM2 = {{ Z0 }}, !, Out2 = {{ N0 }}; % If [In2] is non-negative OutM2 = {{ Zpos lp:P }}, !, Out2 = {{ Npos lp:P }}), !, ring Inv rmorphism-Z In1 OutM1 Out1 VM, !, build.exp Out1 Out2 Out; build.zero Out). % If [In2] is negative % _^-1 ring Inv C {{ @GRing.inv lp:R lp:In1 }} {{ @RInv lp:F lp:OutM1 }} Out1 VM :- rmorphism->field C F, coq.unify-eq { rmorphism->uring C } R ok, !, ring { negb Inv } C In1 OutM1 Out1 VM. % S (..(S ..)..) and nat constants ring Inv rmorphism-nat {{ lib:num.nat.S lp:In }} OutM Out VM :- !, quote.count-succ In N In2, if (In2 = {{ lib:num.nat.O }}) (Cont = (OutM = {{ RnatC (large_nat_N lp:Out1) }}, !, build.invN-constant Inv Out1 Out)) (Inv = ff, Cont = (ring ff rmorphism-nat In2 OutM2 Out2 VM, !, OutM = {{ RnatS lp:Pos lp:OutM2 }}, !, build.add { build.invN-constant ff Out1 } Out2 Out)), !, positive-constant {calc (N + 1)} Pos, !, Out1 = {{ N.pos lp:Pos }}, !, Cont. ring Inv rmorphism-nat {{ lib:num.nat.O }} {{ RnatC (large_nat_N N0) }} Out _ :- !, build.invN-constant Inv {{ N0 }} Out. ring Inv rmorphism-nat {{ Nat.of_num_uint lp:In }} {{ RnatC (large_nat_uint lp:In) }} Out _ :- !, ground-uint In, !, coq.reduction.vm.norm {{ N.of_num_uint lp:In }} {{ N }} InN, !, build.invN-constant Inv InN Out. % Posz ring Inv rmorphism-int {{ Posz lp:In }} {{ @RPosz lp:OutM }} Out VM :- !, ring Inv rmorphism-nat In OutM Out VM. % Negz ring ff rmorphism-int {{ Negz lp:In }} {{ RNegz lp:OutM1 }} Out VM :- !, ring ff rmorphism-nat In OutM1 Out1 VM, !, build.opp { build.add { build.one } Out1 } Out. % N constants ring Inv rmorphism-N In {{ @RNC lp:In }} Out _ :- ground-N In, !, build.invN-constant Inv In Out. % Z constants ring Inv rmorphism-Z In {{ @RZC lp:In }} Out _ :- ground-Z In, !, build.invZ-constant Inv In Out. % morphisms ring Inv C In OutM Out VM :- rmorphism->sring C R, % TODO: for concrete additive functions, should we unpack [NewMorphInst]? NewMorph = (x\ {{ @GRing.RMorphism.sort lp:S lp:R lp:NewMorphInst lp:x }}), coq.unify-eq In (NewMorph In1) ok, !, ring.rmorphism Inv S C NewMorph NewMorphInst In1 OutM Out VM. % additive functions ring Inv C In OutM Out VM :- rmorphism->nmod C U, % TODO: for concrete additive functions, should we unpack [NewMorphInst]? NewMorph = (x\ {{ @GRing.Additive.sort lp:V lp:U lp:NewMorphInst lp:x }}), coq.unify-eq In (NewMorph In1) ok, !, ring.additive Inv V C NewMorph NewMorphInst In1 OutM Out VM. % variables ring Inv C In {{ @RX lp:R lp:In }} Out VM :- !, rmorphism->sring C R, rmorphism->morph C Morph, mem VM { cond-inv Inv (Morph In) } N, !, build.variable { positive-constant {calc (N + 1)} } Out. ring _ _ In _ _ _ :- coq.error "Unknown" {coq.term->string In}. % TODO: converse ring pred ring.rmorphism.aux i:term, i:term -> term, o:rmorphism. ring.rmorphism.aux SR Morph (rmorphism U V' SR R' UR' F' Morph) :- !, Sort = {{ GRing.SemiRing.sort lp:SR }}, coq.unify-eq Sort {{ GRing.Nmodule.sort lp:U }} ok, if (target-zmodule _, coq.unify-eq Sort {{ GRing.Ring.sort lp:R }} ok, coq.unify-eq Sort {{ GRing.Zmodule.sort lp:V }} ok) (V' = some V, R' = some R, if (coq.unify-eq Sort {{ GRing.UnitRing.sort lp:UR }} ok) (UR' = some UR, if (field-mode, coq.unify-eq Sort {{ GRing.Field.sort lp:F }} ok) (F' = some F) (F' = none)) (UR' = none, F' = none)) (V' = none, R' = none, UR' = none, F' = none). pred ring.rmorphism i:bool, i:term, i:rmorphism, i:term -> term, i:term, i:term, o:term, o:term, o:list term. ring.rmorphism Inv S C _ NewMorphInst In1 {{ @RnatMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- coq.unify-eq S (global (const { canonical-nat-semiring })) ok, !, rmorphism->sring C R, !, ring Inv rmorphism-nat In1 OutM1 Out1 VM. ring.rmorphism Inv S C _ NewMorphInst In1 {{ @RNMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- coq.unify-eq S (global (const { canonical-N-semiring })) ok, !, rmorphism->sring C R, !, ring Inv rmorphism-N In1 OutM1 Out1 VM. ring.rmorphism Inv S C _ NewMorphInst In1 {{ @RintMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- coq.unify-eq S (global (const { canonical-int-semiring })) ok, !, rmorphism->sring C R, !, ring Inv rmorphism-int In1 OutM1 Out1 VM. ring.rmorphism Inv S C _ NewMorphInst In1 {{ @RZMorph lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- coq.unify-eq S (global (const { canonical-Z-semiring })) ok, !, rmorphism->sring C R, !, ring Inv rmorphism-Z In1 OutM1 Out1 VM. ring.rmorphism Inv S C NewMorph NewMorphInst In1 {{ @RMorph lp:S lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- !, rmorphism->sring C R, !, rmorphism->morph C Morph, !, ring.rmorphism.aux S (x\ Morph (NewMorph x)) C', !, ring Inv C' In1 OutM1 Out1 VM. pred ring.additive i:bool, i:term, i:rmorphism, i:term -> term, i:term, i:term, o:term, o:term, o:list term. ring.additive Inv V C NewMorph NewMorphInst In1 {{ @RnatAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-nat-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM { cond-inv Inv (Morph (NewMorph {{ 1%N }})) } N, !, ring Inv rmorphism-nat In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive Inv V C NewMorph NewMorphInst In1 {{ @RNAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-N-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM { cond-inv Inv (Morph (NewMorph {{ 1%num }})) } N, !, ring Inv rmorphism-N In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive Inv V C NewMorph NewMorphInst In1 {{ @RintAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-int-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM { cond-inv Inv (Morph (NewMorph {{ 1%Z }})) } N, !, ring Inv rmorphism-int In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive Inv V C NewMorph NewMorphInst In1 {{ @RZAdditive lp:R lp:NewMorphInst lp:OutM1 }} Out VM :- coq.unify-eq V (global (const { canonical-Z-nmodule })) ok, rmorphism->sring C R, rmorphism->morph C Morph, mem VM { cond-inv Inv (Morph (NewMorph {{ Zpos 1 }})) } N, !, ring Inv rmorphism-Z In1 OutM1 Out1 VM, !, build.mul { build.variable { positive-constant {calc (N + 1)} } } Out1 Out. ring.additive Inv V C NewMorph NewMorphInst In1 {{ @RAdditive lp:V lp:R lp:NewMorphInst lp:OutM1 }} Out1 VM :- !, rmorphism->sring C R, rmorphism->morph C Morph, if (coq.unify-eq {{ GRing.Nmodule.sort lp:V }} {{ GRing.Zmodule.sort lp:V' }} ok) (V'' = some V') (V'' = none), !, nmod Inv (additive V V'' (x\ Morph (NewMorph x))) In1 OutM1 Out1 VM, !. } % [quote.exprw C In OutM Out VM] reifies arithmetic expressions % (should be instantiated by each tactic call) % - [C] is the carrier type and structure instances, % - [In] is a term of type [C], % - [OutM] is a reified expression of type [RExpr C], % - [Out] is a reified expression of type [PExpr Q], and % - [VM] is a variable map, that is a list of terms of type [C]. pred exprw i:carrier, i:term, o:term, o:term, o:list term. % [quote.bop2 C In OutM Out VM] reifies boolean (in)equalities % - [C] is the carrier type and structure instances, % - [In] is a term of type [bool], % - [OutM] is a reified expression of type [RFormula C], % - [Out] is a reified expression of type [Formula Q], and % - [VM] is a variable map, that is a list of terms of type [C]. pred bop2 i:carrier, i:term, o:term, o:term, o:list term. bop2 C {{ @Order.le _ lp:O lp:X lp:Y }} {{ Build_RFormula lp:XM' OpLe lp:YM' }} {{ Build_Formula lp:X' OpLe lp:Y' }} VM :- coq.unify-eq { carrier->porder C } O ok, !, exprw C X XM' X' VM, !, exprw C Y YM' Y' VM. bop2 C {{ @Order.lt _ lp:O lp:X lp:Y }} {{ Build_RFormula lp:XM' OpLt lp:YM' }} {{ Build_Formula lp:X' OpLt lp:Y' }} VM :- coq.unify-eq { carrier->porder C } O ok, !, exprw C X XM' X' VM, !, exprw C Y YM' Y' VM. bop2 C {{ @eq_op lp:T lp:X lp:Y }} {{ Build_RFormula lp:XM' OpEq lp:YM' }} {{ Build_Formula lp:X' OpEq lp:Y' }} VM :- coq.unify-eq { carrier->eq C } T ok, !, exprw C X XM' X' VM, !, exprw C Y YM' Y' VM. % [quote.pop2 C In OutM Out VM] reifies (in)equalities of type Prop % - [C] is the carrier type and structure instances, % - [In] is a term of type [Prop], % - [OutM] is a reified expression of type [RFormula C], % - [Out] is a reified expression of type [Formula Q], and % - [VM] is a variable map, that is a list of terms of type [C]. pred pop2 i:carrier, i:term, o:term, o:term, o:list term. pop2 C {{ is_true lp:E }} OutM Out VM :- bop2 C E OutM Out VM. pop2 C {{ @eq lp:T lp:X lp:Y }} {{ Build_RFormula lp:XM' OpEq lp:YM' }} {{ Build_Formula lp:X' OpEq lp:Y' }} VM :- coq.unify-eq { carrier->type C } T ok, !, exprw C X XM' X' VM, !, exprw C Y YM' Y' VM. % [quote.boolean C In OutM Out VM] reifies boolean formulas % - [C] is the carrier type and structure instances, % - [In] is a term of type [bool], % - [OutM] is a reified formula of type [BFormula (RFormula C) isBool], % - [Out] is a reified formula of type [BFormula (Formula Q) isBool], and % - [VM] is a variable map, that is a list of terms of type [C]. pred boolean i:carrier, i:term, o:term, o:term, o:list term. boolean C {{ lp:In1 ==> lp:In2 }} OutM Out VM :- !, std.do! [boolean C In1 OutM1 Out1 VM, boolean C In2 OutM2 Out2 VM, build.implb OutM1 OutM2 OutM, build.implb Out1 Out2 Out]. boolean C {{ lp:In1 && lp:In2 }} OutM Out VM :- !, std.do! [boolean C In1 OutM1 Out1 VM, boolean C In2 OutM2 Out2 VM, build.andb OutM1 OutM2 OutM, build.andb Out1 Out2 Out]. boolean C {{ lp:In1 || lp:In2 }} OutM Out VM :- !, std.do! [boolean C In1 OutM1 Out1 VM, boolean C In2 OutM2 Out2 VM, build.orb OutM1 OutM2 OutM, build.orb Out1 Out2 Out]. boolean C {{ ~~ lp:In1 }} OutM Out VM :- !, std.do! [boolean C In1 OutM1 Out1 VM, build.negb OutM1 OutM, build.negb Out1 Out]. boolean _ {{ true }} {{ TT isBool }} {{ TT isBool }} _ :- !. boolean _ {{ false }} {{ FF isBool }} {{ FF isBool }} _ :- !. boolean C In {{ A isBool lp:OutM tt }} {{ A isBool lp:Out tt }} VM :- bop2 C In OutM Out VM. boolean _ In {{ X isBool lp:In }} {{ X isBool lp:In }} _ :- !. % [quote.proposition C In OutM Out VM] reifies formulas of type Prop % - [C] is the carrier type and structure instances, % - [In] is a term of type [Prop], % - [OutM] is a reified formula of type [BFormula (RFormula C) isProp], % - [Out] is a reified formula of type [BFormula (Formula Q) isProp], and % - [VM] is a variable map, that is a list of terms of type [C]. pred proposition i:carrier, i:term, o:term, o:term, o:list term. proposition C {{ lp:In1 -> lp:In2 }} OutM Out VM :- !, std.do! [proposition C In1 OutM1 Out1 VM, proposition C In2 OutM2 Out2 VM, build.implp OutM1 OutM2 OutM, build.implp Out1 Out2 Out]. proposition C {{ iff lp:In1 lp:In2 }} OutM Out VM :- !, std.do! [proposition C In1 OutM1 Out1 VM, proposition C In2 OutM2 Out2 VM, build.iffp OutM1 OutM2 OutM, build.iffp Out1 Out2 Out]. proposition C {{ lp:In1 /\ lp:In2 }} OutM Out VM :- !, std.do! [proposition C In1 OutM1 Out1 VM, proposition C In2 OutM2 Out2 VM, build.andp OutM1 OutM2 OutM, build.andp Out1 Out2 Out]. proposition C {{ lp:In1 \/ lp:In2 }} OutM Out VM :- !, std.do! [proposition C In1 OutM1 Out1 VM, proposition C In2 OutM2 Out2 VM, build.orp OutM1 OutM2 OutM, build.orp Out1 Out2 Out]. proposition C {{ ~ lp:In1 }} OutM Out VM :- !, std.do! [proposition C In1 OutM1 Out1 VM, build.negp OutM1 OutM, build.negp Out1 Out]. proposition _ {{ True }} {{ TT isProp }} {{ TT isProp }} _ :- !. proposition _ {{ False }} {{ FF isProp }} {{ FF isProp }} _ :- !. proposition C {{ is_true lp:In1 }} {{ EQ lp:OutM1 (TT isBool) }} {{ EQ lp:Out1 (TT isBool) }} VM :- !, boolean C In1 OutM1 Out1 VM, !. proposition C {{ @eq lp:Bool lp:In1 lp:In2 }} OutM Out VM :- coq.unify-eq Bool {{ bool }} ok, !, boolean C In1 OutM1 Out1 VM, !, boolean C In2 OutM2 Out2 VM, !, OutM = {{ EQ lp:OutM1 lp:OutM2 }}, !, Out = {{ EQ lp:Out1 lp:Out2 }}. proposition C In {{ A isProp lp:OutM tt }} {{ A isProp lp:Out tt }} VM :- pop2 C In OutM Out VM. proposition _ In {{ X isProp lp:In }} {{ X isProp lp:In }} _ :- !. % [quote.goal C Ctx Goal Goal' NS OutM Out VM] reifies the goal [Goal], % including the arithmetic hypotheses in the context [Ctx], in the form of % implication chain % - [C] is the carrier type and structure instances, % - [Ctx] is the context (hypotheses), % - [Goal] is the goal, of type [Prop], % - [Goal'] is a chain of implications including [Goal] and hypotheses in [Hyps] % that have some arithmetic contents, % - [NS] are the names of arithmetic hypotheses in [Ctx] added to [Goal'], % - [OutM] is the reified term of type [BFormula (RFormula C) isProp], % - [ReifiedOut] is the reified term of type [BFormula (Formula Q) isProp], and % - [VM] is a variable map, that is a list of terms of type [C]. pred goal i:carrier, i:list prop, i:term, o:term, o:list term, o:term, o:term, o:list term. goal C [decl N _ In1|Ctx] Type {{ lp:In1 -> lp:Type' }} [N|NS] {{ IMPL lp:OutM1 None lp:OutM2 }} {{ IMPL lp:Out1 None lp:Out2 }} VM :- proposition C In1 OutM1 Out1 VM, not (Out1 = {{ X _ _ }}), !, goal C Ctx Type Type' NS OutM2 Out2 VM. goal C [_|Ctx] Type Type' NS OutM Out VM :- !, goal C Ctx Type Type' NS OutM Out VM. goal C [] Type Type [] OutM Out VM :- !, proposition C Type OutM Out VM. } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Main tactic % [exfalso_if_not_prop In Out Bool] changes [In] to [False] % when [In] is not a [Prop] (and then set [Bool] to [tt]) pred exfalso_if_not_prop i:term, o:term, o:bool. exfalso_if_not_prop Type Type ff :- coq.typecheck Type {{ Prop }} ok. exfalso_if_not_prop _ {{ False }} tt. pred gen-witness i:string, i:argument, i:term, i:goal, o:sealed-goal. gen-witness TacW N Out G G' :- coq.ltac.call TacW [N, trm Out] G [G']. gen-witness _ _ _ _ _ :- coq.ltac.fail 0 "Cannot find witness". pred lra-reflection i:string, i:term, i:term, i:term, i:term, i:term, i:goal, i:sealed-goal, o:list sealed-goal. lra-reflection Tac C Hyps OutM Out VM G G' GS :- coq.ltac.set-goal-arguments [trm C, trm Hyps, trm OutM, trm Out, trm VM] G G' G'', coq.ltac.open (g\ gs\ sigma Wit Args Args'\ % NB: the following line is very specific to the current implementation of % the witness generators. We assume that the witness appears as the first % item of the context. g = goal [def Wit _ _ _|_] _ _ _ Args, std.append Args [trm Wit] Args', coq.ltac.call Tac Args' g gs) G'' GS. lra-reflection _ _ _ _ _ _ _ _ _ :- coq.ltac.fail 0 "Reflection failed, this is a bug". % The tactic takes four arguments: % - [TacW] is the name of the Ltac1 tactic that generates the witness, % - [TacF] and [TacR] are the names of the Ltac1 tactics to call respectively % in the [realFieldType] and [realDomainType] cases, and % - [N] is passed as is as the first argument of [TacW]. % The [TacW] tactic will receive [N] and the reified term [Out], explained % below, and the [TacF] or [TacR] tactic will receive six arguments: % - [N] above, % - [Hyps] a function of type % [(H1 -> ... -> Hn -> G) -> G] (if [G] is a [Prop]) or % [(H1 -> ... -> Hn -> False) -> G] (if [G] is not a [Prop]) % that explicitly passes hypotheses of types [H1], ..., [Hn] taken from the % context to the reflexive proof, % - [OutM] the reified goal as a [BFormula RFormula isProp], % - [Out] the reified goal as a [BFormula (Formula Q) isProp], and % - [VM'] a variable map, giving the interpretation to variables in [Out] % it is of type [VarMap.t C] where [C] is the carrier for the detected % [realFieldType] or [realDomainType]. solve (goal Ctx _ Type _ [str TacW, str TacF, str TacR, N] as G) GS :- std.do! [ exfalso_if_not_prop Type Type' Efalso, rfstr Ctx Type' C Env, Env => quote.goal C Ctx Type' Type'' NS OutM Out VM, carrier->ring C R, std.assert-ok! (coq.typecheck OutM {{ BFormula (@RFormula lp:R) isProp }}) "The reification produced an ill-typed result, this is a bug", std.assert-ok! (coq.typecheck Out {{ BFormula (Formula Q) isProp }}) "The reification produced an ill-typed result, this is a bug", gen-witness TacW N Out G G', list-constant { carrier->type C } VM VM', if (Efalso = tt) (Hyps = fun _ Type'' (x \ app [{{ False_rect }}, Type, app [x|NS]])) (Hyps = fun _ Type'' (x \ app [x|NS])), ((carrier->realField C C', Tac = TacF); (carrier->realDomain C C', Tac = TacR)), lra-reflection Tac C' Hyps OutM Out VM' G G' GS ]. algebra-tactics-1.2.4/theories/lra.v000066400000000000000000000367171474420016100173470ustar00rootroot00000000000000From elpi Require Import elpi. From Coq Require Import BinNat QArith Ring. From Coq.micromega Require Import RingMicromega QMicromega EnvRing Tauto Lqa. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat choice seq. From mathcomp Require Import fintype finfun bigop order ssralg ssrnum ssrint. From mathcomp.zify Require Import ssrZ zify. From mathcomp.algebra_tactics Require Import common. From mathcomp.algebra_tactics Extra Dependency "common.elpi" as common. From mathcomp.algebra_tactics Extra Dependency "lra.elpi" as lra. Import Order.TTheory GRing.Theory Num.Theory. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Module Import Internals. Implicit Types (k : kind) (R S : ringType) (F : fieldType). (* Define [Reval_formula] the semantics of [BFormula (Formula Z) Tauto.isProp] as arithmetic expressions on some [realDomainType]. Then prove [RTautoChecker_sound] stating that [ZTautoChecker f w = true] implies that the formula [Reval_formula f] holds. *) Record RFormula R := { Rlhs : RExpr R; Rop : Op2; Rrhs : RExpr R }. Section Rnorm_formula. Variables (R : numDomainType). Variables (R_of_Z : Z -> R) (R_of_ZE : R_of_Z = (fun n => (int_of_Z n)%:~R)). Variables (opp : R -> R) (oppE : opp = -%R). Variables (add : R -> R -> R) (addE : add = +%R). Variables (sub : R -> R -> R) (subE : sub = (fun x y => x - y)). Variables (mul : R -> R -> R) (mulE : mul = *%R). Variables (exp : R -> N -> R) (expE : exp = (fun x n => x ^+ nat_of_N n)). Variables (eqProp : R -> R -> Prop) (eqPropE : eqProp = eq). Variables (eqBool : R -> R -> bool) (eqBoolE : eqBool = eq_op). Variables (le : R -> R -> bool) (leE : le = <=%O). Variables (lt : R -> R -> bool) (ltE : lt = <%O). Local Notation Rnorm_expr := (Ring.Rnorm R_of_Z (R_of_Z 0) add opp sub (R_of_Z 1) mul exp). Definition Reval_pop2 (o : Op2) : R -> R -> Prop := match o with | OpEq => eqProp | OpNEq => fun x y => ~ eqProp x y | OpLe => le | OpGe => fun x y => le y x | OpLt => lt | OpGt => fun x y => lt y x end. Definition Reval_bop2 (o : Op2) : R -> R -> bool := match o with | OpEq => eqBool | OpNEq => fun x y => ~~ eqBool x y | OpLe => le | OpGe => fun x y => le y x | OpLt => lt | OpGt => fun x y => lt y x end. Definition Reval_op2 k : Op2 -> R -> R -> rtyp k := match k with isProp => Reval_pop2 | isBool => Reval_bop2 end. Definition Reval_formula k (ff : RFormula R) : rtyp k := let (lhs,o,rhs) := ff in Reval_op2 k o (Reval lhs) (Reval rhs). Definition Rnorm_formula k (ff : RFormula R) := let (lhs,o,rhs) := ff in Reval_op2 k o (Rnorm_expr id lhs) (Rnorm_expr id rhs). Lemma Rnorm_formula_correct k (ff : RFormula R) : Reval_formula k ff = Rnorm_formula k ff. Proof. case: ff => l o r /=. by rewrite !Ring.Rnorm_correct R_of_ZE addE oppE subE mulE expE. Qed. Lemma Rnorm_bf_correct k (ff : BFormula (RFormula R) k) : eval_bf Reval_formula ff = eval_bf Rnorm_formula ff. Proof. elim: ff => // {k}. - by move=> k ff ?; exact: Rnorm_formula_correct. - by move=> k ff1 IH1 ff2 IH2; congr eAND. - by move=> k ff1 IH1 ff2 IH2; congr eOR. - by move=> k ff IH; congr eNOT. - by move=> k ff1 IH1 o ff2 IH2; congr eIMPL. - by move=> k ff1 IH1 ff2 IH2; congr eIFF. - by move=> ff1 IH1 ff2 IH2; congr eq. Qed. Definition Reval_PFormula (e : PolEnv R) k (ff : Formula Z) : rtyp k := let eval := PEeval add mul sub opp R_of_Z id exp e in let (lhs,o,rhs) := ff in Reval_op2 k o (eval lhs) (eval rhs). Lemma pop2_bop2 (op : Op2) (q1 q2 : R) : Reval_bop2 op q1 q2 <-> Reval_pop2 op q1 q2. Proof. by case: op => //=; rewrite eqPropE eqBoolE; split => /eqP. Qed. Lemma Reval_formula_compat (env : PolEnv R) k (f : Formula Z) : hold k (Reval_PFormula env k f) <-> eval_formula add mul sub opp eqProp le lt R_of_Z id exp env f. Proof. by case: f => lhs op rhs; case: k => //=; rewrite pop2_bop2. Qed. End Rnorm_formula. Section RealDomain. Variable R : realDomainType. Notation Rsor := (Rsor R). Notation RSORaddon := (RSORaddon R). Definition ZTautoChecker (f : BFormula (Formula Z) isProp) (w: list (Psatz Z)) : bool := @tauto_checker (Formula Z) (NFormula Z) unit (check_inconsistent 0 Z.eqb Z.leb) (nformula_plus_nformula 0 Z.add Z.eqb) (@cnf_normalise Z 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb Z.leb unit) (@cnf_negate Z 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb Z.leb unit) (Psatz Z) (fun cl => check_normalised_formulas 0 1 Z.add Z.mul Z.eqb Z.leb (List.map fst cl)) f w. Definition Reval_nformula : PolEnv R -> NFormula Z -> Prop := eval_nformula 0 +%R *%R eq <=%O <%O (fun n => (int_of_Z n)%:~R). Lemma RTautoChecker_sound (ff : BFormula (RFormula R) isProp) (f : BFormula (Formula Z) isProp) (w : seq (Psatz Z)) (env : PolEnv R) : (forall R_of_Z opp add sub mul exp eqProp eqBool le lt, let norm_ff := Rnorm_formula R_of_Z opp add sub mul exp eqProp eqBool le lt in let eval_f := Reval_PFormula R_of_Z opp add sub mul exp eqProp eqBool le lt env in eval_bf norm_ff ff = eval_bf eval_f f) -> ZTautoChecker f w -> eval_bf (Reval_formula eq eq_op <=%O <%O) ff. Proof. rewrite (Rnorm_bf_correct erefl erefl erefl erefl erefl erefl). move=> /(_ _ _ _ (fun x y => x - y)) -> Hchecker. move: Hchecker env; apply: (tauto_checker_sound _ _ _ _ Reval_nformula). - exact: (eval_nformula_dec Rsor). - by move=> [? ?] ? ?; apply: (check_inconsistent_sound Rsor RSORaddon). - move=> t t' u deducett'u env evalt evalt'. exact: (nformula_plus_nformula_correct Rsor RSORaddon env t t'). - move=> env k t tg cnfff; rewrite Reval_formula_compat //. exact: (cnf_normalise_correct Rsor RSORaddon env t tg).1. - move=> env k t tg cnfff; rewrite hold_eNOT Reval_formula_compat //. exact: (cnf_negate_correct Rsor RSORaddon env t tg).1. - move=> t w0 checkw0 env; rewrite (Refl.make_impl_map (Reval_nformula env)) //. exact: (checker_nf_sound Rsor RSORaddon) checkw0 env. Qed. End RealDomain. Section Fnorm_formula. Variables (F : numFieldType). Variables (F_of_Q : Q -> F) (F_of_QE : F_of_Q = R_of_Q). Variables (opp : F -> F) (oppE : opp = -%R). Variables (add : F -> F -> F) (addE : add = +%R). Variables (sub : F -> F -> F) (subE : sub = (fun x y => x - y)). Variables (mul : F -> F -> F) (mulE : mul = *%R). Variables (exp : F -> N -> F) (expE : exp = (fun x n => x ^+ nat_of_N n)). Variables (eqProp : F -> F -> Prop) (eqPropE : eqProp = eq). Variables (eqBool : F -> F -> bool) (eqBoolE : eqBool = eq_op). Variables (le : F -> F -> bool) (leE : le = <=%O). Variables (lt : F -> F -> bool) (ltE : lt = <%O). Local Notation F_of_Z invb n := (if invb then F_of_Q (Qinv (Qmake n 1)) else F_of_Q (Qmake n 1)). Notation Fnorm_expr := (Lra.Rnorm (fun b n => F_of_Z b n) (F_of_Z false 0) add opp sub (F_of_Z false 1) mul exp GRing.inv false). Notation Feval_pop2 := (Reval_pop2 eqProp le lt). Notation Feval_bop2 := (Reval_bop2 eqBool le lt). Notation Feval_op2 := (Reval_op2 eqProp eqBool le lt). Notation Feval_formula := (Reval_formula eqProp eqBool le lt). Definition Fnorm_formula k (ff : RFormula F) := let (lhs,o,rhs) := ff in Feval_op2 k o (Fnorm_expr id lhs) (Fnorm_expr id rhs). Lemma Fnorm_formula_correct k (ff : RFormula F) : Feval_formula k ff = Fnorm_formula k ff. Proof. case: ff => l o r /=; rewrite !Lra.Rnorm_correct addE oppE subE mulE expE. rewrite F_of_QE /R_of_Q/= mul0r mul1r invr1. by congr Feval_op2; apply: Lra.Rnorm_eq => invb n; rewrite mulr1; case: n => [|p|p] /=; rewrite ?(invr0, mul0r, mul1r)//; rewrite mulNr -divrN mul1r NegzE prednK ?nmulrn//; lia. Qed. Lemma Fnorm_bf_correct k (ff : BFormula (RFormula F) k) : eval_bf Feval_formula ff = eval_bf Fnorm_formula ff. Proof. elim: ff => // {k}. - by move=> k ff ?; exact: Fnorm_formula_correct. - by move=> k ff1 IH1 ff2 IH2; congr eAND. - by move=> k ff1 IH1 ff2 IH2; congr eOR. - by move=> k ff IH; congr eNOT. - by move=> k ff1 IH1 o ff2 IH2; congr eIMPL. - by move=> k ff1 IH1 ff2 IH2; congr eIFF. - by move=> ff1 IH1 ff2 IH2; congr eq. Qed. Definition Feval_PFormula (e : PolEnv F) k (ff : Formula Q) : rtyp k := let eval := eval_pexpr add mul sub opp F_of_Q id exp e in let (lhs,o,rhs) := ff in Feval_op2 k o (eval lhs) (eval rhs). Lemma pop2_bop2' (op : Op2) (q1 q2 : F) : Feval_bop2 op q1 q2 <-> Feval_pop2 op q1 q2. Proof. by case: op => //=; rewrite eqPropE eqBoolE; split => /eqP. Qed. Lemma Feval_formula_compat env b f : hold b (Feval_PFormula env b f) <-> eval_formula add mul sub opp eqProp le lt F_of_Q id exp env f. Proof. by case: f => lhs op rhs; case: b => //=; rewrite pop2_bop2'. Qed. End Fnorm_formula. (* Define [Feval_formula] the semantics of [BFormula (Formula Q) Tauto.isProp] as arithmetic expressions on some [realFieldType]. Then prove [FTautoChecker_sound] stating that [QTautoChecker f w = true] implies that the formula [Feval_formula f] holds. *) Section RealField. Variable F : realFieldType. Notation Rsor := (Rsor F). Notation FSORaddon := (FSORaddon F). Definition Feval_nformula : PolEnv F -> NFormula Q -> Prop := eval_nformula 0 +%R *%R eq (fun x y => x <= y) (fun x y => x < y) R_of_Q. Lemma FTautoChecker_sound (ff : BFormula (RFormula F) isProp) (f : BFormula (Formula Q) isProp) (w : seq (Psatz Q)) (env : PolEnv F) : (forall F_of_Q opp add sub mul exp eqProp eqBool le lt, let norm_ff := Fnorm_formula F_of_Q opp add sub mul exp eqProp eqBool le lt in let eval_f := Feval_PFormula F_of_Q opp add sub mul exp eqProp eqBool le lt env in eval_bf norm_ff ff = eval_bf eval_f f) -> QTautoChecker f w -> eval_bf (Reval_formula eq eq_op <=%O <%O) ff. Proof. rewrite (Fnorm_bf_correct erefl erefl erefl erefl erefl erefl). move/(_ R_of_Q) => -> Hchecker. move: Hchecker env; apply: (tauto_checker_sound _ _ _ _ Feval_nformula). - exact: (eval_nformula_dec Rsor). - by move=> [? ?] ? ?; apply: (check_inconsistent_sound Rsor FSORaddon). - move=> t t' u deducett'u env evalt evalt'. exact: (nformula_plus_nformula_correct Rsor FSORaddon env t t'). - move=> env k t tg cnfff; rewrite Feval_formula_compat //. exact: (cnf_normalise_correct Rsor FSORaddon env t tg).1. - move=> env k t tg cnfff; rewrite hold_eNOT Feval_formula_compat //. exact: (cnf_negate_correct Rsor FSORaddon env t tg).1. - move=> t w0 checkw0 env; rewrite (Refl.make_impl_map (Feval_nformula env)) //. exact: (checker_nf_sound Rsor FSORaddon) checkw0 env. Qed. End RealField. (* Auxiliary function called from lra.elpi *) Definition vm_of_list T (l : list T) : VarMap.t T := let fix aux acc p l := match l with | [::] => acc | x :: l => aux (VarMap.vm_add x p x acc) (Pos.succ p) l end in aux VarMap.Empty 1%positive l. (* Translating formulas and witnesses from Q to Z for the realDomainType case *) Definition omap2 {aT1 aT2 rT} (f : aT1 -> aT2 -> rT) o1 o2 := obind (fun a1 => omap (f a1) o2) o1. Fixpoint PExpr_Q2Z (e : PExpr Q) : option (PExpr Z) := match e with | PEc (Qmake z 1) => Some (PEc z) | PEc _ => None | PEX n => Some (PEX n) | PEadd e1 e2 => omap2 PEadd (PExpr_Q2Z e1) (PExpr_Q2Z e2) | PEsub e1 e2 => omap2 PEsub (PExpr_Q2Z e1) (PExpr_Q2Z e2) | PEmul e1 e2 => omap2 PEmul (PExpr_Q2Z e1) (PExpr_Q2Z e2) | PEopp e1 => omap PEopp (PExpr_Q2Z e1) | PEpow e1 n => omap (PEpow ^~ n) (PExpr_Q2Z e1) end. Definition Formula_Q2Z (ff : Formula Q) : option (Formula Z) := omap2 (fun l r => Build_Formula l (Fop ff) r) (PExpr_Q2Z (Flhs ff)) (PExpr_Q2Z (Frhs ff)). Fixpoint BFormula_Q2Z [k] (ff : BFormula (Formula Q) k) : option (BFormula (Formula Z) k) := match ff with | TT k => Some (TT k) | FF k => Some (FF k) | X k P => Some (X k P) | A k a aa => omap (A k ^~ aa) (Formula_Q2Z a) | AND _ f1 f2 => omap2 (fun f => AND f) (BFormula_Q2Z f1) (BFormula_Q2Z f2) | OR _ f1 f2 => omap2 (fun f => OR f) (BFormula_Q2Z f1) (BFormula_Q2Z f2) | NOT _ f1 => omap (fun f => NOT f) (BFormula_Q2Z f1) | IMPL _ f1 o f2 => omap2 (fun f => IMPL f o) (BFormula_Q2Z f1) (BFormula_Q2Z f2) | IFF _ f1 f2 => omap2 (fun f => IFF f) (BFormula_Q2Z f1) (BFormula_Q2Z f2) | EQ f1 f2 => omap2 EQ (BFormula_Q2Z f1) (BFormula_Q2Z f2) end. Fixpoint Pol_Q2Z (p : Pol Q) : Pol Z * positive := match p with | Pc (Qmake n d) => (Pc n, d) | Pinj j p => let (p, n) := Pol_Q2Z p in (Pinj j p, n) | PX p1 i p2 => let (p1, n1) := Pol_Q2Z p1 in let (p2, n2) := Pol_Q2Z p2 in let mulc c p := PmulC Z0 (Zpos 1) Z.mul Z.eqb p (Zpos c) in (PX (mulc n2 p1) i (mulc n1 p2), Pos.mul n1 n2) end. Fixpoint Psatz_Q2Z (l : seq positive) (p : Psatz Q) : Psatz Z * positive := match p with | PsatzC (Qmake n d) => (PsatzC n, d) | PsatzLet p1 p2 => let (p1, n1) := Psatz_Q2Z l p1 in let (p2, n2) := Psatz_Q2Z (n1 :: l) p2 in (PsatzLet p1 p2, n2) | PsatzIn n => (PsatzIn _ n, nth 1%positive l n) | PsatzSquare p => let (p, n) := Pol_Q2Z p in (PsatzSquare p, Pos.mul n n) | PsatzMulC p1 p2 => let (p1, n1) := Pol_Q2Z p1 in let (p2, n2) := Psatz_Q2Z l p2 in (PsatzMulC p1 p2, Pos.mul n1 n2) | PsatzMulE p1 p2 => let (p1, n1) := Psatz_Q2Z l p1 in let (p2, n2) := Psatz_Q2Z l p2 in (PsatzMulE p1 p2, Pos.mul n1 n2) | PsatzAdd p1 p2 => let (p1, n1) := Psatz_Q2Z l p1 in let (p2, n2) := Psatz_Q2Z l p2 in let mulc c p := PsatzMulE (PsatzC (Zpos c)) p in (PsatzAdd (mulc n2 p1) (mulc n1 p2), Pos.mul n1 n2) | PsatzZ => (PsatzZ _, 1%positive) end. Definition seq_Psatz_Q2Z : seq (Psatz Q) -> seq (Psatz Z) := map (fun p => fst (Psatz_Q2Z [::] p)). (* Main tactics, called from the elpi parser (c.f., lra.elpi) *) Ltac lra_witness n f := let w := fresh "__wit" in wlra_Q w f. Ltac nra_witness n f := let w := fresh "__wit" in wnra_Q w f. Ltac psatz_witness n f := let w := fresh "__wit" in wsos_Q w f || wpsatz_Q n w f. Ltac tacF F hyps rff ff varmap wit := let irff := fresh "__rff" in let iff := fresh "__ff" in let ivarmap := fresh "__varmap" in pose (irff := rff); pose (iff := ff); pose (ivarmap := varmap); refine (hyps (@FTautoChecker_sound F irff iff wit (VarMap.find 0 (vm_of_list ivarmap)) (fun _ _ _ _ _ _ _ _ _ _ => erefl) _)); [ vm_compute; reflexivity ]. Ltac tacR R hyps rff ff varmap wit := let irff := fresh "__rff" in let iff := fresh "__ff" in let ivarmap := fresh "__varmap" in lazymatch eval vm_compute in (BFormula_Q2Z ff) with | Some ?f => pose (irff := rff); pose (iff := f); pose (ivarmap := varmap); refine (hyps (@RTautoChecker_sound R irff iff (seq_Psatz_Q2Z wit) (VarMap.find 0 (vm_of_list ivarmap)) (fun _ _ _ _ _ _ _ _ _ _ => erefl) _)); [ vm_compute; reflexivity ] | _ => fail (* should never happen, the parser only parses int constants *) end. End Internals. Strategy expand [addn_expand nat_of_pos_rec_expand nat_of_pos_expand]. Strategy expand [nat_of_N_expand]. Strategy expand [nat_of_large_nat N_of_large_nat Z_of_large_nat]. Strategy expand [Reval Meval Ring.Rnorm Ring.Mnorm Lra.Rnorm Lra.Mnorm]. Strategy expand [Reval_pop2 Reval_bop2 Reval_op2]. Strategy expand [Reval_formula Rnorm_formula Fnorm_formula]. Strategy expand [Reval_PFormula Feval_PFormula]. Elpi Tactic lra. Elpi Accumulate Db canonicals.db. Elpi Accumulate File common lra. Elpi Typecheck. Tactic Notation "lra" := elpi lra "lra_witness" "tacF" "tacR" 0. Tactic Notation "nra" := elpi lra "nra_witness" "tacF" "tacR" 0. Tactic Notation "psatz" integer(n) := elpi lra "psatz_witness" "tacF" "tacR" ltac_int:(n). Tactic Notation "psatz" := elpi lra "psatz_witness" "tacF" "tacR" (-1). Elpi Query lp:{{ canonical-init library "canonicals.db" }}. Elpi Query lp:{{ coercion-init library "canonicals.db" }}. algebra-tactics-1.2.4/theories/ring.elpi000066400000000000000000000230671474420016100202060ustar00rootroot00000000000000% Constructor [mk-ring-morphism Ty Morph ComR Env] takes a type [Ty], % looks for a canonical [comRingType] (or at least [comSemiRingType]) % on it and returns it in [ComR] as well as packed in a rmorphism % [Morph] (with the identity function), the result [Env] lists the % appropriate [target-nmodule], [target-zmodule] and [target-semiring] % If [field-mode] attempt to fill the field field, otherwise don't even attempt pred mk-ring-morphism i:term, o:rmorphism, o:term, o:term, o:list prop. mk-ring-morphism Ty rmorphism-nat {{ semiring_correct }} {{ target_nat }} Env :- coq.unify-eq Ty {{ nat }} ok, !, canonical-nat-nmodule NatNmodule, canonical-nat-semiring NatSemiRing, semiring-env SREnv, Env = [target-nmodule (global (const NatNmodule)), target-semiring (global (const NatSemiRing)) | SREnv]. mk-ring-morphism Ty rmorphism-N {{ semiring_correct }} {{ target_N }} Env :- coq.unify-eq Ty {{ N }} ok, !, canonical-N-nmodule NNmodule, canonical-N-semiring NSemiRing, semiring-env SREnv, Env = [target-nmodule (global (const NNmodule)), target-semiring (global (const NSemiRing)) | SREnv]. mk-ring-morphism Ty rmorphism-int {{ ring_correct }} {{ target_int }} Env :- coq.unify-eq Ty {{ int }} ok, !, canonical-int-nmodule IntNmodule, canonical-int-semiring IntSemiRing, canonical-int-zmodule IntZmodule, ring-env REnv, Env = [target-nmodule (global (const IntNmodule)), target-semiring (global (const IntSemiRing)), target-zmodule (global (const IntZmodule)) | REnv]. mk-ring-morphism Ty rmorphism-Z {{ ring_correct }} {{ target_Z }} Env :- coq.unify-eq Ty {{ Z }} ok, !, canonical-Z-nmodule ZNmodule, canonical-Z-semiring ZSemiRing, canonical-Z-zmodule ZZmodule, ring-env REnv, Env = [target-nmodule (global (const ZNmodule)), target-semiring (global (const ZSemiRing)), target-zmodule (global (const ZZmodule)) | REnv]. mk-ring-morphism Ty (rmorphism U V' SR R' UR' none (x\ x)) Lem CR Env :- !, std.assert-ok! (coq.unify-eq Ty {{ GRing.Nmodule.sort lp:U }}) "Cannot find a declared nmodType", std.assert-ok! (coq.unify-eq Ty {{ GRing.SemiRing.sort lp:SR }}) "Cannot find a declared semiRingType", if (coq.unify-eq Ty {{ GRing.Zmodule.sort lp:V }} ok, coq.unify-eq Ty {{ GRing.Ring.sort lp:R }} ok) % if the target is a ring (V' = some V, R' = some R, if (coq.unify-eq Ty {{ GRing.UnitRing.sort lp:UR }} ok) (UR' = some UR) (UR' = none), Lem = {{ ring_correct }}, std.assert-ok! (coq.unify-eq Ty {{ GRing.ComRing.sort lp:CR' }}) "Cannot find a declared comRingType", CR = {{ target_other_comRing lp:CR' }}, ring-env REnv, Env = [target-nmodule U, target-semiring SR, target-zmodule V | REnv]) % if the target is a semiring (V' = none, R' = none, UR' = none, Lem = {{ semiring_correct }}, std.assert-ok! (coq.unify-eq Ty {{ GRing.ComSemiRing.sort lp:CR' }}) "Cannot find a declared comSemiRingType", CR = {{ target_other_comSemiRing lp:CR' }}, semiring-env SREnv, Env = [target-nmodule U, target-semiring SR | SREnv]). pred mk-field-morphism i:term, o:rmorphism, o:term, o:term, o:list prop, o:list prop. mk-field-morphism Ty (rmorphism U (some V) SR (some R) (some UR) (some F) (x\ x)) Lem Field [target-nmodule U, target-semiring SR, target-zmodule V | REnv] [field-mode, target-nmodule U, target-semiring SR, target-zmodule V | FEnv] :- std.do! [ std.assert-ok! (coq.unify-eq Ty {{ GRing.Nmodule.sort lp:U }}) "Cannot find a declared nmodType", std.assert-ok! (coq.unify-eq Ty {{ GRing.Zmodule.sort lp:V }}) "Cannot find a declared zmodType", std.assert-ok! (coq.unify-eq Ty {{ GRing.SemiRing.sort lp:SR }}) "Cannot find a declared semiRingType", std.assert-ok! (coq.unify-eq Ty {{ GRing.Ring.sort lp:R }}) "Cannot find a declared ringType", std.assert-ok! (coq.unify-eq Ty {{ GRing.UnitRing.sort lp:UR }}) "Cannot find a declared unitRingType", std.assert-ok! (coq.unify-eq Ty {{ GRing.Field.sort lp:F }}) "Cannot find a declared fieldType", (coq.unify-eq Ty {{ Num.NumField.sort lp:Field }} ok, Lem = {{ numField_correct }}; Field = F, Lem = {{ field_correct }}), ring-env REnv, field-env FEnv ]. pred semiring-env o:list prop. semiring-env [(pi In\ quote.build.variable In {{ @PEX N lp:In }} :- !), (quote.build.zero {{ @PEO N }} :- !), (pi In\ quote.build.opp In {{ @PEopp N lp:In }} :- !), (pi In1 In2\ quote.build.add In1 In2 {{ @PEadd N lp:In1 lp:In2 }} :- !), (pi In1 In2\ quote.build.sub In1 In2 {{ @PEsub N lp:In1 lp:In2 }} :- !), (quote.build.one {{ @PEI N }} :- !), (pi In1 In2\ quote.build.mul In1 In2 {{ @PEmul N lp:In1 lp:In2 }} :- !), (pi In1 In2\ quote.build.exp In1 In2 {{ @PEpow N lp:In1 lp:In2 }} :- !), (pi In\ quote.build.N-constant In {{ @PEc N lp:In }} :- !)] :- !. pred ring-env o:list prop. ring-env [(pi In\ quote.build.variable In {{ @PEX Z lp:In }} :- !), (quote.build.zero {{ @PEO Z }} :- !), (pi In\ quote.build.opp In {{ @PEopp Z lp:In }} :- !), (pi In1 In2\ quote.build.add In1 In2 {{ @PEadd Z lp:In1 lp:In2 }} :- !), (pi In1 In2\ quote.build.sub In1 In2 {{ @PEsub Z lp:In1 lp:In2 }} :- !), (quote.build.one {{ @PEI Z }} :- !), (pi In1 In2\ quote.build.mul In1 In2 {{ @PEmul Z lp:In1 lp:In2 }} :- !), (pi In1 In2\ quote.build.exp In1 In2 {{ @PEpow Z lp:In1 lp:In2 }} :- !), (pi In\ quote.build.Z-constant In {{ @PEc Z lp:In }} :- !), (quote.build.N-constant {{ N0 }} {{ @PEc Z Z0 }} :- !), (pi In\ quote.build.N-constant {{ Npos lp:In }} {{ @PEc Z (Zpos lp:In) }} :- !)] :- !. pred field-env o:list prop. field-env [(pi In\ quote.build.variable In {{ @FEX Z lp:In }} :- !), (quote.build.zero {{ @FEO Z }} :- !), (pi In\ quote.build.opp In {{ @FEopp Z lp:In }} :- !), (pi In1 In2\ quote.build.add In1 In2 {{ @FEadd Z lp:In1 lp:In2 }} :- !), (pi In1 In2\ quote.build.sub In1 In2 {{ @FEsub Z lp:In1 lp:In2 }} :- !), (quote.build.one {{ @FEI Z }} :- !), (pi In1 In2\ quote.build.mul In1 In2 {{ @FEmul Z lp:In1 lp:In2 }} :- !), (pi In1 In2\ quote.build.exp In1 In2 {{ @FEpow Z lp:In1 lp:In2 }} :- !), (pi In\ quote.build.inv In {{ @FEinv Z lp:In }} :- !), (pi In\ quote.build.Z-constant In {{ @FEc Z lp:In }} :- !), (quote.build.N-constant {{ N0 }} {{ @FEc Z Z0 }} :- !), (pi In\ quote.build.N-constant {{ Npos lp:In }} {{ @FEc Z (Zpos lp:In) }} :- !)] :- !. pred if-verbose i:prop. if-verbose P :- get-option "verbose" tt, !, P. if-verbose _. pred quote-arg i:term, i:rmorphism, o:list term, i:argument, o:pair term term. quote-arg Ty C VM (trm Proof) (pr {{ (lp:RE1, lp:RE2, lp:PE1, lp:PE2) }} Proof) :- std.do! [ @ltacfail! 0 => std.assert-ok! (coq.typecheck Proof {{ @eq lp:Ty lp:T1 lp:T2 }}) "An argument is not a proof of equation of the expected type", quote.ring C T1 RE1 PE1 VM, quote.ring C T2 RE2 PE2 VM ]. pred list->conj i:list term, o:term. list->conj [] {{ I }} :- !. list->conj [P|PS] {{ conj lp:P lp:IS }} :- !, list->conj PS IS. pred coq.ltac.call-with-error i:string, i:list argument, i:string, i:goal, o:list sealed-goal. coq.ltac.call-with-error Tac Args _ G GS :- coq.ltac.call Tac Args G GS. coq.ltac.call-with-error _ _ Err _ _ :- coq.ltac.fail 0 Err. pred ring i:goal, o:list sealed-goal. ring (goal _ _ P _ Args as G) GS :- attributes A, !, coq.parse-attributes A [att "verbose" bool] Opts, !, Opts => std.do! [ @ltacfail! 0 => std.assert-ok! (coq.unify-eq P {{ @eq lp:Ty lp:T1 lp:T2 }}) "The goal is not an equation", @ltacfail! 0 => mk-ring-morphism Ty C Lem ComRing Env, Env => std.time ( std.unzip { std.map Args (quote-arg Ty C VM) } Lpe LpeProofs, quote.ring C T1 RE1 PE1 VM, quote.ring C T2 RE2 PE2 VM ) ReifTime, if-verbose (coq.say "Reification:" ReifTime "sec."), list-constant Ty VM VM', list-constant _ Lpe Lpe', std.assert-ok! (coq.typecheck Lpe' _) "Ill-typed term", list->conj LpeProofs LpeProofs', std.assert-ok! (coq.typecheck LpeProofs' _) "Ill-typed equations", std.time ( coq.ltac.call-with-error "ring_reflection" [trm Lem, trm ComRing, trm VM', trm Lpe', trm RE1, trm RE2, trm PE1, trm PE2, trm LpeProofs'] "Not a valid ring equation" G GS ) ReflTime, if-verbose (coq.say "Reflection:" ReflTime "sec."), ]. pred field i:goal, o:list sealed-goal. field (goal _ _ P _ Args as G) GS :- attributes A, !, coq.parse-attributes A [att "verbose" bool] Opts, !, Opts => std.do! [ @ltacfail! 0 => std.assert-ok! (coq.unify-eq P {{ @eq lp:Ty lp:T1 lp:T2 }}) "The goal is not an equation", @ltacfail! 0 => mk-field-morphism Ty C Lem Field REnv FEnv, std.time ( REnv => std.unzip { std.map Args (quote-arg Ty { rmorphism-rm-field C } VM) } Lpe LpeProofs, FEnv => quote.ring C T1 RE1 PE1 VM, FEnv => quote.ring C T2 RE2 PE2 VM ) ReifTime, if-verbose (coq.say "Reification:" ReifTime "sec."), list-constant Ty VM VM', list-constant _ Lpe Lpe', std.assert-ok! (coq.typecheck Lpe' _) "Ill-typed term", list->conj LpeProofs LpeProofs', std.assert-ok! (coq.typecheck LpeProofs' _) "Ill-typed equations", std.time ( coq.ltac.call-with-error "field_reflection" [trm Lem, trm Field, trm VM', trm Lpe', trm RE1, trm RE2, trm PE1, trm PE2, trm LpeProofs'] "Not a valid field equation" G GS ) ReflTime, if-verbose (coq.say "Reflection:" ReflTime "sec."), ]. algebra-tactics-1.2.4/theories/ring.v000066400000000000000000000444661474420016100175300ustar00rootroot00000000000000From elpi Require Import elpi. From Coq Require Import ZArith Ring Ring_polynom Field_theory. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat choice seq. From mathcomp Require Import fintype finfun bigop order ssralg ssrnum ssrint. From mathcomp.zify Require Import ssrZ zify. From mathcomp.algebra_tactics Require Import common. From mathcomp.algebra_tactics Extra Dependency "common.elpi" as common. From mathcomp.algebra_tactics Extra Dependency "ring.elpi" as ring. From mathcomp.algebra_tactics Extra Dependency "ring_tac.elpi" as ring_tac. From mathcomp.algebra_tactics Extra Dependency "field_tac.elpi" as field_tac. Import GRing.Theory. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Module Import Internals. Implicit Types (V : nmodType) (R : semiRingType) (F : fieldType). (* Pushing down morphisms in ring and field expressions by reflection *) Fixpoint Reval_eqs C R (lpe : list (RExpr R * RExpr R * PExpr C * PExpr C)) : Prop := if lpe is (lhs, rhs, _, _) :: lpe then Reval lhs = Reval rhs /\ Reval_eqs lpe else True. Variant target_comSemiRing := | target_nat | target_N | target_other_comSemiRing of comSemiRingType. Local Coercion target_comSemiRingType (R : target_comSemiRing) : comSemiRingType := match R with | target_nat => nat | target_N => N | target_other_comSemiRing R => R end. Definition target_comSemiRingMorph (R : target_comSemiRing) : R -> R := match R with | target_nat => GRing.natmul 1 | target_N => fun n => (N.to_nat n)%:R | target_other_comSemiRing _ => id end. Variant target_comRing := | target_int | target_Z | target_other_comRing of comRingType. Local Coercion target_comRingType (R : target_comRing) : comRingType := match R with | target_int => int | target_Z => Z | target_other_comRing R => R end. Definition target_comRingMorph (R : target_comRing) : R -> R := match R with | target_int => intr | target_Z => fun n => (int_of_Z n)%:~R | target_other_comRing _ => id end. Section Snorm. Variables (R' : semiRingType) (R_of_N : N -> R'). Variables (zero : R') (add : R' -> R' -> R'). Variables (one : R') (mul : R' -> R' -> R') (exp : R' -> N -> R'). Local Notation Snorm := (SemiRing.Rnorm R_of_N zero add one mul exp). Fixpoint Snorm_list (lpe : list (RExpr R' * RExpr R' * PExpr N * PExpr N)) : seq R' := if lpe is (lhs, rhs, _, _) :: lpe then Snorm id lhs :: Snorm id rhs :: Snorm_list lpe else [::]. End Snorm. Section Rnorm. Variables (R' : ringType) (R_of_Z : Z -> R'). Variables (zero : R') (add : R' -> R' -> R'). Variables (opp : R' -> R') (sub : R' -> R' -> R'). Variables (one : R') (mul : R' -> R' -> R') (exp : R' -> N -> R'). Local Notation Rnorm := (Ring.Rnorm R_of_Z zero add opp sub one mul exp). Fixpoint Rnorm_list (lpe : list (RExpr R' * RExpr R' * PExpr Z * PExpr Z)) : seq R' := if lpe is (lhs, rhs, _, _) :: lpe then Rnorm id lhs :: Rnorm id rhs :: Rnorm_list lpe else [::]. End Rnorm. (* Normalizing ring and field expressions to the Horner form by reflection *) Fixpoint PEeval_list C R (R_of_C : C -> R) zero opp add sub one mul exp (l : seq R) (lpe : list (RExpr R * RExpr R * PExpr C * PExpr C)) : seq R := if lpe is (_, _, lhs, rhs) :: lpe then PEeval zero one add mul sub opp R_of_C id exp l lhs :: PEeval zero one add mul sub opp R_of_C id exp l rhs :: PEeval_list R_of_C zero opp add sub one mul exp l lpe else [::]. Definition Scorrect (R : comSemiRingType) := let RE := Eq_ext +%R *%R id in let RN := SRmorph_Rmorph (Eqsth R) (RN R) in ring_correct (Eqsth R) RE (SRth_ARth (Eqsth R) (RS R)) RN (PN R) (triv_div_th (Eqsth R) RE (SRth_ARth (Eqsth R) (RS R)) RN). Lemma semiring_correct (R : target_comSemiRing) (n : nat) (l : seq R) (lpe : seq (RExpr R * RExpr R * PExpr N * PExpr N)) (re1 re2 : RExpr R) (pe1 pe2 : PExpr N) : Reval_eqs lpe -> (forall R_of_N zero add one mul exp, SemiRing.Rnorm R_of_N zero add one mul exp (@target_comSemiRingMorph R) re1 :: SemiRing.Rnorm R_of_N zero add one mul exp (@target_comSemiRingMorph R) re2 :: Snorm_list R_of_N zero add one mul exp lpe = PEeval zero one add mul add id R_of_N id exp l pe1 :: PEeval zero one add mul add id R_of_N id exp l pe2 :: PEeval_list R_of_N zero id add add one mul exp l lpe) -> (let norm_subst' := norm_subst 0 1 N.add N.mul N.add id N.eqb (triv_div 0 1 N.eqb) n (mk_monpol_list 0 1 N.add N.mul N.add id N.eqb (triv_div 0 1 N.eqb) (map (fun '(_, _, lhs, rhs) => (lhs, rhs)) lpe)) in Peq N.eqb (norm_subst' pe1) (norm_subst' pe2)) -> Reval re1 = Reval re2. Proof. move=> Hlpe' /(_ (fun n => (nat_of_N n)%:R) 0%R +%R). move=> /(_ 1%R *%R (fun x n => x ^+ nat_of_N n)) /=. have /SemiRing.eq_Rnorm Hnorm: @target_comSemiRingMorph R =1 id. by case R => //= ?; lia. rewrite !{}Hnorm -!SemiRing.Rnorm_correct => -[-> -> Hlpe]; apply: Scorrect. elim: lpe Hlpe Hlpe' => [|[[[{}re1 {}re2] {}pe1] {}pe2] lpe IHlpe] //=. rewrite /= -!SemiRing.Rnorm_correct //. by move=> [-> ->] Hlpe [Hpe /(IHlpe Hlpe)] {IHlpe Hlpe} /=; case: lpe. Qed. Definition Rcorrect (R : comRingType) := let RE := Eq_ext +%R *%R -%R in ring_correct (Eqsth R) RE (Rth_ARth (Eqsth R) RE (RR R)) (RZ R) (PN R) (triv_div_th (Eqsth R) RE (Rth_ARth (Eqsth R) RE (RR R)) (RZ R)). Lemma ring_correct (R : target_comRing) (n : nat) (l : seq R) (lpe : seq (RExpr R * RExpr R * PExpr Z * PExpr Z)) (re1 re2 : RExpr R) (pe1 pe2 : PExpr Z) : Reval_eqs lpe -> (forall R_of_Z zero opp add sub one mul exp, Ring.Rnorm R_of_Z zero add opp sub one mul exp (@target_comRingMorph R) re1 :: Ring.Rnorm R_of_Z zero add opp sub one mul exp (@target_comRingMorph R) re2 :: Rnorm_list R_of_Z zero add opp sub one mul exp lpe = PEeval zero one add mul sub opp R_of_Z id exp l pe1 :: PEeval zero one add mul sub opp R_of_Z id exp l pe2 :: PEeval_list R_of_Z zero opp add sub one mul exp l lpe) -> (let norm_subst' := norm_subst 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb) n (mk_monpol_list 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb) (map (fun '(_, _, lhs, rhs) => (lhs, rhs)) lpe)) in Peq Z.eqb (norm_subst' pe1) (norm_subst' pe2)) -> Reval re1 = Reval re2. Proof. move=> Hlpe' /(_ (fun n => (int_of_Z n)%:~R) 0%R -%R +%R (fun x y => x - y)). move=> /(_ 1%R *%R (fun x n => x ^+ nat_of_N n)) /=. have /Ring.eq_Rnorm Hnorm: @target_comRingMorph R =1 id by case R => //= ?; lia. rewrite !Hnorm -!Ring.Rnorm_correct => -[-> -> Hlpe]; apply: Rcorrect. elim: lpe Hlpe Hlpe' => [|[[[{}re1 {}re2] {}pe1] {}pe2] lpe IHlpe] //=. rewrite /= -!Ring.Rnorm_correct //. by move=> [-> ->] Hlpe [Hpe /(IHlpe Hlpe)] {IHlpe Hlpe} /=; case: lpe. Qed. (* Post-processing non-zero conditions of the field tactic *) Section PCond. Variables (P : Type) (ptrue : P) (pneg : P -> P) (pand : P -> P -> P). Variables (R : Type) (rO rI : R) (radd rmul rsub : R -> R -> R) (ropp : R -> R). Variables (req : R -> R -> P). Variables (C : Type) (phi : C -> R). Variables (Cpow : Type) (Cp_phi : N -> Cpow) (rpow : R -> Cpow -> R). Notation eval := (PEeval rO rI radd rmul rsub ropp phi Cp_phi rpow). Fixpoint PCond' (l : seq R) (le : seq (PExpr C)) : P := match le with | [::] => ptrue | [:: e1] => pneg (req (eval l e1) rO) | e1 :: l1 => pand (pneg (req (eval l e1) rO)) (PCond' l l1) end. End PCond. Section PCond_facts. Lemma PCondE : PCond = PCond' True not and. Proof. by []. Qed. Variable (F : fieldType). Let F_of_pos p : F := if p is xH then 1 else (Pos.to_nat p)%:R. Let F_of_Z n : F := match n with Z0 => 0 | Zpos p => F_of_pos p | Zneg p => - F_of_pos p end. (* The following two lemmas should be immediate consequences of parametricity *) Lemma PEvalE l e : PEeval 0 1 +%R *%R (fun x y => x - y) -%R F_of_Z nat_of_N (@GRing.exp F) l e = PEeval 0 1 +%R *%R (fun x y => x - y) -%R (fun n => (int_of_Z n)%:~R) nat_of_N (@GRing.exp F) l e. Proof. elim: e => //= [| ? -> ? -> | ? -> ? -> | ? -> ? -> | ? -> | ? ->] //. by case=> [|[p|p|]|[p|p|]]; rewrite //= nmulrn; congr intmul; lia. Qed. Lemma PCondP l le : reflect (PCond' True not and 0 1 +%R *%R (fun x y : F => x - y) -%R eq (fun n0 : Z => (int_of_Z n0)%:~R) nat_of_N (@GRing.exp F) l le) (PCond' true negb andb 0 1 +%R *%R (fun x y : F => x - y) -%R eq_op F_of_Z nat_of_N (@GRing.exp F) l le). Proof. elim: le => [/=|e1 /= [|e2 le] IH]. - exact: ReflectT. - by rewrite PEvalE; apply: (iffP negP); apply/contra_not => /eqP. - by rewrite PEvalE; apply: (iffP andP) => -[/eqP ? /IH ?]. Qed. End PCond_facts. Definition Fcorrect F := let RE := Eq_ext +%R *%R -%R in Field_correct (Eqsth F) RE (congr1 GRing.inv) (F2AF (Eqsth F) RE (RF F)) (RZ F) (PN F) (triv_div_th (Eqsth F) RE (Rth_ARth (Eqsth F) RE (RR F)) (RZ F)). Lemma field_correct (F : fieldType) (n : nat) (l : seq F) (lpe : seq (RExpr F * RExpr F * PExpr Z * PExpr Z)) (re1 re2 : RExpr F) (fe1 fe2 : FExpr Z) : Reval_eqs lpe -> (forall R_of_Z zero opp add sub one mul exp div inv, Field.Rnorm R_of_Z zero add opp sub one mul exp inv id re1 :: Field.Rnorm R_of_Z zero add opp sub one mul exp inv id re2 :: Rnorm_list R_of_Z zero add opp sub one mul exp lpe = FEeval zero one add mul sub opp div inv R_of_Z id exp l fe1 :: FEeval zero one add mul sub opp div inv R_of_Z id exp l fe2 :: PEeval_list R_of_Z zero opp add sub one mul exp l lpe) -> (forall is_true_ negb_ andb_ zero one add mul sub opp Feqb F_of_nat exp l', is_true_ = is_true -> negb_ = negb -> andb_ = andb -> zero = 0 -> one = 1 -> add = +%R -> mul = *%R -> sub = (fun x y => x - y) -> opp = -%R -> Feqb = eq_op -> F_of_nat = GRing.natmul 1 -> exp = @GRing.exp F -> l' = l -> let F_of_pos p := if p is xH then one else F_of_nat (Pos.to_nat p) in let F_of_Z n := match n with Z0 => zero | Zpos p => F_of_pos p | Zneg p => opp (F_of_pos p) end in let norm_subst' := norm_subst 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb) n (mk_monpol_list 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb) (map (fun '(_, _, lhs, rhs) => (lhs, rhs)) lpe)) in let nfe1 := Field_theory.Fnorm 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb fe1 in let nfe2 := Field_theory.Fnorm 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb fe2 in Peq Z.eqb (norm_subst' (PEmul (num nfe1) (denum nfe2))) (norm_subst' (PEmul (num nfe2) (denum nfe1))) /\ is_true_ (PCond' true negb_ andb_ zero one add mul sub opp Feqb F_of_Z nat_of_N exp l' (Fapp (Fcons00 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb)) (condition nfe1 ++ condition nfe2) [::]))) -> Reval re1 = Reval re2. Proof. move=> Hlpe' /(_ (fun n => (int_of_Z n)%:~R) 0%R -%R +%R (fun x y => x - y)). move=> /(_ 1%R *%R (fun x n => x ^+ nat_of_N n) (fun x y => x / y) GRing.inv). rewrite -!Field.Rnorm_correct => -[-> -> Hlpe]. move=> /(_ _ _ _ _ _ _ _ _ _ _ _ _ _ erefl erefl erefl erefl erefl erefl erefl). move=> /(_ _ _ _ _ _ _ erefl erefl erefl erefl erefl erefl) [Heq Hcond]. apply: (Fcorrect _ erefl erefl erefl Heq). elim: {Heq Hcond}lpe Hlpe Hlpe' => // -[[[{}re1 {}re2] {}pe1] {}pe2]. move=> lpe IHlpe /=; rewrite -!Ring.Rnorm_correct. by move=> [-> ->] Hlpe [Hpe /(IHlpe Hlpe)] {IHlpe Hlpe} /=; case: lpe. by apply: Pcond_simpl_gen; [ exact: Eq_ext | exact/F2AF/RF/Eq_ext | exact: RZ | exact: PN | exact/triv_div_th/RZ/Rth_ARth/RR/Eq_ext/Eq_ext/Eqsth | move=> _ ->; exact/PCondP ]. Qed. Lemma numField_correct (F : numFieldType) (n : nat) (l : seq F) (lpe : seq (RExpr F * RExpr F * PExpr Z * PExpr Z)) (re1 re2 : RExpr F) (fe1 fe2 : FExpr Z) : Reval_eqs lpe -> (forall R_of_Z zero opp add sub one mul exp div inv, Field.Rnorm R_of_Z zero add opp sub one mul exp inv id re1 :: Field.Rnorm R_of_Z zero add opp sub one mul exp inv id re2 :: Rnorm_list R_of_Z zero add opp sub one mul exp lpe = FEeval zero one add mul sub opp div inv R_of_Z id exp l fe1 :: FEeval zero one add mul sub opp div inv R_of_Z id exp l fe2 :: PEeval_list R_of_Z zero opp add sub one mul exp l lpe) -> (forall is_true_ negb_ andb_ zero one add mul sub opp Feqb F_of_nat exp l', is_true_ = is_true -> negb_ = negb -> andb_ = andb -> zero = 0 -> one = 1 -> add = +%R -> mul = *%R -> sub = (fun x y => x - y) -> opp = -%R -> Feqb = eq_op -> F_of_nat = GRing.natmul 1 -> exp = @GRing.exp F -> l' = l -> let F_of_pos p := if p is xH then one else F_of_nat (Pos.to_nat p) in let F_of_Z n := match n with Z0 => zero | Zpos p => F_of_pos p | Zneg p => opp (F_of_pos p) end in let norm_subst' := norm_subst 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb) n (mk_monpol_list 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb) (map (fun '(_, _, lhs, rhs) => (lhs, rhs)) lpe)) in let nfe1 := Field_theory.Fnorm 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb fe1 in let nfe2 := Field_theory.Fnorm 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb fe2 in Peq Z.eqb (norm_subst' (PEmul (num nfe1) (denum nfe2))) (norm_subst' (PEmul (num nfe2) (denum nfe1))) /\ is_true_ (PCond' true negb_ andb_ zero one add mul sub opp Feqb F_of_Z nat_of_N exp l' (Fapp (Fcons2 0 1 Z.add Z.mul Z.sub Z.opp Z.eqb (triv_div 0 1 Z.eqb)) (condition nfe1 ++ condition nfe2) [::]))) -> Reval re1 = Reval re2. Proof. move=> Hlpe' /(_ (fun n => (int_of_Z n)%:~R) 0%R -%R +%R (fun x y => x - y)). move=> /(_ 1%R *%R (fun x n => x ^+ nat_of_N n) (fun x y => x / y) GRing.inv). rewrite -!Field.Rnorm_correct => -[-> -> Hlpe]. move=> /(_ _ _ _ _ _ _ _ _ _ _ _ _ _ erefl erefl erefl erefl erefl erefl erefl). move=> /(_ _ _ _ _ _ _ erefl erefl erefl erefl erefl erefl) [Heq Hcond]. apply: (Fcorrect _ erefl erefl erefl Heq). elim: {Heq Hcond}lpe Hlpe Hlpe' => // -[[[{}re1 {}re2] {}pe1] {}pe2]. move=> lpe IHlpe /=; rewrite -!Ring.Rnorm_correct. by move=> [-> ->] Hlpe [Hpe /(IHlpe Hlpe)] {IHlpe Hlpe} /=; case: lpe. apply: Pcond_simpl_complete; [ exact: Eq_ext | exact/F2AF/RF/Eq_ext | exact: RZ | exact: PN | exact/triv_div_th/RZ/Rth_ARth/RR/Eq_ext/Eq_ext/Eqsth | move=> x y /intr_inj; lia | move=> _ ->; exact/PCondP ]. Qed. Ltac reflexivity_no_check := move=> *; match goal with | |- @eq ?T ?LHS ?RHS => exact_no_check (@Logic.eq_refl T LHS) end. Ltac field_normalization := let is_true_ := fresh "is_true_" in let negb_ := fresh "negb_" in let andb_ := fresh "andb_" in let zero := fresh "zero" in let one := fresh "one" in let add := fresh "add" in let mul := fresh "mul" in let sub := fresh "sub" in let opp := fresh "opp" in let Feqb := fresh "Feqb" in let F_of_nat := fresh "F_of_nat" in let exp := fresh "exp" in let l := fresh "l" in let is_trueE := fresh "is_trueE" in let negbE := fresh "negbE" in let andbE := fresh "andbE" in let zeroE := fresh "zeroE" in let oneE := fresh "oneE" in let addE := fresh "addE" in let mulE := fresh "mulE" in let subE := fresh "subE" in let oppE := fresh "oppE" in let FeqbE := fresh "FeqbE" in let F_of_natE := fresh "F_of_natE" in let expE := fresh "expE" in let lE := fresh "lE" in move=> is_true_ negb_ andb_ zero one add mul sub opp Feqb F_of_nat exp l; move=> is_trueE negbE andbE zeroE oneE addE mulE subE oppE FeqbE F_of_natE; move=> expE lE; vm_compute; refine (conj erefl _); rewrite ?{is_true_}is_trueE ?{negb_}negbE ?{andb_}andbE; rewrite ?{zero}zeroE ?{one}oneE ?{add}addE ?{mul}mulE ?{sub}subE ?{opp}oppE; rewrite ?{Feqb}FeqbE ?{F_of_nat}F_of_natE ?{exp}expE ?{l}lE. End Internals. (* Auxiliary Ltac code which will be invoked from Elpi *) Ltac ring_reflection_check Lem R VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs := exact (Lem R 100%N VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs ltac:(reflexivity) ltac:(vm_compute; reflexivity)). Ltac ring_reflection_no_check Lem R VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs := exact_no_check (Lem R 100%N VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs ltac:(reflexivity_no_check) ltac:(vm_compute; reflexivity)). Ltac ring_reflection := ring_reflection_check. Ltac field_reflection_check Lem F VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs := refine (Lem F 100%N VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs ltac:(reflexivity) ltac:(field_normalization)). Ltac field_reflection_no_check Lem F VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs := let obligation := fresh in eassert (obligation : _); [ | exact_no_check (Lem F 100%N VarMap Lpe RE1 RE2 PE1 PE2 LpeProofs ltac:(reflexivity_no_check) ltac:(field_normalization; exact obligation)) ]. Ltac field_reflection := field_reflection_check. Strategy expand [addn_expand nat_of_pos_rec_expand nat_of_pos_expand]. Strategy expand [nat_of_N_expand]. Strategy expand [nat_of_large_nat N_of_large_nat Z_of_large_nat]. Strategy expand [Reval Meval SemiRing.Rnorm SemiRing.Mnorm]. Strategy expand [Ring.Rnorm Ring.Mnorm Field.Rnorm Field.Mnorm PEeval FEeval]. Elpi Tactic ring. Elpi Accumulate Db canonicals.db. Elpi Accumulate File common ring ring_tac. Elpi Typecheck. Tactic Notation "ring" := elpi ring. Tactic Notation "ring" ":" ne_constr_list(L) := elpi ring ltac_term_list:(L). Tactic Notation "#[" attributes(A) "]" "ring" := ltac_attributes:(A) elpi ring. Tactic Notation "#[" attributes(A) "]" "ring" ":" ne_constr_list(L) := ltac_attributes:(A) elpi ring ltac_term_list:(L). Elpi Tactic field. Elpi Accumulate Db canonicals.db. Elpi Accumulate File common ring field_tac. Elpi Typecheck. Tactic Notation "field" := elpi field. Tactic Notation "field" ":" ne_constr_list(L) := elpi field ltac_term_list:(L). Tactic Notation "#[" attributes(A) "]" "field" := ltac_attributes:(A) elpi field. Tactic Notation "#[" attributes(A) "]" "field" ":" ne_constr_list(L) := ltac_attributes:(A) elpi field ltac_term_list:(L). Elpi Query lp:{{ canonical-init library "canonicals.db" }}. Elpi Query lp:{{ coercion-init library "canonicals.db" }}. algebra-tactics-1.2.4/theories/ring_tac.elpi000066400000000000000000000001161474420016100210230ustar00rootroot00000000000000shorten coq.ltac.{ open, all }. msolve GL SubGL :- all (open ring) GL SubGL.