├── .github └── workflows │ └── docker-action.yml ├── .gitignore ├── .merlin ├── AUTHORS ├── LICENSE ├── Makefile ├── README.md ├── README_old.md ├── _CoqProject ├── coq-paramcoq.opam ├── dune-project ├── meta.yml ├── src ├── abstraction.mlg ├── debug.ml ├── declare_translation.ml ├── dune ├── paramcoq.mlpack ├── parametricity.ml └── relations.ml ├── test-suite ├── ListQueue.v ├── Makefile ├── Parametricity.v ├── bug.v ├── bug2.v ├── bug3.v ├── bug4.v ├── bug5.v ├── dummyFix.v ├── example.v ├── exmNotParametric.v ├── features.v ├── stdlib_R │ ├── .gitignore │ ├── Makefile │ ├── Parametricity.v │ └── Readme.md └── wadler.v ├── theories ├── Param.v └── dune └── tools ├── coqdep.sh └── gendep.py /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Docker CI 4 | 5 | on: 6 | push: 7 | branches: 8 | - master 9 | pull_request: 10 | branches: 11 | - '**' 12 | 13 | jobs: 14 | build: 15 | # the OS must be GNU/Linux to be able to use the docker-coq-action 16 | runs-on: ubuntu-latest 17 | strategy: 18 | matrix: 19 | image: 20 | - 'rocq/rocq-prover:dev' 21 | fail-fast: false 22 | steps: 23 | - uses: actions/checkout@v3 24 | - uses: coq-community/docker-coq-action@v1 25 | with: 26 | opam_file: 'coq-paramcoq.opam' 27 | custom_image: ${{ matrix.image }} 28 | export: 'OPAMWITHTEST' 29 | env: 30 | OPAMWITHTEST: 'true' 31 | 32 | # See also: 33 | # https://github.com/coq-community/docker-coq-action#readme 34 | # https://github.com/erikmd/docker-coq-github-action-demo 35 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Generated Makefile 2 | Makefile.coq 3 | Makefile.coq.conf 4 | META.coq-paramcoq 5 | META 6 | 7 | # Dune 8 | _build 9 | 10 | # Make dependencies 11 | *.d 12 | 13 | # Backup files 14 | *.bak 15 | 16 | # emacs backup files 17 | *~ 18 | 19 | # vim backup files 20 | \#*\# 21 | 22 | # Coq annotation files 23 | *.glob 24 | 25 | # Coq auxiliary files 26 | .*.aux 27 | *.vos 28 | *.vok 29 | 30 | # Coq compilation unit 31 | *.vo 32 | 33 | *.annot 34 | *.cmo 35 | *.cma 36 | *.cmi 37 | *.a 38 | *.o 39 | *.cmi 40 | *.cmt 41 | *.cmti 42 | *.cmx 43 | *.cmxs 44 | *.cmxa 45 | 46 | # coqpp generated file 47 | src/abstraction.ml 48 | 49 | # lia cache 50 | .lia.cache 51 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | FLG -rectypes -thread -w @1..50@59-4-44 2 | 3 | S src 4 | B src 5 | 6 | PKG threads threads.posix coq.intf coq.ltac coq.idetop 7 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | ParamCoq 2 | Copyright (c) 2012-2018 3 | 4 | Chantal Keller (Inria, École polytechnique) 5 | Marc Lasson (ÉNS de Lyon) 6 | Abhishek Anand 7 | Pierre Roux 8 | Emilio Jesús Gallego Arias 9 | Cyril Cohen 10 | Matthieu Sozeau 11 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | ParamCoq 2 | Copyright (c) 2012-2018 3 | 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a 6 | copy of this software and associated documentation files (the 7 | "Software"), to deal in the Software without restriction, including 8 | without limitation the rights to use, copy, modify, merge, publish, 9 | distribute, sublicense, and/or sell copies of the Software, and to 10 | permit persons to whom the Software is furnished to do so, subject to 11 | the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included 14 | in all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 17 | OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 20 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 21 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 22 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Makefile.coq 2 | @+$(MAKE) -f Makefile.coq all 3 | 4 | clean: Makefile.coq 5 | @+$(MAKE) -f Makefile.coq cleanall 6 | @rm -f Makefile.coq Makefile.coq.conf 7 | 8 | Makefile.coq: _CoqProject 9 | $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq 10 | 11 | force _CoqProject Makefile: ; 12 | 13 | %: Makefile.coq force 14 | @+$(MAKE) -f Makefile.coq $@ 15 | 16 | .PHONY: all clean force 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Deprecation Notice 2 | 3 | Paramcoq is no longer actually maintained and released. It is only 4 | kept as a test case for Rocq's OCaml API. The release for Rocq 9.0 5 | will be the last one and is known to suffer some universe issues 6 | (for instance iit no longer enable to compile CoqEAL). Users are 7 | invited to switch to [coq-elpi](https://github.com/LPCIC/coq-elpi) 8 | derive.param2. One can look at 9 | [CoqEAL](https://github.com/coq-community/coqeal) for an example of 10 | porting. Main current caveat: support for mutual inductives isn't 11 | implemented yet. 12 | 13 | See [old README](README_old.md) for previous documentation. 14 | -------------------------------------------------------------------------------- /README_old.md: -------------------------------------------------------------------------------- 1 | 5 | # Paramcoq 6 | 7 | [![Docker CI][docker-action-shield]][docker-action-link] 8 | [![Contributing][contributing-shield]][contributing-link] 9 | [![Code of Conduct][conduct-shield]][conduct-link] 10 | [![Zulip][zulip-shield]][zulip-link] 11 | [![DOI][doi-shield]][doi-link] 12 | 13 | [docker-action-shield]: https://github.com/coq-community/paramcoq/workflows/Docker%20CI/badge.svg?branch=master 14 | [docker-action-link]: https://github.com/coq-community/paramcoq/actions?query=workflow:"Docker%20CI" 15 | 16 | [contributing-shield]: https://img.shields.io/badge/contributions-welcome-%23f7931e.svg 17 | [contributing-link]: https://github.com/coq-community/manifesto/blob/master/CONTRIBUTING.md 18 | 19 | [conduct-shield]: https://img.shields.io/badge/%E2%9D%A4-code%20of%20conduct-%23f15a24.svg 20 | [conduct-link]: https://github.com/coq-community/manifesto/blob/master/CODE_OF_CONDUCT.md 21 | 22 | [zulip-shield]: https://img.shields.io/badge/chat-on%20zulip-%23c1272d.svg 23 | [zulip-link]: https://coq.zulipchat.com/#narrow/stream/237663-coq-community-devs.20.26.20users 24 | 25 | 26 | [doi-shield]: https://zenodo.org/badge/DOI/10.4230/LIPIcs.CSL.2012.381.svg 27 | [doi-link]: https://doi.org/10.4230/LIPIcs.CSL.2012.381 28 | 29 | A Coq plugin providing commands for generating parametricity statements. 30 | Typical applications of such statements are in data refinement proofs. 31 | Note that the plugin is still in an experimental state - it is not very user 32 | friendly (lack of good error messages) and still contains bugs. But it 33 | is usable enough to "translate" a large chunk of the standard library. 34 | 35 | ## Meta 36 | 37 | - Author(s): 38 | - Chantal Keller (initial) 39 | - Marc Lasson (initial) 40 | - Abhishek Anand 41 | - Pierre Roux 42 | - Emilio Jesús Gallego Arias 43 | - Cyril Cohen 44 | - Matthieu Sozeau 45 | - Coq-community maintainer(s): 46 | - Pierre Roux ([**@proux01**](https://github.com/proux01)) 47 | - License: [MIT License](LICENSE) 48 | - Compatible Coq versions: The master branch tracks the development version of Coq, see releases for compatibility with released versions of Coq 49 | - Additional dependencies: none 50 | - Coq namespace: `Param` 51 | - Related publication(s): 52 | - [Parametricity in an Impredicative Sort](https://hal.archives-ouvertes.fr/hal-00730913/) doi:[10.4230/LIPIcs.CSL.2012.381](https://doi.org/10.4230/LIPIcs.CSL.2012.381) 53 | 54 | ## Building and installation instructions 55 | 56 | The easiest way to install the latest released version of Paramcoq 57 | is via [OPAM](https://opam.ocaml.org/doc/Install.html): 58 | 59 | ```shell 60 | opam repo add coq-released https://coq.inria.fr/opam/released 61 | opam install coq-paramcoq 62 | ``` 63 | 64 | To instead build and install manually, do: 65 | 66 | ``` shell 67 | git clone https://github.com/coq-community/paramcoq.git 68 | cd paramcoq 69 | make # or make -j 70 | make install 71 | ``` 72 | 73 | 74 | ## Usage and Commands 75 | 76 | To load the plugin and make its commands available: 77 | ```coq 78 | From Param Require Import Param. 79 | ``` 80 | 81 | The command scheme for named translations is: 82 | ``` 83 | Parametricity as [arity ]. 84 | ``` 85 | For example, the following command generates a translation named `my_param` 86 | of the constant or inductive `my_id` with arity 2 (the default): 87 | ```coq 88 | Parametricity my_id as my_param. 89 | ``` 90 | 91 | The command scheme for automatically named translations is: 92 | ```coq 93 | Parametricity [Recursive] [arity ] [qualified]. 94 | ``` 95 | Such commands generate and name translations based on the given identifier. 96 | The `Recursive` option can be used to recursively translate all the constants 97 | and inductives which are used by the constant or inductive with the given 98 | identifier. The `qualified` option allows you to use a qualified default name 99 | for the translated constants and inductives. The default name then has the form 100 | `Module_o_Submodule_o_my_id` if the identifier `my_id` is declared in the 101 | `Module.Submodule` namespace. 102 | 103 | Instead of using identifiers, you can provide explicit terms to translate, 104 | according to the following command scheme: 105 | ```coq 106 | Parametricity Translation [as ] [arity ]. 107 | ``` 108 | This defines a new constant containing the parametricity translation of 109 | the given term. 110 | 111 | To recursively translate everything in a module: 112 | ```coq 113 | Parametricity Module . 114 | ``` 115 | 116 | When translating terms containing section variables or axioms, 117 | it may be useful to declare a term to be the translation of a constant: 118 | ```coq 119 | Realizer [as ] [arity ] := . 120 | ``` 121 | 122 | Note that translating a term or module may lead to proof obligations (for some 123 | fixpoints and opaque terms if you did not import `ProofIrrelevence`). You need to 124 | declare a tactic to solve such proof obligations: 125 | ```coq 126 | Parametricity Tactic := . 127 | ``` 128 | (supports global/export/local attributes like Obligation Tactic) 129 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -generate-meta-for-package coq-paramcoq 2 | -R theories Param 3 | -R src Param 4 | -I src 5 | src/debug.ml 6 | src/parametricity.ml 7 | src/relations.ml 8 | src/declare_translation.ml 9 | src/abstraction.mlg 10 | src/paramcoq.mlpack 11 | theories/Param.v 12 | -------------------------------------------------------------------------------- /coq-paramcoq.opam: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | 4 | opam-version: "2.0" 5 | maintainer: "Pierre Roux " 6 | version: "dev" 7 | 8 | homepage: "https://github.com/coq-community/paramcoq" 9 | dev-repo: "git+https://github.com/coq-community/paramcoq.git" 10 | bug-reports: "https://github.com/coq-community/paramcoq/issues" 11 | license: "MIT" 12 | 13 | synopsis: "Plugin for generating parametricity statements to perform refinement proofs" 14 | description: """ 15 | /!\ Paramcoq is no longer actually maintained and released. It is only 16 | kept as a test case for Rocq's OCaml API. The release for Rocq 9.0 17 | will be the last one and is known to suffer some universe issues 18 | (for instance iit no longer enable to compile CoqEAL). Users are 19 | invited to switch to [coq-elpi](https://github.com/LPCIC/coq-elpi) 20 | derive.param2. One can look at 21 | [CoqEAL](https://github.com/coq-community/coqeal) for an example of 22 | porting. Main current caveat: support for mutual inductives isn't 23 | implemented yet. 24 | 25 | A Rocq plugin providing commands for generating parametricity statements. 26 | Typical applications of such statements are in data refinement proofs. 27 | Note that the plugin is still in an experimental state - it is not very user 28 | friendly (lack of good error messages) and still contains bugs. But it 29 | is usable enough to "translate" a large chunk of the standard library.""" 30 | 31 | messages: ["/!\ This is the last release of paramcoq, more details on https://github.com/coq-community/paramcoq/blob/master/README.md"] 32 | build: [make "-j%{jobs}%"] 33 | install: [ 34 | [make "install"] 35 | [make "-C" "test-suite" "examples"] {with-test} 36 | ] 37 | depends: [ 38 | "coq" {= "dev" } 39 | ] 40 | 41 | tags: [ 42 | "category:Miscellaneous/Coq Extensions" 43 | "keyword:paramcoq" 44 | "keyword:parametricity" 45 | "keyword:OCaml modules" 46 | "logpath:Param" 47 | ] 48 | authors: [ 49 | "Chantal Keller" 50 | "Marc Lasson" 51 | "Abhishek Anand" 52 | "Pierre Roux" 53 | "Emilio Jesús Gallego Arias" 54 | "Cyril Cohen" 55 | "Matthieu Sozeau" 56 | ] 57 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.5) 2 | (using coq 0.2) 3 | (name paramcoq) 4 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | --- 2 | fullname: Paramcoq 3 | shortname: paramcoq 4 | organization: coq-community 5 | community: true 6 | action: true 7 | plugin: true 8 | doi: 10.4230/LIPIcs.CSL.2012.381 9 | branch: 'master' 10 | 11 | synopsis: Plugin for generating parametricity statements to perform refinement proofs 12 | 13 | description: |- 14 | A Coq plugin providing commands for generating parametricity statements. 15 | Typical applications of such statements are in data refinement proofs. 16 | Note that the plugin is still in an experimental state - it is not very user 17 | friendly (lack of good error messages) and still contains bugs. But it 18 | is usable enough to "translate" a large chunk of the standard library. 19 | 20 | publications: 21 | - pub_title: Parametricity in an Impredicative Sort 22 | pub_url: https://hal.archives-ouvertes.fr/hal-00730913/ 23 | pub_doi: 10.4230/LIPIcs.CSL.2012.381 24 | 25 | authors: 26 | - name: Chantal Keller 27 | initial: true 28 | - name: Marc Lasson 29 | initial: true 30 | - name: Abhishek Anand 31 | - name: Pierre Roux 32 | - name: Emilio Jesús Gallego Arias 33 | - name: Cyril Cohen 34 | - name: Matthieu Sozeau 35 | 36 | maintainers: 37 | - name: Pierre Roux 38 | nickname: proux01 39 | 40 | license: 41 | fullname: MIT License 42 | identifier: MIT 43 | 44 | supported_coq_versions: 45 | text: >- 46 | The master branch tracks the development version of Coq, see 47 | releases for compatibility with released versions of Coq 48 | opam: '{= "dev" }' 49 | 50 | categories: 51 | - name: 'Miscellaneous/Coq Extensions' 52 | 53 | keywords: 54 | - name: paramcoq 55 | - name: parametricity 56 | - name: OCaml modules 57 | 58 | namespace: Param 59 | 60 | opam-file-maintainer: 'Pierre Roux ' 61 | 62 | opam-file-version: 'dev' 63 | 64 | tested_coq_opam_versions: 65 | - version: 'dev' 66 | 67 | documentation: |- 68 | # Deprecation Notice 69 | 70 | Paramcoq is no longer actually maintained and released. It is only 71 | kept as a test case for Rocq's OCaml API. The release for Rocq 9.0 72 | will be the last one and is known to suffer some universe issues 73 | (for instance iit no longer enable to compile CoqEAL). Users are 74 | invited to switch to [coq-elpi](https://github.com/LPCIC/coq-elpi) 75 | derive.param2. One can look at 76 | [CoqEAL](https://github.com/coq-community/coqeal) for an example of 77 | porting. Main current caveat: support for mutual inductives isn't 78 | implemented yet. 79 | --- 80 | -------------------------------------------------------------------------------- /src/abstraction.mlg: -------------------------------------------------------------------------------- 1 | { 2 | (**************************************************************************) 3 | (* *) 4 | (* ParamCoq *) 5 | (* Copyright (C) 2012 - 2018 *) 6 | (* *) 7 | (* See the AUTHORS file for the list of contributors *) 8 | (* *) 9 | (* This file is distributed under the terms of the MIT License *) 10 | (* *) 11 | (**************************************************************************) 12 | 13 | } 14 | 15 | DECLARE PLUGIN "coq-paramcoq.plugin" 16 | 17 | { 18 | open Feedback 19 | open Stdarg 20 | open Parametricity 21 | open Declare_translation 22 | } 23 | 24 | VERNAC COMMAND EXTEND SetParametricityTactic CLASSIFIED AS SIDEFF 25 | | #[ locality = Tactic_option.tac_option_locality; ] 26 | [ "Parametricity" "Tactic" ":=" generic_tactic(t) ] -> { 27 | Relations.set_parametricity_tactic 28 | locality 29 | (Gentactic.intern (Global.env()) t) } 30 | END 31 | 32 | VERNAC COMMAND EXTEND ShowTable CLASSIFIED AS QUERY 33 | | [ "Show" "Parametricity" "Table" ] -> { 34 | Relations.print_relations () 35 | } 36 | END 37 | 38 | VERNAC COMMAND EXTEND ShowParametricityTactic CLASSIFIED AS QUERY 39 | | [ "Show" "Parametricity" "Tactic" ] -> { 40 | Pp.(msg_info (str "Paramericity obligation tactic is " ++ Relations.print_parametricity_tactic ())) } 41 | END 42 | 43 | VERNAC COMMAND EXTEND ParametricityDefined CLASSIFIED AS SIDEFF STATE program 44 | | ![ close_proof ] [ "Parametricity" "Done" ] -> { 45 | parametricity_close_proof 46 | } 47 | END 48 | 49 | VERNAC COMMAND EXTEND AbstractionReference CLASSIFIED AS SIDEFF STATE opaque_access 50 | | [ "Parametricity" ref(c) ] -> 51 | { 52 | command_reference default_arity (intern_reference_to_name c) None 53 | } 54 | | [ "Parametricity" reference(c) "as" ident(name)] -> 55 | { 56 | command_reference default_arity (intern_reference_to_name c) (Some name) 57 | } 58 | | [ "Parametricity" reference(c) "qualified" ] -> 59 | { 60 | command_reference ~fullname:true default_arity (intern_reference_to_name c) None 61 | } 62 | | [ "Parametricity" reference(c) "arity" int(arity) ] -> 63 | { 64 | command_reference arity (intern_reference_to_name c) None 65 | } 66 | | [ "Parametricity" reference(c) "arity" int(arity) "as" ident(name) ] -> 67 | { 68 | command_reference arity (intern_reference_to_name c) (Some name) 69 | } 70 | | [ "Parametricity" reference(c) "arity" int(arity) "qualified" ] -> 71 | { 72 | command_reference ~fullname:true arity (intern_reference_to_name c) None 73 | } 74 | | [ "Parametricity" reference(c) "as" ident(name) "arity" integer(arity) ] -> 75 | { 76 | command_reference arity (intern_reference_to_name c) (Some name) 77 | } 78 | END 79 | 80 | VERNAC COMMAND EXTEND AbstractionRecursive CLASSIFIED AS SIDEFF STATE opaque_access 81 | | [ "Parametricity" "Recursive" reference(c) ] -> 82 | { 83 | command_reference_recursive default_arity (intern_reference_to_name c) 84 | } 85 | | [ "Parametricity" "Recursive" reference(c) "arity" integer(arity) ] -> 86 | { 87 | command_reference_recursive arity (intern_reference_to_name c) 88 | } 89 | | [ "Parametricity" "Recursive" reference(c) "qualified" ] -> 90 | { 91 | command_reference_recursive ~fullname:true default_arity (intern_reference_to_name c) 92 | } 93 | | [ "Parametricity" "Recursive" reference(c) "arity" integer(arity) "qualified" ] -> 94 | { 95 | command_reference_recursive ~fullname:true arity (intern_reference_to_name c) 96 | } 97 | END 98 | 99 | VERNAC COMMAND EXTEND Abstraction CLASSIFIED AS SIDEFF STATE opaque_access 100 | | [ "Parametricity" "Translation" constr(c) "as" ident(name)] -> 101 | { 102 | translate_command default_arity c name 103 | } 104 | | [ "Parametricity" "Translation" constr(c) "as" ident(name) "arity" integer(arity) ] -> 105 | { 106 | translate_command arity c name 107 | } 108 | | [ "Parametricity" "Translation" constr(c) "arity" integer(arity) "as" ident(name)] -> 109 | { 110 | translate_command arity c name 111 | } 112 | END 113 | 114 | VERNAC COMMAND EXTEND TranslateModule CLASSIFIED AS SIDEFF STATE opaque_access 115 | | [ "Parametricity" "Module" global(qid) ] -> 116 | { 117 | translate_module_command Parametricity.default_arity qid 118 | } 119 | | [ "Parametricity" "Module" global(qid) "as" ident(name) ] -> 120 | { 121 | translate_module_command ~name Parametricity.default_arity qid 122 | } 123 | | [ "Parametricity" "Module" global(qid) "arity" integer(arity) ] -> 124 | { 125 | translate_module_command arity qid 126 | } 127 | | [ "Parametricity" "Module" global(qid) "as" ident(name) "arity" integer(arity) ] -> 128 | { 129 | translate_module_command ~name arity qid 130 | } 131 | | [ "Parametricity" "Module" global(qid) "arity" integer(arity) "as" ident(name)] -> 132 | { 133 | translate_module_command ~name arity qid 134 | } 135 | END 136 | 137 | VERNAC COMMAND EXTEND Realizer CLASSIFIED AS SIDEFF STATE opaque_access 138 | | [ "Realizer" constr(c) "as" ident(name) ":=" constr(t) ] -> 139 | { 140 | realizer_command Parametricity.default_arity (Some name) c t 141 | } 142 | | [ "Realizer" constr(c) "as" ident(name) "arity" integer(arity) ":=" constr(t) ] -> 143 | { 144 | realizer_command arity (Some name) c t 145 | } 146 | | [ "Realizer" constr(c) "arity" integer(arity) "as" ident(name) ":=" constr(t) ] -> 147 | { 148 | realizer_command arity (Some name) c t 149 | } 150 | END 151 | -------------------------------------------------------------------------------- /src/debug.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* ParamCoq *) 4 | (* Copyright (C) 2012 - 2018 *) 5 | (* *) 6 | (* See the AUTHORS file for the list of contributors *) 7 | (* *) 8 | (* This file is distributed under the terms of the MIT License *) 9 | (* *) 10 | (**************************************************************************) 11 | 12 | open Names 13 | open EConstr 14 | open Pp 15 | 16 | let toCDecl old : Constr.rel_declaration = 17 | let (name,value,typ) = old in 18 | match value with 19 | | Some value -> Context.Rel.Declaration.LocalDef (name,value,typ) 20 | | None -> Context.Rel.Declaration.LocalAssum (name,typ) 21 | 22 | let toDecl old : rel_declaration = 23 | let (name,value,typ) = old in 24 | match value with 25 | | Some value -> Context.Rel.Declaration.LocalDef (name,value,typ) 26 | | None -> Context.Rel.Declaration.LocalAssum (name,typ) 27 | 28 | let fromDecl (n: _ Context.Rel.Declaration.pt) = 29 | match n with 30 | | Context.Rel.Declaration.LocalDef (name,value,typ) -> (name,Some value,typ) 31 | | Context.Rel.Declaration.LocalAssum (name,typ) -> (name,None,typ) 32 | 33 | (* 34 | let fromFromLocalEntry (l: Entries.local_entry): Constr.constr = 35 | match l with 36 | | Entries.LocalDefEntry c -> c 37 | | Entries.LocalAssumEntry c -> c 38 | *) 39 | 40 | let all = [`ProofIrrelevance; 41 | `Abstraction; 42 | `Relation; 43 | `Translate; 44 | `Fix; 45 | `Case; 46 | `GenericUnfolding; 47 | `Unfolding; 48 | `Inductive; 49 | `Module; 50 | `Realizer; `Opacity] 51 | 52 | let debug_flag = [`Time; `Fix; `Module; `Abstraction; `Realizer; `Translate; `Cast; `Inductive; `Module; `ProofIrrelevance] 53 | 54 | let debug_mode = ref false 55 | let set_debug_mode = 56 | Goptions.declare_bool_option 57 | { Goptions.optdepr = None; 58 | Goptions.optstage = Interp; 59 | Goptions.optkey = ["Parametricity"; "Debug"]; 60 | Goptions.optread = (fun () -> !debug_mode); 61 | Goptions.optwrite = (:=) debug_mode } 62 | 63 | let debug_rename_env env evd = 64 | let rc = EConstr.rel_context env in 65 | let env = Environ.reset_context env in 66 | let rc = Namegen.name_context env evd rc in 67 | let env = push_rel_context rc env in 68 | Namegen.make_all_name_different env evd 69 | 70 | let debug_message flags s e = 71 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then 72 | Feedback.msg_notice Pp.(str s ++ e) 73 | 74 | let debug_env flags (s : string) env evd = 75 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then 76 | let env = debug_rename_env env evd in 77 | Feedback.(msg_notice (Pp.str s ++ Printer.pr_context_of env evd)) 78 | 79 | 80 | 81 | let debug flags (s : string) env evd c = 82 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then 83 | try 84 | let env = debug_rename_env env evd in 85 | Feedback.(msg_notice (Pp.str s 86 | ++ Printer.pr_context_of env evd)); 87 | Feedback.(msg_notice (Pp.str "" 88 | ++ Pp.str "\n |-" 89 | ++ Printer.pr_econstr_env env evd c)) 90 | with e -> Feedback.(msg_notice (str (Printf.sprintf "Caught exception while debugging '%s'" (Printexc.to_string e)))) 91 | 92 | let debug_evar_map flags s env evd = 93 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then ( 94 | Feedback.msg_info Pp.(str s ++ Termops.pr_evar_map ~with_univs:true None env evd)) 95 | 96 | let debug_string flags s = 97 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then 98 | Feedback.msg_notice (Pp.str ("--->\t"^s)) 99 | 100 | let debug_case_info flags ci = 101 | let open Constr in 102 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then 103 | let (ind, k) = ci.ci_ind in 104 | let ind_string = Printf.sprintf "%s[%d]" (MutInd.to_string ind) k in 105 | let param = ci.ci_npar in 106 | let ndecls = String.concat ";" (List.map string_of_int (Array.to_list ci.ci_cstr_ndecls)) in 107 | let nargs = String.concat ";" (List.map string_of_int (Array.to_list ci.ci_cstr_nargs)) in 108 | let pp_info x = 109 | let string_of_style = match x.style with 110 | LetStyle -> "LetStyle" | IfStyle -> "IfStyle" | LetPatternStyle -> "LetPatternStyle" | MatchStyle -> "MatchStyle" | RegularStyle -> "RegularStyle" 111 | in 112 | Printf.sprintf "style = %s" string_of_style 113 | in 114 | debug_string flags 115 | (Printf.sprintf "CASEINFO:inductive = %s.\nparam = %d.\nndecls = %s.\nnargs = %s.\npp_info = %s\n.EOFCASEINFO" 116 | ind_string 117 | param 118 | ndecls 119 | nargs 120 | (pp_info ci.ci_pp_info)) 121 | 122 | let debug_rel_context flags s env sigma l = 123 | if !debug_mode && List.exists (fun x -> List.mem x flags) debug_flag then 124 | Feedback.msg_notice Pp.(str s ++ (Termops.Internal.print_rel_context (push_rel_context l env) sigma)) 125 | 126 | let not_implemented ?(reason = "no reason") env evd t = 127 | debug [`Not_implemented] (Printf.sprintf "not implemented (%s):" reason) env evd t; 128 | failwith "not_implemented" 129 | 130 | module SortSet = Set.Make(Sorts) 131 | let rec sorts accu t = match Constr.kind t with 132 | | Constr.Sort t -> SortSet.add t accu 133 | | _ -> Constr.fold sorts accu t 134 | 135 | let debug_mutual_inductive_entry = 136 | let open Entries in 137 | let open Pp in 138 | let field name value cont = (align ()) ++ (str name) ++ (str " : ") ++ value ++ fnl () ++ cont in 139 | let rec debug_mutual_inductive_entry evd entry = 140 | let mind_entry_record_pp = str 141 | (match entry.mind_entry_record with 142 | | Some (Some id) -> 143 | let s = ref "" in 144 | let first = ref true in 145 | for i = 0 to Array.length id - 1 do 146 | if not !first then s := !s ^ ", " else first := false; 147 | s := !s ^ Id.to_string id.(i) 148 | done; 149 | Printf.sprintf "Some (Some %s)" !s 150 | | Some None -> "Some None" 151 | | None -> "None") 152 | in 153 | let mind_entry_finite_pp = 154 | let open Declarations in str 155 | (match entry.mind_entry_finite with 156 | Finite -> "Finite" | CoFinite -> "CoFinite" | BiFinite -> "BiFinite") 157 | in 158 | debug_string all "env_params:" 159 | ; 160 | let env_params = 161 | List.fold_left (fun acc decl -> 162 | debug_env all "acc = " acc evd; 163 | match decl with 164 | | Context.Rel.Declaration.LocalAssum (id, typ) -> 165 | debug all "typ = " acc evd (of_constr typ); 166 | Environ.push_rel decl acc 167 | | Context.Rel.Declaration.LocalDef (id, def, typ) -> 168 | debug all "def = " acc evd (of_constr def); 169 | debug all "typ = " acc evd (of_constr typ); 170 | Environ.push_rel decl acc) 171 | (Global.env ()) (List.rev entry.mind_entry_params) 172 | in 173 | debug_string all "arities:"; 174 | let mind_entry_params_pp = Printer.pr_context_of env_params Evd.empty in 175 | let arities = List.map 176 | (fun entry -> entry.mind_entry_typename, entry.mind_entry_arity) 177 | entry.mind_entry_inds 178 | in 179 | let mind_entry_inds_pp = 180 | List.fold_left app (str "") 181 | (List.map (pp_one_inductive_entry arities env_params) entry.mind_entry_inds) 182 | in 183 | let mind_entry_polymorphic_pp = 184 | str (match entry.mind_entry_universes with 185 | | Monomorphic_ind_entry | Template_ind_entry _ -> "false" 186 | | Polymorphic_ind_entry _ -> "true" 187 | ) 188 | in 189 | let mind_entry_universes_pp = 190 | match entry.mind_entry_universes with 191 | | Monomorphic_ind_entry | Template_ind_entry _ -> mt () 192 | | Polymorphic_ind_entry ux -> 193 | UVars.pr_universe_context Sorts.QVar.raw_pr UnivNames.pr_level_with_global_universes ux 194 | in 195 | let mind_entry_cumul_pp = bool (Option.has_some entry.mind_entry_variance) in 196 | let mind_entry_private_pp = 197 | match entry.mind_entry_private with 198 | None -> str "None" | Some true -> str "Some true" | Some false -> str "Some false" 199 | in 200 | let fields = List.rev 201 | [ "mind_entry_record", mind_entry_record_pp; 202 | "mind_entry_finite", mind_entry_finite_pp; 203 | "mind_entry_params", mind_entry_params_pp; 204 | "mind_entry_inds", mind_entry_inds_pp; 205 | "mind_entry_polymorphic", mind_entry_polymorphic_pp; 206 | "mind_entry_universes", mind_entry_universes_pp; 207 | "mind_entry_cumulative", mind_entry_cumul_pp; 208 | "mind_entry_private", mind_entry_private_pp] 209 | in 210 | let res = (str "{") ++ hov 140 ( 211 | List.fold_left (fun acc (name, pp) -> 212 | field name pp acc) (mt ()) fields) ++ str "}" in 213 | Feedback.msg_notice res; 214 | let sorts = List.fold_left (fun accu ind -> 215 | sorts accu ind.mind_entry_arity) SortSet.empty entry.mind_entry_inds 216 | in 217 | let sorts_pp = 218 | SortSet.fold (fun sort accu -> 219 | accu ++ (Printer.pr_sort evd sort) ++ fnl ()) sorts (mt ()) 220 | in 221 | Feedback.msg_notice (hov 100 sorts_pp) 222 | and pp_one_inductive_entry arities env_params entry = 223 | let params = Environ.rel_context env_params in 224 | let arities = List.map (fun (x, y) -> (x, Term.it_mkProd_or_LetIn y params)) arities in 225 | 226 | let arities_params_env = 227 | let env_arities = 228 | List.fold_left (fun acc (id, arity) -> Environ.push_rel (toCDecl (Context.make_annot (Name id) Sorts.Relevant, None, arity)) acc) 229 | Environ.empty_env (List.rev arities) 230 | in 231 | Environ.push_rel_context params env_arities 232 | in 233 | let mind_entry_typename_pp = 234 | str (Id.to_string entry.mind_entry_typename) 235 | in 236 | let mind_entry_arity_pp = 237 | Printer.safe_pr_constr_env env_params Evd.empty entry.mind_entry_arity 238 | in 239 | let mind_entry_consnames_pp = 240 | str (String.concat ";" (List.map Id.to_string entry.mind_entry_consnames)) 241 | in 242 | let mind_entry_lc_pp = 243 | List.fold_left app (str "") 244 | (List.map (Printer.safe_pr_constr_env arities_params_env Evd.empty) entry.mind_entry_lc) 245 | in 246 | let fields = 247 | [ "mind_entry_typename", mind_entry_typename_pp; 248 | "mind_entry_arity", mind_entry_arity_pp; 249 | "mind_entry_consnames", mind_entry_consnames_pp; 250 | "mind_entry_lc", mind_entry_lc_pp ] 251 | in 252 | str "{" ++ hov 100 ( 253 | List.fold_left (fun acc (name, pp) -> 254 | field name pp acc) (mt ()) fields) ++ str "}" 255 | in 256 | fun evd entry -> if !debug_mode then 257 | debug_mutual_inductive_entry evd entry 258 | -------------------------------------------------------------------------------- /src/declare_translation.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* ParamCoq *) 4 | (* Copyright (C) 2012 - 2018 *) 5 | (* *) 6 | (* See the AUTHORS file for the list of contributors *) 7 | (* *) 8 | (* This file is distributed under the terms of the MIT License *) 9 | (* *) 10 | (**************************************************************************) 11 | 12 | open Feedback 13 | open Libnames 14 | open EConstr 15 | open Debug 16 | open Parametricity 17 | 18 | [@@@ocaml.warning "-40"] 19 | let error = CErrors.user_err 20 | let ongoing_translation = Summary.ref false ~name:"parametricity ongoing translation" 21 | let ongoing_translation_opacity = Summary.ref false ~name:"parametricity ongoing translation opacity" 22 | let check_nothing_ongoing () = 23 | if !ongoing_translation then 24 | error (Pp.str "Some terms are being translated, please prove pending obligations before starting a new one. End them with the command 'Parametricity Done'.") 25 | 26 | let intern_reference_to_name qualid = 27 | match Constrintern.intern_reference qualid with 28 | | Some x -> x 29 | | None -> 30 | error Pp.(Libnames.pr_qualid qualid ++ str " does not refer to a global constant") 31 | 32 | let obligation_message () = 33 | let open Pp in 34 | msg_notice (str "The parametricity tactic generated generated proof obligations. " 35 | ++ str "Please prove them and end your proof with 'Parametricity Done'. ") 36 | 37 | let default_continuation = ignore 38 | 39 | let parametricity_close_proof ~lemma ~pm = 40 | let opaque = if !ongoing_translation_opacity then Vernacexpr.Opaque else Transparent in 41 | ongoing_translation := false; 42 | let pm, _ = Declare.Proof.save ~pm ~proof:lemma ~opaque ~idopt:None in 43 | pm 44 | 45 | let add_definition ~opaque ~hook ~poly ~scope ~kind ~tactic name env evd term typ = 46 | debug Debug.all "add_definition, term = " env evd (snd (term ( evd))); 47 | debug Debug.all "add_definition, typ = " env evd typ; 48 | debug_evar_map Debug.all "add_definition, evd = " env evd; 49 | let init_tac = 50 | let open Proofview in 51 | let typecheck = true in 52 | tclTHEN (Refine.refine ~typecheck begin fun sigma -> term sigma end) tactic 53 | in 54 | ongoing_translation_opacity := opaque; 55 | let info = Declare.Info.make ~hook ~scope ~kind ~poly () in 56 | let cinfo = Declare.CInfo.make ~name ~typ () in 57 | let lemma = Declare.Proof.start ~cinfo ~info evd in 58 | let lemma = Declare.Proof.map lemma ~f:(fun p -> 59 | let p, _, () = Proof.run_tactic Global.(env()) init_tac p in 60 | p) 61 | in 62 | let proof = Declare.Proof.get lemma in 63 | let is_done = Proof.is_done proof in 64 | if is_done then 65 | (let pm = Declare.OblState.empty in 66 | let _pm = parametricity_close_proof ~pm ~lemma in None) 67 | else begin 68 | ongoing_translation := true; 69 | obligation_message (); 70 | Some lemma 71 | end 72 | 73 | let declare_abstraction ~opaque_access ?(opaque = false) ?(continuation = default_continuation) ~poly ~scope ~kind arity evdr env a name = 74 | Debug.debug_evar_map Debug.all "declare_abstraction, evd = " env !evdr; 75 | debug [`Abstraction] "declare_abstraction, a =" env !evdr a; 76 | let b = Retyping.get_type_of env !evdr a in 77 | debug [`Abstraction] "declare_abstraction, b =" env !evdr b; 78 | let b = Retyping.get_type_of env !evdr a in 79 | let module P = WithOpaqueAccess(struct let access = opaque_access end) in 80 | let b_R = P.relation arity evdr env b in 81 | let sub = range (fun k -> prime !evdr arity k a) arity in 82 | let b_R = EConstr.Vars.substl sub b_R in 83 | let a_R = fun evd -> 84 | let evdr = ref evd in 85 | let a_R = P.translate arity evdr env a in 86 | debug [`Abstraction] "a_R = " env !evdr a_R; 87 | debug_evar_map Debug.all "abstraction, evar_map = " env !evdr; 88 | !evdr, a_R 89 | in 90 | let evd = !evdr in 91 | let hook = 92 | match EConstr.kind !evdr a with 93 | | Const cte when 94 | let cte = (fst cte, EInstance.kind !evdr (snd cte)) in 95 | (try ignore (Relations.get_constant arity (UVars.out_punivs cte)); false with Not_found -> true) 96 | -> 97 | Declare.Hook.(make (fun { dref ; _ } -> 98 | if !ongoing_translation then error (Pp.str "Please use the 'Debug.Done' command to end proof obligations generated by the parametricity tactic."); 99 | Pp.(Flags.if_verbose msg_info (str (Printf.sprintf "'%s' is now a registered translation." (Names.Id.to_string name)))); 100 | let cte = (fst cte, EInstance.kind !evdr (snd cte)) in 101 | Relations.declare_relation arity (Names.GlobRef.ConstRef (UVars.out_punivs cte)) dref; 102 | continuation ())) 103 | | _ -> Declare.Hook.(make (fun _ -> continuation ())) 104 | in 105 | let tactic = Relations.get_parametricity_tactic () in 106 | add_definition ~tactic ~opaque ~poly ~scope ~kind ~hook name env evd a_R b_R 107 | 108 | let declare_inductive ~opaque_access name ?(continuation = default_continuation) arity evd env (((mut_ind, _) as ind, inst)) = 109 | let mut_body, _ = Inductive.lookup_mind_specif env ind in 110 | debug_string [`Inductive] "Translating mind body ..."; 111 | let module P = Parametricity.WithOpaqueAccess(struct let access = opaque_access end) in 112 | let translation_entry = P.translate_mind_body name arity evd env mut_ind mut_body inst in 113 | debug_string [`Inductive] ("Translating mind body ... done."); 114 | debug_evar_map [`Inductive] "evar_map inductive " env !evd; 115 | let size = Declarations.(Array.length mut_body.mind_packets) in 116 | let mut_ind_R = DeclareInd.declare_mutual_inductive_with_eliminations translation_entry 117 | (Monomorphic_entry Univ.ContextSet.empty, UnivNames.empty_binders) [] in 118 | for k = 0 to size-1 do 119 | Relations.declare_inductive_relation arity (mut_ind, k) (mut_ind_R, k) 120 | done; 121 | continuation () 122 | 123 | let translate_inductive_command arity c name = 124 | let env = Global.env () in 125 | let sigma = Evd.from_env env in 126 | let (sigma, c) = Constrintern.interp_open_constr env sigma c in 127 | let (ind, _) as pind, _ = 128 | try 129 | Inductive.find_rectype env (to_constr sigma c) 130 | with Not_found -> 131 | error (Pp.(str "Unable to locate an inductive in " ++ Printer.pr_econstr_env env sigma c)) 132 | in 133 | try 134 | let ind_R = Globnames.destIndRef (Relations.get_inductive arity ind) in 135 | error (Pp.(str "The inductive " ++ Printer.pr_inductive env ind ++ str " already as the following registered translation " ++ Printer.pr_inductive env ind_R)) 136 | with Not_found -> 137 | let evd = ref sigma in 138 | declare_inductive name arity evd env pind 139 | 140 | let declare_realizer ~opaque_access ?(continuation = default_continuation) ?kind ?real arity evd env name (var : constr) = 141 | let gref = (match EConstr.kind !evd var with 142 | | Var id -> Names.GlobRef.VarRef id 143 | | Const (cst, _) -> Names.GlobRef.ConstRef cst 144 | | _ -> error (Pp.str "Realizer works only for variables and constants.")) in 145 | let evd', typ = Typing.type_of env !evd var in 146 | evd := evd'; 147 | let module P = Parametricity.WithOpaqueAccess(struct let access = opaque_access end) in 148 | let typ_R = P.relation arity evd env typ in 149 | let sub = range (fun _ -> var) arity in 150 | let typ_R = Vars.substl sub typ_R in 151 | let cpt = ref 0 in 152 | let real = 153 | incr cpt; 154 | match real with Some real -> fun sigma -> 155 | let (sigma, term) = real sigma in 156 | let realtyp = Retyping.get_type_of env sigma term in 157 | debug [`Realizer] (Printf.sprintf "real in realdef (%d) =" !cpt) env sigma term; 158 | debug [`Realizer] (Printf.sprintf "realtyp in realdef (%d) =" !cpt) env sigma realtyp; 159 | let sigma = Evarconv.unify_leq_delay env sigma realtyp typ_R in 160 | debug [`Realizer] (Printf.sprintf "real in realdef (%d), after =" !cpt) env sigma term; 161 | debug [`Realizer] (Printf.sprintf "realtyp in realdef (%d), after =" !cpt) env sigma realtyp; 162 | (sigma, term) 163 | | None -> fun sigma -> 164 | (let sigma, real = new_evar_compat env sigma typ_R in 165 | (sigma, real)) 166 | in 167 | let scope = Locality.(Global ImportDefaultBehavior) in 168 | let poly = true in 169 | let kind = Decls.(IsDefinition Definition) in 170 | let name = match name with Some x -> x | _ -> 171 | let name_str = (match EConstr.kind !evd var with 172 | | Var id -> Names.Id.to_string id 173 | | Const (cst, _) -> Names.Label.to_string (Names.Constant.label cst) 174 | | _ -> assert false) 175 | in 176 | let name_R = translate_string arity name_str in 177 | Names.Id.of_string name_R 178 | in 179 | let sigma = !evd in 180 | debug_evar_map [`Realizer] "ear_map =" env sigma; 181 | let hook = Declare.Hook.(make (fun { dref; _ } -> 182 | Pp.(msg_info (str (Printf.sprintf "'%s' is now a registered translation." (Names.Id.to_string name)))); 183 | Relations.declare_relation arity gref dref; 184 | continuation ())) in 185 | let tactic = Relations.get_parametricity_tactic () in 186 | add_definition ~tactic ~opaque:false ~poly ~scope ~kind ~hook name env sigma real typ_R 187 | 188 | let realizer_command ~opaque_access arity name var real = 189 | let env = Global.env () in 190 | let sigma = Evd.from_env env in 191 | let (sigma, var) = Constrintern.interp_open_constr env sigma var in 192 | RetrieveObl.check_evars env sigma; 193 | let real = fun sigma -> Constrintern.interp_open_constr env sigma real in 194 | ignore(declare_realizer ~opaque_access arity (ref sigma) env name var ~real) 195 | 196 | let rec list_continuation final f l _ = match l with [] -> final () 197 | | hd::tl -> f (list_continuation final f tl) hd 198 | 199 | let rec translate_module_command ~opaque_access ?name arity r = 200 | check_nothing_ongoing (); 201 | let qid = r in 202 | let mp, mb = 203 | try 204 | let mp = Nametab.locate_module qid in 205 | let mb = Global.lookup_module mp in 206 | mp, mb 207 | with Not_found -> error Pp.(str "Unknown Module " ++ pr_qualid qid) 208 | in 209 | declare_module ~opaque_access ?name arity mp mb 210 | 211 | and id_of_module_path mp = 212 | let open Names in 213 | let open ModPath in 214 | match mp with 215 | | MPdot (_, lab) -> Label.to_id lab 216 | | MPfile dp -> List.hd (DirPath.repr dp) 217 | | MPbound id -> MBId.to_id id 218 | 219 | and declare_module ~opaque_access ?(continuation = ignore) ?name arity mp mb = 220 | debug_string [`Module] "--> declare_module"; 221 | let open Declarations in 222 | match Mod_declarations.mod_expr mb, Mod_declarations.mod_type mb with 223 | | Algebraic _, NoFunctor fields 224 | | FullStruct, NoFunctor fields -> 225 | let id = id_of_module_path mp in 226 | let id_R = match name with Some id -> id | None -> translate_id arity id in 227 | debug_string [`Module] (Printf.sprintf "start module: '%s' (translating '%s')." 228 | (Names.Id.to_string id_R) (Names.Id.to_string id)); 229 | let _mp_R = Declaremods.start_module None id_R [] (Declaremods.Check []) in 230 | list_continuation 231 | (fun _ -> 232 | debug_string [`Module] (Printf.sprintf "end module: '%s'." (Names.Id.to_string id_R)); 233 | ignore (Declaremods.end_module ()); continuation ()) 234 | (fun continuation -> function 235 | | (lab, SFBconst cb) when (match cb.const_body with OpaqueDef _ -> false | Undef _ -> true | _ -> false) -> 236 | let cst = Mod_subst.constant_of_delta_kn (Mod_declarations.mod_delta mb) (Names.KerName.make mp lab) in 237 | if try ignore (Relations.get_constant arity cst); true with Not_found -> false then 238 | continuation () 239 | else 240 | debug_string [`Module] (Printf.sprintf "axiom field: '%s'." (Names.Label.to_string lab)); 241 | (* As we rely on globally declared constants we need to access the 242 | global env here; previously indeed there was a bug in the call to 243 | Pfedit.get_current_context [it worked because we had no proof 244 | state] *) 245 | let env = Global.env () in 246 | let evd = Evd.from_env env in 247 | let evd, ucst = 248 | Evd.(with_sort_context_set univ_rigid evd (UnivGen.fresh_constant_instance env cst)) 249 | in 250 | let evdr = ref evd in 251 | ignore(declare_realizer ~opaque_access ~continuation arity evdr env None (mkConstU (fst ucst, EInstance.make (snd ucst)))) 252 | 253 | | (lab, SFBconst cb) -> 254 | let opaque = 255 | match cb.const_body with OpaqueDef _ -> true | _ -> false 256 | in 257 | let poly = Declareops.constant_is_polymorphic cb in 258 | let scope = Locality.(Global ImportDefaultBehavior) in 259 | let kind = Decls.(IsDefinition Definition) in 260 | let cst = Mod_subst.constant_of_delta_kn (Mod_declarations.mod_delta mb) (Names.KerName.make mp lab) in 261 | if try ignore (Relations.get_constant arity cst); true with Not_found -> false then 262 | continuation () 263 | else 264 | let env = Global.env () in 265 | let evd = Evd.from_env env in 266 | let evd, ucst = 267 | Evd.(with_sort_context_set univ_rigid evd (UnivGen.fresh_constant_instance env cst)) 268 | in 269 | let c = mkConstU (fst ucst, EInstance.make (snd ucst)) in 270 | let evdr = ref evd in 271 | let lab_R = translate_id arity (Names.Label.to_id lab) in 272 | debug [`Module] "field : " env !evdr c; 273 | (try 274 | let evd, typ = Typing.type_of env !evdr c in 275 | evdr := evd; 276 | debug [`Module] "type :" env !evdr typ 277 | with e -> error (Pp.str (Printexc.to_string e))); 278 | debug_string [`Module] (Printf.sprintf "constant field: '%s'." (Names.Label.to_string lab)); 279 | ignore(declare_abstraction ~opaque_access ~opaque ~continuation ~poly ~scope ~kind arity evdr env c lab_R) 280 | 281 | | (lab, SFBmind _) -> 282 | let env = Global.env () in 283 | let evd = Evd.from_env env in 284 | let evdr = ref evd in 285 | let mut_ind = Mod_subst.mind_of_delta_kn (Mod_declarations.mod_delta mb) (Names.KerName.make mp lab) in 286 | let ind = (mut_ind, 0) in 287 | if try ignore (Relations.get_inductive arity ind); true with Not_found -> false then 288 | continuation () 289 | else begin 290 | let evd, pind = 291 | Evd.(with_sort_context_set univ_rigid !evdr (UnivGen.fresh_inductive_instance env ind)) 292 | in 293 | evdr := evd; 294 | debug_string [`Module] (Printf.sprintf "inductive field: '%s'." (Names.Label.to_string lab)); 295 | let ind_name = Names.Id.of_string 296 | @@ translate_string arity 297 | @@ Names.Label.to_string 298 | @@ Names.MutInd.label 299 | @@ mut_ind 300 | in 301 | declare_inductive ~opaque_access ind_name ~continuation arity evdr env pind 302 | end 303 | | (lab, SFBmodule mb') when 304 | match Mod_declarations.mod_type mb' with NoFunctor _ -> 305 | (match Mod_declarations.mod_expr mb' with FullStruct | Algebraic _ -> true | _ -> false) 306 | | _ -> false 307 | -> 308 | declare_module ~opaque_access ~continuation arity (MPdot (mp, lab)) mb' 309 | 310 | | (lab, _) -> 311 | Pp.(Flags.if_verbose msg_info (str (Printf.sprintf "Ignoring field '%s'." (Names.Label.to_string lab)))); 312 | continuation () 313 | ) fields () 314 | | Struct _, _ -> error Pp.(str "Module " ++ (str (Names.ModPath.to_string mp)) 315 | ++ str " is an interactive module.") 316 | | Abstract, _ -> error Pp.(str "Module " ++ (str (Names.ModPath.to_string mp)) 317 | ++ str " is an abstract module.") 318 | | _ -> Feedback.msg_warning Pp.(str "Module " ++ (str (Names.ModPath.to_string mp)) 319 | ++ str " is not a fully-instantiated module."); 320 | continuation () 321 | 322 | 323 | let command_variable ?(continuation = default_continuation) arity variable names = 324 | error (Pp.str "Cannot translate an axiom nor a variable. Please use the 'Parametricity Realizer' command.") 325 | 326 | let translateFullName ~fullname arity (kername : Names.KerName.t) : string = 327 | let nstr = 328 | (translate_string arity 329 | @@ Names.Label.to_string 330 | @@ Names.KerName.label 331 | @@ kername)in 332 | let pstr = 333 | (Names.ModPath.to_string 334 | @@ Names.KerName.modpath 335 | @@ kername) in 336 | let plstr = Str.split (Str.regexp ("\\.")) pstr in 337 | if fullname then 338 | (String.concat "_o_" (plstr@[nstr])) 339 | else nstr 340 | 341 | let command_constant ~opaque_access ?(continuation = default_continuation) ~fullname arity constant names = 342 | let env = Global.env () in 343 | let evd = Evd.from_env env in 344 | let poly, opaque = 345 | let cb = Global.lookup_constant constant in 346 | let open Declarations in 347 | Declareops.constant_is_polymorphic cb, 348 | (match cb.const_body with Def _ -> false | _ -> true) 349 | in 350 | let name = match names with 351 | | None -> Names.Id.of_string 352 | @@ translateFullName ~fullname arity 353 | @@ Names.Constant.canonical 354 | @@ constant 355 | | Some name -> name 356 | in 357 | let scope = Locality.(Global ImportDefaultBehavior) in 358 | let kind = Decls.(IsDefinition Definition) in 359 | let evd, pconst = 360 | Evd.(with_sort_context_set univ_rigid evd (UnivGen.fresh_constant_instance env constant)) 361 | in 362 | let constr = mkConstU (fst pconst, EInstance.make @@ snd pconst) in 363 | declare_abstraction ~opaque_access ~continuation ~opaque ~poly ~scope ~kind 364 | arity (ref evd) env constr name 365 | 366 | let command_inductive ~opaque_access ?(continuation = default_continuation) ~fullname arity inductive names = 367 | let env = Global.env () in 368 | let evd = Evd.from_env env in 369 | let evd, pind = 370 | Evd.(with_sort_context_set univ_rigid evd (UnivGen.fresh_inductive_instance env inductive)) 371 | in 372 | let name = match names with 373 | | None -> 374 | Names.Id.of_string 375 | @@ translateFullName ~fullname arity 376 | @@ Names.MutInd.canonical 377 | @@ fst 378 | @@ fst 379 | @@ pind 380 | | Some name -> name 381 | in 382 | declare_inductive ~opaque_access name ~continuation arity (ref evd) env pind 383 | 384 | let command_constructor ?(continuation = default_continuation) arity gref names = 385 | let open Pp in 386 | error ((str "'") 387 | ++ (Printer.pr_global gref) 388 | ++ (str "' is a constructor. To generate its parametric translation, please translate its inductive first.")) 389 | 390 | let command_reference ~opaque_access ?(continuation = default_continuation) ?(fullname = false) 391 | arity gref names = 392 | check_nothing_ongoing (); 393 | let open Names.GlobRef in 394 | (* We ignore proofs for now *) 395 | let _pstate = match gref with 396 | | VarRef variable -> 397 | command_variable ~continuation arity variable names 398 | | ConstRef constant -> 399 | command_constant ~opaque_access ~continuation ~fullname arity constant names 400 | | IndRef inductive -> 401 | command_inductive ~opaque_access ~continuation ~fullname arity inductive names; 402 | None 403 | | ConstructRef constructor -> 404 | command_constructor ~continuation arity gref names 405 | in () 406 | 407 | let command_reference_recursive ~opaque_access ?(continuation = default_continuation) ?(fullname = false) arity gref = 408 | let gref= Globnames.canonical_gr gref in 409 | let label = Names.Label.of_id (Nametab.basename_of_global gref) in 410 | (* Assumptions doesn't care about the universes *) 411 | let c, _ = UnivGen.fresh_global_instance (Global.env()) gref in 412 | let (direct, graph, _) = Assumptions.traverse opaque_access label c in 413 | let inductive_of_constructor ref = 414 | let open Globnames in 415 | let ref= Globnames.canonical_gr ref in 416 | if not (isConstructRef ref) then ref else 417 | let (ind, _) = Globnames.destConstructRef ref in 418 | Names.GlobRef.IndRef ind 419 | in 420 | let rec fold_sort graph visited nexts f acc = 421 | Names.GlobRef.Set_env.fold (fun ref ((visited, acc) as visacc) -> 422 | let ref_ind = inductive_of_constructor ref in 423 | if Names.GlobRef.Set_env.mem ref_ind visited 424 | || Relations.is_referenced arity ref_ind then visacc else 425 | let nexts = Names.GlobRef.Map_env.find ref graph in 426 | let nexts = Option.default Names.GlobRef.Set_env.empty nexts in 427 | let visited = Names.GlobRef.Set_env.add ref_ind visited in 428 | let visited, acc = fold_sort graph visited nexts f acc in 429 | let acc = f ref_ind acc in 430 | (visited, acc) 431 | ) nexts (visited, acc) 432 | in 433 | let _, dep_refs = fold_sort graph Names.GlobRef.Set_env.empty direct (fun x l -> (inductive_of_constructor x)::l) [] in 434 | let dep_refs = List.rev dep_refs in 435 | (* DEBUG: *) 436 | (* Pp.(msg_info (str "DepRefs:")); 437 | * List.iter (fun x -> msg_info (Printer.pr_global x)) dep_refs; *) 438 | list_continuation continuation (fun continuation gref -> 439 | command_reference ~opaque_access ~continuation ~fullname arity gref None) dep_refs () 440 | 441 | let translate_command ~opaque_access arity c name = 442 | if !ongoing_translation then error (Pp.str "On going translation."); 443 | (* Same comment as above *) 444 | let env = Global.env () in 445 | let evd = Evd.from_env env in 446 | let (evd, c) = Constrintern.interp_open_constr env evd c in 447 | let cte_option = 448 | match kind evd c with Const cte -> Some cte | _ -> None 449 | in 450 | let poly, opaque = 451 | match cte_option with 452 | | Some (cte, _) -> 453 | let cb = Global.lookup_constant cte in 454 | Declarations.((* cb.const_polymorphic, *) false, 455 | match cb.const_body with Def _ -> false 456 | | _ -> true) 457 | | None -> false, false 458 | in 459 | let scope = Locality.(Global ImportDefaultBehavior) in 460 | let kind = Decls.(IsDefinition Definition) in 461 | let _ : Declare.Proof.t option = declare_abstraction ~opaque_access ~opaque ~poly ~scope ~kind arity (ref evd) env c name in 462 | () 463 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name paramcoq) 3 | (public_name coq-paramcoq.plugin) 4 | (synopsis "Plugin for generating parametricity statements to perform refinement proofs") 5 | (flags :standard -rectypes -w -9-27) 6 | (libraries coq-core.plugins.ltac)) ; not sure if ltac dep is real 7 | 8 | (coq.pp (modules abstraction)) 9 | -------------------------------------------------------------------------------- /src/paramcoq.mlpack: -------------------------------------------------------------------------------- 1 | Debug 2 | Relations 3 | Parametricity 4 | Declare_translation 5 | Abstraction 6 | Paramcoq_mod 7 | -------------------------------------------------------------------------------- /src/relations.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* ParamCoq *) 4 | (* Copyright (C) 2012 - 2018 *) 5 | (* *) 6 | (* See the AUTHORS file for the list of contributors *) 7 | (* *) 8 | (* This file is distributed under the terms of the MIT License *) 9 | (* *) 10 | (**************************************************************************) 11 | 12 | 13 | open Names 14 | open Globnames 15 | open Libobject 16 | 17 | let (set_parametricity_tactic, get_parametricity_tactic, print_parametricity_tactic) = 18 | Tactic_option.declare_tactic_option "Parametricity tactic" 19 | 20 | module IntMap = Map.Make(Int) 21 | module GMap = GlobRef.Map 22 | 23 | 24 | let initial_translations = GMap.empty 25 | let initial_relations = IntMap.empty 26 | 27 | let relations = Summary.ref initial_relations ~name:"parametricity" 28 | 29 | let print_relations () = 30 | IntMap.iter (fun n translations -> 31 | GMap.iter (fun gref c -> Feedback.(msg_info (Printer.pr_global gref))) translations 32 | ) !relations 33 | 34 | let add (n : int) f = 35 | let translations = 36 | try IntMap.find n !relations with Not_found -> initial_translations 37 | in 38 | relations := IntMap.add n (f translations) !relations 39 | 40 | let cache_relation (n, x, x_R) = 41 | add n (GMap.add x x_R) 42 | 43 | let discharge_relation (n, x, x_R) = 44 | Some (n, x, x_R) 45 | 46 | let subst_relation (subst, (n, x, x_R)) = 47 | (n, subst_global_reference subst x, subst_global_reference subst x_R) 48 | 49 | let in_relation = declare_object {(default_object "PARAMETRICITY") with 50 | cache_function = cache_relation; 51 | load_function = (fun _ -> cache_relation); 52 | subst_function = subst_relation; 53 | classify_function = (fun obj -> Substitute); 54 | discharge_function = discharge_relation} 55 | 56 | let declare_relation n x x_R = 57 | Lib.add_leaf (in_relation (n, x, x_R)) 58 | 59 | let declare_constant_relation (n : int) (c : Constant.t) (c_R : Constant.t) = 60 | declare_relation n (GlobRef.ConstRef c) (GlobRef.ConstRef c_R) 61 | 62 | let declare_inductive_relation (n : int) (i : inductive) (i_R : inductive) = 63 | declare_relation n (GlobRef.IndRef i) (GlobRef.IndRef i_R) 64 | 65 | let declare_variable_relation (n : int) (v : variable) (v_R : Constant.t) = 66 | declare_relation n (GlobRef.VarRef v) (GlobRef.ConstRef v_R) 67 | 68 | let get_constant n c = 69 | let map = IntMap.find n !relations in 70 | GMap.find (GlobRef.ConstRef c) map 71 | 72 | let get_inductive n i = 73 | let map = IntMap.find n !relations in 74 | GMap.find (GlobRef.IndRef i) map 75 | 76 | let get_variable n v = 77 | let map = IntMap.find n !relations in 78 | destConstRef (GMap.find (GlobRef.VarRef v) map) 79 | 80 | let is_referenced n ref = 81 | try 82 | let map = IntMap.find n !relations in 83 | GMap.mem ref map 84 | with Not_found -> false 85 | -------------------------------------------------------------------------------- /test-suite/ListQueue.v: -------------------------------------------------------------------------------- 1 | Require Import Parametricity. 2 | 3 | Require Import List. 4 | Import ListNotations. 5 | 6 | Definition bind_option {A B} (f : A -> option B) (x : option A) : 7 | option B := 8 | match x with 9 | | Some x => f x 10 | | None => None 11 | end. 12 | 13 | Notation "'do' X <- A 'in' B" := (bind_option (fun X => B) A) 14 | (at level 200, X ident, A at level 100, B at level 200). 15 | 16 | Definition bind_option2 {A B C} (f : A -> B -> option C) 17 | (x : option (A * B)) : option C := 18 | do yz <- x in let (y, z) := yz : A * B in f y z. 19 | 20 | Notation "'do' X , Y <- A 'in' B" := (bind_option2 (fun X Y => B) A) 21 | (at level 200, X ident, Y ident, A at level 100, B at level 200). 22 | 23 | 24 | 25 | Require Import List. 26 | 27 | 28 | Record Queue := { 29 | t :> Type; 30 | empty : t; 31 | push : nat -> t -> t; 32 | pop : t -> option (nat * t) 33 | }. 34 | 35 | 36 | Definition program (Q : Queue) (n : nat) : option nat := 37 | (* q := 0::1::2::...::n *) 38 | let q : Q := 39 | nat_rect (fun _ => Q) Q.(empty) Q.(push) (S n) 40 | in 41 | let q : option Q := nat_rect (fun _ => option Q) (Some q) 42 | (fun _ (q : option Q) => 43 | do q <- q in 44 | do x, q <- Q.(pop) q in 45 | do y, q <- Q.(pop) q in 46 | Some (Q.(push) (x + y) q)) n 47 | in 48 | do q <- q in 49 | option_map fst (Q.(pop) q). 50 | 51 | Definition ListQueue := {| 52 | t := list nat; 53 | empty := nil; 54 | push := @cons nat; 55 | pop := fun l => 56 | match rev l with 57 | | nil => None 58 | | hd :: tl => Some (hd, rev tl) end 59 | |}. 60 | 61 | Definition DListQueue := {| 62 | t := list nat * list nat; 63 | empty := (nil, nil); 64 | push x l := 65 | let (back, front) := l in 66 | (cons x back,front); 67 | pop := fun l => 68 | let (back, front) := l in 69 | match front with 70 | | [] => 71 | match rev back with 72 | | [] => None 73 | | hd :: tl => Some (hd, (nil, tl)) 74 | end 75 | | hd :: tl => Some (hd, (back, tl)) 76 | end 77 | |}. 78 | 79 | Parametricity Recursive nat. 80 | 81 | Print nat_R. 82 | 83 | Lemma nat_R_equal : 84 | forall x y, nat_R x y -> x = y. 85 | intros x y H; induction H; subst; trivial. 86 | Defined. 87 | Lemma equal_nat_R : 88 | forall x y, x = y -> nat_R x y. 89 | intros x y H; subst. 90 | induction y; constructor; trivial. 91 | Defined. 92 | 93 | Parametricity Recursive option. 94 | 95 | Lemma option_nat_R_equal : 96 | forall x y, option_R nat nat nat_R x y -> x = y. 97 | intros x1 x2 H; destruct H as [x1 x2 x_R | ]. 98 | rewrite (nat_R_equal _ _ x_R); reflexivity. 99 | reflexivity. 100 | Defined. 101 | Lemma equal_option_nat_R : 102 | forall x y, x = y -> option_R nat nat nat_R x y. 103 | intros x y H; subst. 104 | destruct y; constructor; apply equal_nat_R; reflexivity. 105 | Defined. 106 | 107 | Parametricity Recursive prod. 108 | Parametricity Recursive Queue. 109 | 110 | Print Queue_R. 111 | Check Queue_R. 112 | 113 | Notation Bisimilar := Queue_R. 114 | 115 | Print Queue_R. 116 | 117 | 118 | Definition R (l1 : list nat) (l2 : list nat * list nat) := 119 | let (back, front) := l2 in 120 | l1 = back ++ rev front. 121 | 122 | Lemma rev_app : 123 | forall A (l1 l2 : list A), 124 | rev (l1 ++ l2) = rev l2 ++ rev l1. 125 | induction l1. 126 | intro; symmetry; apply app_nil_r. 127 | intro; simpl; rewrite IHl1; rewrite app_assoc. 128 | reflexivity. 129 | Defined. 130 | 131 | Lemma rev_list_rect A : 132 | forall P:list A-> Type, 133 | P [] -> 134 | (forall (a:A) (l:list A), P (rev l) -> P (rev (a :: l))) -> 135 | forall l:list A, P (rev l). 136 | Proof. 137 | induction l; auto. 138 | Defined. 139 | 140 | Theorem rev_rect A : 141 | forall P:list A -> Type, 142 | P [] -> 143 | (forall (x:A) (l:list A), P l -> P (l ++ [x])) -> 144 | forall l:list A, P l. 145 | Proof. 146 | intros. 147 | generalize (rev_involutive l). 148 | intros E; rewrite <- E. 149 | apply (rev_list_rect _ P). 150 | auto. 151 | 152 | simpl. 153 | intros. 154 | apply (X0 a (rev l0)). 155 | auto. 156 | Defined. 157 | 158 | 159 | Lemma bisim_list_dlist : Bisimilar ListQueue DListQueue. 160 | apply (Queue_R_Build_Queue_R _ _ R). 161 | 162 | * reflexivity. 163 | 164 | * intros n1 n2 n_R. 165 | pose (nat_R_equal _ _ n_R) as H. 166 | destruct H. clear n_R. 167 | intros l [back front]. 168 | unfold R. 169 | simpl. 170 | intro; subst. 171 | simpl. 172 | reflexivity. 173 | 174 | * intros l [back front]. 175 | generalize l. clear l. 176 | unfold R; fold R. 177 | pattern back. 178 | 179 | apply rev_rect. 180 | 181 | intros l H; subst. 182 | rewrite rev_app. 183 | simpl. 184 | rewrite app_nil_r. 185 | rewrite rev_involutive. 186 | 187 | destruct front. 188 | constructor. 189 | repeat constructor. 190 | apply equal_nat_R; reflexivity. 191 | 192 | clear back; intros hd back IHR l H. 193 | subst. 194 | rewrite rev_app. 195 | rewrite rev_involutive. 196 | rewrite rev_app. 197 | simpl. 198 | destruct front. 199 | simpl. 200 | repeat constructor. 201 | apply equal_nat_R; reflexivity. 202 | simpl. 203 | repeat constructor. 204 | apply equal_nat_R; reflexivity. 205 | unfold R. 206 | rewrite rev_app. 207 | simpl. 208 | rewrite rev_involutive. 209 | reflexivity. 210 | Defined. 211 | 212 | Print program. 213 | Check program. 214 | Parametricity Recursive program. 215 | Check program_R. 216 | 217 | Lemma program_independent : 218 | forall n, 219 | program ListQueue n = program DListQueue n. 220 | intro n. 221 | apply option_nat_R_equal. 222 | apply program_R. 223 | apply bisim_list_dlist. 224 | apply equal_nat_R. 225 | reflexivity. 226 | Defined. 227 | Print program. 228 | Print program_R. 229 | -------------------------------------------------------------------------------- /test-suite/Makefile: -------------------------------------------------------------------------------- 1 | # -*- Makefile -*- 2 | # This Makefile assumes "make" has been previously run in the parent folder 3 | 4 | COQBIN?=$(dir $(shell which coqtop)) 5 | COQC := $(COQBIN)coqc 6 | PARAMLIBS := -I ../src 7 | EXAMPLES := example.v ListQueue.v features.v wadler.v bug.v bug2.v bug3.v bug4.v bug5.v dummyFix.v exmNotParametric.v 8 | 9 | all:: Parametricity.vo 10 | 11 | examples:: $(EXAMPLES:.v=.vo) 12 | 13 | ListQueue.vo: ListQueue.v Parametricity.vo 14 | example.vo: example.v Parametricity.vo 15 | features.vo: features.v Parametricity.vo 16 | wadler.vo: wadler.v Parametricity.vo 17 | bug.vo: bug.v Parametricity.vo 18 | bug%.vo: bug%.v Parametricity.vo 19 | 20 | # native eats too much memory, see eg https://gitlab.com/coq/coq/-/jobs/1144081161 21 | %.vo: %.v 22 | $(COQC) $(PARAMLIBS) -R . "" -native-compiler no $< 23 | 24 | ide:: Parametricity.vo 25 | $(COQBIN)coqide -debug $(PARAMLIBS) $(EXAMPLES) 26 | 27 | top:: Parametricity.vo 28 | $(COQBIN)coqtop $(PARAMLIBS) 29 | 30 | clean:: 31 | rm -f *.vo *.glob *.d 32 | -------------------------------------------------------------------------------- /test-suite/Parametricity.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "coq-paramcoq.plugin". 2 | 3 | Ltac destruct_reflexivity := 4 | intros ; repeat match goal with 5 | | [ x : _ |- _ = _ ] => destruct x; reflexivity; fail 6 | end. 7 | 8 | Ltac destruct_construct x := 9 | (destruct x; [ constructor 1 ]; auto; fail) 10 | || (destruct x; [ constructor 1 | constructor 2 ]; auto; fail) 11 | || (destruct x; [ constructor 1 | constructor 2 | constructor 3]; auto; fail). 12 | 13 | Ltac unfold_cofix := intros; match goal with 14 | [ |- _ = ?folded ] => 15 | let x := fresh "x" in 16 | let typ := type of folded in 17 | (match folded with _ _ => pattern folded | _ => pattern folded at 2 end); 18 | match goal with [ |- ?P ?x ] => 19 | refine (let rebuild : typ -> typ := _ in 20 | let path : rebuild folded = folded := _ in 21 | eq_rect _ P _ folded path) end; 22 | [ intro x ; destruct_construct x; fail 23 | | destruct folded; reflexivity 24 | | reflexivity]; fail 25 | end. 26 | 27 | Ltac destruct_with_nat_arg_pattern x := 28 | pattern x; 29 | match type of x with 30 | | ?I 0 => refine (let gen : forall m (q : I m), 31 | (match m return I m -> Type with 32 | 0 => fun p => _ p 33 | | S n => fun _ => unit end q) := _ in gen 0 x) 34 | | ?I (S ?n) => refine (let gen : forall m (q : I m), 35 | (match m return I m -> Type with 36 | 0 => fun _ => unit 37 | | S n => fun p => _ p end q) := _ in gen (S n) x) 38 | end; intros m q; destruct q. 39 | 40 | Ltac destruct_reflexivity_with_nat_arg_pattern := 41 | intros ; repeat match goal with 42 | | [ x : _ |- _ = _ ] => destruct_with_nat_arg_pattern x; reflexivity; fail 43 | end. 44 | 45 | Global Parametricity Tactic := ((destruct_reflexivity; fail) 46 | || (unfold_cofix; fail) 47 | || (destruct_reflexivity_with_nat_arg_pattern; fail) 48 | || auto). 49 | 50 | 51 | Require Import ProofIrrelevance. (* for opaque terms *) 52 | 53 | Set Allow StrictProp. (* TODO: use SProp instead of ProofIrrelevance *) 54 | 55 | Parametricity Module Logic. 56 | Parametricity Module Datatypes. 57 | Parametricity Module Specif. 58 | 59 | Parametricity Module Decimal. 60 | Parametricity Module Hexadecimal. 61 | Parametricity Module Number. 62 | Parametricity Module Nat. 63 | 64 | Parametricity Module Peano. 65 | 66 | Parametricity Module Wf. 67 | Parametricity Module Tactics. 68 | 69 | Export Logic_R Datatypes_R Specif_R Nat_R Peano_R Wf_R Tactics_R. 70 | -------------------------------------------------------------------------------- /test-suite/bug.v: -------------------------------------------------------------------------------- 1 | Require Import Parametricity. 2 | 3 | Definition n1 := 3. 4 | Definition n2 := 2. 5 | Definition n3 := 0. 6 | 7 | Inductive I1 (p := n1) (q := n2) (n : nat) (r := n) : Type := c1. 8 | Inductive I2 : let p := n2 in Type := c2. 9 | Inductive I3 : Type := c3 : let p := n3 in I3. 10 | 11 | Inductive J : I1 n2 -> I2 -> I3 -> Type := 12 | | cj : J (c1 n2) c2 c3. 13 | Inductive K : I1 n3 -> I2 -> I3 -> Type := . 14 | 15 | Definition T := I1 n2 -> I2 -> I3. 16 | Definition C := c1. 17 | 18 | Set Parametricity Debug. 19 | 20 | Parametricity Recursive nat. 21 | 22 | Parametricity Recursive I1. 23 | 24 | -------------------------------------------------------------------------------- /test-suite/bug2.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "coq-paramcoq.plugin". 2 | 3 | Definition Coq__o__Init__o__Nat__o__add_R :=0. 4 | 5 | Parametricity Recursive Nat.add. 6 | 7 | (* 8 | Error: Coq__o__Init__o__Nat__o__add_R already exists. 9 | *) 10 | 11 | -------------------------------------------------------------------------------- /test-suite/bug3.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "coq-paramcoq.plugin". 2 | 3 | Require Import PeanoNat. 4 | Require Import Recdef. 5 | Set Implicit Arguments. 6 | Require Import Lia. 7 | 8 | Fixpoint subS (n m : nat) {struct n} : nat := 9 | match n return nat with 10 | | 0 => 0 (* originally n*) 11 | | S k => match m return nat with 12 | | 0 => S k (* originally n*) 13 | | S l => subS k l 14 | end 15 | end. 16 | 17 | Definition modS := 18 | fun x y : nat => match y with 19 | | 0 => match (1 mod 0) with | 0 => 0 | _ => x end 20 | | S y' => subS y' (snd (Nat.divmod x y' 0 y')) 21 | end. 22 | 23 | Lemma subS_same : forall n m, subS n m = Nat.sub n m. 24 | Proof. 25 | induction n; destruct m; simpl; auto. 26 | Defined. 27 | 28 | Lemma modS_same : forall n m, modS n m = Nat.modulo n m. 29 | Proof. 30 | destruct m; simpl; auto. 31 | rewrite subS_same. reflexivity. 32 | Defined. 33 | 34 | Function GcdS (a b : nat) {wf lt a} : nat := 35 | match a with 36 | | O => b 37 | | S k => GcdS (modS b (S k)) (S k) 38 | end. 39 | Proof. 40 | - intros m n k Heq. rewrite modS_same. 41 | simpl. 42 | lia. 43 | - exact Wf_nat.lt_wf. 44 | Defined. 45 | 46 | Ltac destruct_reflexivity := 47 | intros ; repeat match goal with 48 | | [ x : _ |- _ = _ ] => destruct x; reflexivity; fail 49 | end. 50 | 51 | Ltac destruct_construct x := 52 | (destruct x; [ constructor 1 ]; auto; fail) 53 | || (destruct x; [ constructor 1 | constructor 2 ]; auto; fail) 54 | || (destruct x; [ constructor 1 | constructor 2 | constructor 3]; auto; fail). 55 | 56 | Ltac unfold_cofix := intros; match goal with 57 | [ |- _ = ?folded ] => 58 | let x := fresh "x" in 59 | let typ := type of folded in 60 | (match folded with _ _ => pattern folded | _ => pattern folded at 2 end); 61 | match goal with [ |- ?P ?x ] => 62 | refine (let rebuild : typ -> typ := _ in 63 | let path : rebuild folded = folded := _ in 64 | eq_rect _ P _ folded path) end; 65 | [ intro x ; destruct_construct x; fail 66 | | destruct folded; reflexivity 67 | | reflexivity]; fail 68 | end. 69 | 70 | Ltac destruct_with_nat_arg_pattern x := 71 | pattern x; 72 | match type of x with 73 | | ?I 0 => refine (let gen : forall m (q : I m), 74 | (match m return I m -> Type with 75 | 0 => fun p => _ p 76 | | S n => fun _ => unit end q) := _ in gen 0 x) 77 | | ?I (S ?n) => refine (let gen : forall m (q : I m), 78 | (match m return I m -> Type with 79 | 0 => fun _ => unit 80 | | S n => fun p => _ p end q) := _ in gen (S n) x) 81 | end; intros m q; destruct q. 82 | 83 | Ltac destruct_reflexivity_with_nat_arg_pattern := 84 | intros ; repeat match goal with 85 | | [ x : _ |- _ = _ ] => destruct_with_nat_arg_pattern x; reflexivity; fail 86 | end. 87 | 88 | Global Parametricity Tactic := ((destruct_reflexivity; fail) 89 | || (unfold_cofix; fail) 90 | || (destruct_reflexivity_with_nat_arg_pattern; fail) 91 | || auto). 92 | 93 | Require Import ProofIrrelevance. 94 | 95 | (* Parametricity Recursive GcdS qualified. *) (* FIXME *) 96 | 97 | 98 | 99 | (* 100 | DepRefs: 101 | nat 102 | le 103 | lt 104 | prod 105 | snd 106 | subS 107 | Init.Nat.divmod 108 | modS 109 | GcdS_F 110 | Recdef.iter 111 | and 112 | iff 113 | Basics.impl 114 | unit 115 | Init.Unconvertible 116 | Relation_Definitions.relation 117 | Morphisms.Proper 118 | RelationClasses.subrelation 119 | Morphisms.subrelation_proper 120 | eq 121 | eq_rect 122 | eq_ind 123 | eq_sym 124 | eq_ind_r 125 | PeanoNat.Nat.succ_wd_obligation_1 126 | Nat.succ_wd 127 | Morphisms.subrelation_refl 128 | Morphisms.respectful 129 | RelationClasses.Transitive 130 | RelationClasses.transitivity 131 | Morphisms.trans_co_impl_morphism_obligation_1 132 | Morphisms.trans_co_impl_morphism 133 | RelationClasses.Symmetric 134 | RelationClasses.Reflexive 135 | RelationClasses.Equivalence 136 | RelationClasses.Equivalence_Transitive 137 | RelationClasses.PER 138 | RelationClasses.PER_Symmetric 139 | RelationClasses.symmetry 140 | RelationClasses.PER_Transitive 141 | Morphisms.PER_morphism_obligation_1 142 | Morphisms.PER_morphism 143 | Init.Nat.pred 144 | RelationClasses.Equivalence_Symmetric 145 | RelationClasses.Equivalence_PER 146 | Nat.pred_succ 147 | Morphisms.reflexive_proper_proxy 148 | and_rect 149 | and_ind 150 | Morphisms.iff_impl_subrelation 151 | PeanoNat.Nat.pred_wd_obligation_1 152 | Nat.pred_wd 153 | RelationClasses.Equivalence_Reflexive 154 | Morphisms.subrelation_respectful 155 | RelationClasses.eq_Reflexive 156 | eq_trans 157 | RelationClasses.eq_Transitive 158 | RelationClasses.eq_Symmetric 159 | RelationClasses.eq_equivalence 160 | Nat.eq_equiv 161 | Nat.succ_inj 162 | Nat.succ_inj_wd 163 | Morphisms.ProperProxy 164 | Morphisms.Reflexive_partial_app_morphism 165 | False 166 | False_rect 167 | False_ind 168 | not 169 | iff_sym 170 | RelationClasses.iff_Symmetric 171 | iff_trans 172 | RelationClasses.iff_Transitive 173 | iff_refl 174 | RelationClasses.iff_Reflexive 175 | RelationClasses.iff_equivalence 176 | Morphisms.per_partial_app_morphism_obligation_1 177 | Morphisms.per_partial_app_morphism 178 | Morphisms.trans_sym_co_inv_impl_morphism_obligation_1 179 | Morphisms.trans_sym_co_inv_impl_morphism 180 | Basics.flip 181 | RelationClasses.reflexivity 182 | comparison 183 | Init.Nat.compare 184 | or 185 | or_ind 186 | Morphisms.trans_co_eq_inv_impl_morphism_obligation_1 187 | Morphisms.trans_co_eq_inv_impl_morphism 188 | Morphisms.eq_proper_proxy 189 | Morphisms_Prop.or_iff_morphism_obligation_1 190 | Morphisms_Prop.or_iff_morphism 191 | nat_rect 192 | nat_ind 193 | f_equal 194 | f_equal_nat 195 | eq_add_S 196 | True 197 | Nat.compare_eq_iff 198 | Peano.le_0_n 199 | le_ind 200 | Peano.le_pred 201 | Peano.le_S_n 202 | Peano.le_n_S 203 | Nat.compare_le_iff 204 | Nat.compare_lt_iff 205 | Nat.lt_eq_cases 206 | Nat.le_refl 207 | Morphisms.iff_flip_impl_subrelation 208 | Nat.lt_succ_r 209 | Nat.lt_succ_diag_r 210 | PeanoNat.Nat.lt_wd_obligation_1 211 | Nat.lt_wd 212 | Nat.compare_refl 213 | Morphisms_Prop.not_iff_morphism_obligation_1 214 | Morphisms_Prop.not_iff_morphism 215 | Nat.lt_irrefl 216 | Nat.neq_succ_diag_l 217 | Nat.lt_le_incl 218 | Nat.nlt_succ_diag_l 219 | Nat.nle_succ_diag_l 220 | Nat.bi_induction 221 | Morphisms_Prop.iff_iff_iff_impl_morphism_obligation_1 222 | Morphisms_Prop.iff_iff_iff_impl_morphism 223 | Nat.central_induction 224 | Nat.le_wd 225 | or_iff_compat_r 226 | or_cancel_r 227 | Nat.le_succ_l 228 | Nat.succ_lt_mono 229 | lt_S_n 230 | Acc 231 | Acc_inv 232 | positive 233 | BinPosDef.Pos.succ 234 | BinPosDef.Pos.of_succ_nat 235 | Z 236 | BinIntDef.Z.of_nat 237 | Decidable.decidable 238 | Decidable.dec_not_not 239 | BinPosDef.Pos.pred_double 240 | BinIntDef.Z.pred_double 241 | BinIntDef.Z.double 242 | BinIntDef.Z.succ_double 243 | BinIntDef.Z.pos_sub 244 | BinPosDef.Pos.add 245 | BinIntDef.Z.add 246 | Morphisms.reflexive_proper 247 | Z.eq 248 | Morphisms.reflexive_eq_dom_reflexive 249 | Z.add_wd 250 | Z.eq_equiv 251 | BinIntDef.Z.succ 252 | Z.succ_wd 253 | BinIntDef.Z.pred 254 | BinIntDef.Z.opp 255 | BinPosDef.Pos.compare_cont 256 | BinPosDef.Pos.compare 257 | BinPosDef.Pos.mask 258 | BinPosDef.Pos.double_pred_mask 259 | BinPosDef.Pos.double_mask 260 | BinPosDef.Pos.succ_double_mask 261 | BinPosDef.Pos.sub_mask 262 | Pos.mask2cmp 263 | BinPosDef.Pos.pred 264 | BinPosDef.Pos.pred_mask 265 | BinPosDef.Pos.sub_mask_carry 266 | positive_rect 267 | positive_ind 268 | Pos.sub_mask_carry_spec 269 | Pos.switch_Eq 270 | Pos.compare_cont_spec 271 | Pos.compare_xI_xO 272 | Pos.compare_xO_xI 273 | Pos.compare_sub_mask 274 | BinPosDef.Pos.add_carry 275 | Pos.add_carry_spec 276 | Pos.add_comm 277 | Pos.add_1_r 278 | Pos.add_succ_r 279 | Pos.add_succ_l 280 | Pos.add_1_l 281 | Pos.add_assoc 282 | Pos.succ_pred_double 283 | Pos.add_xI_pred_double 284 | Pos.SubMaskSpec 285 | Pos.sub_mask_spec 286 | Pos.sub_mask_nul_iff 287 | Pos.compare_eq_iff 288 | Pos.eq_equiv 289 | Pos.compare_refl 290 | Pos.sub_mask_diag 291 | Pos.compare_xI_xI 292 | Pos.compare_xO_xO 293 | Pos.lt 294 | Pos.compare_lt_iff 295 | CompOpp 296 | Pos.compare_cont_antisym 297 | Pos.compare_antisym 298 | CompOpp_involutive 299 | CompOpp_inj 300 | CompOpp_iff 301 | CompareSpec 302 | Pos.compare_spec 303 | Pos.add_no_neutral 304 | Pos.sub_mask_add_diag_r 305 | ex 306 | Pos.sub_mask_neg_iff 307 | Pos.lt_iff_add 308 | Pos.succ_not_1 309 | Pos.succ_inj 310 | Pos.add_carry_add 311 | not_eq_sym 312 | Pos.add_reg_r 313 | Pos.add_reg_l 314 | Pos.add_cancel_l 315 | Pos.sub_mask_add_diag_l 316 | Pos.sub_mask_add 317 | Pos.sub_mask_pos_iff 318 | Pos.sub_mask_pos' 319 | Pos.sub_mask_pos 320 | BinPosDef.Pos.sub 321 | Pos.sub_xI_xI 322 | Pos.sub_xI_xO 323 | Pos.sub_xO_xI 324 | Pos.sub_xO_xO 325 | Z.pos_sub_spec 326 | Z.pos_sub_diag 327 | Z.Private_BootStrap.add_opp_diag_r 328 | Z.pos_sub_opp 329 | Z.Private_BootStrap.opp_add_distr 330 | Pos.peano_rect 331 | Pos.peano_ind 332 | Pos.compare_succ_r 333 | Pos.compare_succ_l 334 | Pos.compare_succ_succ 335 | Pos.add_compare_mono_l 336 | Pos.add_compare_mono_r 337 | Pos.lt_trans 338 | Pos.add_lt_mono_l 339 | Pos.lt_succ_diag_r 340 | Pos.lt_add_r 341 | Pos.sub_add 342 | Pos.add_sub_assoc 343 | Pos.add_lt_mono_r 344 | Pos.sub_add_distr 345 | Pos.add_sub 346 | Pos.sub_sub_distr 347 | Pos.gt 348 | Pos.gt_lt_iff 349 | Pos.lt_gt 350 | Z.Private_BootStrap.pos_sub_add 351 | Z.Private_BootStrap.opp_inj 352 | Z.Private_BootStrap.add_comm 353 | Z.Private_BootStrap.add_0_r 354 | Z.Private_BootStrap.add_assoc_pos 355 | Z.Private_BootStrap.add_assoc 356 | Z.pred_succ 357 | Z.pred_wd 358 | Z.succ_inj 359 | Z.succ_inj_wd 360 | Z.add_succ_l 361 | Z.add_0_l 362 | Z.succ_pred 363 | Z.peano_ind 364 | Z.bi_induction 365 | Z.add_assoc 366 | fast_Zplus_assoc 367 | lt_n_S 368 | nat_rec 369 | gt 370 | lt_le_S 371 | gt_le_S 372 | all 373 | Morphisms.pointwise_relation 374 | Morphisms_Prop.all_iff_morphism_obligation_1 375 | Morphisms_Prop.all_iff_morphism 376 | RelationClasses.complement 377 | RelationClasses.Irreflexive 378 | RelationClasses.StrictOrder 379 | RelationClasses.StrictOrder_Transitive 380 | Nat.lt_asymm 381 | Nat.lt_trans 382 | Nat.lt_strorder 383 | Nat.Private_OrderTac.IsTotal.lt_strorder 384 | Nat.le_lteq 385 | Nat.Private_OrderTac.IsTotal.le_lteq 386 | Nat.lt_compat 387 | Nat.Private_OrderTac.IsTotal.lt_compat 388 | OrdersTac.ord 389 | OrdersTac.trans_ord 390 | Nat.Private_OrderTac.IsTotal.eq_equiv 391 | Nat.Private_OrderTac.Tac.interp_ord 392 | Nat.Private_OrderTac.Tac.trans 393 | Nat.Private_OrderTac.Tac.lt_trans 394 | RelationClasses.StrictOrder_Irreflexive 395 | Nat.Private_OrderTac.Tac.lt_irrefl 396 | Nat.le_gt_cases 397 | Nat.lt_trichotomy 398 | Nat.lt_total 399 | Nat.Private_OrderTac.IsTotal.lt_total 400 | Nat.Private_OrderTac.Tac.not_gt_le 401 | Nat.le_le_succ_r 402 | Nat.Private_OrderTac.Tac.le_lt_trans 403 | Nat.le_succ_r 404 | Nat.lt_exists_pred_strong 405 | Nat.lt_exists_pred 406 | Nat.rs_rs' 407 | Nat.A'A_right 408 | Nat.le_ngt 409 | Nat.rbase 410 | Nat.lt_lt_succ_r 411 | Nat.rs'_rs'' 412 | Nat.strong_right_induction 413 | Nat.right_induction 414 | Nat.Private_OrderTac.Tac.lt_eq 415 | Nat.eq_le_incl 416 | Nat.pred_0 417 | Nat.neq_succ_0 418 | Nat.le_0_l 419 | Nat.induction 420 | Nat.lt_0_succ 421 | le_n_S 422 | sumbool 423 | sumbool_rect 424 | sumbool_rec 425 | le_lt_dec 426 | le_gt_dec 427 | Zplus_assoc_reverse 428 | fast_Zplus_assoc_reverse 429 | Nat.Private_OrderTac.Tac.not_ge_lt 430 | Nat.lt_le_trans 431 | ltof 432 | lt_n_Sm_le 433 | Nat.nlt_0_r 434 | well_founded 435 | well_founded_ltof 436 | lt_wf 437 | N 438 | BinNatDef.N.sub 439 | Init.Nat.sub 440 | BinNatDef.N.of_nat 441 | Init.Nat.add 442 | BinPosDef.Pos.iter_op 443 | BinPosDef.Pos.to_nat 444 | BinNatDef.N.to_nat 445 | BinPosDef.Pos.of_nat 446 | Pos.of_nat_succ 447 | Pos.iter_op_succ 448 | Nat.add_succ_l 449 | Nat.add_0_l 450 | PeanoNat.Nat.add_wd_obligation_1 451 | Nat.add_wd 452 | Nat.add_assoc 453 | Pos2Nat.inj_succ 454 | Nat2Pos.id 455 | SuccNat2Pos.id_succ 456 | Nnat.Nat2N.id 457 | BinNatDef.N.compare 458 | Pos2Nat.is_succ 459 | Pos.le 460 | Pos.le_1_l 461 | Pos.lt_succ_r 462 | Pos.lt_1_succ 463 | Pos.succ_pred_or 464 | Nat.compare_succ 465 | Pos2Nat.inj_1 466 | Nat.compare_antisym 467 | Nat.compare_gt_iff 468 | Pos2Nat.is_pos 469 | Pos2Nat.inj_compare 470 | Nnat.N2Nat.inj_compare 471 | Nnat.Nat2N.inj_compare 472 | nat_compare_le 473 | BinIntDef.Z.of_N 474 | nat_N_Z 475 | BinIntDef.Z.sub 476 | BinIntDef.Z.compare 477 | Z.compare_sub 478 | N.le 479 | N2Z.inj_compare 480 | N.compare_antisym 481 | BinIntDef.Z.max 482 | N2Z.inj_sub_max 483 | N2Z.inj_sub 484 | Nat.sub_0_r 485 | Pos.sub_mask_neg_iff' 486 | Pos.sub_mask_neg 487 | Pos2Nat.inj_add 488 | PeanoNat.Nat.sub_wd_obligation_1 489 | Nat.sub_wd 490 | Nat.sub_succ_r 491 | Nat.sub_0_l 492 | Nat.nle_succ_0 493 | Nat.succ_le_mono 494 | Nat.sub_succ 495 | Nat.case_analysis 496 | Nat.double_induction 497 | Nat.sub_0_le 498 | Nat.sub_diag 499 | Nat.add_succ_r 500 | Nat.add_0_r 501 | Nat.add_comm 502 | Nat.lt_ind 503 | Nat.lt_succ_l 504 | Nat.lt_ind_rel 505 | Nat.sub_gt 506 | Nat.add_pred_l 507 | Nat.add_pred_r 508 | Nat.add_sub_assoc 509 | Nat.add_sub 510 | Nat.add_sub_eq_l 511 | Pos2Nat.inj_lt 512 | Nnat.N2Nat.inj_sub 513 | Pos2Nat.id 514 | Pos2Nat.inj 515 | Nnat.N2Nat.id 516 | Nnat.N2Nat.inj 517 | Nnat.Nat2N.inj_sub 518 | Nat2Z.inj_sub 519 | BinPosDef.Pos.mul 520 | BinIntDef.Z.mul 521 | Z.mul_wd 522 | Z.Private_BootStrap.mul_1_l 523 | Pos.mul_1_r 524 | Pos.mul_xI_r 525 | Pos.mul_xO_r 526 | Pos.mul_comm 527 | Pos.mul_add_distr_l 528 | Pos.mul_add_distr_r 529 | Pos.add_lt_mono 530 | Pos.gt_lt 531 | Pos.mul_compare_mono_l 532 | Pos.mul_lt_mono_l 533 | Pos.mul_sub_distr_l 534 | Pos.mul_sub_distr_r 535 | Pos.mul_compare_mono_r 536 | Z.Private_BootStrap.mul_add_distr_pos 537 | Z.Private_BootStrap.mul_0_r 538 | Z.Private_BootStrap.mul_opp_r 539 | Z.Private_BootStrap.mul_add_distr_r 540 | Z.mul_succ_l 541 | Z.add_succ_r 542 | Z.add_0_r 543 | Z.add_comm 544 | Z.add_cancel_l 545 | Z.add_cancel_r 546 | Z.mul_0_l 547 | Z.mul_succ_r 548 | Z.one_succ 549 | Z.add_1_l 550 | Zred_factor3 551 | fast_Zred_factor3 552 | Z.mul_0_r 553 | Zred_factor5 554 | fast_Zred_factor5 555 | Z.le 556 | Z.lt 557 | Z.compare_eq_iff 558 | Z.compare_le_iff 559 | Z.compare_lt_iff 560 | Z.lt_eq_cases 561 | Z.lt_wd 562 | Z.compare_refl 563 | Z.lt_irrefl 564 | Z.sub_succ_r 565 | Z.lt_succ_r 566 | Z.lt_le_incl 567 | Z.central_induction 568 | Z.le_refl 569 | Z.lt_succ_diag_r 570 | Z.neq_succ_diag_l 571 | Z.nlt_succ_diag_l 572 | Z.nle_succ_diag_l 573 | Z.le_wd 574 | Z.le_succ_l 575 | Z.lt_asymm 576 | Z.lt_trans 577 | Z.le_trans 578 | RelationClasses.PreOrder 579 | Z.le_preorder 580 | RelationClasses.PreOrder_Reflexive 581 | Nat2Z.is_nonneg 582 | Z.mul_1_r 583 | intro_Z 584 | Z.pred_inj 585 | Z.pred_inj_wd 586 | Z.opp_wd 587 | Z.add_pred_l 588 | Z.opp_succ 589 | Z.opp_0 590 | Z.opp_add_distr 591 | fast_Zopp_plus_distr 592 | Z.mul_add_distr_r 593 | Z.mul_comm 594 | Z.mul_add_distr_l 595 | Z.add_shuffle0 596 | Z.add_shuffle1 597 | Z.sub_wd 598 | Z.sub_0_r 599 | Z.add_pred_r 600 | Z.add_opp_r 601 | Z.sub_succ_l 602 | Z.sub_diag 603 | Z.add_opp_diag_l 604 | Z.add_opp_diag_r 605 | Pos2Z.opp_neg 606 | OMEGA13 607 | fast_OMEGA13 608 | Z.succ_lt_mono 609 | Z.succ_le_mono 610 | Z.add_le_mono_l 611 | Z.add_le_mono_r 612 | Z.opp_pred 613 | Z.opp_involutive 614 | Z.opp_sub_distr 615 | Z.sub_sub_distr 616 | Z.sub_simpl_r 617 | Z.le_0_sub 618 | Z.compare_antisym 619 | Z.ge 620 | Z.ge_le_iff 621 | Zge_left 622 | Nat.lt_nge 623 | gt_not_le 624 | not_le_minus_0 625 | inj_minus2 626 | Z.add_shuffle3 627 | fast_Zplus_permute 628 | subS_same 629 | Init.Nat.modulo 630 | modS_same 631 | ge 632 | ex_ind 633 | Nat.lt_decidable 634 | dec_lt 635 | Nat.nlt_ge 636 | not_lt 637 | Z.add_le_mono 638 | Z.add_nonneg_nonneg 639 | OMEGA2 640 | Z.gt 641 | inj_eq 642 | proj1 643 | Nat.compare_ge_iff 644 | nat_compare_ge 645 | Nat2Z.inj_compare 646 | Nat2Z.inj_ge 647 | inj_ge 648 | nat_compare_gt 649 | Nat2Z.inj_gt 650 | inj_gt 651 | Nat2Z.inj_le 652 | inj_le 653 | Pos2Z.inj_succ 654 | Nat2Z.inj_succ 655 | Z.opp_eq_mul_m1 656 | fast_Zopp_eq_mult_neg_1 657 | sumbool_ind 658 | GcdS_tcc 659 | max_type 660 | max_type_rect 661 | max_type_ind 662 | max 663 | and_rec 664 | Nat.le_lt_trans 665 | sig 666 | sig_rect 667 | sig_rec 668 | GcdS_terminate 669 | GcdS 670 | nat_R is defined 671 | nat_R_rect is defined 672 | nat_R_ind is defined 673 | nat_R_rec is defined 674 | le_R is defined 675 | le_R_ind is defined 676 | Coq__o__Init__o__Peano__o__lt_R is defined 677 | 'Coq__o__Init__o__Peano__o__lt_R' is now a registered translation. 678 | prod_R is defined 679 | prod_R_rect is defined 680 | prod_R_ind is defined 681 | prod_R_rec is defined 682 | Coq__o__Init__o__Datatypes__o__snd_R is defined 683 | 'Coq__o__Init__o__Datatypes__o__snd_R' is now a registered translation. 684 | Top__o__subS_R is defined 685 | 'Top__o__subS_R' is now a registered translation. 686 | Coq__o__Init__o__Nat__o__divmod_R is defined 687 | 'Coq__o__Init__o__Nat__o__divmod_R' is now a registered translation. 688 | Top__o__modS_R is defined 689 | 'Top__o__modS_R' is now a registered translation. 690 | Top__o__GcdS_F_R is defined 691 | 'Top__o__GcdS_F_R' is now a registered translation. 692 | Coq__o__funind__o__Recdef__o__iter_R is defined 693 | 'Coq__o__funind__o__Recdef__o__iter_R' is now a registered translation. 694 | and_R is defined 695 | and_R_rect is defined 696 | and_R_ind is defined 697 | and_R_rec is defined 698 | Coq__o__Init__o__Logic__o__iff_R is defined 699 | 'Coq__o__Init__o__Logic__o__iff_R' is now a registered translation. 700 | Coq__o__Program__o__Basics__o__impl_R is defined 701 | 'Coq__o__Program__o__Basics__o__impl_R' is now a registered translation. 702 | unit_R is defined 703 | unit_R_rect is defined 704 | unit_R_ind is defined 705 | unit_R_rec is defined 706 | Coq__o__Classes__o__Init__o__Unconvertible_R is defined 707 | 'Coq__o__Classes__o__Init__o__Unconvertible_R' is now a registered translation. 708 | Coq__o__Relations__o__Relation_Definitions__o__relation_R is defined 709 | 'Coq__o__Relations__o__Relation_Definitions__o__relation_R' is now a registered translation. 710 | Coq__o__Classes__o__Morphisms__o__Proper_R is defined 711 | 'Coq__o__Classes__o__Morphisms__o__Proper_R' is now a registered translation. 712 | Coq__o__Classes__o__RelationClasses__o__subrelation_R is defined 713 | 'Coq__o__Classes__o__RelationClasses__o__subrelation_R' is now a registered translation. 714 | Coq__o__Classes__o__Morphisms__o__subrelation_proper_R is defined 715 | 'Coq__o__Classes__o__Morphisms__o__subrelation_proper_R' is now a registered translation. 716 | eq_R is defined 717 | eq_R_rect is defined 718 | eq_R_ind is defined 719 | eq_R_rec is defined 720 | Coq__o__Init__o__Logic__o__eq_rect_R is defined 721 | 'Coq__o__Init__o__Logic__o__eq_rect_R' is now a registered translation. 722 | Coq__o__Init__o__Logic__o__eq_ind_R is defined 723 | 'Coq__o__Init__o__Logic__o__eq_ind_R' is now a registered translation. 724 | Coq__o__Init__o__Logic__o__eq_sym_R is defined 725 | 'Coq__o__Init__o__Logic__o__eq_sym_R' is now a registered translation. 726 | Coq__o__Init__o__Logic__o__eq_ind_r_R is defined 727 | 'Coq__o__Init__o__Logic__o__eq_ind_r_R' is now a registered translation. 728 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_obligation_1_R is defined 729 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_obligation_1_R' is now a registered translation. 730 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_R is defined 731 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_R' is now a registered translation. 732 | Coq__o__Classes__o__Morphisms__o__subrelation_refl_R is defined 733 | 'Coq__o__Classes__o__Morphisms__o__subrelation_refl_R' is now a registered translation. 734 | Coq__o__Classes__o__Morphisms__o__respectful_R is defined 735 | 'Coq__o__Classes__o__Morphisms__o__respectful_R' is now a registered translation. 736 | Coq__o__Classes__o__RelationClasses__o__Transitive_R is defined 737 | 'Coq__o__Classes__o__RelationClasses__o__Transitive_R' is now a registered translation. 738 | Coq__o__Classes__o__RelationClasses__o__transitivity_R is defined 739 | 'Coq__o__Classes__o__RelationClasses__o__transitivity_R' is now a registered translation. 740 | Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_obligation_1_R is defined 741 | 'Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_obligation_1_R' is now a registered translation. 742 | Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_R is defined 743 | 'Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_R' is now a registered translation. 744 | Coq__o__Classes__o__RelationClasses__o__Symmetric_R is defined 745 | 'Coq__o__Classes__o__RelationClasses__o__Symmetric_R' is now a registered translation. 746 | Coq__o__Classes__o__RelationClasses__o__Reflexive_R is defined 747 | 'Coq__o__Classes__o__RelationClasses__o__Reflexive_R' is now a registered translation. 748 | Equivalence_R is defined 749 | Coq__o__Classes__o__RelationClasses__o__Equivalence_Transitive_R is defined 750 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_Transitive_R' is now a registered translation. 751 | PER_R is defined 752 | Coq__o__Classes__o__RelationClasses__o__PER_Symmetric_R is defined 753 | 'Coq__o__Classes__o__RelationClasses__o__PER_Symmetric_R' is now a registered translation. 754 | Coq__o__Classes__o__RelationClasses__o__symmetry_R is defined 755 | 'Coq__o__Classes__o__RelationClasses__o__symmetry_R' is now a registered translation. 756 | Coq__o__Classes__o__RelationClasses__o__PER_Transitive_R is defined 757 | 'Coq__o__Classes__o__RelationClasses__o__PER_Transitive_R' is now a registered translation. 758 | Coq__o__Classes__o__Morphisms__o__PER_morphism_obligation_1_R is defined 759 | 'Coq__o__Classes__o__Morphisms__o__PER_morphism_obligation_1_R' is now a registered translation. 760 | Coq__o__Classes__o__Morphisms__o__PER_morphism_R is defined 761 | 'Coq__o__Classes__o__Morphisms__o__PER_morphism_R' is now a registered translation. 762 | Coq__o__Init__o__Nat__o__pred_R is defined 763 | 'Coq__o__Init__o__Nat__o__pred_R' is now a registered translation. 764 | Coq__o__Classes__o__RelationClasses__o__Equivalence_Symmetric_R is defined 765 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_Symmetric_R' is now a registered translation. 766 | Coq__o__Classes__o__RelationClasses__o__Equivalence_PER_R is defined 767 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_PER_R' is now a registered translation. 768 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_succ_R is defined 769 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_succ_R' is now a registered translation. 770 | Coq__o__Classes__o__Morphisms__o__reflexive_proper_proxy_R is defined 771 | 'Coq__o__Classes__o__Morphisms__o__reflexive_proper_proxy_R' is now a registered translation. 772 | Coq__o__Init__o__Logic__o__and_rect_R is defined 773 | 'Coq__o__Init__o__Logic__o__and_rect_R' is now a registered translation. 774 | Coq__o__Init__o__Logic__o__and_ind_R is defined 775 | 'Coq__o__Init__o__Logic__o__and_ind_R' is now a registered translation. 776 | Coq__o__Classes__o__Morphisms__o__iff_impl_subrelation_R is defined 777 | 'Coq__o__Classes__o__Morphisms__o__iff_impl_subrelation_R' is now a registered translation. 778 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_obligation_1_R is defined 779 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_obligation_1_R' is now a registered translation. 780 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_R is defined 781 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_R' is now a registered translation. 782 | Coq__o__Classes__o__RelationClasses__o__Equivalence_Reflexive_R is defined 783 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_Reflexive_R' is now a registered translation. 784 | Coq__o__Classes__o__Morphisms__o__subrelation_respectful_R is defined 785 | 'Coq__o__Classes__o__Morphisms__o__subrelation_respectful_R' is now a registered translation. 786 | Coq__o__Classes__o__RelationClasses__o__eq_Reflexive_R is defined 787 | 'Coq__o__Classes__o__RelationClasses__o__eq_Reflexive_R' is now a registered translation. 788 | Coq__o__Init__o__Logic__o__eq_trans_R is defined 789 | 'Coq__o__Init__o__Logic__o__eq_trans_R' is now a registered translation. 790 | Coq__o__Classes__o__RelationClasses__o__eq_Transitive_R is defined 791 | 'Coq__o__Classes__o__RelationClasses__o__eq_Transitive_R' is now a registered translation. 792 | Coq__o__Classes__o__RelationClasses__o__eq_Symmetric_R is defined 793 | 'Coq__o__Classes__o__RelationClasses__o__eq_Symmetric_R' is now a registered translation. 794 | Coq__o__Classes__o__RelationClasses__o__eq_equivalence_R is defined 795 | 'Coq__o__Classes__o__RelationClasses__o__eq_equivalence_R' is now a registered translation. 796 | Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_equiv_R is defined 797 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_equiv_R' is now a registered translation. 798 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_R is defined 799 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_R' is now a registered translation. 800 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_wd_R is defined 801 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_wd_R' is now a registered translation. 802 | Coq__o__Classes__o__Morphisms__o__ProperProxy_R is defined 803 | 'Coq__o__Classes__o__Morphisms__o__ProperProxy_R' is now a registered translation. 804 | Coq__o__Classes__o__Morphisms__o__Reflexive_partial_app_morphism_R is defined 805 | 'Coq__o__Classes__o__Morphisms__o__Reflexive_partial_app_morphism_R' is now a registered translation. 806 | False_R is defined 807 | False_R_rect is defined 808 | False_R_ind is defined 809 | False_R_rec is defined 810 | Coq__o__Init__o__Logic__o__False_rect_R is defined 811 | 'Coq__o__Init__o__Logic__o__False_rect_R' is now a registered translation. 812 | Coq__o__Init__o__Logic__o__False_ind_R is defined 813 | 'Coq__o__Init__o__Logic__o__False_ind_R' is now a registered translation. 814 | Coq__o__Init__o__Logic__o__not_R is defined 815 | 'Coq__o__Init__o__Logic__o__not_R' is now a registered translation. 816 | Coq__o__Init__o__Logic__o__iff_sym_R is defined 817 | 'Coq__o__Init__o__Logic__o__iff_sym_R' is now a registered translation. 818 | Coq__o__Classes__o__RelationClasses__o__iff_Symmetric_R is defined 819 | 'Coq__o__Classes__o__RelationClasses__o__iff_Symmetric_R' is now a registered translation. 820 | Coq__o__Init__o__Logic__o__iff_trans_R is defined 821 | 'Coq__o__Init__o__Logic__o__iff_trans_R' is now a registered translation. 822 | Coq__o__Classes__o__RelationClasses__o__iff_Transitive_R is defined 823 | 'Coq__o__Classes__o__RelationClasses__o__iff_Transitive_R' is now a registered translation. 824 | Coq__o__Init__o__Logic__o__iff_refl_R is defined 825 | 'Coq__o__Init__o__Logic__o__iff_refl_R' is now a registered translation. 826 | Coq__o__Classes__o__RelationClasses__o__iff_Reflexive_R is defined 827 | 'Coq__o__Classes__o__RelationClasses__o__iff_Reflexive_R' is now a registered translation. 828 | Coq__o__Classes__o__RelationClasses__o__iff_equivalence_R is defined 829 | 'Coq__o__Classes__o__RelationClasses__o__iff_equivalence_R' is now a registered translation. 830 | Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_obligation_1_R is defined 831 | 'Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_obligation_1_R' is now a registered translation. 832 | Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_R is defined 833 | 'Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_R' is now a registered translation. 834 | Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_obligation_1_R is defined 835 | 'Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_obligation_1_R' is now a registered translation. 836 | Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_R is defined 837 | 'Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_R' is now a registered translation. 838 | Coq__o__Program__o__Basics__o__flip_R is defined 839 | 'Coq__o__Program__o__Basics__o__flip_R' is now a registered translation. 840 | Coq__o__Classes__o__RelationClasses__o__reflexivity_R is defined 841 | 'Coq__o__Classes__o__RelationClasses__o__reflexivity_R' is now a registered translation. 842 | comparison_R is defined 843 | comparison_R_rect is defined 844 | comparison_R_ind is defined 845 | comparison_R_rec is defined 846 | Coq__o__Init__o__Nat__o__compare_R is defined 847 | 'Coq__o__Init__o__Nat__o__compare_R' is now a registered translation. 848 | or_R is defined 849 | or_R_ind is defined 850 | Coq__o__Init__o__Logic__o__or_ind_R is defined 851 | 'Coq__o__Init__o__Logic__o__or_ind_R' is now a registered translation. 852 | Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_obligation_1_R is defined 853 | 'Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_obligation_1_R' is now a registered translation. 854 | Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_R is defined 855 | 'Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_R' is now a registered translation. 856 | Coq__o__Classes__o__Morphisms__o__eq_proper_proxy_R is defined 857 | 'Coq__o__Classes__o__Morphisms__o__eq_proper_proxy_R' is now a registered translation. 858 | Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_obligation_1_R is defined 859 | 'Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_obligation_1_R' is now a registered translation. 860 | Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_R is defined 861 | 'Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_R' is now a registered translation. 862 | Coq__o__Init__o__Datatypes__o__nat_rect_R is defined 863 | 'Coq__o__Init__o__Datatypes__o__nat_rect_R' is now a registered translation. 864 | Coq__o__Init__o__Datatypes__o__nat_ind_R is defined 865 | 'Coq__o__Init__o__Datatypes__o__nat_ind_R' is now a registered translation. 866 | Coq__o__Init__o__Logic__o__f_equal_R is defined 867 | 'Coq__o__Init__o__Logic__o__f_equal_R' is now a registered translation. 868 | Coq__o__Init__o__Peano__o__f_equal_nat_R is defined 869 | 'Coq__o__Init__o__Peano__o__f_equal_nat_R' is now a registered translation. 870 | Coq__o__Init__o__Peano__o__eq_add_S_R is defined 871 | 'Coq__o__Init__o__Peano__o__eq_add_S_R' is now a registered translation. 872 | True_R is defined 873 | True_R_rect is defined 874 | True_R_ind is defined 875 | True_R_rec is defined 876 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_eq_iff_R is defined 877 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_eq_iff_R' is now a registered translation. 878 | Coq__o__Init__o__Peano__o__le_0_n_R is defined 879 | 'Coq__o__Init__o__Peano__o__le_0_n_R' is now a registered translation. 880 | Coq__o__Init__o__Peano__o__le_ind_R is defined 881 | 'Coq__o__Init__o__Peano__o__le_ind_R' is now a registered translation. 882 | Coq__o__Init__o__Peano__o__le_pred_R is defined 883 | 'Coq__o__Init__o__Peano__o__le_pred_R' is now a registered translation. 884 | Coq__o__Init__o__Peano__o__le_S_n_R is defined 885 | 'Coq__o__Init__o__Peano__o__le_S_n_R' is now a registered translation. 886 | Coq__o__Init__o__Peano__o__le_n_S_R is defined 887 | 'Coq__o__Init__o__Peano__o__le_n_S_R' is now a registered translation. 888 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_le_iff_R is defined 889 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_le_iff_R' is now a registered translation. 890 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_lt_iff_R is defined 891 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_lt_iff_R' is now a registered translation. 892 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_eq_cases_R is defined 893 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_eq_cases_R' is now a registered translation. 894 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_refl_R is defined 895 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_refl_R' is now a registered translation. 896 | Coq__o__Classes__o__Morphisms__o__iff_flip_impl_subrelation_R is defined 897 | 'Coq__o__Classes__o__Morphisms__o__iff_flip_impl_subrelation_R' is now a registered translation. 898 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_r_R is defined 899 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_r_R' is now a registered translation. 900 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_diag_r_R is defined 901 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_diag_r_R' is now a registered translation. 902 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_obligation_1_R is defined 903 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_obligation_1_R' is now a registered translation. 904 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_R is defined 905 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_R' is now a registered translation. 906 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_refl_R is defined 907 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_refl_R' is now a registered translation. 908 | Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_obligation_1_R is defined 909 | 'Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_obligation_1_R' is now a registered translation. 910 | Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_R is defined 911 | 'Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_R' is now a registered translation. 912 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_irrefl_R is defined 913 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_irrefl_R' is now a registered translation. 914 | Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_diag_l_R is defined 915 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_diag_l_R' is now a registered translation. 916 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_incl_R is defined 917 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_incl_R' is now a registered translation. 918 | Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_succ_diag_l_R is defined 919 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_succ_diag_l_R' is now a registered translation. 920 | Coq__o__Arith__o__PeanoNat__o__Nat__o__nle_succ_diag_l_R is defined 921 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__nle_succ_diag_l_R' is now a registered translation. 922 | Coq__o__Arith__o__PeanoNat__o__Nat__o__bi_induction_R is defined 923 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__bi_induction_R' is now a registered translation. 924 | Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_obligation_1_R is defined 925 | 'Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_obligation_1_R' is now a registered translation. 926 | Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_R is defined 927 | 'Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_R' is now a registered translation. 928 | Coq__o__Arith__o__PeanoNat__o__Nat__o__central_induction_R is defined 929 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__central_induction_R' is now a registered translation. 930 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_wd_R is defined 931 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_wd_R' is now a registered translation. 932 | Coq__o__Init__o__Logic__o__or_iff_compat_r_R is defined 933 | 'Coq__o__Init__o__Logic__o__or_iff_compat_r_R' is now a registered translation. 934 | Coq__o__Init__o__Logic__o__or_cancel_r_R is defined 935 | 'Coq__o__Init__o__Logic__o__or_cancel_r_R' is now a registered translation. 936 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_l_R is defined 937 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_l_R' is now a registered translation. 938 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_lt_mono_R is defined 939 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_lt_mono_R' is now a registered translation. 940 | Coq__o__Arith__o__Lt__o__lt_S_n_R is defined 941 | 'Coq__o__Arith__o__Lt__o__lt_S_n_R' is now a registered translation. 942 | Acc_R is defined 943 | Acc_R_rect is defined 944 | Acc_R_ind is defined 945 | Acc_R_rec is defined 946 | Coq__o__Init__o__Wf__o__Acc_inv_R is defined 947 | 'Coq__o__Init__o__Wf__o__Acc_inv_R' is now a registered translation. 948 | positive_R is defined 949 | positive_R_rect is defined 950 | positive_R_ind is defined 951 | positive_R_rec is defined 952 | Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_R is defined 953 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_R' is now a registered translation. 954 | Coq__o__PArith__o__BinPosDef__o__Pos__o__of_succ_nat_R is defined 955 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__of_succ_nat_R' is now a registered translation. 956 | Z_R is defined 957 | Z_R_rect is defined 958 | Z_R_ind is defined 959 | Z_R_rec is defined 960 | Coq__o__ZArith__o__BinIntDef__o__Z__o__of_nat_R is defined 961 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__of_nat_R' is now a registered translation. 962 | Coq__o__Logic__o__Decidable__o__decidable_R is defined 963 | 'Coq__o__Logic__o__Decidable__o__decidable_R' is now a registered translation. 964 | Coq__o__Logic__o__Decidable__o__dec_not_not_R is defined 965 | 'Coq__o__Logic__o__Decidable__o__dec_not_not_R' is now a registered translation. 966 | Coq__o__PArith__o__BinPosDef__o__Pos__o__pred_double_R is defined 967 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__pred_double_R' is now a registered translation. 968 | Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_double_R is defined 969 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_double_R' is now a registered translation. 970 | Coq__o__ZArith__o__BinIntDef__o__Z__o__double_R is defined 971 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__double_R' is now a registered translation. 972 | Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_double_R is defined 973 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_double_R' is now a registered translation. 974 | Coq__o__ZArith__o__BinIntDef__o__Z__o__pos_sub_R is defined 975 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__pos_sub_R' is now a registered translation. 976 | Coq__o__PArith__o__BinPosDef__o__Pos__o__add_R is defined 977 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__add_R' is now a registered translation. 978 | Coq__o__ZArith__o__BinIntDef__o__Z__o__add_R is defined 979 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__add_R' is now a registered translation. 980 | Coq__o__Classes__o__Morphisms__o__reflexive_proper_R is defined 981 | 'Coq__o__Classes__o__Morphisms__o__reflexive_proper_R' is now a registered translation. 982 | Coq__o__ZArith__o__BinInt__o__Z__o__eq_R is defined 983 | 'Coq__o__ZArith__o__BinInt__o__Z__o__eq_R' is now a registered translation. 984 | Coq__o__Classes__o__Morphisms__o__reflexive_eq_dom_reflexive_R is defined 985 | 'Coq__o__Classes__o__Morphisms__o__reflexive_eq_dom_reflexive_R' is now a registered translation. 986 | Coq__o__ZArith__o__BinInt__o__Z__o__add_wd_R is defined 987 | 'Coq__o__ZArith__o__BinInt__o__Z__o__add_wd_R' is now a registered translation. 988 | Coq__o__ZArith__o__BinInt__o__Z__o__eq_equiv_R is defined 989 | 'Coq__o__ZArith__o__BinInt__o__Z__o__eq_equiv_R' is now a registered translation. 990 | Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_R is defined 991 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__succ_R' is now a registered translation. 992 | Coq__o__ZArith__o__BinInt__o__Z__o__succ_wd_R is defined 993 | 'Coq__o__ZArith__o__BinInt__o__Z__o__succ_wd_R' is now a registered translation. 994 | Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_R is defined 995 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__pred_R' is now a registered translation. 996 | Coq__o__ZArith__o__BinIntDef__o__Z__o__opp_R is defined 997 | 'Coq__o__ZArith__o__BinIntDef__o__Z__o__opp_R' is now a registered translation. 998 | Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_cont_R is defined 999 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_cont_R' is now a registered translation. 1000 | Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_R is defined 1001 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__compare_R' is now a registered translation. 1002 | mask_R is defined 1003 | mask_R_rect is defined 1004 | mask_R_ind is defined 1005 | mask_R_rec is defined 1006 | Coq__o__PArith__o__BinPosDef__o__Pos__o__double_pred_mask_R is defined 1007 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__double_pred_mask_R' is now a registered translation. 1008 | Coq__o__PArith__o__BinPosDef__o__Pos__o__double_mask_R is defined 1009 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__double_mask_R' is now a registered translation. 1010 | Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_double_mask_R is defined 1011 | 'Coq__o__PArith__o__BinPosDef__o__Pos__o__succ_double_mask_R' is now a registered translation. 1012 | 1013 | Anomaly: Uncaught exception Not_found. Please report at 1014 | http://coq.inria.fr/bugs/. 1015 | *) 1016 | -------------------------------------------------------------------------------- /test-suite/bug4.v: -------------------------------------------------------------------------------- 1 | 2 | Declare ML Module "coq-paramcoq.plugin". 3 | 4 | Require Import PeanoNat. 5 | Require Import PArith. 6 | 7 | Print BinPosDef.Pos.sub_mask. 8 | 9 | Fixpoint sub_mask (xx yy : positive) {struct yy} : BinPosDef.Pos.mask := 10 | match xx with 11 | | (p~1)%positive => 12 | match yy with 13 | | (q~1)%positive => BinPosDef.Pos.double_mask (sub_mask p q) 14 | | (q~0)%positive => BinPosDef.Pos.succ_double_mask (sub_mask p q) 15 | | 1%positive => BinPosDef.Pos.IsPos p~0 16 | end 17 | | (p~0)%positive => 18 | match yy with 19 | | (q~1)%positive => BinPosDef.Pos.succ_double_mask (sub_mask_carry p q) 20 | | (q~0)%positive => BinPosDef.Pos.double_mask (sub_mask p q) 21 | | 1%positive => BinPosDef.Pos.IsPos (BinPosDef.Pos.pred_double p) 22 | end 23 | | 1%positive => 24 | match yy with 25 | | (_~1)%positive => BinPosDef.Pos.IsNeg 26 | | (_~0)%positive => BinPosDef.Pos.IsNeg 27 | | 1%positive => BinPosDef.Pos.IsNul 28 | end 29 | end 30 | 31 | with sub_mask_carry (xx yy : positive) {struct yy} : BinPosDef.Pos.mask := 32 | match xx with 33 | | (p~1)%positive => 34 | match yy with 35 | | (q~1)%positive => BinPosDef.Pos.succ_double_mask (sub_mask_carry p q) 36 | | (q~0)%positive => BinPosDef.Pos.double_mask (sub_mask p q) 37 | | 1%positive => BinPosDef.Pos.IsPos (BinPosDef.Pos.pred_double p) 38 | end 39 | | (p~0)%positive => 40 | match yy with 41 | | (q~1)%positive => BinPosDef.Pos.double_mask (sub_mask_carry p q) 42 | | (q~0)%positive => BinPosDef.Pos.succ_double_mask (sub_mask_carry p q) 43 | | 1%positive => BinPosDef.Pos.double_pred_mask p 44 | end 45 | | 1%positive => BinPosDef.Pos.IsNeg 46 | end. 47 | 48 | (* 49 | Set Parametricity Debug. 50 | *) 51 | 52 | Ltac destruct_reflexivity := 53 | intros ; repeat match goal with 54 | | [ x : _ |- _ = _ ] => destruct x; reflexivity; fail 55 | end. 56 | 57 | Ltac destruct_construct x := 58 | (destruct x; [ constructor 1 ]; auto; fail) 59 | || (destruct x; [ constructor 1 | constructor 2 ]; auto; fail) 60 | || (destruct x; [ constructor 1 | constructor 2 | constructor 3]; auto; fail). 61 | 62 | Ltac unfold_cofix := intros; match goal with 63 | [ |- _ = ?folded ] => 64 | let x := fresh "x" in 65 | let typ := type of folded in 66 | (match folded with _ _ => pattern folded | _ => pattern folded at 2 end); 67 | match goal with [ |- ?P ?x ] => 68 | refine (let rebuild : typ -> typ := _ in 69 | let path : rebuild folded = folded := _ in 70 | eq_rect _ P _ folded path) end; 71 | [ intro x ; destruct_construct x; fail 72 | | destruct folded; reflexivity 73 | | reflexivity]; fail 74 | end. 75 | 76 | Ltac destruct_with_nat_arg_pattern x := 77 | pattern x; 78 | match type of x with 79 | | ?I 0 => refine (let gen : forall m (q : I m), 80 | (match m return I m -> Type with 81 | 0 => fun p => _ p 82 | | S n => fun _ => unit end q) := _ in gen 0 x) 83 | | ?I (S ?n) => refine (let gen : forall m (q : I m), 84 | (match m return I m -> Type with 85 | 0 => fun _ => unit 86 | | S n => fun p => _ p end q) := _ in gen (S n) x) 87 | end; intros m q; destruct q. 88 | 89 | Ltac destruct_reflexivity_with_nat_arg_pattern := 90 | intros ; repeat match goal with 91 | | [ x : _ |- _ = _ ] => destruct_with_nat_arg_pattern x; reflexivity; fail 92 | end. 93 | 94 | Global Parametricity Tactic := ((destruct_reflexivity; fail) 95 | || (unfold_cofix; fail) 96 | || (destruct_reflexivity_with_nat_arg_pattern; fail) 97 | || auto). 98 | 99 | Parametricity Recursive sub_mask. 100 | -------------------------------------------------------------------------------- /test-suite/bug5.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "coq-paramcoq.plugin". 2 | 3 | Require Import PeanoNat. 4 | Require Import Recdef. 5 | Set Implicit Arguments. 6 | 7 | 8 | 9 | 10 | Fixpoint subS (n m : nat) {struct n} : nat := 11 | match n return nat with 12 | | 0 => 0(* originally n*) 13 | | S k => match m return nat with 14 | | 0 => S k (* originally n*) 15 | | S l => subS k l 16 | end 17 | end. 18 | 19 | 20 | 21 | Definition modS := 22 | fun x y : nat => match y with 23 | | 0 => y 24 | | S y' => subS y' (snd (Nat.divmod x y' 0 y')) 25 | end. 26 | 27 | (* 28 | Lemma subS_same : forall n m, subS n m = Nat.sub n m. 29 | Proof. 30 | induction n; destruct m; simpl; auto. 31 | Qed. 32 | 33 | Lemma modS_same : forall n m, modS n m = Nat.modulo n m. 34 | Proof. 35 | destruct m; simpl; auto. 36 | rewrite subS_same. reflexivity. 37 | Qed. 38 | *) 39 | Lemma NNmod_upper_boundA 40 | : forall a b : nat, b <> 0 -> modS a b < b. 41 | Admitted. 42 | 43 | Definition T := forall a b : nat, b <> 0 -> modS a b < b. 44 | Parametricity Recursive T. 45 | Print T_R. 46 | 47 | Axiom NNmod_upper_boundA_R : (fun H H0 : forall a b : nat, b <> 0 -> modS a b < b => 48 | forall (a₁ a₂ : nat) (a_R : nat_R a₁ a₂) (b₁ b₂ : nat) (b_R : nat_R b₁ b₂) 49 | (H1 : b₁ <> 0) (H2 : b₂ <> 0), 50 | not_R (eq_R nat_R b_R nat_R_O_R) H1 H2 -> 51 | lt_R (modS_R a_R b_R) b_R (H a₁ b₁ H1) 52 | (H0 a₂ b₂ H2)) NNmod_upper_boundA NNmod_upper_boundA. 53 | 54 | Realizer NNmod_upper_boundA as NNmod_upper_boundA_RR := NNmod_upper_boundA_R. 55 | 56 | 57 | Lemma NNmod_upper_bound 58 | : forall a b : nat, b <> 0 -> modS a b < b. 59 | Proof. 60 | 61 | intros. apply NNmod_upper_boundA. assumption. 62 | Qed. 63 | 64 | 65 | 66 | 67 | Function GcdS (a b : nat) {wf lt a} : nat := 68 | match a with 69 | | O => b 70 | | S k => GcdS (modS b (S k)) (S k) 71 | end. 72 | Proof. 73 | - intros m n k Heq. apply NNmod_upper_bound. 74 | intros Hc. inversion Hc. 75 | - apply Wf_nat.lt_wf. 76 | Defined. 77 | 78 | 79 | Require Import ProofIrrelevance. 80 | Parametricity Recursive sig_rec. 81 | 82 | Ltac destruct_reflexivity := 83 | intros ; repeat match goal with 84 | | [ x : _ |- _ = _ ] => destruct x; reflexivity; fail 85 | end. 86 | 87 | Ltac destruct_construct x := 88 | (destruct x; [ constructor 1 ]; auto; fail) 89 | || (destruct x; [ constructor 1 | constructor 2 ]; auto; fail) 90 | || (destruct x; [ constructor 1 | constructor 2 | constructor 3]; auto; fail). 91 | 92 | Ltac unfold_cofix := intros; match goal with 93 | [ |- _ = ?folded ] => 94 | let x := fresh "x" in 95 | let typ := type of folded in 96 | (match folded with _ _ => pattern folded | _ => pattern folded at 2 end); 97 | match goal with [ |- ?P ?x ] => 98 | refine (let rebuild : typ -> typ := _ in 99 | let path : rebuild folded = folded := _ in 100 | eq_rect _ P _ folded path) end; 101 | [ intro x ; destruct_construct x; fail 102 | | destruct folded; reflexivity 103 | | reflexivity]; fail 104 | end. 105 | 106 | Ltac destruct_with_nat_arg_pattern x := 107 | pattern x; 108 | match type of x with 109 | | ?I 0 => refine (let gen : forall m (q : I m), 110 | (match m return I m -> Type with 111 | 0 => fun p => _ p 112 | | S n => fun _ => unit end q) := _ in gen 0 x) 113 | | ?I (S ?n) => refine (let gen : forall m (q : I m), 114 | (match m return I m -> Type with 115 | 0 => fun _ => unit 116 | | S n => fun p => _ p end q) := _ in gen (S n) x) 117 | end; intros m q; destruct q. 118 | 119 | Ltac destruct_reflexivity_with_nat_arg_pattern := 120 | intros ; repeat match goal with 121 | | [ x : _ |- _ = _ ] => destruct_with_nat_arg_pattern x; reflexivity; fail 122 | end. 123 | 124 | Global Parametricity Tactic := ((destruct_reflexivity; fail) 125 | || (unfold_cofix; fail) 126 | || (destruct_reflexivity_with_nat_arg_pattern; fail) 127 | || auto). 128 | 129 | Parametricity Recursive GcdS qualified. 130 | 131 | (* 132 | 1 subgoal 133 | ______________________________________(1/1) 134 | forall (a₁ a₂ : nat) (a_R : nat_R a₁ a₂) (b₁ b₂ : nat) (b_R : nat_R b₁ b₂), 135 | sig_R nat_R 136 | (fun (v₁ v₂ : nat) (v_R : nat_R v₁ v₂) => 137 | ex_R nat_R 138 | (fun (p₁ p₂ : nat) (p_R : nat_R p₁ p₂) 139 | (H : forall k : nat, 140 | p₁ < k -> 141 | forall def : nat -> nat -> nat, 142 | iter (nat -> nat -> nat) k GcdS_F def a₁ b₁ = v₁) 143 | (H0 : forall k : nat, 144 | p₂ < k -> 145 | forall def : nat -> nat -> nat, 146 | iter (nat -> nat -> nat) k GcdS_F def a₂ b₂ = v₂) => 147 | forall (k₁ k₂ : nat) (k_R : nat_R k₁ k₂) (H1 : p₁ < k₁) (H2 : p₂ < k₂), 148 | Coq__o__Init__o__Peano__o__lt_R p_R k_R H1 H2 -> 149 | forall (def₁ def₂ : nat -> nat -> nat) 150 | (def_R : forall a₁0 a₂0 : nat, 151 | nat_R a₁0 a₂0 -> 152 | forall b₁0 b₂0 : nat, 153 | nat_R b₁0 b₂0 -> nat_R (def₁ a₁0 b₁0) (def₂ a₂0 b₂0)), 154 | eq_R nat_R 155 | (Coq__o__funind__o__Recdef__o__iter_R 156 | (fun H3 H4 : nat -> nat -> nat => 157 | forall a₁0 a₂0 : nat, 158 | nat_R a₁0 a₂0 -> 159 | forall b₁0 b₂0 : nat, 160 | nat_R b₁0 b₂0 -> nat_R (H3 a₁0 b₁0) (H4 a₂0 b₂0)) k_R GcdS_F 161 | GcdS_F Top__o__GcdS_F_R def₁ def₂ def_R a₁ a₂ a_R b₁ b₂ b_R) v_R 162 | (H k₁ H1 def₁) (H0 k₂ H2 def₂))) (GcdS_terminate a₁ b₁) 163 | (GcdS_terminate a₂ b₂) 164 | *) 165 | 166 | (* 167 | DepRefs: 168 | GcdS_F 169 | iter 170 | and 171 | iff 172 | Basics.impl 173 | unit 174 | Init.Unconvertible 175 | Relation_Definitions.relation 176 | Morphisms.Proper 177 | RelationClasses.subrelation 178 | Morphisms.subrelation_proper 179 | eq_rect 180 | eq_ind 181 | eq_sym 182 | eq_ind_r 183 | PeanoNat.Nat.succ_wd_obligation_1 184 | PeanoNat.Nat.succ_wd 185 | Morphisms.subrelation_refl 186 | Morphisms.respectful 187 | RelationClasses.Transitive 188 | RelationClasses.transitivity 189 | Morphisms.trans_co_impl_morphism_obligation_1 190 | Morphisms.trans_co_impl_morphism 191 | RelationClasses.Symmetric 192 | RelationClasses.Reflexive 193 | RelationClasses.Equivalence 194 | RelationClasses.Equivalence_Transitive 195 | RelationClasses.PER 196 | RelationClasses.PER_Symmetric 197 | RelationClasses.symmetry 198 | RelationClasses.PER_Transitive 199 | Morphisms.PER_morphism_obligation_1 200 | Morphisms.PER_morphism 201 | Init.Nat.pred 202 | RelationClasses.Equivalence_Symmetric 203 | RelationClasses.Equivalence_PER 204 | PeanoNat.Nat.pred_succ 205 | Morphisms.reflexive_proper_proxy 206 | and_rect 207 | and_ind 208 | Morphisms.iff_impl_subrelation 209 | PeanoNat.Nat.pred_wd_obligation_1 210 | PeanoNat.Nat.pred_wd 211 | RelationClasses.Equivalence_Reflexive 212 | Morphisms.subrelation_respectful 213 | RelationClasses.eq_Reflexive 214 | eq_trans 215 | RelationClasses.eq_Transitive 216 | RelationClasses.eq_Symmetric 217 | RelationClasses.eq_equivalence 218 | PeanoNat.Nat.eq_equiv 219 | PeanoNat.Nat.succ_inj 220 | PeanoNat.Nat.succ_inj_wd 221 | Morphisms.ProperProxy 222 | Morphisms.Reflexive_partial_app_morphism 223 | False_rect 224 | False_ind 225 | iff_sym 226 | RelationClasses.iff_Symmetric 227 | iff_trans 228 | RelationClasses.iff_Transitive 229 | iff_refl 230 | RelationClasses.iff_Reflexive 231 | RelationClasses.iff_equivalence 232 | Morphisms.per_partial_app_morphism_obligation_1 233 | Morphisms.per_partial_app_morphism 234 | Morphisms.trans_sym_co_inv_impl_morphism_obligation_1 235 | Morphisms.trans_sym_co_inv_impl_morphism 236 | Basics.flip 237 | RelationClasses.reflexivity 238 | comparison 239 | Init.Nat.compare 240 | or 241 | or_ind 242 | Morphisms.trans_co_eq_inv_impl_morphism_obligation_1 243 | Morphisms.trans_co_eq_inv_impl_morphism 244 | Morphisms.eq_proper_proxy 245 | Morphisms_Prop.or_iff_morphism_obligation_1 246 | Morphisms_Prop.or_iff_morphism 247 | nat_rect 248 | nat_ind 249 | f_equal 250 | f_equal_nat 251 | eq_add_S 252 | True 253 | PeanoNat.Nat.compare_eq_iff 254 | le_0_n 255 | le_ind 256 | le_pred 257 | le_S_n 258 | le_n_S 259 | PeanoNat.Nat.compare_le_iff 260 | PeanoNat.Nat.compare_lt_iff 261 | PeanoNat.Nat.lt_eq_cases 262 | PeanoNat.Nat.le_refl 263 | Morphisms.iff_flip_impl_subrelation 264 | PeanoNat.Nat.lt_succ_r 265 | PeanoNat.Nat.lt_succ_diag_r 266 | PeanoNat.Nat.lt_wd_obligation_1 267 | PeanoNat.Nat.lt_wd 268 | PeanoNat.Nat.compare_refl 269 | Morphisms_Prop.not_iff_morphism_obligation_1 270 | Morphisms_Prop.not_iff_morphism 271 | PeanoNat.Nat.lt_irrefl 272 | PeanoNat.Nat.neq_succ_diag_l 273 | PeanoNat.Nat.lt_le_incl 274 | PeanoNat.Nat.nlt_succ_diag_l 275 | PeanoNat.Nat.nle_succ_diag_l 276 | PeanoNat.Nat.bi_induction 277 | Morphisms_Prop.iff_iff_iff_impl_morphism_obligation_1 278 | Morphisms_Prop.iff_iff_iff_impl_morphism 279 | PeanoNat.Nat.central_induction 280 | PeanoNat.Nat.le_wd 281 | or_iff_compat_r 282 | or_cancel_r 283 | PeanoNat.Nat.le_succ_l 284 | PeanoNat.Nat.succ_lt_mono 285 | Lt.lt_S_n 286 | Acc 287 | Acc_inv 288 | RelationClasses.complement 289 | RelationClasses.Irreflexive 290 | RelationClasses.StrictOrder 291 | RelationClasses.StrictOrder_Transitive 292 | PeanoNat.Nat.lt_asymm 293 | PeanoNat.Nat.lt_trans 294 | PeanoNat.Nat.lt_strorder 295 | PeanoNat.Nat.Private_OrderTac.IsTotal.lt_strorder 296 | PeanoNat.Nat.le_lteq 297 | PeanoNat.Nat.Private_OrderTac.IsTotal.le_lteq 298 | PeanoNat.Nat.lt_compat 299 | PeanoNat.Nat.Private_OrderTac.IsTotal.lt_compat 300 | OrdersTac.ord 301 | OrdersTac.trans_ord 302 | PeanoNat.Nat.Private_OrderTac.IsTotal.eq_equiv 303 | PeanoNat.Nat.Private_OrderTac.Tac.interp_ord 304 | PeanoNat.Nat.Private_OrderTac.Tac.trans 305 | PeanoNat.Nat.Private_OrderTac.Tac.le_lt_trans 306 | RelationClasses.StrictOrder_Irreflexive 307 | PeanoNat.Nat.Private_OrderTac.Tac.lt_irrefl 308 | PeanoNat.Nat.le_gt_cases 309 | PeanoNat.Nat.lt_trichotomy 310 | PeanoNat.Nat.lt_total 311 | PeanoNat.Nat.Private_OrderTac.IsTotal.lt_total 312 | PeanoNat.Nat.Private_OrderTac.Tac.not_ge_lt 313 | PeanoNat.Nat.lt_le_trans 314 | Wf_nat.ltof 315 | Lt.lt_n_Sm_le 316 | PeanoNat.Nat.Private_OrderTac.Tac.lt_eq 317 | PeanoNat.Nat.Private_OrderTac.Tac.not_gt_le 318 | PeanoNat.Nat.eq_le_incl 319 | PeanoNat.Nat.Private_OrderTac.Tac.lt_trans 320 | PeanoNat.Nat.le_le_succ_r 321 | PeanoNat.Nat.le_succ_r 322 | PeanoNat.Nat.pred_0 323 | PeanoNat.Nat.neq_succ_0 324 | PeanoNat.Nat.le_0_l 325 | PeanoNat.Nat.le_ngt 326 | PeanoNat.Nat.nlt_0_r 327 | well_founded 328 | Wf_nat.well_founded_ltof 329 | Wf_nat.lt_wf 330 | NNmod_upper_bound 331 | GcdS_tcc 332 | max_type 333 | max_type_rect 334 | max_type_ind 335 | ex 336 | ex_ind 337 | Lt.lt_n_S 338 | nat_rec 339 | gt 340 | Lt.lt_le_S 341 | Gt.gt_le_S 342 | all 343 | Morphisms.pointwise_relation 344 | Morphisms_Prop.all_iff_morphism_obligation_1 345 | Morphisms_Prop.all_iff_morphism 346 | PeanoNat.Nat.lt_exists_pred_strong 347 | PeanoNat.Nat.lt_exists_pred 348 | PeanoNat.Nat.rs_rs' 349 | PeanoNat.Nat.A'A_right 350 | PeanoNat.Nat.rbase 351 | PeanoNat.Nat.lt_lt_succ_r 352 | PeanoNat.Nat.rs'_rs'' 353 | PeanoNat.Nat.strong_right_induction 354 | PeanoNat.Nat.right_induction 355 | PeanoNat.Nat.induction 356 | PeanoNat.Nat.lt_0_succ 357 | Le.le_n_S 358 | sumbool 359 | sumbool_rect 360 | sumbool_rec 361 | Compare_dec.le_lt_dec 362 | Compare_dec.le_gt_dec 363 | max 364 | and_rec 365 | PeanoNat.Nat.le_lt_trans 366 | GcdS_terminate 367 | GcdS 368 | Top__o__GcdS_F_R is defined 369 | 'Top__o__GcdS_F_R' is now a registered translation. 370 | Coq__o__funind__o__Recdef__o__iter_R is defined 371 | 'Coq__o__funind__o__Recdef__o__iter_R' is now a registered translation. 372 | and_R is defined 373 | and_R_rect is defined 374 | and_R_ind is defined 375 | and_R_rec is defined 376 | Coq__o__Init__o__Logic__o__iff_R is defined 377 | 'Coq__o__Init__o__Logic__o__iff_R' is now a registered translation. 378 | Coq__o__Program__o__Basics__o__impl_R is defined 379 | 'Coq__o__Program__o__Basics__o__impl_R' is now a registered translation. 380 | unit_R is defined 381 | unit_R_rect is defined 382 | unit_R_ind is defined 383 | unit_R_rec is defined 384 | Coq__o__Classes__o__Init__o__Unconvertible_R is defined 385 | 'Coq__o__Classes__o__Init__o__Unconvertible_R' is now a registered translation. 386 | Coq__o__Relations__o__Relation_Definitions__o__relation_R is defined 387 | 'Coq__o__Relations__o__Relation_Definitions__o__relation_R' is now a registered translation. 388 | Coq__o__Classes__o__Morphisms__o__Proper_R is defined 389 | 'Coq__o__Classes__o__Morphisms__o__Proper_R' is now a registered translation. 390 | Coq__o__Classes__o__RelationClasses__o__subrelation_R is defined 391 | 'Coq__o__Classes__o__RelationClasses__o__subrelation_R' is now a registered translation. 392 | Coq__o__Classes__o__Morphisms__o__subrelation_proper_R is defined 393 | 'Coq__o__Classes__o__Morphisms__o__subrelation_proper_R' is now a registered translation. 394 | Coq__o__Init__o__Logic__o__eq_rect_R is defined 395 | 'Coq__o__Init__o__Logic__o__eq_rect_R' is now a registered translation. 396 | Coq__o__Init__o__Logic__o__eq_ind_R is defined 397 | 'Coq__o__Init__o__Logic__o__eq_ind_R' is now a registered translation. 398 | Coq__o__Init__o__Logic__o__eq_sym_R is defined 399 | 'Coq__o__Init__o__Logic__o__eq_sym_R' is now a registered translation. 400 | Coq__o__Init__o__Logic__o__eq_ind_r_R is defined 401 | 'Coq__o__Init__o__Logic__o__eq_ind_r_R' is now a registered translation. 402 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_obligation_1_R is defined 403 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_obligation_1_R' is now a registered translation. 404 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_R is defined 405 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_wd_R' is now a registered translation. 406 | Coq__o__Classes__o__Morphisms__o__subrelation_refl_R is defined 407 | 'Coq__o__Classes__o__Morphisms__o__subrelation_refl_R' is now a registered translation. 408 | Coq__o__Classes__o__Morphisms__o__respectful_R is defined 409 | 'Coq__o__Classes__o__Morphisms__o__respectful_R' is now a registered translation. 410 | Coq__o__Classes__o__RelationClasses__o__Transitive_R is defined 411 | 'Coq__o__Classes__o__RelationClasses__o__Transitive_R' is now a registered translation. 412 | Coq__o__Classes__o__RelationClasses__o__transitivity_R is defined 413 | 'Coq__o__Classes__o__RelationClasses__o__transitivity_R' is now a registered translation. 414 | Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_obligation_1_R is defined 415 | 'Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_obligation_1_R' is now a registered translation. 416 | Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_R is defined 417 | 'Coq__o__Classes__o__Morphisms__o__trans_co_impl_morphism_R' is now a registered translation. 418 | Coq__o__Classes__o__RelationClasses__o__Symmetric_R is defined 419 | 'Coq__o__Classes__o__RelationClasses__o__Symmetric_R' is now a registered translation. 420 | Coq__o__Classes__o__RelationClasses__o__Reflexive_R is defined 421 | 'Coq__o__Classes__o__RelationClasses__o__Reflexive_R' is now a registered translation. 422 | Equivalence_R is defined 423 | Coq__o__Classes__o__RelationClasses__o__Equivalence_Transitive_R is defined 424 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_Transitive_R' is now a registered translation. 425 | PER_R is defined 426 | Coq__o__Classes__o__RelationClasses__o__PER_Symmetric_R is defined 427 | 'Coq__o__Classes__o__RelationClasses__o__PER_Symmetric_R' is now a registered translation. 428 | Coq__o__Classes__o__RelationClasses__o__symmetry_R is defined 429 | 'Coq__o__Classes__o__RelationClasses__o__symmetry_R' is now a registered translation. 430 | Coq__o__Classes__o__RelationClasses__o__PER_Transitive_R is defined 431 | 'Coq__o__Classes__o__RelationClasses__o__PER_Transitive_R' is now a registered translation. 432 | Coq__o__Classes__o__Morphisms__o__PER_morphism_obligation_1_R is defined 433 | 'Coq__o__Classes__o__Morphisms__o__PER_morphism_obligation_1_R' is now a registered translation. 434 | Coq__o__Classes__o__Morphisms__o__PER_morphism_R is defined 435 | 'Coq__o__Classes__o__Morphisms__o__PER_morphism_R' is now a registered translation. 436 | Coq__o__Init__o__Nat__o__pred_R is defined 437 | 'Coq__o__Init__o__Nat__o__pred_R' is now a registered translation. 438 | Coq__o__Classes__o__RelationClasses__o__Equivalence_Symmetric_R is defined 439 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_Symmetric_R' is now a registered translation. 440 | Coq__o__Classes__o__RelationClasses__o__Equivalence_PER_R is defined 441 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_PER_R' is now a registered translation. 442 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_succ_R is defined 443 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_succ_R' is now a registered translation. 444 | Coq__o__Classes__o__Morphisms__o__reflexive_proper_proxy_R is defined 445 | 'Coq__o__Classes__o__Morphisms__o__reflexive_proper_proxy_R' is now a registered translation. 446 | Coq__o__Init__o__Logic__o__and_rect_R is defined 447 | 'Coq__o__Init__o__Logic__o__and_rect_R' is now a registered translation. 448 | Coq__o__Init__o__Logic__o__and_ind_R is defined 449 | 'Coq__o__Init__o__Logic__o__and_ind_R' is now a registered translation. 450 | Coq__o__Classes__o__Morphisms__o__iff_impl_subrelation_R is defined 451 | 'Coq__o__Classes__o__Morphisms__o__iff_impl_subrelation_R' is now a registered translation. 452 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_obligation_1_R is defined 453 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_obligation_1_R' is now a registered translation. 454 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_R is defined 455 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_wd_R' is now a registered translation. 456 | Coq__o__Classes__o__RelationClasses__o__Equivalence_Reflexive_R is defined 457 | 'Coq__o__Classes__o__RelationClasses__o__Equivalence_Reflexive_R' is now a registered translation. 458 | Coq__o__Classes__o__Morphisms__o__subrelation_respectful_R is defined 459 | 'Coq__o__Classes__o__Morphisms__o__subrelation_respectful_R' is now a registered translation. 460 | Coq__o__Classes__o__RelationClasses__o__eq_Reflexive_R is defined 461 | 'Coq__o__Classes__o__RelationClasses__o__eq_Reflexive_R' is now a registered translation. 462 | Coq__o__Init__o__Logic__o__eq_trans_R is defined 463 | 'Coq__o__Init__o__Logic__o__eq_trans_R' is now a registered translation. 464 | Coq__o__Classes__o__RelationClasses__o__eq_Transitive_R is defined 465 | 'Coq__o__Classes__o__RelationClasses__o__eq_Transitive_R' is now a registered translation. 466 | Coq__o__Classes__o__RelationClasses__o__eq_Symmetric_R is defined 467 | 'Coq__o__Classes__o__RelationClasses__o__eq_Symmetric_R' is now a registered translation. 468 | Coq__o__Classes__o__RelationClasses__o__eq_equivalence_R is defined 469 | 'Coq__o__Classes__o__RelationClasses__o__eq_equivalence_R' is now a registered translation. 470 | Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_equiv_R is defined 471 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_equiv_R' is now a registered translation. 472 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_R is defined 473 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_R' is now a registered translation. 474 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_wd_R is defined 475 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_inj_wd_R' is now a registered translation. 476 | Coq__o__Classes__o__Morphisms__o__ProperProxy_R is defined 477 | 'Coq__o__Classes__o__Morphisms__o__ProperProxy_R' is now a registered translation. 478 | Coq__o__Classes__o__Morphisms__o__Reflexive_partial_app_morphism_R is defined 479 | 'Coq__o__Classes__o__Morphisms__o__Reflexive_partial_app_morphism_R' is now a registered translation. 480 | Coq__o__Init__o__Logic__o__False_rect_R is defined 481 | 'Coq__o__Init__o__Logic__o__False_rect_R' is now a registered translation. 482 | Coq__o__Init__o__Logic__o__False_ind_R is defined 483 | 'Coq__o__Init__o__Logic__o__False_ind_R' is now a registered translation. 484 | Coq__o__Init__o__Logic__o__iff_sym_R is defined 485 | 'Coq__o__Init__o__Logic__o__iff_sym_R' is now a registered translation. 486 | Coq__o__Classes__o__RelationClasses__o__iff_Symmetric_R is defined 487 | 'Coq__o__Classes__o__RelationClasses__o__iff_Symmetric_R' is now a registered translation. 488 | Coq__o__Init__o__Logic__o__iff_trans_R is defined 489 | 'Coq__o__Init__o__Logic__o__iff_trans_R' is now a registered translation. 490 | Coq__o__Classes__o__RelationClasses__o__iff_Transitive_R is defined 491 | 'Coq__o__Classes__o__RelationClasses__o__iff_Transitive_R' is now a registered translation. 492 | Coq__o__Init__o__Logic__o__iff_refl_R is defined 493 | 'Coq__o__Init__o__Logic__o__iff_refl_R' is now a registered translation. 494 | Coq__o__Classes__o__RelationClasses__o__iff_Reflexive_R is defined 495 | 'Coq__o__Classes__o__RelationClasses__o__iff_Reflexive_R' is now a registered translation. 496 | Coq__o__Classes__o__RelationClasses__o__iff_equivalence_R is defined 497 | 'Coq__o__Classes__o__RelationClasses__o__iff_equivalence_R' is now a registered translation. 498 | Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_obligation_1_R is defined 499 | 'Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_obligation_1_R' is now a registered translation. 500 | Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_R is defined 501 | 'Coq__o__Classes__o__Morphisms__o__per_partial_app_morphism_R' is now a registered translation. 502 | Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_obligation_1_R is defined 503 | 'Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_obligation_1_R' is now a registered translation. 504 | Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_R is defined 505 | 'Coq__o__Classes__o__Morphisms__o__trans_sym_co_inv_impl_morphism_R' is now a registered translation. 506 | Coq__o__Program__o__Basics__o__flip_R is defined 507 | 'Coq__o__Program__o__Basics__o__flip_R' is now a registered translation. 508 | Coq__o__Classes__o__RelationClasses__o__reflexivity_R is defined 509 | 'Coq__o__Classes__o__RelationClasses__o__reflexivity_R' is now a registered translation. 510 | comparison_R is defined 511 | comparison_R_rect is defined 512 | comparison_R_ind is defined 513 | comparison_R_rec is defined 514 | Coq__o__Init__o__Nat__o__compare_R is defined 515 | 'Coq__o__Init__o__Nat__o__compare_R' is now a registered translation. 516 | or_R is defined 517 | or_R_ind is defined 518 | Coq__o__Init__o__Logic__o__or_ind_R is defined 519 | 'Coq__o__Init__o__Logic__o__or_ind_R' is now a registered translation. 520 | Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_obligation_1_R is defined 521 | 'Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_obligation_1_R' is now a registered translation. 522 | Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_R is defined 523 | 'Coq__o__Classes__o__Morphisms__o__trans_co_eq_inv_impl_morphism_R' is now a registered translation. 524 | Coq__o__Classes__o__Morphisms__o__eq_proper_proxy_R is defined 525 | 'Coq__o__Classes__o__Morphisms__o__eq_proper_proxy_R' is now a registered translation. 526 | Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_obligation_1_R is defined 527 | 'Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_obligation_1_R' is now a registered translation. 528 | Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_R is defined 529 | 'Coq__o__Classes__o__Morphisms_Prop__o__or_iff_morphism_R' is now a registered translation. 530 | Coq__o__Init__o__Datatypes__o__nat_rect_R is defined 531 | 'Coq__o__Init__o__Datatypes__o__nat_rect_R' is now a registered translation. 532 | Coq__o__Init__o__Datatypes__o__nat_ind_R is defined 533 | 'Coq__o__Init__o__Datatypes__o__nat_ind_R' is now a registered translation. 534 | Coq__o__Init__o__Logic__o__f_equal_R is defined 535 | 'Coq__o__Init__o__Logic__o__f_equal_R' is now a registered translation. 536 | Coq__o__Init__o__Peano__o__f_equal_nat_R is defined 537 | 'Coq__o__Init__o__Peano__o__f_equal_nat_R' is now a registered translation. 538 | Coq__o__Init__o__Peano__o__eq_add_S_R is defined 539 | 'Coq__o__Init__o__Peano__o__eq_add_S_R' is now a registered translation. 540 | True_R is defined 541 | True_R_rect is defined 542 | True_R_ind is defined 543 | True_R_rec is defined 544 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_eq_iff_R is defined 545 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_eq_iff_R' is now a registered translation. 546 | Coq__o__Init__o__Peano__o__le_0_n_R is defined 547 | 'Coq__o__Init__o__Peano__o__le_0_n_R' is now a registered translation. 548 | Coq__o__Init__o__Peano__o__le_ind_R is defined 549 | 'Coq__o__Init__o__Peano__o__le_ind_R' is now a registered translation. 550 | Coq__o__Init__o__Peano__o__le_pred_R is defined 551 | 'Coq__o__Init__o__Peano__o__le_pred_R' is now a registered translation. 552 | Coq__o__Init__o__Peano__o__le_S_n_R is defined 553 | 'Coq__o__Init__o__Peano__o__le_S_n_R' is now a registered translation. 554 | Coq__o__Init__o__Peano__o__le_n_S_R is defined 555 | 'Coq__o__Init__o__Peano__o__le_n_S_R' is now a registered translation. 556 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_le_iff_R is defined 557 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_le_iff_R' is now a registered translation. 558 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_lt_iff_R is defined 559 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_lt_iff_R' is now a registered translation. 560 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_eq_cases_R is defined 561 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_eq_cases_R' is now a registered translation. 562 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_refl_R is defined 563 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_refl_R' is now a registered translation. 564 | Coq__o__Classes__o__Morphisms__o__iff_flip_impl_subrelation_R is defined 565 | 'Coq__o__Classes__o__Morphisms__o__iff_flip_impl_subrelation_R' is now a registered translation. 566 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_r_R is defined 567 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_r_R' is now a registered translation. 568 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_diag_r_R is defined 569 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_succ_diag_r_R' is now a registered translation. 570 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_obligation_1_R is defined 571 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_obligation_1_R' is now a registered translation. 572 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_R is defined 573 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_wd_R' is now a registered translation. 574 | Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_refl_R is defined 575 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__compare_refl_R' is now a registered translation. 576 | Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_obligation_1_R is defined 577 | 'Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_obligation_1_R' is now a registered translation. 578 | Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_R is defined 579 | 'Coq__o__Classes__o__Morphisms_Prop__o__not_iff_morphism_R' is now a registered translation. 580 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_irrefl_R is defined 581 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_irrefl_R' is now a registered translation. 582 | Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_diag_l_R is defined 583 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_diag_l_R' is now a registered translation. 584 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_incl_R is defined 585 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_incl_R' is now a registered translation. 586 | Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_succ_diag_l_R is defined 587 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_succ_diag_l_R' is now a registered translation. 588 | Coq__o__Arith__o__PeanoNat__o__Nat__o__nle_succ_diag_l_R is defined 589 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__nle_succ_diag_l_R' is now a registered translation. 590 | Coq__o__Arith__o__PeanoNat__o__Nat__o__bi_induction_R is defined 591 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__bi_induction_R' is now a registered translation. 592 | Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_obligation_1_R is defined 593 | 'Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_obligation_1_R' is now a registered translation. 594 | Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_R is defined 595 | 'Coq__o__Classes__o__Morphisms_Prop__o__iff_iff_iff_impl_morphism_R' is now a registered translation. 596 | Coq__o__Arith__o__PeanoNat__o__Nat__o__central_induction_R is defined 597 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__central_induction_R' is now a registered translation. 598 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_wd_R is defined 599 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_wd_R' is now a registered translation. 600 | Coq__o__Init__o__Logic__o__or_iff_compat_r_R is defined 601 | 'Coq__o__Init__o__Logic__o__or_iff_compat_r_R' is now a registered translation. 602 | Coq__o__Init__o__Logic__o__or_cancel_r_R is defined 603 | 'Coq__o__Init__o__Logic__o__or_cancel_r_R' is now a registered translation. 604 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_l_R is defined 605 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_l_R' is now a registered translation. 606 | Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_lt_mono_R is defined 607 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__succ_lt_mono_R' is now a registered translation. 608 | Coq__o__Arith__o__Lt__o__lt_S_n_R is defined 609 | 'Coq__o__Arith__o__Lt__o__lt_S_n_R' is now a registered translation. 610 | Acc_R is defined 611 | Acc_R_rect is defined 612 | Acc_R_ind is defined 613 | Acc_R_rec is defined 614 | Coq__o__Init__o__Wf__o__Acc_inv_R is defined 615 | 'Coq__o__Init__o__Wf__o__Acc_inv_R' is now a registered translation. 616 | Coq__o__Classes__o__RelationClasses__o__complement_R is defined 617 | 'Coq__o__Classes__o__RelationClasses__o__complement_R' is now a registered translation. 618 | Coq__o__Classes__o__RelationClasses__o__Irreflexive_R is defined 619 | 'Coq__o__Classes__o__RelationClasses__o__Irreflexive_R' is now a registered translation. 620 | StrictOrder_R is defined 621 | Coq__o__Classes__o__RelationClasses__o__StrictOrder_Transitive_R is defined 622 | 'Coq__o__Classes__o__RelationClasses__o__StrictOrder_Transitive_R' is now a registered translation. 623 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_asymm_R is defined 624 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_asymm_R' is now a registered translation. 625 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_trans_R is defined 626 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_trans_R' is now a registered translation. 627 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_strorder_R is defined 628 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_strorder_R' is now a registered translation. 629 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__lt_strorder_R is defined 630 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__lt_strorder_R' is now a registered translation. 631 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_lteq_R is defined 632 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_lteq_R' is now a registered translation. 633 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__le_lteq_R is defined 634 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__le_lteq_R' is now a registered translation. 635 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_compat_R is defined 636 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_compat_R' is now a registered translation. 637 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__lt_compat_R is defined 638 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__lt_compat_R' is now a registered translation. 639 | ord_R is defined 640 | ord_R_rect is defined 641 | ord_R_ind is defined 642 | ord_R_rec is defined 643 | Coq__o__Structures__o__OrdersTac__o__trans_ord_R is defined 644 | 'Coq__o__Structures__o__OrdersTac__o__trans_ord_R' is now a registered translation. 645 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__eq_equiv_R is defined 646 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__eq_equiv_R' is now a registered translation. 647 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__interp_ord_R is defined 648 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__interp_ord_R' is now a registered translation. 649 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__trans_R is defined 650 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__trans_R' is now a registered translation. 651 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__le_lt_trans_R is defined 652 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__le_lt_trans_R' is now a registered translation. 653 | Coq__o__Classes__o__RelationClasses__o__StrictOrder_Irreflexive_R is defined 654 | 'Coq__o__Classes__o__RelationClasses__o__StrictOrder_Irreflexive_R' is now a registered translation. 655 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__lt_irrefl_R is defined 656 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__lt_irrefl_R' is now a registered translation. 657 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_gt_cases_R is defined 658 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_gt_cases_R' is now a registered translation. 659 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_trichotomy_R is defined 660 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_trichotomy_R' is now a registered translation. 661 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_total_R is defined 662 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_total_R' is now a registered translation. 663 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__lt_total_R is defined 664 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__IsTotal__o__lt_total_R' is now a registered translation. 665 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__not_ge_lt_R is defined 666 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__not_ge_lt_R' is now a registered translation. 667 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_trans_R is defined 668 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_le_trans_R' is now a registered translation. 669 | Coq__o__Arith__o__Wf_nat__o__ltof_R is defined 670 | 'Coq__o__Arith__o__Wf_nat__o__ltof_R' is now a registered translation. 671 | Coq__o__Arith__o__Lt__o__lt_n_Sm_le_R is defined 672 | 'Coq__o__Arith__o__Lt__o__lt_n_Sm_le_R' is now a registered translation. 673 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__lt_eq_R is defined 674 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__lt_eq_R' is now a registered translation. 675 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__not_gt_le_R is defined 676 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__not_gt_le_R' is now a registered translation. 677 | Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_le_incl_R is defined 678 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__eq_le_incl_R' is now a registered translation. 679 | Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__lt_trans_R is defined 680 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__Private_OrderTac__o__Tac__o__lt_trans_R' is now a registered translation. 681 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_le_succ_r_R is defined 682 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_le_succ_r_R' is now a registered translation. 683 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_r_R is defined 684 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_succ_r_R' is now a registered translation. 685 | Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_0_R is defined 686 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__pred_0_R' is now a registered translation. 687 | Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_0_R is defined 688 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__neq_succ_0_R' is now a registered translation. 689 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_0_l_R is defined 690 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_0_l_R' is now a registered translation. 691 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_ngt_R is defined 692 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_ngt_R' is now a registered translation. 693 | Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_0_r_R is defined 694 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__nlt_0_r_R' is now a registered translation. 695 | Coq__o__Init__o__Wf__o__well_founded_R is defined 696 | 'Coq__o__Init__o__Wf__o__well_founded_R' is now a registered translation. 697 | Coq__o__Arith__o__Wf_nat__o__well_founded_ltof_R is defined 698 | 'Coq__o__Arith__o__Wf_nat__o__well_founded_ltof_R' is now a registered translation. 699 | Coq__o__Arith__o__Wf_nat__o__lt_wf_R is defined 700 | 'Coq__o__Arith__o__Wf_nat__o__lt_wf_R' is now a registered translation. 701 | Top__o__NNmod_upper_bound_R is defined 702 | 'Top__o__NNmod_upper_bound_R' is now a registered translation. 703 | Top__o__GcdS_tcc_R is defined 704 | 'Top__o__GcdS_tcc_R' is now a registered translation. 705 | max_type_R is defined 706 | max_type_R_rect is defined 707 | max_type_R_ind is defined 708 | max_type_R_rec is defined 709 | Coq__o__funind__o__Recdef__o__max_type_rect_R is defined 710 | 'Coq__o__funind__o__Recdef__o__max_type_rect_R' is now a registered translation. 711 | Coq__o__funind__o__Recdef__o__max_type_ind_R is defined 712 | 'Coq__o__funind__o__Recdef__o__max_type_ind_R' is now a registered translation. 713 | ex_R is defined 714 | ex_R_ind is defined 715 | Coq__o__Init__o__Logic__o__ex_ind_R is defined 716 | 'Coq__o__Init__o__Logic__o__ex_ind_R' is now a registered translation. 717 | Coq__o__Arith__o__Lt__o__lt_n_S_R is defined 718 | 'Coq__o__Arith__o__Lt__o__lt_n_S_R' is now a registered translation. 719 | Coq__o__Init__o__Datatypes__o__nat_rec_R is defined 720 | 'Coq__o__Init__o__Datatypes__o__nat_rec_R' is now a registered translation. 721 | Coq__o__Init__o__Peano__o__gt_R is defined 722 | 'Coq__o__Init__o__Peano__o__gt_R' is now a registered translation. 723 | Coq__o__Arith__o__Lt__o__lt_le_S_R is defined 724 | 'Coq__o__Arith__o__Lt__o__lt_le_S_R' is now a registered translation. 725 | Coq__o__Arith__o__Gt__o__gt_le_S_R is defined 726 | 'Coq__o__Arith__o__Gt__o__gt_le_S_R' is now a registered translation. 727 | Coq__o__Init__o__Logic__o__all_R is defined 728 | 'Coq__o__Init__o__Logic__o__all_R' is now a registered translation. 729 | Coq__o__Classes__o__Morphisms__o__pointwise_relation_R is defined 730 | 'Coq__o__Classes__o__Morphisms__o__pointwise_relation_R' is now a registered translation. 731 | Coq__o__Classes__o__Morphisms_Prop__o__all_iff_morphism_obligation_1_R is defined 732 | 'Coq__o__Classes__o__Morphisms_Prop__o__all_iff_morphism_obligation_1_R' is now a registered translation. 733 | Coq__o__Classes__o__Morphisms_Prop__o__all_iff_morphism_R is defined 734 | 'Coq__o__Classes__o__Morphisms_Prop__o__all_iff_morphism_R' is now a registered translation. 735 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_exists_pred_strong_R is defined 736 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_exists_pred_strong_R' is now a registered translation. 737 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_exists_pred_R is defined 738 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_exists_pred_R' is now a registered translation. 739 | Coq__o__Arith__o__PeanoNat__o__Nat__o__rs_rs'_R is defined 740 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__rs_rs'_R' is now a registered translation. 741 | Coq__o__Arith__o__PeanoNat__o__Nat__o__A'A_right_R is defined 742 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__A'A_right_R' is now a registered translation. 743 | Coq__o__Arith__o__PeanoNat__o__Nat__o__rbase_R is defined 744 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__rbase_R' is now a registered translation. 745 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_lt_succ_r_R is defined 746 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_lt_succ_r_R' is now a registered translation. 747 | Coq__o__Arith__o__PeanoNat__o__Nat__o__rs'_rs''_R is defined 748 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__rs'_rs''_R' is now a registered translation. 749 | Coq__o__Arith__o__PeanoNat__o__Nat__o__strong_right_induction_R is defined 750 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__strong_right_induction_R' is now a registered translation. 751 | Coq__o__Arith__o__PeanoNat__o__Nat__o__right_induction_R is defined 752 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__right_induction_R' is now a registered translation. 753 | Coq__o__Arith__o__PeanoNat__o__Nat__o__induction_R is defined 754 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__induction_R' is now a registered translation. 755 | Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_0_succ_R is defined 756 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__lt_0_succ_R' is now a registered translation. 757 | Coq__o__Arith__o__Le__o__le_n_S_R is defined 758 | 'Coq__o__Arith__o__Le__o__le_n_S_R' is now a registered translation. 759 | sumbool_R is defined 760 | sumbool_R_rect is defined 761 | sumbool_R_ind is defined 762 | sumbool_R_rec is defined 763 | Coq__o__Init__o__Specif__o__sumbool_rect_R is defined 764 | 'Coq__o__Init__o__Specif__o__sumbool_rect_R' is now a registered translation. 765 | Coq__o__Init__o__Specif__o__sumbool_rec_R is defined 766 | 'Coq__o__Init__o__Specif__o__sumbool_rec_R' is now a registered translation. 767 | Coq__o__Arith__o__Compare_dec__o__le_lt_dec_R is defined 768 | 'Coq__o__Arith__o__Compare_dec__o__le_lt_dec_R' is now a registered translation. 769 | Coq__o__Arith__o__Compare_dec__o__le_gt_dec_R is defined 770 | 'Coq__o__Arith__o__Compare_dec__o__le_gt_dec_R' is now a registered translation. 771 | Coq__o__funind__o__Recdef__o__max_R is defined 772 | 'Coq__o__funind__o__Recdef__o__max_R' is now a registered translation. 773 | Coq__o__Init__o__Logic__o__and_rec_R is defined 774 | 'Coq__o__Init__o__Logic__o__and_rec_R' is now a registered translation. 775 | Coq__o__Arith__o__PeanoNat__o__Nat__o__le_lt_trans_R is defined 776 | 'Coq__o__Arith__o__PeanoNat__o__Nat__o__le_lt_trans_R' is now a registered translation. 777 | 778 | Anomaly: Uncaught exception Not_found. Please report at 779 | http://coq.inria.fr/bugs/. 780 | *) 781 | -------------------------------------------------------------------------------- /test-suite/dummyFix.v: -------------------------------------------------------------------------------- 1 | 2 | (* the only way to compute zero is for p to become canonical. 3 | The only canonical member of A=A is eq_refl. 4 | However, it is impossible to that p is propositionally equal to eq_refl. 5 | In particular the univalence axiom allows for non-refl proofs. *) 6 | Fixpoint zero (A : Set) (p : A = A) {struct p} : nat := 0. 7 | 8 | 9 | (* although this axiom breaks canonicity, it is believed to be consistent *) 10 | Axiom strong_exm : Set -> nat. 11 | Axiom strong_exm_true : strong_exm True = 0. 12 | Axiom strong_exm_false : strong_exm False = 1. 13 | 14 | 15 | (* same type as [zero] above, but provably non parametric *) 16 | Definition nonParam (A : Set) (p : A = A) : nat := strong_exm A. 17 | 18 | (* because zero cannot be unfolded, it seems safe to assume the following *) 19 | Axiom zeroOpaque :(forall x, zero x = nonParam x). 20 | 21 | 22 | Inductive eq_R (A₁ A₂ : Type) (A_R : A₁ -> A₂ -> Type) (x₁ : A₁) (x₂ : A₂) 23 | (x_R : A_R x₁ x₂) 24 | : forall (H : A₁) (H0 : A₂), A_R H H0 -> x₁ = H -> x₂ = H0 -> Prop := 25 | eq_refl_R : eq_R A₁ A₂ A_R x₁ x₂ x_R x₁ x₂ x_R eq_refl eq_refl. 26 | 27 | 28 | Lemma zero_not_parametric : 29 | (forall (A₁ A₂ : Set) (A_R : A₁ -> A₂ -> Set) (p₁ : A₁ = A₁) (p₂ : A₂ = A₂), 30 | eq_R Set Set (fun H1 H2 : Set => H1 -> H2 -> Set) A₁ A₂ A_R A₁ A₂ A_R p₁ 31 | p₂ -> (zero A₁ p₁) = (zero A₂ p₂)) -> False. 32 | Proof using. 33 | intros Hc. 34 | specialize (Hc True False (fun _ _ => True) eq_refl eq_refl). 35 | do 2 rewrite zeroOpaque in Hc. 36 | unfold nonParam in Hc. simpl in Hc. 37 | rewrite strong_exm_true in Hc. 38 | rewrite strong_exm_false in Hc. 39 | specialize (Hc (@eq_refl_R _ _ _ _ _ _)). 40 | discriminate. 41 | Qed. 42 | 43 | -------------------------------------------------------------------------------- /test-suite/example.v: -------------------------------------------------------------------------------- 1 | Require Import Parametricity. 2 | 3 | 4 | 5 | 6 | (** Base Types. **) 7 | 8 | Inductive bool := true | false. 9 | 10 | Parametricity bool arity 1. 11 | 12 | Print bool_P. 13 | 14 | 15 | Definition boolfun := bool -> bool. 16 | 17 | Parametricity boolfun arity 1. 18 | Print boolfun_P. 19 | 20 | Definition myneg (b : bool) := 21 | match b with 22 | | true => false 23 | | false => true 24 | end. 25 | 26 | Parametricity myneg arity 1. 27 | 28 | Print myneg_P. 29 | 30 | Parametricity Recursive bool. 31 | 32 | (* Prints: 33 | Inductive bool_R : bool -> bool -> Set := 34 | true_R : bool_R true true 35 | | false_R : bool_R false false *) 36 | 37 | Lemma bool_R_eq: 38 | forall x y, bool_R x y -> x = y. 39 | intros x y H. 40 | destruct H. 41 | * reflexivity. 42 | * reflexivity. 43 | Defined. 44 | 45 | Lemma bool_R_refl: 46 | forall x, bool_R x x. 47 | induction x. 48 | constructor. 49 | constructor. 50 | Defined. 51 | 52 | (** Boolean functions **) 53 | 54 | Parametricity Recursive boolfun. 55 | Print boolfun_R. 56 | (* Prints: 57 | boolfun_R = fun f1 f2 : bool -> bool => 58 | forall x1 x2 : bool, bool_R x1 x2 -> 59 | bool_R (f1 x1) (f2 x2) 60 | *) 61 | Definition negb (x : bool) := 62 | match x with 63 | | true => false 64 | | false => true 65 | end. 66 | Parametricity negb. 67 | Check negb_R. 68 | Print negb_R. 69 | 70 | (** Universes **) 71 | 72 | Parametricity Translation Type as Type_R. 73 | Print Type_R. 74 | (* Prints : 75 | Type_R = fun A1 A2 : Type => A1 -> A2 -> Type 76 | *) 77 | Check (bool_R : Type_R bool bool). 78 | Check (boolfun_R : Type_R boolfun boolfun). 79 | 80 | Polymorphic Definition pType := Type. 81 | Parametricity pType. 82 | Check (pType_R : pType_R pType pType). 83 | 84 | (** Simple arrows **) 85 | 86 | Definition arrow (A : Type) (B : Type) := 87 | A -> B. 88 | 89 | Parametricity arrow. 90 | Print arrow_R. 91 | (* Prints: 92 | arrow_R = 93 | fun (A₁ A₂ : Type) (A_R : A₁ -> A₂ -> Type) 94 | (B₁ B₂ : Type) (B_R : B₁ -> B₂ -> Type) 95 | (f₁ : A₁ -> B₁) (f₂ : A₂ -> B₂) => 96 | forall (x₁ : A₁) (x₂ : A₂), 97 | A_R x₁ x₂ -> B_R (f₁ x₁) (f₂ x₂) 98 | *) 99 | 100 | (** Lambdas **) 101 | Definition lambda (A : Type) (B : Type) 102 | (f : arrow A B) := fun x => f x. 103 | Parametricity lambda. 104 | Print lambda_R. 105 | (* lambda_R = 106 | fun (A₁ A₂ : Type) (A_R : A₁ -> A₂ -> Type) 107 | (B₁ B₂ : Type) (B_R : B₁ -> B₂ -> Type) 108 | (f₁ : arrow A₁ B₁) (f₂ : arrow A₂ B₂) 109 | (f_R : arrow_R A₁ A₂ A_R B₁ B₂ B_R f₁ f₂) 110 | (x₁ : A₁) (x₂ : A₂) (x_R : A_R x₁ x₂) => f_R x₁ x₂ x_R *) 111 | 112 | (** Applications of functions *) 113 | Definition application A B (f : arrow A B) (x : A) : B := 114 | f x. 115 | Parametricity application. 116 | Print application_R. 117 | (* Prints : 118 | fun (A₁ A₂ : Type) (A_R : A₁ -> A₂ -> Type) 119 | (B₁ B₂ : Type) (B_R : B₁ -> B₂ -> Type) 120 | (f₁ : arrow A₁ B₁) (f₂ : arrow A₂ B₂) 121 | (f_R : arrow_R A₁ A₂ A_R B₁ B₂ B_R f₁ f₂) 122 | (x₁ : A₁) (x₂ : A₂) (x_R : A_R x₁ x₂) => f_R x₁ x₂ x_R. *) 123 | 124 | (** Dependent product **) 125 | Definition for_all (A : Type) (B : A -> Type) := forall x, B x. 126 | Parametricity for_all. 127 | Print for_all_R. 128 | (* Prints: 129 | for_all_R = 130 | fun (A₁ A₂ : Type) (A_R : A₁ -> A₂ -> Type) 131 | (B₁ : A₁ -> Type) (B₂ : A₂ -> Type) 132 | (B_R : forall (x₁ : A₁) (x₂ : A₂), A_R x₁ x₂ -> B₁ x₁ -> B₂ x₂ -> Type) 133 | (f₁ : forall x : A₁, B₁ x) (f₂ : forall x : A₂, B₂ x) => 134 | for all (x₁ : A₁) (x₂ : A₂) (x_R : A_R x₁ x₂), B_R x₁ x₂ x_R (f₁ x₁) (f₂ x₂) 135 | *) 136 | 137 | (** Inductive types. *) 138 | Inductive nat := 139 | | O : nat 140 | | S : nat -> nat. 141 | Parametricity nat. 142 | Print nat_R. 143 | (* Prints: 144 | Inductive nat_R : nat -> nat -> Set := 145 | O_R : nat_R 0 0 146 | | S_R : forall n₁ n₂ : nat, nat_R n₁ n₂ -> nat_R (S n₁) (S n₂) *) 147 | 148 | Inductive list (A : Type) : Type := nil : list A | cons : A -> list A -> list A. 149 | Parametricity list. 150 | Print list_R. 151 | (* Prints : 152 | Inductive list_R (A₁ A₂ : Type) (A_R : A₁ -> A₂ -> Type) : 153 | list A₁ -> list A₂ -> Type := 154 | nil_R : list_R A₁ A₂ A_R (nil A₁) (nil A₂) 155 | | cons_R : forall (x₁ : A₁) (x₂ : A₂), A_R x₁ x₂ -> 156 | forall (l₁ : list A₁) (l₂ : list A₂), 157 | list_R A₁ A₂ A_R l₁ l₂ -> list_R A₁ A₂ A_R (cons A₁ x₁ l₁) (cons A₂ x₂ l₂) 158 | *) 159 | 160 | Fixpoint length A (l : list A) : nat := 161 | match l with nil _ => O | cons _ _ tl => S (length A tl) end. 162 | Parametricity length. 163 | Check length_R. 164 | Print length_R. 165 | (* Prints : ... something that looks complicated. *) 166 | 167 | Parametricity list_rec. 168 | Print list_rec_R. 169 | Definition length2 (A : Type) (l : list A) : nat := 170 | list_rec A (fun _ => nat) O (fun _ _ => S) l. 171 | Parametricity length2. 172 | Check length2_R. 173 | Print length2_R. 174 | 175 | 176 | Print sum_rect. 177 | 178 | Parametricity Recursive sum_rect. 179 | Check sum_rect. 180 | Check sum_rect_R. 181 | 182 | 183 | 184 | -------------------------------------------------------------------------------- /test-suite/exmNotParametric.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ClassicalFacts. 2 | Inductive False_R : False -> False -> Prop :=. 3 | 4 | Inductive or_R (A₁ A₂ : Prop) (A_R : A₁ -> A₂ -> Prop) (B₁ B₂ : Prop) 5 | (B_R : B₁ -> B₂ -> Prop) : A₁ \/ B₁ -> A₂ \/ B₂ -> Prop := 6 | or_R_or_introl_R : forall (H : A₁) (H0 : A₂), 7 | A_R H H0 -> 8 | or_R A₁ A₂ A_R B₁ B₂ B_R (or_introl H) (or_introl H0) 9 | | or_R_or_intror_R : forall (H : B₁) (H0 : B₂), 10 | B_R H H0 -> 11 | or_R A₁ A₂ A_R B₁ B₂ B_R (or_intror H) (or_intror H0). 12 | 13 | Definition not_R := 14 | fun (A₁ A₂ : Prop) (A_R : A₁ -> A₂ -> Prop) (H : A₁ -> False) 15 | (H0 : A₂ -> False) => 16 | forall (H1 : A₁) (H2 : A₂), A_R H1 H2 -> False_R (H H1) (H0 H2). 17 | 18 | 19 | Lemma exmNotParam (exm : excluded_middle): 20 | (forall (A₁ A₂ : Prop) (A_R : A₁ -> A₂ -> Prop), 21 | or_R A₁ A₂ A_R (~ A₁) (~ A₂) (not_R A₁ A₂ A_R) 22 | (exm A₁) (exm A₂)) -> False. 23 | Proof using. 24 | intros Hc. 25 | specialize (Hc True False (fun _ _ => True)). 26 | destruct Hc; auto. 27 | Qed. 28 | -------------------------------------------------------------------------------- /test-suite/features.v: -------------------------------------------------------------------------------- 1 | Require Import Parametricity. 2 | 3 | 4 | (** Separate compilation: *) 5 | Parametricity nat as test. 6 | Require List. 7 | 8 | Parametricity Recursive List.rev. 9 | Check rev_R. 10 | 11 | (** Module translation *) 12 | Module A. 13 | Definition t := nat. 14 | Module B. 15 | Definition t := nat -> nat. 16 | End B. 17 | End A. 18 | 19 | Parametricity Recursive bool. 20 | Parametricity Module A. 21 | Print Module A_R. 22 | Print Module A_R.B_R. 23 | 24 | (* Parametricity Module Bool. *) 25 | (* Print Module Bool_R. *) 26 | 27 | (** Unary parametricity *) 28 | Parametricity Translation (forall X, X -> X) as ID_R arity 1. 29 | 30 | Lemma ID_unique: 31 | forall f, ID_R f -> forall A x, f A x = x. 32 | intros f f_R A x. 33 | specialize (f_R A (fun y => y = x) x). 34 | apply f_R. 35 | reflexivity. 36 | Defined. 37 | 38 | Parametricity nat arity 10. 39 | Print nat_R_10. 40 | 41 | Set Universe Polymorphism. 42 | 43 | (** Realizing axioms and section variables. *) 44 | Section Test. 45 | Variable A : Set. 46 | Variable R : A -> A -> Set. 47 | Realizer A as A_R := R. 48 | Definition id : A -> A := fun x => x. 49 | Parametricity id. 50 | End Test. 51 | 52 | (** Opaque terms. **) 53 | 54 | Require ProofIrrelevance. 55 | 56 | Lemma opaque : True. 57 | trivial. 58 | Qed. 59 | Parametricity Recursive opaque. 60 | Eval compute in opaque. 61 | Eval compute in opaque_R. 62 | 63 | 64 | Lemma opaqueunit : unit. 65 | exact tt. 66 | Qed. 67 | 68 | 69 | (* 70 | Fail Parametricity Recursive opaqueunit. 71 | DepRefs: 72 | opaqueunit 73 | Vernac Interpreter Executing command 74 | 75 | Anomaly: Uncaught exception Not_found. Please report at 76 | destruct opaqueunit. 77 | reflexivity. 78 | Parametricity Done. 79 | *) 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /test-suite/stdlib_R/.gitignore: -------------------------------------------------------------------------------- 1 | stdlib_R* 2 | -------------------------------------------------------------------------------- /test-suite/stdlib_R/Makefile: -------------------------------------------------------------------------------- 1 | COQSRC=../../../coq/ 2 | COQPLUGIN=../../src 3 | TOOL=bash ../../tools/coqdep.sh 4 | 5 | all: Makefile.gen 6 | make -f Makefile.gen 7 | 8 | Makefile.gen graph.dot: 9 | $(TOOL) $(COQSRC) 10 | 11 | graph.png: graph.dot 12 | dot -Tpng graph.dot -o graph.png 13 | 14 | ide: 15 | $(COQSRC)/bin/coqide -I $(COQPLUGIN) *.v 16 | 17 | clean: Makefile.gen 18 | make -f Makefile.gen clean 19 | rm -f Makefile.gen 20 | rm -f graph.dot graph.png 21 | rm -f stdlib_*.v 22 | -------------------------------------------------------------------------------- /test-suite/stdlib_R/Parametricity.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "coq-paramcoq.plugin". 2 | 3 | Ltac destruct_reflexivity := 4 | intros ; repeat match goal with 5 | | [ x : _ |- _ = _ ] => destruct x; reflexivity; fail 6 | end. 7 | 8 | Ltac destruct_construct x := 9 | (destruct x; [ constructor 1 ]; auto; fail) 10 | || (destruct x; [ constructor 1 | constructor 2 ]; auto; fail) 11 | || (destruct x; [ constructor 1 | constructor 2 | constructor 3]; auto; fail). 12 | 13 | Ltac unfold_cofix := intros; match goal with 14 | [ |- _ = ?folded ] => 15 | let x := fresh "x" in 16 | let typ := type of folded in 17 | (match folded with _ _ => pattern folded | _ => pattern folded at 2 end); 18 | match goal with [ |- ?P ?x ] => 19 | refine (let rebuild : typ -> typ := _ in 20 | let path : rebuild folded = folded := _ in 21 | eq_rect _ P _ folded path) end; 22 | [ intro x ; destruct_construct x; fail 23 | | destruct folded; reflexivity 24 | | reflexivity]; fail 25 | end. 26 | 27 | Ltac destruct_with_nat_arg_pattern x := 28 | pattern x; 29 | match type of x with 30 | | ?I 0 => refine (let gen : forall m (q : I m), 31 | (match m return I m -> Type with 32 | 0 => fun p => _ p 33 | | S n => fun _ => unit end q) := _ in gen 0 x) 34 | | ?I (S ?n) => refine (let gen : forall m (q : I m), 35 | (match m return I m -> Type with 36 | 0 => fun _ => unit 37 | | S n => fun p => _ p end q) := _ in gen (S n) x) 38 | end; intros m q; destruct q. 39 | 40 | Ltac destruct_reflexivity_with_nat_arg_pattern := 41 | intros ; repeat match goal with 42 | | [ x : _ |- _ = _ ] => destruct_with_nat_arg_pattern x; reflexivity; fail 43 | end. 44 | 45 | Axiom absurd : forall X, X. 46 | 47 | Ltac admit_and_print := 48 | intros; match goal with 49 | | [ |- _ = ?RHS ] => idtac "Warning: admiting an ogligation for" RHS 50 | | [ |- ?GOAL] => idtac "Warning: admiting an ogligation of goal" GOAL 51 | end; apply absurd. 52 | 53 | Global Parametricity Tactic := ((destruct_reflexivity; fail) 54 | || (unfold_cofix; fail) 55 | || (destruct_reflexivity_with_nat_arg_pattern; fail) 56 | || admit_and_print). 57 | 58 | Require ProofIrrelevance. (* for opaque terms *) 59 | -------------------------------------------------------------------------------- /test-suite/stdlib_R/Readme.md: -------------------------------------------------------------------------------- 1 | # Not documented yet 2 | 3 | This makefile generates files that translate all the modules in the standard library. 4 | It takes a lot of time. Oh, and also, it's still a bit buggy. 5 | -------------------------------------------------------------------------------- /test-suite/wadler.v: -------------------------------------------------------------------------------- 1 | 2 | Require Import List. 3 | Require Import Parametricity. 4 | 5 | Lemma nat_R_equal : 6 | forall x y, nat_R x y -> x = y. 7 | intros x y H; induction H; subst; trivial. 8 | Defined. 9 | 10 | Lemma equal_nat_R : 11 | forall x y, x = y -> nat_R x y. 12 | intros x y H; subst. 13 | induction y; constructor; trivial. 14 | Defined. 15 | 16 | Definition full_relation {A B} (x : A) (y : B) := True. 17 | 18 | Definition same_length {A B} := list_R A B full_relation. 19 | 20 | Lemma same_length_length : 21 | forall A B (l1 : list A) (l2 : list B), 22 | same_length l1 l2 -> length l1 = length l2. 23 | intros A B l1 l2 H. 24 | induction H; simpl. 25 | reflexivity. 26 | exact (f_equal S IHlist_R). 27 | Qed. 28 | 29 | Lemma length_same_length : 30 | forall A B (l1 : list A) (l2 : list B), 31 | length l1 = length l2 -> same_length l1 l2. 32 | admit. (* exercise :) *) 33 | Admitted. 34 | 35 | 36 | Module LengthType. 37 | 38 | Definition T := forall X, list X -> nat. 39 | Parametricity T. 40 | 41 | Definition FREE_THEOREM (f : T) := 42 | forall A l1 l2, same_length l1 l2 -> f A l1 = f A l2. 43 | 44 | Lemma param_length_type : 45 | forall f (f_R : T_R f f), FREE_THEOREM f. 46 | repeat intro. 47 | apply nat_R_equal. 48 | apply (f_R A A (fun _ _ => True)). 49 | assumption. 50 | Qed. 51 | 52 | Parametricity length. 53 | Definition length_rev : T := fun A l => length (rev l). 54 | 55 | Parametricity Recursive length_rev. 56 | Definition double_length : T := fun A l => length (l ++ l). 57 | 58 | Parametricity Recursive double_length. 59 | Definition constant : T := fun A l => 42. 60 | Parametricity constant. 61 | 62 | Definition length_free_theorem : FREE_THEOREM length 63 | := param_length_type length length_R. 64 | Definition double_length_free_theorem : FREE_THEOREM double_length 65 | := param_length_type double_length double_length_R. 66 | Definition constant_free_theorem : FREE_THEOREM constant 67 | := param_length_type constant constant_R. 68 | 69 | End LengthType. 70 | 71 | 72 | 73 | Definition graph {A B} (f : A -> B) := fun x y => f x = y. 74 | 75 | Definition map_rel {A B} (f : A -> B) := 76 | list_R A B (graph f). 77 | 78 | Lemma map_rel_map A B (f : A -> B) : 79 | forall (l : list A), map_rel f l (map f l). 80 | induction l; constructor; compute; auto. 81 | Defined. 82 | 83 | Lemma rel_map_map A B (f : A -> B) : 84 | forall (l: list A) fl, map_rel f l fl -> fl = map f l. 85 | intros; induction X; unfold graph in *; subst; reflexivity. 86 | Defined. 87 | 88 | Module RevType. 89 | 90 | Definition T := forall X, list X -> list X. 91 | Parametricity T. 92 | 93 | Definition FREE_THEOREM (F : T) := 94 | forall A B (f : A -> B) l, 95 | F B (map f l) = map f (F A l). 96 | 97 | Lemma param_naturality : 98 | forall F (F_R : T_R F F), FREE_THEOREM F. 99 | repeat intro. 100 | apply rel_map_map. 101 | apply F_R. 102 | apply map_rel_map. 103 | Defined. 104 | 105 | Parametricity rev. 106 | 107 | Definition tail : T := fun A l => 108 | match l with 109 | | nil => nil 110 | | hd :: tl => tl 111 | end. 112 | Parametricity tail. 113 | 114 | Definition rev_rev : T := fun A l => rev (rev l). 115 | Parametricity rev_rev. 116 | 117 | 118 | Definition rev_naturality : FREE_THEOREM rev 119 | := param_naturality rev rev_R. 120 | Definition rev_rev_naturality : FREE_THEOREM rev_rev 121 | := param_naturality rev_rev rev_rev_R. 122 | Definition tail_naturality : FREE_THEOREM tail 123 | := param_naturality tail tail_R. 124 | 125 | End RevType. 126 | 127 | 128 | Parametricity prod. 129 | 130 | Definition prod_map {A B} (f : A -> B) 131 | {A' B'} (f' : A' -> B') := 132 | prod_R A B (graph f) A' B' (graph f'). 133 | 134 | Definition pair {A B} (f : A -> B) {A' B'} (f' : A' -> B') : A * A' -> B * B' := 135 | fun c => let (x, x') := c in (f x, f' x'). 136 | 137 | Lemma pair_prod_map : 138 | forall A B (f : A -> B) 139 | A' B' (f' : A' -> B') xy xy', 140 | graph (pair f f') xy xy' -> prod_map f f' xy xy'. 141 | intros ? ? f ? ? f' [x y] [x' y']. 142 | intro H. 143 | compute in H. 144 | injection H. 145 | intros; subst. 146 | constructor; reflexivity. 147 | Defined. 148 | 149 | Lemma prod_map_pair : 150 | forall A B (f : A -> B) 151 | A' B' (f' : A' -> B') xy xy', 152 | prod_map f f' xy xy' -> graph (pair f f') xy xy'. 153 | intros ? ? f ? ? f' [x y] [x' y']. 154 | intro H. 155 | compute in H. 156 | induction H; subst. 157 | reflexivity. 158 | Defined. 159 | 160 | 161 | Lemma list_R_prod_map A B (f : A -> B) A' B' (f' : A' -> B') l1 l2 : 162 | list_R _ _ (prod_map f f') l1 l2 -> list_R _ _ (graph (pair f f')) l1 l2. 163 | intro H; induction H; constructor; [ apply prod_map_pair|]; auto. 164 | Defined. 165 | 166 | Module ZipType. 167 | 168 | Definition T := 169 | forall X Y, list X -> list Y -> list (X * Y). 170 | Parametricity T. 171 | 172 | Definition FREE_THEOREM (F : T) := forall 173 | A B (f : A -> B) 174 | A' B' (f' : A' -> B') l l', 175 | F B B' (map f l) (map f' l') = map (pair f f') (F A A' l l'). 176 | 177 | Lemma param_ZIP_naturality : 178 | forall F (F_R : T_R F F), FREE_THEOREM F. 179 | repeat intro. 180 | specialize (F_R A B (graph f) A' B' (graph f') l (map f l) (map_rel_map _ _ _ _) l' (map f' l') (map_rel_map _ _ _ _)). 181 | apply rel_map_map. 182 | unfold map_rel. 183 | apply list_R_prod_map. 184 | unfold prod_map. 185 | assumption. 186 | Defined. 187 | 188 | Fixpoint zip {X Y} (l1 : list X) (l2 : list Y) : list (X * Y) := 189 | match l1, l2 with 190 | | nil, _ => nil 191 | | _, nil => nil 192 | | x::tl1, y::tl2 => (x,y)::(zip tl1 tl2) 193 | end. 194 | Parametricity zip. 195 | Definition zip_free_theorem : FREE_THEOREM (@zip) := param_ZIP_naturality _ zip_R. 196 | 197 | End ZipType. 198 | -------------------------------------------------------------------------------- /theories/Param.v: -------------------------------------------------------------------------------- 1 | Declare ML Module "paramcoq:coq-paramcoq.plugin". 2 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name Param) 3 | (package coq-paramcoq) 4 | (synopsis "Plugin for generating parametricity statements to perform refinement proofs") 5 | (libraries coq-paramcoq.plugin)) 6 | -------------------------------------------------------------------------------- /tools/coqdep.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | COQSRC=../../coq 3 | if [ $# -gt 0 ]; then 4 | COQSRC=$1 5 | fi 6 | PLUGINSRC=../../src 7 | if [ $# -gt 1 ]; then 8 | PLUGINSRC=$2 9 | fi 10 | THEORIES=$COQSRC 11 | GENDEP=$( dirname "${BASH_SOURCE[0]}")/gendep.py 12 | 13 | 14 | echo "COQSRC = $COQSRC" 15 | echo "PLUGINSRC = $PLUGINSRC" 16 | echo "GENDEP = $GENDEP" 17 | 18 | ARGS=$(find $THEORIES -name "Rdef*.v" | sed 's/^.*coq\///') 19 | ARGS="$ARGS $(find $THEORIES -name "Classical_Prop.v" | sed 's/^.*coq\///')" 20 | modules=$(find $THEORIES -name '*.d' -exec cat '{}' ';' | grep '\.vo[^:]*: ' | python $GENDEP $ARGS) 21 | 22 | tmp="/tmp/stdlib.tmp.v" 23 | prefix="stdlib_R" 24 | makefile="Makefile.gen" 25 | 26 | for x in $modules; do 27 | if [[ $x == *-* ]]; then 28 | echo "Parametricity Module $(echo $x | sed 's/-.*$//') as $(echo $x | sed 's/^.*-//')." >> $tmp 29 | else 30 | echo "Parametricity Module $x." >> $tmp 31 | fi 32 | done 33 | test -f $tmp || exit 34 | 35 | split -l 15 -d $tmp $prefix --additional-suffix=.v 36 | rm -f $tmp 37 | 38 | cat > $makefile << EOF 39 | COQBIN := $COQSRC/bin/ 40 | PLUGINSRC := $PLUGINSRC 41 | OPTIONS := -I \$(PLUGINSRC) 42 | .PHONY: coq clean 43 | 44 | SRCS=\$(wildcard *.v) 45 | OBJS=\$(SRCS:.v=.vo) 46 | 47 | all: \$(OBJS) 48 | 49 | %.vo: %.v 50 | \$(COQBIN)coqc \$(OPTIONS) \$< 51 | 52 | Parametricity.vo: Parametricity.v 53 | 54 | clean: 55 | rm -f *.vo *.glob 56 | 57 | EOF 58 | 59 | first="$(printf "$prefix%02d" 0)" 60 | sed -i "1iRequire Parametricity.\nRequire Import $(echo $modules | sed 's/-[a-Z]*[0-9]*_R//g').\n(* Ignoring the following modules : $ARGS. *)" $first.v 61 | echo "$first.vo : $first.v Parametricity.vo" >> $makefile 62 | 63 | for x in $(seq 0 100); do 64 | y=$(($x + 1)) 65 | prev="$(printf "$prefix%02d" $x)" 66 | file="$(printf "$prefix%02d" $y)" 67 | if [ -f "$file.v" ]; then 68 | sed -i "1iRequire $prev." $file.v 69 | echo "$file.vo : $file.v $prev.vo" >> $makefile 70 | fi 71 | done 72 | -------------------------------------------------------------------------------- /tools/gendep.py: -------------------------------------------------------------------------------- 1 | import sys 2 | import os 3 | import re 4 | from collections import Counter, defaultdict 5 | 6 | 7 | def module_name(x): 8 | if 'theories/' in x: 9 | y = re.sub(r'^.*theories/','', x) 10 | y = re.sub(r'/','.', y) 11 | return y 12 | else: 13 | return os.path.basename(x) 14 | 15 | 16 | def draw (graph, sort, fd): 17 | fd.write('digraph {') 18 | for x in graph: 19 | for y in graph[x]: 20 | fd.write('"{0}" -> "{1}";\n'.format(x,y)) 21 | if sort: 22 | prev = sort[0] 23 | for x in sort[1:]: 24 | fd.write('"{0}" -> "{1}" [constraint=false color=red];'.format(prev,x)) 25 | prev = x 26 | 27 | fd.write('}') 28 | 29 | 30 | def transitive_reduction(graph, start): 31 | aux = defaultdict(Counter) 32 | result = defaultdict(list) 33 | 34 | waiting = list(start) 35 | visited = list() 36 | 37 | while waiting: 38 | x = waiting[-1] 39 | if not (x in visited): 40 | sons = graph[x] 41 | all_son_visited = True 42 | for son in sons: 43 | if not (son in visited): 44 | all_son_visited = False 45 | if all_son_visited: 46 | aux[x].update(sons) 47 | for son in sons: 48 | if son <> x: 49 | aux[x].update(aux[son]) 50 | aux[x].update(aux[son]) 51 | waiting.pop() 52 | visited.append(x) 53 | else : 54 | waiting.extend(graph[x]) 55 | else : 56 | waiting.pop() 57 | 58 | for x in aux: 59 | deps = list(k for k in aux[x] if aux[x][k] == 1) 60 | result[x] = deps 61 | return result 62 | 63 | def topological_sort(graph, start): 64 | def aux (fullfilled, position): 65 | if not position in fullfilled: 66 | for son in graph[position]: 67 | aux(fullfilled, son) 68 | fullfilled.append(position) 69 | result = list() 70 | for x in start: 71 | aux (result, x) 72 | return result 73 | 74 | def reverse(graph): 75 | result = defaultdict(set) 76 | for x in graph: 77 | for son in graph[x]: 78 | result[son].add(x) 79 | return result 80 | 81 | def remove(graph, starts): 82 | rev_graph = reverse(graph) 83 | removed = list() 84 | while starts : 85 | current = starts.pop() 86 | if current in graph: 87 | for son in rev_graph[current]: 88 | starts.append(son) 89 | del graph[current] 90 | removed.append(current) 91 | 92 | 93 | output = './graph.dot' 94 | fd = open(output, 'w') 95 | 96 | graph = defaultdict(list) 97 | 98 | for line in sys.stdin.readlines(): 99 | line_splitted = line.split(':') 100 | targets, needs = line_splitted[0].split(), line_splitted[1].split() 101 | targets = list (os.path.splitext(x)[0] for x in targets if x.endswith('.vo')) 102 | 103 | needs = list (os.path.splitext(x)[0] for x in needs if x.endswith('.vo') or x.endswith('.v')) 104 | 105 | for x in targets: 106 | graph[x].extend(y for y in needs if x <> y) 107 | 108 | 109 | if len(sys.argv) >= 2: 110 | removed_nodes = list(os.path.splitext(x)[0] for x in sys.argv[1:]) 111 | remove(graph, removed_nodes) 112 | 113 | init = list(x for x in list(graph) if 'Init/' in x) 114 | for x in list(graph) : 115 | if not (x in init) : 116 | graph[x].extend(init) 117 | start = list(graph) 118 | reduction = transitive_reduction(graph, start) 119 | sort = topological_sort(graph, start) 120 | draw(reduction, sort, fd) 121 | sort = map(module_name, sort) 122 | def aliasing(l): 123 | done = defaultdict(int) 124 | result = [] 125 | for x in l: 126 | basename = re.sub(r'^.*\.','', x) 127 | done[basename]+=1 128 | if done[basename] > 1: 129 | result.append('{0}-{1}{2}_R'.format(x, basename, done[basename])) 130 | else: 131 | result.append(x) 132 | return result 133 | 134 | sort = aliasing(sort) 135 | print(' '.join(sort)) 136 | --------------------------------------------------------------------------------