├── .gitattributes ├── .github └── workflows │ ├── main.yml │ ├── nix-action-coq-8.20.yml │ ├── nix-action-coq-9.0.yml │ └── nix-action-coq-master.yml ├── .gitignore ├── .nix ├── config.nix ├── coq-nix-toolbox.nix └── coq-overlays │ └── mathcomp-single │ └── default.nix ├── .vscode └── settings.json ├── AUTHORS.md ├── Changelog.md ├── HB ├── README.md ├── about.elpi ├── builders.elpi ├── common │ ├── compat_acc_clauses_all.elpi │ ├── compat_add_secvar_all.elpi │ ├── database.elpi │ ├── log.elpi │ ├── phant-abbreviation.elpi │ ├── stdpp.elpi │ ├── synthesis.elpi │ ├── utils-synterp.elpi │ └── utils.elpi ├── context.elpi ├── export.elpi ├── factory.elpi ├── graph.elpi ├── howto.elpi ├── instance.elpi ├── pack.elpi ├── status.elpi ├── structure.elpi └── structures.v ├── LICENSE ├── Makefile ├── Makefile.coq.local ├── Makefile.test-suite.coq.local ├── README.md ├── _CoqProject ├── _CoqProject.test-suite ├── _CoqProject.test-suite-stdlib ├── build-support └── coq │ ├── extra-lib.nix │ └── meta-fetch │ └── default.nix ├── coq-hierarchy-builder.opam ├── default.nix ├── examples ├── GReTA_talk │ ├── V1.v │ ├── V2.v │ ├── V3.v │ └── V4.v ├── cat │ └── cat.v ├── demo3 │ ├── hierarchy_0.v │ ├── hierarchy_1.v │ ├── hierarchy_2.v │ ├── test_0_0.v │ ├── test_1_0.v │ ├── test_2_0.v │ └── user_0.v ├── demo4 │ └── hierarchy_0.v ├── demo5 │ └── hierarchy_0.v ├── hulk.v └── readme.v ├── examples_stdlib ├── Coq2020_material │ ├── CoqWS_abstract.v │ ├── CoqWS_demo.v │ ├── CoqWS_expansion │ │ ├── withHB.v │ │ └── withoutHB.v │ ├── diagram.pdf │ └── diagram.svg ├── FSCD2020_material │ ├── V1.v │ ├── V2.v │ ├── V3.v │ └── V4.v ├── FSCD2020_talk │ ├── V1.v │ ├── V2.v │ └── V3.v ├── demo1 │ ├── README.md │ ├── hierarchy_0.v │ ├── hierarchy_1.v │ ├── hierarchy_2.v │ ├── hierarchy_3.v │ ├── hierarchy_4.v │ ├── hierarchy_5.v │ ├── test_0_0.v │ ├── test_1_0.v │ ├── test_2_0.v │ ├── test_3_0.v │ ├── test_3_3.v │ ├── test_4_0.v │ ├── test_4_3.v │ ├── test_5_0.v │ ├── test_5_3.v │ ├── user_0.v │ └── user_3.v └── demo2 │ ├── classical.v │ ├── stage10.v │ └── stage11.v ├── rocq-hierarchy-builder.opam ├── shim ├── Makefile ├── _CoqProject └── structures.v ├── tests ├── about.v.out ├── about.v.out.18 ├── about.v.out.19 ├── about.v.out.20 ├── bug_435.v ├── bug_447.v ├── class_for.v ├── compress_coe.v ├── compress_coe.v.out ├── compress_coe.v.out.18 ├── compress_coe.v.out.19 ├── compress_coe.v.out.20 ├── declare.v ├── display.v ├── duplicate_structure.v ├── err_bad_mix.v ├── err_bad_mix.v.out ├── err_instance_nop.v ├── err_instance_nop.v.out ├── err_instance_nop.v.out.18 ├── err_instance_nop.v.out.19 ├── err_instance_nop.v.out.20 ├── err_miss_dep.v ├── err_miss_dep.v.out ├── err_miss_key.v ├── err_miss_key.v.out ├── err_missin_subject.v ├── err_missin_subject.v.out ├── factory_sort.v ├── factory_when_notation.v ├── fix_loop.v ├── fun_instance.v ├── grefclass.v ├── hb_pack.v ├── hnf.v ├── hnf.v.out ├── hnf.v.out.16 ├── howto.v.out ├── howto.v.out.18 ├── howto.v.out.19 ├── howto.v.out.20 ├── instance_before_structure.v ├── instance_merge.v ├── instance_merge_with_distinct_param.v ├── instance_merge_with_param.v ├── instance_params_no_type.v ├── interleave_context.v ├── issue284.v ├── issue287.v ├── local_instance.v ├── lock.v ├── log_impargs_record.v ├── missing_join_error.v ├── missing_join_error.v.out ├── non_forgetful_inheritance.v ├── not_same_key.v ├── not_same_key.v.out ├── packable.v ├── primitive_records.v ├── saturate_on.v ├── short.v ├── subtype.v ├── test_CS_db_filtering.v ├── test_synthesis_params.v ├── two_hier.v ├── type_of_exported_ops.v ├── unimported_irrelevant_class.v ├── unimported_relevant_class.v └── unit │ ├── close_hole_term.v │ ├── enrich_type.v │ ├── mixin_src_has_mixin_instance.v │ ├── mk_src_map.v │ └── struct.v └── tests_stdlib ├── about.v ├── exports.v ├── exports2.v ├── funclass.v └── howto.v /.gitattributes: -------------------------------------------------------------------------------- 1 | *.elpi linguist-language=prolog 2 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: docker CI 4 | 5 | # Controls when the action will run. Triggers the workflow on push or pull request 6 | # events but only for the master branch 7 | on: 8 | push: 9 | branches: [ master ] 10 | tags: [ "v*.*.*" ] 11 | pull_request: 12 | branches: [ master ] 13 | 14 | jobs: 15 | opam: 16 | runs-on: ubuntu-latest 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | coq_version: 21 | - '8.20' 22 | - '9.0' 23 | steps: 24 | - uses: actions/checkout@v2 25 | - uses: coq-community/docker-coq-action@v1 26 | with: 27 | opam_file: './rocq-hierarchy-builder.opam' 28 | coq_version: ${{ matrix.coq_version }} 29 | export: 'OPAMWITHTEST' # space-separated list of variables 30 | env: 31 | OPAMWITHTEST: 'true' 32 | 33 | 34 | release: 35 | runs-on: ubuntu-latest 36 | if: startsWith(github.ref, 'refs/tags/') 37 | needs: [opam] 38 | steps: 39 | - name: Checkout 40 | uses: actions/checkout@v3 41 | 42 | - name: Inject slug/short variables 43 | uses: rlespinasse/github-slug-action@v4 44 | 45 | - name: Create archive 46 | run: | 47 | VERSION="${GITHUB_REF_NAME_SLUG#v}" 48 | git archive -o hierarchy-builder-$VERSION.tar.gz --prefix=hierarchy-builder-$VERSION/ $GITHUB_SHA . 49 | 50 | - name: Release 51 | uses: softprops/action-gh-release@v1 52 | with: 53 | files: hierarchy-builder-*.tar.gz 54 | fail_on_unmatched_files: true 55 | prerelease: true 56 | generate_release_notes: true 57 | name: Hierarchy Builder ${{ github.ref }} 58 | 59 | - name: Use OCaml 4.14.x 60 | uses: ocaml/setup-ocaml@v3 61 | with: 62 | ocaml-compiler: 4.14.x 63 | opam-local-packages: | 64 | !coq-hierarchy-builder*.opam 65 | 66 | - name: Write PAT 67 | env: 68 | OPAM_PUBLISH_TOKEN: ${{ secrets.OPAM_PUBLISH_TOKEN }} 69 | run: | 70 | mkdir -p ~/.opam/plugins/opam-publish 71 | printf "$OPAM_PUBLISH_TOKEN" > ~/.opam/plugins/opam-publish/coqelpibot.token 72 | 73 | - name: Setup SSH 74 | uses: webfactory/ssh-agent@v0.8.0 75 | with: 76 | ssh-private-key: ${{ secrets.BOT_SSH_KEY }} 77 | 78 | - name: Install opam-publish # 2.0.3 because more recent versions do not respect OPAMYES 79 | run: opam install -y -j 2 opam-publish=2.0.3 80 | 81 | - name: Publish 82 | run: | 83 | eval $(opam env) 84 | git config --global user.name coqelpibot 85 | git config --global user.email coqelpibot@inria.fr 86 | OPAM_SUITE=released 87 | TAG=`git tag --sort=-v:refname|head -1` 88 | opam-publish --tag=$TAG --packages-directory=$OPAM_SUITE/packages --repo=coq/opam --no-browser -v ${TAG##v} https://github.com/math-comp/hierarchy-builder/releases/download/$TAG/hierarchy-builder-${TAG##v}.tar.gz 89 | 90 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .*.aux 2 | *.a 3 | *.cma 4 | *.cmi 5 | *.cmo 6 | *.cmx 7 | *.cmxa 8 | *.cmxs 9 | *.glob 10 | *.ml.d 11 | *.ml4.d 12 | *.mli.d 13 | *.mllib.d 14 | *.mlpack.d 15 | *.native 16 | *.coq.d 17 | *.o 18 | *.v.d 19 | *.vio 20 | *.vos 21 | *.vok 22 | *.vo 23 | .coq-native/ 24 | .csdp.cache 25 | .lia.cache 26 | .nia.cache 27 | .nlia.cache 28 | .nra.cache 29 | csdp.cache 30 | lia.cache 31 | nia.cache 32 | nlia.cache 33 | nra.cache 34 | Makefile.coq 35 | Makefile.coq.conf 36 | .coqdeps.d 37 | Makefile.test-suite.coq 38 | Makefile.test-suite.coq.conf 39 | .coqdeps.test-suite 40 | *.v.hb 41 | *.v.hb.old 42 | coq.hb 43 | HB/common/log.compat.elpi 44 | 45 | _minted-* 46 | *.aux 47 | *.log 48 | *.out 49 | !*.v.out 50 | *.synctex.gz 51 | *.toc 52 | *.vrb 53 | *.fls 54 | *.nav 55 | *.bbl 56 | *.blg 57 | *.fdb_latexmk 58 | *.vtc 59 | 60 | *.dot 61 | config.stamp 62 | -------------------------------------------------------------------------------- /.nix/config.nix: -------------------------------------------------------------------------------- 1 | { 2 | format = "1.0.0"; 3 | attribute = "hierarchy-builder"; 4 | no-rocq-yet = true; 5 | default-bundle = "coq-8.20"; 6 | bundles = let 7 | mcHBcommon = { 8 | mathcomp.override.version = "master"; 9 | mathcomp.job = true; 10 | mathcomp-single.job = true; 11 | graph-theory.job = false; 12 | fourcolor.override.version = "master"; 13 | odd-order.override.version = "master"; 14 | mathcomp-finmap.override.version = "master"; 15 | mathcomp-classical.override.version = "master"; 16 | mathcomp-analysis.override.version = "master"; 17 | reglang.override.version = "master"; 18 | coq-bits.override.version = "master"; 19 | deriving.override.version = "master"; 20 | mathcomp-bigenough.override.version = "master"; 21 | multinomials.override.version = "master"; 22 | mathcomp-real-closed.override.version = "master"; 23 | coqeal.override.version = "master"; 24 | mathcomp-zify.override.version = "master"; 25 | mathcomp-algebra-tactics.override.version = "master"; 26 | mathcomp-word.override.version = "master"; 27 | coquelicot.override.version = "master"; 28 | ExtLib.override.version = "master"; 29 | simple-io.override.version = "master"; 30 | QuickChick.override.version = "master"; 31 | # jasmin.override.version = "main"; 32 | jasmin.job = false; # currently broken 33 | }; 34 | in { 35 | "coq-master" = { rocqPackages = { 36 | rocq-core.override.version = "master"; 37 | stdlib.override.version = "master"; 38 | rocq-elpi.override.version = "master"; 39 | rocq-elpi.override.elpi-version = "2.0.7"; 40 | bignums.override.version = "master"; 41 | }; coqPackages = mcHBcommon // { 42 | coq.override.version = "master"; 43 | stdlib.override.version = "master"; 44 | coq-elpi.override.version = "master"; 45 | coq-elpi.override.elpi-version = "2.0.7"; 46 | bignums.override.version = "master"; 47 | coquelicot.job = false; 48 | }; }; 49 | 50 | "coq-9.0".coqPackages = mcHBcommon // { 51 | coq.override.version = "9.0"; 52 | coq-elpi.override.version = "master"; 53 | coq-elpi.override.elpi-version = "2.0.7"; 54 | }; 55 | 56 | "coq-8.20".coqPackages = mcHBcommon // { 57 | coq.override.version = "8.20"; 58 | coq-elpi.override.version = "master"; 59 | coq-elpi.override.elpi-version = "2.0.7"; 60 | interval.override.version = "master"; 61 | }; 62 | 63 | }; 64 | cachix.coq = {}; 65 | cachix.coq-community = {}; 66 | cachix.math-comp.authToken = "CACHIX_AUTH_TOKEN"; 67 | 68 | } 69 | -------------------------------------------------------------------------------- /.nix/coq-nix-toolbox.nix: -------------------------------------------------------------------------------- 1 | "e88c86a9e0099f95e9b4d2511536e5f3c93a7daa" 2 | -------------------------------------------------------------------------------- /.nix/coq-overlays/mathcomp-single/default.nix: -------------------------------------------------------------------------------- 1 | { mathcomp, version ? null }: 2 | mathcomp.override {single = true; inherit version;} 3 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "spellright.language": [], 3 | "spellright.documentTypes": [ 4 | "markdown", 5 | "plaintext" 6 | ], 7 | "search.exclude": { 8 | ".*.aux": true, 9 | "*.a": true, 10 | "*.cma": true, 11 | "*.cmi": true, 12 | "*.cmo": true, 13 | "*.cmx": true, 14 | "*.cmxa": true, 15 | "*.cmxs": true, 16 | "*.glob": true, 17 | "*.ml.d": true, 18 | "*.ml4.d": true, 19 | "*.mli.d": true, 20 | "*.mllib.d": true, 21 | "*.mlpack.d": true, 22 | "*.native": true, 23 | "*.o": true, 24 | "*.v.d": true, 25 | "*.vio": true, 26 | "*.vo": true, 27 | ".coq-native/": true, 28 | ".csdp.cache": true, 29 | ".lia.cache": true, 30 | ".nia.cache": true, 31 | ".nlia.cache": true, 32 | ".nra.cache": true, 33 | "csdp.cache": true, 34 | "lia.cache": true, 35 | "nia.cache": true, 36 | "nlia.cache": true, 37 | "nra.cache": true, 38 | "Makefile.coq": true, 39 | "Makefile.coq.conf": true, 40 | ".coqdeps.d": true, 41 | "**/_minted-*": true, 42 | "**/*.aux": true, 43 | "**/*.log": true, 44 | // "**/*.out": true, // .v.out is used for expected test output 45 | "**/*.synctex.gz": true, 46 | "**/*.toc": true, 47 | "**/*.vrb": true, 48 | "**/*.fls": true, 49 | "**/*.nav": true, 50 | "**/*.bbl": true, 51 | "**/*.blg": true, 52 | "**/*.fdb_latexmk": true, 53 | "**/*.vtc": true 54 | }, 55 | "files.exclude": { 56 | ".*.aux": true, 57 | "*.a": true, 58 | "*.cma": true, 59 | "*.cmi": true, 60 | "*.cmo": true, 61 | "*.cmx": true, 62 | "*.cmxa": true, 63 | "*.cmxs": true, 64 | "*.glob": true, 65 | "*.ml.d": true, 66 | "*.ml4.d": true, 67 | "*.mli.d": true, 68 | "*.mllib.d": true, 69 | "*.mlpack.d": true, 70 | "*.native": true, 71 | "*.o": true, 72 | "*.v.d": true, 73 | "*.vio": true, 74 | "*.vo": true, 75 | ".coq-native/": true, 76 | ".csdp.cache": true, 77 | ".lia.cache": true, 78 | ".nia.cache": true, 79 | ".nlia.cache": true, 80 | ".nra.cache": true, 81 | "csdp.cache": true, 82 | "lia.cache": true, 83 | "nia.cache": true, 84 | "nlia.cache": true, 85 | "nra.cache": true, 86 | "Makefile.coq": true, 87 | "Makefile.coq.conf": true, 88 | ".coqdeps.d": true, 89 | "**/_minted-*": true, 90 | "**/*.aux": true, 91 | "**/*.log": true, 92 | // "**/*.out": true, // .v.out is used for expected test output 93 | "**/*.synctex.gz": true, 94 | "**/*.toc": true, 95 | "**/*.vrb": true, 96 | "**/*.fls": true, 97 | "**/*.nav": true, 98 | "**/*.bbl": true, 99 | "**/*.blg": true, 100 | "**/*.fdb_latexmk": true, 101 | "**/*.vtc": true, 102 | "**/.*.aux": true, 103 | "**/*.a": true, 104 | "**/*.cma": true, 105 | "**/*.cmi": true, 106 | "**/*.cmo": true, 107 | "**/*.cmx": true, 108 | "**/*.cmxa": true, 109 | "**/*.cmxs": true, 110 | "**/*.glob": true, 111 | "**/*.ml.d": true, 112 | "**/*.ml4.d": true, 113 | "**/*.mli.d": true, 114 | "**/*.mllib.d": true, 115 | "**/*.mlpack.d": true, 116 | "**/*.native": true, 117 | "**/*.coq.d": true, 118 | "**/*.o": true, 119 | "**/*.v.d": true, 120 | "**/*.vio": true, 121 | "**/*.vos": true, 122 | "**/*.vok": true, 123 | "**/*.vo": true, 124 | "**/.coq-native/": true, 125 | "**/.csdp.cache": true, 126 | "**/.lia.cache": true, 127 | "**/.nia.cache": true, 128 | "**/.nlia.cache": true, 129 | "**/.nra.cache": true, 130 | "**/csdp.cache": true, 131 | "**/lia.cache": true, 132 | "**/nia.cache": true, 133 | "**/nlia.cache": true, 134 | "**/nra.cache": true, 135 | "**/Makefile.coq": true, 136 | "**/Makefile.coq.conf": true, 137 | "**/.coqdeps.d": true, 138 | "**/Makefile.test-suite.coq": true, 139 | "**/Makefile.test-suite.coq.conf": true, 140 | "**/.coqdeps.test-suite": true, 141 | "**/*.dot": true 142 | } 143 | } -------------------------------------------------------------------------------- /AUTHORS.md: -------------------------------------------------------------------------------- 1 | Copyright (C) 2020 2 | 3 | - Cyril Cohen (Inria) 4 | - Pierre Roux (Onera) 5 | - Kazuhiko Sakaguchi (University of Tsukuba) 6 | - Enrico Tassi (Inria) 7 | 8 | This software is released under the terms of the MIT license, see LICENSE file. 9 | -------------------------------------------------------------------------------- /HB/README.md: -------------------------------------------------------------------------------- 1 | ## File structure 2 | 3 | - `HB/foo.elpi` implements the main entry point for `HB.foo` (or its variants) 4 | - `HB/common/foo.elpi` provides code used by more than one command 5 | - Each file `foo.elpi` should put its public API in the namespace `foo.` 6 | and its private code in `foo.private.`, if you need to access predicates 7 | in the private space then the API needs to be reworked (don't commit code 8 | accessing private stiff, even if Elpi won't prevent you from using it). 9 | 10 | ## Naming conventions 11 | - `under-foo.do! Arg [ Code ]` 12 | enriches the context with `foo`, the runs `std.do! [ Code ]` 13 | - `under-foo.then Arg F Out` 14 | enriches the context with `foo`, the runs `F Out`, as a consequence 15 | on can use the spilling expression `{under-foo.then Arg F}` 16 | - `foo_bar` 17 | projection from foo to its field bar 18 | - `foo->bar` 19 | conversion from type foo to type bar (it can be arbitrarily complex) 20 | - `get-foo` 21 | reads foo from the Coq world 22 | - `findall-foo` 23 | reads foo from `hb.db`, the output is sorted whenever it makes sense 24 | - `declare-foo` 25 | predicate adding to the Coq environment a `foo` 26 | - `postulate-foo` 27 | predicate assuming a `foo` (e.g. declaring a Coq section variable) 28 | - `TheType`, `TheClass`, `TheFoobar` 29 | the thing the current code is working on, eg the type of the structure 30 | begin defined 31 | - `FooAlias` 32 | see `phant-abbrev`, used to talk about the non canonical name of `Foo` 33 | - when foo is the constructor of a data type with type `A1 -> .. -> AN -> t` 34 | we define `mk-foo` as: 35 | `mk-foo A1 .. AN (foo A1 .. AN)` 36 | -------------------------------------------------------------------------------- /HB/common/compat_acc_clauses_all.elpi: -------------------------------------------------------------------------------- 1 | pred acc-clauses i:scope, i:list prop. 2 | acc-clauses Scope CL :- coq.elpi.accumulate-clauses Scope "hb.db" {std.map CL (c\r\ r = clause _ _ c)}. 3 | -------------------------------------------------------------------------------- /HB/common/compat_add_secvar_all.elpi: -------------------------------------------------------------------------------- 1 | pred log.coq.env.add-section-variable-noimplicits i:id, i:term, o:constant. 2 | log.coq.env.add-section-variable-noimplicits Name Ty C :- std.do! [ 3 | if (Name = "_") (ID is "fresh_name_" ^ {std.any->string {new_int}}) (ID = Name), 4 | % elpi:if version coq-elpi < 2.4.0 5 | @local! => coq.env.add-section-variable ID Ty C, 6 | % elpi:endif 7 | % elpi:if version coq-elpi >= 2.4.0 8 | @local! => coq.env.add-section-variable ID _ Ty C, 9 | % elpi:endif 10 | log.private.log-vernac (log.private.coq.vernac.variable ID Ty), 11 | @local! => log.coq.arguments.set-implicit (const C) [[]], 12 | ]. 13 | 14 | -------------------------------------------------------------------------------- /HB/common/utils-synterp.elpi: -------------------------------------------------------------------------------- 1 | /* Hierarchy Builder: algebraic hierarchies made easy 2 | This software is released under the terms of the MIT license */ 3 | 4 | % runs P in a context where Coq #[attributes] are parsed 5 | pred with-attributes i:prop. 6 | with-attributes P :- 7 | attributes A, 8 | coq.parse-attributes A [ 9 | att "verbose" bool, 10 | att "mathcomp" bool, 11 | att "mathcomp.axiom" string, 12 | att "short.type" string, 13 | att "short.pack" string, 14 | att "key" string, 15 | att "arg_sort" bool, 16 | att "log" bool, 17 | att "log.raw" bool, 18 | att "compress_coercions" bool, 19 | att "export" bool, 20 | att "skip" string, 21 | att "local" bool, 22 | att "fail" bool, 23 | att "doc" string, 24 | att "primitive" bool, 25 | att "non_forgetful_inheritance" bool, 26 | att "hnf" bool, 27 | ] Opts, !, 28 | Opts => (save-docstring, P). 29 | 30 | pred if-verbose i:prop. 31 | if-verbose P :- get-option "verbose" tt, !, P. 32 | if-verbose _. 33 | 34 | % header of if-verbose messages 35 | pred header o:string. 36 | header Msg :- Msg is "[" ^ {std.any->string {gettimeofday}} ^ "] HB: ". 37 | 38 | % approximation, it should be logical path, not the file name 39 | pred coq.env.current-library o:string. 40 | coq.env.current-library L :- loc.fields {get-option "elpi.loc"} L _ _ _ _. 41 | coq.env.current-library "dummy.v". 42 | 43 | % this is only declared in hb.db, this declaration is only to avoid a warning 44 | pred docstring o:loc, o:string. 45 | 46 | pred save-docstring. 47 | save-docstring :- 48 | if (get-option "elpi.loc" Loc, get-option "elpi.phase" "interp", get-option "doc" Txt) 49 | (coq.elpi.accumulate _ "hb.db" (clause _ _ (docstring Loc Txt))) 50 | true. 51 | 52 | pred compute-filter i:option string, o:list string. 53 | compute-filter none []. 54 | compute-filter (some S) MFilter :- % S is a component of the current modpath 55 | coq.env.current-path P, 56 | rex_split "\\." S L, 57 | compute-filter.aux P L MFilter, !. 58 | compute-filter (some S) MFilter :- 59 | coq.locate-module S M, 60 | coq.modpath->path M MFilter. 61 | compute-filter.aux [S|_] [S] [S] :- !. 62 | compute-filter.aux [S|XS] [S|SS] [S|YS] :- compute-filter.aux XS SS YS. 63 | compute-filter.aux [X|XS] L [X|YS] :- compute-filter.aux XS L YS. 64 | 65 | pred list-uniq i:list A, o:list A. 66 | pred list-uniq.seen i:A. 67 | list-uniq [] []. 68 | list-uniq [X|XS] YS :- list-uniq.seen X, !, list-uniq XS YS. 69 | list-uniq [X|XS] [X|YS] :- list-uniq.seen X => list-uniq XS YS. 70 | 71 | pred record-decl->id i:indt-decl, o:id. 72 | record-decl->id (parameter _ _ _ D) N :- pi p\ record-decl->id (D p) N. 73 | record-decl->id (record N _ _ _) N. 74 | -------------------------------------------------------------------------------- /HB/context.elpi: -------------------------------------------------------------------------------- 1 | /* Hierarchy Builder: algebraic hierarchies made easy 2 | This software is released under the terms of the MIT license */ 3 | 4 | namespace context { 5 | 6 | pred declare i:factories, o:mixins, o:list term, o:term, o:list prop, o:list constant. 7 | declare FLwP MLwP Params TheKey MSL CL :- !, std.do! [ 8 | factories-provide FLwP MLwPRaw, 9 | declare.params-key MLwPRaw ParamsSection TheKey _MLwA, 10 | std.map ParamsSection triple_2 Params, 11 | declare.mixins TheKey ParamsSection MLwPRaw MLwP MSL CL 12 | ]. 13 | 14 | pred declare.params-key i:w-params A, o:list (triple id term term), o:term, o:A. 15 | declare.params-key MLwP Params TheKey Out :- !, std.do! [ 16 | if-verbose (coq.say {header} "declaring parameters and key as section variables"), 17 | declare.params MLwP Params KId KTy F, 18 | log.coq.env.add-section-variable-noimplicits KId KTy C, 19 | TheKey = global (const C), 20 | Out = F TheKey 21 | ]. 22 | 23 | pred declare.params i:w-params A, o:list (triple id term term), o:id, o:term, o:(term -> A). 24 | declare.params (w-params.cons PId PTy F) [triple PId P PTy|Params] KId KTy Out :- !, std.do! [ 25 | log.coq.env.add-section-variable-noimplicits PId PTy C, 26 | P = global (const C), 27 | declare.params (F P) Params KId KTy Out 28 | ]. 29 | declare.params (w-params.nil KId KTy F) [] KId KTy F :- !. 30 | 31 | % [declare.mixins TheType Parameters Factories Clauses] postulates a 32 | % (section) context with all the mixins provided by the factories and all 33 | % the structure instances we can derive on TheType from these. Clauses 34 | % contain mixin-src for each postulated mixin 35 | pred declare.mixins i:term, i:list (triple id term term), i:mixins, o:mixins, o:list prop, o:list constant. 36 | declare.mixins TheType TheParamsSection MLwPRaw MLwP MSL CL :- std.do! [ 37 | if-verbose (coq.say "Here is the list of mixins to declare (the order matters): " 38 | {list-w-params_list MLwPRaw}), 39 | std.map TheParamsSection triple_2 TheParams, 40 | apply-w-params MLwPRaw TheParams TheType MLwAllArgsRaw, 41 | std.fold MLwAllArgsRaw (triple [] [] []) (private.postulate-mixin TheType) (triple CL MSL MLwPRev), 42 | acc-clauses current {std.map CL (cs\r\ r = local-canonical cs)}, 43 | std.rev MLwPRev MLwPSection, 44 | build-list-w-params TheParamsSection TheType MLwPSection MLwP, 45 | acc-clauses current MSL, 46 | ]. 47 | 48 | /* ------------------------------------------------------------------------- */ 49 | /* ----------------------------- private code ------------------------------ */ 50 | /* ------------------------------------------------------------------------- */ 51 | 52 | namespace private { 53 | 54 | % Given a type T, a fresh number N, and a mixin M it postulates 55 | % a variable "mN" inhabiting M applied to T and 56 | % all its dependencies, previously postulated and associated 57 | % to the corresponding mixin using mixin-for 58 | pred postulate-mixin i:term, i:w-args mixinname, i:triple (list constant) (list prop) (list (w-args mixinname)), 59 | o:triple (list constant) (list prop) (list (w-args mixinname)). 60 | postulate-mixin TheType (triple M Ps T) (triple CL MSL MLwP) (triple OutCL [MC|MSL] [NewMwP|MLwP]) :- MSL => std.do! [ 61 | Name is "local_mixin_" ^ {gref->modname M 2 "_"}, 62 | 63 | if-verbose (coq.say "HB: postulate" Name "on" {coq.term->string T}), 64 | 65 | synthesis.infer-all-gref-deps Ps T M TySkel, 66 | % was synthesis.infer-all-mixin-args Ps T M TySkel, 67 | % if-verbose (coq.say "HB: postulate-mixin checking" TySkel), 68 | % std.assert-ok! (coq.typecheck Ty _) "postulate-mixin: Ty illtyped", 69 | std.assert-ok! (coq.elaborate-ty-skeleton TySkel _ Ty) 70 | "postulate-mixin: Ty illtyped", 71 | log.coq.env.add-section-variable-noimplicits Name Ty C, 72 | factory? Ty NewMwP, 73 | 74 | MC = mixin-src T M (global (const C)), 75 | MC => get-option "local" tt => 76 | instance.declare-all TheType {findall-classes-for [M]} NewCSL, 77 | std.map NewCSL snd NewCL, 78 | std.append CL NewCL OutCL 79 | ]. 80 | }} 81 | -------------------------------------------------------------------------------- /HB/export.elpi: -------------------------------------------------------------------------------- 1 | /* Hierarchy Builder: algebraic hierarchies made easy 2 | This software is released under the terms of the MIT license */ 3 | 4 | pred export.any i:id. 5 | export.any S :- 6 | coq.locate-all S L, 7 | if (L = []) (coq.error "HB: cannot locate" S) true, 8 | if (L = [X]) (export.any.aux S X) (coq.error "HB:" S "is ambiguous:" L). 9 | export.any.aux S (loc-gref GR) :- export.abbrev S GR. 10 | export.any.aux S (loc-modpath MP) :- export.module S MP. 11 | export.any.aux S X :- coq.error "HB:" S "denotes" X "which is not supported for exporting". 12 | 13 | % [export.module Module] exports a Module now adds it to the collection of 14 | % modules to export in the end of the current enclosing module, 15 | % by the command HB.Exports 16 | % CAVEAT: "module" is a keyword, we put it in the namespace by hand 17 | pred export.module i:id, i:modpath. 18 | export.module NiceModule Module :- !, 19 | log.coq.env.export-module NiceModule Module, 20 | coq.env.current-library File, 21 | acc-clause current (module-to-export File NiceModule Module). 22 | 23 | pred export.abbrev i:id, i:gref. 24 | export.abbrev NiceName GR :- !, 25 | coq.env.current-library File, 26 | acc-clause current (abbrev-to-export File NiceName GR). 27 | 28 | pred export.clause i:prop. 29 | export.clause Clause :- !, 30 | coq.env.current-library File, 31 | acc-clauses current [Clause, clause-to-export File Clause]. 32 | 33 | pred export.reexport-all-modules-and-CS i:option string. 34 | export.reexport-all-modules-and-CS Filter :- std.do! [ 35 | coq.env.current-library File, 36 | export.private.compute-filter Filter MFilter, 37 | if-verbose (coq.say {header} "exporting under the module path" MFilter), 38 | 39 | % NODE: std.list-uniq is for coq < 8.13 40 | 41 | std.findall (module-to-export File NiceModule_ Module_) ModsCL, 42 | std.filter {std.list-uniq ModsCL} (export.private.module-in-module MFilter) ModsCLFiltered, 43 | std.map ModsCLFiltered module-to-export_module-nice NiceMods, 44 | std.map ModsCLFiltered module-to-export_module Mods, 45 | 46 | if-verbose (coq.say {header} "exporting modules" NiceMods), 47 | std.forall2 NiceMods Mods log.coq.env.export-module, 48 | 49 | 50 | std.findall (instance-to-export File NiceInstance_ Const_) InstCL, 51 | std.filter {std.list-uniq InstCL} (export.private.instance-in-module MFilter) InstCLFiltered, 52 | std.map InstCLFiltered instance-to-export_instance Insts, 53 | 54 | if-verbose (coq.say {header} "exporting CS instances" Insts), 55 | std.forall Insts log.coq.CS.declare-instance, 56 | 57 | std.findall (abbrev-to-export File NiceAbbrev_ GR_) InstAbbL, 58 | std.filter {std.list-uniq InstAbbL} (export.private.abbrev-in-module MFilter) InstAbbLFiltered, 59 | std.map InstAbbLFiltered abbrev-to-export_name AbbNames, 60 | std.map InstAbbLFiltered abbrev-to-export_body AbbBodies, 61 | 62 | if-verbose (coq.say {header} "exporting Abbreviations" AbbNames), 63 | std.forall2 AbbNames AbbBodies (n\b\@global! => log.coq.notation.add-abbreviation n 0 b ff _), 64 | 65 | std.findall (clause-to-export File Clause_) ClausesL, 66 | if-verbose (coq.say {header} "exporting Clauses" Clauses), 67 | std.map ClausesL clause-to-export_clause Clauses, 68 | acc-clauses current Clauses 69 | 70 | ]. 71 | 72 | 73 | namespace export.private { 74 | 75 | pred abbrev-in-module i:list string, i:prop. 76 | abbrev-in-module PM (abbrev-to-export _ _ GR) :- 77 | coq.gref->path GR PC, 78 | std.appendR PM _ PC. % sublist 79 | 80 | pred module-in-module i:list string, i:prop. 81 | module-in-module PM (module-to-export _ _ M) :- 82 | coq.modpath->path M PC, 83 | std.appendR PM _ PC. % sublist 84 | 85 | pred instance-in-module i:list string, i:prop. 86 | instance-in-module PM (instance-to-export _ _ C) :- 87 | coq.gref->path (const C) PC, 88 | std.appendR PM _ PC. % sublist 89 | 90 | pred compute-filter i:option string, o:list string. 91 | compute-filter none []. 92 | compute-filter (some S) MFilter :- % S is a component of the current modpath 93 | coq.env.current-path P, 94 | rex_split "\\." S L, 95 | compute-filter.aux P L MFilter, !. 96 | compute-filter (some S) MFilter :- 97 | coq.locate-module S M, 98 | coq.modpath->path M MFilter. 99 | compute-filter.aux [S|_] [S] [S] :- !. 100 | compute-filter.aux [S|XS] [S|SS] [S|YS] :- compute-filter.aux XS SS YS. 101 | compute-filter.aux [X|XS] L [X|YS] :- compute-filter.aux XS L YS. 102 | 103 | } 104 | -------------------------------------------------------------------------------- /HB/graph.elpi: -------------------------------------------------------------------------------- 1 | /* Hierarchy Builder: algebraic hierarchies made easy 2 | This software is released under the terms of the MIT license */ 3 | 4 | namespace graph { 5 | 6 | pred to-file i:string. 7 | to-file File :- !, std.do! [ 8 | open_out File OC, 9 | output OC "digraph Hierarchy { ", 10 | std.forall {coq.coercion.db} (private.pp-coercion-dot OC), 11 | output OC "}", 12 | close_out OC, 13 | ]. 14 | 15 | /* ------------------------------------------------------------------------- */ 16 | /* ----------------------------- private code ------------------------------ */ 17 | /* ------------------------------------------------------------------------- */ 18 | 19 | namespace private { 20 | 21 | pred pp-coercion-dot i:out_stream, i:coercion. 22 | pp-coercion-dot OC (coercion _ _ Src (grefclass Tgt)) :- class-def (class Src _ _), class-def (class Tgt _ _), !, std.do! [ 23 | output OC {gref->modname_short Tgt "_"}, 24 | output OC " -> ", 25 | output OC {gref->modname_short Src "_"}, 26 | output OC ";\n", 27 | ]. 28 | pp-coercion-dot _ _. 29 | 30 | }} -------------------------------------------------------------------------------- /HB/pack.elpi: -------------------------------------------------------------------------------- 1 | 2 | /* Hierarchy Builder: algebraic hierarchies made easy 3 | This software is released under the terms of the MIT license */ 4 | 5 | namespace pack { 6 | 7 | pred main i:term, i:list argument, o:term. 8 | main Ty Args Instance :- std.do! [ 9 | std.assert! (not(var Ty)) "HB.pack: the structure to pack cannot be unknown, use HB.pack_for", 10 | std.assert! (coq.safe-dest-app {unwind {whd Ty []}} (global Structure) Params) "HB.pack: not a structure", 11 | std.assert! (class-def (class Class Structure _)) "HB.pack: not a structure", 12 | std.assert! (Args = [trm TSkel|FactoriesSkel]) "HB.pack: not enough arguments", 13 | 14 | get-constructor Class KC, 15 | get-constructor Structure KS, 16 | 17 | std.assert-ok! (d\ 18 | (coq.elaborate-ty-skeleton TSkel _ T d, d = ok) ; 19 | coq.elaborate-skeleton TSkel _ T d 20 | ) "HB.pack: not a well typed key", 21 | 22 | private.elab-factories FactoriesSkel T Factories, 23 | 24 | if (var T) (coq.error "HB.pack: you must pass a type or at least one factory") true, 25 | 26 | if2 (T = app[global (const SortProj)|ProjParams], structure-key SortProj ClassProj _) 27 | (AllFactories = [app[global (const ClassProj)|ProjParams] | Factories], Tkey = T) % already existing class on T 28 | (def T _ _ Tkey) % we unfold letins if we can, they may hide constants with CS instances 29 | (AllFactories = Factories) 30 | (AllFactories = Factories, Tkey = T), % it's a factory, won't add anything 31 | 32 | private.synth-instance Params KC KS T Tkey AllFactories Instance, 33 | 34 | ]. 35 | 36 | /* ------------------------------------------------------------------------- */ 37 | /* ----------------------------- private code ------------------------------ */ 38 | /* ------------------------------------------------------------------------- */ 39 | 40 | namespace private { 41 | 42 | pred synth-instance.aux i:list term, i:gref, i:gref, i:term, i:term, i:list term, i:list prop, o:term. 43 | synth-instance.aux Params KC KS T Tkey [Factory|Factories] MLCano Instance :- 44 | synthesis.under-new-mixin-src-from-factory.do! Tkey Factory (_\ 45 | synth-instance.aux Params KC KS T Tkey Factories MLCano Instance). 46 | synth-instance.aux Params KC KS T Tkey [] MLCano Instance :- 47 | MLCano => std.do! [ 48 | std.assert-ok! (synthesis.infer-all-args-let Params Tkey KC ClassInstance) "HB.pack: cannot infer the instance", 49 | std.append Params [T, ClassInstance] InstanceArgs, 50 | Instance = app[global KS | InstanceArgs] 51 | ]. 52 | 53 | pred synth-instance i:list term, i:gref, i:gref, i:term, i:term, i:list term, o:term. 54 | synth-instance Params KC KS T Tkey Factories Instance :- 55 | if (coq.safe-dest-app Tkey (global _) _) (synthesis.local-canonical-mixins-of Tkey MLCano) (MLCano = []), 56 | synth-instance.aux Params KC KS T Tkey Factories MLCano Instance. 57 | 58 | pred elab-factories i:list argument, i:term, o:list term. 59 | elab-factories [] _ []. 60 | elab-factories [trm FactorySkel|More] T [Factory|Factories] :- 61 | std.assert-ok! (coq.elaborate-skeleton FactorySkel FTy MaybeFactory) "HB.pack: illtyped factory", 62 | if2 (factory? {unwind {whd FTy []}} (triple _ _ T1)) % a factory 63 | (Factory = MaybeFactory) 64 | (coq.safe-dest-app {unwind {whd FTy []}} (global GR) _, structure-key SortP ClassP GR) % a structure instance 65 | (coq.mk-n-holes {structure-nparams GR} Params, 66 | std.append Params [MaybeFactory] ParamsF, 67 | coq.mk-app (global (const SortP)) ParamsF T1, 68 | coq.mk-app (global (const ClassP)) ParamsF Factory) 69 | (coq.error "HB: argument" {coq.term->string MaybeFactory} "is not a factory, it has type:" {coq.term->string FTy}), 70 | std.assert-ok! (coq.unify-eq T T1) "HB.pack: factory for the wrong type", 71 | elab-factories More T Factories. 72 | 73 | }} 74 | -------------------------------------------------------------------------------- /HB/status.elpi: -------------------------------------------------------------------------------- 1 | /* Hierarchy Builder: algebraic hierarchies made easy 2 | This software is released under the terms of the MIT license */ 3 | 4 | namespace status { 5 | 6 | pred print-hierarchy. 7 | print-hierarchy :- std.do! [ 8 | coq.say "--------------------- Hierarchy -----------------------------------", 9 | std.findall (class-def CL_) CL, 10 | std.forall CL private.pp-class, 11 | 12 | coq.say "", 13 | coq.say "--------------------- Builders -----------------------------------", 14 | std.findall (from A_ B_ C_) FL, 15 | std.forall FL private.pp-from, 16 | 17 | std.findall (mixin-src T_ M_ V_) ML, 18 | if (ML = []) true ( 19 | coq.say "", 20 | coq.say "--------------------- Local mixin instances ----------------------", 21 | std.forall ML private.pp-mixin-src 22 | ), 23 | 24 | std.findall (builder-decl BD_) BDL, 25 | if (BDL = []) true ( 26 | coq.say "", 27 | coq.say "--------------------- Builder declarations ----------------------", 28 | std.forall BDL private.pp-builder-decl 29 | ), 30 | 31 | std.findall (current-mode BF_) BFL, 32 | if (BFL = []) true ( 33 | coq.say "", 34 | coq.say "--------------------- Current mode ----------------------", 35 | std.forall BFL private.pp-current-mode 36 | ), 37 | ]. 38 | 39 | /* ------------------------------------------------------------------------- */ 40 | /* ----------------------------- private code ------------------------------ */ 41 | /* ------------------------------------------------------------------------- */ 42 | 43 | namespace private { 44 | 45 | pred pp-from i:prop. 46 | pp-from (from F M T) :- 47 | coq.say "From" {coq.term->string (global F)} "to" {coq.term->string (global M)}, 48 | coq.say " " {coq.term->string (global T)}, 49 | coq.say "". 50 | 51 | pred pp-list-w-params i:mixins, i:term. 52 | pred pp-list-w-params.list-triple i:list (w-args mixinname), i:term. 53 | pred pp-list-w-params.triple i:w-args mixinname. 54 | pp-list-w-params (w-params.cons N Ty LwP) T :- 55 | @pi-parameter N Ty p\ pp-list-w-params (LwP p) {coq.mk-app T [p]}. 56 | pp-list-w-params (w-params.nil N TTy LwP) T :- 57 | @pi-parameter N TTy t\ pp-list-w-params.list-triple (LwP t) {coq.mk-app T [t]}. 58 | pp-list-w-params.list-triple L S :- 59 | coq.say {coq.term->string S} ":=", 60 | std.forall L pp-list-w-params.triple. 61 | pp-list-w-params.triple (triple M Params T) :- 62 | coq.say " " {coq.term->string (app [global M|{std.append Params [T]}])}. 63 | 64 | pred pp-class i:prop. 65 | pp-class (class-def (class _ S MLwP)) :- 66 | pp-list-w-params MLwP (global S). 67 | 68 | pred pp-mixin-src i:prop. 69 | pp-mixin-src (mixin-src T M C) :- 70 | coq.say {coq.term->string T} "is a" 71 | {nice-gref->string M} "thanks to" 72 | {coq.term->string C}. 73 | 74 | pred pp-builder-decl i:prop. 75 | pp-builder-decl (builder-decl (builder N F M GR)) :- 76 | coq.say "builder" GR "with serial number" N 77 | "will build mixin" M "from factory" F. 78 | 79 | pred pp-current-mode i:prop. 80 | pp-current-mode (current-mode (builder-from TheType TheFactory GRF Mod)) :- 81 | coq.say "The current key is" TheType "with factory" TheFactory 82 | "corresponding to Global Ref" GRF "in module" Mod. 83 | 84 | }} 85 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Permission is hereby granted, free of charge, to any person obtaining a copy 2 | of this software and associated documentation files (the "Software"), to deal 3 | in the Software without restriction, including without limitation the rights 4 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 5 | copies of the Software, and to permit persons to whom the Software is 6 | furnished to do so, subject to the following conditions: 7 | 8 | The above copyright notice and this permission notice shall be included in all 9 | copies or substantial portions of the Software. 10 | 11 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 12 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 13 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 14 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 15 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 16 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 17 | SOFTWARE. 18 | -------------------------------------------------------------------------------- /Makefile.coq.local: -------------------------------------------------------------------------------- 1 | # Coq does not know about Elpi Accumulate File, so we declare the dependency here 2 | HB/structures.vo : $(wildcard HB/*.elpi HB/common/*.elpi) 3 | 4 | clean:: 5 | $(SHOW)'CLEAN *.hb *.hb.old' 6 | $(HIDE) find . -name \*.hb -delete 7 | $(HIDE) find . -name \*.hb.old -delete 8 | -------------------------------------------------------------------------------- /Makefile.test-suite.coq.local: -------------------------------------------------------------------------------- 1 | COQ_MINOR=$(shell echo $(COQ_VERSION) | cut -d . -f 2 | cut -d + -f 1) 2 | output_for=`\ 3 | if [ -e $(1).out.$(COQ_MINOR) ]; then\ 4 | echo $(1).out.$(COQ_MINOR);\ 5 | else\ 6 | echo $(1).out;\ 7 | fi` 8 | 9 | DIFF=\ 10 | @if [ -z "$$COQ_ELPI_ATTRIBUTES" ]; then \ 11 | echo OUTPUT DIFF $(1);\ 12 | $(COQTOP) $(COQFLAGS) $(COQLIBS) -topfile $(1) \ 13 | < $(1) 2>&1 \ 14 | | sed 's/Coq < *//g' \ 15 | | sed 's/Rocq < *//g' \ 16 | | grep -v '^$$' \ 17 | | grep -v -e "Skipping rcfile" -e "is declared" -e "is defined" -e "Loading ML file" -e "Welcome to Coq" -e "Welcome to Rocq" \ 18 | | sed 's/characters \([0-9]\+\)-[0-9]\+/character \1/' \ 19 | > $(1).out.aux;\ 20 | diff -u --strip-trailing-cr $(call output_for,$(1)) $(1).out.aux;\ 21 | fi 22 | 23 | post-all:: 24 | $(call DIFF, tests/err_missin_subject.v) 25 | $(call DIFF, tests/compress_coe.v) 26 | $(call DIFF, tests/err_miss_key.v) 27 | $(call DIFF, tests/missing_join_error.v) 28 | $(call DIFF, tests/not_same_key.v) 29 | $(call DIFF, tests/hnf.v) 30 | $(call DIFF, tests/err_miss_dep.v) 31 | $(call DIFF, tests/err_bad_mix.v) 32 | $(call DIFF, tests/err_instance_nop.v) 33 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | HB/structures.v 2 | -arg -w -arg -elpi.accumulate-syntax 3 | -arg -w -arg +elpi.typecheck 4 | -arg -w -arg -elpi.typecheck-syntax 5 | -Q HB HB 6 | 7 | -R tests HB.tests 8 | -R examples HB.examples 9 | -------------------------------------------------------------------------------- /_CoqProject.test-suite: -------------------------------------------------------------------------------- 1 | -arg -w -arg -redundant-canonical-projection 2 | -arg -w -arg -projection-no-head-constant 3 | -arg -w -arg -abstract-large-number 4 | -arg -w -arg -disj-pattern-notation 5 | -arg -w -arg -notation-overridden 6 | -arg -w -arg +elpi.typecheck 7 | 8 | examples/readme.v 9 | examples/hulk.v 10 | 11 | examples/demo3/hierarchy_0.v 12 | examples/demo3/hierarchy_1.v 13 | examples/demo3/hierarchy_2.v 14 | examples/demo3/test_0_0.v 15 | examples/demo3/test_1_0.v 16 | examples/demo3/test_2_0.v 17 | 18 | examples/demo4/hierarchy_0.v 19 | 20 | examples/demo5/hierarchy_0.v 21 | 22 | # examples/cat/cat.v 23 | 24 | tests/type_of_exported_ops.v 25 | tests/duplicate_structure.v 26 | tests/instance_params_no_type.v 27 | tests/test_CS_db_filtering.v 28 | tests/subtype.v 29 | tests/log_impargs_record.v 30 | tests/compress_coe.v 31 | tests/grefclass.v 32 | tests/local_instance.v 33 | tests/lock.v 34 | tests/interleave_context.v 35 | tests/not_same_key.v 36 | #tests/factory_sort.v 37 | tests/hb_pack.v 38 | tests/declare.v 39 | tests/short.v 40 | tests/instance_before_structure.v 41 | tests/primitive_records.v 42 | tests/non_forgetful_inheritance.v 43 | tests/fix_loop.v 44 | tests/test_synthesis_params.v 45 | tests/hnf.v 46 | tests/fun_instance.v 47 | tests/issue284.v 48 | tests/issue287.v 49 | tests/two_hier.v 50 | tests/instance_merge_with_param.v 51 | tests/instance_merge_with_distinct_param.v 52 | tests/instance_merge.v 53 | 54 | tests/unit/enrich_type.v 55 | tests/unit/mixin_src_has_mixin_instance.v 56 | tests/unit/mk_src_map.v 57 | tests/unit/close_hole_term.v 58 | tests/unit/struct.v 59 | tests/factory_when_notation.v 60 | 61 | tests/saturate_on.v 62 | tests/bug_435.v 63 | tests/bug_447.v 64 | 65 | tests/unimported_relevant_class.v 66 | tests/unimported_irrelevant_class.v 67 | 68 | -R tests HB.tests 69 | -R examples HB.examples 70 | 71 | -Q HB HB 72 | -------------------------------------------------------------------------------- /_CoqProject.test-suite-stdlib: -------------------------------------------------------------------------------- 1 | -arg -w -arg -redundant-canonical-projection 2 | -arg -w -arg -projection-no-head-constant 3 | -arg -w -arg -abstract-large-number 4 | -arg -w -arg -disj-pattern-notation 5 | -arg -w -arg -notation-overridden 6 | -arg -w -arg +elpi.typecheck 7 | 8 | examples_stdlib/demo1/hierarchy_0.v 9 | examples_stdlib/demo1/hierarchy_1.v 10 | examples_stdlib/demo1/hierarchy_2.v 11 | examples_stdlib/demo1/hierarchy_3.v 12 | examples_stdlib/demo1/hierarchy_4.v 13 | examples_stdlib/demo1/hierarchy_5.v 14 | examples_stdlib/demo1/test_0_0.v 15 | examples_stdlib/demo1/test_1_0.v 16 | examples_stdlib/demo1/test_2_0.v 17 | examples_stdlib/demo1/test_3_0.v 18 | examples_stdlib/demo1/test_3_3.v 19 | examples_stdlib/demo1/test_4_0.v 20 | examples_stdlib/demo1/test_4_3.v 21 | examples_stdlib/demo1/test_5_0.v 22 | examples_stdlib/demo1/test_5_3.v 23 | 24 | examples_stdlib/demo2/classical.v 25 | examples_stdlib/demo2/stage10.v 26 | examples_stdlib/demo2/stage11.v 27 | 28 | examples_stdlib/FSCD2020_material/V1.v 29 | examples_stdlib/FSCD2020_material/V2.v 30 | examples_stdlib/FSCD2020_material/V3.v 31 | examples_stdlib/FSCD2020_material/V4.v 32 | 33 | examples_stdlib/FSCD2020_talk/V1.v 34 | examples_stdlib/FSCD2020_talk/V2.v 35 | examples_stdlib/FSCD2020_talk/V3.v 36 | 37 | examples_stdlib/Coq2020_material/CoqWS_demo.v 38 | examples_stdlib/Coq2020_material/CoqWS_abstract.v 39 | examples_stdlib/Coq2020_material/CoqWS_expansion/withHB.v 40 | examples_stdlib/Coq2020_material/CoqWS_expansion/withoutHB.v 41 | 42 | tests_stdlib/exports.v 43 | tests_stdlib/exports2.v 44 | tests_stdlib/funclass.v 45 | 46 | -R tests_stdlib HB.tests_stdlib 47 | -R examples_stdlib HB.examples_stdlib 48 | 49 | -Q HB HB 50 | -------------------------------------------------------------------------------- /build-support/coq/extra-lib.nix: -------------------------------------------------------------------------------- 1 | { lib }: 2 | with builtins; with lib; recursiveUpdate lib (rec { 3 | 4 | versions = 5 | let 6 | truncate = n: v: concatStringsSep "." (take n (splitVersion v)); 7 | opTruncate = op: v0: v: let n = length (splitVersion v0); in 8 | op (truncate n v) (truncate n v0); 9 | in rec { 10 | 11 | /* Get string of the first n parts of a version string. 12 | 13 | Example: 14 | - truncate 2 "1.2.3-stuff" 15 | => "1.2" 16 | 17 | - truncate 4 "1.2.3-stuff" 18 | => "1.2.3.stuff" 19 | */ 20 | 21 | inherit truncate; 22 | 23 | /* Get string of the first three parts (major, minor and patch) 24 | of a version string. 25 | 26 | Example: 27 | majorMinorPatch "1.2.3-stuff" 28 | => "1.2.3" 29 | */ 30 | majorMinorPatch = truncate 3; 31 | 32 | /* Version comparison predicates, 33 | - isGe v0 v <-> v is greater or equal than v0 [*] 34 | - isLe v0 v <-> v is lesser or equal than v0 [*] 35 | - isGt v0 v <-> v is strictly greater than v0 [*] 36 | - isLt v0 v <-> v is strictly lesser than v0 [*] 37 | - isEq v0 v <-> v is equal to v0 [*] 38 | - range low high v <-> v is between low and high [**] 39 | 40 | [*] truncating v to the same number of digits as v0 41 | [**] truncating v to low for the lower bound and high for the upper bound 42 | 43 | Examples: 44 | - isGe "8.10" "8.10.1" 45 | => true 46 | - isLe "8.10" "8.10.1" 47 | => true 48 | - isGt "8.10" "8.10.1" 49 | => false 50 | - isGt "8.10.0" "8.10.1" 51 | => true 52 | - isEq "8.10" "8.10.1" 53 | => true 54 | - range "8.10" "8.11" "8.11.1" 55 | => true 56 | - range "8.10" "8.11+" "8.11.0" 57 | => false 58 | - range "8.10" "8.11+" "8.11+beta1" 59 | => false 60 | 61 | */ 62 | isGe = opTruncate versionAtLeast; 63 | isGt = opTruncate (flip versionOlder); 64 | isLe = opTruncate (flip versionAtLeast); 65 | isLt = opTruncate versionOlder; 66 | isEq = opTruncate pred.equal; 67 | range = low: high: pred.inter (versions.isGe low) (versions.isLe high); 68 | }; 69 | 70 | /* Returns a list of list, splitting it using a predicate. 71 | This is analoguous to builtins.split sep list, 72 | with a predicate as a separator and a list instead of a string. 73 | 74 | Type: splitList :: (a -> bool) -> [a] -> [[a]] 75 | 76 | Example: 77 | splitList (x: x == "x") [ "y" "x" "z" "t" ] 78 | => [ [ "y" ] "x" [ "z" "t" ] ] 79 | */ 80 | splitList = pred: l: # put in file lists 81 | let loop = (vv: v: l: if l == [] then vv ++ [v] 82 | else let hd = head l; tl = tail l; in 83 | if pred hd then loop (vv ++ [ v hd ]) [] tl else loop vv (v ++ [hd]) tl); 84 | in loop [] [] l; 85 | 86 | pred = { 87 | /* Predicate intersection, union, and complement */ 88 | inter = p: q: x: p x && q x; 89 | union = p: q: x: p x || q x; 90 | compl = p: x: ! p x; 91 | true = p: true; 92 | false = p: false; 93 | 94 | /* predicate "being equal to y" */ 95 | equal = y: x: x == y; 96 | }; 97 | 98 | /* Emulate a "switch - case" construct, 99 | instead of relying on `if then else if ...` */ 100 | /* Usage: 101 | ```nix 102 | switch-if [ 103 | if-clause-1 104 | .. 105 | if-clause-k 106 | ] default-out 107 | ``` 108 | where a if-clause has the form `{ cond = b; out = r; }` 109 | the first branch such as `b` is true */ 110 | 111 | switch-if = c: d: (findFirst (getAttr "cond") {} c).out or d; 112 | 113 | /* Usage: 114 | ```nix 115 | switch x [ 116 | simple-clause-1 117 | .. 118 | simple-clause-k 119 | ] default-out 120 | ``` 121 | where a simple-clause has the form `{ case = p; out = r; }` 122 | the first branch such as `p x` is true 123 | or 124 | ```nix 125 | switch [ x1 .. xn ] [ 126 | complex-clause-1 127 | .. 128 | complex-clause-k 129 | ] default-out 130 | ``` 131 | where a complex-clause is either a simple-clause 132 | or has the form { cases = [ p1 .. pn ]; out = r; } 133 | in which case the first branch such as all `pi x` are true 134 | 135 | if the variables p are not functions, 136 | they are converted to a equal p 137 | if out is missing the default-out is taken */ 138 | 139 | switch = var: clauses: default: with pred; let 140 | compare = f: if isFunction f then f else equal f; 141 | combine = cl: var: 142 | if cl?case then compare cl.case var 143 | else all (equal true) (zipListsWith compare cl.cases var); in 144 | switch-if (map (cl: { cond = combine cl var; inherit (cl) out; }) clauses) default; 145 | }) 146 | -------------------------------------------------------------------------------- /build-support/coq/meta-fetch/default.nix: -------------------------------------------------------------------------------- 1 | { lib, stdenv, fetchzip }@args: 2 | let lib' = lib; in 3 | let lib = import ../extra-lib.nix {lib = lib';}; in 4 | with builtins; with lib; 5 | let 6 | default-fetcher = {domain ? "github.com", owner ? "", repo, rev, name ? "source", sha256 ? null, ...}@args: 7 | let ext = if args?sha256 then "zip" else "tar.gz"; 8 | fmt = if args?sha256 then "zip" else "tarball"; 9 | pr = match "^#(.*)$" rev; 10 | url = switch-if [ 11 | { cond = isNull pr && !isNull (match "^github.*" domain); 12 | out = "https://${domain}/${owner}/${repo}/archive/${rev}.${ext}"; } 13 | { cond = !isNull pr && !isNull (match "^github.*" domain); 14 | out = "https://api.${domain}/repos/${owner}/${repo}/${fmt}/pull/${head pr}/head"; } 15 | { cond = isNull pr && !isNull (match "^gitlab.*" domain); 16 | out = "https://${domain}/${owner}/${repo}/-/archive/${rev}/${repo}-${rev}.${ext}"; } 17 | { cond = !isNull (match "(www.)?mpi-sws.org" domain); 18 | out = "https://www.mpi-sws.org/~${owner}/${repo}/download/${repo}-${rev}.${ext}";} 19 | ] (throw "meta-fetch: no fetcher found for domain ${domain} on ${rev}"); 20 | fetch = x: if args?sha256 then fetchzip (x // { inherit sha256; }) else fetchTarball x; 21 | in fetch { inherit url ; }; 22 | in 23 | { 24 | fetcher ? default-fetcher, 25 | location, 26 | release ? {}, 27 | releaseRev ? (v: v), 28 | }: 29 | let isVersion = x: isString x && match "^/.*" x == null && release?${x}; 30 | shortVersion = x: if (isString x && match "^/.*" x == null) 31 | then findFirst (v: versions.majorMinor v == x) null 32 | (sort versionAtLeast (attrNames release)) 33 | else null; 34 | isShortVersion = x: shortVersion x != null; 35 | isPathString = x: isString x && match "^/.*" x != null && pathExists x; in 36 | arg: 37 | switch arg [ 38 | { case = isNull; out = { version = "broken"; src = ""; broken = true; }; } 39 | { case = isPathString; out = { version = "dev"; src = arg; }; } 40 | { case = pred.union isVersion isShortVersion; 41 | out = let v = if isVersion arg then arg else shortVersion arg; in 42 | let 43 | given-sha256 = release.${v}.sha256 or ""; 44 | sha256 = if given-sha256 == "" then lib.fakeSha256 else given-sha256; 45 | rv = release.${v} // { inherit sha256; }; in 46 | { 47 | version = rv.version or v; 48 | src = rv.src or fetcher (location // { rev = releaseRev v; } // rv); 49 | }; 50 | } 51 | { case = isString; 52 | out = let 53 | splitted = filter isString (split ":" arg); 54 | rev = last splitted; 55 | has-owner = length splitted > 1; 56 | version = "dev"; in { 57 | inherit version; 58 | src = fetcher (location // { inherit rev; } // 59 | (optionalAttrs has-owner { owner = head splitted; })); 60 | }; } 61 | { case = isAttrs; 62 | out = let 63 | { version = arg.version or "dev"; 64 | src = (arg.fetcher or fetcher) (location // (arg.location or {})); 65 | }; } 66 | { case = isPath; 67 | out = { 68 | version = "dev" ; 69 | src = builtins.path {path = arg; name = location.name or "source";}; }; } 70 | ] (throw "not a valid source description") 71 | -------------------------------------------------------------------------------- /coq-hierarchy-builder.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "coq-hierarchy-builder" 3 | version: "dev" 4 | maintainer: "Enrico Tassi " 5 | authors: [ "Cyril Cohen" "Kazuhiko Sakaguchi" "Enrico Tassi" ] 6 | license: "MIT" 7 | homepage: "https://github.com/math-comp/hierarchy-builder" 8 | bug-reports: "https://github.com/math-comp/hierarchy-builder/issues" 9 | dev-repo: "git+https://github.com/math-comp/hierarchy-builder" 10 | 11 | depends: [ 12 | "coq-core" 13 | "rocq-hierarchy-builder" {= version} 14 | ] 15 | 16 | synopsis: "Compatibility package for rocq-hierarchy-builder" 17 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, 2 | update-nixpkgs ? false, ci-matrix ? false, 3 | override ? {}, ocaml-override ? {}, global-override ? {}, 4 | bundle ? null, job ? null, inNixShell ? null, src ? ./., 5 | }@args: 6 | let auto = fetchGit { 7 | url = "https://github.com/rocq-community/coq-nix-toolbox.git"; 8 | ref = "master"; 9 | rev = import .nix/coq-nix-toolbox.nix; 10 | }; 11 | in 12 | import auto ({inherit src;} // args) 13 | -------------------------------------------------------------------------------- /examples/GReTA_talk/V1.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_monoid (M : Type) := { 5 | zero : M; 6 | add : M -> M -> M; 7 | addrA : associative add; (* add is associative. *) 8 | add0r : forall x, add zero x = x; (* zero is neutral *) 9 | addr0 : forall x, add x zero = x; (* wrt add. *) 10 | }. 11 | 12 | HB.structure Definition Monoid := { M of is_monoid M }. 13 | 14 | HB.instance Definition Z_is_monoid : is_monoid Z := 15 | is_monoid.Build Z 0%Z Z.add Z.add_assoc Z.add_0_l Z.add_0_r. -------------------------------------------------------------------------------- /examples/GReTA_talk/V2.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_semigroup (S : Type) := { 5 | add : S -> S -> S; 6 | addrA : associative add; 7 | }. 8 | HB.structure Definition SemiGroup := 9 | { S of is_semigroup S }. 10 | 11 | HB.mixin Record semigroup_is_monoid M of is_semigroup M := { 12 | zero : M; 13 | add0r : forall x, add zero x = x; 14 | addr0 : forall x, add x zero = x; 15 | }. 16 | HB.structure Definition Monoid := 17 | { M of is_semigroup M & semigroup_is_monoid M }. 18 | 19 | (* is_monoid does not exist anymore *) 20 | Fail Check is_monoid. 21 | 22 | HB.instance Definition Z_is_monoid : is_monoid Z := 23 | is_monoid.Build Z 0%Z Z.add Z.add_assoc Z.add_0_l Z.add_0_r. 24 | HB.mixin Record xxxx P A := { F : bool }. 25 | -------------------------------------------------------------------------------- /examples/GReTA_talk/V3.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_semigroup (S : Type) := { 5 | add : S -> S -> S; 6 | addrA : associative add; 7 | }. 8 | HB.structure Definition SemiGroup := 9 | { S & is_semigroup S }. 10 | 11 | HB.mixin Record semigroup_is_monoid M of is_semigroup M := { 12 | zero : M; 13 | add0r : forall x, add zero x = x; 14 | addr0 : forall x, add x zero = x; 15 | }. 16 | 17 | HB.factory Record is_monoid (M : Type) := { 18 | zero : M; 19 | add : M -> M -> M; 20 | addrA : associative add; 21 | add0r : forall x, add zero x = x; 22 | addr0 : forall x, add x zero = x; 23 | }. 24 | HB.builders Context (M : Type) (f : is_monoid M). 25 | HB.instance Definition _ : is_semigroup M := 26 | is_semigroup.Build M add addrA. 27 | HB.instance Definition _ : semigroup_is_monoid M := 28 | semigroup_is_monoid.Build M zero add0r addr0. 29 | HB.end. 30 | 31 | HB.structure Definition Monoid := 32 | { M & is_monoid M }. 33 | 34 | HB.instance Definition Z_is_monoid : is_monoid Z := 35 | is_monoid.Build Z 0%Z Z.add 36 | Z.add_assoc Z.add_0_l Z.add_0_r. 37 | -------------------------------------------------------------------------------- /examples/GReTA_talk/V4.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_semigroup (S : Type) := { 5 | add : S -> S -> S; 6 | addrA : associative add; 7 | }. 8 | HB.structure Definition SemiGroup := { S & is_semigroup S }. 9 | 10 | HB.mixin Record semigroup_is_monoid M of is_semigroup M := { 11 | zero : M; 12 | add0r : forall x, add zero x = x; 13 | addr0 : forall x, add x zero = x; 14 | }. 15 | 16 | HB.factory Record is_monoid M := { 17 | zero : M; 18 | add : M -> M -> M; 19 | addrA : associative add; 20 | add0r : forall x, add zero x = x; 21 | addr0 : forall x, add x zero = x; 22 | }. 23 | HB.builders Context (M : Type) of is_monoid M. 24 | HB.instance Definition _ := is_semigroup.Build M add addrA. 25 | HB.instance Definition _ := semigroup_is_monoid.Build M zero add0r addr0. 26 | HB.end. 27 | 28 | HB.structure Definition Monoid := { M & is_monoid M }. 29 | 30 | HB.mixin Record monoid_is_group G of is_monoid G := { 31 | opp : G -> G; 32 | subrr : forall x, add x (opp x) = zero; 33 | addNr : forall x, add (opp x) x = zero; 34 | }. 35 | 36 | HB.factory Record is_group G := { 37 | zero : G; 38 | add : G -> G -> G; 39 | opp : G -> G; 40 | addrA : associative add; 41 | add0r : forall x, add zero x = x; 42 | (* addr0 : forall x, add x zero = x; (* spurious *) *) 43 | subrr : forall x, add x (opp x) = zero; 44 | addNr : forall x, add (opp x) x = zero; 45 | }. 46 | HB.builders Context G of is_group G. 47 | Let addr0 : forall x, add x zero = x. 48 | Proof. by move=> x; rewrite -(addNr x) addrA subrr add0r. Qed. 49 | HB.instance Definition _ := is_monoid.Build G zero add addrA add0r addr0. 50 | HB.instance Definition _ := monoid_is_group.Build G opp subrr addNr. 51 | HB.end. 52 | 53 | HB.instance Definition Z_is_group : is_group Z := 54 | is_group.Build Z 0%Z Z.add Z.opp 55 | Z.add_assoc Z.add_0_l (* Z.add_0_r (*spurious *) *) 56 | Z.sub_diag Z.add_opp_diag_l. -------------------------------------------------------------------------------- /examples/demo3/hierarchy_0.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | From Corelib Require Import ssreflect ssrfun. 3 | 4 | HB.mixin Record MulMonoid_of_Type A := { 5 | one : A; 6 | mul : A -> A -> A; 7 | mulrA : associative mul; 8 | mul1r : left_id one mul; 9 | mulr1 : right_id one mul; 10 | }. 11 | HB.structure Definition MulMonoid := { A of MulMonoid_of_Type A }. 12 | 13 | HB.mixin Record Ring_of_MulMonoid A of MulMonoid A := { 14 | zero : A; 15 | add : A -> A -> A; 16 | addrA : associative add; 17 | add0r : left_id zero add; 18 | addr0 : right_id zero add; 19 | opp : A -> A; 20 | addrC : commutative (add : A -> A -> A); 21 | addNr : left_inverse zero opp add; 22 | mulrDl : left_distributive mul add; 23 | mulrDr : right_distributive mul add; 24 | }. 25 | HB.structure Definition Ring := { A of MulMonoid A & Ring_of_MulMonoid A }. 26 | -------------------------------------------------------------------------------- /examples/demo3/hierarchy_1.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record MulMonoid_of_Type A := { 5 | one : A; 6 | mul : A -> A -> A; 7 | mulrA : associative mul; 8 | mul1r : left_id one mul; 9 | mulr1 : right_id one mul; 10 | }. 11 | HB.structure Definition MulMonoid := { A of MulMonoid_of_Type A }. 12 | 13 | HB.mixin Record AddMonoid_of_Type A := { 14 | zero : A; 15 | add : A -> A -> A; 16 | addrA : associative add; 17 | add0r : left_id zero add; 18 | addr0 : right_id zero add; 19 | }. 20 | HB.structure Definition AddMonoid := { A of AddMonoid_of_Type A }. 21 | 22 | HB.mixin Record Ring_of_AddMulMonoid A of MulMonoid A & AddMonoid A := { 23 | opp : A -> A; 24 | addrC : commutative (add : A -> A -> A); 25 | addNr : left_inverse zero opp add; 26 | mulrDl : left_distributive mul (add : A -> A -> A); 27 | mulrDr : right_distributive mul (add : A -> A -> A); 28 | }. 29 | HB.structure Definition Ring := { A of MulMonoid A & AddMonoid A & Ring_of_AddMulMonoid A }. 30 | 31 | HB.factory Record Ring_of_MulMonoid A of MulMonoid A := { 32 | zero : A; 33 | add : A -> A -> A; 34 | addrA : associative add; 35 | add0r : left_id zero add; 36 | addr0 : right_id zero add; 37 | opp : A -> A; 38 | addrC : commutative (add : A -> A -> A); 39 | addNr : left_inverse zero opp add; 40 | mulrDl : left_distributive mul add; 41 | mulrDr : right_distributive mul add; 42 | }. 43 | 44 | HB.builders Context A (a : Ring_of_MulMonoid A). 45 | 46 | HB.instance 47 | Definition to_AddMonoid_of_Type := 48 | AddMonoid_of_Type.Build A zero add addrA add0r addr0. 49 | 50 | HB.instance 51 | Definition to_Ring_of_AddMulMonoid := 52 | Ring_of_AddMulMonoid.Build A opp addrC addNr mulrDl mulrDr. 53 | 54 | HB.end. 55 | -------------------------------------------------------------------------------- /examples/demo3/hierarchy_2.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record MulMonoid_of_Type A := { 5 | one : A; 6 | mul : A -> A -> A; 7 | mulrA : associative mul; 8 | mul1r : left_id one mul; 9 | mulr1 : right_id one mul; 10 | }. 11 | HB.structure Definition MulMonoid := { A of MulMonoid_of_Type A }. 12 | 13 | HB.mixin Record AddMonoid_of_Type A := { 14 | zero : A; 15 | add : A -> A -> A; 16 | addrA : associative add; 17 | add0r : left_id zero add; 18 | addr0 : right_id zero add; 19 | }. 20 | HB.structure Definition AddMonoid := { A of AddMonoid_of_Type A }. 21 | 22 | HB.mixin Record AbGroup_of_AddMonoid A of AddMonoid A := { 23 | opp : A -> A; 24 | addrC : commutative (add : A -> A -> A); 25 | addNr : left_inverse zero opp add; 26 | }. 27 | HB.structure Definition AbGroup := { A of AddMonoid A & AbGroup_of_AddMonoid A }. 28 | 29 | HB.mixin Record Ring_of_AbGroupMulMonoid A of MulMonoid A & AbGroup A := { 30 | mulrDl : left_distributive mul (add : A -> A -> A); 31 | mulrDr : right_distributive mul (add : A -> A -> A); 32 | }. 33 | HB.structure Definition Ring := { A of MulMonoid A & AbGroup A & Ring_of_AbGroupMulMonoid A }. 34 | 35 | HB.factory Record Ring_of_AddMulMonoid A of MulMonoid A & AddMonoid A := { 36 | opp : A -> A; 37 | addrC : commutative (add : A -> A -> A); 38 | addNr : left_inverse zero opp add; 39 | mulrDl : left_distributive mul (add : A -> A -> A); 40 | mulrDr : right_distributive mul (add : A -> A -> A); 41 | }. 42 | 43 | HB.builders Context A (a : Ring_of_AddMulMonoid A). 44 | 45 | HB.instance 46 | Definition to_AbGroup_of_AddMonoid := 47 | AbGroup_of_AddMonoid.Build A opp addrC addNr. 48 | 49 | HB.instance 50 | Definition to_Ring_of_AbGroupMulMonoid := 51 | Ring_of_AbGroupMulMonoid.Build A mulrDl mulrDr. 52 | 53 | HB.end. 54 | 55 | HB.factory Record Ring_of_MulMonoid A of MulMonoid A := { 56 | zero : A; 57 | add : A -> A -> A; 58 | addrA : associative add; 59 | add0r : left_id zero add; 60 | addr0 : right_id zero add; 61 | opp : A -> A; 62 | addrC : commutative (add : A -> A -> A); 63 | addNr : left_inverse zero opp add; 64 | mulrDl : left_distributive mul add; 65 | mulrDr : right_distributive mul add; 66 | }. 67 | 68 | HB.builders Context A (a : Ring_of_MulMonoid A). 69 | 70 | HB.instance 71 | Definition to_AddMonoid_of_Type := 72 | AddMonoid_of_Type.Build A zero add addrA add0r addr0. 73 | 74 | HB.instance 75 | Definition to_AbGroup_of_AddMonoid := 76 | AbGroup_of_AddMonoid.Build A opp addrC addNr. 77 | 78 | HB.instance 79 | Definition to_Ring_of_AddMulMonoid := 80 | Ring_of_AddMulMonoid.Build A opp addrC addNr mulrDl mulrDr. 81 | 82 | HB.end. 83 | -------------------------------------------------------------------------------- /examples/demo3/test_0_0.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From Corelib Require Import BinNums IntDef. 3 | From HB Require Import structures. 4 | From HB Require Import demo3.hierarchy_0. 5 | 6 | Declare Scope hb_scope. 7 | Delimit Scope hb_scope with G. 8 | Local Open Scope hb_scope. 9 | Notation "0" := zero : hb_scope. 10 | Notation "1" := one : hb_scope. 11 | Infix "+" := (@add _) : hb_scope. 12 | Notation "- x" := (@opp _ x) : hb_scope. 13 | Infix "*" := (@mul _) : hb_scope. 14 | Notation "x - y" := (x + - y) : hb_scope. 15 | 16 | (* Theory *) 17 | 18 | Section Theory. 19 | Variable R : Ring.type. 20 | Implicit Type (x : R). 21 | 22 | (* 23 | Lemma addr0 : right_id (@zero R) add. 24 | Proof. by move=> x; rewrite addrC add0r. Qed. 25 | *) 26 | 27 | Lemma addrN : right_inverse (@zero R) opp add. 28 | Proof. by move=> x; rewrite addrC addNr. Qed. 29 | 30 | Lemma subrr x : x - x = 0. 31 | Proof. by rewrite addrN. Qed. 32 | 33 | Lemma addrNK x y : x + y - y = x. 34 | Proof. by rewrite -addrA subrr addr0. Qed. 35 | 36 | End Theory. 37 | 38 | (* Instance *) 39 | 40 | Axiom Z_mul_assoc : forall x y z, Z.mul x (Z.mul y z) = Z.mul (Z.mul x y) z. 41 | Axiom Z_mul_1_l : forall x, Z.mul (Zpos xH) x = x. 42 | Axiom Z_mul_1_r : forall x, Z.mul x (Zpos xH) = x. 43 | 44 | HB.instance Definition Z_mulmonoid_axioms := 45 | MulMonoid_of_Type.Build Z (Zpos xH) Z.mul Z_mul_assoc Z_mul_1_l Z_mul_1_r. 46 | 47 | Axiom Z_add_assoc : forall x y z, Z.add x (Z.add y z) = Z.add (Z.add x y) z. 48 | Axiom Z_add_comm : forall x y, Z.add x y = Z.add y x. 49 | Axiom Z_add_0_l : forall x, Z.add Z0 x = x. 50 | Axiom Z_add_0_r : forall x, Z.add x Z0 = x. 51 | Axiom Z_add_opp_diag_l : forall x, Z.add (Z.opp x) x = Z0. 52 | Axiom Z_mul_add_distr_l : 53 | forall x y z, Z.mul x (Z.add y z) = Z.add (Z.mul x y) (Z.mul x z). 54 | Axiom Z_mul_add_distr_r : 55 | forall x y z, Z.mul (Z.add x y) z = Z.add (Z.mul x z) (Z.mul y z). 56 | 57 | HB.instance Definition Z_ring_axioms := 58 | Ring_of_MulMonoid.Build Z Z0 Z.add 59 | Z_add_assoc Z_add_0_l Z_add_0_r 60 | Z.opp Z_add_comm Z_add_opp_diag_l 61 | Z_mul_add_distr_r Z_mul_add_distr_l. 62 | -------------------------------------------------------------------------------- /examples/demo3/test_1_0.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From Corelib Require Import BinNums IntDef. 3 | From HB Require Import structures. 4 | From HB Require Import demo3.hierarchy_1. 5 | 6 | Declare Scope hb_scope. 7 | Delimit Scope hb_scope with G. 8 | Local Open Scope hb_scope. 9 | Notation "0" := zero : hb_scope. 10 | Notation "1" := one : hb_scope. 11 | Infix "+" := (@add _) : hb_scope. 12 | Notation "- x" := (@opp _ x) : hb_scope. 13 | Infix "*" := (@mul _) : hb_scope. 14 | Notation "x - y" := (x + - y) : hb_scope. 15 | 16 | (* Theory *) 17 | 18 | Section Theory. 19 | Variable R : Ring.type. 20 | Implicit Type (x : R). 21 | 22 | (* 23 | Lemma addr0 : right_id (@zero R) add. 24 | Proof. by move=> x; rewrite addrC add0r. Qed. 25 | *) 26 | 27 | Lemma addrN : right_inverse (@zero R) opp add. 28 | Proof. by move=> x; rewrite addrC addNr. Qed. 29 | 30 | Lemma subrr x : x - x = 0. 31 | Proof. by rewrite addrN. Qed. 32 | 33 | Lemma addrNK x y : x + y - y = x. 34 | Proof. by rewrite -addrA subrr addr0. Qed. 35 | 36 | End Theory. 37 | 38 | (* Instance *) 39 | 40 | Axiom Z_mul_assoc : forall x y z, Z.mul x (Z.mul y z) = Z.mul (Z.mul x y) z. 41 | Axiom Z_mul_1_l : forall x, Z.mul (Zpos xH) x = x. 42 | Axiom Z_mul_1_r : forall x, Z.mul x (Zpos xH) = x. 43 | 44 | HB.instance 45 | Definition Z_mulmonoid_axioms := 46 | MulMonoid_of_Type.Build Z (Zpos xH) Z.mul Z_mul_assoc Z_mul_1_l Z_mul_1_r. 47 | 48 | Axiom Z_add_assoc : forall x y z, Z.add x (Z.add y z) = Z.add (Z.add x y) z. 49 | Axiom Z_add_comm : forall x y, Z.add x y = Z.add y x. 50 | Axiom Z_add_0_l : forall x, Z.add Z0 x = x. 51 | Axiom Z_add_0_r : forall x, Z.add x Z0 = x. 52 | Axiom Z_add_opp_diag_l : forall x, Z.add (Z.opp x) x = Z0. 53 | Axiom Z_mul_add_distr_l : 54 | forall x y z, Z.mul x (Z.add y z) = Z.add (Z.mul x y) (Z.mul x z). 55 | Axiom Z_mul_add_distr_r : 56 | forall x y z, Z.mul (Z.add x y) z = Z.add (Z.mul x z) (Z.mul y z). 57 | 58 | HB.instance 59 | Definition Z_ring_axioms := 60 | Ring_of_MulMonoid.Build Z Z0 Z.add 61 | Z_add_assoc Z_add_0_l Z_add_0_r 62 | Z.opp Z_add_comm Z_add_opp_diag_l 63 | Z_mul_add_distr_r Z_mul_add_distr_l. 64 | -------------------------------------------------------------------------------- /examples/demo3/test_2_0.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From Corelib Require Import BinNums IntDef. 3 | From HB Require Import structures. 4 | From HB Require Import demo3.hierarchy_2. 5 | 6 | Declare Scope hb_scope. 7 | Delimit Scope hb_scope with G. 8 | Local Open Scope hb_scope. 9 | Notation "0" := zero : hb_scope. 10 | Notation "1" := one : hb_scope. 11 | Infix "+" := (@add _) : hb_scope. 12 | Notation "- x" := (@opp _ x) : hb_scope. 13 | Infix "*" := (@mul _) : hb_scope. 14 | Notation "x - y" := (x + - y) : hb_scope. 15 | 16 | (* Theory *) 17 | 18 | Section Theory. 19 | Variable R : Ring.type. 20 | Implicit Type (x : R). 21 | 22 | (* 23 | Lemma addr0 : right_id (@zero R) add. 24 | Proof. by move=> x; rewrite addrC add0r. Qed. 25 | *) 26 | 27 | Lemma addrN : right_inverse (@zero R) opp add. 28 | Proof. by move=> x; rewrite addrC addNr. Qed. 29 | 30 | Lemma subrr x : x - x = 0. 31 | Proof. by rewrite addrN. Qed. 32 | 33 | Lemma addrNK x y : x + y - y = x. 34 | Proof. by rewrite -addrA subrr addr0. Qed. 35 | 36 | End Theory. 37 | 38 | (* Instance *) 39 | 40 | Axiom Z_mul_assoc : forall x y z, Z.mul x (Z.mul y z) = Z.mul (Z.mul x y) z. 41 | Axiom Z_mul_1_l : forall x, Z.mul (Zpos xH) x = x. 42 | Axiom Z_mul_1_r : forall x, Z.mul x (Zpos xH) = x. 43 | 44 | HB.instance 45 | Definition Z_mulmonoid_axioms := 46 | MulMonoid_of_Type.Build Z (Zpos xH) Z.mul Z_mul_assoc Z_mul_1_l Z_mul_1_r. 47 | 48 | Axiom Z_add_assoc : forall x y z, Z.add x (Z.add y z) = Z.add (Z.add x y) z. 49 | Axiom Z_add_comm : forall x y, Z.add x y = Z.add y x. 50 | Axiom Z_add_0_l : forall x, Z.add Z0 x = x. 51 | Axiom Z_add_0_r : forall x, Z.add x Z0 = x. 52 | Axiom Z_add_opp_diag_l : forall x, Z.add (Z.opp x) x = Z0. 53 | Axiom Z_mul_add_distr_l : 54 | forall x y z, Z.mul x (Z.add y z) = Z.add (Z.mul x y) (Z.mul x z). 55 | Axiom Z_mul_add_distr_r : 56 | forall x y z, Z.mul (Z.add x y) z = Z.add (Z.mul x z) (Z.mul y z). 57 | 58 | HB.instance 59 | Definition Z_ring_axioms := 60 | Ring_of_MulMonoid.Build Z Z0 Z.add 61 | Z_add_assoc Z_add_0_l Z_add_0_r 62 | Z.opp Z_add_comm Z_add_opp_diag_l 63 | Z_mul_add_distr_r Z_mul_add_distr_l. 64 | -------------------------------------------------------------------------------- /examples/demo3/user_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | From @@DEMO@@ Require Import @@HIERARCHY@@. 4 | 5 | Declare Scope hb_scope. 6 | Delimit Scope hb_scope with G. 7 | Local Open Scope hb_scope. 8 | Notation "0" := zero : hb_scope. 9 | Notation "1" := one : hb_scope. 10 | Infix "+" := (@add _) : hb_scope. 11 | Notation "- x" := (@opp _ x) : hb_scope. 12 | Infix "*" := (@mul _) : hb_scope. 13 | Notation "x - y" := (x + - y) : hb_scope. 14 | 15 | (* Theory *) 16 | 17 | Section Theory. 18 | Variable R : Ring.type. 19 | Implicit Type (x : R). 20 | 21 | (* 22 | Lemma addr0 : right_id (@zero R) add. 23 | Proof. by move=> x; rewrite addrC add0r. Qed. 24 | *) 25 | 26 | Lemma addrN : right_inverse (@zero R) opp add. 27 | Proof. by move=> x; rewrite addrC addNr. Qed. 28 | 29 | Lemma subrr x : x - x = 0. 30 | Proof. by rewrite addrN. Qed. 31 | 32 | Lemma addrNK x y : x + y - y = x. 33 | Proof. by rewrite -addrA subrr addr0. Qed. 34 | 35 | End Theory. 36 | 37 | (* Instance *) 38 | 39 | Definition Z_mulmonoid_axioms := 40 | MulMonoid_of_Type.Build Z 1%Z Z.mul Z.mul_assoc Z.mul_1_l Z.mul_1_r. 41 | 42 | HB.instance Z Z_mulmonoid_axioms. 43 | 44 | Definition Z_ring_axioms := 45 | Ring_of_MulMonoid.Build Z 0%Z Z.add 46 | Z.add_assoc Z.add_0_l Z.add_0_r 47 | Z.opp Z.add_comm Z.add_opp_diag_l 48 | Z.mul_add_distr_r Z.mul_add_distr_l. 49 | 50 | HB.instance Z Z_ring_axioms. -------------------------------------------------------------------------------- /examples/demo4/hierarchy_0.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | #[key="A"] 4 | HB.mixin Record m1 (T : Type) (A : Type) := { 5 | inhab : A; 6 | inhab_param : T; 7 | }. 8 | HB.structure Definition s1 T := { A of m1 T A }. 9 | 10 | Check inhab. 11 | (* inhab : forall (T : Type) (A : s1.type T), s1.sort A *) 12 | 13 | HB.instance Definition nat_m1 := m1.Build bool nat 7 false. 14 | Check (refl_equal _ : @inhab _ _ = 7). 15 | 16 | HB.instance Definition list_m1 A := m1.Build (option A) (list nat) (cons 7 nil) None. 17 | Check (refl_equal _ : @inhab _ _ = (cons 7 nil)). 18 | 19 | HB.mixin Record m2 (T : Type) (A : Type) of m1 T A := { 20 | inj : T -> A; 21 | }. 22 | 23 | HB.structure Definition s2 T := 24 | { A of m1 T A & m2 T A }. 25 | 26 | Check fun X : s2.type nat => inhab : X. 27 | Check fun X : s2.type nat => inj : nat -> X. 28 | About s2_to_s1. -------------------------------------------------------------------------------- /examples/demo5/hierarchy_0.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record AddComoid_of_TYPE A := { 5 | zero : A; 6 | add : A -> A -> A; 7 | addrA : associative add; 8 | addrC : commutative add; 9 | add0r : left_id zero add; 10 | }. 11 | HB.structure Definition AddComoid := { A of AddComoid_of_TYPE A }. 12 | 13 | (* Begin change *) 14 | 15 | HB.mixin Record AddAG_of_AddComoid A of AddComoid A := { 16 | opp : A -> A; 17 | addNr : left_inverse zero opp add; 18 | }. 19 | HB.factory Record AddAG_of_TYPE A := { 20 | zero : A; 21 | add : A -> A -> A; 22 | opp : A -> A; 23 | addrA : associative add; 24 | addrC : commutative add; 25 | add0r : left_id zero add; 26 | addNr : left_inverse zero opp add; 27 | }. 28 | 29 | HB.builders Context A (a : AddAG_of_TYPE A). 30 | 31 | HB.instance 32 | Definition to_AddComoid_of_TYPE := 33 | AddComoid_of_TYPE.Build A zero add addrA addrC add0r. 34 | 35 | HB.instance 36 | Definition to_AddAG_of_AddComoid := 37 | AddAG_of_AddComoid.Build A _ addNr. 38 | 39 | HB.end. 40 | HB.structure Definition AddAG := { A of AddAG_of_TYPE A }. 41 | 42 | HB.mixin Record Ring_of_AddAG A of AddAG A := { 43 | one : A; 44 | mul : A -> A -> A; 45 | mulrA : associative mul; 46 | mul1r : left_id one mul; 47 | mulr1 : right_id one mul; 48 | mulrDl : left_distributive mul add; 49 | mulrDr : right_distributive mul add; 50 | }. 51 | HB.factory Record Ring_of_AddComoid A of AddComoid A := { 52 | opp : A -> A; 53 | one : A; 54 | mul : A -> A -> A; 55 | addNr : left_inverse zero opp add; 56 | mulrA : associative mul; 57 | mul1r : left_id one mul; 58 | mulr1 : right_id one mul; 59 | mulrDl : left_distributive mul add; 60 | mulrDr : right_distributive mul add; 61 | }. 62 | 63 | HB.builders Context A (a : Ring_of_AddComoid A). 64 | 65 | HB.instance 66 | Definition to_AddAG_of_AddComoid := AddAG_of_AddComoid.Build A _ addNr. 67 | 68 | HB.instance 69 | Definition to_Ring_of_AddAG := Ring_of_AddAG.Build A 70 | _ _ mulrA mul1r mulr1 mulrDl mulrDr. 71 | 72 | HB.end. 73 | 74 | (* End change *) 75 | 76 | HB.factory Record Ring_of_TYPE A := { 77 | zero : A; 78 | one : A; 79 | add : A -> A -> A; 80 | opp : A -> A; 81 | mul : A -> A -> A; 82 | addrA : associative add; 83 | addrC : commutative add; 84 | add0r : left_id zero add; 85 | addNr : left_inverse zero opp add; 86 | mulrA : associative mul; 87 | mul1r : left_id one mul; 88 | mulr1 : right_id one mul; 89 | mulrDl : left_distributive mul add; 90 | mulrDr : right_distributive mul add; 91 | }. 92 | 93 | HB.builders Context A (a : Ring_of_TYPE A). 94 | 95 | HB.instance 96 | Definition to_AddComoid_of_TYPE := AddComoid_of_TYPE.Build A 97 | zero add addrA addrC add0r. 98 | 99 | HB.instance 100 | Definition to_Ring_of_AddComoid := Ring_of_AddComoid.Build A 101 | _ _ _ addNr mulrA mul1r mulr1 mulrDl mulrDr. 102 | 103 | HB.end. 104 | 105 | HB.structure Definition Ring := { A of Ring_of_TYPE A }. 106 | 107 | (* Notations *) 108 | 109 | Declare Scope hb_scope. 110 | Delimit Scope hb_scope with G. 111 | Local Open Scope hb_scope. 112 | Notation "0" := zero : hb_scope. 113 | Notation "1" := one : hb_scope. 114 | Infix "+" := (@add _) : hb_scope. 115 | Notation "- x" := (@opp _ x) : hb_scope. 116 | Infix "*" := (@mul _) : hb_scope. 117 | Notation "x - y" := (x + - y) : hb_scope. 118 | 119 | (* Theory *) 120 | 121 | Section Theory. 122 | Variable R : Ring.type. 123 | Implicit Type (x : R). 124 | 125 | Lemma addr0 : right_id (@zero R) add. 126 | Proof. by move=> x; rewrite addrC add0r. Qed. 127 | 128 | Lemma addrN : right_inverse (@zero R) opp add. 129 | Proof. by move=> x; rewrite addrC addNr. Qed. 130 | 131 | Lemma subrr x : x - x = 0. 132 | Proof. by rewrite addrN. Qed. 133 | 134 | Lemma addrNK x y : x + y - y = x. 135 | Proof. by rewrite -addrA subrr addr0. Qed. 136 | 137 | End Theory. 138 | 139 | HB.mixin Record LModule_of_AG (R : Ring.type) (M : Type) of AddAG M := { 140 | scale : Ring.sort R -> M -> M; (* TODO: insert coercions automatically *) 141 | scaleDl : forall v, {morph scale^~ v: a b / a + b}; 142 | scaleDr : right_distributive scale add; 143 | scaleA : forall a b v, scale a (scale b v) = scale (a * b) v; 144 | scale1r : forall m, scale 1 m = m; 145 | }. 146 | HB.structure Definition LModule (R : Ring.type) := 147 | { M of LModule_of_AG R M & }. 148 | Infix "*:" := (@scale _ _) (at level 30) : hb_scope. 149 | 150 | Definition regular (R : Type) := R. 151 | 152 | HB.instance Definition regular_AG (R : AddAG.type) := 153 | AddAG_of_TYPE.Build (regular (AddAG.sort R)) zero add opp addrA addrC add0r addNr. 154 | 155 | HB.instance Definition regular_LModule (R : Ring.type) := 156 | LModule_of_AG.Build R (regular (Ring.sort R)) mul 157 | (fun _ _ _ => mulrDl _ _ _) mulrDr mulrA mul1r. 158 | 159 | From Corelib Require Import BinNums IntDef. 160 | 161 | Axiom Z_add_assoc : forall x y z, Z.add x (Z.add y z) = Z.add (Z.add x y) z. 162 | Axiom Z_add_comm : forall x y, Z.add x y = Z.add y x. 163 | Axiom Z_add_0_l : forall x, Z.add Z0 x = x. 164 | Axiom Z_add_0_r : forall x, Z.add x Z0 = x. 165 | Axiom Z_add_opp_diag_l : forall x, Z.add (Z.opp x) x = Z0. 166 | Axiom Z_mul_add_distr_l : 167 | forall x y z, Z.mul x (Z.add y z) = Z.add (Z.mul x y) (Z.mul x z). 168 | Axiom Z_mul_add_distr_r : 169 | forall x y z, Z.mul (Z.add x y) z = Z.add (Z.mul x z) (Z.mul y z). 170 | Axiom Z_mul_assoc : forall x y z, Z.mul x (Z.mul y z) = Z.mul (Z.mul x y) z. 171 | Axiom Z_mul_1_l : forall x, Z.mul (Zpos xH) x = x. 172 | Axiom Z_mul_1_r : forall x, Z.mul x (Zpos xH) = x. 173 | 174 | HB.instance Definition Z_ring_axioms := 175 | Ring_of_TYPE.Build Z Z0 (Zpos xH) Z.add Z.opp Z.mul 176 | Z_add_assoc Z_add_comm Z_add_0_l Z_add_opp_diag_l 177 | Z_mul_assoc Z_mul_1_l Z_mul_1_r 178 | Z_mul_add_distr_r Z_mul_add_distr_l. 179 | 180 | Lemma test (m : Z) (n : regular Z) : m *: n = m * n. 181 | Proof. by []. Qed. 182 | -------------------------------------------------------------------------------- /examples/readme.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | From Corelib Require Import ssreflect BinNums IntDef. 3 | 4 | #[verbose, log] 5 | HB.mixin Record AddComoid_of_Type A := { 6 | zero : A; 7 | add : A -> A -> A; 8 | addrA : forall x y z, add x (add y z) = add (add x y) z; 9 | addrC : forall x y, add x y = add y x; 10 | add0r : forall x, add zero x = x; 11 | }. 12 | #[verbose, log(raw)] 13 | HB.structure Definition AddComoid := { A of AddComoid_of_Type A }. 14 | 15 | Notation "0" := zero. 16 | Infix "+" := add. 17 | 18 | Check forall (M : AddComoid.type) (x : M), x + x = 0. 19 | 20 | HB.mixin Record AbelianGrp_of_AddComoid A of AddComoid_of_Type A := { 21 | opp : A -> A; 22 | addNr : forall x, opp x + x = 0; 23 | }. 24 | HB.structure Definition AbelianGrp := { A of AbelianGrp_of_AddComoid A & }. 25 | 26 | Notation "- x" := (opp x). 27 | 28 | Lemma example (G : AbelianGrp.type) (x : G) : x + (- x) = - 0. 29 | Proof. by rewrite addrC addNr -[LHS](addNr zero) addrC add0r. Qed. 30 | 31 | Axiom Z_add_assoc : forall x y z, Z.add x (Z.add y z) = Z.add (Z.add x y) z. 32 | Axiom Z_add_comm : forall x y, Z.add x y = Z.add y x. 33 | Axiom Z_add_0_l : forall x, Z.add Z0 x = x. 34 | Axiom Z_add_opp_diag_l : forall x, Z.add (Z.opp x) x = Z0. 35 | 36 | HB.instance Definition Z_CoMoid := AddComoid_of_Type.Build Z Z0 Z.add Z_add_assoc Z_add_comm Z_add_0_l. 37 | HB.instance Definition Z_AbGrp := AbelianGrp_of_AddComoid.Build Z Z.opp Z_add_opp_diag_l. 38 | 39 | Lemma example2 (x : Z) : x + (- x) = - 0. 40 | Proof. by rewrite example. Qed. 41 | 42 | Check AbelianGrp.on Z. 43 | 44 | HB.graph "readme.dot". 45 | HB.about Z. 46 | 47 | Section Test. 48 | HB.declare Context (T : Type) (p : AddComoid_of_Type T) (q : AbelianGrp_of_AddComoid T). 49 | 50 | Goal forall x : T, x + -x = 0. 51 | Abort. 52 | 53 | End Test. 54 | -------------------------------------------------------------------------------- /examples_stdlib/Coq2020_material/CoqWS_abstract.v: -------------------------------------------------------------------------------- 1 | (* Accompanying material to Coq workshop presentation *) 2 | From Coq Require Import ssreflect ssrfun ZArith. 3 | From HB Require Import structures. 4 | 5 | HB.mixin Record CMonoid_of_Type A := { (* The set of axioms making A a commutative monoid. *) 6 | zero : A; add : A -> A -> A; 7 | addrA : associative add; (* `add` is associative *) 8 | addrC : commutative add; (* `add` is commutative *) 9 | add0r : left_id zero add; (* `zero` is a neutral element *) 10 | }. 11 | HB.structure Definition CMonoid := { A of CMonoid_of_Type A }. (* The structure thereof. *) 12 | Notation "0" := zero. 13 | Infix "+" := add. 14 | 15 | (* The type of the operations and axioms depend on a CMonoid.type structure. *) 16 | Check addrC. (* ?M : CMonoid.type |- commutative (@add ?M) *) 17 | 18 | HB.mixin Record AbelianGrp_of_CMonoid A of CMonoid A := { 19 | opp : A -> A; 20 | (* We can write `add` here since A is a CMonoid *) 21 | addNr : left_inverse zero opp add; (* `opp` is the additive inverse *) 22 | }. 23 | HB.structure Definition AbelianGrp := { A of AbelianGrp_of_CMonoid A }. 24 | Notation "- x" := (opp x). 25 | Notation "x - y" := (add x (opp y)). 26 | 27 | HB.mixin Record SemiRing_of_CMonoid A of CMonoid A := { 28 | one : A; 29 | mul : A -> A -> A; 30 | mulrA : associative mul; (* `mul` is associative *) 31 | mul1r : left_id one mul; (* `one` is left neutral *) 32 | mulr1 : right_id one mul; (* `one` is right neutral *) 33 | mulrDl : left_distributive mul add; (* `mul` distributes over *) 34 | mulrDr : right_distributive mul add; (* `add` on both sides *) 35 | mul0r : left_zero zero mul; (* `zero` is absorbing `mul` *) 36 | mulr0 : right_zero zero mul; (* on both sides *) 37 | }. 38 | HB.structure Definition SemiRing := { A of SemiRing_of_CMonoid A }. 39 | Notation "1" := one. 40 | Infix "*" := mul. 41 | 42 | (* We need no additional mixin to declare the Ring structure. *) 43 | HB.structure Definition Ring := { A of SemiRing_of_CMonoid A & AbelianGrp_of_CMonoid A }. 44 | 45 | (* An example statement in the signature of an Abelian group G, combining 0 and -. *) 46 | Check forall G : AbelianGrp.type, forall x : G, x - x = 0. 47 | (* An example statement in the signature of a Semiring S, combining 0, +, and *. *) 48 | Check forall S : SemiRing.type, forall x : S, x * 1 + 0 = x. 49 | (* An example statement in the signature of a Ring R, combining -, 1 and *. *) 50 | Check forall R : Ring.type, forall x y : R, x * - (1 * y) = - x * y. 51 | 52 | HB.instance Definition Z_CMonoid := CMonoid_of_Type.Build Z 0%Z Z.add 53 | Z.add_assoc Z.add_comm Z.add_0_l. 54 | HB.instance Definition Z_AbelianGrp := AbelianGrp_of_CMonoid.Build Z Z.opp Z.add_opp_diag_l. 55 | HB.instance Definition Z_SemiRing := SemiRing_of_CMonoid.Build Z 1%Z Z.mul 56 | Z.mul_assoc Z.mul_1_l Z.mul_1_r Z.mul_add_distr_r Z.mul_add_distr_l Z.mul_0_l Z.mul_0_r. 57 | 58 | (* An example statement in the signature of the Z ring, combining Z, 0, +, -, 1 and * *) 59 | Check forall x : Z, x * - (1 + x) = 0 + 1. 60 | -------------------------------------------------------------------------------- /examples_stdlib/Coq2020_material/CoqWS_expansion/withHB.v: -------------------------------------------------------------------------------- 1 | (* Accompanying material to Coq workshop presentation *) 2 | From Coq Require Import ssreflect ssrfun ZArith. 3 | From HB Require Import structures. 4 | Set Warnings "-redundant-canonical-projection". 5 | 6 | HB.mixin 7 | Record CMonoid_of_Type A := { 8 | zero : A; 9 | add : A -> A -> A; 10 | addrA : associative add; 11 | addrC : commutative add; 12 | add0r : left_id zero add; 13 | }. 14 | 15 | HB.structure 16 | Definition CMonoid := { A of CMonoid_of_Type A }. 17 | 18 | HB.mixin 19 | Record AbelianGrp_of_CMonoid A of CMonoid A := { 20 | opp : A -> A; 21 | addNr : left_inverse zero opp add; 22 | }. 23 | 24 | HB.structure 25 | Definition AbelianGrp := { A of AbelianGrp_of_CMonoid A & }. 26 | -------------------------------------------------------------------------------- /examples_stdlib/Coq2020_material/CoqWS_expansion/withoutHB.v: -------------------------------------------------------------------------------- 1 | (* Accompanying material to Coq workshop presentation *) 2 | From Coq Require Import ssreflect ssrfun ZArith. 3 | From HB Require Import structures. 4 | Set Warnings "-redundant-canonical-projection". 5 | 6 | (* Helpers *) 7 | Notation "[unify t1 'with' t2 ]" := (unify _ _ t1 t2 _) 8 | (at level 0, format "[unify t1 'with' t2 ]", only printing). 9 | Notation "[unify t1 'with' t2 ]" := (unify _ _ t1 t2 NoMsg) 10 | (at level 0, format "[unify t1 'with' t2 ]", only parsing). 11 | 12 | Module CMonoid_of_Type. 13 | Section CMonoid_of_Type. 14 | Variable (A : Type). 15 | 16 | Record axioms_ : Type := Axioms_ { 17 | zero : A; 18 | add : A -> A -> A; 19 | addrA : associative add; 20 | addrC : commutative add; 21 | add0r : left_id zero add 22 | }. 23 | 24 | Definition phant_Build (zero : A) (add : A -> A -> A) 25 | (addrA : associative add) (addrC : commutative add) := 26 | [eta CMonoid_of_Type.Axioms_ zero add addrA addrC]. 27 | 28 | Definition phant_axioms := CMonoid_of_Type.axioms_. 29 | 30 | End CMonoid_of_Type. 31 | 32 | Notation Build A := (phant_Build A). 33 | Notation axioms A := (phant_axioms A). 34 | 35 | Module Exports. 36 | Notation CMonoid_of_Type A := (axioms A). 37 | End Exports. 38 | End CMonoid_of_Type. 39 | Export CMonoid_of_Type.Exports. 40 | 41 | Module CMonoid. 42 | 43 | Record axioms (A : Type) : Type := Class 44 | { CMonoid_of_Type_mixin : CMonoid_of_Type.axioms_ A }. 45 | 46 | Record type : Type := Pack { sort : Type; class : axioms sort }. 47 | 48 | Module Exports. 49 | 50 | Coercion sort : type >-> Sortclass. 51 | 52 | Definition zero {s : type} := CMonoid_of_Type.zero _ 53 | (CMonoid_of_Type_mixin _ (class s)). 54 | 55 | Definition add {s : type} (x y : s) : s := CMonoid_of_Type.add _ 56 | (CMonoid_of_Type_mixin _ (class s)) x y. 57 | 58 | Definition addrA {s : type} : associative add := 59 | CMonoid_of_Type.addrA _ (CMonoid_of_Type_mixin _ (class s)). 60 | 61 | Definition addrC {s : type} : commutative add := 62 | CMonoid_of_Type.addrC _ (CMonoid_of_Type_mixin _ (class s)). 63 | 64 | Definition add0r {s : type} : left_id zero add := 65 | CMonoid_of_Type.add0r _ (CMonoid_of_Type_mixin _ (class s)). 66 | 67 | End Exports. 68 | End CMonoid. 69 | Export CMonoid.Exports. 70 | 71 | Module AbelianGrp_of_CMonoid. 72 | Section AbelianGrp_of_CMonoid. 73 | Variable (A : Type). 74 | Notation M m := (CMonoid.Pack A (CMonoid.Class A m)). 75 | 76 | Record axioms_ (m : CMonoid_of_Type.axioms_ A) := Axioms_ { 77 | opp : A -> A; 78 | addNr : left_inverse (@zero (M m)) opp (@add (M m)) 79 | }. 80 | 81 | Definition phant_Build := 82 | fun (s : CMonoid.type) of [unify A with CMonoid.sort s] => 83 | fun (c : CMonoid.axioms A) of [unify s with CMonoid.Pack A c] => 84 | fun (m : CMonoid_of_Type.axioms_ A) of [unify c with CMonoid.Class A m] => 85 | fun (opp : A -> A) (addNr : left_inverse (@zero (M m)) opp (@add (M m))) => 86 | Axioms_ m opp addNr. 87 | 88 | Definition phant_axioms := 89 | fun (s : CMonoid.type) of [unify A with CMonoid.sort s] => 90 | fun (c : CMonoid.axioms A) of [unify s with CMonoid.Pack A c] => 91 | fun (m : CMonoid_of_Type.axioms_ A) of [unify c with CMonoid.Class A m] => 92 | axioms_ m. 93 | 94 | End AbelianGrp_of_CMonoid. 95 | 96 | Notation Build A := (phant_Build A _ id_phant _ id_phant _ id_phant). 97 | Notation axioms A := (phant_axioms A _ id_phant _ id_phant _ id_phant). 98 | 99 | Module Exports. 100 | Notation AbelianGrp_of_CMonoid A := (axioms A). 101 | End Exports. 102 | 103 | End AbelianGrp_of_CMonoid. 104 | Export AbelianGrp_of_CMonoid.Exports. 105 | 106 | Module AbelianGrp. 107 | Record axioms (A : Type) : Type := Class 108 | { CMonoid_of_Type_mixin : CMonoid_of_Type.axioms_ A; 109 | AbelianGrp_of_CMonoid_mixin : AbelianGrp_of_CMonoid.axioms_ A 110 | CMonoid_of_Type_mixin }. 111 | Record type : Type := Pack { sort : Type; class : axioms sort }. 112 | 113 | Module Exports. 114 | Coercion sort : type >-> Sortclass. 115 | Coercion AbelianGrp_class_to_CMonoid_class (A : Type) 116 | (c : axioms A) := CMonoid.Class A (CMonoid_of_Type_mixin A c). 117 | Coercion AbelianGrp_to_CMonoid (A : AbelianGrp.type) := 118 | CMonoid.Pack A (class A). 119 | Canonical AbelianGrp_to_CMonoid. 120 | 121 | Definition opp {s : type} (x : s) : s := AbelianGrp_of_CMonoid.opp _ _ 122 | (AbelianGrp_of_CMonoid_mixin _ (class s)) x. 123 | 124 | Definition addNr {s : type} : left_inverse (@zero s) opp (@add s) := 125 | AbelianGrp_of_CMonoid.addNr _ _ (AbelianGrp_of_CMonoid_mixin _ (class s)). 126 | 127 | End Exports. 128 | End AbelianGrp. 129 | Export AbelianGrp.Exports. 130 | -------------------------------------------------------------------------------- /examples_stdlib/Coq2020_material/diagram.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/math-comp/hierarchy-builder/4b6a76fb6802a770dd929a9dd7e8e03c3a47f73e/examples_stdlib/Coq2020_material/diagram.pdf -------------------------------------------------------------------------------- /examples_stdlib/FSCD2020_material/V1.v: -------------------------------------------------------------------------------- 1 | (* Accompanying material to https://hal.inria.fr/hal-02478907 *) 2 | From Coq Require Import ssreflect ssrfun ZArith. 3 | From HB Require Import structures. 4 | 5 | Declare Scope hb_scope. 6 | Delimit Scope hb_scope with G. 7 | Open Scope hb_scope. 8 | 9 | (* Bottom mixin in Fig. 1. *) 10 | HB.mixin Record Monoid_of_Type M := { 11 | zero : M; 12 | add : M -> M -> M; 13 | addrA : associative add; 14 | add0r : left_id zero add; 15 | addr0 : right_id zero add; 16 | }. 17 | HB.structure Definition Monoid := { M of Monoid_of_Type M }. 18 | Notation "0" := zero : hb_scope. 19 | Infix "+" := (@add _) : hb_scope. 20 | 21 | (* Left mixin in Fig. 1. *) 22 | HB.mixin Record Ring_of_Monoid R of Monoid R := { 23 | one : R; 24 | opp : R -> R; 25 | mul : R -> R -> R; 26 | addNr : left_inverse zero opp add; 27 | addrN : right_inverse zero opp add; 28 | mulrA : associative mul; 29 | mul1r : left_id one mul; 30 | mulr1 : right_id one mul; 31 | mulrDl : left_distributive mul add; 32 | mulrDr : right_distributive mul add; 33 | }. 34 | HB.structure Definition Ring := { R of Monoid R & Ring_of_Monoid R }. 35 | Notation "1" := one : hb_scope. 36 | Notation "- x" := (@opp _ x) : hb_scope. 37 | Notation "x - y" := (x + - y) : hb_scope. 38 | Infix "*" := (@mul _) : hb_scope. 39 | 40 | (********) 41 | (* TEST *) 42 | (********) 43 | 44 | Print Monoid.type. 45 | (* Monoid.type := { sort : Type; ... } *) 46 | Check @add. 47 | (* add : forall M : Monoid.type, M -> M -> M *) 48 | Check @addNr. 49 | (* addNr : forall R : Ring.type, left_inverse zero opp add *) 50 | 51 | (* https://math.stackexchange.com/questions/346375/commutative-property-of-ring-addition/346682 *) 52 | Lemma addrC {R : Ring.type} : commutative (@add R). 53 | Proof. 54 | have innerC (a b : R) : a + b + (a + b) = a + a + (b + b). 55 | by rewrite -[a+b]mul1r -mulrDl mulrDr !mulrDl !mul1r. 56 | have addKl (a b c : R) : a + b = a + c -> b = c. 57 | apply: can_inj (add a) (add (opp a)) _ _ _. 58 | by move=> x; rewrite addrA addNr add0r. 59 | have addKr (a b c : R) : b + a = c + a -> b = c. 60 | apply: can_inj (add ^~ a) (add ^~ (opp a)) _ _ _. 61 | by move=> x; rewrite /= -addrA addrN addr0. 62 | move=> x y; apply: addKl (x) _ _ _; apply: addKr (y) _ _ _. 63 | by rewrite -!addrA [in RHS]addrA innerC !addrA. 64 | Qed. 65 | 66 | HB.instance 67 | Definition Z_Monoid_axioms : Monoid_of_Type Z := 68 | Monoid_of_Type.Build Z 0%Z Z.add Z.add_assoc Z.add_0_l Z.add_0_r. 69 | 70 | HB.instance 71 | Definition Z_Ring_axioms : Ring_of_Monoid Z := 72 | Ring_of_Monoid.Build Z 1%Z Z.opp Z.mul 73 | Z.add_opp_diag_l Z.add_opp_diag_r Z.mul_assoc Z.mul_1_l Z.mul_1_r 74 | Z.mul_add_distr_r Z.mul_add_distr_l. 75 | 76 | Lemma exercise (m n : Z) : (n + m) - n * 1 = m. 77 | Proof. by rewrite mulr1 (addrC n) -(addrA m) addrN addr0. Qed. 78 | -------------------------------------------------------------------------------- /examples_stdlib/FSCD2020_material/V2.v: -------------------------------------------------------------------------------- 1 | (* Accompanying material to https://hal.inria.fr/hal-02478907 *) 2 | From Coq Require Import ssreflect ssrfun ZArith. 3 | From HB Require Import structures. 4 | 5 | Declare Scope hb_scope. 6 | Delimit Scope hb_scope with G. 7 | Open Scope hb_scope. 8 | 9 | (* Bottom mixin in Fig. 1. *) 10 | HB.mixin Record Monoid_of_Type M := { 11 | zero : M; 12 | add : M -> M -> M; 13 | addrA : associative add; 14 | add0r : left_id zero add; 15 | addr0 : right_id zero add; 16 | }. 17 | HB.structure Definition Monoid := { M of Monoid_of_Type M }. 18 | Notation "0" := zero : hb_scope. 19 | Infix "+" := (@add _) : hb_scope. 20 | 21 | (* Bottom right mixin in Fig. 1. *) 22 | HB.mixin Record AbelianGroup_of_Monoid A of Monoid A := { 23 | opp : A -> A; 24 | addrC : commutative (add : A -> A -> A); 25 | addNr : left_inverse zero opp add; 26 | }. 27 | HB.structure Definition AbelianGroup := 28 | { A of Monoid A & AbelianGroup_of_Monoid A }. 29 | Notation "- x" := (@opp _ x) : hb_scope. 30 | Notation "x - y" := (x + - y) : hb_scope. 31 | 32 | (* Top right mixin in Fig. 1. *) 33 | HB.mixin Record Ring_of_AbelianGroup R of AbelianGroup R := { 34 | one : R; 35 | mul : R -> R -> R; 36 | mulrA : associative mul; 37 | mul1r : left_id one mul; 38 | mulr1 : right_id one mul; 39 | mulrDl : left_distributive mul add; 40 | mulrDr : right_distributive mul add; 41 | }. 42 | HB.structure Definition Ring := 43 | { R of AbelianGroup R & Ring_of_AbelianGroup R }. 44 | Notation "1" := one : hb_scope. 45 | Infix "*" := (@mul _) : hb_scope. 46 | 47 | Lemma addrN {R : AbelianGroup.type} : right_inverse (zero : R) opp add. 48 | Proof. by move=> x; rewrite addrC addNr. Qed. 49 | 50 | (********) 51 | (* TEST *) 52 | (********) 53 | 54 | Print Monoid.type. 55 | (* Monoid.type := { sort : Type; ... } *) 56 | Check @add. 57 | (* add : forall M : Monoid.type, M -> M -> M *) 58 | Check @addNr. 59 | (* addNr : forall R : Ring.type, left_inverse zero opp add *) 60 | Check @addrC. (* is now an axiom of abelian groups *) 61 | (* addrC : forall R : AbelianGroup.type, commutative add *) 62 | 63 | HB.instance 64 | Definition Z_Monoid_axioms : Monoid_of_Type Z := 65 | Monoid_of_Type.Build Z 0%Z Z.add Z.add_assoc Z.add_0_l Z.add_0_r. 66 | 67 | (********************************************************) 68 | (* This test from V1 FAILS in V2, and is repaired in V3 *) 69 | (********************************************************) 70 | Fail 71 | Definition Z_Ring_axioms : Ring_of_Monoid Z := 72 | Ring_of_Monoid.Build Z 1%Z Z.opp Z.mul 73 | Z.add_opp_diag_l Z.add_opp_diag_r Z.mul_assoc Z.mul_1_l Z.mul_1_r 74 | Z.mul_add_distr_r Z.mul_add_distr_l. 75 | -------------------------------------------------------------------------------- /examples_stdlib/FSCD2020_material/V3.v: -------------------------------------------------------------------------------- 1 | (* Accompanying material to https://hal.inria.fr/hal-02478907 *) 2 | From Coq Require Import ssreflect ssrfun ZArith. 3 | From HB Require Import structures. 4 | 5 | Declare Scope hb_scope. 6 | Delimit Scope hb_scope with G. 7 | Open Scope hb_scope. 8 | 9 | (* Bottom mixin in Fig. 1. *) 10 | HB.mixin Record Monoid_of_Type M := { 11 | zero : M; 12 | add : M -> M -> M; 13 | addrA : associative add; 14 | add0r : left_id zero add; 15 | addr0 : right_id zero add; 16 | }. 17 | HB.structure Definition Monoid := { M of Monoid_of_Type M }. 18 | Notation "0" := zero : hb_scope. 19 | Infix "+" := (@add _) : hb_scope. 20 | 21 | (* Bottom right mixin in Fig. 1. *) 22 | HB.mixin Record AbelianGroup_of_Monoid A of Monoid A := { 23 | opp : A -> A; 24 | addrC : commutative (add : A -> A -> A); 25 | addNr : left_inverse zero opp add; 26 | }. 27 | HB.structure Definition AbelianGroup := 28 | { A of Monoid A & AbelianGroup_of_Monoid A }. 29 | Notation "- x" := (@opp _ x) : hb_scope. 30 | Notation "x - y" := (x + - y) : hb_scope. 31 | 32 | (* Top right mixin in Fig. 1. *) 33 | HB.mixin Record Ring_of_AbelianGroup R of AbelianGroup R := { 34 | one : R; 35 | mul : R -> R -> R; 36 | mulrA : associative mul; 37 | mul1r : left_id one mul; 38 | mulr1 : right_id one mul; 39 | mulrDl : left_distributive mul add; 40 | mulrDr : right_distributive mul add; 41 | }. 42 | HB.structure Definition Ring := 43 | { R of AbelianGroup R & Ring_of_AbelianGroup R }. 44 | Notation "1" := one : hb_scope. 45 | Infix "*" := (@mul _) : hb_scope. 46 | 47 | Lemma addrN {R : AbelianGroup.type} : right_inverse (zero : R) opp add. 48 | Proof. by move=> x; rewrite addrC addNr. Qed. 49 | 50 | (* Left factory in Fig. 1. *) 51 | HB.factory Record Ring_of_Monoid R of Monoid R := { 52 | one : R; 53 | opp : R -> R; 54 | mul : R -> R -> R; 55 | addNr : left_inverse zero opp add; 56 | addrN : right_inverse zero opp add; 57 | mulrA : associative mul; 58 | mul1r : left_id one mul; 59 | mulr1 : right_id one mul; 60 | mulrDl : left_distributive mul add; 61 | mulrDr : right_distributive mul add; 62 | }. 63 | 64 | HB.builders Context (R : Type) (f : Ring_of_Monoid R). 65 | 66 | Lemma addrC : commutative (add : R -> R -> R). 67 | Proof. 68 | have innerC (a b : R) : a + b + (a + b) = a + a + (b + b). 69 | by rewrite -[a+b]mul1r -mulrDl mulrDr !mulrDl !mul1r. 70 | have addKl (a b c : R) : a + b = a + c -> b = c. 71 | apply: can_inj (add a) (add (opp a)) _ _ _. 72 | by move=> x; rewrite addrA addNr add0r. 73 | have addKr (a b c : R) : b + a = c + a -> b = c. 74 | apply: can_inj (add ^~ a) (add ^~ (opp a)) _ _ _. 75 | by move=> x; rewrite /= -addrA addrN addr0. 76 | move=> x y; apply: addKl (x) _ _ _; apply: addKr (y) _ _ _. 77 | by rewrite -!addrA [in RHS]addrA innerC !addrA. 78 | Qed. 79 | 80 | (* Builder to the bottom right mixin. *) 81 | HB.instance 82 | Definition to_AbelianGroup_of_Monoid := 83 | AbelianGroup_of_Monoid.Build R opp addrC addNr. 84 | 85 | (* Builder to the top right mixin. *) 86 | HB.instance 87 | Definition to_Ring_of_AbelianGroup := Ring_of_AbelianGroup.Build R one mul 88 | mulrA mul1r mulr1 mulrDl mulrDr. 89 | 90 | HB.end. 91 | 92 | (********) 93 | (* TEST *) 94 | (********) 95 | 96 | Print Monoid.type. 97 | (* Monoid.type := { sort : Type; ... } *) 98 | Check @add. 99 | (* add : forall M : Monoid.type, M -> M -> M *) 100 | Check @addNr. 101 | (* addNr : forall R : AbelianGroup.type, left_inverse 0 opp add *) 102 | Check @addrC. (* is still an axiom of abelian groups *) 103 | (* addrC : forall R : AbelianGroup.type, commutative add *) 104 | 105 | HB.instance 106 | Definition Z_Monoid_axioms : Monoid_of_Type Z := 107 | Monoid_of_Type.Build Z 0%Z Z.add Z.add_assoc Z.add_0_l Z.add_0_r. 108 | 109 | HB.instance 110 | Definition Z_Ring_axioms : Ring_of_Monoid Z := 111 | Ring_of_Monoid.Build Z 1%Z Z.opp Z.mul 112 | Z.add_opp_diag_l Z.add_opp_diag_r Z.mul_assoc Z.mul_1_l Z.mul_1_r 113 | Z.mul_add_distr_r Z.mul_add_distr_l. 114 | 115 | Lemma exercise (m n : Z) : (n + m) - n * 1 = m. 116 | Proof. by rewrite mulr1 (addrC n) -(addrA m) addrN addr0. Qed. 117 | -------------------------------------------------------------------------------- /examples_stdlib/FSCD2020_talk/V1.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_monoid (M : Type) := { 5 | zero : M; 6 | add : M -> M -> M; 7 | addrA : associative add; (* add is associative. *) 8 | add0r : left_id zero add; (* zero is the neutral *) 9 | addr0 : right_id zero add; (* element wrt add. *) 10 | }. 11 | HB.structure Definition Monoid := { M & is_monoid M }. 12 | 13 | HB.instance Definition Z_is_monoid : is_monoid Z := 14 | is_monoid.Build Z 0%Z Z.add 15 | Z.add_assoc Z.add_0_l Z.add_0_r. 16 | -------------------------------------------------------------------------------- /examples_stdlib/FSCD2020_talk/V2.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_semigroup (S : Type) := { 5 | add : S -> S -> S; 6 | addrA : associative add; 7 | }. 8 | HB.structure Definition SemiGroup := 9 | { S & is_semigroup S }. 10 | 11 | HB.mixin Record monoid_of_semigroup (M : Type) 12 | & is_semigroup M := { 13 | zero : M; 14 | add0r : left_id zero add; 15 | addr0 : right_id zero add; 16 | }. 17 | HB.structure Definition Monoid := 18 | { M & monoid_of_semigroup M }. 19 | 20 | (* is_monoid does not exist anymore *) 21 | Fail Check is_monoid. 22 | 23 | HB.mixin Record xxxx P A := { F : bool }. 24 | -------------------------------------------------------------------------------- /examples_stdlib/FSCD2020_talk/V3.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record is_semigroup (S : Type) := { 5 | add : S -> S -> S; 6 | addrA : associative add; 7 | }. 8 | HB.structure Definition SemiGroup := 9 | { S & is_semigroup S }. 10 | 11 | HB.mixin Record monoid_of_semigroup (M : Type) 12 | & is_semigroup M := { 13 | zero : M; 14 | add0r : left_id zero add; 15 | addr0 : right_id zero add; 16 | }. 17 | 18 | HB.factory Record is_monoid (M : Type) := { 19 | zero : M; 20 | add : M -> M -> M; 21 | addrA : associative add; 22 | add0r : left_id zero add; 23 | addr0 : right_id zero add; 24 | }. 25 | HB.builders Context (M : Type) (f : is_monoid M). 26 | HB.instance Definition is_monoid_semigroup : is_semigroup M := 27 | is_semigroup.Build M add addrA. 28 | HB.instance Definition is_monoid_monoid : monoid_of_semigroup M := 29 | monoid_of_semigroup.Build M zero add0r addr0. 30 | HB.end. 31 | 32 | HB.structure Definition Monoid := 33 | { M & is_monoid M }. 34 | 35 | HB.instance Definition Z_is_monoid : is_monoid Z := 36 | is_monoid.Build Z 0%Z Z.add 37 | Z.add_assoc Z.add_0_l Z.add_0_r. 38 | -------------------------------------------------------------------------------- /examples_stdlib/demo1/README.md: -------------------------------------------------------------------------------- 1 | 2 | # Demo1 3 | 4 | The files `hierarchy_$N.v` describes a hierarchy that born with just one 5 | structure, the one of `Ring`, and evolves to the following one in five steps. 6 | 7 | ``` 8 | AddMonoid ---> AddComoid ----> AddAG ----> Ring 9 | \ \ / 10 | -> BiNearRing -> SemiRing - 11 | ``` 12 | 13 | The file `user_0.v` describes an early adopter of the hierarchy, the version 14 | described in `hierarchy_0.v`. That code works with all version of the hierarchy. 15 | 16 | The file `user_3.v` describes a user that adopted the `hierarchy_3.v` and that 17 | code works up to `hierarchy_5.v` -------------------------------------------------------------------------------- /examples_stdlib/demo1/hierarchy_0.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | (**************************************************************************) 5 | (* Stage 0: +Ring+ *) 6 | (**************************************************************************) 7 | 8 | HB.mixin Record Ring_of_TYPE A := { 9 | zero : A; 10 | one : A; 11 | add : A -> A -> A; 12 | opp : A -> A; 13 | mul : A -> A -> A; 14 | addrA : associative add; 15 | addrC : commutative add; 16 | add0r : left_id zero add; 17 | addNr : left_inverse zero opp add; 18 | mulrA : associative mul; 19 | mul1r : left_id one mul; 20 | mulr1 : right_id one mul; 21 | mulrDl : left_distributive mul add; 22 | mulrDr : right_distributive mul add; 23 | }. 24 | HB.structure Definition Ring := { A of Ring_of_TYPE A }. 25 | 26 | (* Notations *) 27 | 28 | Declare Scope hb_scope. 29 | Delimit Scope hb_scope with G. 30 | Local Open Scope hb_scope. 31 | Notation "0" := zero : hb_scope. 32 | Notation "1" := one : hb_scope. 33 | Infix "+" := (@add _) : hb_scope. 34 | Notation "- x" := (@opp _ x) : hb_scope. 35 | Infix "*" := (@mul _) : hb_scope. 36 | Notation "x - y" := (x + - y) : hb_scope. 37 | 38 | (* Theory *) 39 | 40 | Section Theory. 41 | Variable R : Ring.type. 42 | Implicit Type (x : R). 43 | 44 | Lemma addr0 : right_id (@zero R) add. 45 | Proof. by move=> x; rewrite addrC add0r. Qed. 46 | 47 | Lemma addrN : right_inverse (@zero R) opp add. 48 | Proof. by move=> x; rewrite addrC addNr. Qed. 49 | 50 | Lemma subrr x : x - x = 0. 51 | Proof. by rewrite addrN. Qed. 52 | 53 | Lemma addrNK x y : x + y - y = x. 54 | Proof. by rewrite -addrA subrr addr0. Qed. 55 | 56 | End Theory. 57 | -------------------------------------------------------------------------------- /examples_stdlib/demo1/hierarchy_1.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | (**************************************************************************) 5 | (* Stage 1: +AddComoid+ -> Ring *) 6 | (**************************************************************************) 7 | 8 | (* Begin change *) 9 | 10 | HB.mixin Record AddComoid_of_TYPE A := { 11 | zero : A; 12 | add : A -> A -> A; 13 | addrA : associative add; 14 | addrC : commutative add; 15 | add0r : left_id zero add; 16 | }. 17 | HB.structure Definition AddComoid := { A of AddComoid_of_TYPE A }. 18 | 19 | HB.mixin Record Ring_of_AddComoid A of AddComoid A := { 20 | opp : A -> A; 21 | one : A; 22 | mul : A -> A -> A; 23 | addNr : left_inverse zero opp add; 24 | mulrA : associative mul; 25 | mul1r : left_id one mul; 26 | mulr1 : right_id one mul; 27 | mulrDl : left_distributive mul add; 28 | mulrDr : right_distributive mul add; 29 | }. 30 | 31 | HB.factory Record Ring_of_TYPE A := { 32 | zero : A; 33 | one : A; 34 | add : A -> A -> A; 35 | opp : A -> A; 36 | mul : A -> A -> A; 37 | addrA : associative add; 38 | addrC : commutative add; 39 | add0r : left_id zero add; 40 | addNr : left_inverse zero opp add; 41 | mulrA : associative mul; 42 | mul1r : left_id one mul; 43 | mulr1 : right_id one mul; 44 | mulrDl : left_distributive mul add; 45 | mulrDr : right_distributive mul add; 46 | }. 47 | 48 | #[verbose] 49 | HB.builders Context A (a : Ring_of_TYPE A). 50 | 51 | HB.instance 52 | Definition to_AddComoid_of_TYPE := 53 | AddComoid_of_TYPE.Build A zero add addrA addrC add0r. 54 | 55 | HB.instance 56 | Definition to_Ring_of_AddComoid := 57 | Ring_of_AddComoid.Build A _ _ _ addNr mulrA mul1r 58 | mulr1 mulrDl mulrDr. 59 | 60 | HB.end. 61 | 62 | (* End change *) 63 | 64 | HB.structure Definition Ring := { A of Ring_of_TYPE A }. 65 | 66 | (* Notations *) 67 | 68 | Declare Scope hb_scope. 69 | Delimit Scope hb_scope with G. 70 | Local Open Scope hb_scope. 71 | Notation "0" := zero : hb_scope. 72 | Notation "1" := one : hb_scope. 73 | Infix "+" := (@add _) : hb_scope. 74 | Notation "- x" := (@opp _ x) : hb_scope. 75 | Infix "*" := (@mul _) : hb_scope. 76 | Notation "x - y" := (x + - y) : hb_scope. 77 | 78 | (* Theory *) 79 | 80 | Section Theory. 81 | Variable R : Ring.type. 82 | Implicit Type (x : R). 83 | 84 | Lemma addr0 : right_id (@zero R) add. 85 | Proof. by move=> x; rewrite addrC add0r. Qed. 86 | 87 | Lemma addrN : right_inverse (@zero R) opp add. 88 | Proof. by move=> x; rewrite addrC addNr. Qed. 89 | 90 | Lemma subrr x : x - x = 0. 91 | Proof. by rewrite addrN. Qed. 92 | 93 | Lemma addrNK x y : x + y - y = x. 94 | Proof. by rewrite -addrA subrr addr0. Qed. 95 | 96 | End Theory. 97 | -------------------------------------------------------------------------------- /examples_stdlib/demo1/hierarchy_2.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | (**************************************************************************) 5 | (* Stage 2: AddComoid -> +AddAG+ -> Ring *) 6 | (**************************************************************************) 7 | 8 | HB.mixin Record AddComoid_of_TYPE A := { 9 | zero : A; 10 | add : A -> A -> A; 11 | addrA : associative add; 12 | addrC : commutative add; 13 | add0r : left_id zero add; 14 | }. 15 | HB.structure Definition AddComoid := { A of AddComoid_of_TYPE A }. 16 | 17 | (* Begin change *) 18 | 19 | HB.mixin Record AddAG_of_AddComoid A of AddComoid A := { 20 | opp : A -> A; 21 | addNr : left_inverse zero opp add; 22 | }. 23 | HB.factory Record AddAG_of_TYPE A := { 24 | zero : A; 25 | add : A -> A -> A; 26 | opp : A -> A; 27 | addrA : associative add; 28 | addrC : commutative add; 29 | add0r : left_id zero add; 30 | addNr : left_inverse zero opp add; 31 | }. 32 | 33 | HB.builders Context A (a : AddAG_of_TYPE A). 34 | 35 | HB.instance 36 | Definition to_AddComoid_of_TYPE := 37 | AddComoid_of_TYPE.Build A zero add addrA addrC add0r. 38 | 39 | HB.instance 40 | Definition to_AddAG_of_AddComoid := 41 | AddAG_of_AddComoid.Build A _ addNr. 42 | 43 | HB.end. 44 | HB.structure Definition AddAG := { A of AddAG_of_TYPE A }. 45 | 46 | HB.mixin Record Ring_of_AddAG A of AddAG A := { 47 | one : A; 48 | mul : A -> A -> A; 49 | mulrA : associative mul; 50 | mulr1 : left_id one mul; 51 | mul1r : right_id one mul; 52 | mulrDl : left_distributive mul add; 53 | mulrDr : right_distributive mul add; 54 | }. 55 | 56 | 57 | HB.structure Definition Ring := { A of Ring_of_AddAG A }. 58 | 59 | HB.factory Record Ring_of_AddComoid A of AddComoid A := { 60 | opp : A -> A; 61 | one : A; 62 | mul : A -> A -> A; 63 | addNr : left_inverse zero opp add; 64 | mulrA : associative mul; 65 | mul1r : left_id one mul; 66 | mulr1 : right_id one mul; 67 | mulrDl : left_distributive mul add; 68 | mulrDr : right_distributive mul add; 69 | }. 70 | 71 | 72 | HB.builders Context A (a : Ring_of_AddComoid A). 73 | 74 | HB.instance 75 | Definition to_AddAG_of_AddComoid := AddAG_of_AddComoid.Build A _ addNr. 76 | 77 | HB.instance 78 | Definition to_Ring_of_AddAG := Ring_of_AddAG.Build A 79 | _ _ mulrA mul1r mulr1 mulrDl mulrDr. 80 | 81 | #[verbose] 82 | HB.end. 83 | 84 | (* End change *) 85 | 86 | HB.factory Record Ring_of_TYPE A := { 87 | zero : A; 88 | one : A; 89 | add : A -> A -> A; 90 | opp : A -> A; 91 | mul : A -> A -> A; 92 | addrA : associative add; 93 | addrC : commutative add; 94 | add0r : left_id zero add; 95 | addNr : left_inverse zero opp add; 96 | mulrA : associative mul; 97 | mul1r : left_id one mul; 98 | mulr1 : right_id one mul; 99 | mulrDl : left_distributive mul add; 100 | mulrDr : right_distributive mul add; 101 | }. 102 | 103 | HB.builders Context A (a : Ring_of_TYPE A). 104 | 105 | HB.instance 106 | Definition to_AddComoid_of_TYPE := AddComoid_of_TYPE.Build A 107 | zero add addrA addrC add0r. 108 | 109 | HB.instance 110 | Definition to_Ring_of_AddComoid := Ring_of_AddComoid.Build A 111 | _ _ _ addNr mulrA mul1r mulr1 mulrDl mulrDr. 112 | 113 | HB.end. 114 | 115 | 116 | (* Notations *) 117 | 118 | Declare Scope hb_scope. 119 | Delimit Scope hb_scope with G. 120 | Local Open Scope hb_scope. 121 | Notation "0" := zero : hb_scope. 122 | Notation "1" := one : hb_scope. 123 | Infix "+" := (@add _) : hb_scope. 124 | Notation "- x" := (@opp _ x) : hb_scope. 125 | Infix "*" := (@mul _) : hb_scope. 126 | Notation "x - y" := (x + - y) : hb_scope. 127 | 128 | (* Theory *) 129 | 130 | Section Theory. 131 | Variable R : Ring.type. 132 | Implicit Type (x : R). 133 | 134 | Lemma addr0 : right_id (@zero R) add. 135 | Proof. by move=> x; rewrite addrC add0r. Qed. 136 | 137 | Lemma addrN : right_inverse (@zero R) opp add. 138 | Proof. by move=> x; rewrite addrC addNr. Qed. 139 | 140 | Lemma subrr x : x - x = 0. 141 | Proof. by rewrite addrN. Qed. 142 | 143 | Lemma addrNK x y : x + y - y = x. 144 | Proof. by rewrite -addrA subrr addr0. Qed. 145 | 146 | End Theory. 147 | -------------------------------------------------------------------------------- /examples_stdlib/demo1/hierarchy_3.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | (**************************************************************************) 5 | (* Stage 3: AddComoid ----> AddAG -----> Ring *) 6 | (* \ / *) 7 | (* -> +SemiRing+ - *) 8 | (**************************************************************************) 9 | 10 | HB.mixin Record AddComoid_of_TYPE A := { 11 | zero : A; 12 | add : A -> A -> A; 13 | addrA : associative add; 14 | addrC : commutative add; 15 | add0r : left_id zero add; 16 | }. 17 | HB.structure Definition AddComoid := { A of AddComoid_of_TYPE A }. 18 | 19 | HB.mixin Record AddAG_of_AddComoid A of AddComoid A := { 20 | opp : A -> A; 21 | addNr : left_inverse zero opp add; 22 | }. 23 | HB.factory Record AddAG_of_TYPE A := { 24 | zero : A; 25 | add : A -> A -> A; 26 | opp : A -> A; 27 | addrA : associative add; 28 | addrC : commutative add; 29 | add0r : left_id zero add; 30 | addNr : left_inverse zero opp add; 31 | }. 32 | 33 | HB.builders Context A (a : AddAG_of_TYPE A). 34 | 35 | HB.instance 36 | Definition to_AddComoid_of_TYPE := AddComoid_of_TYPE.Build A 37 | zero add addrA addrC add0r. 38 | 39 | HB.instance 40 | Definition to_AddAG_of_AddComoid := AddAG_of_AddComoid.Build A _ addNr. 41 | 42 | HB.end. 43 | HB.structure Definition AddAG := { A of AddAG_of_TYPE A }. 44 | 45 | (* Begin change *) 46 | 47 | HB.mixin Record SemiRing_of_AddComoid A of AddComoid A := { 48 | one : A; 49 | mul : A -> A -> A; 50 | mulrA : associative mul; 51 | mul1r : left_id one mul; 52 | mulr1 : right_id one mul; 53 | mulrDl : left_distributive mul add; 54 | mulrDr : right_distributive mul add; 55 | mul0r : left_zero zero mul; 56 | mulr0 : right_zero zero mul; 57 | }. 58 | HB.structure Definition SemiRing := { A of AddComoid A & SemiRing_of_AddComoid A }. 59 | 60 | HB.factory Record Ring_of_AddAG A of AddAG A := { 61 | one : A; 62 | mul : A -> A -> A; 63 | mulrA : associative mul; 64 | mulr1 : left_id one mul; 65 | mul1r : right_id one mul; 66 | mulrDl : left_distributive mul add; 67 | mulrDr : right_distributive mul add; 68 | }. 69 | 70 | HB.builders Context A (a : Ring_of_AddAG A). 71 | 72 | Fact mul0r : left_zero zero mul. 73 | Proof. 74 | move=> x; rewrite -[LHS]add0r addrC. 75 | rewrite -{2}(addNr (mul x x)) (addrC (opp _)) addrA. 76 | by rewrite -mulrDl add0r addrC addNr. 77 | Qed. 78 | 79 | Fact mulr0 : right_zero zero mul. 80 | Proof. 81 | move=> x; rewrite -[LHS]add0r addrC. 82 | rewrite -{2}(addNr (mul x x)) (addrC (opp _)) addrA. 83 | by rewrite -mulrDr add0r addrC addNr. 84 | Qed. 85 | 86 | HB.instance 87 | Definition to_SemiRing_of_AddComoid := SemiRing_of_AddComoid.Build A 88 | _ mul mulrA mulr1 mul1r 89 | mulrDl mulrDr mul0r mulr0. 90 | 91 | 92 | HB.end. 93 | 94 | (* End change *) 95 | HB.factory Record Ring_of_AddComoid A of AddComoid A := { 96 | opp : A -> A; 97 | one : A; 98 | mul : A -> A -> A; 99 | addNr : left_inverse zero opp add; 100 | mulrA : associative mul; 101 | mul1r : left_id one mul; 102 | mulr1 : right_id one mul; 103 | mulrDl : left_distributive mul add; 104 | mulrDr : right_distributive mul add; 105 | }. 106 | 107 | HB.builders Context A (a : Ring_of_AddComoid A). 108 | 109 | HB.instance 110 | Definition to_AddAG_of_AddComoid := AddAG_of_AddComoid.Build A _ addNr. 111 | 112 | HB.instance 113 | Definition to_Ring_of_AddAG := Ring_of_AddAG.Build A 114 | _ _ mulrA mul1r mulr1 mulrDl mulrDr. 115 | 116 | HB.end. 117 | 118 | (* End change *) 119 | 120 | HB.factory Record Ring_of_TYPE A := { 121 | zero : A; 122 | one : A; 123 | add : A -> A -> A; 124 | opp : A -> A; 125 | mul : A -> A -> A; 126 | addrA : associative add; 127 | addrC : commutative add; 128 | add0r : left_id zero add; 129 | addNr : left_inverse zero opp add; 130 | mulrA : associative mul; 131 | mul1r : left_id one mul; 132 | mulr1 : right_id one mul; 133 | mulrDl : left_distributive mul add; 134 | mulrDr : right_distributive mul add; 135 | }. 136 | 137 | HB.builders Context A (a : Ring_of_TYPE A). 138 | 139 | HB.instance 140 | Definition to_AddComoid_of_TYPE := AddComoid_of_TYPE.Build A 141 | zero add addrA addrC add0r. 142 | 143 | HB.instance 144 | Definition to_Ring_of_AddComoid := Ring_of_AddComoid.Build A 145 | _ _ _ addNr mulrA mul1r mulr1 mulrDl mulrDr. 146 | 147 | HB.end. 148 | 149 | HB.structure Definition Ring := { A of Ring_of_TYPE A }. 150 | 151 | (* Notations *) 152 | 153 | Declare Scope hb_scope. 154 | Delimit Scope hb_scope with G. 155 | Local Open Scope hb_scope. 156 | Notation "0" := zero : hb_scope. 157 | Notation "1" := one : hb_scope. 158 | Infix "+" := (@add _) : hb_scope. 159 | Notation "- x" := (@opp _ x) : hb_scope. 160 | Infix "*" := (@mul _) : hb_scope. 161 | Notation "x - y" := (x + - y) : hb_scope. 162 | 163 | (* Theory *) 164 | 165 | Section Theory. 166 | Variable R : Ring.type. 167 | Implicit Type (x : R). 168 | 169 | Lemma addr0 : right_id (@zero R) add. 170 | Proof. by move=> x; rewrite addrC add0r. Qed. 171 | 172 | Lemma addrN : right_inverse (@zero R) opp add. 173 | Proof. by move=> x; rewrite addrC addNr. Qed. 174 | 175 | Lemma subrr x : x - x = 0. 176 | Proof. by rewrite addrN. Qed. 177 | 178 | Lemma addrNK x y : x + y - y = x. 179 | Proof. by rewrite -addrA subrr addr0. Qed. 180 | 181 | End Theory. 182 | -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_0_0.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect. 2 | From Stdlib Require Import ZArith. 3 | From HB Require Import structures. 4 | From HB Require Import demo1.hierarchy_0. 5 | 6 | HB.instance 7 | Definition Z_ring_axioms := 8 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 9 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 10 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 11 | Z.mul_add_distr_r Z.mul_add_distr_l. 12 | 13 | 14 | 15 | Open Scope hb_scope. 16 | 17 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 18 | Proof. by rewrite addrNK addr0. Qed. 19 | -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_1_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_1. 4 | 5 | HB.instance 6 | Definition Z_ring_axioms := 7 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 8 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 9 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 10 | Z.mul_add_distr_r Z.mul_add_distr_l. 11 | 12 | Open Scope hb_scope. 13 | 14 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 15 | Proof. by rewrite addrNK addr0. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_2_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_2. 4 | 5 | HB.instance 6 | Definition Z_ring_axioms := 7 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 8 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 9 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 10 | Z.mul_add_distr_r Z.mul_add_distr_l. 11 | 12 | Open Scope hb_scope. 13 | 14 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 15 | Proof. by rewrite addrNK addr0. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_3_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_3. 4 | 5 | HB.instance 6 | Definition Z_ring_axioms := 7 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 8 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 9 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 10 | Z.mul_add_distr_r Z.mul_add_distr_l. 11 | 12 | Open Scope hb_scope. 13 | 14 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 15 | Proof. by rewrite addrNK addr0. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_3_3.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_3. 4 | 5 | HB.instance 6 | Definition Z_AddComoid := AddComoid_of_TYPE.Build 7 | Z 0%Z Z.add 8 | Z.add_assoc Z.add_comm Z.add_0_l. 9 | 10 | HB.instance 11 | Definition Z_SemiRing := SemiRing_of_AddComoid.Build 12 | Z 1%Z Z.mul 13 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 14 | Z.mul_add_distr_r Z.mul_add_distr_l 15 | Z.mul_0_l Z.mul_0_r. 16 | 17 | Open Scope hb_scope. 18 | 19 | Example test1 (m n : Z) : m + n * 0 * 0 = m. 20 | Proof. by rewrite -mulrA !mulr0 addrC add0r. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_4_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_4. 4 | 5 | HB.instance 6 | Definition Z_ring_axioms := 7 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 8 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 9 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 10 | Z.mul_add_distr_r Z.mul_add_distr_l. 11 | 12 | 13 | 14 | Open Scope hb_scope. 15 | 16 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 17 | Proof. by rewrite addrNK addr0. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_4_3.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_4. 4 | 5 | HB.instance 6 | Definition Z_AddComoid := AddComoid_of_TYPE.Build 7 | Z 0%Z Z.add 8 | Z.add_assoc Z.add_comm Z.add_0_l. 9 | 10 | HB.instance 11 | Definition Z_SemiRing := SemiRing_of_AddComoid.Build 12 | Z 1%Z Z.mul 13 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 14 | Z.mul_add_distr_r Z.mul_add_distr_l 15 | Z.mul_0_l Z.mul_0_r. 16 | 17 | Open Scope hb_scope. 18 | 19 | Example test1 (m n : Z) : m + n * 0 * 0 = m. 20 | Proof. by rewrite -mulrA !mulr0 addrC add0r. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_5_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_5. 4 | 5 | HB.instance 6 | Definition Z_ring_axioms := 7 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 8 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 9 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 10 | Z.mul_add_distr_r Z.mul_add_distr_l. 11 | 12 | Open Scope hb_scope. 13 | 14 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 15 | Proof. by rewrite addrNK addr0. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/test_5_3.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_5. 4 | 5 | HB.instance 6 | Definition Z_AddComoid := AddComoid_of_TYPE.Build 7 | Z 0%Z Z.add 8 | Z.add_assoc Z.add_comm Z.add_0_l. 9 | 10 | HB.instance 11 | Definition Z_SemiRing := SemiRing_of_AddComoid.Build 12 | Z 1%Z Z.mul 13 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 14 | Z.mul_add_distr_r Z.mul_add_distr_l 15 | Z.mul_0_l Z.mul_0_r. 16 | 17 | Open Scope hb_scope. 18 | 19 | Example test1 (m n : Z) : m + n * 0 * 0 = m. 20 | Proof. by rewrite -mulrA !mulr0 addrC add0r. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/user_0.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From @@DEMO@@ Require Import @@HIERARCHY@@. 4 | 5 | Definition Z_ring_axioms := 6 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 7 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 8 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 9 | Z.mul_add_distr_r Z.mul_add_distr_l. 10 | 11 | HB.instance Z Z_ring_axioms. 12 | 13 | Open Scope hb_scope. 14 | 15 | Example test1 (m n : Z) : (m + n) - n + 0 = m. 16 | Proof. by rewrite addrNK addr0. Qed. -------------------------------------------------------------------------------- /examples_stdlib/demo1/user_3.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssreflect. 2 | From HB Require Import structures. 3 | From @@DEMO@@ Require Import @@HIERARCHY@@. 4 | 5 | Definition Z_AddComoid := AddComoid_of_TYPE.Build 6 | Z 0%Z Z.add 7 | Z.add_assoc Z.add_comm Z.add_0_l. 8 | 9 | HB.instance Z Z_AddComoid. 10 | 11 | Definition Z_SemiRing := SemiRing_of_AddComoid.Build 12 | Z 1%Z Z.mul 13 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 14 | Z.mul_add_distr_r Z.mul_add_distr_l 15 | Z.mul_0_l Z.mul_0_r. 16 | 17 | HB.instance Z Z_SemiRing. 18 | 19 | Open Scope hb_scope. 20 | 21 | Example test1 (m n : Z) : m + n * 0 * 0 = m. 22 | Proof. by rewrite -mulrA !mulr0 addrC add0r. Qed. -------------------------------------------------------------------------------- /rocq-hierarchy-builder.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "coq-hierarchy-builder" 3 | version: "dev" 4 | maintainer: "Enrico Tassi " 5 | authors: [ "Cyril Cohen" "Kazuhiko Sakaguchi" "Enrico Tassi" ] 6 | license: "MIT" 7 | homepage: "https://github.com/math-comp/hierarchy-builder" 8 | bug-reports: "https://github.com/math-comp/hierarchy-builder/issues" 9 | dev-repo: "git+https://github.com/math-comp/hierarchy-builder" 10 | 11 | build: [ [ make "build"] 12 | [ make "test-suite" ] {with-test & rocq-core:installed} 13 | ] 14 | install: [ make "install" ] 15 | depends: [ 16 | ("coq" {>= "8.20" & < "8.21~"} & "coq-elpi" {>= "2.4" | = "dev"} 17 | | "rocq-core" {(>= "9.0" & < "9.1~") | = "dev"} & "rocq-elpi" {>= "2.4" | = "dev"}) 18 | ] 19 | conflicts: [ 20 | "coq-hierarchy-builder" {< "1.9~"} 21 | "coq-hierarchy-builder-shim" 22 | ] 23 | depexts: [ 24 | [ "wdiff" ] {os-family = "debian" & with-test} 25 | ] 26 | synopsis: "High level commands to declare and evolve a hierarchy based on packed classes" 27 | description: """ 28 | Hierarchy Builder is a high level language to build hierarchies of algebraic structures and make these 29 | hierarchies evolve without breaking user code. The key concepts are the ones of factory, builder 30 | and abbreviation that let the hierarchy developer describe an actual interface for their library. 31 | Behind that interface the developer can provide appropriate code to ensure retro compatibility. 32 | """ 33 | tags: [ "logpath:HB" ] 34 | -------------------------------------------------------------------------------- /shim/Makefile: -------------------------------------------------------------------------------- 1 | COQMAKEFILE?=$(COQBIN)coq_makefile 2 | build: 3 | $(COQMAKEFILE) -f _CoqProject -o Makefile.coq 4 | $(MAKE) -f Makefile.coq 5 | 6 | install: 7 | $(MAKE) -f Makefile.coq install 8 | 9 | clean: 10 | $(MAKE) -f Makefile.coq clean 11 | 12 | -------------------------------------------------------------------------------- /shim/_CoqProject: -------------------------------------------------------------------------------- 1 | -R . HB 2 | 3 | structures.v -------------------------------------------------------------------------------- /shim/structures.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import String ssreflect ssrfun. 2 | Export String.StringSyntax. 3 | 4 | Variant error_msg := NoMsg | IsNotCanonicallyA (x : Type). 5 | Definition unify T1 T2 (t1 : T1) (t2 : T2) (s : error_msg) := 6 | phantom T1 t1 -> phantom T2 t2. 7 | Definition id_phant {T} {t : T} (x : phantom T t) := x. 8 | Definition nomsg : error_msg := NoMsg. 9 | Definition is_not_canonically_a x := IsNotCanonicallyA x. 10 | Definition new {T} (x : T) := x. 11 | Definition eta {T} (x : T) := x. 12 | -------------------------------------------------------------------------------- /tests/about.v.out.18: -------------------------------------------------------------------------------- 1 | HB: AddMonoid_of_TYPE is a factory 2 | (from "./examples/demo1/hierarchy_5.v", line 10) 3 | HB: AddMonoid_of_TYPE operations and axioms are: 4 | - zero 5 | - add 6 | - addrA 7 | - add0r 8 | - addr0 9 | HB: AddMonoid_of_TYPE requires the following mixins: 10 | HB: AddMonoid_of_TYPE provides the following mixins: 11 | - AddMonoid_of_TYPE 12 | HB: AddMonoid_of_TYPE.Build is a factory constructor 13 | (from "./examples/demo1/hierarchy_5.v", line 10) 14 | HB: AddMonoid_of_TYPE.Build requires its subject to be already equipped with: 15 | HB: AddMonoid_of_TYPE.Build provides the following mixins: 16 | - AddMonoid_of_TYPE 17 | HB: arguments: AddMonoid_of_TYPE.Build S zero add addrA add0r addr0 18 | - S : Type 19 | - zero : AddMonoid.sort S 20 | - add : S -> S -> S 21 | - addrA : associative add 22 | - add0r : left_id 0%G add 23 | - addr0 : right_id 0%G add 24 | HB: AddAG.type is a structure (from "./examples/demo1/hierarchy_5.v", line 73) 25 | HB: AddAG.type characterizing operations and axioms are: 26 | - addNr 27 | - opp 28 | HB: AddAG is a factory for the following mixins: 29 | - AddMonoid_of_TYPE 30 | - AddComoid_of_AddMonoid 31 | - AddAG_of_AddComoid (* new, not from inheritance *) 32 | HB: AddAG inherits from: 33 | - AddMonoid 34 | - AddComoid 35 | HB: AddAG is inherited by: 36 | - Ring 37 | HB: AddMonoid.type is a structure 38 | (from "./examples/demo1/hierarchy_5.v", line 17) 39 | HB: AddMonoid.type characterizing operations and axioms are: 40 | - addr0 41 | - add0r 42 | - addrA 43 | - add 44 | - zero 45 | HB: AddMonoid is a factory for the following mixins: 46 | - AddMonoid_of_TYPE (* new, not from inheritance *) 47 | HB: AddMonoid inherits from: 48 | HB: AddMonoid is inherited by: 49 | - AddComoid 50 | - AddAG 51 | - BiNearRing 52 | - SemiRing 53 | - Ring 54 | HB: Ring_of_AddAG is a factory 55 | (from "./examples/demo1/hierarchy_5.v", line 108) 56 | HB: Ring_of_AddAG operations and axioms are: 57 | - one 58 | - mul 59 | - mulrA 60 | - mulr1 61 | - mul1r 62 | - mulrDl 63 | - mulrDr 64 | HB: Ring_of_AddAG requires the following mixins: 65 | - AddMonoid_of_TYPE 66 | - AddComoid_of_AddMonoid 67 | - AddAG_of_AddComoid 68 | HB: Ring_of_AddAG provides the following mixins: 69 | - BiNearRing_of_AddMonoid 70 | Doc: Builds a Ring from an Abelian Group: the absorbing properties mul0r and 71 | mul0r are derived from addrC and the other ring axioms, following a proof 72 | of Hankel (Gerhard Betsch. On the beginnings and development of near-ring 73 | theory. In Near-rings and near-fields. Proceedings of the conference held 74 | in Fredericton, New Brunswick, July 18-24, 1993, pages 1–11. Mathematics 75 | and its Applications, 336. Kluwer Academic Publishers Group, Dordrecht, 76 | 1995). 77 | HB: Ring_of_AddAG.Build is a factory constructor 78 | (from "./examples/demo1/hierarchy_5.v", line 108) 79 | HB: Ring_of_AddAG.Build requires its subject to be already equipped with: 80 | - AddMonoid_of_TYPE 81 | - AddComoid_of_AddMonoid 82 | - AddAG_of_AddComoid 83 | HB: Ring_of_AddAG.Build provides the following mixins: 84 | - BiNearRing_of_AddMonoid 85 | HB: arguments: Ring_of_AddAG.Build A [one] [mul] mulrA mulr1 mul1r mulrDl mulrDr 86 | - A : Type 87 | - one : A 88 | - mul : A -> A -> A 89 | - mulrA : associative mul 90 | - mulr1 : left_id one mul 91 | - mul1r : right_id one mul 92 | - mulrDl : left_distributive mul add 93 | - mulrDr : right_distributive mul add 94 | Doc: Builds a Ring from an Abelian Group: the absorbing properties mul0r and 95 | mul0r are derived from addrC and the other ring axioms, following a proof 96 | of Hankel (Gerhard Betsch. On the beginnings and development of near-ring 97 | theory. In Near-rings and near-fields. Proceedings of the conference held 98 | in Fredericton, New Brunswick, July 18-24, 1993, pages 1–11. Mathematics 99 | and its Applications, 336. Kluwer Academic Publishers Group, Dordrecht, 100 | 1995). 101 | HB: add is an operation of structure AddMonoid 102 | (from "./examples/demo1/hierarchy_5.v", line 17) 103 | HB: add comes from mixin AddMonoid_of_TYPE 104 | (from "./examples/demo1/hierarchy_5.v", line 10) 105 | HB: AddAG.sort is a canonical projection 106 | (from "./examples/demo1/hierarchy_5.v", line 73) 107 | HB: AddAG.sort has the following canonical values: 108 | - Ring.sort (from "./examples/demo1/hierarchy_5.v", line 196) 109 | - Z 110 | HB: AddAG.sort is a coercion from AddAG to Sortclass 111 | (from "./examples/demo1/hierarchy_5.v", line 73) 112 | HB: Z is canonically equipped with structures: 113 | - AddMonoid 114 | AddComoid 115 | AddAG 116 | (from "(stdin)", line 5) 117 | - BiNearRing 118 | SemiRing 119 | Ring 120 | (from "(stdin)", line 10) 121 | HB: hierarchy_5_Ring_class__to__hierarchy_5_SemiRing_class is a coercion from 122 | Ring to SemiRing (from "./examples/demo1/hierarchy_5.v", line 196) 123 | HB: hierarchy_5_Ring__to__hierarchy_5_SemiRing is a coercion from 124 | Ring to SemiRing (from "./examples/demo1/hierarchy_5.v", line 196) 125 | Toplevel input, character 15: 126 | > HB.about Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid. 127 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 128 | Error: 129 | HB: unable to locate 130 | Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid 131 | HB: synthesized in file File "(stdin)", line 5, column 0, character 127: 132 | Interactive Module hierarchy_5 started 133 | Interactive Module AddComoid started 134 | HB: Z is canonically equipped with structures: 135 | - AddMonoid 136 | demo1.hierarchy_5.AddComoid 137 | AddAG 138 | (from "(stdin)", line 5) 139 | - BiNearRing 140 | SemiRing 141 | Ring 142 | (from "(stdin)", line 10) 143 | -------------------------------------------------------------------------------- /tests/about.v.out.19: -------------------------------------------------------------------------------- 1 | HB: AddMonoid_of_TYPE is a factory 2 | (from "./examples/demo1/hierarchy_5.v", line 10) 3 | HB: AddMonoid_of_TYPE operations and axioms are: 4 | - zero 5 | - add 6 | - addrA 7 | - add0r 8 | - addr0 9 | HB: AddMonoid_of_TYPE requires the following mixins: 10 | HB: AddMonoid_of_TYPE provides the following mixins: 11 | - AddMonoid_of_TYPE 12 | HB: AddMonoid_of_TYPE.Build is a factory constructor 13 | (from "./examples/demo1/hierarchy_5.v", line 10) 14 | HB: AddMonoid_of_TYPE.Build requires its subject to be already equipped with: 15 | HB: AddMonoid_of_TYPE.Build provides the following mixins: 16 | - AddMonoid_of_TYPE 17 | HB: arguments: AddMonoid_of_TYPE.Build S zero add addrA add0r addr0 18 | - S : Type 19 | - zero : AddMonoid.sort S 20 | - add : S -> S -> S 21 | - addrA : associative add 22 | - add0r : left_id 0%G add 23 | - addr0 : right_id 0%G add 24 | HB: AddAG.type is a structure (from "./examples/demo1/hierarchy_5.v", line 73) 25 | HB: AddAG.type characterizing operations and axioms are: 26 | - addNr 27 | - opp 28 | HB: AddAG is a factory for the following mixins: 29 | - AddMonoid_of_TYPE 30 | - AddComoid_of_AddMonoid 31 | - AddAG_of_AddComoid (* new, not from inheritance *) 32 | HB: AddAG inherits from: 33 | - AddMonoid 34 | - AddComoid 35 | HB: AddAG is inherited by: 36 | - Ring 37 | HB: AddMonoid.type is a structure 38 | (from "./examples/demo1/hierarchy_5.v", line 17) 39 | HB: AddMonoid.type characterizing operations and axioms are: 40 | - addr0 41 | - add0r 42 | - addrA 43 | - add 44 | - zero 45 | HB: AddMonoid is a factory for the following mixins: 46 | - AddMonoid_of_TYPE (* new, not from inheritance *) 47 | HB: AddMonoid inherits from: 48 | HB: AddMonoid is inherited by: 49 | - AddComoid 50 | - AddAG 51 | - BiNearRing 52 | - SemiRing 53 | - Ring 54 | HB: Ring_of_AddAG is a factory 55 | (from "./examples/demo1/hierarchy_5.v", line 108) 56 | HB: Ring_of_AddAG operations and axioms are: 57 | - one 58 | - mul 59 | - mulrA 60 | - mulr1 61 | - mul1r 62 | - mulrDl 63 | - mulrDr 64 | HB: Ring_of_AddAG requires the following mixins: 65 | - AddMonoid_of_TYPE 66 | - AddComoid_of_AddMonoid 67 | - AddAG_of_AddComoid 68 | HB: Ring_of_AddAG provides the following mixins: 69 | - BiNearRing_of_AddMonoid 70 | Doc: Builds a Ring from an Abelian Group: the absorbing properties mul0r and 71 | mul0r are derived from addrC and the other ring axioms, following a proof 72 | of Hankel (Gerhard Betsch. On the beginnings and development of near-ring 73 | theory. In Near-rings and near-fields. Proceedings of the conference held 74 | in Fredericton, New Brunswick, July 18-24, 1993, pages 1–11. Mathematics 75 | and its Applications, 336. Kluwer Academic Publishers Group, Dordrecht, 76 | 1995). 77 | HB: Ring_of_AddAG.Build is a factory constructor 78 | (from "./examples/demo1/hierarchy_5.v", line 108) 79 | HB: Ring_of_AddAG.Build requires its subject to be already equipped with: 80 | - AddMonoid_of_TYPE 81 | - AddComoid_of_AddMonoid 82 | - AddAG_of_AddComoid 83 | HB: Ring_of_AddAG.Build provides the following mixins: 84 | - BiNearRing_of_AddMonoid 85 | HB: arguments: Ring_of_AddAG.Build A [one] [mul] mulrA mulr1 mul1r mulrDl mulrDr 86 | - A : Type 87 | - one : A 88 | - mul : A -> A -> A 89 | - mulrA : associative mul 90 | - mulr1 : left_id one mul 91 | - mul1r : right_id one mul 92 | - mulrDl : left_distributive mul add 93 | - mulrDr : right_distributive mul add 94 | Doc: Builds a Ring from an Abelian Group: the absorbing properties mul0r and 95 | mul0r are derived from addrC and the other ring axioms, following a proof 96 | of Hankel (Gerhard Betsch. On the beginnings and development of near-ring 97 | theory. In Near-rings and near-fields. Proceedings of the conference held 98 | in Fredericton, New Brunswick, July 18-24, 1993, pages 1–11. Mathematics 99 | and its Applications, 336. Kluwer Academic Publishers Group, Dordrecht, 100 | 1995). 101 | HB: add is an operation of structure AddMonoid 102 | (from "./examples/demo1/hierarchy_5.v", line 17) 103 | HB: add comes from mixin AddMonoid_of_TYPE 104 | (from "./examples/demo1/hierarchy_5.v", line 10) 105 | HB: AddAG.sort is a canonical projection 106 | (from "./examples/demo1/hierarchy_5.v", line 73) 107 | HB: AddAG.sort has the following canonical values: 108 | - Ring.sort (from "./examples/demo1/hierarchy_5.v", line 196) 109 | - Z 110 | HB: AddAG.sort is a coercion from AddAG to Sortclass 111 | (from "./examples/demo1/hierarchy_5.v", line 73) 112 | HB: Z is canonically equipped with structures: 113 | - AddMonoid 114 | AddComoid 115 | AddAG 116 | (from "(stdin)", line 5) 117 | - BiNearRing 118 | SemiRing 119 | Ring 120 | (from "(stdin)", line 10) 121 | HB: hierarchy_5_Ring_class__to__hierarchy_5_SemiRing_class is a coercion from 122 | Ring to SemiRing (from "./examples/demo1/hierarchy_5.v", line 196) 123 | HB: hierarchy_5_Ring__to__hierarchy_5_SemiRing is a coercion from 124 | Ring to SemiRing (from "./examples/demo1/hierarchy_5.v", line 196) 125 | Toplevel input, character 15: 126 | > HB.about Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid. 127 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 128 | Error: 129 | HB: unable to locate 130 | Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid 131 | HB: synthesized in file File "(stdin)", line 5, column 0, character 127: 132 | Interactive Module hierarchy_5 started 133 | Interactive Module AddComoid started 134 | HB: Z is canonically equipped with structures: 135 | - AddMonoid 136 | demo1.hierarchy_5.AddComoid 137 | AddAG 138 | (from "(stdin)", line 5) 139 | - BiNearRing 140 | SemiRing 141 | Ring 142 | (from "(stdin)", line 10) 143 | -------------------------------------------------------------------------------- /tests/about.v.out.20: -------------------------------------------------------------------------------- 1 | HB: AddMonoid_of_TYPE is a factory 2 | (from "./examples/demo1/hierarchy_5.v", line 10) 3 | HB: AddMonoid_of_TYPE operations and axioms are: 4 | - zero 5 | - add 6 | - addrA 7 | - add0r 8 | - addr0 9 | HB: AddMonoid_of_TYPE requires the following mixins: 10 | HB: AddMonoid_of_TYPE provides the following mixins: 11 | - AddMonoid_of_TYPE 12 | HB: AddMonoid_of_TYPE.Build is a factory constructor 13 | (from "./examples/demo1/hierarchy_5.v", line 10) 14 | HB: AddMonoid_of_TYPE.Build requires its subject to be already equipped with: 15 | HB: AddMonoid_of_TYPE.Build provides the following mixins: 16 | - AddMonoid_of_TYPE 17 | HB: arguments: AddMonoid_of_TYPE.Build S zero add addrA add0r addr0 18 | - S : Type 19 | - zero : AddMonoid.sort S 20 | - add : S -> S -> S 21 | - addrA : associative add 22 | - add0r : left_id 0%G add 23 | - addr0 : right_id 0%G add 24 | HB: AddAG.type is a structure (from "./examples/demo1/hierarchy_5.v", line 73) 25 | HB: AddAG.type characterizing operations and axioms are: 26 | - addNr 27 | - opp 28 | HB: AddAG is a factory for the following mixins: 29 | - AddMonoid_of_TYPE 30 | - AddComoid_of_AddMonoid 31 | - AddAG_of_AddComoid (* new, not from inheritance *) 32 | HB: AddAG inherits from: 33 | - AddMonoid 34 | - AddComoid 35 | HB: AddAG is inherited by: 36 | - Ring 37 | HB: AddMonoid.type is a structure 38 | (from "./examples/demo1/hierarchy_5.v", line 17) 39 | HB: AddMonoid.type characterizing operations and axioms are: 40 | - addr0 41 | - add0r 42 | - addrA 43 | - add 44 | - zero 45 | HB: AddMonoid is a factory for the following mixins: 46 | - AddMonoid_of_TYPE (* new, not from inheritance *) 47 | HB: AddMonoid inherits from: 48 | HB: AddMonoid is inherited by: 49 | - AddComoid 50 | - AddAG 51 | - BiNearRing 52 | - SemiRing 53 | - Ring 54 | HB: Ring_of_AddAG is a factory 55 | (from "./examples/demo1/hierarchy_5.v", line 108) 56 | HB: Ring_of_AddAG operations and axioms are: 57 | - one 58 | - mul 59 | - mulrA 60 | - mulr1 61 | - mul1r 62 | - mulrDl 63 | - mulrDr 64 | HB: Ring_of_AddAG requires the following mixins: 65 | - AddMonoid_of_TYPE 66 | - AddComoid_of_AddMonoid 67 | - AddAG_of_AddComoid 68 | HB: Ring_of_AddAG provides the following mixins: 69 | - BiNearRing_of_AddMonoid 70 | Doc: Builds a Ring from an Abelian Group: the absorbing properties mul0r and 71 | mul0r are derived from addrC and the other ring axioms, following a proof 72 | of Hankel (Gerhard Betsch. On the beginnings and development of near-ring 73 | theory. In Near-rings and near-fields. Proceedings of the conference held 74 | in Fredericton, New Brunswick, July 18-24, 1993, pages 1–11. Mathematics 75 | and its Applications, 336. Kluwer Academic Publishers Group, Dordrecht, 76 | 1995). 77 | HB: Ring_of_AddAG.Build is a factory constructor 78 | (from "./examples/demo1/hierarchy_5.v", line 108) 79 | HB: Ring_of_AddAG.Build requires its subject to be already equipped with: 80 | - AddMonoid_of_TYPE 81 | - AddComoid_of_AddMonoid 82 | - AddAG_of_AddComoid 83 | HB: Ring_of_AddAG.Build provides the following mixins: 84 | - BiNearRing_of_AddMonoid 85 | HB: arguments: Ring_of_AddAG.Build A [one] [mul] mulrA mulr1 mul1r mulrDl mulrDr 86 | - A : Type 87 | - one : A 88 | - mul : A -> A -> A 89 | - mulrA : associative mul 90 | - mulr1 : left_id one mul 91 | - mul1r : right_id one mul 92 | - mulrDl : left_distributive mul add 93 | - mulrDr : right_distributive mul add 94 | Doc: Builds a Ring from an Abelian Group: the absorbing properties mul0r and 95 | mul0r are derived from addrC and the other ring axioms, following a proof 96 | of Hankel (Gerhard Betsch. On the beginnings and development of near-ring 97 | theory. In Near-rings and near-fields. Proceedings of the conference held 98 | in Fredericton, New Brunswick, July 18-24, 1993, pages 1–11. Mathematics 99 | and its Applications, 336. Kluwer Academic Publishers Group, Dordrecht, 100 | 1995). 101 | HB: add is an operation of structure AddMonoid 102 | (from "./examples/demo1/hierarchy_5.v", line 17) 103 | HB: add comes from mixin AddMonoid_of_TYPE 104 | (from "./examples/demo1/hierarchy_5.v", line 10) 105 | HB: AddAG.sort is a canonical projection 106 | (from "./examples/demo1/hierarchy_5.v", line 73) 107 | HB: AddAG.sort has the following canonical values: 108 | - Ring.sort (from "./examples/demo1/hierarchy_5.v", line 196) 109 | - Z 110 | HB: AddAG.sort is a coercion from AddAG to Sortclass 111 | (from "./examples/demo1/hierarchy_5.v", line 73) 112 | HB: Z is canonically equipped with structures: 113 | - AddMonoid 114 | AddComoid 115 | AddAG 116 | (from "(stdin)", line 5) 117 | - BiNearRing 118 | SemiRing 119 | Ring 120 | (from "(stdin)", line 10) 121 | HB: hierarchy_5_Ring_class__to__hierarchy_5_SemiRing_class is a coercion from 122 | Ring to SemiRing (from "./examples/demo1/hierarchy_5.v", line 196) 123 | HB: hierarchy_5_Ring__to__hierarchy_5_SemiRing is a coercion from 124 | Ring to SemiRing (from "./examples/demo1/hierarchy_5.v", line 196) 125 | Toplevel input, character 15: 126 | > HB.about Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid. 127 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 128 | Error: 129 | HB: unable to locate 130 | Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid 131 | HB: synthesized in file File "(stdin)", line 5, column 0, character 127: 132 | Interactive Module hierarchy_5 started 133 | Interactive Module AddComoid started 134 | HB: Z is canonically equipped with structures: 135 | - AddMonoid 136 | demo1.hierarchy_5.AddComoid 137 | AddAG 138 | (from "(stdin)", line 5) 139 | - BiNearRing 140 | SemiRing 141 | Ring 142 | (from "(stdin)", line 10) 143 | -------------------------------------------------------------------------------- /tests/bug_435.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record M T := { m : bool }. 4 | HB.structure Definition S := {T of M T}. 5 | 6 | HB.mixin Record A1 X T := { a1 : bool }. 7 | HB.structure Definition B1 X := {T of A1 X T}. 8 | 9 | HB.instance Definition _ (X : Type) := A1.Build X unit true. 10 | 11 | HB.mixin Record A2 (X : Type) T := { a2 : bool }. 12 | HB.structure Definition B2 (X : Type) := {T of A2 X T}. 13 | 14 | (* This should work but fails. *) 15 | Module should_work_but_fails. 16 | HB.structure Definition B (X : S.type) := {T of A1 X T & A2 X T}. 17 | #[verbose] HB.instance Definition _ (X : Type) := A2.Build X unit true. 18 | HB.saturate unit. 19 | Check unit : B.type _. 20 | End should_work_but_fails. 21 | 22 | Module workaround. 23 | HB.instance Definition _ (X : Type) := A2.Build X unit true. 24 | HB.structure Definition B (X : S.type) := {T of A1 X T & A2 X T}. 25 | HB.saturate unit. 26 | Check unit : B.type _. 27 | End workaround. -------------------------------------------------------------------------------- /tests/bug_447.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Variant testTy := A | B. 4 | HB.mixin Record Stack1 T := { prop1 : unit }. 5 | HB.structure Definition JustStack1 := { T of Stack1 T }. 6 | HB.mixin Record Stack1Param R T := { prop2 : unit }. 7 | HB.structure Definition JustStack1Param R := { T of Stack1Param R T }. 8 | 9 | HB.mixin Record Stack2 T := { prop3 : unit }. 10 | HB.structure Definition JustStack2 := { T of Stack2 T }. 11 | HB.mixin Record Mixed T of Stack1 T & Stack2 T := { prop4 : unit }. 12 | HB.structure Definition JustMixed := { T of Mixed T & Stack1 T & Stack2 T}. 13 | HB.structure Definition JustMixedParam R := 14 | { T of Mixed T & Stack1 T & Stack1Param R T & Stack2 T}. 15 | 16 | HB.instance Definition _ := @Stack1.Build testTy tt. 17 | HB.instance Definition _ := @Stack2.Build testTy tt. 18 | 19 | HB.instance Definition _ {R} := @Stack1Param.Build R testTy tt. 20 | HB.instance Definition _ := @Mixed.Build testTy tt. 21 | 22 | Check testTy : JustMixedParam.type _. -------------------------------------------------------------------------------- /tests/class_for.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ssreflect ssrfun ssrbool. 2 | From HB Require Import structures. 3 | 4 | (* without params *) 5 | HB.mixin Record isInhab T := { x : T }. 6 | HB.structure Definition Inhab := { T of isInhab T }. 7 | Definition unit' := unit. 8 | 9 | HB.instance Definition _ := isInhab.Build unit' tt. 10 | Check Inhab.of unit'. 11 | Fail Check Inhab.of unit. 12 | HB.instance Definition _ := Inhab.copy unit unit'. 13 | Check Inhab.of unit. 14 | 15 | (* with params *) 16 | HB.mixin Record isInhabIf (b : bool) (T : Type) := 17 | { y : forall ph : phant T, (match b with true => T | false => unit end) }. 18 | HB.structure Definition InhabIf b := { T of isInhabIf b T }. 19 | 20 | Definition bool' := bool. 21 | HB.instance Definition _ := isInhabIf.Build true bool' (fun=> false). 22 | Check InhabIf.of bool'. 23 | Fail Check InhabIf.of bool. 24 | HB.instance Definition _ := InhabIf.copy bool bool'. 25 | Check InhabIf.of bool. 26 | Check (y (Phant bool) : bool). 27 | -------------------------------------------------------------------------------- /tests/compress_coe.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record hasA T := { a : T }. 5 | HB.structure Definition A := {T of hasA T}. 6 | 7 | HB.mixin Record hasB (p : unit) T of A T := { b : T }. 8 | HB.structure Definition B p := {T of A T & hasB p T}. 9 | 10 | HB.mixin Record hasC (p q : unit) T of B p T := { c : T }. 11 | HB.structure Definition C p q := {T of B p T & hasC p q T}. 12 | 13 | HB.mixin Record hasD T of C tt tt T := { d : T }. 14 | HB.structure Definition D := {T of C tt tt T & hasD T}. 15 | 16 | #[compress_coercions] 17 | HB.instance Definition prodA (A A' : A.type) := 18 | hasA.Build (A * A')%type (a, a). 19 | 20 | #[compress_coercions] 21 | HB.instance Definition prodB p (B B' : B.type p) := 22 | hasB.Build p (B * B')%type (b, b). 23 | 24 | #[compress_coercions] 25 | HB.instance Definition prodC p q (C C' : C.type p q) := 26 | hasC.Build p q (C * C')%type (c, c). 27 | 28 | #[compress_coercions] 29 | HB.instance Definition prodD (D D' : D.type) := 30 | hasD.Build (D * D')%type (d, d). 31 | 32 | Set Printing Coercions. 33 | Print Datatypes_prod__canonical__compress_coe_D. 34 | -------------------------------------------------------------------------------- /tests/compress_coe.v.out: -------------------------------------------------------------------------------- 1 | Datatypes_prod__canonical__compress_coe_D = 2 | fun D D' : D.type => 3 | {| 4 | D.sort := D.sort D * D.sort D'; 5 | D.class := 6 | {| 7 | D.compress_coe_hasA_mixin := 8 | prodA (compress_coe_D__to__compress_coe_A D) 9 | (compress_coe_D__to__compress_coe_A D'); 10 | D.compress_coe_hasB_mixin := 11 | prodB tt (compress_coe_D__to__compress_coe_B D) 12 | (compress_coe_D__to__compress_coe_B D'); 13 | D.compress_coe_hasC_mixin := 14 | prodC tt tt (compress_coe_D__to__compress_coe_C D) 15 | (compress_coe_D__to__compress_coe_C D'); 16 | D.compress_coe_hasD_mixin := prodD D D' 17 | |} 18 | |} 19 | : D.type -> D.type -> D.type 20 | Arguments Datatypes_prod__canonical__compress_coe_D D D' 21 | -------------------------------------------------------------------------------- /tests/compress_coe.v.out.18: -------------------------------------------------------------------------------- 1 | Datatypes_prod__canonical__compress_coe_D = 2 | fun D D' : D.type => 3 | {| 4 | D.sort := D.sort D * D.sort D'; 5 | D.class := 6 | {| 7 | D.compress_coe_hasA_mixin := 8 | prodA (compress_coe_D__to__compress_coe_A D) 9 | (compress_coe_D__to__compress_coe_A D'); 10 | D.compress_coe_hasB_mixin := 11 | prodB tt (compress_coe_D__to__compress_coe_B D) 12 | (compress_coe_D__to__compress_coe_B D'); 13 | D.compress_coe_hasC_mixin := 14 | prodC tt tt (compress_coe_D__to__compress_coe_C D) 15 | (compress_coe_D__to__compress_coe_C D'); 16 | D.compress_coe_hasD_mixin := prodD D D' 17 | |} 18 | |} 19 | : D.type -> D.type -> D.type 20 | Arguments Datatypes_prod__canonical__compress_coe_D D D' 21 | -------------------------------------------------------------------------------- /tests/compress_coe.v.out.19: -------------------------------------------------------------------------------- 1 | Datatypes_prod__canonical__compress_coe_D = 2 | fun D D' : D.type => 3 | {| 4 | D.sort := D.sort D * D.sort D'; 5 | D.class := 6 | {| 7 | D.compress_coe_hasA_mixin := 8 | prodA (compress_coe_D__to__compress_coe_A D) 9 | (compress_coe_D__to__compress_coe_A D'); 10 | D.compress_coe_hasB_mixin := 11 | prodB tt (compress_coe_D__to__compress_coe_B D) 12 | (compress_coe_D__to__compress_coe_B D'); 13 | D.compress_coe_hasC_mixin := 14 | prodC tt tt (compress_coe_D__to__compress_coe_C D) 15 | (compress_coe_D__to__compress_coe_C D'); 16 | D.compress_coe_hasD_mixin := prodD D D' 17 | |} 18 | |} 19 | : D.type -> D.type -> D.type 20 | Arguments Datatypes_prod__canonical__compress_coe_D D D' 21 | -------------------------------------------------------------------------------- /tests/compress_coe.v.out.20: -------------------------------------------------------------------------------- 1 | Datatypes_prod__canonical__compress_coe_D = 2 | fun D D' : D.type => 3 | {| 4 | D.sort := D.sort D * D.sort D'; 5 | D.class := 6 | {| 7 | D.compress_coe_hasA_mixin := 8 | prodA (compress_coe_D__to__compress_coe_A D) 9 | (compress_coe_D__to__compress_coe_A D'); 10 | D.compress_coe_hasB_mixin := 11 | prodB tt (compress_coe_D__to__compress_coe_B D) 12 | (compress_coe_D__to__compress_coe_B D'); 13 | D.compress_coe_hasC_mixin := 14 | prodC tt tt (compress_coe_D__to__compress_coe_C D) 15 | (compress_coe_D__to__compress_coe_C D'); 16 | D.compress_coe_hasD_mixin := prodD D D' 17 | |} 18 | |} 19 | : D.type -> D.type -> D.type 20 | Arguments Datatypes_prod__canonical__compress_coe_D D D' 21 | -------------------------------------------------------------------------------- /tests/declare.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record hasA T := { a : T }. 5 | HB.structure Definition A := {T of hasA T}. 6 | 7 | HB.mixin Record hasB (p : unit) T of A T := { b : T }. 8 | HB.structure Definition B p := {T of A T & hasB p T}. 9 | 10 | HB.mixin Record hasC (p q : unit) T of B p T := { c : T }. 11 | HB.structure Definition C p q := {T of B p T & hasC p q T}. 12 | 13 | Section test. 14 | HB.declare Context p q T of hasA T & hasB p T & hasC p q T. 15 | Definition test := [the C.type _ _ of T]. 16 | End test. 17 | 18 | HB.factory Record hasABC (p q : unit) T := { a : T; b : T; c : T}. 19 | HB.builders Context p q T of hasABC p q T. 20 | HB.instance Definition _ := hasA.Build T a. 21 | HB.instance Definition _ := hasB.Build p T b. 22 | HB.instance Definition _ := hasC.Build p q T c. 23 | HB.end. 24 | 25 | Section test2. 26 | HB.declare Context p q T of hasABC p q T. 27 | Definition test2 := [the C.type _ _ of T]. 28 | End test2. 29 | 30 | (* broken *) 31 | (* Section test3. 32 | Definition copy : Type -> Type := id. 33 | HB.declare Context p T of hasABC p tt (copy T). 34 | Definition test3 := [the C.type _ _ of copy T]. 35 | End test3. *) 36 | -------------------------------------------------------------------------------- /tests/display.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | #[key="T"] 4 | HB.mixin Record m (d : unit) (T : Type) := { 5 | op : T -> T -> T; 6 | }. 7 | 8 | -------------------------------------------------------------------------------- /tests/duplicate_structure.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Definition comb A op := forall x : A, op (op x) = x. 4 | 5 | HB.mixin Record Foo A := { 6 | op : A -> A; 7 | ax : comb A op 8 | }. 9 | 10 | HB.structure Definition S1 := { A of Foo A }. 11 | Fail HB.structure Definition S2 := { A of Foo A }. 12 | -------------------------------------------------------------------------------- /tests/err_bad_mix.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Module Test. 4 | HB.mixin Record Mixin T := { 5 | zero: T; 6 | }. 7 | 8 | HB.structure Definition Struct := { T of Mixin T }. 9 | 10 | HB.instance Definition struct_bool := Mixin.Build bool true. 11 | 12 | Module Exports. 13 | HB.reexport. 14 | End Exports. 15 | End Test. 16 | (** Uncommenting any of these two prevents the issue *) 17 | (* Export Test.Exports. *) 18 | (* HB.export Test. *) 19 | 20 | Fail HB.instance Definition struct_nat := Test.Mixin.Build nat 0. 21 | -------------------------------------------------------------------------------- /tests/err_bad_mix.v.out: -------------------------------------------------------------------------------- 1 | Interactive Module Test started 2 | Interactive Module Exports started 3 | The command has indeed failed with message: 4 | HB: Test.Mixin.axioms_ is not a factory or its library (HB.tests.err_bad_mix.Test) was not correctly imported 5 | -------------------------------------------------------------------------------- /tests/err_instance_nop.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record M T := {}. 4 | HB.structure Definition S := { x of M x }. 5 | HB.instance Definition _ : M nat := M.Build nat. 6 | HB.instance Definition _ : M nat := M.Build nat. -------------------------------------------------------------------------------- /tests/err_instance_nop.v.out: -------------------------------------------------------------------------------- 1 | Toplevel input, character 0: 2 | > HB.instance Definition _ : M nat := M.Build nat. 3 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 4 | Warning: HB: no new instance is generated 5 | [HB.no-new-instance,HB,elpi,default] 6 | -------------------------------------------------------------------------------- /tests/err_instance_nop.v.out.18: -------------------------------------------------------------------------------- 1 | Toplevel input, character 155: 2 | Warning: HB: no new instance is generated 3 | [HB.no-new-instance,HB,elpi,default] 4 | -------------------------------------------------------------------------------- /tests/err_instance_nop.v.out.19: -------------------------------------------------------------------------------- 1 | Toplevel input, character 155: 2 | Warning: HB: no new instance is generated 3 | [HB.no-new-instance,HB,elpi,default] 4 | -------------------------------------------------------------------------------- /tests/err_instance_nop.v.out.20: -------------------------------------------------------------------------------- 1 | Toplevel input, character 155: 2 | Warning: HB: no new instance is generated 3 | [HB.no-new-instance,HB,elpi,default] 4 | -------------------------------------------------------------------------------- /tests/err_miss_dep.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | HB.mixin Record IsAddComoid A := {}. 3 | HB.structure Definition AddComoid := { A of IsAddComoid A }. 4 | HB.mixin Record IsAbelianGrp A of IsAddComoid A := {}. 5 | HB.structure Definition AbelianGrp := { A of IsAbelianGrp A }. 6 | Fail HB.mixin Record IsRing K of IsAbelianGrp K (*& IsAddComoid K*) := {}. 7 | -------------------------------------------------------------------------------- /tests/err_miss_dep.v.out: -------------------------------------------------------------------------------- 1 | Toplevel input, character 0: 2 | > HB.structure Definition AbelianGrp := { A of IsAbelianGrp A }. 3 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 4 | Warning: 5 | pulling in dependencies: [err_miss_dep_IsAddComoid] 6 | Please list them or end the declaration with '&' 7 | [HB.implicit-structure-dependency,HB,elpi,default] 8 | The command has indeed failed with message: 9 | HB: Unable to find mixin err_miss_dep_IsAddComoid on subject K 10 | -------------------------------------------------------------------------------- /tests/err_miss_key.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Fail #[key="Tmiss"] 4 | HB.mixin Record Foo T := {}. -------------------------------------------------------------------------------- /tests/err_miss_key.v.out: -------------------------------------------------------------------------------- 1 | The command has indeed failed with message: 2 | HB: The #[key="Tmiss"] attribute does not match the selected subject T 3 | -------------------------------------------------------------------------------- /tests/err_missin_subject.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | HB.mixin Record M X := {}. 3 | HB.structure Definition S := { X of M X}. 4 | HB.instance Definition _ : M nat := M.Build _. 5 | HB.instance Definition _ : M _ := M.Build bool. 6 | Fail HB.instance Definition _ : M _ := M.Build _. -------------------------------------------------------------------------------- /tests/err_missin_subject.v.out: -------------------------------------------------------------------------------- 1 | The command has indeed failed with message: 2 | HB: The instance subject must be explicitly given. 3 | Use: 4 | HB.instance Definition _ : M := ... 5 | HB.instance Definition _ := M.Build ... 6 | -------------------------------------------------------------------------------- /tests/factory_sort.v: -------------------------------------------------------------------------------- 1 | Require Import ssreflect ssrfun ssrbool. 2 | From HB Require Import structures. 3 | 4 | #[verbose] HB.mixin Record hasA T := { a : T }. 5 | About hasA.type. 6 | HB.structure Definition A := {T of hasA T}. 7 | 8 | HB.mixin Record hasB T := { b : T }. 9 | About hasB.type. 10 | HB.structure Definition B := {T of hasB T}. 11 | 12 | HB.structure Definition AB := {T of hasA T & hasB T}. 13 | 14 | HB.factory Record hasAB T := { a : T; b : T }. 15 | HB.builders Context T of hasAB T. 16 | HB.instance Definition _ := AB.copy T 17 | (AB.pack T (hasB.Build (hasA.Build T a) b)). 18 | HB.end. 19 | About hasAB.type. 20 | 21 | HB.factory Definition hasA' T := hasA T. 22 | About hasA'.type. 23 | 24 | Section test. 25 | Variables (G : Prop) (P : AB.type -> G). 26 | 27 | Goal forall T (a b : T), G. 28 | Proof. 29 | move=> T a b. 30 | pose Ta := hasA.Build _ a. 31 | pose Tab := hasB.Build Ta b. 32 | exact: P (AB.pack T Tab). 33 | Qed. 34 | 35 | Goal forall T (a b : T), G. 36 | Proof. 37 | move=> T a b. 38 | exact: P [the AB.type of hasAB.Build T a b : Type]. 39 | Qed. 40 | 41 | End test. 42 | -------------------------------------------------------------------------------- /tests/factory_when_notation.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | Notation x := (fun x : nat => true). 3 | HB.mixin Record m T := {x : T}. 4 | HB.factory Record f T := { x : T }. 5 | HB.builders Context T of f T. 6 | HB.instance Definition _ := m.Build T x. 7 | HB.end. 8 | -------------------------------------------------------------------------------- /tests/fix_loop.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record M A := { x: nat }. 4 | HB.structure Definition S := { A of M A }. 5 | -------------------------------------------------------------------------------- /tests/fun_instance.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun ssrbool. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record HasA T := { a : T }. 5 | HB.structure Definition A := { T of HasA T }. 6 | 7 | HB.instance Definition _ T (T' : A.type) := 8 | HasA.Build (T -> T') (fun=> a). 9 | 10 | HB.instance Definition _ := HasA.Build Prop True. 11 | 12 | HB.instance Definition _ := HasA.Build Type nat. 13 | -------------------------------------------------------------------------------- /tests/grefclass.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Definition pred T := T -> bool. 4 | 5 | HB.mixin Record isPredNat (f : pred nat) := {}. 6 | 7 | HB.structure Definition PredNat := {f of isPredNat f}. 8 | 9 | Section TestSort. 10 | Variable p : PredNat.type. 11 | Check p : pred nat. 12 | End TestSort. 13 | -------------------------------------------------------------------------------- /tests/hb_pack.v: -------------------------------------------------------------------------------- 1 | Require Import ssreflect ssrfun ssrbool. 2 | From elpi Require Import elpi. 3 | From HB Require Import structures. 4 | 5 | #[verbose] HB.mixin Record hasA T := { a : T }. 6 | About hasA.type. 7 | HB.structure Definition A := {T of hasA T}. 8 | 9 | HB.mixin Record hasB T := { b : T * T }. 10 | About hasB.type. 11 | HB.structure Definition B := {T of hasB T}. 12 | #[short(pack="AB.pack")] 13 | HB.structure Definition AB := {T of hasA T & hasB T}. 14 | 15 | HB.factory Record hasAB T := { a : T; b : T * T }. 16 | HB.builders Context T of hasAB T. 17 | 18 | Definition xxx := HB.pack_for AB.type T (hasB.Build T b) (hasA.Build T a). 19 | HB.instance Definition _ := AB.copy T xxx. 20 | HB.end. 21 | About hasAB.type. 22 | 23 | HB.factory Definition hasA' T := hasA T. 24 | About hasA'.type. 25 | 26 | Section test. 27 | Variables (G : Prop) (P : AB.type -> G). 28 | (* problem with planB 29 | Goal forall T (a b : T), G. 30 | Proof. 31 | move=> T a b. 32 | pose Ta := hasA.Build _ a. 33 | pose A := ltac:(elpi HB.pack_for (A.type) (T) (Ta)). 34 | pose Tab := hasB.Build A (b,b). 35 | pose AB : AB.type := ltac:(elpi HB.pack (A) (Tab)). 36 | exact: P AB. 37 | Qed. 38 | *) 39 | Goal forall T (a b : T), G. 40 | Proof. 41 | move=> T a b. 42 | pose Ta := hasA.Build _ a. 43 | pose A := HB.pack_for A.type T Ta. 44 | pose Tab := hasB.Build A (b,b). 45 | pose AB := HB.pack_for AB.type A Tab. 46 | exact: P AB. 47 | Qed. 48 | 49 | Goal forall T (a b : T), G. 50 | Proof. 51 | move=> T a b. 52 | pose Ta := hasA.Build _ a. 53 | pose A : A.type := HB.pack T Ta. 54 | pose Tab := hasB.Build A (b,b). 55 | pose AB : AB.type := HB.pack A Tab. 56 | exact: P AB. 57 | Qed. 58 | 59 | 60 | Check forall T : AB.type, 61 | let x := AB.pack T in 62 | x. 63 | 64 | Goal forall T (a b : T), G. 65 | Proof. 66 | move=> T a b. 67 | 68 | unshelve epose (A := HB.pack_for A.type T (_ : hasA T)). 69 | by exact: (hasA.Build _ a). 70 | Check A : A.type. 71 | 72 | unshelve epose (A1 := HB.pack_for A.type T (hasA.Build T _)). 73 | by exact: a. 74 | Check A : A.type. 75 | 76 | pose AB1 := AB.pack A (_ : hasB _). 77 | Check AB1 : hasB A -> AB.type. 78 | 79 | have [:Bm] @AB2 := AB.pack A (Bm : hasB A). 80 | by exact: (hasB.Build _ (b,b)). 81 | Check Bm : hasB A. 82 | Check AB2 : AB.type. 83 | 84 | have [:pB] @AB3 := AB.pack A (hasB.Build A pB). 85 | by exact: (b,b). 86 | Check pB : T * T. 87 | Check AB3 : AB.type. 88 | 89 | have [:pA pB'] @AB4 := AB.pack T (hasAB.Build A pA pB'). 90 | by exact: a. 91 | by exact: (b,b). 92 | 93 | exact: P AB4. 94 | Qed. 95 | 96 | End test. 97 | 98 | HB.mixin Record HasFoo (A : Type) (P : A -> Prop) T := { 99 | foo : forall x, P x -> T; 100 | }. 101 | #[short(pack="Foo.pack")] 102 | HB.structure Definition Foo A P := { T of HasFoo A P T }. 103 | 104 | Section test2. 105 | Variable A : Type. 106 | Variable P : A -> Prop. 107 | 108 | Goal forall T, (forall x, P x -> T) -> True. 109 | intros T H. 110 | pose X := Foo.pack T (HasFoo.Build A P T H). 111 | Check X : Foo.type A P. 112 | Abort. 113 | 114 | End test2. 115 | 116 | HB.mixin Record isID T (F : T -> T) := { p : forall x : T, F x = x }. 117 | HB.structure Definition Fun T := { F of isID T F }. 118 | 119 | Goal forall f : nat -> nat, forall p : (forall x, f x = x ), True. 120 | intros f p. 121 | pose F := isID.Build nat f p. 122 | pose T : Fun.type nat := HB.pack f F. 123 | Check T : Fun.type nat. 124 | Abort. 125 | 126 | -------------------------------------------------------------------------------- /tests/hnf.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record M A := { x: nat }. 4 | HB.structure Definition S := { X of M X}. 5 | 6 | HB.factory Record f A := { y : nat }. 7 | HB.builders Context T of f T. 8 | HB.instance Definition _ := M.Build T (y + 1). 9 | HB.end. 10 | 11 | #[hnf] HB.instance Definition _ := f.Build nat (3 + 2). 12 | Print Datatypes_nat__canonical__hnf_S. 13 | Print HB_unnamed_mixin_8. 14 | 15 | HB.instance Definition _ := f.Build bool (3 + 2). 16 | Print Datatypes_bool__canonical__hnf_S. 17 | Print HB_unnamed_mixin_12. 18 | 19 | -------------------------------------------------------------------------------- /tests/hnf.v.out: -------------------------------------------------------------------------------- 1 | Datatypes_nat__canonical__hnf_S = 2 | {| S.sort := nat; S.class := {| S.hnf_M_mixin := HB_unnamed_mixin_8 |} |} 3 | : S.type 4 | HB_unnamed_mixin_8 = 5 | {| M.x := f.y nat HB_unnamed_factory_6 + 1 |} 6 | : M.axioms_ nat 7 | Datatypes_bool__canonical__hnf_S = 8 | {| S.sort := bool; S.class := {| S.hnf_M_mixin := HB_unnamed_mixin_12 |} |} 9 | : S.type 10 | HB_unnamed_mixin_12 = 11 | Builders_1.HB_unnamed_factory_3 bool HB_unnamed_factory_9 12 | : M.axioms_ bool 13 | -------------------------------------------------------------------------------- /tests/hnf.v.out.16: -------------------------------------------------------------------------------- 1 | Datatypes_nat__canonical__hnf_S = 2 | {| S.sort := nat; S.class := {| S.hnf_M_mixin := HB_unnamed_mixin_8 |} |} 3 | : S.type 4 | HB_unnamed_mixin_8 = 5 | {| M.x := f.y nat HB_unnamed_factory_6 + 1 |} 6 | : M.axioms_ nat 7 | Datatypes_bool__canonical__hnf_S = 8 | {| S.sort := bool; S.class := {| S.hnf_M_mixin := HB_unnamed_mixin_12 |} |} 9 | : S.type 10 | HB_unnamed_mixin_12 = 11 | Builders_2.HB_unnamed_factory_4 bool HB_unnamed_factory_9 12 | : M.axioms_ bool 13 | -------------------------------------------------------------------------------- /tests/howto.v.out: -------------------------------------------------------------------------------- 1 | Toplevel input, character 0: 2 | > From Coq Require Import ZArith ssrfun ssreflect. 3 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 4 | Warning: "From Coq" has been replaced by "From Stdlib". 5 | [deprecated-from-Coq,deprecated-since-9.0,deprecated,default] 6 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 7 | - Ring_of_TYPE 8 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 9 | - AddAG_of_TYPE; Ring_of_AddAG 10 | - AddAG_of_TYPE; SemiRing_of_AddComoid 11 | - AddComoid_of_TYPE; Ring_of_AddComoid 12 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 13 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 14 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 15 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 16 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 17 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 18 | - Ring_of_TYPE 19 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 20 | - AddAG_of_TYPE; Ring_of_AddAG 21 | - AddAG_of_TYPE; SemiRing_of_AddComoid 22 | - AddComoid_of_TYPE; Ring_of_AddComoid 23 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 24 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 25 | - Ring_of_TYPE 26 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 27 | - AddAG_of_TYPE; Ring_of_AddAG 28 | - AddAG_of_TYPE; SemiRing_of_AddComoid 29 | - AddComoid_of_TYPE; Ring_of_AddComoid 30 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 31 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 32 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 33 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 34 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 35 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 36 | - Ring_of_TYPE 37 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 38 | - AddAG_of_TYPE; Ring_of_AddAG 39 | - AddAG_of_TYPE; SemiRing_of_AddComoid 40 | - AddComoid_of_TYPE; Ring_of_AddComoid 41 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 42 | The command has indeed failed with message: 43 | HB: no solution found, try to increase search depth. 44 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 45 | - Ring_of_AddComoid 46 | - AddAG_of_AddComoid; BiNearRing_of_AddMonoid 47 | - AddAG_of_AddComoid; Ring_of_AddAG 48 | - AddAG_of_AddComoid; SemiRing_of_AddComoid 49 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 50 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 51 | - BiNearRing_of_AddMonoid 52 | - Ring_of_AddAG 53 | - SemiRing_of_AddComoid 54 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 55 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 56 | - BiNearRing_of_AddMonoid 57 | - Ring_of_AddAG 58 | - SemiRing_of_AddComoid 59 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 60 | HB: nothing to do. 61 | -------------------------------------------------------------------------------- /tests/howto.v.out.18: -------------------------------------------------------------------------------- 1 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 2 | - Ring_of_TYPE 3 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 4 | - AddAG_of_TYPE; Ring_of_AddAG 5 | - AddAG_of_TYPE; SemiRing_of_AddComoid 6 | - AddComoid_of_TYPE; Ring_of_AddComoid 7 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 8 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 9 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 10 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 11 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 12 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 13 | - Ring_of_TYPE 14 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 15 | - AddAG_of_TYPE; Ring_of_AddAG 16 | - AddAG_of_TYPE; SemiRing_of_AddComoid 17 | - AddComoid_of_TYPE; Ring_of_AddComoid 18 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 19 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 20 | - Ring_of_TYPE 21 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 22 | - AddAG_of_TYPE; Ring_of_AddAG 23 | - AddAG_of_TYPE; SemiRing_of_AddComoid 24 | - AddComoid_of_TYPE; Ring_of_AddComoid 25 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 26 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 27 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 28 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 29 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 30 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 31 | - Ring_of_TYPE 32 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 33 | - AddAG_of_TYPE; Ring_of_AddAG 34 | - AddAG_of_TYPE; SemiRing_of_AddComoid 35 | - AddComoid_of_TYPE; Ring_of_AddComoid 36 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 37 | The command has indeed failed with message: 38 | HB: no solution found, try to increase search depth. 39 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 40 | - Ring_of_AddComoid 41 | - AddAG_of_AddComoid; BiNearRing_of_AddMonoid 42 | - AddAG_of_AddComoid; Ring_of_AddAG 43 | - AddAG_of_AddComoid; SemiRing_of_AddComoid 44 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 45 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 46 | - BiNearRing_of_AddMonoid 47 | - Ring_of_AddAG 48 | - SemiRing_of_AddComoid 49 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 50 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 51 | - BiNearRing_of_AddMonoid 52 | - Ring_of_AddAG 53 | - SemiRing_of_AddComoid 54 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 55 | HB: nothing to do. 56 | -------------------------------------------------------------------------------- /tests/howto.v.out.19: -------------------------------------------------------------------------------- 1 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 2 | - Ring_of_TYPE 3 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 4 | - AddAG_of_TYPE; Ring_of_AddAG 5 | - AddAG_of_TYPE; SemiRing_of_AddComoid 6 | - AddComoid_of_TYPE; Ring_of_AddComoid 7 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 8 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 9 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 10 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 11 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 12 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 13 | - Ring_of_TYPE 14 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 15 | - AddAG_of_TYPE; Ring_of_AddAG 16 | - AddAG_of_TYPE; SemiRing_of_AddComoid 17 | - AddComoid_of_TYPE; Ring_of_AddComoid 18 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 19 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 20 | - Ring_of_TYPE 21 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 22 | - AddAG_of_TYPE; Ring_of_AddAG 23 | - AddAG_of_TYPE; SemiRing_of_AddComoid 24 | - AddComoid_of_TYPE; Ring_of_AddComoid 25 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 26 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 27 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 28 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 29 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 30 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 31 | - Ring_of_TYPE 32 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 33 | - AddAG_of_TYPE; Ring_of_AddAG 34 | - AddAG_of_TYPE; SemiRing_of_AddComoid 35 | - AddComoid_of_TYPE; Ring_of_AddComoid 36 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 37 | The command has indeed failed with message: 38 | HB: no solution found, try to increase search depth. 39 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 40 | - Ring_of_AddComoid 41 | - AddAG_of_AddComoid; BiNearRing_of_AddMonoid 42 | - AddAG_of_AddComoid; Ring_of_AddAG 43 | - AddAG_of_AddComoid; SemiRing_of_AddComoid 44 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 45 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 46 | - BiNearRing_of_AddMonoid 47 | - Ring_of_AddAG 48 | - SemiRing_of_AddComoid 49 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 50 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 51 | - BiNearRing_of_AddMonoid 52 | - Ring_of_AddAG 53 | - SemiRing_of_AddComoid 54 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 55 | HB: nothing to do. 56 | -------------------------------------------------------------------------------- /tests/howto.v.out.20: -------------------------------------------------------------------------------- 1 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 2 | - Ring_of_TYPE 3 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 4 | - AddAG_of_TYPE; Ring_of_AddAG 5 | - AddAG_of_TYPE; SemiRing_of_AddComoid 6 | - AddComoid_of_TYPE; Ring_of_AddComoid 7 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 8 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 9 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 10 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 11 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 12 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 13 | - Ring_of_TYPE 14 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 15 | - AddAG_of_TYPE; Ring_of_AddAG 16 | - AddAG_of_TYPE; SemiRing_of_AddComoid 17 | - AddComoid_of_TYPE; Ring_of_AddComoid 18 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 19 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 20 | - Ring_of_TYPE 21 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 22 | - AddAG_of_TYPE; Ring_of_AddAG 23 | - AddAG_of_TYPE; SemiRing_of_AddComoid 24 | - AddComoid_of_TYPE; Ring_of_AddComoid 25 | - AddComoid_of_TYPE; AddAG_of_AddComoid; BiNearRing_of_AddMonoid 26 | - AddComoid_of_TYPE; AddAG_of_AddComoid; Ring_of_AddAG 27 | - AddComoid_of_TYPE; AddAG_of_AddComoid; SemiRing_of_AddComoid 28 | - AddMonoid_of_TYPE; AddComoid_of_AddMonoid; Ring_of_AddComoid 29 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 30 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 31 | - Ring_of_TYPE 32 | - AddAG_of_TYPE; BiNearRing_of_AddMonoid 33 | - AddAG_of_TYPE; Ring_of_AddAG 34 | - AddAG_of_TYPE; SemiRing_of_AddComoid 35 | - AddComoid_of_TYPE; Ring_of_AddComoid 36 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 37 | The command has indeed failed with message: 38 | HB: no solution found, try to increase search depth. 39 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 40 | - Ring_of_AddComoid 41 | - AddAG_of_AddComoid; BiNearRing_of_AddMonoid 42 | - AddAG_of_AddComoid; Ring_of_AddAG 43 | - AddAG_of_AddComoid; SemiRing_of_AddComoid 44 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 45 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 46 | - BiNearRing_of_AddMonoid 47 | - Ring_of_AddAG 48 | - SemiRing_of_AddComoid 49 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 50 | HB: solutions (use 'HB.about F.Build' to see the arguments of each factory F): 51 | - BiNearRing_of_AddMonoid 52 | - Ring_of_AddAG 53 | - SemiRing_of_AddComoid 54 | For a guide on declaring MathComp instances please refer to the following link: https://github.com/math-comp/math-comp/wiki/How-to-declare-MathComp-instances 55 | HB: nothing to do. 56 | -------------------------------------------------------------------------------- /tests/instance_before_structure.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record m1 T := { default1 : T }. 4 | 5 | HB.mixin Record m2 T := { default2 : T }. 6 | 7 | HB.mixin Record m3 T := { default3 : T }. 8 | 9 | HB.structure Definition s1 := { T of m1 T }. 10 | 11 | HB.instance Definition _ : m1 nat := m1.Build nat 1. 12 | 13 | HB.about nat. 14 | 15 | (* too early *) 16 | HB.instance Definition _ : m2 nat := m2.Build nat 2. 17 | 18 | HB.about nat. (* only s1 on nat *) 19 | 20 | HB.instance Definition _ : m3 nat := m3.Build nat 3. 21 | 22 | HB.structure Definition s2 := { T of m1 T & m2 T }. 23 | HB.about nat. (* s2 is not there yet *) 24 | 25 | HB.structure Definition s3 := { T of m3 T }. 26 | HB.about nat. (* s2 has been instanciated but not s3 *) 27 | 28 | 29 | (* here it works *) 30 | HB.saturate. 31 | HB.about nat. (* all there *) 32 | 33 | Check @default1 nat. 34 | Check @default2 nat. 35 | Check @default3 nat. 36 | 37 | 38 | -------------------------------------------------------------------------------- /tests/instance_merge.v: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/math-comp/hierarchy-builder/4b6a76fb6802a770dd929a9dd7e8e03c3a47f73e/tests/instance_merge.v -------------------------------------------------------------------------------- /tests/instance_merge_with_distinct_param.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record m1 T := { default1 : T }. 4 | 5 | HB.mixin Record m2 T := { default2 : T }. 6 | 7 | (* since s1 only requires m1 there is a 1:1 correspondence 8 | between the structure s1 and the mixin m1 *) 9 | HB.structure Definition s1 := { T of m1 T }. 10 | HB.structure Definition s2 := { T of m2 T }. 11 | 12 | HB.instance Definition nat_m1 := m1.Build nat 0. 13 | HB.instance Definition nat_m2 := m2.Build nat 1. 14 | 15 | (* with the following example we want to show that list 16 | preserves the s1 structure ie. if x:s1.type then (list x):s1.type, 17 | in practice we can use this for the type of polynomials *) 18 | HB.instance Definition list_m1 (X : s1.type) : m1 (list X) := 19 | m1.Build (list X) (cons default1 nil). 20 | (* similarly list preserves s2 structure *) 21 | HB.instance Definition list_m2 (X : s2.type) : m2 (list X) := 22 | m2.Build (list X) (cons default2 nil). 23 | 24 | 25 | HB.structure Definition s3 := { T of m1 T & m2 T }. 26 | (* since we can preserve m1 and m2 with list, we can preserve s3 as well ! *) 27 | 28 | (* 29 | if we have a file A with definitions of S1 and S2, 30 | file B importing Awith definitions of instance nat_m1 and nat_m2 31 | file C importing A with the definition of s3 32 | in a file D that imports B and C if we call saturate_instance, we create the instance for s3. 33 | this example shows the need for a separate command 34 | *) 35 | 36 | Fail Check nat : s3.type. 37 | HB.saturate. 38 | Check nat : s3.type. 39 | (* since nat satisfies s3.type, so does list nat *) 40 | Check list nat : s3.type. 41 | Check list (list nat) : s3.type. 42 | 43 | Fail Check fun t : s1.type => (list t : s3.type). 44 | Fail Check fun t : s2.type => (list t : s3.type). 45 | Check fun t : s3.type => (list t : s3.type). 46 | -------------------------------------------------------------------------------- /tests/instance_merge_with_param.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record m1 T := { default1 : T }. 4 | 5 | HB.mixin Record m2 T := { default2 : T }. 6 | 7 | HB.structure Definition s1 := { T of m1 T }. 8 | HB.structure Definition s2 := { T of m2 T }. 9 | 10 | HB.instance Definition _ (X : s1.type) : m1 (list X) := 11 | m1.Build (list X) (cons default1 nil). 12 | HB.instance Definition list_m2 (X : s1.type) : m2 (list X) := 13 | m2.Build (list X) nil. 14 | 15 | HB.structure Definition s3 := { T of m1 T & m2 T }. 16 | 17 | HB.about list. (* should have s3 *) 18 | 19 | (* The s3 instance on list should be synthetized automatically, *) 20 | (* But since it's defined afterwards, it's not taken into account. *) 21 | (* The subtelty now is that there is a parameter, but it's always the same *) 22 | (* A simple recall suffices: *) 23 | HB.instance Definition _ (X : s1.type) := list_m2 X. 24 | HB.about list. 25 | 26 | 27 | -------------------------------------------------------------------------------- /tests/instance_params_no_type.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record is_foo P A := { op : P -> A -> A }. 4 | 5 | HB.instance Definition nat_foo P := is_foo.Build P nat (fun _ x => x). 6 | HB.instance Definition list_foo P := is_foo.Build P (list P) (fun _ x => x). 7 | HB.instance Definition list_foo' P A:= is_foo.Build P (list A) (fun _ x => x). 8 | 9 | About list_foo'. 10 | 11 | HB.structure Definition foo P := { A of is_foo P A }. 12 | 13 | (* .... list A .... 14 | 15 | (fun A => {| 16 | foo.sort := list..; 17 | foo.class := 18 | {| foo.instance_params_no_type_is_foo_mixin := list_foo A |} 19 | |} ). 20 | 21 | 22 | HB.about foo. *) 23 | 24 | (* Elpi Trace Browser. *) 25 | Check nat_foo. 26 | Check list_foo. 27 | HB.mixin Record is_b A:= { default : A }. 28 | Check foo.type. 29 | Print foo.type. 30 | Print Module foo. 31 | Print foo.axioms_. 32 | (*Elpi Trace Browser. *) 33 | HB.structure Definition b := { A of is_b A}. 34 | HB.instance Definition nat_b := is_b.Build nat 0. 35 | 36 | HB.mixin Record is_bar (P : b.type) A := { test : P -> A -> A }. 37 | 38 | HB.structure Definition bar P := { A of is_bar P A}. 39 | HB.instance Definition list_bar P := is_bar.Build P (list P) (fun _ x => x). 40 | Check list_bar. 41 | 42 | -------------------------------------------------------------------------------- /tests/interleave_context.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun ssrbool. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record HasA (n : nat) T := { a : T }. 5 | HB.structure Definition A n := { T of HasA n T }. 6 | 7 | HB.mixin Record HasB (X : A.type 0) (T : Type) := { b : X -> T }. 8 | HB.structure Definition B (X : A.type 0) := { T of HasB X T }. 9 | 10 | (* Since `B` expects an argument of type `A.type 0` (and not just 11 | just the naked type `T`) we pass `A.clone 0 T _` 12 | (of type `A.type 0`) and inference uses the first 13 | parameter `A` to elaborate it. *) 14 | HB.mixin Record IsSelfA T of A 0 T & B (A.clone 0 T _) T := {}. 15 | 16 | HB.structure Definition SelfA := { T of IsSelfA T }. 17 | 18 | HB.factory Record IsSelfA' T := { a : T ; b : T -> T}. 19 | HB.builders Context T of IsSelfA' T. 20 | HB.instance Definition _ := HasA.Build 0 T a. 21 | HB.instance Definition _ := HasB.Build _ T b. 22 | HB.instance Definition _ := IsSelfA.Build T. 23 | HB.end. 24 | 25 | HB.instance Definition _ := IsSelfA'.Build nat 0 id. 26 | -------------------------------------------------------------------------------- /tests/issue284.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record X_of_Type Ω := {}. 4 | HB.structure Definition X := {Ω of X_of_Type Ω}. 5 | 6 | HB.instance Definition XProp := X_of_Type.Build Prop. 7 | Definition prop := Prop. 8 | HB.instance Definition Xprop := X_of_Type.Build prop. 9 | 10 | HB.instance Definition XSet := X_of_Type.Build Set. 11 | Definition set := Set. 12 | HB.instance Definition Xset := X_of_Type.Build set. 13 | 14 | HB.instance Definition XType := X_of_Type.Build Type. 15 | Definition type := Type. 16 | HB.instance Definition Xtype := X_of_Type.Build type. 17 | -------------------------------------------------------------------------------- /tests/issue287.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record InhMixin T := { 4 | point : T; 5 | }. 6 | 7 | HB.structure Definition Inh := { T of InhMixin T }. 8 | 9 | HB.instance Definition nat_inh := InhMixin.Build nat 0. 10 | 11 | Section ProdInh. 12 | 13 | Variables (T S : Inh.type). 14 | 15 | (* This works fine *) 16 | HB.instance Definition prod_inh := 17 | InhMixin.Build (T * S)%type (point, point). 18 | 19 | End ProdInh. 20 | 21 | Section FunInh. 22 | 23 | Variables (T S : Inh.type). 24 | 25 | HB.instance Definition fun_inh := 26 | InhMixin.Build (T -> S) (fun _ => point). 27 | 28 | End FunInh. 29 | -------------------------------------------------------------------------------- /tests/local_instance.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record def A := { default : A }. 4 | HB.structure Definition nonempty := { T of def T }. 5 | 6 | Section Box. 7 | #[local] HB.instance Definition def_nat := def.Build nat 1. 8 | Check default : nat. 9 | End Box. 10 | 11 | #[fail, skip="8.11"] 12 | HB.check (default : nat). 13 | -------------------------------------------------------------------------------- /tests/lock.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.lock Definition foo := 3. 4 | 5 | Definition nat1 := nat. 6 | 7 | HB.lock Definition bar : nat1 := 3. 8 | 9 | HB.lock Definition baz n : nat := 3 + n. 10 | 11 | Module Import X. 12 | 13 | Axiom bigbody : Type -> Type -> Type. 14 | Axiom bigop : forall R I : Type, R -> list I -> (I -> bigbody R I) -> R. 15 | 16 | HB.lock Definition big := bigop. 17 | 18 | End X. 19 | 20 | About big. 21 | 22 | -------------------------------------------------------------------------------- /tests/log_impargs_record.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Set Implicit Arguments. 4 | 5 | #[log] HB.mixin 6 | Record A T := { 7 | a : T; 8 | f : T -> T; 9 | p : forall x : T, f x = x -> True; 10 | q : forall h : f a = a, p _ h = p _ h; 11 | }. 12 | 13 | HB.structure Definition S := { T of A T }. 14 | 15 | About A.p. -------------------------------------------------------------------------------- /tests/missing_join_error.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record isTop M := { }. 4 | HB.structure Definition Top := {M of isTop M}. 5 | 6 | HB.mixin Record isA1 M of Top M := { }. 7 | HB.structure Definition A1 := {M of isA1 M & isTop M}. 8 | 9 | HB.mixin Record isA2 M of Top M := { }. 10 | HB.structure Definition A2 := {M of isA2 M & isTop M}. 11 | 12 | HB.mixin Record isB1 M of A1 M := { }. 13 | HB.structure Definition B1 := {M of isB1 M & }. 14 | 15 | HB.mixin Record isB2 M of A2 M := { }. 16 | HB.structure Definition B2 := {M of isB2 M & isA2 M }. 17 | 18 | HB.structure Definition B2A1 := {M of B2 M & A1 M }. 19 | 20 | Fail HB.structure Definition A2B1 := {M of A2 M & B1 M }. -------------------------------------------------------------------------------- /tests/missing_join_error.v.out: -------------------------------------------------------------------------------- 1 | Toplevel input, character 0: 2 | > HB.structure Definition B2 := {M of isB2 M & isA2 M }. 3 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 4 | Warning: 5 | pulling in dependencies: [missing_join_error_isTop] 6 | Please list them or end the declaration with '&' 7 | [HB.implicit-structure-dependency,HB,elpi,default] 8 | The command has indeed failed with message: 9 | You must declare the hierarchy bottom-up or add a missing join. 10 | There are two ways out: 11 | - declare structure A2B1 before structure B2A1 if B2A1 inherits from it; 12 | - declare an additional structure that inherits from both A1 and A2 and from which A2B1 and/or B2A1 inherit. 13 | -------------------------------------------------------------------------------- /tests/non_forgetful_inheritance.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | Require Import ssreflect ssrfun ssrbool. 3 | 4 | HB.mixin Record HasMul T := { 5 | mul : T -> T -> T; 6 | }. 7 | HB.structure Definition Mul := { T of HasMul T }. 8 | 9 | HB.mixin Record HasSq T := { 10 | sq : T -> T; 11 | }. 12 | HB.structure Definition Sq := { T of HasSq T }. 13 | 14 | (* We need a functorial construction (a container) 15 | which preserves both structures. The simplest one is the option type. *) 16 | Definition option_mul {T : Mul.type} (o1 o2 : option T) : option T := 17 | match o1, o2 with 18 | | Some n, Some m => Some (mul n m) 19 | | _, _ => None 20 | end. 21 | HB.instance Definition _ (T : Mul.type) := HasMul.Build (option T) option_mul. 22 | 23 | Definition option_square {T : Sq.type} (o : option T) : option T := 24 | match o with 25 | | Some n => Some (sq n) 26 | | None => None 27 | end. 28 | HB.instance Definition _ (T : Sq.type) := HasSq.Build (option T) option_square. 29 | 30 | (* Now we mix the two unrelated structures by building Sq out of Mul. 31 | *** This breaks Forgetful Inheritance *** 32 | https://math-comp.github.io/competing-inheritance-paths-in-dependent-type-theory/ 33 | hence, HB prevents us from using it without care. 34 | *) 35 | Set Warnings "+HB.non-forgetful-inheritance". 36 | Fail HB.instance Definition _ (T : Mul.type) := 37 | HasSq.Build T (fun x => mul x x). 38 | 39 | (* As advised by the error message, we contain the problem in a module *) 40 | Module MulSq. 41 | #[non_forgetful_inheritance] 42 | HB.instance Definition _ (T : Mul.type) := HasSq.Build T (fun x => mul x x). 43 | 44 | (* As we expect we can proved this (by reflexivity) *) 45 | Lemma sq_mul (V : Mul.type) (v : V) : sq v = mul v v. 46 | Proof. by reflexivity. Qed. 47 | 48 | Lemma problem (W : Mul.type) (w : option W) : sq w = mul w w. 49 | Proof. 50 | Fail reflexivity. (* What? It used to work! *) 51 | Fail rewrite sq_mul. (* Lemmas don't cross the container either! *) 52 | (* Let's investigate *) 53 | rewrite /mul/= /sq/=. 54 | (* As we expect, we are on the option type. In the LHS it is the Sq built using 55 | the NFI instance 56 | 57 | option_square w = option_mul w w 58 | *) 59 | rewrite /option_mul/=. 60 | rewrite /option_square/sq/=. 61 | congr (match w with Some n => _ | None => None end). 62 | (* The branches for Some differ, since w is a variable, 63 | they don't compare as equal 64 | 65 | (fun n : W => Some (mul n n)) = 66 | (fun n : W => match w with 67 | | Some m => Some (mul n m) 68 | | None => None 69 | end) 70 | *) 71 | Abort. 72 | End MulSq. -------------------------------------------------------------------------------- /tests/not_same_key.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record A T := { a : T }. 4 | #[key="T"] 5 | HB.mixin Record B T1 (T : Type) := { b : T -> T1 }. 6 | 7 | Fail HB.structure Definition sAB T1 := {T of A T & B T T1}. -------------------------------------------------------------------------------- /tests/not_same_key.v.out: -------------------------------------------------------------------------------- 1 | The command has indeed failed with message: 2 | HB: all mixins must have the same key 3 | -------------------------------------------------------------------------------- /tests/packable.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record AddComoid_of_TYPE A := { 5 | zero : A; 6 | add : A -> A -> A; 7 | addrA : associative add; 8 | addrC : commutative add; 9 | add0r : left_id zero add; 10 | }. 11 | HB.structure Definition AddComoid := { A of AddComoid_of_TYPE A }. 12 | 13 | HB.mixin Record Ring_of_AddComoid A of AddComoid A := { 14 | opp : A -> A; 15 | one : A; 16 | mul : A -> A -> A; 17 | addNr : left_inverse zero opp add; 18 | mulrA : associative mul; 19 | mul1r : left_id one mul; 20 | mulr1 : right_id one mul; 21 | mulrDl : left_distributive mul add; 22 | mulrDr : right_distributive mul add; 23 | }. 24 | 25 | HB.factory Record Ring_of_TYPE A := { 26 | zero : A; 27 | one : A; 28 | add : A -> A -> A; 29 | opp : A -> A; 30 | mul : A -> A -> A; 31 | addrA : associative add; 32 | addrC : commutative add; 33 | add0r : left_id zero add; 34 | addNr : left_inverse zero opp add; 35 | mulrA : associative mul; 36 | mul1r : left_id one mul; 37 | mulr1 : right_id one mul; 38 | mulrDl : left_distributive mul add; 39 | mulrDr : right_distributive mul add; 40 | }. 41 | 42 | #[verbose] 43 | HB.builders Context A (a : Ring_of_TYPE A). 44 | 45 | HB.instance 46 | Definition to_AddComoid_of_TYPE := 47 | AddComoid_of_TYPE.Build A zero add addrA addrC add0r. 48 | 49 | HB.instance 50 | Definition to_Ring_of_AddComoid := 51 | Ring_of_AddComoid.Build A _ _ _ addNr mulrA mul1r 52 | mulr1 mulrDl mulrDr. 53 | 54 | HB.end. 55 | 56 | (* End change *) 57 | 58 | HB.structure Definition Ring := { A of Ring_of_TYPE A }. -------------------------------------------------------------------------------- /tests/primitive_records.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From elpi Require Import elpi. 3 | From HB Require Import structures. 4 | 5 | Elpi Command HB.test. 6 | 7 | #[primitive] 8 | HB.mixin Record hasA T := { a : T }. 9 | 10 | Elpi Query lp:{{ 11 | coq.locate "hasA.axioms_" (indt Ind), 12 | std.assert! (coq.env.record? Ind tt) "not primitive" 13 | }}. 14 | 15 | #[primitive] 16 | HB.structure Definition A := {T of hasA T}. 17 | 18 | Elpi Query lp:{{ 19 | coq.locate "A.axioms_" (indt Ind), 20 | std.assert! (coq.env.record? Ind tt) "not primitive" 21 | }}. 22 | 23 | Elpi Query lp:{{ 24 | coq.locate "A.type" (indt Ind), 25 | std.assert! (coq.env.record? Ind tt) "not primitive" 26 | }}. 27 | 28 | (* Issue #248 *) 29 | #[primitive] 30 | HB.mixin Record HasMul T := { 31 | mul : T -> T -> T; 32 | mulC: forall x y : T, mul x y = mul y x; 33 | mulA: associative mul; 34 | }. 35 | 36 | #[primitive] 37 | HB.structure Definition Mul := { T of HasMul T }. 38 | 39 | #[primitive] 40 | HB.mixin Record HasSq T of Mul T := { 41 | sq : T -> T; 42 | pmul : forall x y, sq (mul x y) = mul (sq x) (sq y); 43 | }. 44 | #[primitive] 45 | HB.structure Definition Sq := { T of HasSq T & Mul T }. 46 | Check erefl : Sq.sort _ = Mul.sort _. 47 | -------------------------------------------------------------------------------- /tests/saturate_on.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record HasPoint T := { default : T }. 4 | 5 | HB.instance Definition _ : HasPoint nat := HasPoint.Build nat 0. 6 | HB.instance Definition _ : HasPoint bool := HasPoint.Build bool false. 7 | HB.instance Definition _ A : HasPoint (list A) := HasPoint.Build (list A) nil. 8 | HB.instance Definition _ A : HasPoint Type := HasPoint.Build Type nat. 9 | 10 | HB.structure Definition Pointed := { T of HasPoint T }. 11 | 12 | HB.saturate (list _). 13 | 14 | Fail Check nat : Pointed.type. 15 | Fail Check bool : Pointed.type. 16 | Check (list unit : Pointed.type). 17 | Fail Check Type : Pointed.type. 18 | 19 | 20 | -------------------------------------------------------------------------------- /tests/short.v: -------------------------------------------------------------------------------- 1 | From Corelib Require Import ssreflect ssrfun. 2 | From HB Require Import structures. 3 | 4 | HB.mixin Record hasA T := { a : T }. 5 | #[short(type="aType", pack="AType")] 6 | HB.structure Definition A := {T of hasA T}. 7 | Check aType. 8 | 9 | HB.mixin Record hasB T := { b : T }. 10 | About hasB.type. 11 | #[short(type="bType", pack="BType")] 12 | HB.structure Definition B := {T of hasB T}. 13 | 14 | #[short(type="abType", pack="ABType")] 15 | HB.structure Definition AB := {T of hasA T & hasB T}. 16 | 17 | HB.factory Record hasAB T := { a : T; b : T }. 18 | HB.builders Context T of hasAB T. 19 | Definition xxx := ABType T (hasB.Build T b) (hasA.Build T a). 20 | HB.instance Definition _ := AB.copy T xxx. 21 | HB.end. 22 | About hasAB.type. 23 | 24 | HB.factory Definition hasA' T := hasA T. 25 | About hasA'.type. 26 | 27 | Section test. 28 | Variables (G : Prop) (P : AB.type -> G). 29 | 30 | Goal forall T (a b : T), G. 31 | Proof. 32 | move=> T a b. 33 | pose Ta := hasA.Build T a. 34 | pose Tb := hasB.Build T b. 35 | exact: P (ABType T Ta Tb). 36 | Qed. 37 | 38 | End test. 39 | -------------------------------------------------------------------------------- /tests/subtype.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record is_inhab T := { default : T }. 4 | HB.structure Definition Inhab := { T of is_inhab T }. 5 | 6 | HB.mixin Record is_nontrivial T := { twodiff : forall x : T, exists y : T, ~~ (x = y) }. 7 | 8 | HB.structure Definition Nontrivial1 := { T of is_nontrivial T }. 9 | 10 | HB.structure Definition Nontrivial := { T of is_inhab T & is_nontrivial T }. 11 | 12 | 13 | 14 | Definition pred T := T -> Prop. 15 | 16 | #[key="sub_sort"] 17 | HB.mixin Record is_SUB (T : Type) (P : pred T) (sub_sort : Type) := SubType { 18 | val : sub_sort -> T; 19 | Sub : forall x, P x -> sub_sort; 20 | Sub_rect : forall K (_ : forall x Px, K (@Sub x Px)) u, K u; 21 | SubK : forall x Px, val (@Sub x Px) = x 22 | }. 23 | 24 | HB.structure Definition SUB (T : Type) (P : pred T) := { S of is_SUB T P S }. 25 | 26 | #[verbose] 27 | HB.structure Definition SubInhab (T : Type) P := 28 | { sT of is_inhab sT & is_SUB T P sT }. 29 | 30 | HB.structure Definition SubNontrivial T P := { sT of is_nontrivial sT & is_SUB T P sT }. 31 | 32 | #[key="sT"] 33 | HB.factory Record InhabForSub (T : Inhab.type) P (sT : Type) of SubNontrivial T P sT := {}. 34 | 35 | HB.builders Context (T : Inhab.type) P sT of InhabForSub T P sT. 36 | 37 | Axiom xxx : P (default : T). 38 | HB.instance Definition SubInhabMix := is_inhab.Build sT (Sub (default : T) xxx). 39 | 40 | HB.end. -------------------------------------------------------------------------------- /tests/test_CS_db_filtering.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record base_m T := { A : T }. 4 | HB.structure Definition base := { T of base_m T }. 5 | 6 | HB.mixin Record child1_m T := { C1 : T }. 7 | HB.structure Definition child1 := { T of base T & child1_m T }. 8 | 9 | HB.mixin Record child2_m T := { C2 : T }. 10 | HB.structure Definition child2 := { T of base T & child2_m T }. 11 | 12 | Axiom ix : Type. 13 | Definition vec T := ix -> T. 14 | 15 | Section b. 16 | Variable T : base.type. 17 | HB.instance Definition v_base_m : base_m (vec T) := 18 | base_m.Build _ (fun _ => A). 19 | End b. 20 | 21 | Section c1. 22 | Variable T : child1.type. 23 | HB.instance Definition v_child1_m : child1_m (vec T) := 24 | child1_m.Build _ (fun _ => C1). 25 | End c1. 26 | 27 | Section c2. 28 | Variable T : child2.type. 29 | 30 | HB.instance Definition v_child2_m : child2_m (vec T) := 31 | child2_m.Build _ (fun _ => C2). 32 | 33 | End c2. 34 | -------------------------------------------------------------------------------- /tests/test_synthesis_params.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record IsDualPOrdered (d : unit) T := { 4 | le : T -> T -> bool; ge : T -> T -> bool 5 | }. 6 | 7 | HB.structure Definition POrder d := { T of IsDualPOrdered d T }. 8 | 9 | HB.factory Record IsPOrdered (d : unit) T := { le : T -> T -> bool }. 10 | 11 | HB.builders Context d T of IsPOrdered d T. 12 | HB.instance Definition _ := IsDualPOrdered.Build d T le le. 13 | HB.end. 14 | 15 | HB.mixin Record HasBottom d T of IsDualPOrdered d T := { bottom : T }. 16 | 17 | HB.structure Definition BPOrder d := { T of HasBottom d T & IsDualPOrdered d T }. 18 | 19 | HB.mixin Record HasTop d T of IsDualPOrdered d T := { top : T }. 20 | 21 | HB.structure Definition TPOrder d := { T of HasTop d T & IsDualPOrdered d T }. 22 | 23 | Definition dual (T : Type) := T. 24 | 25 | Definition dd (d:unit) : unit. exact d. Qed. 26 | 27 | HB.instance Definition _ d (T : POrder.type d) := 28 | IsDualPOrdered.Build (dd d) (dual T) (fun x y => @le d T y x) (fun x y => @le d T y x). 29 | 30 | HB.instance Definition _ d (T : TPOrder.type d) := 31 | HasBottom.Build (dd d) (dual T) (@top _ T). 32 | 33 | HB.instance Definition _ d (T : BPOrder.type d) := 34 | HasTop.Build (dd d) (dual T) (@bottom _ T). 35 | 36 | -------------------------------------------------------------------------------- /tests/two_hier.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record m1 T := { default1 : T }. 4 | 5 | HB.mixin Record m2 T := { default2 : T }. 6 | 7 | (* since s1 only requires m1 there is a 1:1 correspondence 8 | between the structure s1 and the mixin m1 *) 9 | HB.structure Definition s1 := { T of m1 T }. 10 | HB.structure Definition s2 := { T of m2 T }. 11 | 12 | HB.instance Definition nat_m1 := m1.Build nat 0. 13 | HB.instance Definition nat_m2 := m2.Build nat 1. 14 | 15 | (* with the following example we want to show that list 16 | preserves the s1 structure ie. if x:s1.type then (list x):s1.type, 17 | in practice we can use this for the type of polynomials *) 18 | HB.instance Definition list_m1 (X : s1.type) : m1 (list X) := 19 | m1.Build (list X) (cons default1 nil). 20 | (* similarly list preserves s2 structure *) 21 | HB.instance Definition list_m2 (X : s2.type) : m2 (list X) := 22 | m2.Build (list X) (cons default2 nil). 23 | 24 | 25 | HB.structure Definition s3 := { T of m1 T & m2 T }. 26 | (* since we can preserve m1 and m2 with list, we can preserve s3 as well ! *) 27 | 28 | (* 29 | if we have a file A with definitions of S1 and S2, 30 | file B importing Awith definitions of instance nat_m1 and nat_m2 31 | file C importing A with the definition of s3 32 | in a file D that imports B and C if we call saturate_instance, we create the instance for s3. 33 | this example shows the need for a separate command 34 | *) 35 | Fail Check nat : s3.type. 36 | HB.saturate. 37 | Check nat : s3.type. 38 | (* since nat satisfies s3.type, so does list nat *) 39 | Check list nat : s3.type. 40 | Check list (list nat) : s3.type. 41 | 42 | Fail Check fun t : s1.type => (list t : s3.type). 43 | Fail Check fun t : s2.type => (list t : s3.type). 44 | Check fun t : s3.type => (list t : s3.type). 45 | 46 | HB.mixin Record m1' (P : s1.type) T := { f1 : P -> T }. 47 | 48 | HB.mixin Record m2' (P : s2.type) T := { f2 : P -> T }. 49 | 50 | (* since s1 only requires m1 there is a 1:1 correspondence 51 | between the structure s1 and the mixin m1 *) 52 | HB.structure Definition s1' P := { T of m1' P T }. 53 | HB.structure Definition s2' P := { T of m2' P T }. 54 | 55 | HB.instance Definition nat_m1' := m1'.Build nat nat (fun _ => 0). 56 | HB.instance Definition nat_m2' := m2'.Build nat nat (fun _ => 1). 57 | 58 | (* with the following example we want to show that list 59 | preserves the s1 structure ie. if x:s1.type then (list x):s1.type, 60 | in practice we can use this for the type of polynomials *) 61 | HB.instance Definition list_m1' (P : s1.type) (X : s1'.type P) : m1' P (list X) := 62 | m1'.Build P (list X) (fun x => cons (f1 x) nil). 63 | (* similarly list preserves s2 structure *) 64 | HB.instance Definition list_m2' (P : s2.type) (X : s2'.type P) : m2' P (list X) := 65 | m2'.Build P (list X) (fun x => cons (f2 x) nil). 66 | 67 | 68 | HB.structure Definition s3' (P : s3.type) := { T of m1' P T & m2' P T }. 69 | Fail Check nat : s3'.type _. 70 | HB.saturate. 71 | Check nat : s3'.type _. 72 | (* since nat satisfies s3'.type, so does list nat *) 73 | Check list nat : s3'.type _. 74 | Check Datatypes_list__canonical__two_hier_s3'. 75 | Check list (list nat) : s3'.type _. -------------------------------------------------------------------------------- /tests/type_of_exported_ops.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Definition comb A op := forall x : A, op (op x) = x. 4 | 5 | HB.mixin Record Foo A := { 6 | op : A -> A; 7 | ax : comb A op 8 | }. 9 | 10 | HB.structure Definition S := { A of Foo A }. 11 | 12 | Set Printing All. 13 | Lemma test1 : True. 14 | Proof. 15 | pose proof @ax as H. 16 | match goal with 17 | | H : forall x : S.type, comb (S.sort x) op |- _ => trivial 18 | | H : ?T |- _ => fail "type of ax not as nice as expected:" T 19 | end. 20 | Qed. 21 | 22 | HB.mixin Record HasMul T := { 23 | mul : T -> T -> T; 24 | mulC: forall x y : T, mul x y = mul y x; 25 | mulA: forall x y z : T, mul x (mul y z) = mul (mul x y) z; 26 | }. 27 | HB.structure Definition Mul := { T of HasMul T }. 28 | Lemma test2 : True. 29 | Proof. 30 | pose proof @mulA as H. 31 | match goal with 32 | | H : forall s : Mul.type, forall x y z : Mul.sort s, mul x (mul y z) = mul (mul x y) z |- _ => trivial 33 | | H : ?T |- _ => fail "type of mulA not as nice as expected:" T 34 | end. 35 | Qed. 36 | -------------------------------------------------------------------------------- /tests/unimported_irrelevant_class.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Module A. 4 | HB.mixin Record isA T := {}. 5 | HB.structure Definition A := {T of isA T}. 6 | End A. 7 | 8 | HB.mixin Record isB T := {}. 9 | HB.structure Definition B := {T of isB T}. 10 | 11 | Module Export C. 12 | Import A. 13 | HB.mixin Record isC T of A T & B T := {}. 14 | HB.structure Definition C := {T of isB T & isA T & isC T}. 15 | End C. 16 | 17 | (* Should not fail: A is irrelevant *) 18 | HB.instance Definition _ := isB.Build unit. -------------------------------------------------------------------------------- /tests/unimported_relevant_class.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | Module A. 4 | HB.mixin Record isA T := {}. 5 | HB.structure Definition A := {T of isA T}. 6 | End A. 7 | 8 | Module Export B. 9 | Import A. 10 | HB.factory Record isB T := {}. 11 | HB.builders Context T of isB T. 12 | HB.instance Definition _ := isA.Build T. 13 | HB.end. 14 | End B. 15 | 16 | (* legitimate failure: A is relevant *) 17 | Fail HB.instance Definition _ := isB.Build unit. -------------------------------------------------------------------------------- /tests/unit/close_hole_term.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | From elpi Require Import elpi. 3 | From Corelib Require Export Setoid. 4 | 5 | Elpi Query HB.instance lp:{{ 6 | X = app [{{list}}, Y_], 7 | % X needs to be typechecked here to get rid of the hole for the type of Y 8 | coq.typecheck X _ ok, 9 | abstract-holes.main X Z, 10 | std.assert! (Z = {{fun x => list x}}) "term badly closed" 11 | }}. 12 | 13 | Elpi Query HB.instance lp:{{ 14 | abstract-holes.main {{nat}} Z, 15 | std.assert! (Z = {{nat}}) "term badly closed" 16 | }}. 17 | 18 | 19 | Class Inj {A B} (R : relation A) (S : relation B) (f : A -> B) : Prop := 20 | inj x y : S (f x) (f y) -> R x y. 21 | 22 | Elpi Query HB.structure lp:{{ 23 | Y = {{Inj}}, %Inj has 5 implicit arguments 24 | saturate-type-constructor Y X, 25 | % X needs to be typechecked here to get rid of the holes of the types of its arguments 26 | coq.typecheck X _ ok, 27 | abstract-holes.main X Z, 28 | std.assert! (Z = {{ fun a b c d e => @Inj a b c d e }}) "term badly closed" 29 | }}. 30 | -------------------------------------------------------------------------------- /tests/unit/enrich_type.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | From elpi Require Import elpi. 3 | From Corelib Require Export Setoid. 4 | 5 | Elpi Query HB.structure lp:{{ 6 | saturate-type-constructor {{nat}} X, 7 | std.assert! (X = {{nat}}) "wrong enriched type" 8 | }}. 9 | 10 | Elpi Query HB.structure lp:{{ 11 | saturate-type-constructor {{list}} X, 12 | std.assert! (X = app [{{list}}, Y_]) "wrong enriched type" 13 | }}. 14 | 15 | Elpi Query HB.structure lp:{{ 16 | Y = (x \ (y \ {{(prod (list lp:x) (list lp:y))}})), 17 | saturate-type-constructor (Y _ _) X, 18 | std.assert! (X = (app [{{prod}}, (app[{{list}},X1_]), app[{{list}},C_]])) "wrong enriched type" 19 | }}. 20 | 21 | Class Inj {A B} (R : relation A) (S : relation B) (f : A -> B) : Prop := 22 | inj x y : S (f x) (f y) -> R x y. 23 | 24 | Elpi Query HB.structure lp:{{ 25 | saturate-type-constructor {{Inj}} X, 26 | std.assert! (X = app [(global (const Inj_)), A_, B_, R_, S_, F_]) "wrong enriched type" 27 | }}. 28 | -------------------------------------------------------------------------------- /tests/unit/mixin_src_has_mixin_instance.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | From elpi Require Import elpi. 3 | 4 | HB.mixin Record m1 T := { default1 : T }. 5 | HB.mixin Record m2 T := { default2 : T }. 6 | 7 | HB.structure Definition s1 := { T of m1 T }. 8 | HB.instance Definition i1 (X : s1.type) : m1 (list X) := 9 | m1.Build (list X) (cons default1 nil). 10 | 11 | HB.instance Definition nat_m1 : m1 nat := m1.Build nat 1. 12 | HB.instance Definition nat_m2 : m2 nat := m2.Build nat 1. 13 | 14 | 15 | Elpi Query HB.instance lp:{{ 16 | mixin-src->has-mixin-instance (mixin-src {{nat}} M1_ {{nat_m1}}) Y, 17 | Y = has-mixin-instance (cs-gref {{:gref nat}}) {{:gref m1.phant_axioms}} {{:gref nat_m1}}. 18 | 19 | }}. 20 | 21 | Section Test. 22 | Variable X:s1.type. 23 | 24 | Elpi Query HB.instance lp:{{ 25 | mixin-src->has-mixin-instance (mixin-src {{list X}} M1_ {{i1 X}}) Y, 26 | Y = has-mixin-instance (cs-gref {{:gref list}}) {{:gref m1.phant_axioms}} {{:gref i1}}. 27 | 28 | }}. 29 | End Test. 30 | 31 | -------------------------------------------------------------------------------- /tests/unit/mk_src_map.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record is_foo P A := { op : P -> A -> A }. 4 | HB.mixin Record is_foo' P A := { op : P -> A -> A }. 5 | 6 | HB.instance Definition list_foo P := is_foo.Build P (list P) (fun _ x => x). 7 | 8 | HB.instance Definition list_foo' P A := is_foo.Build P (list A) (fun _ x => x). 9 | Check list_foo'. 10 | Check list_foo. 11 | 12 | Elpi Query HB.structure lp:{{ 13 | 14 | has-mixin-instance->mixin-src (has-mixin-instance (cs-gref{{:gref list}}) {{:gref is_foo.axioms_}} {{:gref list_foo}}) MS, 15 | MS = (pi a b \ 16 | mixin-src (app [{{list}}, b]) ({{:gref is_foo.axioms_}}) (app [{{list_foo}}, a]) 17 | :- [coq.unify-eq a b ok]) 18 | }}. 19 | 20 | Elpi Query HB.structure lp:{{ 21 | 22 | has-mixin-instance->mixin-src (has-mixin-instance (cs-gref{{:gref list}}) {{:gref is_foo.axioms_}} {{:gref list_foo'}}) MS', 23 | MS' = (pi p a b \ 24 | mixin-src (app [{{list}}, b]) {{:gref is_foo.axioms_}} (app [{{list_foo'}}, p,a]) 25 | :- [coq.unify-eq a b ok]). 26 | }}. -------------------------------------------------------------------------------- /tests/unit/struct.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record m1 T := { default1 : T }. 4 | HB.mixin Record m2 T := { default2 : T }. 5 | HB.mixin Record is_foo P A := { op : P -> A -> A }. 6 | HB.structure Definition foo P := { A of is_foo P A}. 7 | HB.structure Definition foo1 := { A of is_foo (option nat) A & m1 A}. 8 | 9 | 10 | Elpi Query HB.structure lp:{{ 11 | std.findall (has-mixin-instance _ _ _) H_ 12 | }}. 13 | 14 | (* here we don't have any declared instances but a clause is still created by the system : 15 | has-mixin-instance (cs-gref (const «eta»)) (indt «is_foo.axioms_») (const «struct_foo1__to__struct_is_foo») 16 | struct_foo1__to__struct_is_foo is an instance created by the system upon structure declaration to allow 17 | coercions from foo1 to other structures with the mixin is_foo. 18 | *) 19 | Print struct_foo1__to__struct_foo. 20 | 21 | (* its type is 22 | forall A : foo1.type, is_foo.axioms_ (option nat) (eta A)) 23 | which means it can't serve as a coercion for foo2 or foo3, 24 | 25 | however foo3 can still be declared because it has another mixin, 26 | while foo2 can't because it has the exact same mixins than foo 27 | 28 | *) 29 | 30 | 31 | Fail HB.structure Definition foo2 := { A of is_foo bool A}. 32 | 33 | 34 | HB.structure Definition foo3 := { A of is_foo bool A & m2 A}. 35 | 36 | Fail HB.structure Definition fooj := { A of foo1 A & foo3 A}. 37 | -------------------------------------------------------------------------------- /tests_stdlib/about.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssrfun ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_5. 4 | 5 | HB.instance 6 | Definition _ := 7 | AddAG_of_TYPE.Build Z 0%Z Z.add Z.opp 8 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l. 9 | 10 | HB.instance 11 | Definition _ := 12 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 13 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 14 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 15 | Z.mul_add_distr_r Z.mul_add_distr_l. 16 | 17 | (* mixin *) 18 | HB.about AddMonoid_of_TYPE. 19 | 20 | (* mixin constructor *) 21 | HB.about AddMonoid_of_TYPE.Build. 22 | 23 | (* structure *) 24 | HB.about AddAG.type. 25 | 26 | (* class *) 27 | HB.about AddMonoid. 28 | 29 | (* factory *) 30 | HB.about Ring_of_AddAG. 31 | 32 | (* factory constructor *) 33 | HB.about Ring_of_AddAG.Build. 34 | 35 | (* operation *) 36 | HB.about add. 37 | 38 | (* canonical proj/value *) 39 | HB.about AddAG.sort. 40 | 41 | (* canonical value *) 42 | HB.about Z. 43 | 44 | (* coercion *) 45 | HB.about hierarchy_5_Ring_class__to__hierarchy_5_SemiRing_class. 46 | HB.about hierarchy_5_Ring__to__hierarchy_5_SemiRing. 47 | 48 | (* builder *) 49 | HB.about Builders_40.hierarchy_5_Ring_of_AddAG__to__hierarchy_5_BiNearRing_of_AddMonoid. 50 | 51 | HB.locate BinNums_Z__canonical__hierarchy_5_AddAG. 52 | 53 | (* Test minimally qualified names *) 54 | Module Import hierarchy_5. 55 | Module AddComoid. 56 | End AddComoid. 57 | End hierarchy_5. 58 | HB.about Z. 59 | -------------------------------------------------------------------------------- /tests_stdlib/exports.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ssreflect ssrfun ZArith. 2 | From HB Require Import structures. 3 | 4 | Module Enclosing. 5 | (**************************************************************************) 6 | (* Stage 0: +Ring+ *) 7 | (**************************************************************************) 8 | 9 | HB.mixin Record Ring_of_TYPE A := { 10 | zero : A; 11 | one : A; 12 | add : A -> A -> A; 13 | opp : A -> A; 14 | mul : A -> A -> A; 15 | addrA : associative add; 16 | addrC : commutative add; 17 | add0r : left_id zero add; 18 | addNr : left_inverse zero opp add; 19 | mulrA : associative mul; 20 | mul1r : left_id one mul; 21 | mulr1 : right_id one mul; 22 | mulrDl : left_distributive mul add; 23 | mulrDr : right_distributive mul add; 24 | }. 25 | #[mathcomp] 26 | HB.structure Definition Ring := { A of Ring_of_TYPE A }. 27 | 28 | (* Notations *) 29 | 30 | Module RingExports. 31 | Declare Scope hb_scope. 32 | Delimit Scope hb_scope with G. 33 | Local Open Scope hb_scope. 34 | Notation "0" := zero : hb_scope. 35 | Notation "1" := one : hb_scope. 36 | Infix "+" := (@add _) : hb_scope. 37 | Notation "- x" := (@opp _ x) : hb_scope. 38 | Infix "*" := (@mul _) : hb_scope. 39 | Notation "x - y" := (x + - y) : hb_scope. 40 | End RingExports. 41 | HB.export RingExports. 42 | 43 | (* Theory *) 44 | 45 | Section Theory. 46 | Local Open Scope hb_scope. 47 | Variable R : Ring.type. 48 | Implicit Type (x : R). 49 | 50 | Lemma addr0 : right_id (@zero R) add. 51 | Proof. by move=> x; rewrite addrC add0r. Qed. 52 | HB.export addr0. 53 | 54 | Lemma addrN : right_inverse (@zero R) opp add. 55 | Proof. by move=> x; rewrite addrC addNr. Qed. 56 | 57 | Lemma subrr x : x - x = 0. 58 | Proof. by rewrite addrN. Qed. 59 | 60 | Lemma addrNK x y : x + y - y = x. 61 | Proof. by rewrite -addrA subrr addr0. Qed. 62 | 63 | End Theory. 64 | 65 | HB.mixin Record Dummy T := { u : unit }. 66 | HB.structure Definition URing := { R of Ring R & Dummy R }. 67 | 68 | HB.factory Record dummy R of Ring R := {}. 69 | HB.builders Context T of dummy T. 70 | HB.instance Definition _ := Dummy.Build T tt. 71 | Definition addrNK := addrNK. 72 | HB.export addrNK. 73 | HB.end. 74 | 75 | Module Import Instances. 76 | 77 | #[export] 78 | HB.instance 79 | Definition Z_ring_axioms := 80 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 81 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 82 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 83 | Z.mul_add_distr_r Z.mul_add_distr_l. 84 | 85 | Module Exports. 86 | HB.reexport Instances. 87 | End Exports. 88 | End Instances. 89 | 90 | Module Exports. 91 | #[verbose] 92 | HB.reexport. 93 | End Exports. 94 | 95 | Module ExportsOnlyInstance. 96 | Export Instances.Exports. 97 | End ExportsOnlyInstance. 98 | 99 | End Enclosing. 100 | 101 | Module Test1. 102 | 103 | (* We miss the coercions, canonical and elpi metadata *) 104 | Fail Check forall (R : Enclosing.Ring.type) (x : R), x = x. 105 | Fail Check 0%G. 106 | Fail Check addr0. 107 | 108 | Export Enclosing.Exports. 109 | 110 | Check forall (R : Enclosing.Ring.type) (x : R), x = x. 111 | Check 0%G. 112 | Example test1 (m n : Z) : ((m + n) - n + 0 = m)%G. 113 | Proof. by rewrite addrNK addr0. Qed. 114 | 115 | End Test1. 116 | 117 | 118 | Module Test2. 119 | 120 | Fail Check Enclosing.zero : Z. 121 | 122 | Export Enclosing.ExportsOnlyInstance. 123 | 124 | Check Enclosing.zero : Z. 125 | Fail Check 0%G. (* notation not there *) 126 | 127 | End Test2. 128 | -------------------------------------------------------------------------------- /tests_stdlib/exports2.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | From HB Require tests_stdlib.exports. 3 | Import exports.Enclosing. 4 | 5 | #[verbose] HB.reexport. 6 | -------------------------------------------------------------------------------- /tests_stdlib/funclass.v: -------------------------------------------------------------------------------- 1 | From HB Require Import structures. 2 | 3 | HB.mixin Record has_assoc T (F : T -> T -> T) := { 4 | assoc : forall x y z : T , F x (F y z) = F (F x y) z; 5 | }. 6 | HB.structure Definition Magma T := { F of has_assoc T F }. 7 | 8 | HB.mixin Record has_neutral T (F : T -> T -> T) := { 9 | id : T; 10 | idl : forall x : T , F id x = x; 11 | idr : forall x : T , F x id = x; 12 | }. 13 | HB.structure Definition Monoid T := { F of Magma T F & has_neutral T F }. 14 | 15 | About id. 16 | 17 | Require Import Arith ssreflect. 18 | 19 | HB.instance Definition x1 := has_assoc.Build nat plus Nat.add_assoc. 20 | 21 | Lemma plus_O_r x : x + 0 = x. Proof. by rewrite -plus_n_O. Qed. 22 | HB.instance Definition x2 := has_neutral.Build nat plus 0 plus_O_n plus_O_r. 23 | 24 | Check Monoid.on plus. 25 | 26 | Lemma test x : x + 0 = x. 27 | Proof. by rewrite idr. Qed. 28 | 29 | HB.factory Record MOT T (F : T -> T -> T) := { 30 | assoc : forall x y z : T , F x (F y z) = F (F x y) z; 31 | id : T; 32 | idl : forall x : T , F id x = x; 33 | commid : forall x : T , F x id = F id x; 34 | }. 35 | 36 | HB.builders Context T F of MOT T F. 37 | 38 | HB.instance Definition x3 := has_assoc.Build T F assoc. 39 | 40 | Lemma myidr x : F x id = x. 41 | Proof. by rewrite commid idl. Qed. 42 | 43 | HB.instance Definition x4 := has_neutral.Build T F id idl myidr. 44 | 45 | HB.end. 46 | 47 | HB.instance Definition x5 := 48 | MOT.Build nat mult Nat.mul_assoc 1 Nat.mul_1_l (fun x => Nat.mul_comm x 1). 49 | 50 | Check Monoid.on mult. 51 | 52 | HB.mixin Record silly (T1 : Type) (F : Monoid.type T1) (T : Type) := { xx : T }. 53 | HB.structure Definition wp T (F : Monoid.type T) := { A of silly T F A }. 54 | 55 | #[skip="8.11"] 56 | HB.check (forall w : wp.type _ mult, w = w). 57 | 58 | -------------------------------------------------------------------------------- /tests_stdlib/howto.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith ssrfun ssreflect. 2 | From HB Require Import structures. 3 | From HB Require Import demo1.hierarchy_5. 4 | 5 | HB.howto Ring.type. 6 | 7 | HB.howto Ring.type 2. 8 | 9 | HB.howto Z Ring.type. 10 | 11 | HB.howto Z Ring.type 2. 12 | 13 | Fail HB.howto Z Ring.type 0. 14 | 15 | HB.howto AddComoid.type Ring.type. 16 | 17 | HB.instance 18 | Definition _ := 19 | AddAG_of_TYPE.Build Z 0%Z Z.add Z.opp 20 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l. 21 | 22 | HB.howto Z Ring.type. 23 | 24 | HB.howto AddAG.type Ring.type. 25 | 26 | HB.instance 27 | Definition _ := 28 | Ring_of_TYPE.Build Z 0%Z 1%Z Z.add Z.opp Z.mul 29 | Z.add_assoc Z.add_comm Z.add_0_l Z.add_opp_diag_l 30 | Z.mul_assoc Z.mul_1_l Z.mul_1_r 31 | Z.mul_add_distr_r Z.mul_add_distr_l. 32 | 33 | HB.howto Z Ring.type. 34 | --------------------------------------------------------------------------------