pax_global_header00006660000000000000000000000064152304175340014516gustar00rootroot0000000000000052 comment=589c61680d8f2f336fa702fefc7ad46f3090d47e LPCIC-coq-elpi-eb449d7/000077500000000000000000000000001523041753400145035ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.gitattributes000066400000000000000000000000401523041753400173700ustar00rootroot00000000000000*.elpi linguist-language=prolog LPCIC-coq-elpi-eb449d7/.github/000077500000000000000000000000001523041753400160435ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.github/workflows/000077500000000000000000000000001523041753400201005ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.github/workflows/ci.yml000066400000000000000000000043011523041753400212140ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: CI # Controls when the action will run. Triggers the workflow on push or pull request # events but only for the master branch on: push: branches: [ master ] tags: [ "v*.*.*" ] pull_request: branches: [ master ] jobs: docker: runs-on: ubuntu-latest # container actions require GNU/Linux strategy: matrix: image: - 'rocq/rocq-prover:dev' - 'rocq/rocq-prover:9.2' - 'rocq/rocq-prover:9.1' - 'rocq/rocq-prover:9.0' profile: - dev include: - image: 'rocq/rocq-prover:9.1' profile: fatalwarnings fail-fast: false # don't stop jobs if one fails steps: - uses: actions/checkout@v3 - uses: coq-community/docker-coq-action@v1 with: opam_file: 'rocq-elpi.opam' custom_image: ${{ matrix.image }} install: | sudo apt-get update -y -q opam pin add -n -y -k path rocq-elpi $WORKDIR opam pin add -n -y -k path rocq-elpi-json $WORKDIR opam pin add -n -y -k path rocq-elpi-xml $WORKDIR opam update -y opam install --confirm-level=unsafe-yes -j 2 rocq-elpi --deps-only opam install --confirm-level=unsafe-yes -j 2 rocq-elpi-json --deps-only opam install --confirm-level=unsafe-yes -j 2 rocq-elpi-xml --deps-only uninstall: | opam remove -y rocq-elpi opam remove -y rocq-elpi-json opam remove -y rocq-elpi-xml before_script: | sudo chmod -R a+w . if [ "${{ matrix.profile }}" = "fatalwarnings" ]; then sed -i 's/-A/+A/' dune; fi script: | opam install -y -v -j 2 rocq-elpi opam install -y -v -j 2 rocq-elpi-json opam install -y -v -j 2 rocq-elpi-xml opam list after_script: | make all-examples make all-tests export: 'OPAMWITHTEST OPAMIGNORECONSTRAINTS OPAMVERBOSE' # space-separated list of variables env: OPAMWITHTEST: 'true' #OPAMIGNORECONSTRAINTS: 'rocq-core' OPAMVERBOSE: '1' LPCIC-coq-elpi-eb449d7/.github/workflows/doc.yml000066400000000000000000000025201523041753400213670ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: DOC # Controls when the action will run. Triggers the workflow on push or pull request # events but only for the master branch on: push: branches: [ master ] pull_request: branches: [ master ] jobs: build: name: Build doc runs-on: ubuntu-latest steps: - name: workaround bug run: sudo apt-get update - name: checkout uses: actions/checkout@v3 - name: setup ocaml uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: 4.14.2 - name: install deps run: | export OPAMYES=true opam repo add coq https://coq.inria.fr/opam/released opam repo add coq-dev https://coq.inria.fr/opam/core-dev opam repo add extra-dev https://coq.inria.fr/opam/extra-dev opam update opam install rocq-core.9.0.0 vsrocq-language-server coq-core opam install ./rocq-elpi.opam sudo apt-get update sudo apt-get install python3-pip -y - name: build doc run: opam exec -- make doc - name: Save artifact uses: actions/upload-artifact@v4 with: path: doc - name: deploy uses: JamesIves/github-pages-deploy-action@4.1.4 if: ${{ github.ref == 'refs/heads/master' }} with: branch: gh-pages folder: doc LPCIC-coq-elpi-eb449d7/.github/workflows/nix-action-rocq-9.0.yml000066400000000000000000003445351523041753400241600ustar00rootroot00000000000000jobs: bignums: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (bignums) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"bignums\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "bignums" coq: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" coq-elpi: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"coq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq-elpi" coqeal: needs: - coq - mathcomp-ssreflect - mathcomp-algebra - bignums - multinomials - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coqeal) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"coqeal\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "bignums" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "multinomials" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coqeal" hierarchy-builder: needs: - rocq-core - coq-elpi runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (hierarchy-builder) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" jasmin: needs: - coq - mathcomp-word runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (jasmin) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"jasmin\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-word' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-word" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: ITree' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "ITree" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "jasmin" mathcomp: needs: - rocq-core - mathcomp-character - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp" mathcomp-algebra: needs: - rocq-core - mathcomp-order - mathcomp-fingroup - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-algebra\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: micromega-plugin' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "micromega-plugin" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" mathcomp-algebra-tactics: needs: - coq - mathcomp-ssreflect - mathcomp-algebra - coq-elpi - mathcomp-zify runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra-tactics) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-algebra-tactics\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra-tactics" mathcomp-analysis: needs: - rocq-core - mathcomp-reals - mathcomp-field - mathcomp-bigenough - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-analysis" mathcomp-analysis-stdlib: needs: - rocq-core - mathcomp-analysis - mathcomp-reals-stdlib - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-analysis-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals-stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-reals-stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-analysis-stdlib" mathcomp-bigenough: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-bigenough) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-bigenough\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-bigenough" mathcomp-boot: needs: - rocq-core - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-boot) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-boot\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" mathcomp-character: needs: - rocq-core - mathcomp-field - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-character) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-character\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-character" mathcomp-classical: needs: - rocq-core - mathcomp-algebra - mathcomp-finmap runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-classical) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-classical\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-classical" mathcomp-experimental-reals: needs: - rocq-core - mathcomp-analysis - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-experimental-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-experimental-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-experimental-reals" mathcomp-field: needs: - rocq-core - mathcomp-solvable - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-field) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-field\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-solvable' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-solvable" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-field" mathcomp-fingroup: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-fingroup) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-fingroup\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-fingroup" mathcomp-finmap: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-finmap) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-finmap" mathcomp-order: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-order" mathcomp-real-closed: needs: - rocq-core - mathcomp-field - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-real-closed) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-real-closed\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-real-closed" mathcomp-reals: needs: - rocq-core - mathcomp-classical runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-classical' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-classical" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-reals" mathcomp-reals-stdlib: needs: - rocq-core - mathcomp-reals - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-reals-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-reals-stdlib" mathcomp-solvable: needs: - rocq-core - mathcomp-algebra - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-solvable) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-solvable\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-solvable" mathcomp-ssreflect: needs: - coq - mathcomp-boot - mathcomp-order runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-ssreflect) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-ssreflect\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-ssreflect" mathcomp-word: needs: - coq - mathcomp-algebra - mathcomp-ssreflect - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-word) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-word\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-word" mathcomp-zify: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-zify) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"mathcomp-zify\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-finmap - mathcomp-fingroup - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (multinomials) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"multinomials\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "multinomials" rocq-core: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-core) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"rocq-core\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" rocq-elpi: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"rocq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-elpi" rocq-elpi-tests: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"rocq-elpi-tests\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-elpi-tests" rocq-elpi-tests-stdlib: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"rocq-elpi-tests-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-elpi-tests-stdlib" stdlib: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.0\" --argstr job \"stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.0" --argstr job "stdlib" name: Nix CI for bundle rocq-9.0 on: pull_request: paths: - .github/workflows/nix-action-rocq-9.0.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-rocq-9.0.yml types: - opened - synchronize - reopened push: branches: - master LPCIC-coq-elpi-eb449d7/.github/workflows/nix-action-rocq-9.1.yml000066400000000000000000003616751523041753400241650ustar00rootroot00000000000000jobs: bignums: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (bignums) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"bignums\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "bignums" coq: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" coq-elpi: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"coq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq-elpi" coqeal: needs: - coq - mathcomp-ssreflect - mathcomp-algebra - bignums - multinomials - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coqeal) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"coqeal\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "bignums" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "multinomials" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coqeal" hierarchy-builder: needs: - rocq-core - coq-elpi runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (hierarchy-builder) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" jasmin: needs: - coq - mathcomp-word runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (jasmin) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"jasmin\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-word' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-word" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: ITree' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "ITree" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "jasmin" mathcomp: needs: - rocq-core - mathcomp-character - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp" mathcomp-algebra: needs: - rocq-core - mathcomp-order - mathcomp-fingroup - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-algebra\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: micromega-plugin' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "micromega-plugin" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" mathcomp-algebra-tactics: needs: - coq - mathcomp-ssreflect - mathcomp-algebra - coq-elpi - mathcomp-zify runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra-tactics) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-algebra-tactics\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra-tactics" mathcomp-analysis: needs: - rocq-core - mathcomp-reals - mathcomp-field - mathcomp-bigenough - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-analysis" mathcomp-analysis-stdlib: needs: - rocq-core - mathcomp-analysis - mathcomp-reals-stdlib - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-analysis-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals-stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-reals-stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-analysis-stdlib" mathcomp-bigenough: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-bigenough) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-bigenough\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-bigenough" mathcomp-boot: needs: - rocq-core - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-boot) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-boot\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" mathcomp-character: needs: - rocq-core - mathcomp-field - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-character) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-character\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-character" mathcomp-classical: needs: - rocq-core - mathcomp-algebra - mathcomp-finmap runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-classical) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-classical\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-classical" mathcomp-experimental-reals: needs: - rocq-core - mathcomp-analysis - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-experimental-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-experimental-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-experimental-reals" mathcomp-field: needs: - rocq-core - mathcomp-solvable - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-field) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-field\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-solvable' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-solvable" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-field" mathcomp-fingroup: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-fingroup) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-fingroup\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-fingroup" mathcomp-finmap: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-finmap) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-finmap" mathcomp-order: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-order" mathcomp-real-closed: needs: - rocq-core - mathcomp-field - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-real-closed) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-real-closed\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-real-closed" mathcomp-reals: needs: - rocq-core - mathcomp-classical runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-classical' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-classical" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-reals" mathcomp-reals-stdlib: needs: - rocq-core - mathcomp-reals - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-reals-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-reals-stdlib" mathcomp-solvable: needs: - rocq-core - mathcomp-algebra - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-solvable) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-solvable\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-solvable" mathcomp-ssreflect: needs: - coq - mathcomp-boot - mathcomp-order runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-ssreflect) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-ssreflect\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-ssreflect" mathcomp-word: needs: - coq - mathcomp-algebra - mathcomp-ssreflect - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-word) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-word\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-word" mathcomp-zify: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-zify) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"mathcomp-zify\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-finmap - mathcomp-fingroup - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (multinomials) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"multinomials\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "multinomials" odd-order: needs: - coq - mathcomp-character runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (odd-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"odd-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "odd-order" rocq-core: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-core) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"rocq-core\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" rocq-elpi: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"rocq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-elpi" rocq-elpi-tests: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"rocq-elpi-tests\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-elpi-tests" rocq-elpi-tests-stdlib: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"rocq-elpi-tests-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-elpi-tests-stdlib" stdlib: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" trakt: needs: - coq - coq-elpi - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (trakt) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.1\" --argstr job \"trakt\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "trakt" name: Nix CI for bundle rocq-9.1 on: pull_request: paths: - .github/workflows/nix-action-rocq-9.1.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-rocq-9.1.yml types: - opened - synchronize - reopened push: branches: - master LPCIC-coq-elpi-eb449d7/.github/workflows/nix-action-rocq-9.2.yml000066400000000000000000003040371523041753400241530ustar00rootroot00000000000000jobs: bignums: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (bignums) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"bignums\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "bignums" coq: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq" coq-elpi: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"coq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq-elpi" hierarchy-builder: needs: - rocq-core - coq-elpi runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (hierarchy-builder) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" mathcomp: needs: - rocq-core - mathcomp-character - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp" mathcomp-algebra: needs: - rocq-core - mathcomp-order - mathcomp-fingroup - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-algebra\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: micromega-plugin' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "micromega-plugin" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-algebra" mathcomp-analysis: needs: - rocq-core - mathcomp-reals - mathcomp-field - mathcomp-bigenough - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-analysis" mathcomp-bigenough: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-bigenough) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-bigenough\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-bigenough" mathcomp-boot: needs: - rocq-core - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-boot) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-boot\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" mathcomp-character: needs: - rocq-core - mathcomp-field - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-character) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-character\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-character" mathcomp-classical: needs: - rocq-core - mathcomp-algebra - mathcomp-finmap runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-classical) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-classical\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-classical" mathcomp-experimental-reals: needs: - rocq-core - mathcomp-analysis - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-experimental-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-experimental-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-experimental-reals" mathcomp-field: needs: - rocq-core - mathcomp-solvable - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-field) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-field\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-solvable' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-solvable" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-field" mathcomp-fingroup: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-fingroup) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-fingroup\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-fingroup" mathcomp-finmap: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-finmap) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-finmap" mathcomp-order: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-order" mathcomp-real-closed: needs: - rocq-core - mathcomp-field - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-real-closed) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-real-closed\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-real-closed" mathcomp-reals: needs: - rocq-core - mathcomp-classical runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-classical' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-classical" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-reals" mathcomp-solvable: needs: - rocq-core - mathcomp-algebra - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-solvable) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-solvable\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-solvable" mathcomp-ssreflect: needs: - coq - mathcomp-boot - mathcomp-order runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-ssreflect) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-ssreflect\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-ssreflect" mathcomp-word: needs: - coq - mathcomp-algebra - mathcomp-ssreflect - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-word) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"mathcomp-word\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-word" multinomials: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-finmap - mathcomp-fingroup - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (multinomials) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"multinomials\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "multinomials" odd-order: needs: - coq - mathcomp-character runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (odd-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"odd-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "odd-order" rocq-core: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-core) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"rocq-core\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" rocq-elpi: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"rocq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-elpi" rocq-elpi-tests: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"rocq-elpi-tests\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-elpi-tests" rocq-elpi-tests-stdlib: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"rocq-elpi-tests-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-elpi-tests-stdlib" stdlib: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "stdlib" trakt: needs: - coq - coq-elpi - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (trakt) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-9.2\" --argstr job \"trakt\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "trakt" name: Nix CI for bundle rocq-9.2 on: pull_request: paths: - .github/workflows/nix-action-rocq-9.2.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-rocq-9.2.yml types: - opened - synchronize - reopened push: branches: - master LPCIC-coq-elpi-eb449d7/.github/workflows/nix-action-rocq-master.yml000066400000000000000000003540411523041753400251360ustar00rootroot00000000000000jobs: bignums: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (bignums) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"bignums\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "bignums" coq: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" coq-elpi: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"coq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq-elpi" coqeal: needs: - coq - mathcomp-ssreflect - mathcomp-algebra - bignums - multinomials - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (coqeal) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"coqeal\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "bignums" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "multinomials" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coqeal" hierarchy-builder: needs: - rocq-core - coq-elpi runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (hierarchy-builder) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" mathcomp: needs: - rocq-core - mathcomp-character - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp" mathcomp-algebra: needs: - rocq-core - mathcomp-order - mathcomp-fingroup - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-algebra\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: micromega-plugin' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "micromega-plugin" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" mathcomp-algebra-tactics: needs: - coq - mathcomp-ssreflect - mathcomp-algebra - coq-elpi - mathcomp-zify runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-algebra-tactics) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-algebra-tactics\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra-tactics" mathcomp-analysis: needs: - rocq-core - mathcomp-reals - mathcomp-field - mathcomp-bigenough - mathcomp-real-closed runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-real-closed" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-analysis" mathcomp-analysis-stdlib: needs: - rocq-core - mathcomp-analysis - mathcomp-reals-stdlib - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-analysis-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-analysis-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals-stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-reals-stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-analysis-stdlib" mathcomp-bigenough: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-bigenough) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-bigenough\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-bigenough" mathcomp-boot: needs: - rocq-core - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-boot) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-boot\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" mathcomp-character: needs: - rocq-core - mathcomp-field - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-character) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-character\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-character" mathcomp-classical: needs: - rocq-core - mathcomp-algebra - mathcomp-finmap runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-classical) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-classical\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-classical" mathcomp-experimental-reals: needs: - rocq-core - mathcomp-analysis - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-experimental-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-experimental-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-analysis" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-experimental-reals" mathcomp-field: needs: - rocq-core - mathcomp-solvable - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-field) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-field\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-solvable' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-solvable" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-field" mathcomp-fingroup: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-fingroup) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-fingroup\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-fingroup" mathcomp-finmap: needs: - rocq-core - mathcomp-boot runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-finmap) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-finmap" mathcomp-order: needs: - rocq-core - mathcomp-boot - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-order" mathcomp-real-closed: needs: - rocq-core - mathcomp-field - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-real-closed) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-real-closed\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-real-closed" mathcomp-reals: needs: - rocq-core - mathcomp-classical runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-reals\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-classical' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-classical" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-reals" mathcomp-reals-stdlib: needs: - rocq-core - mathcomp-reals - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-reals-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-reals-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-reals' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-reals" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-reals-stdlib" mathcomp-solvable: needs: - rocq-core - mathcomp-algebra - hierarchy-builder runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-solvable) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-solvable\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-solvable" mathcomp-ssreflect: needs: - coq - mathcomp-boot - mathcomp-order runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-ssreflect) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-ssreflect\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-order' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-order" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-ssreflect" mathcomp-word: needs: - coq - mathcomp-algebra - mathcomp-ssreflect - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-word) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-word\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-ssreflect" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-word" mathcomp-zify: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-fingroup - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (mathcomp-zify) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"mathcomp-zify\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-boot - mathcomp-algebra - mathcomp-finmap - mathcomp-fingroup - mathcomp-bigenough runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (multinomials) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"multinomials\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-boot' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-boot" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-algebra' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-finmap" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-fingroup' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-fingroup" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "multinomials" odd-order: needs: - coq - mathcomp-character runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (odd-order) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"odd-order\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: mathcomp-character' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "mathcomp-character" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "odd-order" rocq-core: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-core) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"rocq-core\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" rocq-elpi: needs: [] runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"rocq-elpi\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-elpi" rocq-elpi-tests: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"rocq-elpi-tests\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-elpi-tests" rocq-elpi-tests-stdlib: needs: - rocq-core - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (rocq-elpi-tests-stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"rocq-elpi-tests-stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"\ Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-elpi-tests-stdlib" stdlib: needs: - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (stdlib) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"stdlib\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: rocq-core' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "rocq-core" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" trakt: needs: - coq - coq-elpi - stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ \ fi\nfi\n" - name: Git checkout uses: actions/checkout@v6 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v31 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup coq-elpi uses: cachix/cachix-action@v16 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: coq-elpi - id: stepGetDerivation name: Getting derivation for current job (trakt) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"rocq-master\" --argstr job \"trakt\" \\\n --dry-run 2> err > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting derivation failed\"; exit 1; fi\n" - id: stepCheck name: Checking presence of CI target for current job run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: coq-elpi' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status != 'fetched' name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "trakt" name: Nix CI for bundle rocq-master on: pull_request: paths: - .github/workflows/nix-action-rocq-master.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-rocq-master.yml types: - opened - synchronize - reopened push: branches: - master LPCIC-coq-elpi-eb449d7/.github/workflows/release.yml000066400000000000000000000057351523041753400222550ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: RELEASE # Controls when the action will run. Triggers the workflow on push or pull request # events but only for the master branch on: push: tags: [ "v*.*.*" ] workflow_dispatch: inputs: opam: description: "Force OPAM release" required: true default: false type: boolean suite: description: "OPAM suite" required: true default: "released" type: choice options: - released - extra-dev env: OPAM_SUITE: ${{ inputs.suite }} jobs: release: runs-on: ubuntu-latest if: startsWith(github.ref, 'refs/tags/') steps: - name: Checkout uses: actions/checkout@v4 - name: Inject slug/short variables uses: rlespinasse/github-slug-action@v4 - name: Create archive run: | VERSION="${GITHUB_REF_NAME_SLUG#v}" git archive -o rocq-elpi-$VERSION.tar.gz --prefix=rocq-elpi-$VERSION/ $GITHUB_SHA . - name: Release uses: softprops/action-gh-release@v1 with: files: rocq-elpi-*.tar.gz fail_on_unmatched_files: true prerelease: true generate_release_notes: true name: Rocq-Elpi ${{ github.ref }} for Rocq XXX opam: runs-on: ubuntu-latest if: startsWith(github.ref, 'refs/tags/') || inputs.opam steps: - name: Checkout uses: actions/checkout@v4 with: fetch-depth: 0 - name: Use OCaml 4.14.x uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: 4.14.x opam-local-packages: | !coq-elpi.opam !rocq-elpi.opam !rocq-elpi-json.opam - name: Write PAT env: OPAM_PUBLISH_TOKEN: ${{ secrets.OPAM_PUBLISH_TOKEN }} run: | mkdir -p ~/.opam/plugins/opam-publish printf "$OPAM_PUBLISH_TOKEN" > ~/.opam/plugins/opam-publish/coqelpibot.token - name: Setup SSH uses: webfactory/ssh-agent@v0.8.0 with: ssh-private-key: ${{ secrets.BOT_SSH_KEY }} - name: Install opam-publish run: opam install -y -j 2 opam-publish=2.5.0 - name: Publish run: | eval $(opam env) git config --global user.name coqelpibot git config --global user.email coqelpibot@inria.fr echo known tags: git tag TAG=`git tag --sort=-v:refname|head -1` echo selected tag: $TAG # do not use the new name of the repo, or you get a 404 using GH APIs GITHUB_DEBUG=1 opam-publish --no-confirmation --tag=$TAG \ --packages-directory=${OPAM_SUITE:-released}/packages \ --repo=rocq-prover/opam --no-browser -v ${TAG##v} \ rocq-elpi.opam rocq-elpi-json.opam rocq-elpi-xml.opam \ coq-elpi.opam \ https://github.com/LPCIC/coq-elpi/releases/download/$TAG/rocq-elpi-${TAG##v}.tar.gz LPCIC-coq-elpi-eb449d7/.gitignore000066400000000000000000000013371523041753400164770ustar00rootroot00000000000000*.o *.cmx *.cmo *.cmi *.a *.cmxa *.cmxs *.cma *.cmt *.cmti *.annot .*~ .*.swp *.vo *.vos *.vok *.d *.glob .*.aux *.html *.txt *.crashcoqide \#*\# etc/__pycache__/ /.deps.elpi src/rocq_elpi_config.ml src/rocq_elpi_vernacular_syntax.ml src/rocq_elpi_arg_syntax.ml src/rocq_elpi_builtins_HOAS.ml doc/ Makefile.coq Makefile.coq.conf .merlin Makefile.*.coq Makefile.*.coq.conf tests/test_glob/*.css META *.cache apps/coercion/src/rocq_elpi_coercion_hook.ml .filestoinstall apps/tc/src/rocq_elpi_tc_hook.ml apps/cs/src/rocq_elpi_cs_hook.ml *.timing _build tmp.out rocq-elpi-tests.opam rocq-elpi-tests.install rocq-elpi.install coq-elpi.install theories-stdlib/dune apps/coercion/src/dune apps/cs/src/dune apps/tc/src/dune src/duneLPCIC-coq-elpi-eb449d7/.nix/000077500000000000000000000000001523041753400153575ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.nix/config.nix000066400000000000000000000107341523041753400173510ustar00rootroot00000000000000with builtins; with (import {}).lib; let default-elpi-version = "3.7.1"; min-elpi-version = "3.7.1"; master = [ "hierarchy-builder" "mathcomp" "mathcomp-analysis" "mathcomp-bigenough" "mathcomp-finmap" "mathcomp-real-closed" ]; coq-master = [ "coqeal" "ITree" "mathcomp-algebra-tactics" "mathcomp-word" "mathcomp-zify" "multinomials" "odd-order" "trakt" ]; rocq-common-bundles = listToAttrs (forEach master (p: { name = p; value.override.version = "master"; })) // { rocq-elpi.override.elpi-version = default-elpi-version; rocq-elpi-tests.job = true; rocq-elpi-tests-stdlib.job = true; mathcomp-boot.job = true; mathcomp-fingroup.job = true; mathcomp-order.job = true; mathcomp-algebra.job = true; mathcomp-solvable.job = true; mathcomp-field.job = true; mathcomp-character.job = true; mathcomp-classical.job = true; mathcomp-reals.job = true; mathcomp-experimental-reals.job = true; mathcomp-reals-stdlib.job = true; mathcomp-analysis-stdlib.job = true; }; coq-common-bundles = listToAttrs (forEach (master ++ coq-master) (p: { name = p; value.override.version = "master"; })) // { coq-elpi.override.elpi-version = default-elpi-version; jasmin.override.version = "main"; bignums.job = true; stdlib.job = true; mathcomp-single-planB-src.job = false; mathcomp-single-planB.job = false; mathcomp-single.job = false; deriving.job = false; reglang.job = false; coquelicot.job = false; interval.job = false; QuickChick.job = false; vcfloat.job = false; autosubst.job = false; ConCert.job = false; ITree.job = false; # only a dependency of jasmin }; in { format = "1.0.0"; attribute = "rocq-elpi"; coq-attribute = "coq-elpi"; default-bundle = "rocq-9.1"; bundles = { "rocq-9.0" = { rocqPackages = rocq-common-bundles // { rocq-core.override.version = "9.0"; micromega-plugin.override.version = "master"; # to be removed at some point micromega-plugin.job = false; }; coqPackages = coq-common-bundles // { coq.override.version = "9.0"; odd-order.job = false; # no longer supported since https://github.com/math-comp/odd-order/pull/74 trakt.job = false; # broken }; }; "rocq-9.1" = { rocqPackages = rocq-common-bundles // { rocq-core.override.version = "9.1"; micromega-plugin.override.version = "master"; # to be removed at some point micromega-plugin.job = false; }; coqPackages = coq-common-bundles // { coq.override.version = "9.1"; }; }; "rocq-9.2" = { rocqPackages = rocq-common-bundles // { rocq-core.override.version = "9.2"; micromega-plugin.override.version = "master"; # to be removed at some point micromega-plugin.job = false; coqeal.job = false; # MathComp not released yet mathcomp-reals-stdlib.job = false; # MathComp not released yet mathcomp-analysis-stdlib.job = false; # MathComp not released yet mathcomp-zify.job = false; # MathComp not released yet mathcomp-algebra-tactics.job = false; # MathComp not released yet jasmin.job = false; # MathComp not released yet }; coqPackages = coq-common-bundles // { coq.override.version = "9.2"; }; }; "rocq-master" = { rocqPackages = rocq-common-bundles // { rocq-core.override.version = "master"; micromega-plugin.override.version = "master"; micromega-plugin.job = false; bignums.override.version = "master"; stdlib.override.version = "master"; }; coqPackages = coq-common-bundles // { coq.override.version = "master"; bignums.override.version = "master"; stdlib.override.version = "master"; jasmin.job = false; }; }; } // optionalAttrs (min-elpi-version != default-elpi-version) { "rocq-master-min-elpi" = { rocqPackages = rocq-common-bundles // { rocq-elpi.override.elpi-version = min-elpi-version; rocq-core.override.version = "master"; bignums.override.version = "master"; stdlib.override.version = "master"; }; coqPackages = coq-common-bundles // { coq-elpi.override.elpi-version = min-elpi-version; coq.override.version = "master"; bignums.override.version = "master"; stdlib.override.version = "master"; jasmin.job = false; }; }; }; cachix.coq = {}; cachix.math-comp = {}; cachix.coq-community = {}; cachix.coq-elpi.authToken = "CACHIX_AUTH_TOKEN"; } LPCIC-coq-elpi-eb449d7/.nix/coq-nix-toolbox.nix000066400000000000000000000000531523041753400211370ustar00rootroot00000000000000"9cd6ca08dba2a6557e46cbf3243a24f7f67ec5ff" LPCIC-coq-elpi-eb449d7/.nix/rocq-overlays/000077500000000000000000000000001523041753400201655ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.nix/rocq-overlays/rocq-elpi-tests-stdlib/000077500000000000000000000000001523041753400244775ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.nix/rocq-overlays/rocq-elpi-tests-stdlib/default.nix000066400000000000000000000006121523041753400266420ustar00rootroot00000000000000{ rocq-elpi, rocqPackages }: rocqPackages.lib.overrideRocqDerivation { pname = "rocq-elpi-tests-stdlib"; propagatedBuildInputs = rocq-elpi.propagatedBuildInputs ++ [ rocqPackages.stdlib ]; buildPhase = '' export COQPATH=$ROCQPATH make test-stdlib make examples-stdlib make test-apps-stdlib ''; installPhase = '' echo "nothing to install" ''; } rocq-elpi LPCIC-coq-elpi-eb449d7/.nix/rocq-overlays/rocq-elpi-tests/000077500000000000000000000000001523041753400232205ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.nix/rocq-overlays/rocq-elpi-tests/default.nix000066400000000000000000000003731523041753400253670ustar00rootroot00000000000000{ rocq-elpi, rocqPackages }: rocqPackages.lib.overrideRocqDerivation { pname = "rocq-elpi-tests"; buildPhase = '' make test-core make examples make test-apps ''; installPhase = '' echo "nothing to install" ''; } rocq-elpi LPCIC-coq-elpi-eb449d7/.vscode/000077500000000000000000000000001523041753400160445ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/.vscode/settings.json000066400000000000000000000017321523041753400206020ustar00rootroot00000000000000{ "files.exclude": { "**/*.o": true, "**/*.cmx": true, "**/*.cmo": true, "**/*.cmi": true, "**/*.a": true, "**/*.cmxa": true, "**/*.cmxs": true, "**/*.cma": true, "**/*.cmt": true, "**/*.cmti": true, "**/*.annot": true, "**/.*~": true, "**/.*.swp": true, "**/*.vo": true, "**/*.vos": true, "**/*.vok": true, "**/*.d": true, "**/*.glob": true, "**/.*.aux": true, "**/*.html": true, "**/*.crashcoqide": true, "**/\\#*\\#": true, ".deps.elpi": true, "src/rocq_elpi_config.ml": true, "src/rocq_elpi_vernacular_syntax.ml": true, "**/Makefile.coq": true, "**/Makefile.coq.conf": true, "**/.merlin": true }, "restructuredtext.confPath": "${workspaceFolder}/alectryon/recipes/sphinx", "ocaml.server.args": [ "--fallback-read-dot-merlin" ], } LPCIC-coq-elpi-eb449d7/Changelog.md000066400000000000000000001565251523041753400167320ustar00rootroot00000000000000 # [3.5.0] 21/07/2026 Requires Elpi 3.7.1 and Rocq 9.0, 9.1, 9.2 and 9.3. ### HOAS: - New `minductive` and `mblock` for mutual inductive types - New the `name` data type carries a relevance (as in Rocq). Quotations default to "relevant" as before, while omitted biner names are mapped to Rocq relevance variables, that can be set by the typechecker. Similarly `coq.id->name` leaves the relevance unset, and `coq.name-suffix` preserves the orignal relevance. ### API: - fix `coq.CS.canonical-projection?`, used to disregard `#[canonical=no]` - fix `ltac_tactic:(t)`, use to ignore ltac variables in `t` - New `coq.elpi.add-predicate?` to check if a predicate is declared in elpi - New `coq.env.indt-block` to list the inductive types in the same mutual block - New `coq.name.relevant?` to test the relevance set by the typechecker ### LIB: - Change `coq.build-indt-decl`, now taking a `coq.indt-spec` tuple - New `coq.build-mindt-decl` taking a list of `coq.indt-spec` ### APPS: - Fix many bugs in `derive` related to universe polymorphism - Fix binary parametricity translation for primitive records - Fix param1 and map on mutual inductives ### Vernac: - Fix double accumulation bug when mixing Files and Dbs # [3.4.0] 19/05/2026 Requires Elpi 3.7.1 and Rocq 9.0, 9.1 or 9.2. ### Elpi - Change `accumulate` in Elpi code is now fully supported. There is no difference between `Elpi Accumulate file.` and `Elpi Accumulate lp:{{ accumulate "file". }}.` since Elpi 3.7 exposes accumulated files via the API. Applications with complex file hierarchies can `Accumulate` root files and have each file accumulate its dependencies, so that dependencies are written inside .elpi files, rather than inside the .v files that use them. Example [commit](https://github.com/rocq-community/trocq/commit/df9af6e16ccd5e819b6f625321b2f909a39f20ac) [commit](https://github.com/math-comp/hierarchy-builder/pull/590/changes/0156bcc1f524e1c8df7e3045f65d5de5846f6ea7) ### HOAS - New `mfix` (with `mfix-ty` and `mfix-bo`) for mutual fixpoints ### Vernac - New support for functors and module types: gref are substituted inside rules ### Plugins - New `xml` plugin containing minimal bindings to `xml-light`, see [apps/xml](apps/xml/) for the doc. ### API - Change `main-interp-proof` and `main-interp-qed` changed type to better chain with `coq.ltac.collect-goals`. It is now easy to take a term, extract from it missing subterms and start a proof with goals for these holes, and finally recover the full term at proof end time. Finally, one cannot close a proof started in Elpi with a regular `Qed` anymore. - New argument `const-decl` can now be introduces by the `Lemma` keyword, and not just by `Definition`. - New `coq.scheme` to query registered schemes # [3.3.1] 12/03/2026 Requires Elpi 3.6.1 and Rocq 9.0, 9.1 or 9.2. ### Plugins - New `json` plugin containing minimal bindings to `yojson`, see [apps/json](apps/json/) for the doc. # [3.3.0] 06/03/2026 Requires Elpi 3.6.1 and Rocq 9.0, 9.1 or 9.2. ### HOAS: - Fix explicitly declared goals are considered reachable, even if they do not occur in the proof term - Fix avoid evar-map shelved goals to leak into the tactic shelve. Sometimes a goal was both focused and shelved because of that ### API: - Fix `coq.sort.*` to not rely on puring algebraic universes that will become first class in Rocq 10 - Rename `coq.env.section`, use `coq.env.section-variables` - New `coq.env.section-contents` listing the contents of sections. - New `coq.ltac.call-mltac` to call code defined via `TACTIC EXTEND` directives in OCaml. - New `coq.ltac.call-simple-mltac` for tactics not changing the proof context - New `coq.ltac.call-simple-ltac1` for tactics not changing the proof context - Rename `coq.ltac.collect-goals` -> `coq.ltac.collect-sealed-goals` - New `coq.ltac.collect-simple-goals` for goals in the current proof context - Change `coq.ltac.call-ltac1` also gives a diagnostic - Change `coq.ltac.call` also gives a diagnostic ### Vernacular: - New `Elpi Accumulate Plugin` to load built-in defined in a plugin, see the corresponding example # [3.2.0] 19/09/2025 Requires Elpi 3.0.0 and Coq 8.20 or Rocq 9.0 or Rocq 9.1. ### Apps: - Derive: - Change `Set Uniform Inductive Parameters` is `#[export]` and not `#[global]` ### API - Fix `.glob` generation for `coq.notation.*` - Fix binder handling in `coq.ltac.collect-goals` # [3.1.0] 01/09/2025 Requires Elpi 3.0.0 and Coq 8.20 or Rocq 9.0 or Rocq 9.1. Port to Elpi 3.1 # [3.0.0] 18/7/2025 Requires Elpi 3.0.0 and Coq 8.20 or Rocq 9.0 or Rocq 9.1. ### Workflow - Deprecate `Elpi Typecheck` since code is typechecked upfront when accumulated ### Documentation - Update elpi_lang tutorial w.r.t. Elpi 3.0 new determinacy checker, in particular the `func` declaration and the `=!=>` oeprator ### APPS: - New experimental app `rbuild`: build any record with « ... » ### API - `coq.ltac.collect-goals` now takes the parameters of primitive projections into account # [2.6.0] 8/7/2025 Requires Elpi 2.0.7 and Coq 8.20 or Rocq 9.0 or Rocq 9.1. ### Vernacular - New attributes `#[proof="begin"]`, `#[proof(begin_if="att")]` and `#[proof="end"]` to `Elpi Export` to declare commands starting/ending proofs ### API - New `coq.redflags.proj` to control "unfolding" of primitive projections - New `main-interp-proof` and `main-interp-qed` for commands starting/ending proofs # [2.5.2] 29/4/2025 Requires Elpi 2.0.7 and Coq 8.20 or Rocq 9.0. ### API - New `coq.univ.alg-max` API that relates two universes to their algebraic maximum. # [2.5.1] 22/4/2025 Requires Elpi 2.0.7 and Coq 8.20 or Rocq 9.0. ### APPS: - derive: support for primitive strings in `param1` and `param1_trivial` - derive: support for `is_true` in `param1_trivial` (based on pre-existing special support for `is_eq` and `is_bool`) ### API - New `coq.univ.alg-super` that relates a univ `U` to its algebraic successor `V`, that is `U+1` and not any `V` s.t. `U < V` - New `coq.register` API ### HOAS - New `@keep-alg-univs!` option for all APIs taking terms. By default algebraic universes are replaced by named universes. See the `coq.univ.alg-super` API. # [2.5.0] 18/2/2025 Requires Elpi 2.0.7 and Coq 8.20 or Rocq 9.0. ### Packaging - rename to `rocq-elpi` (`coq-elpi` is a transitional package) - remove cram tests - separate tests bsed on `rocq-stdlib`, the main build targets just depend on `rocq-core` - CI based on docker images rather than ocaml setup ### APPS - derive: fix missing universe constraints in `param2` - derive: new `param2.register` command - derive: improve generated names in `param2` - derive: put eqb AST into a dedicated namespace - derive: new (experimental) derive.eqbOK.register_axiom - eltac: apply and rewrite examples ### API - `coq.count-prods` now count products modulo reduction, rather than purely syntactically - `coq.arity->sort` now attempts reduction to find a sort or prod, before failing - `coq.arity->sort` now handles let-in # [2.4.0] 15/1/2025 Requires Elpi 2.0.7 and Coq 8.20. ### API - Change `coq.env.add-section-variable` now takes the implicit status of the variable # [2.3.0] - 6/12/2024 Requires Elpi 2.0.3 and Coq 8.20. The major change is the port to Elpi 2.0 that reports type checking errors to the location of the offending term and not its enclosing rule. ### Vernacular - `Elpi Accumulate Db Header ` to accumulate just the `Db` declaration but no code added after that - `Elpi File ` to name a piece of code without requiring an external file - `Elpi Accumulate File Signature ` to accumulate only the types declarations from a file. - `Elpi Typecheck` is deprecated and is a no-op since `Elpi Accumulate` performs type checking incrementally ### HOAS - new `open-trm` argument for tactics with syntax ````(...)``` and `ltac_open_term:(...)`. Open terms can mention free variables. - new `{{:pat ...}}` quotations inside which `_` is interpreted as a wildcard, not as a regular evar. ### API - Support export locality in `coq.TC.declare-instance` - `tc-instance` now just carries a priority, no matter if inferred or declared, and works for instances added as `Hint Resolve` to the `typclass_instances` database ### Build system - Support dune workspace build with `elpi` ### Misc - Resolve `.elpi` files based on Coq's resolver. Paths are now expected to be of the form `/`, where `` part is a logical Coq directory (as mapped with `-Q` or `-R`), and `` is a relative path from the corresponding directory. # [2.2.3] - 30/07/2024 Requires Elpi 1.19.2 and Coq 8.19 or Coq 8.20. ### API - New `coq.arguments.reset-simplification` - Change some speedup concerning universes # [2.2.2] - 15/07/2024 Requires Elpi 1.19.2 and Coq 8.19 or Coq 8.20. ### Packaging - Fix release script to just publish coq-elpi (and not coq-elpi-tests) - Fix opam constraints by adding upper bound # [2.2.1] - 12/07/2024 Requires Elpi 1.19.2 and Coq 8.19 or Coq 8.20. ### Error reporting - Fix type checking errors on inline code are now reported on the correct line in LSP based interfaces ### Build system - Fix various missing dependencies - Fix rebuild before installation - Change CI no more use of docker images - Change silence `default-output-directory` warning ### Apps/tc - Change organize the code inside a `tc` namespace ### Apps/derive - Change do not leak `positive_scope` open # [2.2.0] - 28/06/2024 Requires Elpi 1.19.2 and Coq 8.19 or Coq 8.20. ### Build system - Change switch to dune - New ppx_optcomp to support multiple Coq version - New no need for dot-merlin-reader, OCaml's language server understands dune ### Apps/tc - Change supports higher order unification - Change syntax to register, enable and disable solver - Change solutions found in Elpi are eta-contracted ### API - New `coq.debug` - New `coq.pstring->string` and `coq.string->pstring` - New `@warn!` attribute for `coq.notation.add-abbreviation` - New `coq.*.set.min`, `coq.*.set.max`, `coq.*.set.choose`, `coq.*.set.fold`, `coq.*.set.partition` - New `coq.*.map.fold` - New `coq.env.projection?` and `coq-env.primitive-projection?` ### HOAS - New `primitive (pstring S)` in Coq 8.20 # Changelog ## [2.1.1] - 15/05/2024 Requires Elpi 1.18.2 and Coq 8.19. ### Commands - Fix initial synterp state of commands with a synterp phase ## [2.1.0] - 29/03/2024 Requires Elpi 1.18.2 and Coq 8.19. ### Commands - New `Elpi Accumulate dbname File filename` allows to accumulate a file int a db - Change `Elpi Db` now only creates (and initialises) a database for the specified phase ### API - New `coq.parse-attributes` support for the `attlabel` specification, see `coq-lib-common.elpi` for its documentation. - New `coq.goal->pp` - Replace `coq.replay-all-missing-synterp-actions` by (nestable) groups of actions - New `coq.begin-synterp-group` and `coq.end-synterp-group` primitives - New `coq.replay-synterp-action-group` primitive (replaces `coq.replay-all-missing-synterp-actions` in conjunction with a group) - New `coq.replay-next-synterp-actions` to replay all synterp actions until the next beginning/end of a synterp group - New `coq.primitive.projection-unfolded` to fold/unfold a primitive projection. Note that unfolded primitive projections are still compact terms, but they are displayed as `match` expressions and some Ltac code can see that. ## [2.0.2] - 01/02/2024 Requires Elpi 1.18.2 and Coq 8.19. ### API - Fix `coq.elaborate-*` does not erase the type annotation of `Let`s (regression introduced in 2.0.1). This fix may introduce differences in generated names - Fix `coq.elaborate-*` are not affected anymore by printing options ### Commands - Fix install the right initial parsing state (the one before any synterp action is re-played) ### HOAS - Fix evar instantiation loss when crossing the elpi/ltac border - Fix encoding of "definitional classes" (`Class` with no record) - Fix order of implicit arguments of `Record` ### Misc - Change requiring `elpi` does not load primitive integers nor primitive floats ### Apps - TC: avoid declaring options twice (could make vscoq2 fail) - CS: `cs` now takes a context, a term that is the projection of some structure applied to the parameters of the structure, a term to put a structure on and the solution to return ## [2.0.1] - 29/12/2023 Requires Elpi 1.18.1 and Coq 8.19. This minor release adds compatibility with Coq 8.19. ## [2.0.0] - 23/12/2023 Requires Elpi 1.18.1 and Coq 8.18. This major release accommodates for the separation of parsing from execution of Coq 8.18 enabling Coq-Elpi programs to be run efficiently (and correctly) under VSCoq 2.0. ### Documentation - New section about parsing/execution separation in the [Writing commands in Elpi](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_command.html) tutorial ### Commands - New `Elpi *` commands understand the `#[phase]` attribute, see the doc in the [README](README.md#vernacular-commands) file, and the section about the [separation of parsing from execution](README.md#separation-of-parsing-from-execution-of-vernacular-commands) - New `Elpi Export` understands an `As` clause to rename or alias a program when exported ### API - Change `coq.elpi.add-predicate` now locality can be changed - Experimental `coq.toposort` returns a valid topological ordering of the nodes of a graph - Change `coq.TC.db-for`, now instances are returned sorted wrt their priority - New `tc-priority`, contains the priority of an instance and if the priority has been given by the user or computed by `coq` - Change `tc-instance`, now the type is `gref -> tc-priority -> tc-instance` i.e. the priority is not an integer anymore - New `coq.ltac.fresh-id` to generate fresh names in the proof context - New `@no-tc!` attribute supported by `coq.ltac.call-ltac1` - New `coq.TC.get-inst-prio` returns the `tc-priority` of an instance - New `synterp-action` datatype - New `coq.replay-all-missing-synterp-actions` - New `coq.replay-synterp-action` - New `coq.next-synterp-action` - New `coq.synterp-actions` (parsing phase only) ### Apps - New `tc` app providing an implementation of a type class solver written in elpi. This app is experimental ## [1.19.3] - 12/10/2023 Requires Elpi 1.16.5 and Coq 8.18. ### Misc - Fix `Elpi Export` broken when used from VsCoq2 ### APIs - New `ltac1-tactic` opaque data type - New `tac` argument constructor - Change `coq.ltac.call-ltac1` now accepts either a string (tactic name) or a tactic expression (of type `ltac1-tactic`) - New `ltac_tactic:(...)` syntax to pass tactic expressions to Elpi tactics - New `coq.extra-dep` predicate ## [1.19.1] - 30/08/2023 Requires Elpi 1.16.5 and Coq 8.18. ### Misc - Automate release process ## [1.19.0] - 04/08/2023 Requires Elpi 1.16.5 and Coq 8.18. ### APPS - New `coercion` app providing `coercion` predicate to program coercions (thanks @proux01). This app is experimental. ### API - Removed option `@nonuniform!` as it disappears from Coq 8.18. (c.f. https://github.com/coq/coq/pull/17716 ) ## [1.18.0] - 27/07/2023 Requires Elpi 1.16.5 and Coq 8.17. ### Doc - Mention the trace browser for VSCode in the Elpi tutorial. ### API - New `coq.elpi.accumulate-clauses` takes a list of clauses which share the same DB and accumulation site - New `coq.elpi.add-predicate` to declare the signature of a new predicate into a Db - New `coq.elpi.predicate` to build a term of type `prop` out of a predicate name and arguments - Change `coq.env.global` now relates a term with a gref, instead of working one way only - Change `coq.elpi.accumulate*` generalise clauses over global universe level, and error if algebraic levels are present. It used to warn if levels were present. - New `coq.elaborate*skeleton` support the `@no-tc!` option to disable type class resolution - New `@global!` option for `coq.elpi.accumulate*` - New `coq.env.current-section-path` - New `coq.TC.db-tc` giving all type classes - New `coq.reduction.eta-contract` ### HOAS - Fix evar declarations were (rarely) generated at the wrong depth, possibly resulting in variable captures in types containing binders - Fix `assert false` in evar instantiation readback (eta contraction code was incomplete) - Fix resiliency in case a goal is closed by side effect (was raising fatal errors such as "Not a goal" or "Not a variable after goal") - Change assigning a hole linked to an evar *always* triggers type checking. This is necessary even if the term being assigned is well typed since one may still need to declare some universe constraints. - Change propagate type constraints in `Prop` inward (Coq 8.17 only). Eg. `Check (T -> _) : Prop` fails in 8.17 since `_` is assumed to be in `Type`. We propagate the constraint ourselves across `->`, `/\`, `\/` and `~`. - Quotations `{{ ... }}` are now parsed by Coq ensuring the end of input is reached. Spurious text results in a parse error. For example `{{ f ) }}` is no more accepted, as well as `{{ _.x }}` ### Vernacular - New `Elpi Print` also print the program in `.txt` format ### Runtime - Change compilation cache able to prevent most of lengthy compilations in Hierarchy-Builder for MathComp 2.0. In some cases Coq-Elpi is more picky about the order of accumulated files, in particular a file containing the spilling of a predicate `{p}` needs to be accumulated after the type or mode of `p` is declared ### APPS - `derive Inductive i {A}` now sets `A` implicit status globally - `lock Definition f {A}` now sets `A` implicit status globally ## [1.17.1] - 09/03/2023 Requires Elpi 1.16.5 and Coq 8.17. ### API: - New `coq.int->uint63` and `coq.float->float64` - Fix bug introduced in 1.17.0 affecting `coq.ltac.call-ltac1` ## [1.17.0] - 13/02/2023 Requires Elpi 1.16.5 and Coq 8.17. ### API - New `coq.modpath->library` - New `coq.modtypath->library` - Fix `coq.env.*` APIs generating inductives, definitions and modules now emit metadata in the `.glob` files so that `coqdoc` can generate hyperlinks ### APPS - Add `NES.{List,Print}`. - Support relative paths in `NES.{Open,List,Print}` (path `_.P` references top-level namespace `P`, paths without a leading `_.` are relative to the current namespace) ## [1.16.0] - 10/11/2022 Requires Elpi 1.16.5 and Coq 8.16. The main change is the `derive` app which must now be loaded by importing `derive.std` (just loading `derive` won't work). See the [new derive documentation](apps/derive). ### API - Change `coq.env.module` and `coq.env.module-type` do not fail if the module (type) contains a mutual inductive. The resulting `gref` is going to me unusable with most APIs, though. - Change `coq.env.module` returns a ADT describing the module contents - Change `coq.gref->path` and `coq.gref->id` do work on `gref` which point to mutual inductives. - New `coq.env.term-dependencies` computing all the `grefs` occurring in a term. - New `coq.redflag` and `coq.redflags` types for `@redflags!` option understood by `coq.reduction.lazy.*` `and coq.reduction.cbv.norm` - New `coq.env.fresh-global-id` ### APPS - Change `derive` usage. One should now import `From elpi.apps Require Import derive.std` - Change derivations `eq` and `eqOK` move to `derive.legacy` - New derivations `eqb` and `eqbOK` subsuming the previous ones ## [1.15.6] - 27-08-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix parse error location display for quotation code - Fix HOAS of inductives with non-uniform parameters ## [1.15.5] - 30-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix parse error location display for inline code - Fix HOAS of evars: pruning was not propagated to the type of the evar ## [1.15.4] - 26-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix lexical analysis inside quotations error location display - Fix drop of universe constraints attached to automatically generates universe levels (eg when `sort (typ X)` is passed to Coq) - Fix nix CI ## [1.15.3] - 20-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - Fix parse error location display ## [1.15.2] - 19-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - API: - Fix `coq.env.indt-decl` correctly handles universes in parameters of universe polymorphic inductive - Fix `coq.typecheck-indt-decl` ignores non uniform parameters to compute the universe level of the inductive - Fix `coq.elaborate-indt-decl-skeleton` ignores non uniform parameters to compute the universe level of the inductive ## [1.15.1] - 16-07-2022 Requires Elpi 1.16.5 and Coq 8.16. - API: - Fix `coq.elaborate*skeleton` does refresh universes - New `@keepunivs!` attribute to force skeleton APIs to not refresh universes. This is useful to keep a link between a universe declaration and the declaration itself but still elaborate it - Fix Coq-Elpi is reentrant when commands call tactics ## [1.15.0] - 13-07-2022 Requires Elpi 1.16.5 and Coq 8.16. The main changes are: - experimental support for universe polymorphism. One can read and write universe polymorphic terms and manipulate their constraint declarations. Terms now have a new `pglobal` term constructor, akin to `global` but for global references to universe polymorphic terms, also carrying a universe instance. The attribute `@uinstance!` can be used to pass or retrieve a universe instance to/from APIs to access the Coq environment, as in `@uinstance! I => coq.env.typeof GR Ty_at_I`. The meaning of `@uinstance! I =>` depends if `I` is an unset variable or a concrete universe instance. In the former case the API generate a fresh universe instance (for `GR`) and assign it to `I`; in the latter case it uses the provided universe instance. See [coq-builtin](coq-builtin.elpi) for the full documentation - command arguments are elaborated by Coq (unless told otherwise). As a consequence arguments can use the full Coq syntax, including deep pattern matching and tactics in terms. Raw arguments are (and will remain) available, but don't support that yet ### APPS - New experimental support for polymorphic definitions in `locker` - New example of `clearbody` tactic taking a list of names in `eltac` - Change `derive` sets, *globally*, `Uniform Inductive Parameters`. See https://coq.inria.fr/refman/language/core/inductive.html#coq:flag.Uniform-Inductive-Parameters for reference. The immediate effect is that inductive types uniform parameters don't have to be repeated in the types of the constructors (they can't vary anyway). Non-uniform parameters and indexes have to be passed, as usual. If the flag is unset by the user `Coq-Elpi` will raise a warning since inference of non-uniform parameters is not implemented ### HOAS - Change arguments to commands are elaborated by Coq by default - New attribute `#[arguments(raw)]` to get arguments in raw format (as in version 1.14 or below) - Change raw inductive declaration using `|` to mark non-uniform parameters is expected to not pass uniform parameters to the inductive type (the same behavior applies to elaborated arguments, making the two consistent) - Change `coercion` attribute for record fields now takes values `off`, `regular` or `reversible` - New `pglobal` term constructor carrying a `gref` and a `univ-instance` for universe polymorphic terms - New `upoly-indt-decl` argument type for polymorphic inductive types declarations - New `upoly-const-decl` argument type for polymorphic definitions - New `upoly-decl` data type for universe parameters declarations, i.e. the `@{u1 u2 | u1 < u2}` Coq syntax one can use for inductives or definitions - New `upoly-decl-cumul` data type for universe parameters declarations, i.e. the `@{u1 u2 | u1 < u2}` Coq syntax one can use for cumulative inductives - Rename `univ` -> `sort` i.e. `(sort S)` is a `term` and `S` can be `prop` or `(type U)` where `U` is a `univ` - New `univ-instance` opaque type to represent how a polymorphic constant is instantiated, i.e. `(pglobal GR I)` where `GR` is a `gref` and `I` a `univ-instance` - New `univ.variable` opaque type for `univ` which are not algebraic. This data type is used in `upoly-decl` and `upoly-decl-cumul` ### API - New `coq.env.indc->indt` - New `coq.env.dependencies` to compute the dependencies of a `gref` - New `coq.env.transitive-dependencies` - New `@nonuniform!` and `@reversible!` for `coq.coercion.declare` - New `@uinstance!` attribute supported by many `coq.env.*` APIs that can be used to read/write the universe instance of polymorphic constants. E.g. `@uinstance! UI => coq.env.typeof GR Ty` can instantiate `Ty` to `UI` if provided or set `UI` to a fresh instance if not - New `@udecl!` attribute to declare polymorphic constants or inductives, like the `@{u1 u2 | u1 < u2}` Coq syntax - New `@udecl-cumul!` attribute to declare polymorphic inductives, like the `@{+u1 u2 | u1 < u2}` Coq syntax - New `@univpoly!` shorter version of `@udecl!`, like the `#[universes(polymorphic)]` Coq syntax (without giving any other `@{u1 u2 | u1 < u2}` directive) - New `@univpoly-cumul!` shorter version of `@udecl-cumul!`, like the `#[universes(polymorphic,cumulative)]` Coq syntax - New `coq.env.global` API to craft a `term` from a `gref`. When used with spilling `{coq.env.global GR}` gives either `(global GR)` or `(pglobal GR I)` depending on `GR` being universe polymorphic or not. It understands the `@unistance!` attribute for both reading or setting `I` - New `coq.env.univpoly?` to tell if a `gref` is universe polymorphic and how many parameters it has - Change `coq.univ.leq` -> `coq.sort.leq` - Change `coq.univ.eq` -> `coq.sort.eq` - Change `coq.univ.sup` -> `coq.sort.sup` - New `coq.sort.pts-triple` computes the resulting `sort` of a product - New `coq.univ.constraints` gives all the universe constraints in a first class form - Change `coq.univ.new` does not take a list anymore - New `coq.univ` to find a global universe - New `coq.univ.global?` tests if a universe is global - New `coq.univ.variable` links a `univ` to a `univ.variable` (imposing an equality constraint if needed) - New `coq.univ.variable.constraints` finds all constraints talking about a variable - New `coq.univ.variable.of-term` finds all variables occurring in a term - New `coq.univ-instance` links a `univ-instance` to a list of of `univ.variable` - New `coq.univ-instance.unify-eq` unifies two `univ-instance` (for the same `gref`) - New `coq.univ-instance.unify-leq` unifies two `univ-instance` (for the same `gref`) - New `coq.univ.set` OCaml's set for `univ` - New `coq.univ.map` OCaml's map for `univ` - New `coq.univ.variable.set` OCaml's set for `univ.variable` - New `coq.univ.variable.map` OCaml's map for `univ.variable` ### Vernacular - New `Accumulate File ` to be used in tandem with Coq 8.16 `From Extra Dependency as ` ## [1.14.0] - 07-04-2022 Requires Elpi 1.15.0 and Coq 8.15. ### Vernacular - All `Elpi Bla` commands accept (and ignore with a warning) unknown attributes, to be forward compatible ## [1.13.0] - 08-02-2022 Requires Elpi 1.14.1 and Coq 8.15. ### Performance - New 1 slot cache for context read back to improve the speed of FFI calls needing to read back a large `coq_context` - New `Conversion.t` for `gref` handwritten to minimize allocations - New terms of the form `(global ...)` are now hashconsed - New `extra_goals` postprocessing removing `declare-evar/rm-evar` pairs which happen naturally writing code like `coq.unify-eq {{ f _ x }} {{ f y _ }}` (the `_` are solved immediately, no need to declare them to elpi) ### API - New `coq.hints.opaque` - New `coq.hints.set-opaque` - Change load `coq.ltac.*` also in commands (and not just tactics) so that commands can easily turn holes into goals and inhabit them calling regular tactics. - New `coq.hints.add-resolve` - Fix `coq.option.add` survives the end of a file - New `coq.env.begin-module-functor` - New `coq.env.begin-module-type-functor` - New `coq.env.apply-module-functor` - New `coq.env.apply-module-type-functor` - New `coq.inline` with constructors `coq.inline.no`, `coq.inline.at` and `coq.inline.default` - New `@inline-at! N` and `@inline!` macros - Change `coq.env.add-axiom` honors `@inline` macros ## [1.12.1] - 20-01-2022 Requires Elpi 1.13.6 and Coq 8.15. ### APPS - `derive Inductive i {A}` now correctly sets `A` implicit status - `lock Definition f {A}` now correctly sets `A` implicit status ### API - New `coq.arity->implicits` - New `coq.indt-decl->implicits` - New `coq.any-implicit?` ## [1.12.0] - 15-01-2021 Requires Elpi 1.13.6 and Coq 8.15. ### HOAS - Change `{{ p x }}` is no more interpreted as a primitive projection even if `p` is the associated constant - New `{{ x.(p) }}` is interpreted as a primitive projection if `p` is a primitive projection - New `{{ x.(@p params) }}` is interpreted as a regular projection even if `p` is a primitive projection, since primitive projections don't have parameters and the user wrote some ### API - Fix globalization of `arity` inside a section - New `coq.option` type to access Coq's GOption system (Set/Unset vernaculars) - New `coq.option.add` - New `coq.option.get` - New `coq.option.set` - New `coq.option.available?` - New `coq.bind-ind-parameters` ### APPS - New `locker` app providing `lock` and `mlock` commands ## [1.11.2] - 24-09-2021 Requires Elpi 1.13.6 and Coq 8.14. ### API - Change `coq.bind-ind-arity` preserves `let` - New `coq.bind-ind-arity-no-let` to reduce `let`, used in `coq.build-match` - Fix `coq.build-match` putting `let` bindings in `match` return type - Change `coq.map-under-fun` preserves `let` ## [1.11.1] - 24-09-2021 Requires Elpi 1.13.6 and Coq 8.13. ### API - New `coq.env.informative?` to know if a type can be eliminated to build a term of sort `Type` - Fix `coq.warning` is synchronized with Coq's Undo machinery - Retire the venerable "elpi fails" message, replaced with something more precise inviting the user to report a bug: errors should be taken care of and reported nicely by the programmer. - New `coq.uint63->int` - New `coq.float64->float` - New `coq.ltac.id-free?` tells if a given ident is already used to denote a goal hypothesis, or not. ### Derive - Fix derivation of induction principles for "data types" in `Prop` - Add derivation of `param1` for the equality test `eq` with name `t.param1_eq` - Fix `invert` and `idx2inv` when dealing with containers - New datatypes from the Coq's prelude are derived in advance, no need to to `derive nat` anymore. ## [1.11.0] - 30-06-2021 Requires Elpi 1.13.6 and Coq 8.13. ### HOAS - New node `proj` of type `projection -> int -> primitive-value` holding the projection name (a Coq detail) and the number of the field it projects (0 based), eg: `primitive (proj _ N)` stands for the projection for the Nth constructor field counting parameters. - Change `cs-instance` carries a `gref` ### API - New `coq.notation.add-abbreviation-for-tactic` to add a parsing rule for a tactic-in-term, along the lines of `Notation foo := ltac:(elpi mytactic arguments)` but passing `mytactic` the correct `elpi.loc` of invocation. - New `@pplevel!` attribute to control outermost parentheses in `coq.term->pp` and similar - New `coq.hints.add-mode` like the `Hint Mode` vernacular - New `coq.hints.modes` - New `coq.TC.declare-class` - Deprecate `coq.env.const-opaque?` -> `coq.env.opaque?` - Deprecate `coq.env.const-primitive?` -> `coq.env.primitive?` - Deprecate `coq.CS.canonical-projections` -> `coq.env.projections` - New `coq.env.primitive-projections` - Change `coq.warning` emits the same warning only once ## [1.10.3] - 18-06-2021 Requires Elpi 1.13.6 and Coq 8.13. ### Lib - Cleanup `elpi.loc` attribute, which now carries a real loc and not a string. Thanks to elpi 1.13.6 we can project out the components without messing with regular expressions. Moreover loc are printed in a consistent way on Unix and Windows. ## [1.10.2] - 11-06-2021 Requires Elpi 1.13.5 and Coq 8.13. ### API - Change `coq.gref->path` now (consistently) gives the path without the final id, which can be retrieved by `coq.gref->id`. ## [1.10.1] - 24-05-2021 Requires Elpi 1.13.5 and Coq 8.13. ### HOAS - Fix (reverse) the order of the context argument of `goal`. The head of the list is the most recent hypothesis and in the last to be loaded (the one with higher precedence) by implication when one writes `Ctx => ...`. - New `msolve` entry point for (possibly multi goal) tactics ### API - Fix argument interpretation for `coq.ltac.call-ltac1`, the context is now the one of the goal alone (and not the one of the goal plus the current one) - Rename `coq.ltac.then` to `coq.ltac.all` ## [1.10.0] - 21-05-2021 Requires Elpi 1.13.5 and Coq 8.13. ### Derive - New `lens` and `lens_laws` for regular and primitive records with or without parameters - `derive` takes `#[only(this, that)]` to select the desired derivations ### API - Fix `coq.elpi.accumulate` scope `current`, which was putting the closes in the current module for the current file, but was making them global for the files importing it - New scope `library` for `coq.elpi.accumulate` which links the clauses to the library, that is the module named after the file. - Fix databases are always available, no need to import files in the right order when databases have named clauses. The error "Error: unable to graft this clause: no clause named ..." should no more be raised in response to a `Require Import`. - New `coq.strategy.*` to `set` and `get` the unfolding priority of constants followed by the term comparison algorithm Coq uses at type checking time. - New `coq.env.record?` to test if an inductive is a record and if it has primitive projections - New `coq.env.recursive?` to test if an inductive is recursive - Change `coq.locate*` understands strings like `"lib:some.name"` which point to global references registered via the Coq `Register` command - New `coq.ltac.fail` like `coq.error` but catch by Ltac - New `@ltacfail!` to be used like `@ltacfail! Level => std.assert! ...` in tactic code to use `coq.ltac.fail` instead of `coq.error` in case of failure - Change failure as is `elpi fails` (no more clauses to try) or `elpi run out of steps` are not considered Ltac failures anymore, but rather fatal errors. Add a clause `solve _ _ :- coq.ltac.fail _` to preserve the old behavior. - New `coq.ltac.collect-goals` to turn unresolved unification variables into goals. - Fix `coq.env.add-const` now accepts an opaque definition with no given type. The body is assumed to be well typed and is quickly retypechecked. ### HOAS - Fix handling of default case in `match`, now Coq's `if _ then _ else _` works just fine. - New quotation `{{:gref id }}` and `{{:gref lib:qualid }}` that unfolds to the `gref` data type (`{{ id }}` and `{{ lib:qualid }}` unfold to terms) - Change `solve` only takes 2 arguments (the arguments passed at tactic invocation time are now part of the goal) and the first argument is a single goal, not a list thereof. The second argument is now a `sealed-goal`. - Change `refine` now generates a list of `sealed-goal`s - Change `goal` now carries two unification variables standing for the raw solution to goal and the elaborated, well typed, one. Assigning a term to the raw variable triggers a call to `coq.elaborate-skeleton` which in turn assigns the other one to the (partial) proof term. Assigning the elaborated variable directly does not trigger a type check of the term. ### Vernacular - New `attributes` tactic argument (for `Tactic Notation`) - New `elpi tac` can receive attributes via the usual `#[stuff] tac` syntax - New syntax to pass Elpi tactics arguments coming from Ltac variables: - `ltac_string:(v)` (for `v` of type `string` or `ident`) - `ltac_int:(v)` (for `v` of type `int` or `integer`) - `ltac_term:(v)` (for `v` of type `constr` or `open_constr` or `uconstr` or `hyp`) - `ltac_(string|int|term)_list:(v)` (for `v` of type `list` of ...) - `ltac_attributes:(v)` (for `v` of type `attributes`) Example: ```coq Tactic Notation "foo" string(X) ident(Y) int(Z) constr(T) constr_list(L) := elpi foo ltac_string:(X) ltac_string:(T) ltac_int:(Z) (T) ltac_term_list(L). ``` lets one write `foo "a" b 3 nat t1 t2 t3` in any Ltac context. For attributes one has to place `ltac_attributes:(v)` in front of `elpi`, as in: ```coq Tactic Notation "foo" "#[" attributes(A) "]" := ltac_attributes:(A) elpi foo. ``` Here the delimiters `#[` and `]` are chosen for consistency, you can use any "delimited" syntax really. The usual prefix notation is also possible with the following limitations due to a parsing conflicts in the Coq grammar (at the time of writing): ```coq Tactic Notation "#[" attributes(A) "]" "tac" := ltac_attributes:(A) elpi tac. ``` - `#[ att ] tac.` does not parse - `(#[ att ] tac).` works - `idtac; #[ att ] tac.` works - Change `-qua.lid` is no more understood as the string `"-qua.lid"` but as two strings (when passed to a command, syntax error when passed to a tactic) ## [1.9.7] - 15-04-2021 Requires Elpi 1.13.1 and Coq 8.13. ### Vernacular - New attribute `#[skip="rex"]` and `#[only="rex"]` for the `Elpi Acumulate` family of commands which let one accumulate a piece of (compatibility) code only on some Coq versions. ## [1.9.6] - 13-04-2021 Requires Elpi 1.13.1 and Coq 8.13. ### API - New `coq.reduction.lazy.norm` - New `coq.reduction.native.norm` - New `coq.reduction.native.available?` - Rename `coq.reduction.cbv.whd_all` -> `coq.reduction.cbv.norm` - Rename `coq.reduction.vm.whd_all` -> `coq.reduction.vm.norm` ## [1.9.5] - 26-03-2021 Requires Elpi 1.13 and Coq 8.13. ### Vernacular - Commands, Tactics and Db cannot be declared inside sections or modules (it never really worked, but now you get an error message). - Clauses which are accumulated via `coq.elpi.accumulate` and are not `@local!` survive section closing if they don't mention the section variables being discharged. ### Typechecker - Warnings can be turned into errors by passing Coq `-w +elpi.typecheck`. ### API - New `coq.CS.db-for` to filter the CS db given a projection or a canonical value, or both. - New `coq.warning` like `coq.warn` but with a category and name, so that the message can be silenced or turned into an error. ## [1.9.4] - 17-03-2021 Requires Elpi 1.13 and Coq 8.13. ### Elpi - Calls to APIs that only read the global state are much faster (thousands of times faster) - Fix compilation with OCaml 4.12 ### API - Fix issue with `coq.env.add-abbreviation` when given a term with binders having overlapping `name`s. - New `copy-indt-decl` - New `coq.coercion.declare` is able to infer the endpoints if omitted ## [1.9.3] - 18-02-2021 Requires Elpi 1.13 and Coq 8.13. ### Elpi - Fix issue with async-mode (Elpi commands can change the parser) ### API - New `attmap` attribute type to represent associative maps over strings, eg `#[foo(x = "a", y = "b")]` ## [1.9.2] - 12-02-2021 Requires Elpi 1.13 and Coq 8.13. ### API - Fix `elpi.loc` computation when run in interactive mode. - New `@using! S` attribute for `coq.env.add-const` akin to Coq's `#[using=S]`. ## [1.9.1] - 11-02-2021 Requires Elpi 1.13 and Coq 8.13. ### API - Fix `coq.env.add-section-variable` and `coq.env.add-axiom` were not handling universes correctly. ### Build system - New target `build` which only builds elpi and the apps - New target `test` which runs all tests for elpi and the apps - OPAM package only calls `test` only if requested, hence the package typically installs faster ## [1.9.0] - 10-02-2021 Requires Elpi 1.13 and Coq 8.13. ### HOAS - Fix `coq.env.indt-decl` to generate a `record-decl` for records. ### Elpi - Fix issue with the compiler cache when used in async-mode (via CoqIDE or vscoq). ### API - New type `coq.pp` and `coq.pp.box` to describe Coq's pretty printer box model - New `coq.pp->string` to turn formatting boxes into a string - New `coq.term->pp` to turn formatting boxes into a string - New `@ppall!` attribute to print terms in full details - New `@ppmost!` attribute to print terms in a reparsable way - New `@ppwidth! N` attribute to specify the maximal line length when turning formatting boxes into strings - New `fold-map` to map a term with an accumulator - New `coq.env.add-section-variable` - New `coq.env.add-axiom` - Deprecate `coq.env.add-const` for declaring axioms or section variables. The deprecation warning is called `elpi.add-const-for-axiom-or-sectionvar` and can be turned into an error by passing to `coqc` the option `-w +elpi.add-const-for-axiom-or-sectionvar` ### Tooling - The `COQ_ELPI_ATTRIBUTES=text` parses `text` as Coq attributes `#[elpi(text)]` and passes them to all commands. Attributes in the `elpi.` namespace are silently ignored by commands not using them. - Attribute `elpi.loc` carries the `loc` of the command being run (if exported with `Elpi Export cmd`). This location does not comprise control flags (eg `Fail`, `Time`) nor attributes. This limitation will be lifted in Coq 8.14 (8.13 does not expose this parsing information to plugins). ## [1.8.1] - 11-12-2020 Requires Elpi 1.12 and Coq 8.13. ### HOAS - Illformed terms like `global (const X)` (which have no representation in Coq) are now reported with a proper error message. Whe passed to `coq.term->string`, instead of a fatal error, we pick for the illformed sub term the `unknown_gref` special constant. ## [1.8.0] - 29-11-2020 Requires Elpi 1.12 and Coq 8.12. ### API - New `@primitive!` attribute for `coq.env.add-indt` allowing one to declare primitive records. So far no term syntax for primitive projects is supported, their "non primitive" version is always used instead. ### HOAS - Best effort support for Coq's `let (x, y, .. ) := t in ` in quotations. ### API - Fix `coq.term->gref` skips over casts ## [1.7.0] - 26-11-2020 Requires Elpi 1.12 and Coq 8.12. ### HOAS - New `primitive (uint63 )` term constructor - New `primitive (float64 )` term constructor ### API - New `coq.reduction.lazy.whd_all` - New `coq.reduction.cbv.whd_all` - New `coq.reduction.vm.whd_all` - New `coq.env.const-primitive?` - Fix argument `const-decl` is accepted even if the name is "_", allowing one to write `Elpi command Definition _ : type := body` - Fix `coq.notation.abbreviation` gives an error if too few arguments are provided ### Sources Major reorganization of sources: - src/ is for .ml files - elpi/ for .elpi files - theories/ for .v files meant to be installed - tests/ for the test suite, not to be installed - examples/ for tests (not to be installed) Moreover the apps/ directory is for applications written in Coq-Elpi, their structure follows the same convention ### NES (Namespace Emulation System) - POC application emulating name spaces on top of modules ### Elpi integration - Use Elpi 1.12 API to implement a compiler cache and avoid recompiling over and over the same programs. ## [1.6.0] - 21-08-2020 Requires Elpi 1.11 and Coq 8.12. ### UIs - Display failures generated by `std.assert!` as errors ### Derive - Use the new `coq.elaborate-skeleton` API to insert coercions ### Fix - Embedding for sorts was incorrectly mapping `Prop` to `sprop` - `coq.env.add-const` made 8.12 friendly with a workaround for coq/coq#12759 ### API - New `coq.elaborate-skeleton` and `coq.elaborate-ty-skeleton` that run Coq's elaborator on a term obtained by disregarding evars and universes in the given input. Unfortunately Coq's elaborator does not take terms as input, but glob terms, and the conversion function is not lossless. See also `lib:elpi.hole`. - New `coq.elaborate-indt-decl-skeleton` to elaborate an inductive type declaration. - New `coq.elaborate-arity-skeleton` to elaborate an arity. - New `coq.env.current-path` to get the current module path. - New `coq.modpath->path` and `coq.modpath->path` to get access to the components of a module path. - Change `coq.elpi.accumulate` understands the `@local!` attribute, which makes the clauses `Local` to the module into which they live. ### HOAS - New `lib:elpi.hole` constant that can be used in place of a unification variable to denote an implicit argument when calling `coq.*-skeleton` APIs ## [1.5.1] - 29-07-2020 Requires Elpi 1.11 and Coq 8.12. ### API: Locality is now supported by `coq.CS.declare-instance` ## [1.5.0] - 29-07-2020 Requires Elpi 1.11 and Coq 8.11. ### HOAS - New option `@holes!` to be assumed (as in `@holes! => ...`) before calling any Coq API. When this option is given unknown unification variables are interpreted as "implicit arguments" (linear holes that see all the variables in scope). If the unification variable is outside the pattern fragment the following heuristic is applied: arguments that are not variables are heuristically dropped; arguments which are variables but occur multiple times are kept only once (the first occurrence is kept, the others are dropped). ### API - New `coq.arguments.set-default-implicit` that behaves like `Arguments foo : default implicits` - Change of arguments of type `@global?` attributes `@local!` or `@global!`. In order to pass a locality directive one has to do something like `@global! => coq.add-something` Locality is understood by: - `coq.TC.declare-instance` - `coq.coercion.declare` - `coq.arguments.set-implicit` - `coq.arguments.set-default-implicit` - `coq.arguments.set-name` - `coq.arguments.set-scope` - `coq.arguments.set-simplification` - `coq.notation.add-abbreviation` - `coq.env.add-const` - Change of argument for deprecation to attribute `@deprecated! Since Message`. In order to pass a deprecation directive one has to do something like `@deprecated! "8.11.0" "use this instead" => coq.add-something` Deprecation is understood by: - `coq.notation.add-abbreviation` - New macro `@transparent!` with value `ff` to be used with `coq.env.add-const` ### Elaborator - `engine/elaborator.elpi` is now installed (but not used by default). One can `Elpi Accumulate "engine/elaborator.elpi".` in order to load it. It is too experimental to use it in production, but it is also hard to experiment with it without having it installed. ### CI - Switch to Github Actions and Coq Community's Docker workflow ### Bugfix - anonymous record fields are not given a generated name anymore - `coq.typecheck` and `coq.typecheck-ty` API now ensure that all unification problems required by type checking are actually solved by Coq's unifier - some debug printings used to raise errors in corner cases, now fixed ## [1.4.1] - 2020-06-10 Minor fixes - Missing opaque data type declaration for `abbreviation` (could lead to confusing type errors) - Parse also "keywords" where `qualified_name` is expected. `Elpi Export x.` turns `x` into a keyword, and that used to break commands `Elpi Something x ...`. Parsing of all commands is now resilient to this. ## [1.4.0] - 2020-05-19 Requires Elpi 1.11 and Coq 8.11 or 8.12. The main visible change is the `indt-decl` data type that now faithfully represents an inductive type declaration (including the implicit status of parameters). Also all the predicates implemented in `coq-lib` are now in the `coq.` namespace. ### API - New `coq.notation.abbreviation-body` to retrieve the number of arguments and body of a syntactic definition. - New `coq.id->name` to convert a relevant id into an irrelevant pretty printing hint. - New `coq.mk-n-holes ` to produce a list of flexible terms. - New `coq.env.indt-decl` to read for the environment an inductive type represented in HOAS form - `coq.env.indt->decl` renamed `coq.build-indt-decl` - New `coq.env.rename-indt-decl` - Change `coq.env.add-indt` now sets the imlicit status of the inductive type and its constructors (since the `parameter` constructor can carry it) - New `coq.arity->nparams` to count the number of parameters - Change `parse-attributes` made deterministic - Change `coq.unify-leq` and `coq.unify-eq` now return a diagnostic - Change `subst-prod` -> `coq.subst-prod` - Change `subst-fun` -> `coq.subst-fun` - Change `prod->fun` -> `coq.prod->fun` - Change `count-prods` -> `coq.count-prods` - Change `prod-R-fun` -> `coq.prod-R-fun` - Change `safe-dest-app` -> `coq.safe-dest-app` - Change `arity->sort` -> `coq.arity->sort` - Change `term->gref` -> `coq.term->gref` - Change `fresh-type` -> `coq.fresh-type` - Change `build-match` -> `coq.build-match` - Change `map-under-fun` -> `coq.map-under-fun` - Change `iter-under-fun` -> `coq.iter-under-fun` - Change `bind-ind-arity` -> `coq.bind-ind-arity` - Change `with-TC` -> `coq.with-TC` - Change `valid-attribute` -> `coq.valid-attribute` - Change `is-one-of` -> `coq.is-one-of` - Change `parse-attributes` -> `coq.parse-attributes` - Change `mk-app` -> `coq.mk-app` - Change `mk-app-uvar` -> `coq.mk-app-uvar` - Change `mk-eta` -> `coq.mk-eta` ### Universes - New support for `Type@{name}` in Coq `{{ quotations }}`. - Fix more precise promotion of universe variables to universe global names in builtins changing the Coq environment (eg `coq.env.add-const`). - New user error when `coq.elpi.accumulate` is given a clause that mentions universe variables: only global universes can be stored in a DB. ### HOAS - Change `indt-decl`: - the `parameter` constructor carries an `id`, `imlpicit_kind` and a type - the `coinductive` constructor was removed, the `inductive` one carries a `bool`, `tt` for inductive, `ff` for coinductive - the `inductive` constructor no more carries the number of non uniform parameters, and the inductive type arity (see below) is no more a simple term but rather an `arity` (all its parameters are non uniform) - the `constructor` constructor now carries an `arity` so that non uniform parameters can be represented faitfully - New `arity` data type, constructors are `parameter` (shared with `indt-decl`) and `arity`. - New `indt-decl` argument type introduced in version 1.3 now supports the syntax of inductive types (not just records). Eg `Elpi command Inductive P {A} t : I := | K1 .. | K2 ..`. - Change `context-item` now carries an `id` and an `implicit-kind` - Change `const-decl` now carries an arity to describe the parameters of the definition in a faithful way - New `@pi-parameter ID Ty p\ ...` to postulate a nominal `p` with type `Ty` and a name built out of the id `ID` ### Derive - New derivations `derive.invert` and `derive.idx2inv` now called by `derive` - New global command `derive` taking in input the name of an inductive or an inductive declaration. In the latter case all derivations are placed in a module named after the inductive ## [1.3.1] - 2020-03-01 Port to Coq 8.11, two API changes: - `field` constructor of `indt-decl` takes an argument of type `field-attributes` rather than a simple `bool`. The macro `@coercion!` works in both versions, as well as omitting the attribute using `_`. In 8.11 it is possible to disable canonical inference for a field using the `(canonical false)` attribute. - `coq.env.add-abbreviation` takes an extra argument (deprecation info). Code working on both versions can be obtained as follows: ```prolog if (coq.version _ 8 10 _) (std.unsafe-cast coq.notation.add-abbreviation F, F ... Abbrev) (std.unsafe-cast coq.notation.add-abbreviation G, G ... Deprecation Abbrev). ``` ## [1.3.0] - 2020-02-27 Requires Elpi 1.10 and Coq 8.10 or 8.11. The main visible change is that opaque data types such as `@constructor`, `@inductive` and `@constant` are now written without the `@`, since Elpi now supports the `typeabbrev` directive. The main invisible change is that code accumulated into commands and tactics is "compiled" by Elpi once and forall in the context in which it is accumulated. As a consequence Coq code inside `{{quotations}}` is processed in that, and only that, context of notations, scopes, etc. Data bases are compiled every time it is needed in the current Coq context, hence quotations should be used with care. The file `coq-HOAS.elpi` is now distributed as part of `coq-builtin.elpi`. ### Vernacular - New `Elpi Export command` to make `command` available without the `Elpi` prefix. - `Elpi command` (exported or not) can now access Coq's attributes (the `#[option]` thing). See the HOAS section below. - Coq keywords or symbols passed to command and tactics are interpreted as strings even if not quoted. Eg `Elpi command =>` is the same of `Elpi command "=>"`. - The identifiers `Record`, `Definition`, `Axioms` and `Context` are now reserved (see the HOAS section below). In order to pass them (as strings) one has to quote them. ### APIs - New `coq.typecheck-ty` to typecheck a type (outputs a universe) - New `coq.env.import/export-module`. - New `coq.env.begin/end-section`. - New `coq.notation.abbreviation` to unfold an abbreviation. - New `coq.locate-abbreviation` to locate abbreviations. - New `coq.locate-any` that never fails and gives a list of possible interpretations (term, abbreviation, module, module type). - Rename `coq.env.typeof-gr` to `coq.env.typeof`. - Rename `term->gr` to `germ->gref`. - Rename `coq.gr->*` to `coq.gref->*string*` - Change `coq.typecheck` and `coq.typecheck-indt-decl` so that they never fail and have a 3rd argument of type `diagnostic` (from Elpi 1.9) to signal success or errors (that can be printed). - Change `coq.elpi.accumulate` so that one can put the clause either in current module from which the program is started, or in the current module while the program runs (which can be different if one uses the `coq.env.begin-module` API). - Remove `coq.elaborate` and `coq.elaborate-indt-decl`. - Fix `coq.typecheck T TY` to uses Coq's unification to equate the type inferred for `T` and `TY` (when it is provided by the user). - Fix `coq.CS.*` w.r.t. default instances of canonical structures. - Fix all APIs changing the Coq global state to abort if they are used from a tactic. - Fix `coq.gr->string` to not duplicate the label part of the name ### HOAS - Change context entry `def` to not carry a cache for the normal form of the defined term (now cached by a specific `cache` context entry). `def` now carries the exact same information of a `let`, as `decl` carries the same information of a `fun`. - New `indt-decl` argument type with a concrete syntax that mimics the standard one for records. Eg `Elpi command Record x := K { f : T }`. - New `const-decl` argument type with a concrete syntax that mimics the standard one for definitions or axioms. Eg `Elpi command Definition x := t.`. - New `ctx-decl` argument type with a concrete syntax that mimics the standard one for contexts. Eg `Elpi command Context T (x : T).`. - Add to the context under which `main` is run the list of attributes passed to the command invocation (Coq syntax is for example `#[myflag]`). See the `attribute-value` data type in `coq-builtin.elpi` and `parse-attributes` helper in `coq-lib.elpi`. ## [1.2.0] - 2019-10-30 ### APIs - New `coq.gr->path` to get the path components as a list of strings - Failure of `coq.ltac.call` is now turned into logical failure, as any other Elpi tactic - Fix `coq.end.add-indt` in the case of record (was not flagging the inductive as such) - Fix `coq.version`, wrong parsing of beta versions - Expose `set` and `map` from Elpi 1.8 (generic data structure for ground terms) ### Documentation - Improve reflexive tactic demo - Fix documentation of `coq.gr->*` APIs - `coq-HOAS.elpi`, `coq-lib.elpi` and `coq-builtin.elpi` are now installed since they provide useful doc (but are not needed by the runtime, since they are embedded in `elpi.vo`) ## [1.1.0] - 2019-10-10 ### derive.param2 - interface made consistent with other derivations: `derive.param2` takes in input optional suffix, instead of the full name of the derived concept - storage of previous derivations based on Elpi Db - the derivation generates nicer types for relators over fixpoints (the new types are convertible to the old ones, but the fixpoint is not expanded). PR [#84](https://github.com/LPCIC/coq-elpi/pull/84/) by Cyril Cohen ### Documentation - Improved documentation of `coq.typecheck` ## [1.0.0] - 2019-10-09 - First public release LPCIC-coq-elpi-eb449d7/LICENSE000066400000000000000000000635351523041753400155240ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. (This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.) Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. {description} Copyright (C) {year} {fullname} This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. {signature of Ty Coon}, 1 April 1990 Ty Coon, President of Vice That's all there is to it! LPCIC-coq-elpi-eb449d7/Makefile000066400000000000000000000052151523041753400161460ustar00rootroot00000000000000dune_wrap = $(shell command -v coqc > /dev/null || echo "etc/with-rocq-wrap.sh") dune = $(dune_wrap) dune $(1) $(DUNE_$(1)_FLAGS) --stop-on-first-error # This makefile is mostly calling dune and dune doesn't like # being called in parralel, so we enforce -j1 .NOTPARALLEL: all: $(call dune,build) $(call dune,build) builtin-doc .PHONY: all build-core: $(call dune,build) theories $(call dune,build) builtin-doc .PHONY: build-core build-apps: $(call dune,build) $$(find apps -type d -name theories) .PHONY: build-apps build: $(call dune,build) -p rocq-elpi @install $(call dune,build) builtin-doc .PHONY: build all-tests-no-plugins: test-core test-repro test-stdlib test-apps test-apps-stdlib .PHONY: all-tests-no-plugins all-tests: all-tests-no-plugins test-plugins .PHONY: all-tests test-core: $(call dune,runtest) tests $(call dune,build) tests # Check for build reproducibility test-repro: test-core $(dune_wrap) dune coq top --toplevel coqc tests/accumulate1.v -- tests/accumulate1.v md5sum tests/accumulate1.vo > md5sum_accumulate1vo_1 rm -f tests/accumulate1.vo tests/accumulate1.glob $(dune_wrap) dune coq top --toplevel coqc tests/accumulate1.v -- tests/accumulate1.v md5sum tests/accumulate1.vo > md5sum_accumulate1vo_2 rm -f tests/accumulate1.vo tests/accumulate1.glob diff md5sum_accumulate1vo_1 md5sum_accumulate1vo_2 rm md5sum_accumulate1vo_1 md5sum_accumulate1vo_2 .PHONY: test-core test-repro test-apps: $(call dune,build) $$(find apps -type d -name tests) .PHONY: test-apps test-plugins: $(call dune,build) $$(find apps -type d -name tests-plugin) .PHONY: test-plugins test-apps-stdlib: $(call dune,build) $$(find apps -type d -name tests-stdlib) .PHONY: test-apps-stdlib test-stdlib: $(call dune,build) tests-stdlib .PHONY: test-stdlib all-examples: examples examples-stdlib .PHONY: all-examples examples: $(call dune,build) examples .PHONY: examples examples-stdlib: $(call dune,build) examples-stdlib .PHONY: examples-stdlib doc: @echo "########################## generating doc ##########################" @python3 -m venv alectryon @alectryon/bin/pip3 install git+https://github.com/gares/alectryon.git@4509235b1b83b256fd15d8dff92ac71666f419a1 @mkdir -p doc @$(foreach tut,$(wildcard examples/tutorial*$(ONLY)*.v),\ echo ALECTRYON $(tut) && alectryon/bin/python3 etc/alectryon_elpi.py \ --frontend coq+rst \ --output-directory doc \ --pygments-style vs \ --coq-driver vsrocq \ $(tut) &&) true @cp etc/tracer.png doc/ clean: $(call dune,clean) .PHONY: clean install: $(call dune,install) rocq-elpi .PHONY: install nix: nix-shell --arg do-nothing true --run "updateNixToolBox && genNixActions" .PHONY: nix LPCIC-coq-elpi-eb449d7/README.md000066400000000000000000000732211523041753400157670ustar00rootroot00000000000000[![CI](https://github.com/LPCIC/coq-elpi/actions/workflows/ci.yml/badge.svg)](https://github.com/LPCIC/coq-elpi/actions/workflows/ci.yml) [![Nix 9.0](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-9.0.yml/badge.svg)](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-9.0.yml) [![Nix 9.1](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-9.1.yml/badge.svg)](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-9.1.yml) [![Nix 9.1](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-9.2.yml/badge.svg)](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-9.2.yml) [![Nix master](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-master.yml/badge.svg)](https://github.com/LPCIC/coq-elpi/actions/workflows/nix-action-rocq-master.yml) [![DOC](https://github.com/LPCIC/coq-elpi/actions/workflows/doc.yml/badge.svg)](https://github.com/LPCIC/coq-elpi/actions/workflows/doc.yml) [![project chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://coq.zulipchat.com/#narrow/stream/253928-Elpi-users.20.26.20devs) Rocq-Elpi logo ### Rocq-Elpi [Rocq](https://github.com/coq/coq) plugin embedding [Elpi](https://github.com/LPCIC/elpi). [Elpi](https://github.com/LPCIC/elpi) provides an easy-to-embed implementation of a dialect of λProlog, a programming language well suited to manipulate abstract syntax trees containing binders and unification variables. Rocq-Elpi provides a Rocq plugin that lets one define new commands and tactics in Elpi. For that purpose it provides an embedding of Rocq's terms into λProlog using the Higher-Order Abstract Syntax approach ([HOAS](https://en.wikipedia.org/wiki/Higher-order_abstract_syntax)). Rocq-Elpi also exports to Elpi a comprehensive set of Rocq's primitives, so that one can print a message, access the environment of theorems and data types, define a new constant, declare implicit arguments, type classes instances, and so on. For convenience it also provides quotations and anti-quotations for Rocq's syntax, so that one can write `{{ nat -> lp:X }}` in the middle of an Elpi program instead of the equivalent AST. Finally Rocq-Elpi provides an FFI to bind OCaml libraries. For example [apps/json](apps/json) provides access to external data in json format via the Yojson library, and [apps/xml](apps/xml) does the same for xml-light. ## What is the purpose of all that In the short term, provide an extension language for Rocq well suited to manipulate terms containing binders. One can already use Elpi to implement commands and tactics. As ongoing research we are looking forward to express algorithms like higher order unification and type inference, and to provide an alternative elaborator for Rocq. ## Installation The simplest way is to use [OPAM](http://opam.ocaml.org/) and type ``` opam repo add rocq-released https://rocq-prover.org/opam/released opam install rocq-elpi opam install rocq-elpi-json # example of optional plugin ``` ### Editor Setup The recommended user interface is [VSRocq](https://github.com/rocq-prover/vsrocq/). We provide an [extension for vscode](https://github.com/LPCIC/coq-elpi-lang) in the market place, just look for Elpi. The extension provides syntax hilighting for both languages even when they are nested via quotations and antiquotations.
Other editors (click to expand)

At the time of writing Proof General does not handle quotations correctly, see ProofGeneral/PG#437. In particular `Elpi Accumulate lp:{{ .... }}.` is used in tutorials to mix Rocq and Elpi code without escaping. Rocq-Elpi also accepts `Elpi Accumulate " .... ".` but strings part of the Elpi code needs to be escaped. Finally, for non-tutorial material, one can always put the code in an external file declared with `From some.load.path Extra Dependency "filename" as f.` and use `Elpi Accumulate File f.`. RocqIDE does handle quotations. The installation process puts [coq-elpi.lang](etc/coq-elpi.lang) in a place where RocqIDE can find it. Then you can select `coq-elpi` from the menu `Edit -> Preferences -> Colors`. For Vim users, [Coqtail](https://github.com/whonore/Coqtail) provides syntax highlighting and handles quotations.

Development version (click to expand)

To install the development version one can type ``` opam pin add rocq-elpi https://github.com/LPCIC/coq-elpi.git ``` One can also clone this repository and type `make`, but check you have all the dependencies installed first (see [rocq-elpi.opam](rocq-elpi.opam)). We recommend to look at the [CI setup](.github/workflows) for ocaml versions being tested. Also, we recommend to install `dot-merlin-reader` and `ocaml-lsp-server` (version 1.15).

## Documentation ### Tutorials - [The Elpi programming language](https://lpcic.github.io/coq-elpi/tutorial_elpi_lang.html) is an Elpi tutorial, there is nothing Rocq specific in there even if the tutorial uses Rocq to step trough the various examples. If you never heard of λProlog or HOAS based languages (like Twelf or Beluga) then you are strongly encouraged to read this tutorial and have a look at [λProlog's home page](http://www.lix.polytechnique.fr/Labo/Dale.Miller/lProlog/) for additional documentation. Even if you are familiar with λProlog or HOAS it may be worth reading the last sections since they focus on Elpi specific features. Last but not least it covers common pitfalls for people with a background in functional programming and the tracing mechanisms (useful for debugging). - [HOAS of Rocq terms](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_HOAS.html) focuses on how Rocq terms are represented in Elpi, how to inspect them and call Rocq APIs under a context of binders, and finally how holes ("evars" in Rocq slang) are represented. It assumes the reader is familiar with Elpi. - [Writing commands in Elpi](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_command.html) focuses on how to write commands, in particular how to store a state across calls via so called DBs and how to handled command arguments. It assumes the reader is familiar with Elpi and the HOAS of Rocq terms. - [Writing tactics in Elpi](https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_tactic.html) describes how goals and tactics are represented, how to handle tactic arguments and finally how to define tactic notations. It assumes the reader is familiar with Elpi and the HOAS of Rocq terms. - [Elpi: rule-based meta-language for Rocq](https://www.youtube.com/watch?v=XjkpA5rVxkM) video recording of the keynote at RocqPL25 ([slides & demo files](https://www-sop.inria.fr/members/Enrico.Tassi/coqpl2025/)). - [Rocq-Elpi in 20 minutes](https://youtu.be/m60rHnvCJ2o) video recording of a talk given at the Rocq Users and Developers Workshop 2020. ### Small examples (proofs of concept) - [reification](examples/example_reflexive_tactic.v) is the typical use case for meta programs: reading the syntax of terms into an inductive representing a sub language on which some decision procedure can be implemented - [data bases](examples/example_data_base.v) shows how Elpi programs can store data and reuse it across multiple runs - [record expansion](examples/example_record_expansion.v) sketches a program to unpack records in a definition: it replaces an abstraction over a records with abstractions over all of its components - [record to sigma](examples/example_record_to_sigma.v) sketches a program that de-sugars a record type to iterated sigma types - [fuzzer](examples/example_fuzzer.v) sketches a program to alter an inductive type while preserving its well typedness. It makes nothing useful per se, but shows how to map a term and call the type checker deep inside it. - [tactics](examples/example_curry_howard_tactics.v) show how to create simple tactics by using (proof) terms and the elaborator of Rocq - [generalize](examples/example_generalize.v) show how to abstract subterms out (one way to skin the cat, there are many) - [abs_evars](examples/example_abs_evars.v) show how to close a term containing holes (evars) with binders - [record import](examples/example_import_projections.v) gives short names to record projections applied to the given record instance. - [reduction surgery](examples/example_reduction_surgery.v) implements a tactic fine tuning cbv with a list of allowed unfoldings taken from a module. - [open terms](examples/example_open_terms.v) implements a tactic like `replace` that receives terms containing free variables, i.e. variables bound in the goal but not in the proof context. - [builtins](examples/example_plugin/) adds builtin predicates (hence implemented in OCaml) to Elpi via a Rocq plugin ### Applications written in Rocq-Elpi - [Derive](apps/derive/examples/usage.v) shows how to obtain proved equality tests and a few extra gadgets out of inductive type declarations. See the [README](apps/derive/README.md) for the list of derivations. It comes bundled with Rocq-Elpi. - [Locker](apps/locker) lets one hide the computational contents of definitions via modules or opaque locks. It comes bundled with Rocq-Elpi. - [Hierarchy Builder](https://github.com/math-comp/hierarchy-builder) is a Rocq extension to declare hierarchies of algebraic structures. - [Algebra Tactics](https://github.com/math-comp/algebra-tactics/) is a port of the `ring` and `field` tactics to the Mathematical Components library. - [Trakt](https://github.com/ecranceMERCE/trakt) is a generic goal preprocessing tool for proof automation tactics in Rocq. - [Namespace Emulation System](apps/NES/examples/usage_NES.v) implements most of the features of namespaces (on top of Rocq's modules). - [Dx](https://gitlab.univ-lille.fr/samuel.hym/dx) uses elpi to generate an intermediate representation of Rocq terms, to be later tranformed into C. - [Coercion](apps/coercion) enable to program coercions in Elpi. It comes bundled with Rocq-Elpi. - [Record builder](apps/rbuild) implements fancy record build/update syntax. It comes bundled with Rocq-Elpi. ### Quick Reference In order to load Rocq-Elpi use `From elpi Require Import elpi`. #### Vernacular commands
(click to expand) - `Elpi Command ` creates command named `` containing the preamble [elpi-command](elpi/elpi-command-template.elpi). - `Elpi Tactic ` creates a tactic `` containing the preamble [elpi-tactic](elpi/elpi-tactic-template.elpi). - `Elpi Db ` creates a Db (a program that is accumulated into other programs). `` is the initial contents of the Db, including the type declaration of its constituting predicates. It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands). - `Elpi Program ` lower level primitive letting one crate a command/tactic with a custom preamble ``. - `From some.load.path Extra Dependency as ` declares `` as a piece of code that can be accumulated via `Elpi Accumulate File`. The content is given in the external file `` to be found in the Rocq load path `some.load.path`. - `Elpi File .` declares `` as a piece of code that can be accumulated via `Elpi Accumulate File`. This time the code is given in the .v file. It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands). - `Elpi Accumulate [|] [|File [Signature] |Db [Header] ]` adds code to the current program (or `` or `` if specified). The code can be verbatim, from a file or a Db. File names `` must have been previously declared with `Extra Dependency` or `Elpi File`. Accumulating `File Signature ` only adds the signautre declarations (kinds, types, modes, type abbreviations) from `` skipping the code (clauses/rules). Accumulating `Db Header `, instead of `Db `, accumulates only the first chunk of code associated with Db, typically the type declaration of the predicates that live in the Db. When defining a command or tactic it can be useful to first accumulate the Db header, then some code (possibly calling the predicate living in the Db), and finally accumulating the (full) Db. Note that when a command is executed it may need to be (partially) recompiled, e.g. if the Db was updated. In this case all the code accumulated after the Db (but not after its header) may need to be recompiled. Hence we recommend to accumulate Dbs last. It understands the `#[skip="rex"]` and `#[only="rex"]` which make the command a no op if the Rocq version is matched (or not) by the given regular expression. It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands). It understands the `#[local]`, `#[global]`, and `#[superglobal]` scope attributes, although only when accumulating to a `` (all accumulations to a program are `#[superglobal]`). Default accumulation to db is the equivalent of `#[export]`. See the Rocq reference manual for the meaning of these scopes. - `Elpi Typecheck []` typechecks the current program (or `` if specified). It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands) - `Elpi Debug ` sets the variable ``, relevant for conditional clause compilation (the `:if VARIABLE` clause attribute). It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands) - `Elpi Trace [[ ] *|Off]` enable/disable tracing, eventually limiting it to a specific range of execution steps or predicate names. It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands) - `Elpi Trace Browser` enable/disable tracing for Elpi's [trace browser](). - `Elpi Bound Steps ` limits the number of steps an Elpi program can make. - `Elpi Print [ *]` prints the program `` to a text file called `.txt` (or `` if provided) filtering out clauses whose file or clause-name matches ``. It understands the `#[phase]` attribute, see [synterp-vs-interp](README.md#separation-of-parsing-from-execution-of-vernacular-commands) where: - `` is a qualified Rocq name, e.g. `derive.eq` or `my_program`. - `` is like `` but lives in a different namespace. By convention `` ends in `.db`, e.g. `derive.eq.db`. - `` is verbatim Elpi code, either `lp:{{ ... }}` or `" ... "` (in the latter case, strings delimiters need to be escaped following Rocq rules, e.g. `lp:{{ coq.say "hello!" }}` becomes `" coq.say ""hello!"" "`). - `` is a string containing the path of an external file, e.g. `"this_file.elpi"`. - `` is a qualified Rocq name, eg `foo.elpi` (note that `Extra Dependency` only allows simple identifiers). - `` and `` are numbers, e.g. `17 24`. - `` is a regexp against which the predicate name is matched, e.g. `"derive.*"`.

#### Separation of parsing from execution of vernacular commands
(click to expand) Since version 8.18 Rocq has separate parsing and execution phases, respectively called synterp and interp. Since Rocq has an extensible grammar the parsing phase is not entirely performed by the parser: after parsing one sentence Rocq evaluates its synterp action. The synterp actions of a command like `Import A.` are the subset of its effect which affect parsing, like enabling a notation. Later, during the execution phase Rocq evaluates the its interp action, which includes effects like putting lemma names in scope or enables type class instances etc. Being able to parse an entire document quickly, without actually executing any sentence, is important for developing reactive user interfaces, but requires some extra work when defining new commands, in particular to separate their synterp actions from their interp ones. Each command defined with Rocq-Elpi is split into two programs, one running during the parsing phase and the other one during the execution phase. ##### Declaration of synterp actions Each `Elpi Command` internally declares two programs with the same name. One to be run while the Rocq document is parsed, the synterp-command, and the other one while it is executed, the interp command. `Elpi Accumulate`, by default, adds code to the interp-command. The `#[phase]` attribute can be used to accumulate code to the synterp-command or to both commands. `Elpi Typecheck` checks both commands. Each `Elpi Db` internally declares one db, by default for the interp phase. The `#[phase]` attribute can be used crate a database for the synterp phase, or for both phases. Note that databases for the two phases are distinct, no data is shared among them. In particular the `coq.elpi.accumulate*` API exists in both phases and only acts on data bases for the current phase. ##### The alignment of phases All synterp actions, i.e. calls to APIs dealing with modules and sections like begin/end-module or import/export, have to happen at *both* synterp and interp time and *in the same order*. In order to do so, the synterp-command may need to communicate data to the corresponding interp-command. There are two ways for doing so. The first one is to use, as the main entry points, the following ones: ``` pred main-synterp i:list argument, o:any. pred main-interp i:list argument, i:any. ``` Unlike `main` the former outputs a datum while the latter receives it in input. During the synterp phase the API `coq.synterp-actions` lists the actions performed so far. An excerpt from the [coq-builtin-synterp](builtin-doc/coq-builtin-synterp.elpi) file: ``` % Action executed during the parsing phase (aka synterp) kind synterp-action type. type begin-module id -> synterp-action. type end-module modpath -> synterp-action. ``` The synterp-command can output data of that type, but also any other data it wishes. The second way to communicate data is implicit, but limited to synterp actions. Such synterp actions can be recorded into (nested) groups whose structure is declared using well-bracketed calls to predicates `coq.begin-synterp-group` and `coq.end-synterp-group` in the synterp phase. In the interp phase, one can then use predicate `coq.replay-synterp-action-group` to replay all the synterp actions of the group with the given name at once. In the case where one wishes to interleave code between the actions of a given group, it is also possible to match the synterp group structure at interp, via `coq.begin-synterp-group` and `coq.end-synterp-group`. Individual actions that are contained in the group then need to be replayed individually. One can use `coq.replay-next-synterp-actions` to replay all synterp actions until the next beginning/end of a synterp group. However, this is discouraged in favour of using groups explicitly, as this is more modular. Code that used to rely on the now-removed `coq.replay-all-missing-synterp-actions` predicate can rely on `coq.replay-next-synterp-actions` instead, but this is discouraged in favour of using groups explicitly) ##### Syntax of the `#[phase]` attribute - `#[phase="ph"]` where `"ph"` can be `"parsing"`, `"execution"` or `"both"` - `#[synterp]` is a shorthand for `#[phase="parsing"]` - `#[interp]` is a shorthand for `#[phase="execution]`

#### Invocation of Elpi code
(click to expand) - `Elpi *.` invokes the `main` predicate of the `` program passing a possible empty list of arguments. This is how you invoke a command. - `elpi *.` invokes the `solve` predicate of the `` program passing a possible empty list of arguments and the current goal. This is how you invoke a tactic. - `Elpi Export [As ]` makes it possible to invoke command `` (or `` if given) without the `Elpi` prefix or invoke tactic `` in the middle of a term just writing ` args` instead of `ltac:(elpi args)`. Note that in the case of tactics, all arguments are considered to be terms. Moreover, remember that one can use `Tactic Notation` to give the tactic a better syntax and a shorter name when used in the middle of a proof script. Commands can declare the behavior of starting/ending a proof by, respectively, using `#[proof="begin"] Elpi Export ..` and `#[proof="end"] Elpi Export ..`. Starting the proof can depend on the presence of an attribute, for example `#[proof(begin_if="interactive")] Elpi Export foo` will make `foo` not open a proof, while `#[interactive] foo` will open a proof. See also the `main-interp-proof` and `main-interp-qed` entry points in [coq-builtin](builtin-doc/coq-builtin.elpi). where `` can be: - a number, e.g. `3`, represented in Elpi as `(int 3)` - a string, e.g. `"foo"` or `bar.baz`, represented in Elpi as `(str "foo")` and `(str "bar.baz")`. Rocq keywords and symbols are recognized as strings, eg `=>` requires no quotes. Quotes are necessary if the string contains a space or a character that is not accepted for qualified identifiers or if the string is `Definition`, `Axiom`, `Record`, `Structure`, `Inductive`, `CoInductive`, `Variant` or `Context`. - a term, e.g. `(3)` or `(f x)`, represented in Elpi as `(trm ...)`. Note that terms always require parentheses, that is `3` is a number while `(3)` is a Rocq term and depending on the context could be a natural number (i.e. `S (S (S O))`) or a `Z` or ... See also the section Terms as arguments down below, and the syntax for Ltac variables down below. Commands also accept the following arguments (the syntax is as close as possible to the Rocq one: [...] means optional, * means 0 or more). See the `argument` data type in `coq-builtin.elpi` for their HOAS encoding. See also the section Terms as arguments down below. - `Definition` _name_ _binder_* [`:` _term_] `:=` _term_ - `Axiom` _name_ `:` _term_ - [ `Record` | `Structure` ] _name_ _binder_* [`:` _sort_] `:=` [_name_] `{` _name_ `:` _term_ `;` * `}` - [ `Inductive` | `CoInductive` | `Variant` ] _name_ _binder_* [`|` _binder_*] [`:` _term_] `:=` `|` _name_ _binder_* `:` _term_ * - `Context` _binder_* ##### Ltac Variables Tactics also accept Ltac variables as follows: - `ltac_string:(v)` (for `v` of type `string` or `ident`) - `ltac_int:(v)` (for `v` of type `int` or `integer`) - `ltac_term:(v)` (for `v` of type `constr` or `open_constr` or `uconstr` or `hyp`) - `ltac_open_term:(v)` (for `v` of type `uconstr`) - `ltac_(string|int|term|open_term)_list:(v)` (for `v` of type `list` of ...) - `ltac_tactic:(t)` (for `t` of type `tactic`) - `ltac_attributes:(v)` (for `v` of type `attributes`) For example: ```coq Tactic Notation "tac" string(X) ident(Y) int(Z) hyp(T) constr_list(L) simple_intropattern_list(P) uconstr(U) tactic(TA) := elpi tac ltac_string:(X) ltac_string:(Y) ltac_int:(Z) ltac_term:(T) ltac_term_list:(L) ltac_tactic:(intros P) ltac_open_term:(U) ltac_tactic:(TA). ``` lets one write `tac "a" b 3 H t1 t2 t3 [|m] u ta` in any Ltac context. Arguments are first interpreted by Ltac according to the types declared in the tactic notation and then injected in the corresponding Elpi argument. For example `H` must be an existing hypothesis, since it is typed with the `hyp` Ltac type, but in Elpi it will appear as a term, eg `trm c0`. Similarly `t1`, `t2` and `t3` are checked to be well typed and to contain no unresolved implicit arguments, since this is what the `constr` Ltac type means If they were typed as `open_constr` or `uconstr`, the last or both checks would be respectively skipped. In any case they are passed to the Elpi code as `trm ...`. Both `"a"` and `b` are passed to Elpi as `str ...`. Argument `U` flagged as `ltac_open_term` can mention free variables. The Elpi tactic receives `open-trm N F` where `N` is the number of free variables in `U` and `F` is `fun x1 => ... fun xN => U`. Argument `TA` is received as `tac T` where `T` is an (opaque) tactic that can be called via the `coq.ltac.*` APIs. Finally, `ltac_term:(T)` and `(T)` are *not* synonyms: but the former must be used when defining tactic notations, the latter when invoking elpi tactics directly. ``` `(T)``` can be used to pass an open term to `elpi tactic ...`. ##### Attributes Attributes are supported in both commands and tactics. Examples: - `#[ att ] Elpi cmd` - `#[ att ] cmd` for a command `cmd` exported via `Elpi Export cmd` - `#[ att ] elpi tac` - `Tactic Notation ... attributes(A) ... := ltac_attributes:(A) elpi tac`. Due to a parsing conflict in Rocq grammar, at the time of writing this code: ```coq Tactic Notation "#[" attributes(A) "]" "tac" := ltac_attributes:(A) elpi tac. ``` has the following limitation: - `#[ att ] tac.` does not parse - `(#[ att ] tac).` works - `idtac; #[ att ] tac.` works ##### Terms as arguments Since version 1.15, terms passed to Elpi commands code via `(term)` or via a declaration (like `Record`, `Inductive` ...) are in elaborated format by default. This means that all Rocq notational facilities are available, like deep pattern matching, or tactics in terms. One can use the attribute `#[arguments(raw)]` to declare a command which instead takes arguments in raw format. In that case, notations are unfolded, implicit arguments are expanded (holes `_` are added) and lexical analysis is performed (global names and bound names are identified, holes are applied to bound names in scope), but deep pattern matching or tactics in terms are not supported, and in particular type checking/inference is not performed. Once can use the `coq.typecheck` or `coq.elaborate-skeleton` APIs to fill in implicit arguments and insert coercions on raw terms. Terms passed to Elpi tactics via tactic notations can be forced to be elaborated beforehand by declaring the parameters to be of type `constr` or `open_constr`. Arguments of type `uconstr` are passed raw. ##### Testing/debugging: - `Elpi Query [] ` runs `` in the current program (or in `` if specified). - `Elpi Query [] ` runs `` in the current (synterp) program (or in `` if specified) and `` in the current program (or ``). - `elpi query [] *` runs the `` predicate (that must have the same signature of the default predicate `solve`).

#### Supported features of Gallina (core calculus of Rocq)
(click to expand) - [x] functional core (fun, forall, match, application, let-in, sorts) - [x] evars (unification variables) - [x] single Inductive and CoInductive types (including parameters, non-uniform parameters, indexes) - [ ] mutual Inductive and CoInductive types - [x] fixpoints - [ ] mutual fixpoints - [ ] cofixpoints - [x] primitive records - [x] primitive projections - [x] primitive integers - [x] primitive floats - [ ] primitive arrays - [x] universe polymorphism - [x] modules - [x] module types - [x] functor application - [x] functor definition

#### Supported features of Gallina's extensions (extra logical features, APIs)
(click to expand) Checked boxes are available, unchecked boxes are planned, missing items are not planned. This is a high level list, for the details see [coq-builtin](builtin-doc/coq-builtin.elpi). - [x] i/o: messages, warnings, errors, Rocq version - [x] logical environment: read, write, locate + [x] dependencies between objects - [x] type classes database: read, write + [ ] take over resolution - [x] canonical structures database: read, write + [ ] take over resolution - [x] coercions database: read, write - [x] sections: open, close - [x] scope management: import, export - [x] hints: mode, opaque, resolve, strategy - [x] arguments: implicit, name, scope, simpl - [x] abbreviations: read, write, locate - [x] typing and elaboration - [x] unification - [x] reduction: `lazy`, `cbv`, `vm`, `native` - [x] flags for `lazy` and `cbv` - [x] ltac1: bridge to call ltac1 code, mono and multi-goal tactics - [x] option system: get, set, add - [x] pretty printer: boxes, printing width - [x] attributes: read

#### Relevant files - [coq-builtin](builtin-doc/coq-builtin.elpi) documents the HOAS encoding of Rocq terms and the API to access Rocq - [coq-builtin-synterp](builtin-doc/coq-builtin-synterp.elpi) documents APIs to interact with Rocq at parsing time - [elpi-buitin](builtin-doc/elpi-builtin.elpi) documents Elpi's standard library, you may look here for list processing code - [coq-lib](elpi/coq-lib.elpi) provides some utilities to manipulate Rocq terms; it is an addendum to coq-builtin - [elpi-command-template](elpi/elpi-command-template.elpi) provides the pre-loaded code for `Elpi Command` (execution phase) and `Elpi Tactic` - [elpi-command-template-synterp](elpi/elpi-command-template-synterp.elpi) provides the pre-loaded code for `Elpi Command` (parsing phase) - [elpi-tactic-template](elpi/elpi-tactic-template.elpi) provides the pre-loaded code for `Elpi Tactic` (note tactics also load [elpi-command-template](elpi/elpi-command-template.elpi)) #### Organization of the repository The code of the Rocq plugin is at the root of the repository in the [src](src/), [elpi](elpi/) and [theories](theories/) directories. The [apps](apps/) directory contains client applications written in Rocq-Elpi. #### License Rocq-Elpi is free software under the LGPL v2.1 license or any later version. LPCIC-coq-elpi-eb449d7/_CoqProject000066400000000000000000000066161523041753400166470ustar00rootroot00000000000000-arg -w -arg +elpi.deprecated -arg -w -arg -ambiguous-extra-dep -arg -w -arg -future-coercion-class-field # Plugins. -I _build/install/default/lib # Theories -R theories elpi -R _build/default/theories elpi -Q elpi elpi_elpi -Q _build/default/elpi elpi_elpi -Q examples elpi.examples -Q _build/default/examples elpi.examples -Q examples-stdlib elpi_examples_stdlib -Q _build/default/examples-stdlib elpi_examples_stdlib -Q apps/coercion/tests elpi.apps.coercion.tests -Q _build/default/apps/coercion/tests elpi.apps.coercion.tests -Q apps/coercion/theories elpi.apps.coercion -Q _build/default/apps/coercion/theories elpi.apps.coercion -Q apps/cs/tests elpi.apps.cs.tests -Q _build/default/apps/cs/tests elpi.apps.cs.tests -Q apps/cs/theories elpi.apps.cs -Q _build/default/apps/cs/theories elpi.apps.cs -Q apps/derive/elpi elpi.apps.derive.elpi -Q _build/default/apps/derive/elpi elpi.apps.derive.elpi -Q apps/derive/examples elpi.apps.derive.examples -Q _build/default/apps/derive/examples elpi.apps.derive.examples -Q apps/derive/theories elpi.apps.derive -Q _build/default/apps/derive/theories elpi.apps.derive -Q apps/derive/theories/derive elpi.apps.derive.derive -Q _build/default/apps/derive/theories/derive elpi.apps.derive.derive -Q _build/default/apps/derive/tests elpi.apps.derive.tests -Q apps/derive/tests-stdlib elpi_apps_derive_tests_stdlib -Q _build/default/apps/derive/tests-stdlib elpi_apps_derive_tests_stdlib -Q apps/eltac/examples elpi.apps.eltac.examples -Q _build/default/apps/eltac/examples elpi.apps.eltac.examples -Q apps/eltac/theories elpi.apps.eltac -Q _build/default/apps/eltac/theories elpi.apps.eltac -Q apps/eltac/tests elpi.apps.eltac.tests -Q _build/default/apps/eltac/tests elpi.apps.eltac.tests -Q apps/eltac/tests-stdlib elpi_apps_eltac_tests_stdlib -Q _build/default/apps/eltac/tests-stdlib elpi_apps_eltac_tests_stdlib -Q apps/locker/elpi elpi.apps.locker.elpi -Q _build/default/apps/locker/elpi elpi.apps.locker.elpi -Q apps/locker/tests elpi.apps.locker.tests -Q _build/default/apps/locker/tests elpi.apps.locker.tests -Q apps/locker/theories elpi.apps.locker -Q _build/default/apps/locker/theories elpi.apps.locker -Q apps/NES/elpi elpi.apps.NES.elpi -Q _build/default/apps/NES/elpi elpi.apps.NES.elpi -Q apps/NES/examples elpi.apps.NES.examples -Q _build/default/apps/NES/examples elpi.apps.NES.examples -Q apps/NES/tests elpi.apps.NES.tests -Q _build/default/apps/NES/tests elpi.apps.NES.tests -Q apps/NES/theories elpi.apps.NES -Q _build/default/apps/NES/theories elpi.apps.NES -Q apps/tc/elpi elpi.apps.tc.elpi -Q _build/default/apps/tc/elpi elpi.apps.tc.elpi -Q apps/tc/examples elpi.apps.tc.examples -Q _build/default/apps/tc/examples elpi.apps.tc.examples -Q apps/tc/theories elpi.apps.tc -Q _build/default/apps/tc/theories elpi.apps.tc -Q _build/default/apps/tc/tests elpi.apps.tc.tests -Q apps/tc/tests elpi.apps.tc.tests -Q _build/default/apps/tc/tests-stdlib elpi_apps_tc_tests_stdlib -Q apps/tc/tests-stdlib elpi_apps_tc_tests_stdlib -Q apps/rbuild/elpi elpi.apps.rbuild.elpi -Q _build/default/apps/rbuild/elpi elpi.apps.rbuild.elpi -Q apps/rbuild/examples elpi.apps.rbuild.examples -Q _build/default/apps/rbuild/examples elpi.apps.rbuild.examples -Q apps/rbuild/theories elpi.apps.rbuild -Q _build/default/apps/rbuild/theories elpi.apps.rbuild # Cram tests. -Q tests elpi.tests -Q _build/default/tests elpi.tests -Q tests-stdlib elpi_tests_stdlib -Q _build/default/tests-stdlib elpi_tests_stdlib LPCIC-coq-elpi-eb449d7/apps/000077500000000000000000000000001523041753400154465ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/NES/000077500000000000000000000000001523041753400160735ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/NES/elpi/000077500000000000000000000000001523041753400170245ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/NES/elpi/dune000066400000000000000000000005431523041753400177040ustar00rootroot00000000000000(coq.theory (name elpi.apps.NES.elpi) (package rocq-elpi) (theories elpi)) (rule (target dummy.v) (deps (glob_files *.elpi)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (install (files (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/NES/elpi/))) (section lib_root) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/apps/NES/elpi/nes_interp.elpi000066400000000000000000000055641523041753400220570ustar00rootroot00000000000000namespace nes { % Print a namespace func print-path list string, (pred i:gref, o:coq.pp). print-path Path PP :- std.do! [ std.map {std.findall (ns Path _)} (p\ mp\ p = ns _ mp) MPs, print.pp-list MPs (print.pp-module Path PP) Out, coq.say {coq.pp->string Out}, ]. func begin-path. begin-path :- coq.replay-synterp-action-group "nes.begin-path". func end-path. end-path :- coq.replay-synterp-action-group "nes.end-path". func open-path. open-path :- coq.replay-synterp-action-group "nes.open-path". namespace print { func pp-list list A, (pred i:A, o:coq.pp) -> coq.pp. pp-list L F Out :- std.do! [ std.map-filter L F PPs, Out = coq.pp.box (coq.pp.v 0) {std.intersperse (coq.pp.brk 0 0) PPs}, ]. kind context type. type context list string -> % readable path int -> % length of full path (pred i:gref, o:coq.pp) -> context. % Hides `aux` modules func readable-path context, list string -> list string. readable-path (context Prefix N _) FullPath Path :- std.do! [ std.drop N FullPath RelPath, std.append Prefix RelPath Path, ]. func module-context list string, modpath, (pred i:gref, o:coq.pp) -> context. module-context Prefix MP PP Ctx :- std.do! [ coq.modpath->path MP FullPath, Ctx = context Prefix {std.length FullPath} PP, ]. func submodule-context context, modpath -> context. submodule-context (context _ _ PP as Ctx) MP Ctx' :- std.do! [ coq.modpath->path MP FullPath, readable-path Ctx FullPath Path, Ctx' = context Path {std.length FullPath} PP, ]. func pp-module list string, (pred i:gref, o:coq.pp), modpath -> coq.pp. pp-module Prefix PP MP Out :- std.do! [ pp-module-items {module-context Prefix MP PP} {coq.env.module MP} Out, ]. func pp-module-items context, list module-item -> coq.pp. pp-module-items Ctx Items Out :- pp-list Items (pp-module-item Ctx) Out. func pp-module-item context, module-item -> coq.pp. pp-module-item (context _ _ PP) (gref GR) Out :- PP GR Out, !. pp-module-item Ctx (submodule MP Items) Out :- std.do! [ pp-module-items {submodule-context Ctx MP} Items Out, ]. pp-module-item Ctx (module-type MTP) Out :- pp-modtypath Ctx MTP Out. pp-module-item Ctx (module-type-functor MTP _) Out :- pp-modtypath Ctx MTP Out. pp-module-item Ctx (module-functor MP _) Out :- pp-modpath Ctx MP Out. func pp-path context, string, list string -> coq.pp. pp-path Ctx What FullPath Out :- std.do! [ readable-path Ctx FullPath Path, Out = coq.pp.box coq.pp.h [ coq.pp.str What, coq.pp.spc, coq.pp.str {std.string.concat "." Path}, ], ]. func pp-modtypath context, modtypath -> coq.pp. pp-modtypath Ctx MTP Out :- std.do! [ pp-path Ctx "Module Type" {coq.modtypath->path MTP} Out, ]. func pp-modpath context, modpath -> coq.pp. pp-modpath Ctx MP Out :- std.do! [ pp-path Ctx "Module" {coq.modpath->path MP} Out, ]. } } LPCIC-coq-elpi-eb449d7/apps/NES/elpi/nes_synterp.elpi000066400000000000000000000134551523041753400222600ustar00rootroot00000000000000namespace nes { func ns->modpath prop -> modpath. ns->modpath (ns _ M) M. func open-ns->string prop -> string. open-ns->string (open-ns S _) S. func begin-ns string, list string, list prop -> list prop. begin-ns NS Path In Out :- if (Path = []) (Fresh is NS ^ "_aux_" ^ {std.any->string {new_int} }, coq.env.begin-module Fresh none) true, coq.env.begin-module NS none, coq.env.current-path CP, Clause = open-ns NS CP, Out = [Clause | In], @local! => coq.elpi.accumulate current "NES.db" (clause _ (after "open-ns:begin") Clause). func subpath list string, prop ->. subpath Path (ns Sub _) :- std.appendR _Prefix Path Sub, !. func submod modpath, prop ->. submod Mod (ns _ SubMod) :- coq.modpath->path SubMod SubPath, coq.modpath->path Mod ModPath, std.appendR ModPath _Suffix SubPath, !. func undup list A, list A -> list A. undup [] _ []. undup [X|XS] Seen YS :- std.mem! Seen X, !, undup XS Seen YS. undup [X|XS] Seen [X|YS] :- undup XS [X|Seen] YS. % end-ns ID Stack ClauseIn ClauseOut func end-ns string, list string, list prop -> list prop. end-ns NS Stack In Out :- In => std.do! [ std.rev Stack Path, std.append Path [NS|END_] PathNoEnd, std.findall (ns PathNoEnd M_) AllNS, coq.env.end-module M, % stuff inside M std.filter AllNS (submod M) SubmodNS, % since the current program still sees the clauses that will be dropped % after closing M undup SubmodNS [] SubmodNSNodup, coq.locate-module NS M, if (Path = []) (std.do! [coq.env.end-module M_aux, coq.env.export-module M_aux, Local = @global!]) (Local = @local!), % NES.Open can put clauses in scope std.append Path [NS] NewPath, New = [ns NewPath M | SubmodNSNodup], std.append In New Out, std.forall New (c\ Local => coq.elpi.accumulate current "NES.db" (clause _ _ c)), ]. :index (_ 1) func iter-> list A, list A, (func A, list A, list prop -> list prop), list prop -> list prop. iter-> _ [] _ O O :- coq.error "No elements". iter-> INIT [X] F In Out :- !, F X INIT In Out. iter-> INIT [X|XS] F In Out :- F X {std.append XS INIT} In Mid, iter-> INIT XS F Mid Out. :index (_ 1) func iter<- list A, list A, (func A, list A, list prop -> list prop), list prop -> list prop. iter<- _ [] _ _ _ :- coq.error "No elements". iter<- INIT [X] F In Out :- !, F X INIT In Out. iter<- INIT [X|XS] F In Out :- iter<- INIT XS F In Mid, F X {std.append XS INIT} Mid Out. % Panics unless [S] well-formed. func string->non-empty-ns string -> list string. string->non-empty-ns S L :- std.do! [ Ident = "[a-zA-Z_][a-zA-Z_0-9']*", % non-unicode Coq identifiers Path is "^\\(" ^ Ident ^ "\\.\\)*" ^ Ident ^ "$", if (rex.match Path S) true (string->ns.err S), rex.split "\\." S L, if (std.mem L "_") (string->ns.err S) true, ]. func string->ns.err string ->. string->ns.err S :- coq.error {calc ("NES: Bad : \"" ^ S ^ "\"")}. % Panics unless [S] empty, or well-formed. func string->ns string -> list string. string->ns "" [] :- !. string->ns S L :- string->non-empty-ns S L. func ns->string list string -> string. ns->string NS S :- std.string.concat "." NS S. func begin-path list string -> list prop. begin-path [] [] :- std.do! [ coq.begin-synterp-group "nes.begin-path" Group, coq.end-synterp-group Group, ]. begin-path ([_|_] as Path) Out :- std.do! [ coq.begin-synterp-group "nes.begin-path" Group, coq.env.current-path CP, if (open-ns _ NSCP) (std.assert! (NSCP = CP) "NS: cannot begin a namespace inside a module that is inside a namespace") true, std.map {std.findall (open-ns Y_ P_)} open-ns->string Stack, if (Stack = []) true (std.do! [ coq.locate-all {std.string.concat "." Path} L, if (std.do! [ std.mem L (loc-modpath M), coq.modpath->path M MP, MP = {std.append CP Path} ]) (iter-> [] Stack end-ns [] _, iter<- [] Stack begin-ns [] _) true, ]), iter<- Stack {std.rev Path} begin-ns [] Out, open-super-path Path [], coq.end-synterp-group Group, ]. func std.time-do! list prop ->. std.time-do! []. std.time-do! [P|PS] :- std.time P T, coq.say P "\ntakes" T "\n", !, std.time-do! PS. func end-path list string -> list prop. end-path [] [] :- std.do! [ coq.begin-synterp-group "nes.end-path" Group, coq.end-synterp-group Group, ]. end-path ([_|_] as Path) Out :- std.do! [ coq.begin-synterp-group "nes.end-path" Group, std.map {std.findall (open-ns X_ P_)} nes.open-ns->string Stack, std.assert! (std.appendR {std.rev Path} Bottom Stack) "NES: Ending a namespace that is not begun", nes.iter-> Bottom {std.rev Path} nes.end-ns [] Out, coq.end-synterp-group Group, ]. func open-path list string ->. open-path Path :- std.do! [ coq.begin-synterp-group "nes.open-path" Group, std.map {std.findall (ns Path M_)} nes.ns->modpath Mods, std.forall Mods coq.env.import-module, coq.end-synterp-group Group, ]. :index (1) func open-super-path list string, list string ->. open-super-path [] _. open-super-path [P|PS] ACC :- std.append ACC [P] Cur, open-path Cur, open-super-path PS Cur. % Currently open namespace, or []. func current-path -> list string. current-path NS :- std.do! [ std.map {std.findall (open-ns X_ P_)} nes.open-ns->string Stack, std.rev Stack NS, ]. % Find an existing namespace, or panic. func resolve string -> list string. resolve S Path :- std.do! [ if (Top = "^_\\.", rex.match Top S) (std.do! [ rex.replace Top "" S S', string->non-empty-ns S' NS, if (ns NS _) (Path = NS) (resolve.err S'), ])( resolve.walk S {current-path} {string->non-empty-ns S} Path ), ]. func resolve.walk string, list string, list string -> list string. resolve.walk S Ctx SP Path :- std.do! [ std.append Ctx SP Candidate, ( ns Candidate _, Path = Candidate ; Ctx = [], resolve.err S ; resolve.walk S {std.drop-last 1 Ctx} SP Path ), ]. func resolve.err string ->. resolve.err S :- coq.error "NES: Namespace not found:" S. } LPCIC-coq-elpi-eb449d7/apps/NES/examples/000077500000000000000000000000001523041753400177115ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/NES/examples/dune000066400000000000000000000001501523041753400205630ustar00rootroot00000000000000(coq.theory (name elpi.apps.NES.examples) (theories elpi elpi.apps.NES)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/NES/examples/usage_NES.v000066400000000000000000000037201523041753400217130ustar00rootroot00000000000000From elpi.apps Require Import NES. (* Namespaces are like modules, since they let you organize your notions and avoid name collisions. Namespaces are unlinke modules, since you can always add a notion to a namespace, even if the namespace was ended before. *) NES.Begin This.Is.A.Long.Namespace. Definition stuff := 1. NES.End This.Is.A.Long.Namespace. NES.Begin This.Is.A.Long.Namespace. Definition more_stuff := stuff. (* stuff in the namespace is visible *) NES.End This.Is.A.Long.Namespace. Print This.Is.A.Long.Namespace.stuff. (* = 1 *) Eval compute in This.Is.A.Long.Namespace.more_stuff. (* = 1 *) (* Unlike a module, a namespace can contain two notions with the same name. The latter shadows the former. *) NES.Begin This.Is.A.Long.Namespace. Definition stuff := 2. NES.End This.Is.A.Long.Namespace. (* Binding is static, eg more_stuff still values 1 *) Print This.Is.A.Long.Namespace.stuff. (* = 2 *) Eval compute in This.Is.A.Long.Namespace.more_stuff. (* = 1 *) (* Listing and printing namespaces *) NES.List This. (* This_aux_1.This.Is.A.Long.Namespace.stuff (* <-- shadowed *) This.Is.A.Long.Namespace.more_stuff This.Is.A.Long.Namespace.stuff *) NES.Print This. (* This_aux_1.This.Is.A.Long.Namespace.stuff : nat This.Is.A.Long.Namespace.more_stuff : nat This.Is.A.Long.Namespace.stuff : nat *) (* For convenience one can open a namespace to write short names *) NES.Open This.Is.A.Long.Namespace. Print stuff. (* Not quite a name space yet *) Structure Default := { sort : Type; default : sort }. NES.Begin CS. Global Canonical Structure nat_def := {| sort := nat; default := 46 |}. Check @default _ : nat. NES.End CS. Fail Check nat_def. (* we want nat_def to live in the CS namespace, BUT we want the canonical structure declaration to live outside the namespace *) Fail Check @default _ : nat. (* This behavior requires Libobject to be aware of the role played by a module: if it is a namespace some "actions" have to be propagated upward *) LPCIC-coq-elpi-eb449d7/apps/NES/tests/000077500000000000000000000000001523041753400172355ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/NES/tests/dune000066400000000000000000000002011523041753400201040ustar00rootroot00000000000000(coq.theory (name elpi.apps.NES.tests) (package rocq-elpi-tests) (theories elpi elpi.apps.NES)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/NES/tests/test_NES.v000066400000000000000000000023021523041753400211050ustar00rootroot00000000000000From elpi.apps Require Import NES. (* Some invalid namespaces *) Fail NES.Begin. Fail NES.Begin "". Fail NES.Begin ".". Fail NES.Begin ".A". Fail NES.Begin "A.". Fail NES.Begin "A..B". Fail NES.Begin "A._.B". (* name space creation *) NES.Begin Foo. Definition x := 3. NES.End Foo. Print Foo.x. (* adding one name inside an existing name space *) NES.Begin Foo. Definition x2 := 4. NES.End Foo. Print Foo.x. Print Foo.x2. (* shadowing: adding the same name twice *) NES.Begin Foo. Definition x := 5. NES.End Foo. Check (refl_equal _ : Foo.x = 5). (* shadowing *) (* nesting *) NES.Begin A. NES.Begin B. Definition c := 1. NES.End B. NES.End A. About A.B.c. (* adding one name inside an existing, nested, name space *) NES.Begin A1. NES.Begin B1. Definition c := 1. NES.End B1. NES.Begin B1. Definition d := 1. NES.End B1. NES.End A1. About A1.B1.d. About A1.B1.c. (* all names in the Foo namespace must be visible *) NES.Open Foo. Print x. Print x2. NES.Open A1. Print B1.c. Print B1.d. NES.Open A1.B1. Print d. (* boh *) NES.Begin A2.B2. Definition e := 1. NES.End B2. NES.End A2. NES.Begin A2.B2. Definition f := 2. NES.End A2.B2. Print A2.B2.f. NES.Begin X. Module Y. Fail NES.Begin Z. End Y. NES.End X. LPCIC-coq-elpi-eb449d7/apps/NES/tests/test_NES_lib.v000066400000000000000000000014161523041753400217400ustar00rootroot00000000000000From elpi.apps.NES.elpi Extra Dependency "nes_synterp.elpi" as nes_synterp. From elpi.apps.NES.elpi Extra Dependency "nes_interp.elpi" as nes_interp. From elpi.apps Require Import NES. Elpi Command Make. #[phase="both"] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[interp] Elpi Accumulate File nes_interp. #[synterp] Elpi Accumulate lp:{{ main [str Path] :- std.do! [ nes.string->ns Path NS, nes.begin-path NS OpenNS, OpenNS => nes.end-path NS _NewNS, ]. main _ :- coq.error "usage: Make ". }}. #[interp] Elpi Accumulate lp:{{ main _ :- std.do! [ nes.begin-path, coq.env.add-const "x" {{ 42 }} _ @transparent! _C, nes.end-path, ]. }}. Elpi Export Make. Make Cats.And.Dogs. Print Cats.And.Dogs.x. LPCIC-coq-elpi-eb449d7/apps/NES/tests/test_NES_perf.v000066400000000000000000000623321523041753400221320ustar00rootroot00000000000000From elpi.apps Require Import NES. NES.Begin NS1. Definition x := 0. NES.End NS1. NES.Begin NS2. Definition x := 0. NES.End NS2. NES.Begin NS3. Definition x := 0. NES.End NS3. NES.Begin NS4. Definition x := 0. NES.End NS4. NES.Begin NS5. Definition x := 0. NES.End NS5. NES.Begin NS6. Definition x := 0. NES.End NS6. NES.Begin NS7. Definition x := 0. NES.End NS7. NES.Begin NS8. Definition x := 0. NES.End NS8. NES.Begin NS9. Definition x := 0. NES.End NS9. NES.Begin NS10. Definition x := 0. NES.End NS10. NES.Begin NS11. Definition x := 0. NES.End NS11. NES.Begin NS12. Definition x := 0. NES.End NS12. NES.Begin NS13. Definition x := 0. NES.End NS13. NES.Begin NS14. Definition x := 0. NES.End NS14. NES.Begin NS15. Definition x := 0. NES.End NS15. NES.Begin NS16. Definition x := 0. NES.End NS16. NES.Begin NS17. Definition x := 0. NES.End NS17. NES.Begin NS18. Definition x := 0. NES.End NS18. NES.Begin NS19. Definition x := 0. NES.End NS19. NES.Begin NS20. Definition x := 0. NES.End NS20. NES.Begin NS21. Definition x := 0. NES.End NS21. NES.Begin NS22. Definition x := 0. NES.End NS22. NES.Begin NS23. Definition x := 0. NES.End NS23. NES.Begin NS24. Definition x := 0. NES.End NS24. NES.Begin NS25. Definition x := 0. NES.End NS25. NES.Begin NS26. Definition x := 0. NES.End NS26. NES.Begin NS27. Definition x := 0. NES.End NS27. NES.Begin NS28. Definition x := 0. NES.End NS28. NES.Begin NS29. Definition x := 0. NES.End NS29. NES.Begin NS30. Definition x := 0. NES.End NS30. NES.Begin NS31. Definition x := 0. NES.End NS31. NES.Begin NS32. Definition x := 0. NES.End NS32. NES.Begin NS33. Definition x := 0. NES.End NS33. NES.Begin NS34. Definition x := 0. NES.End NS34. NES.Begin NS35. Definition x := 0. NES.End NS35. NES.Begin NS36. Definition x := 0. NES.End NS36. NES.Begin NS37. Definition x := 0. NES.End NS37. NES.Begin NS38. Definition x := 0. NES.End NS38. NES.Begin NS39. Definition x := 0. NES.End NS39. NES.Begin NS40. Definition x := 0. NES.End NS40. NES.Begin NS41. Definition x := 0. NES.End NS41. NES.Begin NS42. Definition x := 0. NES.End NS42. NES.Begin NS43. Definition x := 0. NES.End NS43. NES.Begin NS44. Definition x := 0. NES.End NS44. NES.Begin NS45. Definition x := 0. NES.End NS45. NES.Begin NS46. Definition x := 0. NES.End NS46. NES.Begin NS47. Definition x := 0. NES.End NS47. NES.Begin NS48. Definition x := 0. NES.End NS48. NES.Begin NS49. Definition x := 0. NES.End NS49. NES.Begin NS50. Definition x := 0. NES.End NS50. NES.Begin NS51. Definition x := 0. NES.End NS51. NES.Begin NS52. Definition x := 0. NES.End NS52. NES.Begin NS53. Definition x := 0. NES.End NS53. NES.Begin NS54. Definition x := 0. NES.End NS54. NES.Begin NS55. Definition x := 0. NES.End NS55. NES.Begin NS56. Definition x := 0. NES.End NS56. NES.Begin NS57. Definition x := 0. NES.End NS57. NES.Begin NS58. Definition x := 0. NES.End NS58. NES.Begin NS59. Definition x := 0. NES.End NS59. NES.Begin NS60. Definition x := 0. NES.End NS60. NES.Begin NS61. Definition x := 0. NES.End NS61. NES.Begin NS62. Definition x := 0. NES.End NS62. NES.Begin NS63. Definition x := 0. NES.End NS63. NES.Begin NS64. Definition x := 0. NES.End NS64. NES.Begin NS65. Definition x := 0. NES.End NS65. NES.Begin NS66. Definition x := 0. NES.End NS66. NES.Begin NS67. Definition x := 0. NES.End NS67. NES.Begin NS68. Definition x := 0. NES.End NS68. NES.Begin NS69. Definition x := 0. NES.End NS69. NES.Begin NS70. Definition x := 0. NES.End NS70. NES.Begin NS71. Definition x := 0. NES.End NS71. NES.Begin NS72. Definition x := 0. NES.End NS72. NES.Begin NS73. Definition x := 0. NES.End NS73. NES.Begin NS74. Definition x := 0. NES.End NS74. NES.Begin NS75. Definition x := 0. NES.End NS75. NES.Begin NS76. Definition x := 0. NES.End NS76. NES.Begin NS77. Definition x := 0. NES.End NS77. NES.Begin NS78. Definition x := 0. NES.End NS78. NES.Begin NS79. Definition x := 0. NES.End NS79. NES.Begin NS80. Definition x := 0. NES.End NS80. NES.Begin NS81. Definition x := 0. NES.End NS81. NES.Begin NS82. Definition x := 0. NES.End NS82. NES.Begin NS83. Definition x := 0. NES.End NS83. NES.Begin NS84. Definition x := 0. NES.End NS84. NES.Begin NS85. Definition x := 0. NES.End NS85. NES.Begin NS86. Definition x := 0. NES.End NS86. NES.Begin NS87. Definition x := 0. NES.End NS87. NES.Begin NS88. Definition x := 0. NES.End NS88. NES.Begin NS89. Definition x := 0. NES.End NS89. NES.Begin NS90. Definition x := 0. NES.End NS90. NES.Begin NS91. Definition x := 0. NES.End NS91. NES.Begin NS92. Definition x := 0. NES.End NS92. NES.Begin NS93. Definition x := 0. NES.End NS93. NES.Begin NS94. Definition x := 0. NES.End NS94. NES.Begin NS95. Definition x := 0. NES.End NS95. NES.Begin NS96. Definition x := 0. NES.End NS96. NES.Begin NS97. Definition x := 0. NES.End NS97. NES.Begin NS98. Definition x := 0. NES.End NS98. NES.Begin NS99. Definition x := 0. NES.End NS99. NES.Begin NS100. Definition x := 0. NES.End NS100. NES.Begin NS101. Definition x := 0. NES.End NS101. NES.Begin NS102. Definition x := 0. NES.End NS102. NES.Begin NS103. Definition x := 0. NES.End NS103. NES.Begin NS104. Definition x := 0. NES.End NS104. NES.Begin NS105. Definition x := 0. NES.End NS105. NES.Begin NS106. Definition x := 0. NES.End NS106. NES.Begin NS107. Definition x := 0. NES.End NS107. NES.Begin NS108. Definition x := 0. NES.End NS108. NES.Begin NS109. Definition x := 0. NES.End NS109. NES.Begin NS110. Definition x := 0. NES.End NS110. NES.Begin NS111. Definition x := 0. NES.End NS111. NES.Begin NS112. Definition x := 0. NES.End NS112. NES.Begin NS113. Definition x := 0. NES.End NS113. NES.Begin NS114. Definition x := 0. NES.End NS114. NES.Begin NS115. Definition x := 0. NES.End NS115. NES.Begin NS116. Definition x := 0. NES.End NS116. NES.Begin NS117. Definition x := 0. NES.End NS117. NES.Begin NS118. Definition x := 0. NES.End NS118. NES.Begin NS119. Definition x := 0. NES.End NS119. NES.Begin NS120. Definition x := 0. NES.End NS120. NES.Begin NS121. Definition x := 0. NES.End NS121. NES.Begin NS122. Definition x := 0. NES.End NS122. NES.Begin NS123. Definition x := 0. NES.End NS123. NES.Begin NS124. Definition x := 0. NES.End NS124. NES.Begin NS125. Definition x := 0. NES.End NS125. NES.Begin NS126. Definition x := 0. NES.End NS126. NES.Begin NS127. Definition x := 0. NES.End NS127. NES.Begin NS128. Definition x := 0. NES.End NS128. NES.Begin NS129. Definition x := 0. NES.End NS129. NES.Begin NS130. Definition x := 0. NES.End NS130. NES.Begin NS131. Definition x := 0. NES.End NS131. NES.Begin NS132. Definition x := 0. NES.End NS132. NES.Begin NS133. Definition x := 0. NES.End NS133. NES.Begin NS134. Definition x := 0. NES.End NS134. NES.Begin NS135. Definition x := 0. NES.End NS135. NES.Begin NS136. Definition x := 0. NES.End NS136. NES.Begin NS137. Definition x := 0. NES.End NS137. NES.Begin NS138. Definition x := 0. NES.End NS138. NES.Begin NS139. Definition x := 0. NES.End NS139. NES.Begin NS140. Definition x := 0. NES.End NS140. NES.Begin NS141. Definition x := 0. NES.End NS141. NES.Begin NS142. Definition x := 0. NES.End NS142. NES.Begin NS143. Definition x := 0. NES.End NS143. NES.Begin NS144. Definition x := 0. NES.End NS144. NES.Begin NS145. Definition x := 0. NES.End NS145. NES.Begin NS146. Definition x := 0. NES.End NS146. NES.Begin NS147. Definition x := 0. NES.End NS147. NES.Begin NS148. Definition x := 0. NES.End NS148. NES.Begin NS149. Definition x := 0. NES.End NS149. NES.Begin NS150. Definition x := 0. NES.End NS150. NES.Begin NS151. Definition x := 0. NES.End NS151. NES.Begin NS152. Definition x := 0. NES.End NS152. NES.Begin NS153. Definition x := 0. NES.End NS153. NES.Begin NS154. Definition x := 0. NES.End NS154. NES.Begin NS155. Definition x := 0. NES.End NS155. NES.Begin NS156. Definition x := 0. NES.End NS156. NES.Begin NS157. Definition x := 0. NES.End NS157. NES.Begin NS158. Definition x := 0. NES.End NS158. NES.Begin NS159. Definition x := 0. NES.End NS159. NES.Begin NS160. Definition x := 0. NES.End NS160. NES.Begin NS161. Definition x := 0. NES.End NS161. NES.Begin NS162. Definition x := 0. NES.End NS162. NES.Begin NS163. Definition x := 0. NES.End NS163. NES.Begin NS164. Definition x := 0. NES.End NS164. NES.Begin NS165. Definition x := 0. NES.End NS165. NES.Begin NS166. Definition x := 0. NES.End NS166. NES.Begin NS167. Definition x := 0. NES.End NS167. NES.Begin NS168. Definition x := 0. NES.End NS168. NES.Begin NS169. Definition x := 0. NES.End NS169. NES.Begin NS170. Definition x := 0. NES.End NS170. NES.Begin NS171. Definition x := 0. NES.End NS171. NES.Begin NS172. Definition x := 0. NES.End NS172. NES.Begin NS173. Definition x := 0. NES.End NS173. NES.Begin NS174. Definition x := 0. NES.End NS174. NES.Begin NS175. Definition x := 0. NES.End NS175. NES.Begin NS176. Definition x := 0. NES.End NS176. NES.Begin NS177. Definition x := 0. NES.End NS177. NES.Begin NS178. Definition x := 0. NES.End NS178. NES.Begin NS179. Definition x := 0. NES.End NS179. NES.Begin NS180. Definition x := 0. NES.End NS180. NES.Begin NS181. Definition x := 0. NES.End NS181. NES.Begin NS182. Definition x := 0. NES.End NS182. NES.Begin NS183. Definition x := 0. NES.End NS183. NES.Begin NS184. Definition x := 0. NES.End NS184. NES.Begin NS185. Definition x := 0. NES.End NS185. NES.Begin NS186. Definition x := 0. NES.End NS186. NES.Begin NS187. Definition x := 0. NES.End NS187. NES.Begin NS188. Definition x := 0. NES.End NS188. NES.Begin NS189. Definition x := 0. NES.End NS189. NES.Begin NS190. Definition x := 0. NES.End NS190. NES.Begin NS191. Definition x := 0. NES.End NS191. NES.Begin NS192. Definition x := 0. NES.End NS192. NES.Begin NS193. Definition x := 0. NES.End NS193. NES.Begin NS194. Definition x := 0. NES.End NS194. NES.Begin NS195. Definition x := 0. NES.End NS195. NES.Begin NS196. Definition x := 0. NES.End NS196. NES.Begin NS197. Definition x := 0. NES.End NS197. NES.Begin NS198. Definition x := 0. NES.End NS198. NES.Begin NS199. Definition x := 0. NES.End NS199. NES.Begin NS200. Definition x := 0. NES.End NS200. NES.Begin NS201. Definition x := 0. NES.End NS201. NES.Begin NS202. Definition x := 0. NES.End NS202. NES.Begin NS203. Definition x := 0. NES.End NS203. NES.Begin NS204. Definition x := 0. NES.End NS204. NES.Begin NS205. Definition x := 0. NES.End NS205. NES.Begin NS206. Definition x := 0. NES.End NS206. NES.Begin NS207. Definition x := 0. NES.End NS207. NES.Begin NS208. Definition x := 0. NES.End NS208. NES.Begin NS209. Definition x := 0. NES.End NS209. NES.Begin NS210. Definition x := 0. NES.End NS210. NES.Begin NS211. Definition x := 0. NES.End NS211. NES.Begin NS212. Definition x := 0. NES.End NS212. NES.Begin NS213. Definition x := 0. NES.End NS213. NES.Begin NS214. Definition x := 0. NES.End NS214. NES.Begin NS215. Definition x := 0. NES.End NS215. NES.Begin NS216. Definition x := 0. NES.End NS216. NES.Begin NS217. Definition x := 0. NES.End NS217. NES.Begin NS218. Definition x := 0. NES.End NS218. NES.Begin NS219. Definition x := 0. NES.End NS219. NES.Begin NS220. Definition x := 0. NES.End NS220. NES.Begin NS221. Definition x := 0. NES.End NS221. NES.Begin NS222. Definition x := 0. NES.End NS222. NES.Begin NS223. Definition x := 0. NES.End NS223. NES.Begin NS224. Definition x := 0. NES.End NS224. NES.Begin NS225. Definition x := 0. NES.End NS225. NES.Begin NS226. Definition x := 0. NES.End NS226. NES.Begin NS227. Definition x := 0. NES.End NS227. NES.Begin NS228. Definition x := 0. NES.End NS228. NES.Begin NS229. Definition x := 0. NES.End NS229. NES.Begin NS230. Definition x := 0. NES.End NS230. NES.Begin NS231. Definition x := 0. NES.End NS231. NES.Begin NS232. Definition x := 0. NES.End NS232. NES.Begin NS233. Definition x := 0. NES.End NS233. NES.Begin NS234. Definition x := 0. NES.End NS234. NES.Begin NS235. Definition x := 0. NES.End NS235. NES.Begin NS236. Definition x := 0. NES.End NS236. NES.Begin NS237. Definition x := 0. NES.End NS237. NES.Begin NS238. Definition x := 0. NES.End NS238. NES.Begin NS239. Definition x := 0. NES.End NS239. NES.Begin NS240. Definition x := 0. NES.End NS240. NES.Begin NS241. Definition x := 0. NES.End NS241. NES.Begin NS242. Definition x := 0. NES.End NS242. NES.Begin NS243. Definition x := 0. NES.End NS243. NES.Begin NS244. Definition x := 0. NES.End NS244. NES.Begin NS245. Definition x := 0. NES.End NS245. NES.Begin NS246. Definition x := 0. NES.End NS246. NES.Begin NS247. Definition x := 0. NES.End NS247. NES.Begin NS248. Definition x := 0. NES.End NS248. NES.Begin NS249. Definition x := 0. NES.End NS249. NES.Begin NS250. Definition x := 0. NES.End NS250. NES.Begin NS251. Definition x := 0. NES.End NS251. NES.Begin NS252. Definition x := 0. NES.End NS252. NES.Begin NS253. Definition x := 0. NES.End NS253. NES.Begin NS254. Definition x := 0. NES.End NS254. NES.Begin NS255. Definition x := 0. NES.End NS255. NES.Begin NS256. Definition x := 0. NES.End NS256. NES.Begin NS257. Definition x := 0. NES.End NS257. NES.Begin NS258. Definition x := 0. NES.End NS258. NES.Begin NS259. Definition x := 0. NES.End NS259. NES.Begin NS260. Definition x := 0. NES.End NS260. NES.Begin NS261. Definition x := 0. NES.End NS261. NES.Begin NS262. Definition x := 0. NES.End NS262. NES.Begin NS263. Definition x := 0. NES.End NS263. NES.Begin NS264. Definition x := 0. NES.End NS264. NES.Begin NS265. Definition x := 0. NES.End NS265. NES.Begin NS266. Definition x := 0. NES.End NS266. NES.Begin NS267. Definition x := 0. NES.End NS267. NES.Begin NS268. Definition x := 0. NES.End NS268. NES.Begin NS269. Definition x := 0. NES.End NS269. NES.Begin NS270. Definition x := 0. NES.End NS270. NES.Begin NS271. Definition x := 0. NES.End NS271. NES.Begin NS272. Definition x := 0. NES.End NS272. NES.Begin NS273. Definition x := 0. NES.End NS273. NES.Begin NS274. Definition x := 0. NES.End NS274. NES.Begin NS275. Definition x := 0. NES.End NS275. NES.Begin NS276. Definition x := 0. NES.End NS276. NES.Begin NS277. Definition x := 0. NES.End NS277. NES.Begin NS278. Definition x := 0. NES.End NS278. NES.Begin NS279. Definition x := 0. NES.End NS279. NES.Begin NS280. Definition x := 0. NES.End NS280. NES.Begin NS281. Definition x := 0. NES.End NS281. NES.Begin NS282. Definition x := 0. NES.End NS282. NES.Begin NS283. Definition x := 0. NES.End NS283. NES.Begin NS284. Definition x := 0. NES.End NS284. NES.Begin NS285. Definition x := 0. NES.End NS285. NES.Begin NS286. Definition x := 0. NES.End NS286. NES.Begin NS287. Definition x := 0. NES.End NS287. NES.Begin NS288. Definition x := 0. NES.End NS288. NES.Begin NS289. Definition x := 0. NES.End NS289. NES.Begin NS290. Definition x := 0. NES.End NS290. NES.Begin NS291. Definition x := 0. NES.End NS291. NES.Begin NS292. Definition x := 0. NES.End NS292. NES.Begin NS293. Definition x := 0. NES.End NS293. NES.Begin NS294. Definition x := 0. NES.End NS294. NES.Begin NS295. Definition x := 0. NES.End NS295. NES.Begin NS296. Definition x := 0. NES.End NS296. NES.Begin NS297. Definition x := 0. NES.End NS297. NES.Begin NS298. Definition x := 0. NES.End NS298. NES.Begin NS299. Definition x := 0. NES.End NS299. NES.Begin NS300. Definition x := 0. NES.End NS300. NES.Begin NS301. Definition x := 0. NES.End NS301. NES.Begin NS302. Definition x := 0. NES.End NS302. NES.Begin NS303. Definition x := 0. NES.End NS303. NES.Begin NS304. Definition x := 0. NES.End NS304. NES.Begin NS305. Definition x := 0. NES.End NS305. NES.Begin NS306. Definition x := 0. NES.End NS306. NES.Begin NS307. Definition x := 0. NES.End NS307. NES.Begin NS308. Definition x := 0. NES.End NS308. NES.Begin NS309. Definition x := 0. NES.End NS309. NES.Begin NS310. Definition x := 0. NES.End NS310. NES.Begin NS311. Definition x := 0. NES.End NS311. NES.Begin NS312. Definition x := 0. NES.End NS312. NES.Begin NS313. Definition x := 0. NES.End NS313. NES.Begin NS314. Definition x := 0. NES.End NS314. NES.Begin NS315. Definition x := 0. NES.End NS315. NES.Begin NS316. Definition x := 0. NES.End NS316. NES.Begin NS317. Definition x := 0. NES.End NS317. NES.Begin NS318. Definition x := 0. NES.End NS318. NES.Begin NS319. Definition x := 0. NES.End NS319. NES.Begin NS320. Definition x := 0. NES.End NS320. NES.Begin NS321. Definition x := 0. NES.End NS321. NES.Begin NS322. Definition x := 0. NES.End NS322. NES.Begin NS323. Definition x := 0. NES.End NS323. NES.Begin NS324. Definition x := 0. NES.End NS324. NES.Begin NS325. Definition x := 0. NES.End NS325. NES.Begin NS326. Definition x := 0. NES.End NS326. NES.Begin NS327. Definition x := 0. NES.End NS327. NES.Begin NS328. Definition x := 0. NES.End NS328. NES.Begin NS329. Definition x := 0. NES.End NS329. NES.Begin NS330. Definition x := 0. NES.End NS330. NES.Begin NS331. Definition x := 0. NES.End NS331. NES.Begin NS332. Definition x := 0. NES.End NS332. NES.Begin NS333. Definition x := 0. NES.End NS333. NES.Begin NS334. Definition x := 0. NES.End NS334. NES.Begin NS335. Definition x := 0. NES.End NS335. NES.Begin NS336. Definition x := 0. NES.End NS336. NES.Begin NS337. Definition x := 0. NES.End NS337. NES.Begin NS338. Definition x := 0. NES.End NS338. NES.Begin NS339. Definition x := 0. NES.End NS339. NES.Begin NS340. Definition x := 0. NES.End NS340. NES.Begin NS341. Definition x := 0. NES.End NS341. NES.Begin NS342. Definition x := 0. NES.End NS342. NES.Begin NS343. Definition x := 0. NES.End NS343. NES.Begin NS344. Definition x := 0. NES.End NS344. NES.Begin NS345. Definition x := 0. NES.End NS345. NES.Begin NS346. Definition x := 0. NES.End NS346. NES.Begin NS347. Definition x := 0. NES.End NS347. NES.Begin NS348. Definition x := 0. NES.End NS348. NES.Begin NS349. Definition x := 0. NES.End NS349. NES.Begin NS350. Definition x := 0. NES.End NS350. NES.Begin NS351. Definition x := 0. NES.End NS351. NES.Begin NS352. Definition x := 0. NES.End NS352. NES.Begin NS353. Definition x := 0. NES.End NS353. NES.Begin NS354. Definition x := 0. NES.End NS354. NES.Begin NS355. Definition x := 0. NES.End NS355. NES.Begin NS356. Definition x := 0. NES.End NS356. NES.Begin NS357. Definition x := 0. NES.End NS357. NES.Begin NS358. Definition x := 0. NES.End NS358. NES.Begin NS359. Definition x := 0. NES.End NS359. NES.Begin NS360. Definition x := 0. NES.End NS360. NES.Begin NS361. Definition x := 0. NES.End NS361. NES.Begin NS362. Definition x := 0. NES.End NS362. NES.Begin NS363. Definition x := 0. NES.End NS363. NES.Begin NS364. Definition x := 0. NES.End NS364. NES.Begin NS365. Definition x := 0. NES.End NS365. NES.Begin NS366. Definition x := 0. NES.End NS366. NES.Begin NS367. Definition x := 0. NES.End NS367. NES.Begin NS368. Definition x := 0. NES.End NS368. NES.Begin NS369. Definition x := 0. NES.End NS369. NES.Begin NS370. Definition x := 0. NES.End NS370. NES.Begin NS371. Definition x := 0. NES.End NS371. NES.Begin NS372. Definition x := 0. NES.End NS372. NES.Begin NS373. Definition x := 0. NES.End NS373. NES.Begin NS374. Definition x := 0. NES.End NS374. NES.Begin NS375. Definition x := 0. NES.End NS375. NES.Begin NS376. Definition x := 0. NES.End NS376. NES.Begin NS377. Definition x := 0. NES.End NS377. NES.Begin NS378. Definition x := 0. NES.End NS378. NES.Begin NS379. Definition x := 0. NES.End NS379. NES.Begin NS380. Definition x := 0. NES.End NS380. NES.Begin NS381. Definition x := 0. NES.End NS381. NES.Begin NS382. Definition x := 0. NES.End NS382. NES.Begin NS383. Definition x := 0. NES.End NS383. NES.Begin NS384. Definition x := 0. NES.End NS384. NES.Begin NS385. Definition x := 0. NES.End NS385. NES.Begin NS386. Definition x := 0. NES.End NS386. NES.Begin NS387. Definition x := 0. NES.End NS387. NES.Begin NS388. Definition x := 0. NES.End NS388. NES.Begin NS389. Definition x := 0. NES.End NS389. NES.Begin NS390. Definition x := 0. NES.End NS390. NES.Begin NS391. Definition x := 0. NES.End NS391. NES.Begin NS392. Definition x := 0. NES.End NS392. NES.Begin NS393. Definition x := 0. NES.End NS393. NES.Begin NS394. Definition x := 0. NES.End NS394. NES.Begin NS395. Definition x := 0. NES.End NS395. NES.Begin NS396. Definition x := 0. NES.End NS396. NES.Begin NS397. Definition x := 0. NES.End NS397. NES.Begin NS398. Definition x := 0. NES.End NS398. NES.Begin NS399. Definition x := 0. NES.End NS399. NES.Begin NS400. Definition x := 0. NES.End NS400. NES.Begin NS401. Definition x := 0. NES.End NS401. NES.Begin NS402. Definition x := 0. NES.End NS402. NES.Begin NS403. Definition x := 0. NES.End NS403. NES.Begin NS404. Definition x := 0. NES.End NS404. NES.Begin NS405. Definition x := 0. NES.End NS405. NES.Begin NS406. Definition x := 0. NES.End NS406. NES.Begin NS407. Definition x := 0. NES.End NS407. NES.Begin NS408. Definition x := 0. NES.End NS408. NES.Begin NS409. Definition x := 0. NES.End NS409. NES.Begin NS410. Definition x := 0. NES.End NS410. NES.Begin NS411. Definition x := 0. NES.End NS411. NES.Begin NS412. Definition x := 0. NES.End NS412. NES.Begin NS413. Definition x := 0. NES.End NS413. NES.Begin NS414. Definition x := 0. NES.End NS414. NES.Begin NS415. Definition x := 0. NES.End NS415. NES.Begin NS416. Definition x := 0. NES.End NS416. NES.Begin NS417. Definition x := 0. NES.End NS417. NES.Begin NS418. Definition x := 0. NES.End NS418. NES.Begin NS419. Definition x := 0. NES.End NS419. NES.Begin NS420. Definition x := 0. NES.End NS420. NES.Begin NS421. Definition x := 0. NES.End NS421. NES.Begin NS422. Definition x := 0. NES.End NS422. NES.Begin NS423. Definition x := 0. NES.End NS423. NES.Begin NS424. Definition x := 0. NES.End NS424. NES.Begin NS425. Definition x := 0. NES.End NS425. NES.Begin NS426. Definition x := 0. NES.End NS426. NES.Begin NS427. Definition x := 0. NES.End NS427. NES.Begin NS428. Definition x := 0. NES.End NS428. NES.Begin NS429. Definition x := 0. NES.End NS429. NES.Begin NS430. Definition x := 0. NES.End NS430. NES.Begin NS431. Definition x := 0. NES.End NS431. NES.Begin NS432. Definition x := 0. NES.End NS432. NES.Begin NS433. Definition x := 0. NES.End NS433. NES.Begin NS434. Definition x := 0. NES.End NS434. NES.Begin NS435. Definition x := 0. NES.End NS435. NES.Begin NS436. Definition x := 0. NES.End NS436. NES.Begin NS437. Definition x := 0. NES.End NS437. NES.Begin NS438. Definition x := 0. NES.End NS438. NES.Begin NS439. Definition x := 0. NES.End NS439. NES.Begin NS440. Definition x := 0. NES.End NS440. NES.Begin NS441. Definition x := 0. NES.End NS441. NES.Begin NS442. Definition x := 0. NES.End NS442. NES.Begin NS443. Definition x := 0. NES.End NS443. NES.Begin NS444. Definition x := 0. NES.End NS444. NES.Begin NS445. Definition x := 0. NES.End NS445. NES.Begin NS446. Definition x := 0. NES.End NS446. NES.Begin NS447. Definition x := 0. NES.End NS447. NES.Begin NS448. Definition x := 0. NES.End NS448. NES.Begin NS449. Definition x := 0. NES.End NS449. NES.Begin NS450. Definition x := 0. NES.End NS450. NES.Begin NS451. Definition x := 0. NES.End NS451. NES.Begin NS452. Definition x := 0. NES.End NS452. NES.Begin NS453. Definition x := 0. NES.End NS453. NES.Begin NS454. Definition x := 0. NES.End NS454. NES.Begin NS455. Definition x := 0. NES.End NS455. NES.Begin NS456. Definition x := 0. NES.End NS456. NES.Begin NS457. Definition x := 0. NES.End NS457. NES.Begin NS458. Definition x := 0. NES.End NS458. NES.Begin NS459. Definition x := 0. NES.End NS459. NES.Begin NS460. Definition x := 0. NES.End NS460. NES.Begin NS461. Definition x := 0. NES.End NS461. NES.Begin NS462. Definition x := 0. NES.End NS462. NES.Begin NS463. Definition x := 0. NES.End NS463. NES.Begin NS464. Definition x := 0. NES.End NS464. NES.Begin NS465. Definition x := 0. NES.End NS465. NES.Begin NS466. Definition x := 0. NES.End NS466. NES.Begin NS467. Definition x := 0. NES.End NS467. NES.Begin NS468. Definition x := 0. NES.End NS468. NES.Begin NS469. Definition x := 0. NES.End NS469. NES.Begin NS470. Definition x := 0. NES.End NS470. NES.Begin NS471. Definition x := 0. NES.End NS471. NES.Begin NS472. Definition x := 0. NES.End NS472. NES.Begin NS473. Definition x := 0. NES.End NS473. NES.Begin NS474. Definition x := 0. NES.End NS474. NES.Begin NS475. Definition x := 0. NES.End NS475. NES.Begin NS476. Definition x := 0. NES.End NS476. NES.Begin NS477. Definition x := 0. NES.End NS477. NES.Begin NS478. Definition x := 0. NES.End NS478. NES.Begin NS479. Definition x := 0. NES.End NS479. NES.Begin NS480. Definition x := 0. NES.End NS480. NES.Begin NS481. Definition x := 0. NES.End NS481. NES.Begin NS482. Definition x := 0. NES.End NS482. NES.Begin NS483. Definition x := 0. NES.End NS483. NES.Begin NS484. Definition x := 0. NES.End NS484. NES.Begin NS485. Definition x := 0. NES.End NS485. NES.Begin NS486. Definition x := 0. NES.End NS486. NES.Begin NS487. Definition x := 0. NES.End NS487. NES.Begin NS488. Definition x := 0. NES.End NS488. NES.Begin NS489. Definition x := 0. NES.End NS489. NES.Begin NS490. Definition x := 0. NES.End NS490. NES.Begin NS491. Definition x := 0. NES.End NS491. NES.Begin NS492. Definition x := 0. NES.End NS492. NES.Begin NS493. Definition x := 0. NES.End NS493. NES.Begin NS494. Definition x := 0. NES.End NS494. NES.Begin NS495. Definition x := 0. NES.End NS495. NES.Begin NS496. Definition x := 0. NES.End NS496. NES.Begin NS497. Definition x := 0. NES.End NS497. NES.Begin NS498. Definition x := 0. NES.End NS498. NES.Begin NS499. Definition x := 0. NES.End NS499. NES.Begin NS500. Definition x := 0. NES.End NS500.LPCIC-coq-elpi-eb449d7/apps/NES/tests/test_NES_perf_optimal.v000066400000000000000000001210261523041753400236530ustar00rootroot00000000000000From elpi.apps Require Import NES. Module NS1. Module NS1. Definition x := 0. End NS1. End NS1. Export NS1. Module NS2. Module NS2. Definition x := 0. End NS2. End NS2. Export NS2. Module NS3. Module NS3. Definition x := 0. End NS3. End NS3. Export NS3. Module NS4. Module NS4. Definition x := 0. End NS4. End NS4. Export NS4. Module NS5. Module NS5. Definition x := 0. End NS5. End NS5. Export NS5. Module NS6. Module NS6. Definition x := 0. End NS6. End NS6. Export NS6. Module NS7. Module NS7. Definition x := 0. End NS7. End NS7. Export NS7. Module NS8. Module NS8. Definition x := 0. End NS8. End NS8. Export NS8. Module NS9. Module NS9. Definition x := 0. End NS9. End NS9. Export NS9. Module NS10. Module NS10. Definition x := 0. End NS10. End NS10. Export NS10. Module NS11. Module NS11. Definition x := 0. End NS11. End NS11. Export NS11. Module NS12. Module NS12. Definition x := 0. End NS12. End NS12. Export NS12. Module NS13. Module NS13. Definition x := 0. End NS13. End NS13. Export NS13. Module NS14. Module NS14. Definition x := 0. End NS14. End NS14. Export NS14. Module NS15. Module NS15. Definition x := 0. End NS15. End NS15. Export NS15. Module NS16. Module NS16. Definition x := 0. End NS16. End NS16. Export NS16. Module NS17. Module NS17. Definition x := 0. End NS17. End NS17. Export NS17. Module NS18. Module NS18. Definition x := 0. End NS18. End NS18. Export NS18. Module NS19. Module NS19. Definition x := 0. End NS19. End NS19. Export NS19. Module NS20. Module NS20. Definition x := 0. End NS20. End NS20. Export NS20. Module NS21. Module NS21. Definition x := 0. End NS21. End NS21. Export NS21. Module NS22. Module NS22. Definition x := 0. End NS22. End NS22. Export NS22. Module NS23. Module NS23. Definition x := 0. End NS23. End NS23. Export NS23. Module NS24. Module NS24. Definition x := 0. End NS24. End NS24. Export NS24. Module NS25. Module NS25. Definition x := 0. End NS25. End NS25. Export NS25. Module NS26. Module NS26. Definition x := 0. End NS26. End NS26. Export NS26. Module NS27. Module NS27. Definition x := 0. End NS27. End NS27. Export NS27. Module NS28. Module NS28. Definition x := 0. End NS28. End NS28. Export NS28. Module NS29. Module NS29. Definition x := 0. End NS29. End NS29. Export NS29. Module NS30. Module NS30. Definition x := 0. End NS30. End NS30. Export NS30. Module NS31. Module NS31. Definition x := 0. End NS31. End NS31. Export NS31. Module NS32. Module NS32. Definition x := 0. End NS32. End NS32. Export NS32. Module NS33. Module NS33. Definition x := 0. End NS33. End NS33. Export NS33. Module NS34. Module NS34. Definition x := 0. End NS34. End NS34. Export NS34. Module NS35. Module NS35. Definition x := 0. End NS35. End NS35. Export NS35. Module NS36. Module NS36. Definition x := 0. End NS36. End NS36. Export NS36. Module NS37. Module NS37. Definition x := 0. End NS37. End NS37. Export NS37. Module NS38. Module NS38. Definition x := 0. End NS38. End NS38. Export NS38. Module NS39. Module NS39. Definition x := 0. End NS39. End NS39. Export NS39. Module NS40. Module NS40. Definition x := 0. End NS40. End NS40. Export NS40. Module NS41. Module NS41. Definition x := 0. End NS41. End NS41. Export NS41. Module NS42. Module NS42. Definition x := 0. End NS42. End NS42. Export NS42. Module NS43. Module NS43. Definition x := 0. End NS43. End NS43. Export NS43. Module NS44. Module NS44. Definition x := 0. End NS44. End NS44. Export NS44. Module NS45. Module NS45. Definition x := 0. End NS45. End NS45. Export NS45. Module NS46. Module NS46. Definition x := 0. End NS46. End NS46. Export NS46. Module NS47. Module NS47. Definition x := 0. End NS47. End NS47. Export NS47. Module NS48. Module NS48. Definition x := 0. End NS48. End NS48. Export NS48. Module NS49. Module NS49. Definition x := 0. End NS49. End NS49. Export NS49. Module NS50. Module NS50. Definition x := 0. End NS50. End NS50. Export NS50. Module NS51. Module NS51. Definition x := 0. End NS51. End NS51. Export NS51. Module NS52. Module NS52. Definition x := 0. End NS52. End NS52. Export NS52. Module NS53. Module NS53. Definition x := 0. End NS53. End NS53. Export NS53. Module NS54. Module NS54. Definition x := 0. End NS54. End NS54. Export NS54. Module NS55. Module NS55. Definition x := 0. End NS55. End NS55. Export NS55. Module NS56. Module NS56. Definition x := 0. End NS56. End NS56. Export NS56. Module NS57. Module NS57. Definition x := 0. End NS57. End NS57. Export NS57. Module NS58. Module NS58. Definition x := 0. End NS58. End NS58. Export NS58. Module NS59. Module NS59. Definition x := 0. End NS59. End NS59. Export NS59. Module NS60. Module NS60. Definition x := 0. End NS60. End NS60. Export NS60. Module NS61. Module NS61. Definition x := 0. End NS61. End NS61. Export NS61. Module NS62. Module NS62. Definition x := 0. End NS62. End NS62. Export NS62. Module NS63. Module NS63. Definition x := 0. End NS63. End NS63. Export NS63. Module NS64. Module NS64. Definition x := 0. End NS64. End NS64. Export NS64. Module NS65. Module NS65. Definition x := 0. End NS65. End NS65. Export NS65. Module NS66. Module NS66. Definition x := 0. End NS66. End NS66. Export NS66. Module NS67. Module NS67. Definition x := 0. End NS67. End NS67. Export NS67. Module NS68. Module NS68. Definition x := 0. End NS68. End NS68. Export NS68. Module NS69. Module NS69. Definition x := 0. End NS69. End NS69. Export NS69. Module NS70. Module NS70. Definition x := 0. End NS70. End NS70. Export NS70. Module NS71. Module NS71. Definition x := 0. End NS71. End NS71. Export NS71. Module NS72. Module NS72. Definition x := 0. End NS72. End NS72. Export NS72. Module NS73. Module NS73. Definition x := 0. End NS73. End NS73. Export NS73. Module NS74. Module NS74. Definition x := 0. End NS74. End NS74. Export NS74. Module NS75. Module NS75. Definition x := 0. End NS75. End NS75. Export NS75. Module NS76. Module NS76. Definition x := 0. End NS76. End NS76. Export NS76. Module NS77. Module NS77. Definition x := 0. End NS77. End NS77. Export NS77. Module NS78. Module NS78. Definition x := 0. End NS78. End NS78. Export NS78. Module NS79. Module NS79. Definition x := 0. End NS79. End NS79. Export NS79. Module NS80. Module NS80. Definition x := 0. End NS80. End NS80. Export NS80. Module NS81. Module NS81. Definition x := 0. End NS81. End NS81. Export NS81. Module NS82. Module NS82. Definition x := 0. End NS82. End NS82. Export NS82. Module NS83. Module NS83. Definition x := 0. End NS83. End NS83. Export NS83. Module NS84. Module NS84. Definition x := 0. End NS84. End NS84. Export NS84. Module NS85. Module NS85. Definition x := 0. End NS85. End NS85. Export NS85. Module NS86. Module NS86. Definition x := 0. End NS86. End NS86. Export NS86. Module NS87. Module NS87. Definition x := 0. End NS87. End NS87. Export NS87. Module NS88. Module NS88. Definition x := 0. End NS88. End NS88. Export NS88. Module NS89. Module NS89. Definition x := 0. End NS89. End NS89. Export NS89. Module NS90. Module NS90. Definition x := 0. End NS90. End NS90. Export NS90. Module NS91. Module NS91. Definition x := 0. End NS91. End NS91. Export NS91. Module NS92. Module NS92. Definition x := 0. End NS92. End NS92. Export NS92. Module NS93. Module NS93. Definition x := 0. End NS93. End NS93. Export NS93. Module NS94. Module NS94. Definition x := 0. End NS94. End NS94. Export NS94. Module NS95. Module NS95. Definition x := 0. End NS95. End NS95. Export NS95. Module NS96. Module NS96. Definition x := 0. End NS96. End NS96. Export NS96. Module NS97. Module NS97. Definition x := 0. End NS97. End NS97. Export NS97. Module NS98. Module NS98. Definition x := 0. End NS98. End NS98. Export NS98. Module NS99. Module NS99. Definition x := 0. End NS99. End NS99. Export NS99. Module NS100. Module NS100. Definition x := 0. End NS100. End NS100. Export NS100. Module NS101. Module NS101. Definition x := 0. End NS101. End NS101. Export NS101. Module NS102. Module NS102. Definition x := 0. End NS102. End NS102. Export NS102. Module NS103. Module NS103. Definition x := 0. End NS103. End NS103. Export NS103. Module NS104. Module NS104. Definition x := 0. End NS104. End NS104. Export NS104. Module NS105. Module NS105. Definition x := 0. End NS105. End NS105. Export NS105. Module NS106. Module NS106. Definition x := 0. End NS106. End NS106. Export NS106. Module NS107. Module NS107. Definition x := 0. End NS107. End NS107. Export NS107. Module NS108. Module NS108. Definition x := 0. End NS108. End NS108. Export NS108. Module NS109. Module NS109. Definition x := 0. End NS109. End NS109. Export NS109. Module NS110. Module NS110. Definition x := 0. End NS110. End NS110. Export NS110. Module NS111. Module NS111. Definition x := 0. End NS111. End NS111. Export NS111. Module NS112. Module NS112. Definition x := 0. End NS112. End NS112. Export NS112. Module NS113. Module NS113. Definition x := 0. End NS113. End NS113. Export NS113. Module NS114. Module NS114. Definition x := 0. End NS114. End NS114. Export NS114. Module NS115. Module NS115. Definition x := 0. End NS115. End NS115. Export NS115. Module NS116. Module NS116. Definition x := 0. End NS116. End NS116. Export NS116. Module NS117. Module NS117. Definition x := 0. End NS117. End NS117. Export NS117. Module NS118. Module NS118. Definition x := 0. End NS118. End NS118. Export NS118. Module NS119. Module NS119. Definition x := 0. End NS119. End NS119. Export NS119. Module NS120. Module NS120. Definition x := 0. End NS120. End NS120. Export NS120. Module NS121. Module NS121. Definition x := 0. End NS121. End NS121. Export NS121. Module NS122. Module NS122. Definition x := 0. End NS122. End NS122. Export NS122. Module NS123. Module NS123. Definition x := 0. End NS123. End NS123. Export NS123. Module NS124. Module NS124. Definition x := 0. End NS124. End NS124. Export NS124. Module NS125. Module NS125. Definition x := 0. End NS125. End NS125. Export NS125. Module NS126. Module NS126. Definition x := 0. End NS126. End NS126. Export NS126. Module NS127. Module NS127. Definition x := 0. End NS127. End NS127. Export NS127. Module NS128. Module NS128. Definition x := 0. End NS128. End NS128. Export NS128. Module NS129. Module NS129. Definition x := 0. End NS129. End NS129. Export NS129. Module NS130. Module NS130. Definition x := 0. End NS130. End NS130. Export NS130. Module NS131. Module NS131. Definition x := 0. End NS131. End NS131. Export NS131. Module NS132. Module NS132. Definition x := 0. End NS132. End NS132. Export NS132. Module NS133. Module NS133. Definition x := 0. End NS133. End NS133. Export NS133. Module NS134. Module NS134. Definition x := 0. End NS134. End NS134. Export NS134. Module NS135. Module NS135. Definition x := 0. End NS135. End NS135. Export NS135. Module NS136. Module NS136. Definition x := 0. End NS136. End NS136. Export NS136. Module NS137. Module NS137. Definition x := 0. End NS137. End NS137. Export NS137. Module NS138. Module NS138. Definition x := 0. End NS138. End NS138. Export NS138. Module NS139. Module NS139. Definition x := 0. End NS139. End NS139. Export NS139. Module NS140. Module NS140. Definition x := 0. End NS140. End NS140. Export NS140. Module NS141. Module NS141. Definition x := 0. End NS141. End NS141. Export NS141. Module NS142. Module NS142. Definition x := 0. End NS142. End NS142. Export NS142. Module NS143. Module NS143. Definition x := 0. End NS143. End NS143. Export NS143. Module NS144. Module NS144. Definition x := 0. End NS144. End NS144. Export NS144. Module NS145. Module NS145. Definition x := 0. End NS145. End NS145. Export NS145. Module NS146. Module NS146. Definition x := 0. End NS146. End NS146. Export NS146. Module NS147. Module NS147. Definition x := 0. End NS147. End NS147. Export NS147. Module NS148. Module NS148. Definition x := 0. End NS148. End NS148. Export NS148. Module NS149. Module NS149. Definition x := 0. End NS149. End NS149. Export NS149. Module NS150. Module NS150. Definition x := 0. End NS150. End NS150. Export NS150. Module NS151. Module NS151. Definition x := 0. End NS151. End NS151. Export NS151. Module NS152. Module NS152. Definition x := 0. End NS152. End NS152. Export NS152. Module NS153. Module NS153. Definition x := 0. End NS153. End NS153. Export NS153. Module NS154. Module NS154. Definition x := 0. End NS154. End NS154. Export NS154. Module NS155. Module NS155. Definition x := 0. End NS155. End NS155. Export NS155. Module NS156. Module NS156. Definition x := 0. End NS156. End NS156. Export NS156. Module NS157. Module NS157. Definition x := 0. End NS157. End NS157. Export NS157. Module NS158. Module NS158. Definition x := 0. End NS158. End NS158. Export NS158. Module NS159. Module NS159. Definition x := 0. End NS159. End NS159. Export NS159. Module NS160. Module NS160. Definition x := 0. End NS160. End NS160. Export NS160. Module NS161. Module NS161. Definition x := 0. End NS161. End NS161. Export NS161. Module NS162. Module NS162. Definition x := 0. End NS162. End NS162. Export NS162. Module NS163. Module NS163. Definition x := 0. End NS163. End NS163. Export NS163. Module NS164. Module NS164. Definition x := 0. End NS164. End NS164. Export NS164. Module NS165. Module NS165. Definition x := 0. End NS165. End NS165. Export NS165. Module NS166. Module NS166. Definition x := 0. End NS166. End NS166. Export NS166. Module NS167. Module NS167. Definition x := 0. End NS167. End NS167. Export NS167. Module NS168. Module NS168. Definition x := 0. End NS168. End NS168. Export NS168. Module NS169. Module NS169. Definition x := 0. End NS169. End NS169. Export NS169. Module NS170. Module NS170. Definition x := 0. End NS170. End NS170. Export NS170. Module NS171. Module NS171. Definition x := 0. End NS171. End NS171. Export NS171. Module NS172. Module NS172. Definition x := 0. End NS172. End NS172. Export NS172. Module NS173. Module NS173. Definition x := 0. End NS173. End NS173. Export NS173. Module NS174. Module NS174. Definition x := 0. End NS174. End NS174. Export NS174. Module NS175. Module NS175. Definition x := 0. End NS175. End NS175. Export NS175. Module NS176. Module NS176. Definition x := 0. End NS176. End NS176. Export NS176. Module NS177. Module NS177. Definition x := 0. End NS177. End NS177. Export NS177. Module NS178. Module NS178. Definition x := 0. End NS178. End NS178. Export NS178. Module NS179. Module NS179. Definition x := 0. End NS179. End NS179. Export NS179. Module NS180. Module NS180. Definition x := 0. End NS180. End NS180. Export NS180. Module NS181. Module NS181. Definition x := 0. End NS181. End NS181. Export NS181. Module NS182. Module NS182. Definition x := 0. End NS182. End NS182. Export NS182. Module NS183. Module NS183. Definition x := 0. End NS183. End NS183. Export NS183. Module NS184. Module NS184. Definition x := 0. End NS184. End NS184. Export NS184. Module NS185. Module NS185. Definition x := 0. End NS185. End NS185. Export NS185. Module NS186. Module NS186. Definition x := 0. End NS186. End NS186. Export NS186. Module NS187. Module NS187. Definition x := 0. End NS187. End NS187. Export NS187. Module NS188. Module NS188. Definition x := 0. End NS188. End NS188. Export NS188. Module NS189. Module NS189. Definition x := 0. End NS189. End NS189. Export NS189. Module NS190. Module NS190. Definition x := 0. End NS190. End NS190. Export NS190. Module NS191. Module NS191. Definition x := 0. End NS191. End NS191. Export NS191. Module NS192. Module NS192. Definition x := 0. End NS192. End NS192. Export NS192. Module NS193. Module NS193. Definition x := 0. End NS193. End NS193. Export NS193. Module NS194. Module NS194. Definition x := 0. End NS194. End NS194. Export NS194. Module NS195. Module NS195. Definition x := 0. End NS195. End NS195. Export NS195. Module NS196. Module NS196. Definition x := 0. End NS196. End NS196. Export NS196. Module NS197. Module NS197. Definition x := 0. End NS197. End NS197. Export NS197. Module NS198. Module NS198. Definition x := 0. End NS198. End NS198. Export NS198. Module NS199. Module NS199. Definition x := 0. End NS199. End NS199. Export NS199. Module NS200. Module NS200. Definition x := 0. End NS200. End NS200. Export NS200. Module NS201. Module NS201. Definition x := 0. End NS201. End NS201. Export NS201. Module NS202. Module NS202. Definition x := 0. End NS202. End NS202. Export NS202. Module NS203. Module NS203. Definition x := 0. End NS203. End NS203. Export NS203. Module NS204. Module NS204. Definition x := 0. End NS204. End NS204. Export NS204. Module NS205. Module NS205. Definition x := 0. End NS205. End NS205. Export NS205. Module NS206. Module NS206. Definition x := 0. End NS206. End NS206. Export NS206. Module NS207. Module NS207. Definition x := 0. End NS207. End NS207. Export NS207. Module NS208. Module NS208. Definition x := 0. End NS208. End NS208. Export NS208. Module NS209. Module NS209. Definition x := 0. End NS209. End NS209. Export NS209. Module NS210. Module NS210. Definition x := 0. End NS210. End NS210. Export NS210. Module NS211. Module NS211. Definition x := 0. End NS211. End NS211. Export NS211. Module NS212. Module NS212. Definition x := 0. End NS212. End NS212. Export NS212. Module NS213. Module NS213. Definition x := 0. End NS213. End NS213. Export NS213. Module NS214. Module NS214. Definition x := 0. End NS214. End NS214. Export NS214. Module NS215. Module NS215. Definition x := 0. End NS215. End NS215. Export NS215. Module NS216. Module NS216. Definition x := 0. End NS216. End NS216. Export NS216. Module NS217. Module NS217. Definition x := 0. End NS217. End NS217. Export NS217. Module NS218. Module NS218. Definition x := 0. End NS218. End NS218. Export NS218. Module NS219. Module NS219. Definition x := 0. End NS219. End NS219. Export NS219. Module NS220. Module NS220. Definition x := 0. End NS220. End NS220. Export NS220. Module NS221. Module NS221. Definition x := 0. End NS221. End NS221. Export NS221. Module NS222. Module NS222. Definition x := 0. End NS222. End NS222. Export NS222. Module NS223. Module NS223. Definition x := 0. End NS223. End NS223. Export NS223. Module NS224. Module NS224. Definition x := 0. End NS224. End NS224. Export NS224. Module NS225. Module NS225. Definition x := 0. End NS225. End NS225. Export NS225. Module NS226. Module NS226. Definition x := 0. End NS226. End NS226. Export NS226. Module NS227. Module NS227. Definition x := 0. End NS227. End NS227. Export NS227. Module NS228. Module NS228. Definition x := 0. End NS228. End NS228. Export NS228. Module NS229. Module NS229. Definition x := 0. End NS229. End NS229. Export NS229. Module NS230. Module NS230. Definition x := 0. End NS230. End NS230. Export NS230. Module NS231. Module NS231. Definition x := 0. End NS231. End NS231. Export NS231. Module NS232. Module NS232. Definition x := 0. End NS232. End NS232. Export NS232. Module NS233. Module NS233. Definition x := 0. End NS233. End NS233. Export NS233. Module NS234. Module NS234. Definition x := 0. End NS234. End NS234. Export NS234. Module NS235. Module NS235. Definition x := 0. End NS235. End NS235. Export NS235. Module NS236. Module NS236. Definition x := 0. End NS236. End NS236. Export NS236. Module NS237. Module NS237. Definition x := 0. End NS237. End NS237. Export NS237. Module NS238. Module NS238. Definition x := 0. End NS238. End NS238. Export NS238. Module NS239. Module NS239. Definition x := 0. End NS239. End NS239. Export NS239. Module NS240. Module NS240. Definition x := 0. End NS240. End NS240. Export NS240. Module NS241. Module NS241. Definition x := 0. End NS241. End NS241. Export NS241. Module NS242. Module NS242. Definition x := 0. End NS242. End NS242. Export NS242. Module NS243. Module NS243. Definition x := 0. End NS243. End NS243. Export NS243. Module NS244. Module NS244. Definition x := 0. End NS244. End NS244. Export NS244. Module NS245. Module NS245. Definition x := 0. End NS245. End NS245. Export NS245. Module NS246. Module NS246. Definition x := 0. End NS246. End NS246. Export NS246. Module NS247. Module NS247. Definition x := 0. End NS247. End NS247. Export NS247. Module NS248. Module NS248. Definition x := 0. End NS248. End NS248. Export NS248. Module NS249. Module NS249. Definition x := 0. End NS249. End NS249. Export NS249. Module NS250. Module NS250. Definition x := 0. End NS250. End NS250. Export NS250. Module NS251. Module NS251. Definition x := 0. End NS251. End NS251. Export NS251. Module NS252. Module NS252. Definition x := 0. End NS252. End NS252. Export NS252. Module NS253. Module NS253. Definition x := 0. End NS253. End NS253. Export NS253. Module NS254. Module NS254. Definition x := 0. End NS254. End NS254. Export NS254. Module NS255. Module NS255. Definition x := 0. End NS255. End NS255. Export NS255. Module NS256. Module NS256. Definition x := 0. End NS256. End NS256. Export NS256. Module NS257. Module NS257. Definition x := 0. End NS257. End NS257. Export NS257. Module NS258. Module NS258. Definition x := 0. End NS258. End NS258. Export NS258. Module NS259. Module NS259. Definition x := 0. End NS259. End NS259. Export NS259. Module NS260. Module NS260. Definition x := 0. End NS260. End NS260. Export NS260. Module NS261. Module NS261. Definition x := 0. End NS261. End NS261. Export NS261. Module NS262. Module NS262. Definition x := 0. End NS262. End NS262. Export NS262. Module NS263. Module NS263. Definition x := 0. End NS263. End NS263. Export NS263. Module NS264. Module NS264. Definition x := 0. End NS264. End NS264. Export NS264. Module NS265. Module NS265. Definition x := 0. End NS265. End NS265. Export NS265. Module NS266. Module NS266. Definition x := 0. End NS266. End NS266. Export NS266. Module NS267. Module NS267. Definition x := 0. End NS267. End NS267. Export NS267. Module NS268. Module NS268. Definition x := 0. End NS268. End NS268. Export NS268. Module NS269. Module NS269. Definition x := 0. End NS269. End NS269. Export NS269. Module NS270. Module NS270. Definition x := 0. End NS270. End NS270. Export NS270. Module NS271. Module NS271. Definition x := 0. End NS271. End NS271. Export NS271. Module NS272. Module NS272. Definition x := 0. End NS272. End NS272. Export NS272. Module NS273. Module NS273. Definition x := 0. End NS273. End NS273. Export NS273. Module NS274. Module NS274. Definition x := 0. End NS274. End NS274. Export NS274. Module NS275. Module NS275. Definition x := 0. End NS275. End NS275. Export NS275. Module NS276. Module NS276. Definition x := 0. End NS276. End NS276. Export NS276. Module NS277. Module NS277. Definition x := 0. End NS277. End NS277. Export NS277. Module NS278. Module NS278. Definition x := 0. End NS278. End NS278. Export NS278. Module NS279. Module NS279. Definition x := 0. End NS279. End NS279. Export NS279. Module NS280. Module NS280. Definition x := 0. End NS280. End NS280. Export NS280. Module NS281. Module NS281. Definition x := 0. End NS281. End NS281. Export NS281. Module NS282. Module NS282. Definition x := 0. End NS282. End NS282. Export NS282. Module NS283. Module NS283. Definition x := 0. End NS283. End NS283. Export NS283. Module NS284. Module NS284. Definition x := 0. End NS284. End NS284. Export NS284. Module NS285. Module NS285. Definition x := 0. End NS285. End NS285. Export NS285. Module NS286. Module NS286. Definition x := 0. End NS286. End NS286. Export NS286. Module NS287. Module NS287. Definition x := 0. End NS287. End NS287. Export NS287. Module NS288. Module NS288. Definition x := 0. End NS288. End NS288. Export NS288. Module NS289. Module NS289. Definition x := 0. End NS289. End NS289. Export NS289. Module NS290. Module NS290. Definition x := 0. End NS290. End NS290. Export NS290. Module NS291. Module NS291. Definition x := 0. End NS291. End NS291. Export NS291. Module NS292. Module NS292. Definition x := 0. End NS292. End NS292. Export NS292. Module NS293. Module NS293. Definition x := 0. End NS293. End NS293. Export NS293. Module NS294. Module NS294. Definition x := 0. End NS294. End NS294. Export NS294. Module NS295. Module NS295. Definition x := 0. End NS295. End NS295. Export NS295. Module NS296. Module NS296. Definition x := 0. End NS296. End NS296. Export NS296. Module NS297. Module NS297. Definition x := 0. End NS297. End NS297. Export NS297. Module NS298. Module NS298. Definition x := 0. End NS298. End NS298. Export NS298. Module NS299. Module NS299. Definition x := 0. End NS299. End NS299. Export NS299. Module NS300. Module NS300. Definition x := 0. End NS300. End NS300. Export NS300. Module NS301. Module NS301. Definition x := 0. End NS301. End NS301. Export NS301. Module NS302. Module NS302. Definition x := 0. End NS302. End NS302. Export NS302. Module NS303. Module NS303. Definition x := 0. End NS303. End NS303. Export NS303. Module NS304. Module NS304. Definition x := 0. End NS304. End NS304. Export NS304. Module NS305. Module NS305. Definition x := 0. End NS305. End NS305. Export NS305. Module NS306. Module NS306. Definition x := 0. End NS306. End NS306. Export NS306. Module NS307. Module NS307. Definition x := 0. End NS307. End NS307. Export NS307. Module NS308. Module NS308. Definition x := 0. End NS308. End NS308. Export NS308. Module NS309. Module NS309. Definition x := 0. End NS309. End NS309. Export NS309. Module NS310. Module NS310. Definition x := 0. End NS310. End NS310. Export NS310. Module NS311. Module NS311. Definition x := 0. End NS311. End NS311. Export NS311. Module NS312. Module NS312. Definition x := 0. End NS312. End NS312. Export NS312. Module NS313. Module NS313. Definition x := 0. End NS313. End NS313. Export NS313. Module NS314. Module NS314. Definition x := 0. End NS314. End NS314. Export NS314. Module NS315. Module NS315. Definition x := 0. End NS315. End NS315. Export NS315. Module NS316. Module NS316. Definition x := 0. End NS316. End NS316. Export NS316. Module NS317. Module NS317. Definition x := 0. End NS317. End NS317. Export NS317. Module NS318. Module NS318. Definition x := 0. End NS318. End NS318. Export NS318. Module NS319. Module NS319. Definition x := 0. End NS319. End NS319. Export NS319. Module NS320. Module NS320. Definition x := 0. End NS320. End NS320. Export NS320. Module NS321. Module NS321. Definition x := 0. End NS321. End NS321. Export NS321. Module NS322. Module NS322. Definition x := 0. End NS322. End NS322. Export NS322. Module NS323. Module NS323. Definition x := 0. End NS323. End NS323. Export NS323. Module NS324. Module NS324. Definition x := 0. End NS324. End NS324. Export NS324. Module NS325. Module NS325. Definition x := 0. End NS325. End NS325. Export NS325. Module NS326. Module NS326. Definition x := 0. End NS326. End NS326. Export NS326. Module NS327. Module NS327. Definition x := 0. End NS327. End NS327. Export NS327. Module NS328. Module NS328. Definition x := 0. End NS328. End NS328. Export NS328. Module NS329. Module NS329. Definition x := 0. End NS329. End NS329. Export NS329. Module NS330. Module NS330. Definition x := 0. End NS330. End NS330. Export NS330. Module NS331. Module NS331. Definition x := 0. End NS331. End NS331. Export NS331. Module NS332. Module NS332. Definition x := 0. End NS332. End NS332. Export NS332. Module NS333. Module NS333. Definition x := 0. End NS333. End NS333. Export NS333. Module NS334. Module NS334. Definition x := 0. End NS334. End NS334. Export NS334. Module NS335. Module NS335. Definition x := 0. End NS335. End NS335. Export NS335. Module NS336. Module NS336. Definition x := 0. End NS336. End NS336. Export NS336. Module NS337. Module NS337. Definition x := 0. End NS337. End NS337. Export NS337. Module NS338. Module NS338. Definition x := 0. End NS338. End NS338. Export NS338. Module NS339. Module NS339. Definition x := 0. End NS339. End NS339. Export NS339. Module NS340. Module NS340. Definition x := 0. End NS340. End NS340. Export NS340. Module NS341. Module NS341. Definition x := 0. End NS341. End NS341. Export NS341. Module NS342. Module NS342. Definition x := 0. End NS342. End NS342. Export NS342. Module NS343. Module NS343. Definition x := 0. End NS343. End NS343. Export NS343. Module NS344. Module NS344. Definition x := 0. End NS344. End NS344. Export NS344. Module NS345. Module NS345. Definition x := 0. End NS345. End NS345. Export NS345. Module NS346. Module NS346. Definition x := 0. End NS346. End NS346. Export NS346. Module NS347. Module NS347. Definition x := 0. End NS347. End NS347. Export NS347. Module NS348. Module NS348. Definition x := 0. End NS348. End NS348. Export NS348. Module NS349. Module NS349. Definition x := 0. End NS349. End NS349. Export NS349. Module NS350. Module NS350. Definition x := 0. End NS350. End NS350. Export NS350. Module NS351. Module NS351. Definition x := 0. End NS351. End NS351. Export NS351. Module NS352. Module NS352. Definition x := 0. End NS352. End NS352. Export NS352. Module NS353. Module NS353. Definition x := 0. End NS353. End NS353. Export NS353. Module NS354. Module NS354. Definition x := 0. End NS354. End NS354. Export NS354. Module NS355. Module NS355. Definition x := 0. End NS355. End NS355. Export NS355. Module NS356. Module NS356. Definition x := 0. End NS356. End NS356. Export NS356. Module NS357. Module NS357. Definition x := 0. End NS357. End NS357. Export NS357. Module NS358. Module NS358. Definition x := 0. End NS358. End NS358. Export NS358. Module NS359. Module NS359. Definition x := 0. End NS359. End NS359. Export NS359. Module NS360. Module NS360. Definition x := 0. End NS360. End NS360. Export NS360. Module NS361. Module NS361. Definition x := 0. End NS361. End NS361. Export NS361. Module NS362. Module NS362. Definition x := 0. End NS362. End NS362. Export NS362. Module NS363. Module NS363. Definition x := 0. End NS363. End NS363. Export NS363. Module NS364. Module NS364. Definition x := 0. End NS364. End NS364. Export NS364. Module NS365. Module NS365. Definition x := 0. End NS365. End NS365. Export NS365. Module NS366. Module NS366. Definition x := 0. End NS366. End NS366. Export NS366. Module NS367. Module NS367. Definition x := 0. End NS367. End NS367. Export NS367. Module NS368. Module NS368. Definition x := 0. End NS368. End NS368. Export NS368. Module NS369. Module NS369. Definition x := 0. End NS369. End NS369. Export NS369. Module NS370. Module NS370. Definition x := 0. End NS370. End NS370. Export NS370. Module NS371. Module NS371. Definition x := 0. End NS371. End NS371. Export NS371. Module NS372. Module NS372. Definition x := 0. End NS372. End NS372. Export NS372. Module NS373. Module NS373. Definition x := 0. End NS373. End NS373. Export NS373. Module NS374. Module NS374. Definition x := 0. End NS374. End NS374. Export NS374. Module NS375. Module NS375. Definition x := 0. End NS375. End NS375. Export NS375. Module NS376. Module NS376. Definition x := 0. End NS376. End NS376. Export NS376. Module NS377. Module NS377. Definition x := 0. End NS377. End NS377. Export NS377. Module NS378. Module NS378. Definition x := 0. End NS378. End NS378. Export NS378. Module NS379. Module NS379. Definition x := 0. End NS379. End NS379. Export NS379. Module NS380. Module NS380. Definition x := 0. End NS380. End NS380. Export NS380. Module NS381. Module NS381. Definition x := 0. End NS381. End NS381. Export NS381. Module NS382. Module NS382. Definition x := 0. End NS382. End NS382. Export NS382. Module NS383. Module NS383. Definition x := 0. End NS383. End NS383. Export NS383. Module NS384. Module NS384. Definition x := 0. End NS384. End NS384. Export NS384. Module NS385. Module NS385. Definition x := 0. End NS385. End NS385. Export NS385. Module NS386. Module NS386. Definition x := 0. End NS386. End NS386. Export NS386. Module NS387. Module NS387. Definition x := 0. End NS387. End NS387. Export NS387. Module NS388. Module NS388. Definition x := 0. End NS388. End NS388. Export NS388. Module NS389. Module NS389. Definition x := 0. End NS389. End NS389. Export NS389. Module NS390. Module NS390. Definition x := 0. End NS390. End NS390. Export NS390. Module NS391. Module NS391. Definition x := 0. End NS391. End NS391. Export NS391. Module NS392. Module NS392. Definition x := 0. End NS392. End NS392. Export NS392. Module NS393. Module NS393. Definition x := 0. End NS393. End NS393. Export NS393. Module NS394. Module NS394. Definition x := 0. End NS394. End NS394. Export NS394. Module NS395. Module NS395. Definition x := 0. End NS395. End NS395. Export NS395. Module NS396. Module NS396. Definition x := 0. End NS396. End NS396. Export NS396. Module NS397. Module NS397. Definition x := 0. End NS397. End NS397. Export NS397. Module NS398. Module NS398. Definition x := 0. End NS398. End NS398. Export NS398. Module NS399. Module NS399. Definition x := 0. End NS399. End NS399. Export NS399. Module NS400. Module NS400. Definition x := 0. End NS400. End NS400. Export NS400. Module NS401. Module NS401. Definition x := 0. End NS401. End NS401. Export NS401. Module NS402. Module NS402. Definition x := 0. End NS402. End NS402. Export NS402. Module NS403. Module NS403. Definition x := 0. End NS403. End NS403. Export NS403. Module NS404. Module NS404. Definition x := 0. End NS404. End NS404. Export NS404. Module NS405. Module NS405. Definition x := 0. End NS405. End NS405. Export NS405. Module NS406. Module NS406. Definition x := 0. End NS406. End NS406. Export NS406. Module NS407. Module NS407. Definition x := 0. End NS407. End NS407. Export NS407. Module NS408. Module NS408. Definition x := 0. End NS408. End NS408. Export NS408. Module NS409. Module NS409. Definition x := 0. End NS409. End NS409. Export NS409. Module NS410. Module NS410. Definition x := 0. End NS410. End NS410. Export NS410. Module NS411. Module NS411. Definition x := 0. End NS411. End NS411. Export NS411. Module NS412. Module NS412. Definition x := 0. End NS412. End NS412. Export NS412. Module NS413. Module NS413. Definition x := 0. End NS413. End NS413. Export NS413. Module NS414. Module NS414. Definition x := 0. End NS414. End NS414. Export NS414. Module NS415. Module NS415. Definition x := 0. End NS415. End NS415. Export NS415. Module NS416. Module NS416. Definition x := 0. End NS416. End NS416. Export NS416. Module NS417. Module NS417. Definition x := 0. End NS417. End NS417. Export NS417. Module NS418. Module NS418. Definition x := 0. End NS418. End NS418. Export NS418. Module NS419. Module NS419. Definition x := 0. End NS419. End NS419. Export NS419. Module NS420. Module NS420. Definition x := 0. End NS420. End NS420. Export NS420. Module NS421. Module NS421. Definition x := 0. End NS421. End NS421. Export NS421. Module NS422. Module NS422. Definition x := 0. End NS422. End NS422. Export NS422. Module NS423. Module NS423. Definition x := 0. End NS423. End NS423. Export NS423. Module NS424. Module NS424. Definition x := 0. End NS424. End NS424. Export NS424. Module NS425. Module NS425. Definition x := 0. End NS425. End NS425. Export NS425. Module NS426. Module NS426. Definition x := 0. End NS426. End NS426. Export NS426. Module NS427. Module NS427. Definition x := 0. End NS427. End NS427. Export NS427. Module NS428. Module NS428. Definition x := 0. End NS428. End NS428. Export NS428. Module NS429. Module NS429. Definition x := 0. End NS429. End NS429. Export NS429. Module NS430. Module NS430. Definition x := 0. End NS430. End NS430. Export NS430. Module NS431. Module NS431. Definition x := 0. End NS431. End NS431. Export NS431. Module NS432. Module NS432. Definition x := 0. End NS432. End NS432. Export NS432. Module NS433. Module NS433. Definition x := 0. End NS433. End NS433. Export NS433. Module NS434. Module NS434. Definition x := 0. End NS434. End NS434. Export NS434. Module NS435. Module NS435. Definition x := 0. End NS435. End NS435. Export NS435. Module NS436. Module NS436. Definition x := 0. End NS436. End NS436. Export NS436. Module NS437. Module NS437. Definition x := 0. End NS437. End NS437. Export NS437. Module NS438. Module NS438. Definition x := 0. End NS438. End NS438. Export NS438. Module NS439. Module NS439. Definition x := 0. End NS439. End NS439. Export NS439. Module NS440. Module NS440. Definition x := 0. End NS440. End NS440. Export NS440. Module NS441. Module NS441. Definition x := 0. End NS441. End NS441. Export NS441. Module NS442. Module NS442. Definition x := 0. End NS442. End NS442. Export NS442. Module NS443. Module NS443. Definition x := 0. End NS443. End NS443. Export NS443. Module NS444. Module NS444. Definition x := 0. End NS444. End NS444. Export NS444. Module NS445. Module NS445. Definition x := 0. End NS445. End NS445. Export NS445. Module NS446. Module NS446. Definition x := 0. End NS446. End NS446. Export NS446. Module NS447. Module NS447. Definition x := 0. End NS447. End NS447. Export NS447. Module NS448. Module NS448. Definition x := 0. End NS448. End NS448. Export NS448. Module NS449. Module NS449. Definition x := 0. End NS449. End NS449. Export NS449. Module NS450. Module NS450. Definition x := 0. End NS450. End NS450. Export NS450. Module NS451. Module NS451. Definition x := 0. End NS451. End NS451. Export NS451. Module NS452. Module NS452. Definition x := 0. End NS452. End NS452. Export NS452. Module NS453. Module NS453. Definition x := 0. End NS453. End NS453. Export NS453. Module NS454. Module NS454. Definition x := 0. End NS454. End NS454. Export NS454. Module NS455. Module NS455. Definition x := 0. End NS455. End NS455. Export NS455. Module NS456. Module NS456. Definition x := 0. End NS456. End NS456. Export NS456. Module NS457. Module NS457. Definition x := 0. End NS457. End NS457. Export NS457. Module NS458. Module NS458. Definition x := 0. End NS458. End NS458. Export NS458. Module NS459. Module NS459. Definition x := 0. End NS459. End NS459. Export NS459. Module NS460. Module NS460. Definition x := 0. End NS460. End NS460. Export NS460. Module NS461. Module NS461. Definition x := 0. End NS461. End NS461. Export NS461. Module NS462. Module NS462. Definition x := 0. End NS462. End NS462. Export NS462. Module NS463. Module NS463. Definition x := 0. End NS463. End NS463. Export NS463. Module NS464. Module NS464. Definition x := 0. End NS464. End NS464. Export NS464. Module NS465. Module NS465. Definition x := 0. End NS465. End NS465. Export NS465. Module NS466. Module NS466. Definition x := 0. End NS466. End NS466. Export NS466. Module NS467. Module NS467. Definition x := 0. End NS467. End NS467. Export NS467. Module NS468. Module NS468. Definition x := 0. End NS468. End NS468. Export NS468. Module NS469. Module NS469. Definition x := 0. End NS469. End NS469. Export NS469. Module NS470. Module NS470. Definition x := 0. End NS470. End NS470. Export NS470. Module NS471. Module NS471. Definition x := 0. End NS471. End NS471. Export NS471. Module NS472. Module NS472. Definition x := 0. End NS472. End NS472. Export NS472. Module NS473. Module NS473. Definition x := 0. End NS473. End NS473. Export NS473. Module NS474. Module NS474. Definition x := 0. End NS474. End NS474. Export NS474. Module NS475. Module NS475. Definition x := 0. End NS475. End NS475. Export NS475. Module NS476. Module NS476. Definition x := 0. End NS476. End NS476. Export NS476. Module NS477. Module NS477. Definition x := 0. End NS477. End NS477. Export NS477. Module NS478. Module NS478. Definition x := 0. End NS478. End NS478. Export NS478. Module NS479. Module NS479. Definition x := 0. End NS479. End NS479. Export NS479. Module NS480. Module NS480. Definition x := 0. End NS480. End NS480. Export NS480. Module NS481. Module NS481. Definition x := 0. End NS481. End NS481. Export NS481. Module NS482. Module NS482. Definition x := 0. End NS482. End NS482. Export NS482. Module NS483. Module NS483. Definition x := 0. End NS483. End NS483. Export NS483. Module NS484. Module NS484. Definition x := 0. End NS484. End NS484. Export NS484. Module NS485. Module NS485. Definition x := 0. End NS485. End NS485. Export NS485. Module NS486. Module NS486. Definition x := 0. End NS486. End NS486. Export NS486. Module NS487. Module NS487. Definition x := 0. End NS487. End NS487. Export NS487. Module NS488. Module NS488. Definition x := 0. End NS488. End NS488. Export NS488. Module NS489. Module NS489. Definition x := 0. End NS489. End NS489. Export NS489. Module NS490. Module NS490. Definition x := 0. End NS490. End NS490. Export NS490. Module NS491. Module NS491. Definition x := 0. End NS491. End NS491. Export NS491. Module NS492. Module NS492. Definition x := 0. End NS492. End NS492. Export NS492. Module NS493. Module NS493. Definition x := 0. End NS493. End NS493. Export NS493. Module NS494. Module NS494. Definition x := 0. End NS494. End NS494. Export NS494. Module NS495. Module NS495. Definition x := 0. End NS495. End NS495. Export NS495. Module NS496. Module NS496. Definition x := 0. End NS496. End NS496. Export NS496. Module NS497. Module NS497. Definition x := 0. End NS497. End NS497. Export NS497. Module NS498. Module NS498. Definition x := 0. End NS498. End NS498. Export NS498. Module NS499. Module NS499. Definition x := 0. End NS499. End NS499. Export NS499. Module NS500. Module NS500. Definition x := 0. End NS500. End NS500. Export NS500.LPCIC-coq-elpi-eb449d7/apps/NES/tests/test_NES_resolve.v000066400000000000000000000011351523041753400226470ustar00rootroot00000000000000From elpi.apps Require Import NES. NES.Begin A. Definition cats := 3. NES.End A. NES.Begin B. Definition dogs := 4. NES.End B. NES.Begin C. NES.Begin A. Definition bunnies := 42. NES.End A. Section more_bunnies. NES.Open A. Definition more_bunnies := bunnies. End more_bunnies. Section more_cats. NES.Open _.A. Definition more_cats := cats. End more_cats. Section more_dogs. NES.Open B. Definition more_dogs := dogs. End more_dogs. Section even_more_dogs. NES.Open _.B. Definition even_more_dogs := dogs. End even_more_dogs. NES.End C. LPCIC-coq-elpi-eb449d7/apps/NES/tests/test_module_namespace.v000066400000000000000000000001371523041753400237650ustar00rootroot00000000000000From elpi.apps Require Import NES. Module MyModule. End MyModule. Succeed NES.Begin MyModule. LPCIC-coq-elpi-eb449d7/apps/NES/theories/000077500000000000000000000000001523041753400177155ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/NES/theories/NES.v000066400000000000000000000062631523041753400205400ustar00rootroot00000000000000From elpi.apps.NES.elpi Extra Dependency "nes_synterp.elpi" as nes_synterp. From elpi.apps.NES.elpi Extra Dependency "nes_interp.elpi" as nes_interp. From elpi Require Import elpi. #[phase="both"] Elpi Db NES.db lp:{{ typeabbrev path (list string). :index (2) pred ns o:list string, o:modpath. }}. #[synterp] Elpi Accumulate NES.db lp:{{ pred open-ns o:string, o:list string. :name "open-ns:begin" open-ns _ _ :- fail. }}. Elpi Command NES.Status. #[synterp] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[synterp] Elpi Accumulate lp:{{ main _ :- coq.say "NES: current namespace" {nes.current-path}, std.findall (ns Y_ Z_) NS, coq.say "NES: registered namespaces" NS. }}. Elpi Export NES.Status. Elpi Command NES.Begin. #[phase="both"] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[interp] Elpi Accumulate File nes_interp. #[synterp] Elpi Accumulate lp:{{ main [str NS] :- !, nes.begin-path {nes.string->non-empty-ns NS} _. main _ :- coq.error "usage: NES.Begin ". }}. #[interp] Elpi Accumulate lp:{{ main _ :- nes.begin-path. }}. Elpi Export NES.Begin. Elpi Command NES.End. #[phase="both"] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[interp] Elpi Accumulate File nes_interp. #[synterp] Elpi Accumulate lp:{{ main [str NS] :- nes.end-path {nes.string->non-empty-ns NS} _. main _ :- coq.error "usage: NES.End ". }}. #[interp] Elpi Accumulate lp:{{ main _ :- nes.end-path. }}. Elpi Export NES.End. Elpi Command NES.Open. #[phase="both"] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[interp] Elpi Accumulate File nes_interp. #[synterp] Elpi Accumulate lp:{{ main [str NS] :- nes.open-path {nes.resolve NS}. main _ :- coq.error "usage: NES.Open ". }}. #[interp] Elpi Accumulate lp:{{ main _ :- nes.open-path. }}. Elpi Export NES.Open. (* List the contents a namespace *) Elpi Command NES.List. #[phase="both"] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[interp] Elpi Accumulate File nes_interp. #[synterp] Elpi Accumulate lp:{{ main-synterp [str NS] (pr DB Path) :- nes.resolve NS Path, std.findall (ns O_ P_) DB. }}. #[interp] Elpi Accumulate lp:{{ pred pp-gref i:gref, o:coq.pp. pp-gref GR PP :- coq.term->pp (global GR) PP. main-interp [str _] (pr DB Path) :- DB => nes.print-path Path pp-gref. main _ :- coq.error "usage: NES.List ". }}. Elpi Export NES.List. (* NES.List with types *) Elpi Command NES.Print. #[phase="both"] Elpi Accumulate Db NES.db. #[synterp] Elpi Accumulate File nes_synterp. #[interp] Elpi Accumulate File nes_interp. #[synterp] Elpi Accumulate lp:{{ main-synterp [str NS] (pr DB Path) :- nes.resolve NS Path, std.findall (ns O_ P_) DB. }}. Elpi Accumulate lp:{{ pred pp-gref i:gref, o:coq.pp. pp-gref GR PP :- std.do! [ coq.env.typeof GR Ty, PP = coq.pp.box (coq.pp.hov 2) [ {coq.term->pp (global GR)}, coq.pp.str " :", coq.pp.spc, {coq.term->pp Ty}, ], ]. main-interp [str _] (pr DB Path) :- DB => nes.print-path Path pp-gref. main _ :- coq.error "usage: NES.Print ". }}. Elpi Export NES.Print. LPCIC-coq-elpi-eb449d7/apps/NES/theories/dune000066400000000000000000000001711523041753400205720ustar00rootroot00000000000000(coq.theory (name elpi.apps.NES) (package rocq-elpi) (theories elpi elpi.apps.NES.elpi)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/README.md000066400000000000000000000010531523041753400167240ustar00rootroot00000000000000## Applications written in Rocq-Elpi ### Derive Given an inductive type declaration it synthesizes a bunch of useful stuff such as proved equality tests, projections, parametricity relations. ### Eltac A toy set of tactics implemented in Elpi. ### NES A Namespace Emulation System. ### Locker A kit to lock definitions hard. ### Coercion A hook to insert coercions using Elpi. ### RBuild A handy syntax to build records. ### CS A hook to solve Canonical Structure problems in Elpi. ### TC An alternative Type Class solver written in Elpi. LPCIC-coq-elpi-eb449d7/apps/coercion/000077500000000000000000000000001523041753400172475ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/coercion/README.md000066400000000000000000000037111523041753400205300ustar00rootroot00000000000000# Coercion The `coercion` app enables to program Coq coercions in Elpi. This app is experimental. ## The coercion predicate The `coercion` predicate lives in the database `coercion.db` ```elpi % [coercion Ctx V Inferred Expected Res] is queried to cast V to Res % - [Ctx] is the context % - [V] is the value to be coerced % - [Inferred] is the type of [V] % - [Expected] is the type [V] should be coerced to % - [Res] is the result (of type [Expected]) pred coercion i:goal-ctx, i:term, i:term, i:term, o:term. ``` By addings rules for this predicate one can recover from a type error, that is when `Inferred` and `Expected` are not unifiable. ## Simple example of coercion This example maps `True : Prop` to `true : bool`, which is a function you cannot express in type theory, hence in the standard Coercion system. ```coq From elpi.apps Require Import coercion. From Coq Require Import Bool. Elpi Accumulate coercion.db lp:{{ coercion _ {{ True }} {{ Prop }} {{ bool }} {{ true }}. coercion _ {{ False }} {{ Prop }} {{ bool }} {{ false }}. }}. Check True && False. ``` ## Example of coercion with proof automation This coercion enriches `x : T` to a `{x : T | P x}` by using `my_solver` to prove `P x`. ```coq From elpi.apps Require Import coercion. From Coq Require Import Arith ssreflect. Ltac my_solver := trivial with arith. Elpi Accumulate coercion.db lp:{{ coercion _ X Ty {{ @sig lp:Ty lp:P }} Solution :- std.do! [ % we unfold letins since the solver is dumb and the `as` in the second % example introduces a letin (pi a b b1\ copy a b :- def a _ _ b, copy b b1) => copy X X1, % we build the solution Solution = {{ @exist lp:Ty lp:P lp:X1 _ }}, % we call the solver coq.ltac.collect-goals Solution [G] [], coq.ltac.open (x\y\coq.ltac.call-ltac1 "my_solver" x y ok) G [], ]. }}. Elpi Typecheck coercion. Goal {x : nat | x > 0}. apply: 3. Qed. Definition ensure_pos n : {x : nat | x > 0} := match n with | O => 1 | S x as y => y end. ``` LPCIC-coq-elpi-eb449d7/apps/coercion/src/000077500000000000000000000000001523041753400200365ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/coercion/src/dune000066400000000000000000000005301523041753400207120ustar00rootroot00000000000000(library (name elpi_coercion_plugin) (public_name rocq-elpi.coercion) (flags :standard -w -27) (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) (libraries rocq-runtime.plugins.ltac rocq-runtime.vernac rocq-elpi.elpi)) (coq.pp (modules rocq_elpi_coercion_hook)) LPCIC-coq-elpi-eb449d7/apps/coercion/src/elpi_coercion_plugin.mlpack000066400000000000000000000000301523041753400254100ustar00rootroot00000000000000Rocq_elpi_coercion_hook LPCIC-coq-elpi-eb449d7/apps/coercion/src/rocq_elpi_coercion_hook.mlg000066400000000000000000000066131523041753400254230ustar00rootroot00000000000000DECLARE PLUGIN "rocq-elpi.coercion" { open Elpi open Elpi_plugin open Rocq_elpi_arg_syntax open Rocq_elpi_vernacular let relevant = EConstr.ERelevance.relevant let anonR = Context.make_annot Names.Name.Anonymous EConstr.ERelevance.irrelevant let nameR x = Context.make_annot (Names.Name.Name x) EConstr.ERelevance.irrelevant let annotR x = Context.make_annot x EConstr.ERelevance.irrelevant let build_expected_type env sigma expected = match expected with | Coercion.Type t -> sigma, t, false | Coercion.Product -> let (sigma, (source, _)) = Evarutil.new_type_evar env sigma Evd.univ_flexible in let (sigma, (target, _)) = let env = EConstr.push_rel (Context.Rel.Declaration.LocalAssum (EConstr.annotR (Names.Name (Namegen.default_dependent_ident)) , source)) env in Evarutil.new_type_evar env sigma Evd.univ_flexible in sigma, EConstr.mkProd (annotR (Names.Name (Namegen.default_type_ident)), source, target), true | Coercion.Sort -> let (sigma, t) = Evarutil.new_Type sigma in sigma, t, true let return s g t = Some (s,g,t) let elpi_coercion_hook program env sigma ~flags v ~inferred ~expected = let atts = [] in let sigma, expected, retype = build_expected_type env sigma expected in let sigma, goal = Evarutil.new_evar ~typeclass_candidate:false env sigma expected in let goal_evar, _ = EConstr.destEvar sigma goal in let query state = let loc = Elpi.API.State.get Rocq_elpi_builtins_synterp.invocation_site_loc state in let depth = 0 in let state, q, gls = Rocq_elpi_HOAS.solvegoals2query sigma [goal_evar] loc ~main:[v; inferred] ~in_elpi_tac_arg:Rocq_elpi_arg_HOAS.in_elpi_tac_econstr ~depth ~base:() state in let state, qatts = atts2impl loc Summary.Stage.Interp ~depth state atts q in let state = API.State.set Rocq_elpi_builtins.tactic_mode state true in state, qatts, gls in let loc = Loc.initial Loc.ToplevelInput in match Interp.get_and_compile ~loc program with | None -> None | Some (cprogram, _) -> match Interp.run ~loc cprogram (Fun (query)) with | API.Execute.Success solution -> let gls = Evar.Set.singleton goal_evar in let sigma, _, _ = Rocq_elpi_HOAS.solution2evd ~eta_contract_solution:false sigma solution gls in if Evd.is_defined sigma goal_evar then let t = if retype then Retyping.get_type_of env sigma goal else expected in return sigma goal t else None | API.Execute.NoMoreSteps | API.Execute.Failure -> None | exception (Rocq_elpi_utils.LtacFail (level, msg)) -> None let add_coercion_hook = let coercion_hook_program = Summary.ref ~name:"elpi-coercion" None in let coercion_hook env sigma ~flags v ~inferred ~expected = match !coercion_hook_program with | None -> None | Some h -> elpi_coercion_hook h env sigma ~flags v ~inferred ~expected in let name = "elpi-coercion" in Coercion.register_hook ~name coercion_hook; let inCoercion = let cache program = coercion_hook_program := Some program; Coercion.activate_hook ~name in let open Libobject in declare_object @@ superglobal_object_nodischarge "ELPI-COERCION" ~cache ~subst:None in fun program -> Lib.add_leaf (inCoercion program) } VERNAC COMMAND EXTEND ElpiCoercion CLASSIFIED AS SIDEFF | #[ atts = any_attribute ] [ "Elpi" "CoercionFallbackTactic" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in add_coercion_hook (snd p) } END LPCIC-coq-elpi-eb449d7/apps/coercion/tests/000077500000000000000000000000001523041753400204115ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/coercion/tests/dune000066400000000000000000000002121523041753400212620ustar00rootroot00000000000000(coq.theory (name elpi.apps.coercion.tests) (package rocq-elpi-tests) (theories elpi elpi.apps.coercion)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/coercion/tests/test.v000066400000000000000000000016201523041753400215560ustar00rootroot00000000000000From elpi.apps Require Import coercion. #[warning="-deprecated-from-Coq"] Elpi Accumulate coercion.db lp:{{ coercion _ {{ True }} {{ Prop }} {{ bool }} {{ true }}. coercion _ {{ False }} {{ Prop }} {{ bool }} {{ false }}. }}. Check andb True False. Parameter ringType : Type. Parameter ringType_sort : ringType -> Type. Parameter natmul : forall (R : ringType) (n : nat), (ringType_sort R). Elpi Accumulate coercion.db lp:{{ coercion _ N {{ nat }} {{ ringType_sort lp:R }} {{ natmul lp:R lp:N }} :- coq.typecheck R {{ ringType }} ok. }}. Section TestNatMul. Variable R : ringType. Variable n : nat. Check natmul R n : ringType_sort R. Check n : ringType_sort R. End TestNatMul. Axiom ord : nat -> Type. Axiom bump : forall n, ord n -> ord (S n). Elpi Accumulate coercion.db lp:{{ coercion _ X {{ ord lp:N }} {{ ord (S lp:N) }} {{ bump lp:N lp:X }}. }}. Check fun i : ord 1 => (i : ord 2). LPCIC-coq-elpi-eb449d7/apps/coercion/tests/test2.v000066400000000000000000000000511523041753400216350ustar00rootroot00000000000000Require Import test. Check True : bool. LPCIC-coq-elpi-eb449d7/apps/coercion/tests/test_open.v000066400000000000000000000012771523041753400226070ustar00rootroot00000000000000From elpi.apps Require Import coercion. From Corelib Require Import ssreflect. Ltac my_solver := try ((repeat apply: le_n_S); apply: le_0_n). Elpi Accumulate coercion lp:{{ coercion _ X Ty {{ @sig lp:Ty lp:P }} Solution :- std.do! [ % we unfold letins since the solve is dumb (pi a b b1\ copy a b :- def a _ _ b, !, copy b b1) => copy X X1, % we build the solution Solution = {{ @exist lp:Ty lp:P lp:X1 _ }}, % we call the solver coq.ltac.collect-goals Solution [G] [], coq.ltac.open (x\y\coq.ltac.call-ltac1 "my_solver" x y ok) G [], ]. }}. Goal {x : nat | x > 0}. apply: 3. Qed. Definition add1 n : {x : nat | x > 0} := match n with | O => 1 | S x as y => y end. Check 1. LPCIC-coq-elpi-eb449d7/apps/coercion/theories/000077500000000000000000000000001523041753400210715ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/coercion/theories/coercion.v000066400000000000000000000013501523041753400230600ustar00rootroot00000000000000Declare ML Module "rocq-elpi.coercion". From elpi Require Import elpi. Elpi Db coercion.db lp:{{ % predicate [coercion Ctx V Inferred Expected Res] used to add new coercion, with % - [Ctx] is the context % - [V] is the value to be coerced % - [Inferred] is the type of [V] % - [Expected] is the type [V] should be coerced to % - [Res] is the result (of type [Expected]) % Be careful not to trigger coercion as this may loop. :index(_ _ 10 10) pred coercion i:goal-ctx, i:term, i:term, i:term, o:term. }}. Elpi Tactic coercion. Elpi Accumulate Db Header coercion.db. Elpi Accumulate lp:{{ solve (goal Ctx _ Ty Sol [trm V, trm VTy]) _ :- coercion Ctx V VTy Ty Sol. }}. Elpi Accumulate Db coercion.db. Elpi CoercionFallbackTactic coercion. LPCIC-coq-elpi-eb449d7/apps/coercion/theories/dune000066400000000000000000000002111523041753400217410ustar00rootroot00000000000000(coq.theory (name elpi.apps.coercion) (package rocq-elpi) (theories elpi) (plugins rocq-elpi.coercion)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/cs/000077500000000000000000000000001523041753400160535ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/cs/README.md000066400000000000000000000017261523041753400173400ustar00rootroot00000000000000# Canonical solution The `canonical_solution` app enables to program Coq canonical structure solutions in Elpi. This app is experimental. ## The cs predicate The `cs` predicate lives in the database `cs.db` ```elpi % predicate [cs Ctx Lhs Rhs] used to unify Lhs with Rhs, with % - [Ctx] is the context % - [Lhs] and [Rhs] are the terms to unify :index (0 6 6) pred cs i:goal-ctx, o:term, o:term. ``` By addings rules for this predicate one can recover from a CS instance search failure error, that is when `Lhs` and `Rhs` are not unifiable using a canonical structure registered by Coq. ## Simple example of canonical solution This example declares a structure `S` with a projection `sort` and declares a canonical solution for `nat` in `S`. ```coq From elpi.apps Require Import cs. From Coq Require Import Bool. Structure S : Type := mkS { sort :> Type }. Elpi Accumulate cs.db lp:{{ cs _ {{ sort }} {{ nat }} {{ mkS nat }}. }}. Check eq_refl _ : (sort _) = nat. ``` LPCIC-coq-elpi-eb449d7/apps/cs/src/000077500000000000000000000000001523041753400166425ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/cs/src/dune000066400000000000000000000005061523041753400175210ustar00rootroot00000000000000(library (name elpi_cs_plugin) (public_name rocq-elpi.cs) (flags :standard -w -27) (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) (libraries rocq-runtime.plugins.ltac rocq-runtime.vernac rocq-elpi.elpi)) (coq.pp (modules rocq_elpi_cs_hook)) LPCIC-coq-elpi-eb449d7/apps/cs/src/elpi_cs_plugin.mlpack000066400000000000000000000000221523041753400230210ustar00rootroot00000000000000Rocq_elpi_cs_hook LPCIC-coq-elpi-eb449d7/apps/cs/src/rocq_elpi_cs_hook.mlg000066400000000000000000000071121523041753400230260ustar00rootroot00000000000000DECLARE PLUGIN "rocq-elpi.cs" { open Elpi open Elpi_plugin open Rocq_elpi_arg_syntax open Rocq_elpi_vernacular [%%if coq = "9.0" || coq = "9.1"] let structure_projection_nparams env ind = Structures.Structure.projection_nparams ind [%%else] let structure_projection_nparams env ind = Structures.Structure.projection_nparams env ind [%%endif] let elpi_cs_hook program env sigma ((proji, u), params1, c1) (t2, args2) = let atts = [] in let rhs = Reductionops.Stack.zip sigma (t2, Reductionops.Stack.append_app_list args2 Reductionops.Stack.empty) in let sigma, (goal_ty, _) = Evarutil.new_type_evar env sigma Evd.UnivRigid in let sigma, goal = Evarutil.new_evar ~typeclass_candidate:false env sigma goal_ty in let goal_evar, _ = EConstr.destEvar sigma goal in let nparams = structure_projection_nparams env proji in let query state = let loc = Elpi.API.State.get Rocq_elpi_builtins_synterp.invocation_site_loc state in let state, q, gls = let lhs = match params1 with | Some params1 -> EConstr.mkApp (EConstr.mkConstU (proji, u), Array.of_list params1) | None -> EConstr.mkConstU (proji, u) in Rocq_elpi_HOAS.solvegoals2query sigma [goal_evar] loc ~main:[lhs; rhs] ~in_elpi_tac_arg:Rocq_elpi_arg_HOAS.in_elpi_tac_econstr ~depth:0 ~base:() state in let state, qatts = atts2impl loc Summary.Stage.Interp ~depth:0 state atts q in let state = API.State.set Rocq_elpi_builtins.tactic_mode state true in state, qatts, gls in let loc = Loc.initial Loc.ToplevelInput in match Interp.get_and_compile ~loc program with | None -> None | Some (cprogram, _) -> begin match Interp.run ~loc cprogram (Fun query) with | API.Execute.Success solution -> let gls = Evar.Set.singleton goal_evar in let sigma, _, _ = Rocq_elpi_HOAS.solution2evd ~eta_contract_solution:false sigma solution gls in if Evd.is_defined sigma goal_evar then let constant = EConstr.to_constr sigma goal in let args_goal, t = Reduction.whd_decompose_lambda env constant in let args_type = List.rev_map Context.Rel.Declaration.get_type args_goal in let args_type = List.map EConstr.of_constr args_type in let args = snd (Constr.decompose_app_list t) in let params, projs = CList.chop nparams args in let i = Structures.Structure.projection_number env proji in let lhs = List.nth projs i in let lhs = EConstr.of_constr lhs in let _, sk1 = EConstr.decompose_app sigma lhs in let open Structures.CanonicalSolution in Some (sigma, { constant = EConstr.of_constr constant; abstractions_ty = args_type; body = lhs; nparams; params = List.map EConstr.of_constr params; cvalue_abstraction = None; cvalue_arguments = Array.to_list sk1}) else None | API.Execute.NoMoreSteps | API.Execute.Failure -> None end let add_cs_hook = let cs_hook_program = Summary.ref ~name:"elpi-cs" None in let cs_hook env sigma proj pat = match !cs_hook_program with | None -> None | Some h -> elpi_cs_hook h env sigma proj pat in let name = "elpi-cs" in Evarconv.register_hook ~name cs_hook; let inCs = let cache program = cs_hook_program := Some program; Evarconv.activate_hook ~name in let open Libobject in declare_object @@ superglobal_object_nodischarge "ELPI-CS" ~cache ~subst:None in fun program -> Lib.add_leaf (inCs program) } VERNAC COMMAND EXTEND ElpiCS CLASSIFIED AS SIDEFF | #[ atts = any_attribute ] [ "Elpi" "CS" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in add_cs_hook (snd p) } END LPCIC-coq-elpi-eb449d7/apps/cs/tests/000077500000000000000000000000001523041753400172155ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/cs/tests/cs.t.disabled_broken_8.19/000077500000000000000000000000001523041753400236515ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/cs/tests/cs.t.disabled_broken_8.19/run.t.disabled_broken_8.19000066400000000000000000000012531523041753400304300ustar00rootroot00000000000000 $ DEPS="elpi elpi.apps.cs" $ . ../setup-project.sh $ dune build test.vo 1 : nat eq_refl : {| sort := id (A:=nat) |} = id (A:=nat) : {| sort := id (A:=nat) |} = id (A:=nat) 11 : nat eq_refl : {| sort := id (A:=nat) |} 1 = id 1 : {| sort := id (A:=nat) |} 1 = id 1 2 : nat eq_refl : {| sort := id (A:=nat) |} = id1 nat : {| sort := id (A:=nat) |} = id1 nat 3 : nat eq_refl : sort1 nat {| sort := id (A:=nat) |} = id (A:=nat) : sort1 nat {| sort := id (A:=nat) |} = id (A:=nat) 4 : nat eq_refl : sort1 nat {| sort := id (A:=nat) |} = id1 nat : sort1 nat {| sort := id (A:=nat) |} = id1 nat LPCIC-coq-elpi-eb449d7/apps/cs/tests/cs.t.disabled_broken_8.19/test.v000066400000000000000000000010461523041753400250200ustar00rootroot00000000000000From elpi.apps Require Import cs. From Coq Require Import Bool. Structure S (T : Type) : Type := { sort :> T -> T }. Elpi Accumulate canonical_solution lp:{{ cs _ {{ sort lp:T }} {{ @id lp:T }} {{ Build_S lp:T (@id lp:T) }}. }}. Check 1. Check eq_refl _ : (sort nat _) = @id nat. Check 11. Check eq_refl _ : (sort nat _) 1 = @id nat 1. Definition id1 := id. Check 2. Check eq_refl _ : (sort nat _) = @id1 nat. Definition sort1 := sort. Check 3. Check eq_refl _ : (sort1 nat _) = @id nat. Check 4. Check eq_refl _ : (sort1 nat _) = @id1 nat. LPCIC-coq-elpi-eb449d7/apps/cs/tests/dune000066400000000000000000000001631523041753400200730ustar00rootroot00000000000000(cram (applies_to :whole_subtree) (deps %{bin:coqc} %{bin:coqdep} (package rocq-elpi) setup-project.sh)) LPCIC-coq-elpi-eb449d7/apps/cs/theories/000077500000000000000000000000001523041753400176755ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/cs/theories/cs.v000066400000000000000000000012461523041753400204740ustar00rootroot00000000000000Declare ML Module "rocq-elpi.cs". From elpi Require Import elpi. Elpi Db cs.db lp:{{ % predicate [cs Ctx Proj Rhs Sol] used to find Sol such that Proj Sol = Rhs, where % - [Ctx] is the context % - [Proj] is the projector of some structure, applied to the structure's parameters if any % - [Rhs] the term to find a structure on. :index (0 6 6) pred cs i:goal-ctx, i:term, i:term, o:term. }}. Elpi Tactic canonical_solution. Elpi Accumulate Db cs.db. Elpi Accumulate canonical_solution lp:{{ solve (goal Ctx _ _Ty Sol [trm Proj, trm Rhs]) _ :- cs Ctx Proj Rhs Sol, % std.assert! (P = {{ eq_refl lp:Lhs }}) "cs: wrong solution". true. }}. Elpi CS canonical_solution. LPCIC-coq-elpi-eb449d7/apps/cs/theories/dune000066400000000000000000000001751523041753400205560ustar00rootroot00000000000000(coq.theory (name elpi.apps.cs) (package rocq-elpi) (theories elpi) (plugins rocq-elpi.cs)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/derive/000077500000000000000000000000001523041753400167245ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/README.md000066400000000000000000000522601523041753400202100ustar00rootroot00000000000000# Derive The `derive` command automatically synthesizes a bunch of useful lemmas given an inductive type declaration. ## In a nutshell ```coq From elpi.apps Require Import derive.std. #[module] derive Inductive peano := Zero | Succ (p : peano). Print peano.peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano. *) Eval compute in peano.eqb Zero (Succ Zero). (* = false : bool *) About peano.eqb_OK. (* peano.eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (peano.eqb x1 x2) peano.eqb_OK is not universe polymorphic Arguments peano.eqb_OK x1 x2 peano.eqb_OK is opaque Expands to: Constant elpi.apps.derive.examples.readme.peano.eqb_OK *) ``` See also [examples/usage.v](examples/usage.v) and [tests/test_readme.v](tests/test_readme.v). :warning: The line `From elpi.apps Require Import derive.std.` sets globally `Uniform Inductive Parameters`. See the [documentation of that option in the Coq reference manual](https://coq.inria.fr/refman/language/core/inductive.html#coq:flag.Uniform-Inductive-Parameters). ## Usage and attributes Using `derive Inductive ty := ...` produces the inductive `ty`, together with derivations, all in the current scope. The `#[module=]` attribute can be used to specify that the inductive and the derivations should be wrapped in a module of the given name (the name of the inductive is used if no name is specified). When a wrapper module is generated, an alias (i.e., a notation) is generated for the inductive to be accessible with its name, outside of the module scope. This behaviour can be disabled by using the `#[no_alias]` boolean attribute. The `#[prefix=]` attribute can be used to specify a prefix for all the derived definitions/lemmas. ## Documentation Elpi's `derive` app is a little framework to register derivations. Currently there are 3 groups: - `derive.std` contains well tested derivations including: + `eqb` and `eqbOK` generate sound boolean equality test in linear time/space, see [Practical and sound equality tests, automatically](https://hal.inria.fr/hal-03800154) + `eqbOK` generates its soundness proof in linear time/space + `induction` generates deep induction principles, see [Stronger Induction Principles for Containers](http://drops.dagstuhl.de/opus/volltexte/2019/11084/) + `param1` and `param2` generate the unary and binary parametricity translations + `map` map over a container + `param1_functor` functoriality lemmas (map over the param1 translation) + `lens` and `lens_laws` generate lenses focusing on record fields and some equations governing setter/setters (aka record update syntax) - `derive.legacy` contains derivations superseded by `std`: + `eq` and `eqOK` generate sound equality tests in quadratic time/space, see [Deriving proved equality tests in Coq-elpi](http://drops.dagstuhl.de/opus/volltexte/2019/11084/) - `derive.experimental` contains derivations not suitable for mainstream use: + `idx2inv` generates an inductive type where indexes are replaced by non uniform parameters and equations The `elpi/` directory contains the elpi files implementing various automatic derivation of terms. The corresponding .v files, defining the Coq commands, are in `theories/derive/`. Single steps of the derivation are available as separate commands. Only the main entry point `derive` comes with an handy syntax; the other commands have to be invoked mentioning `Elpi` and only accept an already declared inductive as input. ## Derivations
std (click to expand)

### `map` Map a container over its parameters. ```coq Elpi derive.map list. Check list_map : forall A B, (A -> B) -> list A -> list B. ``` ### `lens` See also [theories/derive/lens.v](theories/derive/lens.v) for the `Lens` definition and the support constants `view`, `set` and `over`. ```coq Record pa_record A := { f3 : peano; f4 : A; }. Elpi derive.lens pa_record. Check _f3 : forall A, Lens (pa_record A) (pa_record A) peano peano. ``` ### `lens_laws` See also [theories/derive/lens_laws.v](theories/derive/lens_laws.v) for the statements of the 4 laws (set_set, view_set, set_view, exchange). ```coq Elpi derive.lens_laws pa_record. Check _f3_view_set : forall A (r : pa_record A) x, view _f3 (set _f3 x r) = x. ``` ### `param1` Unary parametricity translation. ```coq Elpi derive.param1 nat. Print is_nat. (* Inductive is_nat : nat -> Type := | is_O : is_nat 0 | is_S : forall n : nat, is_nat n -> is_nat (S n) *) ``` ### `param2` Binary parametricity translation. Main command is `derive.param2` ```coq Elpi derive.param2 nat. Print nat_R. (* Inductive nat_R : nat -> nat -> Set := | O_R : nat_R 0 0 | S_R : forall H H0 : nat, nat_R H H0 -> nat_R (S H) (S H0). ``` The command `derive.param2.register` can be used to register handcrafted parametricity rules, so that they can be used by further `derive.param2` commands. ```coq Definition fa := 0. Definition fb := fa. Fail Elpi derive.param2 fb. (* derive.param2: No binary parametricity translation for fa *) Definition fa_R := O_R. Elpi derive.param2.register fa fa_R. Elpi derive.param2 fb. ``` ### `param1_functor` ```coq Elpi derive.param1.functor is_list. Check is_list_functor : forall A PA QA, (forall x, PA x -> QA x) -> forall l, is_list A PA l -> list A QA l. ``` ### `param1_trivial` ```coq Elpi derive.param1.trivial is_nat. Check is_nat_trivial : forall x : nat, { p : is_nat x & forall q, p = q }. Check is_nat_inhab : forall x : nat, is_nat x. ``` ### `induction` Induction principle for `T` based on `is_T` ```coq Elpi derive.induction list. Check list_induction : forall (A : Type) (PA : A -> Type) P, P (nil A) -> (forall x : A, PA x -> forall xs, P xs -> P (cons A x xs)) -> forall l, is_list A PA l -> P l. ``` ### `tag` The "name" of the constructor ```coq Elpi derive.tag peano. Check peano_tag : peano -> positive. ``` ### `fields` The types of the fields and the fields of each constructor ```coq Elpi derive.fields peano. Check peano_fields_t : positive -> Type. Check peano_fields : forall (n:peano), peano_fields_t (peano_tag n). Check peano_construct : forall (p: positive), peano_fields_t p -> Datatypes.option peano. Check peano_constructP : forall (n:peano), peano_construct (peano_tag n) (peano_fields n) = Datatypes.Some n. ``` ### `eqb` Equality test ```coq Elpi derive.eqb peano. Check peano_eqb : peano -> peano -> bool. ``` ### `eqbcorrect` Two directions of the soundness proof ```coq Elpi derive.eqbcorrect peano. Check peano_eqb_correct : forall n m, peano_eqb n m = true -> n = m. Check peano_eqb_refl : forall n, peano_eqb n n = true. ``` ### `eqbOK` The soundness proof ```coq Elpi derive.eqbOK peano. Check peano_eqb_OK : forall n m, reflect (n = m) (peano_eqb n m). ``` ### `param1_congr` Used by `param1_trivial`, not interesting. ```coq Elpi derive.param1.congr is_nat. Check is_Succ congr : forall x (px qx : is_nat x), px = qx -> is_Succ x px = is_Succ x qx. ```

legacy (click to expand)

See [Deriving proved equality tests in Coq-elpi: Stronger Induction Principles for Containers](http://drops.dagstuhl.de/opus/volltexte/2019/11084/) for a description of most of these components. ### `isK` Given an inductive type it generates for each constructor a function that tests if a term is a specific constructor. Example: ```coq Elpi derive.isK list. Print list_is_nil. (* list_is_nil = fun (A : Type) (i : list A) => match i with | nil => true | _ => false end *) ``` ### `projK` Given an inductive type it generates for each constructor `K` and argument `i` of this constructor a function extracting that argument (provided enough default values). ```coq Elpi derive.projK Vector.t. Check projcons1. (* projcons1 : forall (A : Type) (H : nat), A -> forall n : nat, Vector.t A n -> Vector.t A H -> A ``` The intended use is to perform injection, i.e. one already has a term of the shape `K args` and can just use these args to provide the default values. If the projected argument's type depends on the value of other arguments, then it is boxed using `existT`. ```coq Check projcons3. (* projcons3 : forall (A : Type) (H : nat), A -> forall n : nat, Vector.t A n -> Vector.t A H -> {i1 : nat & Vector.t A i1} *) ``` ### injection `injection H EqAB PL` given an equation `H` of type `EqAB` returns a list of equations `PL`. `EqAB` is expected to be of the form `K .. = K ..` for a constructor `K`. coverage: does not do the smart thing when the obtained equations are like `{ i : nat & Vector.t A i } = ...` in which case, given that `nat` is `eqType` one could obtain systematically the two equalities. Note: this is not a real derivation, since it generates no constant, but it a piece of code used by derivations. ### discriminate `discriminate H EqAB G PG` given an equation `H` of type `EqAB` and a goal `G` it provides a proof `PG`. It asserts that `EqAB` is of the form `K1 .. = K2 ..` when `K1` is a constructor different from `K2`. Note: this is not a real derivation, since it generates no constant, but it a piece of code used by derivations. ### `bcongr` We call a boolean congruence lemma an instance of the `reflect` predicate on a proposition `K x1..xn = K y1..yn` and a boolean expression `b1 && .. bn`. ```coq Elpi derive.bcongr list. Check nil_congr : forall A, reflect (@nil A = @nil A) true. Check cons_congr : forall A, forall (x y : A) b1, reflect (x = y) b1 -> forall (xs ys : list A) b2, reflect (xs = ys) b2 -> reflect (cons x xs = cons y ys) (b1 && b2). ``` ### `eq` Generates a boolean comparison function. ```coq Elpi derive.eq list. Check list_eq. (* list_eq : forall A : Type, (A -> A -> bool) -> list A -> list A -> bool *) ``` ### `eqK` Generates, for each constructor, the correctness lemma for the comparison function. ```coq Elpi derive.eqK list. Check eq_axiom_nil : forall A fa, axiom (list A) (list_eq A fa) (@nil A). Check eq_axiom_cons : forall A fa, forall x, axiom A fa x -> forall xs, axiom (list A) (list_eq A fa) xs -> axiom (list A) (list_eq A fa) (cons x xs). ``` ### `eqcorrect` Correctness of equality test using reified type information. ```coq Elpi derive.eqcorrect list. Check list_eq_correct : forall A f l, is_list A (eq_axiom A f) l -> eq_axiom (list A) (list_eq A f) l. ``` ### `eqOK` Correctness of equality test. ```coq Elpi derive.eqOK list. Check list_eq_OK : forall A f, (forall a, axiom A f a) -> (forall l, eq_axiom (list A) (list_eq A f) l). ``` ## Coverage This is the list of inductive types we use for testing, and the table with the result of each derivation (:sunny: = OK, :bug: = does not work but might, :cloud: = looks like this can't possible work) ```coq Inductive empty := . Inductive unit := tt. Inductive peano := Zero | Succ (n : peano). Inductive option A := None | Some (_ : A). Inductive pair A B := Comma (a : A) (b : B). Inductive seq A := Nil | Cons (x : A) (xs : seq A). Inductive rose (A : Type) := Leaf | Node (sib : seq (rose A)). Inductive nest A := NilN | ConsN (x : A) (xs : nest (pair A A)). Fail Inductive bush A := BNil | BCons (x : A) (xs : bush (bush A)). Inductive w A := via (f : A -> w A). Inductive vect A : peano -> Type := VNil : vect A Zero | VCons (x : A) n (xs : vect A n) : vect A (Succ n). Inductive dyn := box (T : Type) (t : T). Inductive zeta Sender (Receiver := Sender) := Envelope (a : Sender) (ReplyTo := a) (c : Receiver). Inductive beta (A : (fun x : Type => x) Type) := Redex (a : (fun x : Type => x) A). Inductive iota := Why n (a : match n in peano return Type with Zero => peano | Succ _ => unit end). Inductive large := K1 (_ : unit) | K2 (_ : unit) (_ : unit) | ... Inductive prim_int := PI (i : Int63.int). Inductive prim_float := PF (f : PrimFloat.float). Record fo_record := { f1 : peano; f2 : unit; }. Record pa_record A := { f3 : peano; f4 : A; }. Record pr_record A := { pf3 : peano; pf4 : A; }. (* with primitive projections *) Record dep_record := { f5 : peano; f6 : vect unit f5; }. Variant enum := E1 | E2 | E3. ``` test | eq | param1 | map | induction | isK | projK | bcongr | eqK | eqcorrect | eqOK | lens_laws -----------|---------|---------|---------|-----------|---------|---------|---------|---------|-----------|---------|---------- empty | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: unit | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: peano | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: option | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: pair | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: seq | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: rose | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: nest | :cloud: | :sunny: | :cloud: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :cloud: w | :cloud: | :sunny: | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :cloud: vect | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :bug: | :cloud: dyn | :cloud: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :bug: | :cloud: zeta | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: beta | :sunny: | :sunny: | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :sunny: | :cloud: iota | :cloud: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: | :bug: | :cloud: | :cloud: | :cloud: large | :sunny: | :sunny: | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: prim_int | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: prim_float | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: | :cloud: | :cloud: fo_record | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: pa_record | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: pr_record | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: dep_record | :bug: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :bug: | :bug: | :bug: | :bug: | :cloud: enum | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :sunny: | :cloud: test | functor | inhab | congr | trivial | ----------|---------|---------|-----------|---------| is_empty | :sunny: | :sunny: | :sunny: | :sunny: | is_unit | :sunny: | :sunny: | :sunny: | :sunny: | is_peano | :sunny: | :sunny: | :sunny: | :sunny: | is_option | :sunny: | :sunny: | :sunny: | :sunny: | is_pair | :sunny: | :sunny: | :sunny: | :sunny: | is_seq | :sunny: | :sunny: | :sunny: | :sunny: | is_rose | :sunny: | :sunny: | :sunny: | :sunny: | is_nest | :bug: | :bug: | :cloud: | :cloud: | is_w | :bug: | :sunny: | :sunny: | :bug: | is_vect | :sunny: | :bug: | :cloud: | :bug: | is_dyn | :sunny: | :cloud: | :cloud: | :bug: | is_zeta | :sunny: | :sunny: | :sunny: | :sunny: | is_beta | :sunny: | :sunny: | :sunny: | :sunny: | is_iota | :sunny: | :bug: | :cloud: | :bug: | is_large | :sunny: | :sunny: | :bug: | :bug: | is_prim_int | :sunny: | :sunny: | :sunny: | :sunny: | is_is_prim_float| :sunny: | :sunny: | :sunny: | :sunny: | is_fo_record | :sunny: | :sunny: | :sunny: | :sunny: | is_pa_record | :sunny: | :sunny: | :sunny: | :sunny: | is_pr_record | :sunny: | :sunny: | :sunny: | :sunny: | is_dep_record| :sunny: | :bug: | :sunny: | :bug: | is_enum | :sunny: | :sunny: | :sunny: | :sunny: |

experimental (click to expand)

### `invert` ```coq Inductive is_list A PA : list A -> Type := | nilR : is_list (@nil A) | consR : forall a : A, PA a -> forall xs : list A, is_list xs -> is_list (cons a xs). Elpi derive.invert is_list. Print is_list_inv. (* Inductive is_list_inv (A : Type) (PA : A -> Type) (idx0 : list A) : Type := | nilR_inv : idx0 = nil -> is_list_inv A PA idx0 | consR_inv : forall a : A, PA a -> forall xs : list A, is_list_inv A PA xs -> idx0 = (cons a xs) -> is_list_inv A PA idx0. *) ``` ## `idx2inv` ```coq Elpi derive.idx2inv is_list. Check is_list_to_is_list_inv : forall A PA l, is_list A PA l -> is_list_inv A PA l. ```

## Writing a new derivation A derivation is made of: - a file implementing the derivation - a data base to carry some state - a stand alone command - a hook in the main derive procedure At the light of that, here a typical derivation file `myder.v`. The first section loads the standard derive code and declares the dependency the external file `myder.elpi`. The file `derive_hook.elpi` contains a few data types needed in order to register the derivation in the main derive loop. ```coq From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook. From mypkg Extra Dependency "myder.elpi" as myder. From elpi Require Import elpi. From elpi.apps Require Import derive. ``` The database is typically a predicate `myder` linking a type name to some concept previously derived. We also need to know if we did already derive a type, hence we declare a second predicate `myder-done` (we could reuse the former, but sometimes this is not easy, so here we are pedantic). We like to prefix these data bases name with `derive.`. ```coq Elpi Db derive.mydb.db lp:{{ % [myder T D] links a type T to a derived concept D pred myder o:gref, o:gref. % [myder-done T] mean T was already derived pred myder-done o:gref. }}. ``` Then we build a standalone derivation accessible via the name `derive.myder` which accumulates the external files declared before, the data base and an entry point ```coq Elpi Command derive.myder. Elpi Accumulate File derive_hook. Elpi Accumulate File myder. Elpi Accumulate Db derive.mydb.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.myder.main GR Prefix _. main _ :- usage. pred usage. usage :- coq.error "Usage: derive.myder ". }}. ``` This is enough to run the derivation via something like `Elpi derive.myder nat.`. In order to have `derive` run it one has to accumulate some code on top of `derive` itself. ```coq Elpi Accumulate derive Db derive.myder.db. Elpi Accumulate derive File myder. Elpi Accumulate derive lp:{{ dep1 "myder" "somedep". dep1 "myder" "someotherdep". derivation (indt T) Prefix % inputs (derive "myder" % name (for dep1) (derive.myder.main (indt T) Prefix) % code to run (myder-done (indt T)) % idempotency test ). }}. ``` First, one declares via `dep1` the derivations that should run before, here `somedep` and `someotherdep`. `derive` will compute a topological order and ensure dependencies are run first. Then one declares a derivation for a gref and a prefix. One can restrict which grefs can be derived, here for example we make `myder` only available on `indt` (inductive types, and not definitions or constructors). `Prefix` is a string, typically passed to the main code. The the `(derive ...)` tuple carrier the name of the derivation, already used in `dep1` and two predicates, one to run the derivation and one to test if the derivation was already run. The types for `dep1`, `derivation` and `derive` are declared in `derive_hook.elpi`. Finally, one is expected to `Import` the `myder.v` file in a derivation group, for example `better_std.v` would look like so: ```coq From elpi.apps Require Export derive. From elpi.apps Require Export derive.map derive.lens derive.lens_laws ... myder (* new derivation *) . ``` So when the user `Import`s `better_std` he gets a fully loaded `derive`. The code of the derivation must be put in a namespace. So `myder.elpi` should look like so ```elpi namespace derive.myder { pred main i:gref, i:string, o:list prop. main GR Prefix Clauses :- std.do! [ ... % synthesize Body and Type Name is Prefix ^ "myconcept", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName Body Type _ C, Clauses = [myder-done GR, myder GR (const C)], std.forall Clauses (x\ coq.elpi.accumulate _ "derive.myder.db" (clause _ _ x) ), ]. } ``` It is important that all clauses added to the database are also returned (see the last argument of `main`). Derive runs all derivations at once and databases are updated only when the program ends. So derive will assume, with `=>`, the clauses generated by one derivation before running the nest one. LPCIC-coq-elpi-eb449d7/apps/derive/derive.svg000066400000000000000000001620751523041753400207360ustar00rootroot00000000000000 image/svg+xml eqOK induction eqK eq param1 projK bcongr injection isK discriminate eqcorrect param1functor param1congr param1inhab param1trivial LPCIC-coq-elpi-eb449d7/apps/derive/elpi/000077500000000000000000000000001523041753400176555ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/elpi/bcongr.elpi000066400000000000000000000113301523041753400220000ustar00rootroot00000000000000 /* Boolean congruence lemmas */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{nth, map2, assert!, rev, do!}. namespace derive.bcongr { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % take in input all hyps % links an assumption to the two terms being compared and the boolean value % for them: forall x y b (H : reflext (x = y) b), ----> (arg H x y b) kind arg type. type arg term -> term -> term -> term -> arg. func bo-args term, term, term, list arg -> term. bo-args (prod N S T) K1 K2 Hs (fun `x` S x\ fun `y` S y\ fun `b` {{bool}} b\ R x y b) :- !, @pi-decl `x` S x\ @pi-decl `y` S y\ @pi-decl `b` {{ Corelib.Init.Datatypes.bool }} b\ @pi-decl Hn (TH x y b) h\ do! [ TH x y b = {{ lib:elpi.reflect (lib:@elpi.eq lp:S lp:x lp:y) lp:b }}, R x y b = (fun `h` (TH x y b) h\ Body x y b h), coq.name-suffix `h` N Hn, bo-args (T x) {coq.mk-app K1 [x]} {coq.mk-app K2 [y]} [arg h x y b|Hs] (Body x y b h) ]. bo-args T K1 K2 HsRev Bo :- (T = global (indt _) ; T = app[global (indt _)|_]), !, rev HsRev Hs, mk-conj Hs Conj, Concl = {{ lib:elpi.reflect (lib:@elpi.eq lp:T lp:K1 lp:K2) lp:Conj }}, elim-all 0 Hs Concl Bo. bo-args T K1 K2 HsRev Bo :- whd1 T T1, !, bo-args T1 K1 K2 HsRev Bo. func mk-conj list arg -> term. mk-conj [] {{ lib:elpi.true }}. mk-conj [arg _ _ _ X] X :- !. mk-conj [arg _ _ _ X|XS] {{ lib:elpi.andb lp:X lp:C }} :- mk-conj XS C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % we case split on each and every assumption (arg H _ _ _) func elim-all int, list arg -> term, term. elim-all _ [] {{ lib:elpi.reflect lp:P lp:_}} {{ lib:elpi.ReflectT lp:P (lib:@elpi.erefl lp:T lp:LHS) }} :- coq.safe-dest-app P _ [T,LHS,_]. elim-all N [arg H X Y B|Hs] P R :- decl H _ TH, (pi x b\ (copy Y x :- !) => (copy B b :- !) => copy P (Pxb x b)), !, coq.build-match H TH (otyR Pxb Y) (branchR Pxb X Y N Hs) R. func otyR (term -> term -> term), term, term, list term, list term -> term. otyR F X _ [Idx,_] _ R :- R = F X Idx. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Two branch per hyp: ReflectT or ReflectF % we continue func branchR (term -> term -> term), term, term, int, list arg, term ,term, list term, list term -> term. branchR Pxb X _ N Hs K _ [E] [ET] R :- coq.safe-dest-app K {{ lib:elpi.ReflectT }} _, !, coq.build-match E ET (otyE Pxb {{ lib:elpi.true}}) (branchE (Pxb X {{ lib:elpi.true }}) N Hs) R. % we stop, emit ReflectF and prove false via injection branchR Pxb _ Y N _ K _ [NE] [_] R :- coq.safe-dest-app K {{ lib:elpi.ReflectF }} _, !, Pxb Y {{ lib:elpi.false}} = {{ lib:elpi.reflect lp:P lp:_ }}, R = {{ lib:elpi.ReflectF lp:P lp:PNE }}, PNE = (fun `h` P h\ app[NE, Inj h]), @pi-decl `h` P h\ do! [ ltac.injection h P _ (PEs h), nth N (PEs h) (Inj h) ]. func branchE term, int, list arg, term ,term, list term, list term -> term. branchE P N Hs _ _ [] [] R :- M is N + 1, elim-all M Hs P R. func otyE (term -> term -> term), term, term, list term, list term -> term. otyE F B _ [X,_] _ R :- R = F X B. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % we take in input all parameters :index (1) func bo-param int, term, term -> term. bo-param 0 K T R :- !, bo-args T K K [] R. bo-param N K (prod Name Src T) (fun Name Src T1) :- N > 0, !, M is N - 1, @pi-decl Name Src x\ bo-param M {coq.mk-app K [x]} (T x) (T1 x). bo-param N K T R :- whd1 T T1, !, bo-param N K T1 R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for each constructor we generate the congruence lemma func main-constructor int, string, constructor, term -> prop. main-constructor Lno Prefix K Kt Clause :- do! [ Kn = global (indc K), % we build the comparison function bo-param Lno Kn Kt R, std.assert-ok! (coq.typecheck R RT) "derive.bcongr generates illtyped term", Name is Prefix ^ "bcongr_" ^ {coq.gref->id (indc K)}, coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R RT @opaque! Cong, % we register it as a clause Clause = (bcongr-db K (global (const Cong)) :- !), coq.elpi.accumulate _ "derive.bcongr.db" (clause _ (before "bcongr-db:fail") Clause) ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main inductive, string -> list prop. main GR Prefix Clauses :- do! [ coq.env.indt GR Ind Lno _ _ Kns Ktys, assert! (Ind = tt) "derive.bcongr: Coinductive types are not supported", map2 Kns Ktys (main-constructor Lno Prefix) Clauses ]. } % vim: set spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/cast.elpi000066400000000000000000000045741523041753400214740ustar00rootroot00000000000000/* Type cast using an equation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{append, rev, any->string, last, take}. namespace derive.cast { namespace aux { :index (1) func arity list term, list term -> term. arity [] _ (sort (typ U)) :- coq.univ.new U. arity [V|VS] Acc (prod `x` T R) :- coq.mk-app V {rev Acc} T, @pi-decl `x` T x\ arity VS [x|Acc] (R x). :index (1) func args list term, list term -> term. args [] [X|_] X. args [V|VS] Acc (fun `c` S R) :- coq.mk-app V {rev Acc} S, @pi-decl `x` S c\ args VS [c|Acc] (R c). func arg int, term, term, term, list term, list term, list term -> list term. arg _ _ _ _ _ [] _ []. arg I E X Y Ps [V|VS] Acc [R|RS] :- cast-db I T, take {calc (I )} Ps PsI, coq.mk-app T {append {append PsI [X,Y,E]} {append {rev Acc} [V]}} R, J is I + 1, arg J E X Y Ps VS [V|Acc] RS. :index(_ _ _ _ 1) func args-ty term, term, term, list term, list term, list term -> term. args-ty E X Y Ps [] [_|Acc] R :- last Ps V, rev Acc [_|Vars], arg 2 E X Y Ps Vars [] CastedVars, coq.mk-app V [X|CastedVars] R. args-ty E X Y Ps [V|VS] Acc (prod `c` S R) :- coq.mk-app V {rev Acc} S, @pi-decl `c` S c\ args-ty E X Y Ps VS [c|Acc] (R c). func body int, int, list term -> term. body I J V (fun Name T R) :- I > 0, !, coq.name-suffix `A` {calc (J - I)} Name, I1 is I - 1, arity {rev V} [] T, @pi-decl Name T x\ body I1 J [x|V] (R x). body 0 _ V R :- rev V [A|Rest], Ety = (x\y\ {{ @eq lp:A lp:x lp:y }}), R = {{ fun (x y : lp:A) (e : lp:(Ety x y)) => lp:(Bo x y e) }}, @pi-decl `x` A x\ @pi-decl `y` A y\ @pi-decl `e` (Ety x y) e\ coq.build-match e (Ety x y) (rty A Rest x) (body-branch Rest x) (Bo x y e). func rty term, list term, term, term, list term, list term -> term. rty A Rest X _ [Y,E] _ R :- args-ty E X Y [A|Rest] Rest [Y] R. func body-branch list term, term, term, term, list term, list term -> term. body-branch Rest Y _ _ _ _ R :- args Rest [Y] R. } func main int. main N :- Name is "cast" ^ {any->string N}, aux.body N N [] Bo, std.assert-ok! (coq.typecheck Bo Ty) "derive.cast generates illtyped term", coq.env.add-const Name Bo Ty _ C, coq.elpi.accumulate _ "derive.cast.db" (clause _ _ (cast-db N (global (const C)))). } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/derive.elpi000066400000000000000000000143101523041753400220050ustar00rootroot00000000000000/* Entry point for all derivations */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive { func exists-indc inductive, (func constructor ->). exists-indc I P :- coq.env.indt I _ _ _ _ KL _, std.exists! KL P. func if-verbose (func) ->. if-verbose P :- (get-option "verbose" tt ; get-option "recursive" tt), !, P. if-verbose _. pred dep o:string, o:string. dep X Y :- dep1 X Y. dep X Y :- dep1 X Z, dep Z Y. func selected string ->. selected Name :- get-option "only" Map, !, Map => (get-option Name _; (get-option X _, dep X Name)), !. selected _. func validate-only gref, list derive ->. validate-only T LD :- get-option "only" Map, !, std.forall Map (known-option T LD). validate-only _ _. func known-option gref, list derive, prop ->. known-option T L (get-option X _) :- if (std.mem! L (derive X _ _)) true (coq.error "Derivation" X "unknown or not applicable to input" T). :index (_ 1) func chain gref, list derive -> list prop. chain _ [] []. chain T [derive Name _ _|FS] CL :- not(selected Name), !, if-verbose (coq.say "Skipping derivation" Name "on" T "since the user did not select it"), chain T FS CL. chain T [derive Name _ AlreadyDone|FS] CL :- ((pi x\ stop x :- !, fail) ==> AlreadyDone), !, if-verbose (coq.say "Skipping derivation" Name "on" T "since it has been already run"), chain T FS CL. chain T [derive Name F _|FS] CL :- get-option "only" _, !, % request this one if-verbose (coq.say "Derivation" Name "on" T), (@dropunivs! ==> std.time (F C) Time), if-verbose (coq.say "Derivation" Name "on" T "took" Time), (C ==> chain T FS CS), std.append C CS CL. chain T [derive Name F _|FS] CL :- % all are selected, we can fail if-verbose (coq.say "Derivation" Name "on" T), ((pi x\ stop x :- !, fail) ==> @dropunivs! ==> std.time (F C) Time), !, if-verbose (coq.say "Derivation" Name "on" T "took" Time), (C ==> chain T FS CS), std.append C CS CL. chain T [derive F _ _|FS] CL :- if-verbose (coq.say "Derivation" F "on" T "failed, continuing"), chain T FS CL. func toposort list derive -> list derive. toposort L SL :- std.findall (dep1 _ _) Deps, topo L Deps SL. func not-a-src list prop, derive ->. not-a-src Deps (derive A _ _) :- not(std.mem! Deps (dep1 A _)). :index (1) func tgt-is-not-in list derive, prop ->. tgt-is-not-in [] _. tgt-is-not-in [derive Tgt _ _|_] (dep1 _ Tgt) :- !, fail. tgt-is-not-in [_|L] D :- tgt-is-not-in L D. func topo list derive, list prop -> list derive. topo [] _ [] :- !. topo L Deps SL :- std.partition L (not-a-src Deps) LNoDeps Other, if (LNoDeps = []) (coq.error "derive: no topological order:" L Deps) true, std.filter Deps (tgt-is-not-in LNoDeps) NewDeps, topo Other NewDeps SOther, std.append LNoDeps SOther SL. func export? prop -> prop. export? (export M) (coq.env.export-module M). func indt-or-const gref ->. indt-or-const (indt _). indt-or-const (const _). func main gref -> list prop. main GR CL :- get-option "module" M, !, if (M = "") (coq.gref->id GR Mod) (Mod = M), if-verbose (coq.say "Starting module" Mod), coq.env.begin-module Mod none, main-derive GR tt CL, coq.env.end-module _. main GR CL :- main-derive GR ff CL. func main-derive gref, bool -> list prop. main-derive GR InModule CL :- get-option "recursive" tt, !, coq.env.dependencies GR _ AllDeps, coq.gref.set.elements AllDeps AllDepsL, std.filter AllDepsL indt-or-const Deps, main.aux InModule Deps [] CL1, (CL1 ==> main1 GR InModule CL2), std.append CL1 CL2 CL. main-derive GR InModule CL :- main1 GR InModule CL. :index (_ 1) func main.aux bool, list gref, list prop -> list prop. main.aux _ [] X X. main.aux InModule [GR|GRS] Acc CL :- ((pi X\get-option "only" X :- !, fail) ==> Acc ==> main-derive GR InModule CL1), main.aux InModule GRS {std.append CL1 Acc} CL. func validate-recursive prop -> derive. validate-recursive (derivation _ _ tt _) _ :- get-option "recursive" tt, !, coq.error "Synterp actions not supported in recursive derive.". validate-recursive (derivation _ _ _ R) R. func main1 gref, bool -> list prop. main1 GR InModule CL :- if (get-option "prefix" PFX) (Prefix = PFX) (if (InModule is ff) (Prefix is {coq.gref->id GR} ^ "_") (Prefix = "")), std.findall (derivation GR Prefix _ _) L, if (L = []) (coq.error "no derivation found, did you Import derive.std?") true, std.map L validate-recursive DL, validate-only GR DL, toposort DL SortedDL, chain GR SortedDL CL. func decl+main string, indt-decl ->. decl+main TypeName DS :- std.do! [ if (get-option "module" M) (if (M = "") (ModName = TypeName) (ModName = M), HasModule = tt) (HasModule = ff), if (HasModule = tt) (if-verbose (coq.say "Starting module" ModName), coq.env.begin-module ModName none) true, std.assert-ok! (coq.elaborate-indt-decl-skeleton DS D) "Inductive type declaration illtyped", if-verbose (coq.say "Declaring inductive" D), coq.env.add-indt D I, if-verbose (coq.say "Deriving"), main-derive (indt I) HasModule CL, if-verbose (coq.say "Done"), if (HasModule = tt) (coq.env.end-module _, decl+main.post TypeName I DS CL) check-no-no-alias ]. func check-no-no-alias. check-no-no-alias :- get-option "no_alias" tt, !, coq.error "The no_alias attribute only has an effect when a wrapper module is generated.". check-no-no-alias. func decl+main.post string, inductive, indt-decl -> list prop. decl+main.post TypeName I DS CL :- std.do! [ coq.env.indt I _ _ _ _ KS _, std.map KS (k\r\ r = indc k) KGRS, std.map KGRS coq.gref->id KNS, std.map KGRS (gr\r\ r = global gr) KTS, std.forall2 [TypeName|KNS] [global (indt I)|KTS] short-alias, coq.indt-decl->implicits DS IndImpls KsImpls, if (coq.any-implicit? IndImpls) (@global! ==> coq.arguments.set-implicit (indt I) [IndImpls]) true, std.forall2 KsImpls KS (i\k\ if (coq.any-implicit? i) (@global! ==> coq.arguments.set-implicit (indc k) [i]) true ), std.map-filter CL export? P, std.do! P, ]. func short-alias id, term ->. short-alias _ _ :- get-option "no_alias" tt, !. short-alias ID T :- @global! ==> coq.notation.add-abbreviation ID 0 T ff _. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/derive_hook.elpi000066400000000000000000000010511523041753400230230ustar00rootroot00000000000000/* Entry point for derive extensions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ pred derivation i:gref, i:string, o:bool, o:derive. pred export i:modpath. pred dep1 o:string, o:string. kind derive type. type derive string -> (func -> list (pred)) -> prop -> derive. % if a derivation fails it should end by calling stop, instead of coq.error, % so that derive can make the failure non fatal LPCIC-coq-elpi-eb449d7/apps/derive/elpi/derive_synterp.elpi000066400000000000000000000043141523041753400235740ustar00rootroot00000000000000/* Entry point for all derivations */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive { pred dep o:string, o:string. dep X Y :- dep1 X Y. dep X Y :- dep1 X Z, dep Z Y. func selected string ->. selected Name :- get-option "only" Map, !, Map ==> (get-option Name _; (get-option X _, dep X Name)), !. selected _. :index (_ 1) func chain string, list derive ->. chain _ []. chain T [derive Name _ _|FS] :- not(selected Name), !, chain T FS. chain T [derive _ _ AlreadyDone|FS] :- ((pi x\ stop x :- !, fail) ==> AlreadyDone), !, chain T FS. chain T [derive _ F _|FS] :- get-option "only" _, !, % request this one F _, chain T FS. chain T [derive _ F _|FS] :- % all are selected, we can fail ((pi x\ stop x :- !, fail) ==> F _), !, chain T FS. chain T [derive _ _ _|FS] :- chain T FS. func toposort list derive -> list derive. toposort L SL :- std.findall (dep1 _ _) Deps, topo L Deps SL. func not-a-src list prop, derive ->. not-a-src Deps (derive A _ _) :- not(std.mem! Deps (dep1 A _)). :index (1) func tgt-is-not-in list derive, prop ->. tgt-is-not-in [] _. tgt-is-not-in [derive Tgt _ _|_] (dep1 _ Tgt) :- !, fail. tgt-is-not-in [_|L] D :- tgt-is-not-in L D. func topo list derive, list prop -> list derive. topo [] _ [] :- !. topo L Deps SL :- std.partition L (not-a-src Deps) LNoDeps Other, if (LNoDeps = []) (coq.error "derive: no topological order:" L Deps) true, std.filter Deps (tgt-is-not-in LNoDeps) NewDeps, topo Other NewDeps SOther, std.append LNoDeps SOther SL. func main string ->. main TypeName :- get-option "module" M, !, if (M = "") (Mod = TypeName) (Mod = M), coq.env.begin-module Mod none, main-derive TypeName tt, coq.env.end-module _. main TypeName :- main-derive TypeName ff. func main-derive string, bool ->. main-derive TypeName InModule :- if (get-option "prefix" PFX) (Prefix = PFX) (if (InModule is ff) (Prefix is TypeName ^ "_") (Prefix = "")), std.findall (derivation TypeName Prefix _) L, std.map L (x\r\ x = derivation _ _ r) DL, toposort DL SortedDL, chain TypeName SortedDL. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/derive_synterp_hook.elpi000066400000000000000000000006451523041753400246170ustar00rootroot00000000000000/* Entry point for derive extensions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ pred derivation i:string, i:string, o:derive. pred export i:modpath. pred dep1 o:string, o:string. kind derive type. type derive string -> (func -> list (pred)) -> prop -> derive. LPCIC-coq-elpi-eb449d7/apps/derive/elpi/discriminate.elpi000066400000000000000000000026161523041753400232100ustar00rootroot00000000000000/* core of discriminate */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{ do! }. namespace ltac { % Tests if the command can be applied func discriminate? term, inductive -> list term, constructor, term, term. discriminate? Ty GR Args GRA A B :- do! [ whd Ty [] {{lib:@elpi.eq}} [T,A,B], whd T [] IT Args, whd A [] KA _, whd B [] KB _, coq.env.global (indt GR) IT, coq.env.global (indc GRA) KA, coq.env.global (indc GRB) KB, not(GRA = GRB) ]. % Does the job :functional :index (1) pred discriminate! i:term, i:term, o:term, i:inductive, i:list term, i:constructor, i:term, i:term. discriminate! H G PG GR Args GRA A B :- do! [ isK-db GRA IsKA, coq.env.global (indt GR) Ind, coq.mk-app IsKA Args IsKAArgs, coq.mk-app Ind Args IndT, coq.mk-app {{lib:elpi.derive.eq_f}} [IndT, {{lib:elpi.bool}},IsKAArgs,A,B,H] Eq_isKA_isKB, coq.mk-app {{lib:elpi.bool_discr}} [Eq_isKA_isKB, G] PG ]. func discriminate term, term, term -> term. discriminate H EqAB G PG :- if (discriminate? EqAB GR Args GRA A B) (discriminate! H G PG GR Args GRA A B) (coq.error "discriminate: the equation" {coq.term->string H} "of type" {coq.term->string EqAB} "is trivial at the top level"). } % vim:set ft=lprolog spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/dune000066400000000000000000000005511523041753400205340ustar00rootroot00000000000000(coq.theory (name elpi.apps.derive.elpi) (package rocq-elpi) (theories elpi)) (rule (target dummy.v) (deps (glob_files *.elpi)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (install (files (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/derive/elpi/))) (section lib_root) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eq.elpi000066400000000000000000000156031523041753400211420ustar00rootroot00000000000000/* Boolean comparison functions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, append}. namespace derive.eq { %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Fills in the matrix with the truth values :index (_ 1 1) func body term, list term, list term, % constructor, arguments and their types term, list term, list term % constructor, arguments and their types -> term. %result :name "derive.eq.body:begin" % Extension point (e.g. to skip a subterm) body K [] _ K [] _ R :- !, % no arguments, same constructor R = {{ true }}. body K [X] [T1] K [Y] [T2] R :- !, % special case to avoid ".. && true" eq-db T1 T2 F, coq.mk-app F [X,Y] R. body K [X|XS] [T1|TS1] K [Y|YS] [T2|TS2] R :- !, % compare X with Y eq-db T1 T2 F, coq.mk-app F [X,Y] RX, % compare XS with YS body K XS TS1 K YS TS2 RXS, R = {{ (lp:RX && lp:RXS)%bool }}. body _ _ _ _ _ _ R :- !, % outside the diagonal it is always false R = {{ false }}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Build the body :index (_ _ 1) func bo-idx prop, % eq-db clause for the current type (applied to params) term, % inductive type (applied to params) for the first argument term, % arity left for the first argument term, % inductive type (applied to params) for the second argument term, % arity left for the second argument int % accumulator to set Recno -> int, % Recno term, % Type of the term being built term. % Term buing built bo-idx C Ity1 (prod _ Src1 Tgt1) Ity2 (prod _ Src2 Tgt2) N M Rty R :- !, coq.name-suffix `i` 1 I1, coq.name-suffix `i` 2 I2, R = (fun I1 Src1 i\ fun I2 Src2 j\ Rrec i j), Rty = (prod I1 Src1 i\ prod I2 Src2 j\ Rtyrec i j), quantify-eq-db-idx C Crec, pi x y\ decl x `i` Src1 => decl y `j` Src2 => bo-idx Crec {coq.mk-app Ity1 [x]} (Tgt1 x) {coq.mk-app Ity2 [y]} (Tgt2 y) {calc (N + 2)} M (Rtyrec x y) (Rrec x y). bo-idx C Ity1 (sort _) Ity2 (sort _) N N Rty R :- !, Rty = {{ lp:Ity1 -> lp:Ity2 -> bool }}, R = {{ fun (x1 : lp:Ity1) (x2 : lp:Ity2) => lp:(Bo x1 x2) }}, pi x1 x2\ decl x1 `a` Ity1 => decl x2 `b` Ity2 => C => bo-matrix x1 Ity1 x2 Ity2 (Bo x1 x2). bo-idx C Ity1 X Ity2 Y N M Rty R :- whd1 X X1, whd1 Y Y1, !, bo-idx C Ity1 X1 Ity2 Y1 N M Rty R. func bo-matrix term, term, term, term -> term. bo-matrix X1 TyX1 X2 TyX2 R :- coq.build-match X1 TyX1 bo-ty (k1\ _\ a1\ ty1\ coq.build-match X2 TyX2 bo-ty (k2\ _\ a2\ ty2\ body k1 a1 ty1 k2 a2 ty2)) R. func bo-ty term, list term, list term -> term. bo-ty _ _ _ {{ bool }}. % Take in input all parameters and their comparison function %%%%%%%%%%%%%% func bo-param int, % Number of parameters, recursion fuel term, % Inductive type (applied to all parameters taken in input) term % Inductive type arity (parameters + indexes) -> term. % Comparison function bo-param 0 Ity Arity R :- coq.safe-dest-app Ity (global (indt GR)) _, coq.env.recursive? GR, !, Boidx = fix `f` Recno Rty Rbo, (pi f\ decl f `f` Rty => % We build the body (assuming the indexes are *not* the same) bo-idx (eq-db Ity Ity f :- []) Ity Arity Ity Arity 0 Recno Rty (Rbo f)), % We then pass to the body the terms with their indexes (that are the same) apply-idx Ity Arity Boidx R. bo-param 0 Ity Arity R :- !, bo-idx (pi f\eq-db Ity Ity f :- fail) Ity Arity Ity Arity 0 _ _ Boidx, apply-idx Ity Arity Boidx R. bo-param N Ity (prod _ Sty Rty) R :- !, M is N - 1, R = {{ fun (A : lp:Sty) (eqA : A -> A -> bool) => lp:(Bo A eqA) }}, pi a f\ sigma ItyA\ coq.mk-app Ity [a] ItyA, (eq-db a a f :- !) => decl a `a` Sty => decl f `f` {{ lp:a -> lp:a -> bool }} => bo-param M ItyA (Rty a) (Bo a f). bo-param N Ity X R :- whd1 X X1, !, bo-param N Ity X1 R. func apply-idx term, % Ity applied to parameters term, % Arity remaining after parameters term % Bo comparison with potentially different indexes as per bo-idx -> term. % fun idx1 idx2 (x1 : Ity ixd1) (x2 : Ity idx2) => Bo idx1 x1 idx2 x2 apply-idx _ (sort _) Bo Bo :- !. % no indexes -> avoid eta expansion of Bo apply-idx Ity Arity Bo R :- apply-idx.aux Ity Arity Bo R. apply-idx.aux Ity (prod N S T) Bo (fun N S x\ R x) :- !, pi x\ apply-idx.aux {coq.mk-app Ity [x]} (T x) {coq.mk-app Bo [x,x]} (R x). apply-idx.aux Ity (sort _) Bo (fun `x1` Ity x1\ fun `x2` Ity x2\ Bo1 x1 x2) :- !, pi x1 x2\ coq.mk-app Bo [x1,x2] (Bo1 x1 x2). func apply-idx.aux term, term, term -> term. apply-idx.aux Ity X Bo R :- whd1 X X1, !, apply-idx.aux Ity X1 Bo R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Builds a clause for eq-db that fits the inductive arity: % - a premise per type parameter % - a simple argument for each index % Also used to load the context under the fix :index (1) func quantify-eq-db-idx prop -> prop. quantify-eq-db-idx (pi x y\ C x y) (pi x y\ C1 x y) :- pi x y\ quantify-eq-db-idx (C x y) (C1 x y). quantify-eq-db-idx (eq-db A B C :- L) (pi x y\ eq-db (A1 x) (B1 y) (C1 x y) :- L) :- pi x y\ coq.mk-app A [x] (A1 x), coq.mk-app B [y] (B1 y), coq.mk-app C [x,y] (C1 x y). func quantify-eq-db-param prop -> prop. quantify-eq-db-param (pi x f\ C x f) (pi x f\ C1 x f) :- pi x f\ quantify-eq-db-param (C x f) (C1 x f). quantify-eq-db-param (eq-db A B C :- (L : list prop)) (pi x f\ eq-db (A1 x) (B1 x) (C1 x f) :- (L1 x f : list prop)) :- pi x f\ append [eq-db x x f] L (L1 x f), coq.mk-app A [x] (A1 x), coq.mk-app B [x] (B1 x), coq.mk-app C [x,f] (C1 x f). func mk-clause int, term, prop -> prop. mk-clause Lno (prod _ _ Tx) C R :- Lno > 0, !, Lno1 is Lno - 1, quantify-eq-db-param C C1, pi x\ mk-clause Lno1 (Tx x) C1 R. mk-clause 0 (prod _ _ Tx) C R :- !, quantify-eq-db-idx C C1, pi x\ mk-clause 0 (Tx x) C1 R. mk-clause 0 (sort _) C C :- !. mk-clause N T A B :- whd1 T T1, !, mk-clause N T1 A B. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main inductive, string -> list prop. main GR Name [Clause1, Clause2] :- do! [ coq.env.indt GR Ind Lno Luno Arity _ _, assert! (Ind = tt) "derive.eq: Coinductive types are not supported", assert! (Lno = Luno) "derive.eq: Non-uniform parameters not supported", % we build the comparison function bo-param Lno (global (indt GR)) Arity RSkel, std.assert-ok! (coq.elaborate-skeleton RSkel RT R) "derive.eq generates illtyped term", coq.env.add-const Name R RT _ Cmp, % we register it as a clause mk-clause Lno Arity (eq-db (global (indt GR)) (global (indt GR)) (global (const Cmp)) :- [!]) Clause1, coq.elpi.accumulate _ "derive.eq.db" (clause _ (before "eq-db:fail") Clause1), Clause2 = eq-for GR Cmp, coq.elpi.accumulate _ "derive.eq.db" (clause _ _ Clause2), ]. } % vim: set spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqK.elpi000066400000000000000000000074321523041753400212560ustar00rootroot00000000000000/* eq.axiom for each constructor */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, last, map2}. namespace derive.eqK { % links a term x, a comparison cmp, and H : eq_axiom cmp x func axiom-db term -> term, term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % case split on the second constructor % same constructor, we use the bcongr lemma func branch term, term, term, list term, list term -> term. branch K1 K2 _ V _ R :- coq.safe-dest-app K1 (global (indc GR)) Args1, coq.safe-dest-app K2 (global (indc GR)) LArgs2, !, do! [ bcongr-db GR Lem, call Lem Args1 LArgs2 V R, ]. % different constructor, ReflectF + discriminate branch K1 K2 T V _ R :- coq.safe-dest-app K2 _ _, !, do! [ coq.mk-app K2 V K2A, Eq = {{ lib:@elpi.eq lp:T lp:K1 lp:K2A }}, R = {{ lib:@elpi.ReflectF lp:Eq (fun abs : lp:Eq => lp:(Bo abs)) }}, (pi abs\ ltac.discriminate abs Eq {{ lib:elpi.False }} (Bo abs)), ]. func call term, list term, list term, list term -> term. call X [] [] [] X. call X [P|P1] [_|Q1] V R :- coq.mk-app X [P] XP, call XP P1 Q1 V R. call X [A|AS] [] [B|BS] R :- if (axiom-db A F P) true (M is "derive.eqK: no proved comparison for " ^ {coq.term->string A}, stop M), coq.mk-app X [A,B,{coq.mk-app F [A,B]},{coq.mk-app P [B]}] XAB, call XAB AS [] BS R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % bind the arguments of the constructor func args term, term -> term. args (prod _ S T) K R :- !, std.assert! (eq-db S S F) "derive.eqK: cannot find an eq test for constructor argument", R = (fun `x` S x\ fun `h` {{ lib:elpi.derive.eq_axiom_at lp:S lp:F lp:x }} (Bo x)), @pi-decl `x` S x\ @pi-decl `h` {{ lib:elpi.derive.eq_axiom_at lp:S lp:F lp:x }} h\ axiom-db x F h => args (T x) {coq.mk-app K [x]} (Bo x h). args T K (fun `x` T R) :- (T = global (indt _) ; T = app[global (indt _)|_]), !, eq-db T T Cmp, @pi-decl `x` T x\ coq.build-match x T (oty Cmp K) (branch K) (R x). args T K R :- whd1 T T1, !, args T1 K R. args T _ _ :- M is "derive.eqK: cannot find an eq test for " ^ {coq.term->string T}, stop M. func oty term, term, term, list term, list term -> term. oty Cmp K _ V VT R :- last V X, last VT T, R = {{ lib:elpi.derive.eq_axiom_on lp:T lp:Cmp lp:K lp:X }}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % For each parameter take in input a comparison function func param int, term, term -> term. param 0 T K R :- !, args T K R. param L (prod N S T) K R :- L > 0, !, R = (fun N S a\ fun `f` {{ lp:a -> lp:a -> bool }} (Bo a)), M is L - 1, @pi-decl N S a\ @pi-decl `f` {{ lp:a -> lp:a -> bool }} f\ (eq-db a a f :- !) => param M (T a) {coq.mk-app K [a]} (Bo a f). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % for each constructor we generate the case split lemma func main-constructor int, string, constructor, term -> prop. main-constructor Lno Prefix K Kty C :- do! [ assert! (bcongr-db K _) "derive.eqK: run derive.bcongr first", % generate the K-split lemma param Lno Kty (global (indc K)) RSkel, % add to the environment std.assert-ok! (coq.elaborate-skeleton RSkel RT R) "derive.eqK generates illtyped term", coq.gref->id (indc K) Kname, Name is Prefix ^ Kname, coq.env.add-const Name R RT @opaque! EqK, % add the clause to the db C = (eqK-db K (global (const EqK)) :- !), coq.elpi.accumulate _ "derive.eqK.db" (clause _ (before "eqK-db:fail") C) ]. func main inductive, string -> list prop. main GR Prefix Clauses :- coq.env.indt GR _ Lno _ _ Kns Ktys, map2 Kns Ktys (main-constructor Lno Prefix) Clauses. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqOK.elpi000066400000000000000000000030631523041753400213710ustar00rootroot00000000000000/* constant elimination */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!}. namespace derive.eqOK { pred body i:int, i:term, i:term, i:term, o:term. body N (prod NA A a\ prod NF (A_eq a) (B a)) E TisT (fun NA A a\ fun NF (A_eq a) f\ fun `p` (PA a f) (B1 a f)) :- N > 0, !, M is N - 1, @pi-decl NA A a\ @pi-decl NF (A_eq a) f\ (PA a f = {{ lib:elpi.derive.eq_axiom lp:a lp:f }}, @pi-decl `p` (PA a f) p\ body M (B a f) {coq.mk-app E [a,f]} {coq.mk-app TisT [a, {{lib:elpi.derive.eq_axiom_at lp:a lp:f}}, p]} (B1 a f p)). % done body 0 (prod N S x\ prod _ _ _) E TisT (fun N S R) :- @pi-decl N S x\ R x = {{ lp:E lp:x (lp:TisT lp:x) }}. func main inductive, string -> list prop. main GR O [eqOK-done GR] :- do! [ T = global (indt GR), coq.env.indt GR _ Lno _ _ _ _, assert! (eqcorrect-db (indt GR) E) "derive.eqOK: use derive.eqcorrect before", coq.env.typeof {coq.term->gref E} ETy, assert! (reali T IsT) "derive.eqOK: use derive.param1 before", assert! (param1-inhab-db IsT TisT) "derive.eqOK: use derive.param1.inhab before", body Lno ETy E TisT NewBo, %coq.say {coq.term->string NewBo}, std.assert-ok! (coq.typecheck NewBo NewTy) "derive.eqOK generates illtyped term", coq.env.add-const O NewBo NewTy @opaque! _, coq.elpi.accumulate _ "derive.eqOK.db" (clause _ _ (eqOK-done GR)), ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqType.elpi000066400000000000000000000152501523041753400220020ustar00rootroot00000000000000/* eqType representation and validation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive.eqType.ast { func translate-indt inductive -> eqb.eqType, diagnostic. translate-indt I O D :- coq.env.indt-decl I Decl, coq.env.indt I _ _ _ _ KN _, translate-param Decl I KN O D. func translate-param indt-decl, inductive, list constructor -> eqb.eqType, diagnostic. translate-param (parameter ID _ Ty F) I KS (eqb.type-param F1) D :- whd Ty [] {{ Type }} _, !, @pi-parameter ID Ty x\ pi y\ (term->trm x y ok :- !) => translate-param (F x) I KS (F1 y) D. translate-param (parameter ID _ Ty F) I KS (eqb.value-param Ty1 F1) D :- term->trm Ty Ty1 ok, !, @pi-parameter ID Ty x\ pi y\ (term->trm x y ok :- !) => translate-param (F x) I KS (F1 y) D. translate-param (parameter ID _ _ _) _ _ _ (error S) :- !, S is "unsupported parameter " ^ ID. translate-param (inductive ID tt (arity (sort S)) F) I KS (eqb.inductive I F1) D :- !, @pi-inductive ID (arity (sort S)) x\ pi y\ (term->trm x y ok :- !) => translate-constructors (F x) KS (F1 y) D. translate-param (record _ _ _ F) I [K] (eqb.inductive I (y\ [eqb.constructor K (F1 y)])) D :- !, pi y\ (self y :- !) => translate-record-constructor F (F1 y) D. translate-param _ _ _ _ (error S) :- S is "unsupported inductive arity". :index (1) func translate-constructors list indc-decl, list constructor -> list eqb.constructor, diagnostic. translate-constructors [] [] [] ok. translate-constructors [constructor _ A|KS] [K|KK] [eqb.constructor K Args|KS1] D :- std.do-ok! D [ translate-arguments {coq.arity->term A} Args, translate-constructors KS KK KS1, ]. func translate-arguments term -> eqb.arguments, diagnostic. translate-arguments T T2 D :- whd1 T T1, !, translate-arguments T1 T2 D. translate-arguments (prod N Ty F) (eqb.irrelevant Ty1 F1) D :- not(pi x\ occurs x (F x)), irrelevant? Ty Ty1 ok, !, @pi-decl N Ty x\ translate-arguments (F x) F1 D. translate-arguments (prod N Ty F) (eqb.regular Ty1 F1) D :- not(pi x\ occurs x (F x)), !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-decl N Ty x\ translate-arguments (F x) F1 d), ]. translate-arguments (prod N Ty F) (eqb.dependent Ty1 F1) D :- !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-decl N Ty x\ pi y\ term->trm x y ok => translate-arguments (F x) (F1 y) d), ]. translate-arguments Ty (eqb.stop Ty1) D :- name Ty, term->trm Ty Ty1 D, !. translate-arguments (app [N|_] as Ty) (eqb.stop Ty1) D :- name N, term->trm Ty Ty1 D, !. translate-arguments T _ (error S) :- S is "unsupported argument " ^ {coq.term->string T}. func translate-record-constructor record-decl -> eqb.arguments, diagnostic. translate-record-constructor end-record (eqb.stop X) ok :- self X. translate-record-constructor (field _ ID Ty F) (eqb.irrelevant Ty1 F1) D :- not(pi x\ occurs x (F x)), irrelevant? Ty Ty1 ok, !, @pi-parameter ID Ty x\ translate-record-constructor (F x) F1 D. translate-record-constructor (field _ ID Ty F) (eqb.regular Ty1 F1) D :- not(pi x\ occurs x (F x)), !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-parameter ID Ty x\ translate-record-constructor (F x) F1 d), ]. translate-record-constructor (field _ ID Ty F) (eqb.dependent Ty1 F1) D :- !, std.do-ok! D [ term->trm Ty Ty1, (d\ @pi-parameter ID Ty x\ pi y\ term->trm x y ok => translate-record-constructor (F x) (F1 y) d), ]. translate-record-constructor (field _ ID _ _) _ (error S) :- S is "unsupported record field " ^ ID. func self -> eqb.trm. func valid eqb.trm -> diagnostic. valid (eqb.global GR) ok :- eqType GR _, !. valid (eqb.app GR A Args) D :- eqType GR EQT, !, valid-eqType EQT [A|Args] D. valid T (error S) :- S is "not an eqType: " ^ {std.any->string T}. :index (1) func valid-eqType eqb.eqType, list eqb.trm -> diagnostic. valid-eqType (eqb.inductive _ _) [] ok. valid-eqType (eqb.type-param F) [T|TS] D :- std.do-ok! D [ valid T, (d\ pi x\ valid-eqType (F x) TS d), ]. valid-eqType (eqb.value-param _ F) [_|TS] D :- std.do-ok! D [ (d\ pi x\ valid-eqType (F x) TS d), ]. pred irrelevant? i:term, o:eqb.trm, o:diagnostic. irrelevant? (app [{{ @eq }}, global EqType, A, B]) (eqb.app EQ EQTYPE [A1,B1]) D :- std.do-ok! D [ std.lift-ok (eqType EqType _) "Not an eqType", %eqb-for Bool Bool _, std.lift-ok ({{ @eq }} = global EQ) "", term->trm (global EqType) EQTYPE, term->trm A A1, term->trm B B1, ]. irrelevant? T R D :- whd1 T T1, irrelevant? T1 R D. func term->trm term -> eqb.trm, diagnostic. term->trm (global GR) (eqb.global GR) ok :- !. term->trm (app [global GRF,A|As]) (eqb.app GRF A1 As1) D :- !, std.do-ok! D [ term->trm A A1, map-ok! As term->trm As1, ]. term->trm {{ lp:A -> lp:B }} (eqb.app {{:gref lib:elpi.derive.arrow }} A1 [B1]) D :- !, std.do-ok! D [ term->trm A A1, term->trm B B1, ]. term->trm (app [N|As]) (eqb.app {{:gref lib:elpi.derive.apply }} N1 As1) D :- name N, !, std.do-ok! D [ term->trm N N1, map-ok! As term->trm As1, ]. term->trm X _ (error S) :- S is "not an applicative term: " ^ {coq.term->string X}. func map-ok! list A, (func A -> B, diagnostic) -> list B, diagnostic. map-ok! [] _ [] ok. map-ok! [X|XS] F [Y|YS] D :- F X Y D1, if (D1 = ok) (map-ok! XS F YS D) (D = D1). func validate-eqType eqb.eqType -> diagnostic. validate-eqType (eqb.type-param F) D :- pi x\ (valid x ok :- !) => validate-eqType (F x) D. validate-eqType (eqb.value-param _ F) D :- pi x\ validate-eqType (F x) D. validate-eqType (eqb.inductive _ F) D :- pi x\ (valid x ok :- !) => validate-constructors (F x) D. func validate-constructors list eqb.constructor -> diagnostic. validate-constructors [] ok. validate-constructors [eqb.constructor _ Args|Ks] D :- std.do-ok! D [ validate-arguments Args, validate-constructors Ks ]. func validate-arguments eqb.arguments -> diagnostic. validate-arguments (eqb.stop _) ok. validate-arguments (eqb.regular T Args) D :- std.do-ok! D [ valid T, validate-arguments Args, ]. validate-arguments (eqb.irrelevant _ Args) D :- validate-arguments Args D. validate-arguments (eqb.dependent T Args) D :- std.do-ok! D [ valid T, (d\ pi x\ validate-arguments (Args x) d), ]. func main inductive -> list prop. main I [C] :- std.assert-ok! (translate-indt I EQT) "derive.eqType.ast: translate", std.assert-ok! (validate-eqType EQT) "derive.eqType.ast: validate", C = (eqType (indt I) EQT), coq.elpi.accumulate _ "derive.eqType.db" (clause _ _ C). } namespace feqb { func trm->term eqb.trm -> term. trm->term (eqb.global GR) (global GR) :- !. trm->term (eqb.app GR A AS) (app[global GR,A1|AS1]) :- !, trm->term A A1, std.map AS trm->term AS1. trm->term T _ :- coq.error "cannot translate trm" T "to term, did you forget to assume feqb.trm->term ?". } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqb.elpi000066400000000000000000000244671523041753400213140ustar00rootroot00000000000000/* equality test generation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. func derive.eqb.main gref, string -> list prop. derive.eqb.main (indt I) Prefix CL :- std.do! [ std.assert! (eqType (indt I) FI) "this inductive is not supported", derive.eqb.eqbf.main FI FI [] [] R, std.assert-ok! (coq.typecheck R Rty) "derive.eqbf generates illtyped term", Name is Prefix ^ "eqb_fields", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R Rty ff C, EQBF = (global (const C) : term), derive.eqb.eqb.main FI FI [] [] EQBF R1Skel, std.assert-ok! (coq.elaborate-skeleton R1Skel R1ty R1) "derive.eqb generates illtyped term", % need elaborate for prim record Name1 is Prefix ^ "eqb", coq.ensure-fresh-global-id Name1 FName1, coq.env.add-const FName1 R1 R1ty ff C1, EQB = (global (const C1) : term), % populate dbs derive.eqb.eqbf.do-clause FI FI [] [] EQBF [] CL1, derive.eqb.eqb.do-clause FI FI [] [] EQB [] CL2, CL = [CL1,CL2,eqb-done (indt I)], std.forall CL (x\ coq.elpi.accumulate _ "derive.eqb.db" (clause _ _ x)), ]. derive.eqb.main (const C) Prefix CL :- std.do! [ coq.env.const C (some T) _, std.assert! (eqb-for T T EQB) "cannot derive eqb", Name is Prefix ^ "eqb", coq.ensure-fresh-global-id Name FName, X = (global (const C) : term), coq.env.add-const FName EQB {{ lp:X -> lp:X -> bool }} @transparent! EQBC, CL = [eqb-done (const C), eqb-for (global (const C)) (global (const C)) (global (const EQBC))], std.forall CL (x\ coq.elpi.accumulate _ "derive.eqb.db" (clause _ (before "eqb-for:whd") x)), ]. % derive.eqb.main (indc _) _ _ :- stop "eqrive.eqb cannot be called on constructors". namespace derive.eqb.eqb { % ----------------------------------------------------------------------------- func main eqb.eqType, eqb.eqType, list term, list term, term -> term. main (eqb.type-param FI) (eqb.type-param FJ) PI PJ EF {{ fun (x : Type) (eqx : x -> x -> bool) => lp:(R x eqx) }} :- @pi-trm `x` {{ Type }} y\x\ @pi-decl `eqx` {{ lp:x -> lp:x -> bool }} eqx\ main (FI y) (FJ y) [x|PI] [x|PJ] {coq.mk-app EF [x,eqx]} (R x eqx). main (eqb.value-param TYI FI) (eqb.value-param TYJ FJ) PI PJ EF {{ fun (x : lp:TI) (y : lp:TJ) => lp:(R x y) }} :- feqb.trm->term TYI TI, feqb.trm->term TYJ TJ, @pi-trm `x` TI xx\x\ @pi-trm `y` TJ yy\y\ main (FI xx) (FJ yy) [x|PI] [y|PJ] {coq.mk-app EF [x,y]} (R x y). main (eqb.inductive Ind _) (eqb.inductive Ind _) PI PJ EF {{ fix rec (x1 : lp:I) (x2 : lp:J) {struct x1} : bool := lp:(R rec x1 x2) }} :- coq.env.recursive? Ind, !, coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J, @pi-decl `rec` {{ lp:I -> lp:J -> bool }} rec\ @pi-decl `x1` I x1\ @pi-decl `x2` J x2\ do-match x1 I x2 J {coq.mk-app EF [rec]} (R rec x1 x2). main (eqb.inductive Ind _) (eqb.inductive Ind _) PI PJ EF {{ fun (x1 : lp:I) (x2 : lp:J) => lp:(R x1 x2) }} :- coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J, @pi-decl `x1` I x1\ @pi-decl `x2` J x2\ do-match x1 I x2 J {coq.mk-app EF [{{fun (_ : lp:I) (_ : lp:J) => true}}]} (R x1 x2). % ----------------------------------------------------------------------------- func do-match term, term, term, term, term -> term. do-match X1 I X2 J F R :- coq.build-match X1 I (_\_\_\r\ r = {{ bool }}) (do-branch X2 J F) R. % ----------------------------------------------------------------------------- func do-branch term, term, term, term, term, list term, list term -> term. do-branch X2 J F K KTY Vars _ {{ @eqb_core_defs.eqb_body _ _ _ _ lp:FLDP lp:F lp:TAG lp:X lp:X2 }} :- std.do! [ coq.safe-dest-app KTY (global (indt I)) ParamsI, std.assert! (fields-for I _ FLD _ _) "derive.eqb: run derive.fields before", coq.safe-dest-app J _ ParamsJ, coq.mk-app (global (const FLD)) ParamsJ FLDP, std.assert! (tag-for I T) "derive.eqb: run derive.tag before", coq.mk-app (global (const T)) {std.append ParamsI [{coq.mk-app K Vars}]} TAG, coq.safe-dest-app K (global (indc KI)) _, std.assert! (box-for KI _ BK) "derive.eqb: run derive.fields before", coq.mk-app (global (indc BK)) {std.append ParamsI Vars} X, ]. % ----------------------------------------------------------------------------- % example: eqb-for {{ list lp:A }} {{ @list_eqb lp:A lp:F }} :- eqb-for A F. :index (1) func do-clause eqb.eqType, eqb.eqType, list term, list term, term, list prop -> prop. do-clause (eqb.type-param AI) (eqb.type-param AJ) PI PJ F Todo (pi a ea\ C a ea) :- !, pi x a ea\ do-clause (AI x) (AJ x) [a|PI] [a|PJ] {coq.mk-app F [a,ea]} [eqb-for a a ea|Todo] (C a ea). do-clause (eqb.value-param _ AI) (eqb.value-param _ AJ) PI PJ F Todo (pi a b\ C a b) :- !, pi x a b\ do-clause (AI x) (AJ x) [a|PI] [b|PJ] {coq.mk-app F [a,b]} Todo (C a b). do-clause (eqb.inductive Ind _) (eqb.inductive Ind _) PI PJ F Todo (eqb-for I J F :- Todo) :- coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J. } namespace derive.eqb.eqbf { % ----------------------------------------------------------------------------- :index (1 1) func main eqb.eqType, eqb.eqType, list term, list term -> term. main (eqb.type-param FI) (eqb.type-param FJ) PI PJ {{ fun (p : Type) (eqp : p -> p -> bool) => lp:(R p eqp) }} :- @pi-trm `P` {{ Type }} x\p\ @pi-decl `eqP` {{ lp:p -> lp:p -> bool }} eqP\ eqb-for p p eqP => main (FI x) (FJ x) [p|PI] [p|PJ] (R p eqP). main (eqb.value-param TYI FI) (eqb.value-param TYJ FJ) PI PJ {{ fun (x y : lp:T) => lp:(R x y) }} :- feqb.trm->term TYI TI, feqb.trm->term TYJ TJ, @pi-trm `P` TI xx\x\ @pi-trm `P` TJ yy\y\ main (FI xx) (FJ yy) [x|PI] [y|PJ] (R x y). main (eqb.inductive Ind F) (eqb.inductive Ind G) PI PJ {{ fun (rec : lp:I -> lp:J -> bool) (x : positive) => lp:(R rec x) }} :- std.do! [ std.rev PI ParamsI, std.rev PJ ParamsJ, coq.mk-app (global (indt Ind)) ParamsI I, coq.mk-app (global (indt Ind)) ParamsJ J, std.assert! (fields-for Ind F_t _ _ _) "derive.eqb: run derive.fields before", coq.mk-app (global (const F_t)) ParamsI Fields_t_I, coq.mk-app (global (const F_t)) ParamsJ Fields_t_J, (@pi-decl `rec` {{ lp:I -> lp:J -> bool }} rec\ @pi-decl `x` {{ positive }} x\ eqb-for I J rec => pi i j\ (feqb.trm->term i I :- !) => (feqb.trm->term j J :- !) => derive.fields.splay-over-positive x {std.zip (F i) (G j)} (rty Fields_t_I Fields_t_J) {{ fun (_ : lib:elpi.derive.unit) (_ : lib:elpi.derive.unit) => true }} (fields ParamsI ParamsJ) (R rec x)), ]. func rty term, term, term -> term. rty Fields_t_I Fields_t_J X {{ lp:Fields_t_I lp:X -> lp:Fields_t_J lp:X -> bool }}. % ----------------------------------------------------------------------------- func fields list term, list term, pair eqb.constructor eqb.constructor -> term. fields ParamsI ParamsJ (pr (eqb.constructor K (eqb.stop _)) (eqb.constructor K (eqb.stop _))) {{ fun (a : lp:BoxTy1) (b : lp:BoxTy2) => true }} :- !, std.do! [ std.assert! (box-for K IB _) "derive.eqb: run derive.fields before", coq.mk-app (global (indt IB)) ParamsI BoxTy1, coq.mk-app (global (indt IB)) ParamsJ BoxTy2, ]. fields ParamsI ParamsJ (pr (eqb.constructor K Args) (eqb.constructor K Args2)) {{ fun (a : lp:BoxTy1) (b : lp:BoxTy2) => lp:(R a b) }} :- std.do! [ std.assert! (box-for K IB _) "derive.eqb: run derive.fields before", coq.mk-app (global (indt IB)) ParamsI BoxTy1, coq.mk-app (global (indt IB)) ParamsJ BoxTy2, @pi-decl `a` BoxTy a\ @pi-decl `b` BoxTy b\ coq.build-match a BoxTy1 fields.rty1 (fields.branch1 b BoxTy2 Args Args2) (R a b) ]. func fields.rty1 term, list term, list term -> term. fields.rty1 _ _ _ {{ bool }}. :index (1) func fields.branch1 term, term, eqb.arguments, eqb.arguments, term, term, list term, list term -> term. fields.branch1 B BoxTy2 Args Args2 _ _ VarsA _ R :- coq.build-match B BoxTy2 fields.rty2 (fields.branch2 Args Args2 VarsA) R. func fields.rty2 term, list term, list term -> term. fields.rty2 _ _ _ {{ bool }}. :index (1) func fields.branch2 eqb.arguments, eqb.arguments, list term, term, term, list term, list term -> term. fields.branch2 Args Args2 VarsA _ _ VarsB _ R :- fields.aux Args Args2 VarsA VarsB R. func mk-eqb-for term, term -> term. mk-eqb-for T1 T2 R :- eqb-for T1 T2 R, !. mk-eqb-for T1 _ _ :- Msg is "derive.eqb: missing boolean equality for " ^ {coq.term->string T1} ^ ", maybe use derive.eqb first", stop Msg. func fields.aux eqb.arguments, eqb.arguments, list term, list term -> term. fields.aux (eqb.dependent TYX FX) (eqb.dependent TYY FY) [X|XS] [Y|YS] {{ lib:elpi.andb (lp:EQB lp:X lp:Y) lp:R1 }} :- feqb.trm->term TYX TX, feqb.trm->term TYY TY, mk-eqb-for TX TY EQB, (@pi-decl `p` TX n\ pi a\ (feqb.trm->term a n :- !) ==> @pi-decl `p` TY m\ pi b\ (feqb.trm->term b m :- !) ==> fields.aux (FX a) (FY b) XS YS (R n m)), R1 = R X Y. fields.aux (eqb.regular TYX FX) (eqb.regular TYY FY) [X|XS] [Y|YS] {{ lib:elpi.andb (lp:EQB lp:X lp:Y) lp:R }} :- feqb.trm->term TYX TX, feqb.trm->term TYY TY, mk-eqb-for TX TY EQB, fields.aux FX FY XS YS R. fields.aux (eqb.irrelevant _ FX) (eqb.irrelevant _ FY) [_|XS] [_|YS] R :- fields.aux FX FY XS YS R. fields.aux (eqb.stop _) (eqb.stop _) [] [] {{ true }}. % ----------------------------------------------------------------------------- % example: % eqb-fields {{ list lp:A }} {{ @list_eqb_fields lp:A lp:EA lp:ELA }} :- % eqb-for A EA, eqb-for {{ list lp:A }} ELA. func do-clause eqb.eqType, eqb.eqType, list term, list term, term, list prop -> prop. do-clause (eqb.type-param AI) (eqb.type-param AJ) PI PJ F Todo (pi a ea\ C a ea) :- !, pi x a ea\ do-clause (AI x) (AJ x) [a|PI] [a|PJ] {coq.mk-app F [a,ea]} [eqb-for a a ea|Todo] (C a ea). do-clause (eqb.value-param _ AI) (eqb.value-param _ AJ) PI PJ F Todo (pi a b\ C a b) :- !, pi x a b\ do-clause (AI x) (AJ x) [a|PI] [b|PJ] {coq.mk-app F [a,b]} Todo (C a b). do-clause (eqb.inductive Ind _) (eqb.inductive Ind _) PI PJ F Todo (pi ela\ eqb-fields I J (F1 ela) :- [C ela|Todo]) :- !, coq.mk-app (global (indt Ind)) {std.rev PI} I, coq.mk-app (global (indt Ind)) {std.rev PJ} J, pi ela\ (coq.mk-app F [ela] (F1 ela), C ela = eqb-for I J ela). } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqbOK.elpi000066400000000000000000000075351523041753400215430ustar00rootroot00000000000000/* equality test soundness proof */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ func feqb.trm->term eqb.trm -> term. macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. namespace derive.eqbOK { :index (1) func add-reflect eqb.eqType, term, term -> term. add-reflect (eqb.type-param F) Correct Refl {{ fun (a : lp:Type) (eqA: a -> a -> bool) (heqA : lp:(HeqA a eqA)) => lp:(R a eqA heqA) }} :- Type = sort (typ {coq.univ.new}), HeqA = (a\eqA\ {{ forall x1 x2 : lp:a, lib:elpi.reflect (@eq lp:a x1 x2) (lp:eqA x1 x2) }}), @pi-trm `a` Type aa\a\ @pi-decl `eqA` {{ lp:a -> lp:a -> bool }} eqA\ @pi-decl `heqA` (HeqA a eqA) heqA\ add-reflect (F aa) {{lp:Correct lp:a lp:eqA (fun (a1 a2 : lp:a) => @elimT (@eq lp:a a1 a2) (lp:eqA a1 a2) (lp:heqA a1 a2))}} {{lp:Refl lp:a lp:eqA (fun (a1: lp:a) => @introT (@eq lp:a a1 a1) (lp:eqA a1 a1) (lp:heqA a1 a1) (@refl_equal lp:a a1))}} (R a eqA heqA). add-reflect (eqb.value-param TY F) Correct Refl {{ fun x : lp:Ty => lp:(R x) }} :- feqb.trm->term TY Ty, @pi-trm `x` Ty xx\x\ add-reflect (F xx) {{lp:Correct lp:x}} {{lp:Refl lp:x}} (R x). add-reflect (eqb.inductive _ _) Correct Refl {{iffP2 lp:Correct lp:Refl}}. pred add-sumbool i:eqb.eqType, i:term, o:term. add-sumbool (eqb.type-param F) Reflect {{ fun (a : lp:Type) (heqA : lp:(HeqA a)) => lp:(R a heqA) }} :- Type = sort (typ {coq.univ.new}), HeqA = (a\ {{ forall x1 x2 : lp:a, { @eq lp:a x1 x2 } + { ~ (@eq lp:a x1 x2) } }}), @pi-trm `a` Type aa\a\ @pi-decl `heqA` (HeqA a) heqA\ add-sumbool (F aa) {{lp:Reflect lp:a (eqb_of_dec lp:a lp:heqA) (dec_reflect lp:a lp:heqA) }} (R a heqA). add-sumbool (eqb.value-param TY F) Reflect {{ fun x : lp:Ty => lp:(R x) }} :- feqb.trm->term TY Ty, @pi-trm `x` Ty xx\x\ add-sumbool (F xx) {{lp:Reflect lp:x}} (R x). add-sumbool (eqb.inductive _ _) Reflect {{reflect_dec _ _ lp:Reflect}}. func main gref, string -> list prop. main (indt I) Prefix [CL] :- std.do! [ std.assert! (eqType (indt I) FI) "this inductive is not supported", std.assert! (eqcorrect-for (indt I) Correct Refl) "run eqbcorrect before", add-reflect FI (global (const Correct)) (global (const Refl)) Breflect, std.assert-ok! (coq.typecheck Breflect Treflect) "eqbOK generates illtyped term", coq.ensure-fresh-global-id (Prefix ^ "eqb_OK") Namerf, coq.env.add-const Namerf Breflect Treflect @opaque! Reflect, add-sumbool FI (global (const Reflect)) Breflect_sb, std.assert-ok! (coq.typecheck Breflect_sb Treflect_sb) "eqbOK generates illtyped term", coq.ensure-fresh-global-id (Prefix ^ "eqb_OK_sumbool") Namerf_sb, coq.env.add-const Namerf_sb Breflect_sb Treflect_sb @opaque! Reflect_sb, CL = eqbok-for (indt I) Reflect, coq.elpi.accumulate _ "derive.eqbOK.db" (clause _ _ CL), coq.register (const Reflect_sb) (coq.register.scheme (indt I) coq.register.scheme.eq_dec), ]. main (const C) Prefix [CL] :- std.do! [ std.assert! (eqb-for (global (const C)) (global (const C)) F) "run eqb before", std.assert! (eqcorrect-for (const C) Correct Refl) "run eqbcorrect before", add-reflect (eqb.inductive _ _) (global (const Correct)) (global (const Refl)) Breflect, std.assert-ok! (coq.typecheck Breflect _) "eqbOK generates illtyped term", coq.ensure-fresh-global-id (Prefix ^ "eqb_OK") Namerf, X = (global (const C) : term), coq.env.add-const Namerf Breflect {{ forall a b : lp:X, lib:elpi.reflect (@eq lp:X a b) (lp:F a b) }} @opaque! Reflect, CL = eqbok-for (const C) Reflect, coq.elpi.accumulate _ "derive.eqbOK.db" (clause _ _ CL), coq.elpi.accumulate _ "derive.eqType.db" (clause _ _ (eqType (const C) eqb.axiom)), ]. main (indc _) _ _ :- stop "cannot call eqbOK on a constructor". } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqbcorrect.elpi000066400000000000000000000457571523041753400227030ustar00rootroot00000000000000/* equality test correctness and reflexivity proof */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ func feqb.trm->term eqb.trm -> term. macro @pi-trm N T F :- pi x xx\ decl x N T => (feqb.trm->term xx x :- !) => F xx x. namespace derive.eqbcorrect { func has-params? eqb.eqType ->. has-params? (eqb.type-param _). has-params? (eqb.value-param _ _). % use: % config Pred Pred_on Pred_body Solver Db % to make the code agnostic on the proof of correctness or reflexivity % % eg: config {{ @eqb_correct }} {{ @eqb_correct_on }} {{ @eqb_body_correct }} "eqb_correct_on__solver" correct-lemma-for pred config o:term, o:term, o:term, o:string, o:(pred i:term, o:term). func main gref, string -> list prop. main (indt I) Prefix CLs :- std.do! [ std.assert! (eqType (indt I) FI) "this inductive is not supported", std.assert! (induction-db I Indu) "call derive.induction before", /* Correctness */ (config {{ @eqb_correct }} {{ @eqb_correct_on }} {{ @eqb_body_correct }} "eqb_correct_on__solver" correct-lemma-for => common FI [] Indu R), %std.assert! (ground_term R) "ww", std.assert-ok! (coq.typecheck R Ty) "derive.eqbcorrect: common/correct generates ill typed term", Name is Prefix ^ "eqb_correct", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R Ty @opaque! Correct, if (has-params? FI) ( (config {{ @eqb_correct }} {{ @eqb_correct_on }} {{ @eqb_body_correct }} "eqb_correct_on__solver" correct-lemma-for => common-aux FI [] Indu Rx), std.assert-ok! (coq.typecheck Rx Tyx) "derive.eqbcorrect: common-aux/corect generates ill typed term", Namex is Prefix ^ "eqb_correct_aux", coq.ensure-fresh-global-id Namex FNamex, coq.env.add-const FNamex Rx Tyx @opaque! Correctx, CL_CORRECT = [correct-lemma-for (global (indt I)) (global (const Correctx))] ) (CL_CORRECT = [correct-lemma-for (global (indt I)) (global (const Correct))]), /* Reflexivity */ (config {{ @eqb_reflexive }} {{ @eqb_refl_on }} {{ @eqb_body_refl }} "eqb_refl_on__solver" refl-lemma-for => common FI [] Indu Rr), std.assert-ok! (coq.typecheck Rr Tyr) "derive.eqbcorrect: common/refl generates ill typed term", Namer is Prefix ^ "eqb_refl", coq.ensure-fresh-global-id Namer FNamer, coq.env.add-const FNamer Rr Tyr @opaque! Refl, if (has-params? FI) ( (config {{ @eqb_reflexive }} {{ @eqb_refl_on }} {{ @eqb_body_refl }} "eqb_refl_on__solver" refl-lemma-for => common-aux FI [] Indu Rrx), std.assert-ok! (coq.typecheck Rrx Tyrx) "derive.eqbcorrect: common-aux/refl generates ill typed term", Namerx is Prefix ^ "eqb_refl_aux", coq.ensure-fresh-global-id Namerx FNamerx, coq.env.add-const FNamerx Rrx Tyrx @opaque! Reflx, CL_REFL = [refl-lemma-for (global (indt I)) (global (const Reflx))] ) (CL_REFL = [refl-lemma-for (global (indt I)) (global (const Refl))]), /* Add the clauses in the database */ std.flatten [ [ eqcorrect-for (indt I) Correct Refl ] , CL_CORRECT , CL_REFL ] CLs , std.forall CLs (x\coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ x)), ]. main (const C) Prefix [Clause4, ClauseC, ClauseR] :- std.do! [ std.assert! (eqb-for (global (const C)) (global (const C)) F) "run eqb first", coq.env.const C (some T) _, search-eqcorrect-for T Correct Refl, std.assert-ok! (coq.typecheck Correct _) "eqbcorrect: illtyped correct", std.assert-ok! (coq.typecheck Refl _) "eqbcorrect: illtyped refl", NameR is Prefix ^ "eqb_refl", NameC is Prefix ^ "eqb_correct", X = (global (const C) : term), coq.ensure-fresh-global-id NameR FNameR, coq.ensure-fresh-global-id NameC FNameC, coq.env.add-const FNameC Correct {{ @eqb_correct lp:X lp:F }} @transparent! CC, coq.env.add-const FNameR Refl {{ @eqb_reflexive lp:X lp:F }} @transparent! CR, Clause4 = (eqcorrect-for (const C) CC CR), ClauseC = (correct-lemma-for (global (const C)) (global (const CC))), ClauseR = (refl-lemma-for (global (const C)) (global (const CR))), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ Clause4), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ ClauseC), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ ClauseR), ]. main (indc _) _ _ :- stop "derive.eqbcorrect does not work on a constructor". %--------------------------------------------------------------------------- func search-eqcorrect-for term -> term, term. search-eqcorrect-for (global (indt I)) (global (const C)) (global (const R)) :- std.assert! (eqType (indt I) (eqb.inductive _ _)) "unknown or not applied enough type", eqcorrect-for (indt I) C R. search-eqcorrect-for (app[global (indt I)|Args]) CArgs RArgs :- std.assert! (eqType (indt I) F) "unknown", eqcorrect-for (indt I) C R, search-eqcorrect-apply F Args (global (const C)) (global (const R)) CArgs RArgs. func search-eqcorrect-apply eqb.eqType, list term, term, term -> term, term. search-eqcorrect-apply (eqb.type-param F) [T|Args] C R C1 R1 :- search-eqcorrect-for T CT RT, pi x\ search-eqcorrect-apply (F x) Args {coq.mk-app C [T,_,CT]} {coq.mk-app R [T,_,RT]} C1 R1. search-eqcorrect-apply (eqb.value-param _ F) [T|Args] C R C1 R1 :- pi x\ search-eqcorrect-apply (F x) Args {coq.mk-app C [T]} {coq.mk-app R [T]} C1 R1. search-eqcorrect-apply (eqb.inductive _ _) [] C R C R. %--------------------------------------------------------------------------- func run-solver sealed-goal, string ->. run-solver G Name :- if (coq.ltac.open (g\gl\coq.ltac.call Name [] g gl ok) G []) true ((@holes! => coq.sealed-goal->string G SG), std.fatal-error {calc ( "solver " ^ Name ^ " fails on goal:\n" ^ SG )}). func coq.sealed-goal->string sealed-goal -> string. coq.sealed-goal->string (nabla G) R :- pi x\ coq.sealed-goal->string (G x) R. coq.sealed-goal->string (seal (goal Ctx _ Ty _ _)) R :- Ctx =!=> (std.map {std.rev Ctx} coq.ctx->string L, coq.term->string Ty G, R is "Lemma foo " ^ {std.string.concat "\n" L} ^ "\n :\n" ^ G ^ "."). func coq.ctx->string prop -> string. coq.ctx->string (decl X _ Ty) R :- R is "(" ^ {coq.term->string X} ^ " : " ^ {coq.term->string Ty} ^ ")". coq.ctx->string (def X _ Ty B) R :- R is "(" ^ {coq.term->string X} ^ " : " ^ {coq.term->string Ty} ^ " := " ^ {coq.term->string B} ^ ")". pred common-body o:term. pred fields-t o:term, o:term, o:term, o:term. %--------------------------------------------------------------------------- :index (1) func common eqb.eqType, list term, term -> term. common (eqb.type-param F) Params Ind O :- std.do! [ config Pred Pred_on _Pred_body _Solver Db, O = {{ fun (a : lp:Type) (eqA : a -> a -> bool) (eqAc : lp:Pred a eqA) => lp:(R a eqA eqAc) }}, Type = sort (typ {coq.univ.new}), @pi-trm `a` Type aa\a\ @pi-decl `eqA` {{ lp:a -> lp:a -> bool }} eqA\ @pi-decl `eqAc` {{ lp:Pred lp:a lp:eqA }} eqAc\ param1-inhab-db {{ lp:Pred_on lp:a lp:eqA }} eqAc => eqb-for a a eqA => reali a {{ lp:Pred_on lp:a lp:eqA }} => prove Db a {{ fun (x: lp:a) (Hx : lp:Pred_on lp:a lp:eqA x) => Hx }} => common (F aa) [a|Params] {coq.mk-app Ind [a, {{ lp:Pred_on lp:a lp:eqA }} ] } (R a eqA eqAc) ]. common (eqb.value-param TY F) Params Ind O :- std.do! [ feqb.trm->term TY T, O = {{ fun (a : lp:T) => lp:(R a) }}, mk-reali T TR, std.assert! (param1-inhab-db TR Is_full) "not trivially inhabited", @pi-trm `a` T aa\a\ reali a {{ lp:Is_full lp:a }} => common (F aa) [a|Params] {{ lp:Ind lp:a (lp:Is_full lp:a) }} (R a) ]. common (eqb.inductive I Ks) ParamsRev Ind O :- std.do! [ config _Pred Pred_on Pred_body _Solver Db, std.rev ParamsRev Params, coq.mk-app (global (indt I)) Params Ty, mk-eqb-for Ty Cmp, tag-for I TagC, fields-for I Fields_tC FieldsC ConstructC ConstructPC, coq.mk-app (global (const TagC)) Params Tag, coq.mk-app (global (const Fields_tC)) Params Fields_t, coq.mk-app (global (const FieldsC)) Params Fields, coq.mk-app (global (const ConstructC)) Params Construct, coq.mk-app (global (const ConstructPC)) Params ConstructP, eqb-fields Ty Ty EqbFields, Common = ({{ lp:Pred_body lp:Ty lp:Tag lp:Fields_t lp:Fields lp:Construct lp:ConstructP lp:EqbFields }} : term), std.assert-ok! (coq.typecheck Common CommonTy) "WTF", mk-reali (global (indt I)) IR, % param1-db, really coq.safe-dest-app Ind _ RealiArgs, coq.mk-app IR RealiArgs TyR, std.assert! (param1-inhab-db TyR Is_full) "not trivially inhabited", mk-eqb-for Ty Cmp, (@pi-decl `x` Ty x\ @pi-def `common` CommonTy Common c\ common-body c => fields-t Tag Fields_t Fields Construct => prove Db Ty {{ fun (i : lp:Ty) (Hi : lp:Pred_on lp:Ty lp:Cmp i) => Hi }} => reali Ty {{ lp:Pred_on lp:Ty lp:Cmp }} => pi i\ (feqb.trm->term i Ty :- !) => std.do! [ std.map (Ks i) (branch Params) (LS c), std.append (LS c) [x, app[Is_full,x]] (Args x c), R x c = (app [Ind, {{ lp:Pred_on lp:Ty lp:Cmp }} | Args x c] : term), ]), O = {{ fun (x :lp:Ty) (common : lp:CommonTy := lp:Common) => lp:(R x common) }}, ]. %--------------------------------------------------------------------------- :index (1) func common-aux eqb.eqType, list term, term -> term. common-aux (eqb.type-param F) Params Ind O :- std.do! [ config _Pred Pred_on _Pred_body _Solver Db, O = {{ fun (a : lp:Type) (eqA : a -> a -> bool) => lp:(R a eqA) }}, Type = sort (typ {coq.univ.new}), @pi-trm `a` Type aa\a\ @pi-decl `eqA` {{ lp:a -> lp:a -> bool }} eqA\ eqb-for a a eqA => reali a {{ lp:Pred_on lp:a lp:eqA }} => prove Db a {{ fun (x: lp:a) (Hx : lp:Pred_on lp:a lp:eqA x) => Hx }} => common-aux (F aa) [a|Params] {coq.mk-app Ind [a, {{ lp:Pred_on lp:a lp:eqA }} ] } (R a eqA) ]. common-aux (eqb.value-param TY F) Params Ind O :- std.do! [ feqb.trm->term TY T, O = {{ fun (a : lp:T) (pa : lp:TR a) => lp:(R a pa) }}, mk-reali T TR, @pi-trm `a` T aa\a\ @pi-decl `pa` {{ lp:TR lp:a }} pa\ reali a pa => common-aux (F aa) [a|Params] {{ lp:Ind lp:a lp:pa }} (R a pa) ]. common-aux (eqb.inductive I Ks) ParamsRev Ind O :- std.do! [ config _Pred Pred_on Pred_body _Solver Db, std.rev ParamsRev Params, coq.mk-app (global (indt I)) Params Ty, mk-eqb-for Ty Cmp, tag-for I TagC, fields-for I Fields_tC FieldsC ConstructC ConstructPC, coq.mk-app (global (const TagC)) Params Tag, coq.mk-app (global (const Fields_tC)) Params Fields_t, coq.mk-app (global (const FieldsC)) Params Fields, coq.mk-app (global (const ConstructC)) Params Construct, coq.mk-app (global (const ConstructPC)) Params ConstructP, eqb-fields Ty Ty EqbFields, Common = ({{ lp:Pred_body lp:Ty lp:Tag lp:Fields_t lp:Fields lp:Construct lp:ConstructP lp:EqbFields }} : term), std.assert-ok! (coq.typecheck Common CommonTy) "WTF", prove Db Ty {{ fun (i : lp:Ty) (Hi : lp:Pred_on lp:Ty lp:Cmp i) => Hi }} => reali Ty {{ lp:Pred_on lp:Ty lp:Cmp }} => (pi i\ (feqb.trm->term i Ty :- !) => @pi-def `common` CommonTy Common c\ common-body c => fields-t Tag Fields_t Fields Construct => std.map (Ks i) (branch Params) (LS c)), O = (let `common` CommonTy Common c\ app [Ind, {{ lp:Pred_on lp:Ty lp:Cmp }} | LS c]), ]. %--------------------------------------------------------------------------- func branch list term, eqb.constructor -> term. branch Params (eqb.constructor K Args) R :- coq.mk-app (global (indc K)) Params KParams, args Args KParams [] [] [] 0 R. :index (1) func args eqb.arguments, term, list term,list term, list term, int -> term. args (eqb.irrelevant TY Args) K As Hs Bs N O :- std.do! [ O = {{ fun (x : lp:T) (px : lp:EqbOn x) => lp:(R x px) }}, feqb.trm->term TY T, mk-reali T EqbOn, @pi-decl `x` T x\ @pi-decl `px` {{ lp:EqbOn lp:x }} px\ args Args {coq.mk-app K [x]} [x|As] Hs Bs {calc (N + 1)} (R x px) ]. args (eqb.regular TY Args) K As Hs Bs N O :- std.do! [ config _Pred Pred_on _Pred_body _Solver Db, O = {{ fun (x : lp:T) (px : lp:EqbOn x) (h : lp:EqbOn' x := lp:View x px) => lp:(R x px h) }}, feqb.trm->term TY T, mk-reali T EqbOn, mk-eqb-for T Cmp, EqbOn' = {{ lp:Pred_on lp:T lp:Cmp }}, if (same_term EqbOn EqbOn') (View = {{ fun (x : lp:T) (px : lp:EqbOn x) => px }}) (prove Db T View), @pi-decl `x` T x\ @pi-decl `px` {{ lp:EqbOn lp:x }} px\ % reali x px => @pi-def `h` {{ lp:EqbOn' lp:x }} {{ lp:View lp:x lp:px }} h\ args Args {coq.mk-app K [x]} [x|As] [h|Hs] [{{ lp:Cmp lp:x }}|Bs] N (R x px h) ]. args (eqb.dependent TY Args) K As Hs Bs N O :- std.do! [ config _Pred Pred_on _Pred_body _Solver Db, O = {{ fun (x : lp:T) (px : lp:EqbOn x) (h : lp:EqbOn' x := lp:View x px) => lp:(R x px h) }}, feqb.trm->term TY T, mk-reali T EqbOn, mk-eqb-for T Cmp, EqbOn' = {{ lp:Pred_on lp:T lp:Cmp }}, if (same_term EqbOn EqbOn') (View = {{ fun (x : lp:T) (px : lp:EqbOn x) => px }}) (prove Db T View), @pi-trm `x` T xx\x\ @pi-decl `px` {{ lp:EqbOn lp:x }} px\ reali x px => @pi-def `h` {{ lp:EqbOn' lp:x }} {{ lp:View lp:x lp:px }} h\ args (Args xx) {coq.mk-app K [x]} [x|As] [h|Hs] [{{ lp:Cmp lp:x }}|Bs] {calc (N + 1)} (R x px h) ]. args (eqb.stop TY) K As Hs Bs 0 {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} :- % no tricky arguments config {{ @eqb_correct }} Pred_on _Pred_body _Solver _Db, !, std.do! [ feqb.trm->term TY T, mk-eqb-for T Cmp, fields-t Tag Fields_t Fields Construct, eqb-fields T T EqbFields, std.assert! (common-body Common) "anomaly, no let for common body proof", coq.mk-app Common [K,{{ fun (x : lp:Fields_t (lp:Tag lp:K)) => lp:(Proof x) }}] B, @pi-decl `x` {{ lp:Fields_t (lp:Tag lp:K) }} x\ HYP = (x\ {{ @eq bool (lp:EqbFields (lp:Tag lp:K) (lp:Fields lp:K) lp:x) true }} : term -> term), GOAL = (x\ {{ @eq (option lp:T) (@Some lp:T lp:K) (lp:Construct (lp:Tag lp:K) lp:x) }} : term -> term), correct-proof x {{ lp:Fields_t (lp:Tag lp:K) }} HYP GOAL As Bs Hs (Proof x) ]. args (eqb.stop TY) K _As _Hs _Bs _ {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} :- config {{ @eqb_correct }} Pred_on _Pred_body Solver _Db, !, std.do! [ feqb.trm->term TY T, mk-eqb-for T Cmp, std.assert! (common-body Common) "anomaly, no let for common body proof", coq.mk-app Common [K,Fresh_] B, std.assert-ok! (coq.typecheck {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} _) "illtyped correctness proof", std.assert! (coq.ltac.collect-goals B [G] _) "wrong number of goals", run-solver G Solver, ]. func correct-proof term, term, (term -> term), (term -> term), list term, list term, list term -> term. correct-proof X TX H G As Bs Hs R :- coq.build-match X TX (cp.rty H G) (cp.bs As Bs Hs G) R. func cp.rty (term -> term), (term -> term), term, list term, list term -> term. cp.rty H G _ Vs _ {{ lp:{{ H X }} -> lp:{{ G X }} }} :- std.last Vs X. func cp.bs list term, list term, list term, (term -> term), term, term, list term, list term -> term. cp.bs As Bs Hs G K _ Vs Ts {{ @impliesP lp:Bools lp:P lp:Next }} :- std.rev Vs VsRev, mkblistcorrect Bs VsRev {{ bnil }} Bools, P = G {coq.mk-app K Vs }, cp.curry {std.rev Bs} As Vs Vs Ts Hs [] G K Next. :index (1) func cp.curry list term, list term, list term, list term, list term, list term, list term, (term -> term), term -> term. cp.curry [B|Bs] As [V|Vs] OVs Ts Hs Hs2 G K W :- std.do! [ TyH = ({{ @eq bool (lp:B lp:V) true }} : term), (@pi-decl `h` TyH h\ cp.curry Bs As Vs OVs Ts Hs [h|Hs2] G K (R h)), W = {{ fun h : lp:TyH => lp:(R h) }}, ]. cp.curry [] As [] Vs Ts Hs Hs2 G K R :- std.do! [ mktlistcorrect {std.rev Ts} {{ tnil }} Types, mkrewpred Ts K G P, (pi x\ sigma X\G x = {{ @eq lp:T lp:LHS lp:X }}), End = ({{ @eq_refl lp:T lp:LHS }} : term), mkeqns {std.rev As} Vs {std.rev Hs} {std.rev Hs2} Eqns, coq.mk-app {{ @eq_ind_r_nP lp:Types lp:P }} {std.append Eqns [End]} R, ]. :index (1) func mkrewpred list term, term, (term -> term) -> term. mkrewpred [] K G (G K). mkrewpred [T|Ts] K G {{ fun w : lp:T => lp:(R w) }} :- @pi-decl `w` T w\ mkrewpred Ts {coq.mk-app K [w]} G (R w). :index (1) func mkeqns list term, list term, list term, list term -> list term. mkeqns [] [] [] [] []. mkeqns [A|As] [V|Vs] [H|Hs] [H2|H2s] [A,V,{{ lp:H lp:V lp:H2 }}|R] :- mkeqns As Vs Hs H2s R. :index (1) func mktlistcorrect list term, term -> term. mktlistcorrect [] ACC ACC. mktlistcorrect [X|XS] ACC R :- mktlistcorrect XS {{ tcons lp:X lp:ACC }} R. :index (1) func mkblistcorrect list term, list term, term -> term. mkblistcorrect [] [] ACC ACC. mkblistcorrect [X|XS] [V|VS] ACC R :- coq.mk-app X [V] E, mkblistcorrect XS VS {{ bcons lp:E lp:ACC }} R. args (eqb.stop TY) K _As Hs Bs _ {{ lp:B : lp:Pred_on lp:T lp:Cmp lp:K }} :- config {{ @eqb_reflexive }} Pred_on _Pred_body _Solver _Db, !, std.do! [ feqb.trm->term TY T, mk-eqb-for T Cmp, std.assert! (common-body Common) "anomaly, no let for common body proof", mkblistrefl {std.rev Bs} {{ bnil }} Bools, Proof = (app [ {{ @eqb_refl_statementP }} , Bools | Hs ] : term), coq.mk-app Common [K,Proof] B, ]. :index (1) func mkblistrefl list term, term -> term. mkblistrefl [] ACC ACC. mkblistrefl [X|XS] ACC R :- coq.safe-dest-app X _ Args, std.last Args A, coq.mk-app X [A] E, mkblistrefl XS {{ bcons lp:E lp:ACC }} R. %--------------------------------------------------------------------------- % prove {{ is_option (seq A) (is_seq A (eqb_correrct A eqA)) }} T % such that T has type {{ forall x (px : is_option ...), eqb_correrct (option (seq A)) x }} func prove (pred i:term, o:term), term -> term. prove Lemma T R :- search Lemma (prove Lemma) T R. %prove T R :- whd1 T T', !, prove T' R. :index (_ _ 3) func search (pred i:term, o:term), (func term -> term), term -> term. search What Rec (app [GR|L] as GRL) R :- !, std.do! [ What GR Aux, mk-reali GR (global (indt ISGR)), param1-functor-for ISGR Funct BitMask, !, apply-functor (global Funct) BitMask L Rec TOTO, apply-aux Aux L Aux1, R = {{ fun (x : lp:GRL) H => lp:Aux1 x (lp:TOTO x H) }}, ]. % no params, no aux lemma (no reali argument) search What _Rec (global GR as GRL) {{ fun (x : lp:GRL) (_ : lp:IsGR x) => lp:R x }} :- What (global GR) R, mk-reali (global GR) IsGR, !. search What _ X _ :- coq.safe-dest-app X HD _, std.assert! (What HD _) "run eqbcorrect before". func apply-aux term, list term -> term. apply-aux Aux [] Aux. apply-aux Aux [T|L] Aux1 :- !, std.do![ std.assert! (eqb-for T T EQB ; reali T EQB) "WTF", apply-aux {coq.mk-app Aux [T, EQB]} L Aux1 ]. func apply-functor term, list bool, list term, (pred i:term, o:term) -> term. apply-functor X _ [] _ X. apply-functor X [ff,tt|Mask] [Y|YS] Rec R :- Rec Y Y1, !, apply-functor {coq.mk-app X [_,_,_,Y1]} Mask YS Rec R. apply-functor X [ff|Mask] [Y|YS] Rec R :- reali Y PY, apply-functor {coq.mk-app X [Y,PY]} Mask YS Rec R. %--------------------------------------------------------------------------- func mk-reali term -> term. mk-reali T R :- reali T R, !. mk-reali T _ :- Msg is "derive.eqbcorrect: no unary parametricity translation for " ^ {coq.term->string T} ^ ", use derive.param1 first", stop Msg. func mk-eqb-for term -> term. mk-eqb-for T R :- eqb-for T T R, !. mk-eqb-for T _ :- Msg is "derive.eqbcorrect: missing boolean equality for " ^ {coq.term->string T} ^ ", maybe use derive.eqb first", stop Msg. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/eqcorrect.elpi000066400000000000000000000114031523041753400225160ustar00rootroot00000000000000/* Correctness of comparison functions */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{map, rev, assert!, do!, appendR}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % link param1-functor-db and eqcorrect-db func pointfree (func term, term -> term), term, term -> term. pointfree F A B R :- coq.safe-dest-app A HDA ARGSA, coq.safe-dest-app B HDB ARGSB, appendR AA [_] ARGSA, appendR BB [_] ARGSB, coq.mk-app HDA AA LEFT, coq.mk-app HDB BB RIGHT, !, if (LEFT = RIGHT) (R = {{ fun _ x => x }}) (F LEFT RIGHT R). param1-functor-db {{ lib:elpi.derive.eq_axiom_at lp:A lp:F }} {{ lib:elpi.derive.eq_axiom_at lp:_ lp:F }} {{ fun (x : lp:A) (px : lib:elpi.derive.eq_axiom_at lp:A lp:F x) => px }} :- !. param1-functor-db HypTy {{ lib:elpi.derive.eq_axiom_at lp:A lp:_ }} {{ fun (x : lp:A) (px : lp:(PA x)) => lp:(R x px) }} :- (pi x\ coq.mk-app HypTy [x] (PA x)), coq.safe-dest-app HypTy (global (indt KR)) Args, realiR (global KGR) (global (indt KR)), !, Msg is "derive.eqcorrect: no eqcorrect for " ^ {coq.gref->string KGR}, assert! (eqcorrect-db KGR OK) Msg, (derive.eqcorrect.mk-app-eqfun OK Args OKLemma), coq.typecheck OKLemma OKLemmaTy ok, % we do the HO inference of P in elpi, since Coq is unable to do it OKLemmaTy = (prod _ _ x\ prod _ (P x) _), (pi x\ pointfree param1-functor-db {coq.mk-app HypTy [x]} (P x) Map), pi x px\ coq.mk-app OKLemma [x,{coq.mk-app Map [x,px]}] (R x px). namespace derive.eqcorrect { :index (_ 1) func mk-app-eqfun term, list term -> term. mk-app-eqfun X [] X. mk-app-eqfun X [Y] R :- coq.mk-app X [Y] R. mk-app-eqfun X [Y,_|YS] R :- eq-db Y Y F, !, coq.mk-app X [Y,F] X1, mk-app-eqfun X1 YS R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % func branch term, term, term -> term. branch (prod N T x\ prod M (P x) (B x)) (prod _ _ y\ prod _ (Q y) (Lty y)) L (fun N T x\ fun M (P x) (R x)) :- !, @pi-decl `x` T x\ @pi-decl `px` (P x) px\ sigma Proof ProofXPX\ (pointfree param1-functor-db (P x) (Q x) Proof, coq.mk-app Proof [x,px] ProofXPX, branch (B x px) (Lty x ProofXPX) {coq.mk-app L [x,ProofXPX]} (R x px)). branch _ _ X X. func branches list term, term -> list term. branches [] _ []. branches [Lemma | Lemmas] (prod _ S T) [P|PS] :- coq.typecheck Lemma LemmaTy ok, branch S LemmaTy Lemma P, branches Lemmas (T P) PS. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % apply the induction principle to the P and the fill in all branches % using eqK lemmas func eqK-lem list term, term -> term. eqK-lem Args K Lemma :- coq.safe-dest-app K (global (indc Kname)) _, eqK-db Kname Lem, coq.mk-app Lem Args Lemma. func idx term, term, list term, term, list term -> term. idx (sort _) IT K IndP A R :- !, eq-db IT IT Cmp, !, coq.mk-app IndP [ {{ lib:elpi.derive.eq_axiom_at lp:IT lp:Cmp }} ] Induction, coq.typecheck Induction Inductionty ok, branches {map K (eqK-lem A)} Inductionty KArgs, coq.mk-app Induction KArgs R. idx Arity IT K IndP A R :- whd1 Arity Arity1, !, idx Arity1 IT K IndP A R. idx _ _ _ _ _ _ :- assert! false "derive.eqcorrect: indexed data not supported". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Input paremeters and their equality tests pred params i:int, i:term, i:term, i:list term, i:term, i:list term, o:term. params L (prod N S T) I K IndP A R :- L > 0, !, M is L - 1, R = {{ fun (a : lp:S) (fa : a -> a -> bool) => lp:(Bo a fa) }}, @pi-decl N S a\ @pi-decl `fa` {{ lp:a -> lp:a -> bool }} fa\ (eq-db a a fa :- !) => params M (T a) {coq.mk-app I [a]} {map K (x\ coq.mk-app x [a])} {coq.mk-app IndP [a, {{ lib:elpi.derive.eq_axiom_at lp:a lp:fa }}]} [fa,a|A] (Bo a fa). params 0 Arity T K IndP A R :- idx Arity T K IndP {rev A} R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main inductive, string -> list prop. main GR Name [C] :- do! [ T = global (indt GR), assert! (induction-db GR IndP) "derive.eqcorrect: use derive.induction first", coq.env.indt GR Ind Lno _ Arity K _KT, assert! (Ind = tt) "derive.eqcorrect: co-inductive types not supported", % derive and define the lemma params Lno Arity T {std.map K (k\r\ r = global (indc k))} IndP [] CmpOK, std.assert-ok! (coq.typecheck CmpOK CmpTy) "derive.eqcorrect generates illtyped term", coq.env.add-const Name CmpOK CmpTy @opaque! Thm, % add a clause to the db C = (eqcorrect-db (indt GR) (global (const Thm)) :- !), coq.elpi.accumulate _ "derive.eqcorrect.db" (clause _ (before "eqcorrect-db:fail") C) ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/fields.elpi000066400000000000000000000305671523041753400220110ustar00rootroot00000000000000/* fields type description and accessor */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ macro @pi-trm N T F :- pi x xx\ decl x N T ==> (feqb.trm->term xx x :- !) ==> F xx x. namespace derive.fields { pred fields_t. % chose between fields_t and construct pred self o:term. func std.stop-do! list prop ->. std.stop-do! []. std.stop-do! [P|PS] :- coq.say P, ((pi x\ stop x :- !, fail) ==> P), !, std.stop-do! PS. std.stop-do! [P|_] :- coq.say "STOP" P. func main inductive, string -> list prop. main I Prefix AllCL :- std.do! [ std.assert! (tag-for I Tag) "no tag for this inductive, run that derivation first", std.assert! (eqType(indt I) FI) "this inductive is not supported", coq.env.indt I _ _ _ Arity KS _, box (global (indt I)) KS FI CLB, (CLB =!=> fields_t.main FI (global (indt I)) Body_t), std.assert-ok! (coq.typecheck Body_t Ty_t) "derive.fields generates illtyped fields_t", Name_t is Prefix ^ "fields_t", coq.ensure-fresh-global-id Name_t FName_t, coq.env.add-const FName_t Body_t Ty_t ff Fields_t, (CLB =!=> fields.main FI (global (indt I)) (global (const Fields_t)) (global (const Tag)) BodySkel), % we elaborate only for primitive records... std.assert-ok! (coq.elaborate-skeleton BodySkel Ty Body) "derive.fields generates illtyped fields", Name is Prefix ^ "fields", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName Body Ty ff Fields, (CLB =!=> construct.main FI (global (indt I)) Fields_t Body_c), std.assert-ok! (coq.typecheck Body_c Ty_c) "derive.fields generates illtyped construct", Name_c is Prefix ^ "construct", coq.ensure-fresh-global-id Name_c FName_c, coq.env.add-const FName_c Body_c Ty_c ff Construct, coq.bind-ind-arity (global (indt I)) Arity (case-refl Tag Fields Construct) Body_PSkel, std.assert-ok! (coq.elaborate-skeleton Body_PSkel Ty_P Body_P) "derive.fields generates illtyped constructP", Name_P is Prefix ^ "constructP", coq.ensure-fresh-global-id Name_P FName_P, coq.env.add-const FName_P Body_P Ty_P @opaque! ConstructP, AllCL = [fields-for I Fields_t Fields Construct ConstructP|CLB], std.forall AllCL (x\ coq.elpi.accumulate _ "derive.fields.db" (clause _ _ x)), ]. % ---------------------------------------------------------------------- :index (1) func fields_t.main eqb.eqType, term -> term. fields_t.main (eqb.type-param F) I {{ fun p : Type => lp:(R p) }} :- !, @pi-trm `p` {{ Type }} x\p\ fields_t.main (F x) {coq.mk-app I [p]} (R p). fields_t.main (eqb.value-param TY F) I {{ fun p : lp:Ty => lp:(R p) }} :- !, feqb.trm->term TY Ty, @pi-trm `p` Ty x\p\ fields_t.main (F x) {coq.mk-app I [p]} (R p). fields_t.main (eqb.inductive _ F) I {{ fun p : lib:elpi.derive.positive => lp:(R p) }} :- coq.safe-dest-app I _ Params, @pi-decl `p` {{ lib:elpi.derive.positive }} p\ pi i\ splay-over-positive p (F i) fields_t.rty {{ unit }} (fields_t.k Params) (R p). func fields_t.rty term -> term. fields_t.rty _ {{ Type }}. func fields_t.k list term, eqb.constructor -> term. fields_t.k Params (eqb.constructor K _) T :- box-for K I _, coq.mk-app (global (indt I)) Params T. % ---------------------------------------------------------------------- func fields.main eqb.eqType, term, term, term -> term. fields.main (eqb.type-param F) I F_t Tag {{ fun p : Type => lp:(R p) }} :- !, @pi-trm `p` {{ Type }} x\p\ fields.main (F x) {coq.mk-app I [p]} {coq.mk-app F_t [p]} {coq.mk-app Tag [p]} (R p). fields.main (eqb.value-param TY F) I F_t Tag {{ fun p : lp:Ty => lp:(R p) }} :- !, feqb.trm->term TY Ty, @pi-trm `p` Ty x\p\ fields.main (F x) {coq.mk-app I [p]} {coq.mk-app F_t [p]} {coq.mk-app Tag [p]} (R p). fields.main (eqb.inductive _ _) I F_t Tag {{ fun i : lp:I => lp:(R i) }} :- @pi-trm `i` I _\i\ coq.build-match i I (fields.rty F_t Tag) fields.branch (R i). func fields.rty term, term, term, list term, list term -> term. fields.rty F_t Tag _ Vars _ {{ lp:F_t (lp:Tag lp:X) }} :- std.last Vars X. func fields.branch term, term, list term, list term -> term. fields.branch K _ Vars _ R :- coq.safe-dest-app K (global (indc C)) Params, box-for C _ B, coq.mk-app (global (indc B)) {std.append Params Vars} R. % ------------------------------------------------------------------------ func box term, list constructor, eqb.eqType -> list prop. box I KL Decl CL :- std.do! [ box.aux Decl I ILDr, box.declare KL ILDr CL, ]. func box.declare list constructor, list box-spec -> list prop. box.declare [] [] []. box.declare [K|Ks] [real-box I|Bs] [C|Cs] :- std.assert-ok! (coq.elaborate-indt-decl-skeleton I D) "ILD", coq.env.add-indt D IB, coq.env.indt IB _ _ _ _ [KB] _, C = box-for K IB KB, (C ==> box.declare Ks Bs Cs). box.declare [K|Ks] [same-box K1|Bs] [box-for K IB KB|Cs] :- box-for K1 IB KB, box.declare Ks Bs Cs. kind box-spec type. type real-box indt-decl -> box-spec. type same-box constructor -> box-spec. func box.aux eqb.eqType, term -> list box-spec. box.aux (eqb.type-param F) I L :- (@pi-trm `p` {{ Type }} x\y\ box.aux (F x) {coq.mk-app I [y]} (L1 y)), distribute L1 (f\r\ sigma U\ r = parameter "A" explicit (sort (typ U)) f) L. box.aux (eqb.value-param TY F) I L :- feqb.trm->term TY Ty, (@pi-trm `p` Ty x\y\ box.aux (F x) {coq.mk-app I [y]} (L1 y)), distribute L1 (f\r\ r = parameter "v" explicit Ty f) L. box.aux (eqb.inductive Ind F) I L :- pi x\ box.aux2 I Ind x (F x) L. pred args-of o:constructor, o:eqb.arguments. :index(_ _ _ 2) func box.aux2 term, inductive, eqb.trm, list eqb.constructor -> list box-spec. box.aux2 _ _ _ [] []. box.aux2 I Ind X [eqb.constructor _ Args|MoreKs] [same-box K|MoreBoxes] :- args-of K Args, !, box.aux2 I Ind X MoreKs MoreBoxes. box.aux2 I Ind X [eqb.constructor K Args|MoreKs] [real-box (record ID1 S ID2 Fields)|MoreBoxes] :- if (coq.env.informative? Ind) (S = {{ Type }}) (S = {{ Prop }}), ID1 is "box_" ^ {coq.gref->id (indt Ind)} ^ "_" ^ {coq.gref->id (indc K)}, ID2 is "Box_" ^ {coq.gref->id (indt Ind)} ^ "_" ^ {coq.gref->id (indc K)}, ((feqb.trm->term X I :- !) ==> box.box-argument ID2 0 Args Fields), args-of K Args ==> box.aux2 I Ind X MoreKs MoreBoxes. :index(_ _ 1) func box.box-argument string, int, eqb.arguments -> record-decl. box.box-argument _ _ (eqb.stop _) end-record. box.box-argument S M (eqb.regular T Args) (field [] N TY _\A) :- N is S ^ "_" ^ {std.any->string M}, feqb.trm->term T TY, box.box-argument S {calc (M + 1)} Args A. box.box-argument S M (eqb.irrelevant T Args) (field [] N TY _\A) :- N is S ^ "_" ^ {std.any->string M}, feqb.trm->term T TY, box.box-argument S {calc (M + 1)} Args A. box.box-argument S M (eqb.dependent T Args) (field [] N TY A) :- N is S ^ "_" ^ {std.any->string M}, feqb.trm->term T TY, pi x y\ (feqb.trm->term x y :- !) ==> box.box-argument S {calc (M + 1)} (Args x) (A y). func distribute (A -> list box-spec), (func (A -> indt-decl) -> indt-decl) -> list box-spec. distribute (_\ []) _ [] :- !. distribute (x\ [real-box (X x)| XS x]) F [real-box F_X|R] :- !, F X F_X, distribute XS F R. distribute (x\ [same-box K| XS x]) F [same-box K|R] :- distribute XS F R. % ---------------------------------------------------------------------- :index(1) func construct.main eqb.eqType, term, constant -> term. construct.main (eqb.type-param F) I F_t {{ fun p : Type => lp:(R p) }} :- @pi-trm `p` {{ Type }} x\p\ construct.main (F x) {coq.mk-app I [p]} F_t (R p). construct.main (eqb.value-param TY F) I F_t {{ fun p : lp:Ty => lp:(R p) }} :- feqb.trm->term TY Ty, @pi-trm `p` Ty x\p\ construct.main (F x) {coq.mk-app I [p]} F_t (R p). construct.main (eqb.inductive _ F) I F_t {{ fun p : lib:elpi.derive.positive => lp:(R p) }} :- coq.safe-dest-app I _ Params, coq.mk-app (global (const F_t)) Params Fields_t, @pi-decl `p` {{ lib:elpi.derive.positive }} p\ pi i\ splay-over-positive p (F i) (construct.rty1 Fields_t I) {{ fun (_:lib:elpi.derive.unit) => @None lp:I }} (construct.k I Params) (R p). func construct.rty1 term, term, term -> term. construct.rty1 Fields_t I X {{ lp:Fields_t lp:X -> option lp:I }}. func construct.k term, list term, eqb.constructor -> term. construct.k _ Params (eqb.constructor K (eqb.stop _)) {{ fun b : lp:BoxTy => Some lp:B }} :- !, box-for K BT _, coq.mk-app (global (indt BT)) Params BoxTy, coq.mk-app (global (indc K)) Params B. construct.k I Params (eqb.constructor K _) {{ fun b : lp:BoxTy => lp:(R b) }} :- box-for K BT _, coq.mk-app (global (indt BT)) Params BoxTy, @pi-decl `b` BoxTy b\ coq.build-match b BoxTy (construct.rty I) (construct.branch {coq.mk-app (global (indc K)) Params}) (R b). func construct.rty term, term, list term, list term -> term. construct.rty I _ _ _ {{ option lp:I }}. func construct.branch term, term, term, list term, list term -> term. construct.branch B _ _ Vars _ {{ Some lp:BVars }} :- coq.mk-app B Vars BVars. % ------------------------------------------------------------------------- % match x return construct (fields x) = Some x with _ => erefl func case-refl constant, constant, constant, term, list term, list term -> term. case-refl Tag Fields Construct _ ParamsX Tys R :- std.appendR Params [X] ParamsX, !, coq.mk-app (global (const Tag)) Params TP, coq.mk-app (global (const Fields)) Params FP, coq.mk-app (global (const Construct)) Params CP, coq.build-match X {std.last Tys} (case-refl-rty TP FP CP) case-refl-branch R. func case-refl-rty term, term, term, term, list term,list term -> term. case-refl-rty Tag Fields Construct _ Vs _ {{ lp:Construct (lp:Tag lp:X) (lp:Fields lp:X) = Some lp:X }} :- std.last Vs X. func case-refl-branch term, term, list term,list term -> term. case-refl-branch _ _ _ _ {{ refl_equal }}. func splay-over-positive term, list A, (func term -> term), term, (pred i:A, o:term) -> term. splay-over-positive X L DoRty Def DoBranch R :- splay-over-positive.aux X (x\x) L DoRty DoBranch Def R. func splay-over-positive.aux term, (term -> term), list A, (func term -> term), (pred i:A, o:term), term -> term. splay-over-positive.aux _ _ [] _ _ Def Def :- !. splay-over-positive.aux _ _ [X] _ DoBranch _ R :- DoBranch X R, !. splay-over-positive.aux X XCtx KL DoRty DoBranch Def R :- coq.build-match X {{ lib:elpi.derive.positive }} (do-rty XCtx DoRty) (do-branch XCtx DoRty DoBranch Def KL) R. func do-rty (term -> term), (func term -> term), term, list term, list term -> term. do-rty Ctx DoRty _ Vs _ R :- P = Ctx {std.last Vs}, DoRty P R. :index (1) func list-bitmask list A -> list A, list A. list-bitmask [] [] []. list-bitmask [X] [X] []. list-bitmask [X,Y|L] [X|A] [Y|B] :- list-bitmask L A B. func do-branch (term -> term), (func term -> term), (pred i:A, o:term), term, list A, term, term, list term, list term -> term. do-branch PCtx DoRty DoBranch Def [_|KS] {{ xO }} _ [P] _ R :- !, list-bitmask KS KODD _, splay-over-positive.aux P (x\ PCtx {{ xO lp:x }}) KODD DoRty DoBranch Def R. do-branch PCtx DoRty DoBranch Def [_|KS] {{ xI }} _ [P] _ R :- !, list-bitmask KS _ KEVEN, splay-over-positive.aux P (x\ PCtx {{ xI lp:x }}) KEVEN DoRty DoBranch Def R. do-branch _ _ DoBranch _ [X|_] {{ xH }} _ _ _ R :- DoBranch X R, !. func prod->tuple term -> term. prod->tuple (prod N Ty F) {{ { x:lp:Ty & lp:(X x)}%type }} :- /*(F = x\prod _ _ _),*/ (pi x\ occurs x (F x)), !, % not the last one and dependent @pi-decl N Ty x\ prod->tuple (F x) (X x). prod->tuple (prod N Ty F) {{ (lp:Ty * lp:X)%type }} :- /*(F = x\prod _ _ _),*/ !, % not the last one @pi-decl N Ty x\ prod->tuple (F x) X. prod->tuple (prod _ Ty _) Ty :- !. prod->tuple _ {{ unit }}. % other branches func repack-as-tuple constant, constant, term, list term, list term -> term. repack-as-tuple C_t Tag _ Vars Tys R :- std.appendR Params [X] Vars, !, std.last Tys XTy, coq.mk-app (global (const C_t)) Params C_tp, coq.mk-app (global (const Tag)) Params Tagp, coq.build-match X XTy (do-rty_t C_tp Tagp) args->tuple R. :index (1) func do-rty_t term, term, term, list term, list term -> term. do-rty_t C_t Tag _ Vars _ {{ lp:C_t (lp:Tag lp:X) }} :- std.last Vars X. :index (_ _ 1) func args->tuple term, term, list term, list term -> term. args->tuple _ _ [] _ {{ tt }}. /*args->tuple _ _ [X] _ X.*/ args->tuple A B [X|XS] [T|TS] {{ @existT lp:T _ lp:X lp:R }} :- occurs X TS, !, args->tuple A B XS TS R. args->tuple A B [X|XS] [_T|TS] {{ ( lp:X , lp:R ) }} :- args->tuple A B XS TS R. }LPCIC-coq-elpi-eb449d7/apps/derive/elpi/idx2inv.elpi000066400000000000000000000064031523041753400221160ustar00rootroot00000000000000/* Links an inductive an its inverted form */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{last, assert!, do!}. namespace derive.idx2inv { :index (1) func params indt-decl, term, term -> term. params (parameter ID _ Ty In) T Ti (fun Name Ty Out) :- coq.id->name ID Name, @pi-decl Name Ty p\ params (In p) {coq.mk-app T [p]} {coq.mk-app Ti [p]} (Out p). params (inductive _ _ Arity _) T Ti (fix `rec` N FixTy FixBo) :- coq.safe-dest-app T (global (indt GR)) _, coq.env.recursive? GR, !, coq.arity->term Arity Ty, compute-fix-ty Ty T Ti N FixTy, compute-fix-clause Ty T Ti N Prove, compute-fix-clause Ty T Ti {calc (N + 1)} Prove1, @pi-decl `rec` Ty f\ Prove f => Prove1 f => compute-fix-bo Ty T Ti (FixBo f). params (inductive _ _ Arity _) T Ti Bo :- coq.arity->term Arity Ty, compute-fix-bo Ty T Ti Bo. func compute-fix-ty term, term, term -> int, term. compute-fix-ty (prod N S Tgt) T Ti M (prod N S T1) :- !, @pi-decl N S x\ compute-fix-ty (Tgt x) {coq.mk-app T [x]} {coq.mk-app Ti [x]} J (T1 x), M is J + 1. compute-fix-ty _ S T 0 {{ lp:S -> lp:T }}. func compute-fix-clause term, term, term, int -> (term -> prop). compute-fix-clause _ S T 1 (ih\ param1-functor-db S T ih) :- !. compute-fix-clause (prod N S Tgt) T Ti M (ih\ pi x\ C ih x) :- !, J is M - 1, @pi-decl N S x\ compute-fix-clause (Tgt x) {coq.mk-app T [x]} {coq.mk-app Ti [x]} J (ih\ C ih x). func compute-fix-bo term, term, term -> term. compute-fix-bo (prod N S Tgt) T Ti (fun N S T1) :- !, @pi-decl N S x\ compute-fix-bo (Tgt x) {coq.mk-app T [x]} Ti (T1 x). compute-fix-bo _ T Ti (fun `x` T B) :- @pi-decl `x` T x\ coq.build-match x T (mk-rty Ti) (mk-branch) (B x). func mk-rty term, term, list term, list term -> term. mk-rty Ti _ Vars _ R :- std.appendR Idxs [_] Vars, !, coq.mk-app Ti Idxs R. func mk-branch term, term, list term, list term -> term. mk-branch K KTy Vars VarsTy R :- std.do! [ coq.safe-dest-app K (global (indc GR)) _, coq.safe-dest-app KTy (global (indt I)) IArgs, coq.env.indt I _ _ NP _ _ _, std.split-at NP IArgs Params IDX, Vars = RealArgs, VarsTy = RealArgsTy, assert! (invert-db (indc GR) InvK) "derive.idx2inv: No inverted constructor", coq.mk-app {coq.mk-app (global InvK) Params} IDX K1, (pi H G P\ paramX.prove H G P :- param1-functor-db H G P) =!=> (pi X T\ paramX.cross T :- (pi M\stop M :- !, fail) => realiR X T) =!=> paramX.prove-args RealArgs RealArgsTy Args, coq.mk-app K1 Args K2, std.map IDX mk-refl ArgsEq, coq.mk-app K2 ArgsEq R, ]. func mk-refl term -> term. mk-refl E {{ @refl_equal _ lp:E }}. func main inductive, string -> list prop. main GR Infix [Clause] :- do! [ T = global (indt GR), assert! (invert-db (indt GR) (indt GRinv)) "derive.idx2inv: No inverted inductive", Tinv = global (indt GRinv), Name is {coq.gref->id (indt GR)} ^ Infix ^ {coq.gref->id (indt GRinv)}, coq.env.indt-decl GR D, copy T Tinv => params D T Tinv R, std.assert-ok! (coq.typecheck R RT) "derive.idx2inv: illtyped term", coq.env.add-const Name R RT _ C, Clause = idx2inv-db GR GRinv C C, coq.elpi.accumulate _ "derive.idx2inv.db" (clause _ _ Clause) ]. } % vim: set spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/induction.elpi000066400000000000000000000122621523041753400225270ustar00rootroot00000000000000/* induction principles */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{do!, assert!, last, appendR, rev, map}. namespace derive.induction { % local db associating to each constructor the hypothesis to be used func induction-hyp-db term -> term. func informative. % loaded in the context if we can elim to Type % create (paramX.prove (is_T params) P IH) :index (1) func mk-paramX.prove-clause list term, term, term, term -> prop. mk-paramX.prove-clause [_] T P IH (param1-functor-db T P IH). mk-paramX.prove-clause [_,_|Args] T P IH (pi x y\ C x y) :- pi x y\ mk-paramX.prove-clause Args {coq.mk-app T [x,y]} {coq.mk-app P [x,y]} {coq.mk-app IH [x,y]} (C x y). % branch for constructor k is (hyp-k ...) where ... are the terms % generated by prove-args func branch term, term, list term, list term -> term. branch K _ V VT R :- induction-hyp-db K IH, ((pi H G P\ paramX.prove H G P :- param1-functor-db H G P) =!=> (pi X\ paramX.cross X) =!=> paramX.prove-args V VT Args), coq.mk-app IH Args R. func oty term, list term, list term -> term. oty _ _ VT P :- last VT XT, copy XT P. func branches term, term, list term, term, int -> int, term, term. branches (prod Name S T) Ity Args IH N M (prod Name S F1) (fun Name S R1) :- !, @pi-decl Name S x\ branches (T x) Ity [x|Args] IH {calc (N + 1)} M (F1 x) (R1 x). branches (sort _) Ity Args IH Rno Rno Fty (fun `x` ItyArgs Bo) :- do! [ coq.mk-app Ity {rev Args} ItyArgs, copy ItyArgs PArgs, Fty = prod `x` ItyArgs (_\ PArgs), copy Ity P, mk-paramX.prove-clause Args Ity P IH C, @pi-decl `x` ItyArgs x\ C => coq.build-match x ItyArgs oty branch (Bo x) ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Synthesize the type of each hypothesis starting from the type % of the constructor of is_T func hyp term -> term. hyp (prod N S T) (prod N Q R) :- !, copy S Q, @pi-decl N Q x\ hyp (T x) (R x). hyp S Q :- copy S Q. func hyps list term, list term, term, term -> term. hyps [K|KS] [KT|KTS] Ity Arity (fun Name Ind Bo) :- coq.term->gref K GRK, coq.name-suffix `H` {coq.gref->id GRK} Name, hyp KT Ind, !, % we cut since copy generates many solutions @pi-decl `Name` Ind x\ induction-hyp-db K x =!=> % This is the hyp to be used for branch K hyps KS KTS Ity Arity (Bo x). hyps [] [] Ity Arity (fix `IH` Recno Fty Bo) :- @pi-decl `IH` Fty f\ sigma C\ branches Arity Ity [] f 0 Recno Fty (Bo f). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Parameters and the P of the induction predicate (truncated wrt the type % of the unary parametricity translation, eg P takes only the indexes) func truncated-predicate-ty term -> term. truncated-predicate-ty (sort _) T :- informative, !, T = sort (typ U), coq.univ.new U. truncated-predicate-ty (sort _) (sort prop). truncated-predicate-ty (prod N S T) (prod N S R) :- @pi-decl N S x\ truncated-predicate-ty (T x) (R x). % loads the context with the substitution "is_T params -> P" func mk-subst-clause term, term -> list prop. mk-subst-clause Ity P C :- coq.safe-dest-app Ity IT ITArgs, C = [(copy IT P :- !), (pi Args Rest O\ copy (app[IT|Args]) O :- !, appendR ITArgs Rest Args, coq.mk-app P Rest O, !)]. func params int, term, list term, list term, term -> term. params N Ity K KT (prod Nx Sx x\ prod NP (SP x) (T x)) (fun Nx Sx x\ fun NP (SP x) (R1 x)) :- N > 0, !, M is N - 2, @pi-decl Nx Sx x\ @pi-decl NP (SP x) px\ % useless, the identity map is already there % paramX.prove px px (fun `x` x a\ fun `pa` (app[px,a]) pa\ pa) => params M {coq.mk-app Ity [x,px]} {map K (k\ coq.mk-app k [x,px])} {map KT (coq.subst-prod [x,px])} (T x px) (R1 x px). params 0 Ity K KT Arity (fun `P` Pty p\ Bo p) :- % P only takes the indexes of Arity truncated-predicate-ty Arity Pty, @pi-decl `P` Pty p\ sigma Subst\ (mk-subst-clause Ity p Subst, % replace (is_T params) with P Subst => hyps K KT Ity Arity (Bo p)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main inductive, string -> list prop. main GR Prefix [Clause] :- do! [ T = global (indt GR), if (coq.env.informative? GR) (Informative = [informative]) (Informative = []), assert! (reali T TR) {calc ( "derive.induction: no unary parametricity translation for" ^ {coq.term->string T} ^ ", use derive.param1 first")}, TR = global (indt GRR), coq.env.indt GRR Ind Lno _ Arity K KT, assert! (Ind = tt) "derive.induction: Coinductive types are not supported", % we build the induction principle Informative =!=> params Lno TR {std.map K (k\r\ r = global (indc k))} KT Arity R, % coq.say {coq.term->string R}, std.assert-ok! (coq.typecheck R RT) "derive.induction generates illtyped term", Name is Prefix ^ "induction", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R RT _ I, % we register it as a clause Clause = (induction-db GR (global (const I)) :- !), coq.elpi.accumulate _ "derive.induction.db" (clause _ (before "induction-db:fail") Clause) ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/injection.elpi000066400000000000000000000041311523041753400225110ustar00rootroot00000000000000/* core of injection */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{append, drop, length, do!}. namespace ltac.injection { pred arg-i i:int, i:int, i:term, i:inductive, i:list term, i:int, i:constructor, i:list term, i:term, i:term, i:term, o:list term. arg-i MAX MAX _ _ _ _ _ _ _ _ _ [] :- !. arg-i J MAX EQF GR TyArgs Pno GRK KArgs A B H R :- J < MAX, I is J + 1, if (projK-db GRK I Proj) (do! [ drop Pno KArgs Defaults, coq.mk-app Proj {append TyArgs Defaults} ProjectorSkel, coq.mk-app {coq.env.global (indt GR)} TyArgs Ty, coq.elaborate-skeleton ProjectorSkel (prod _ _ _\Ty2) Projector ok, % FIXME whd coq.mk-app EQF [Ty,Ty2,Projector,A,B,H] P, R = [P|RS] ]) (R = RS), arg-i I MAX EQF GR TyArgs Pno GRK KArgs A B H RS. } namespace ltac { % Tests if the command can be applied pred injection? i:term, o:inductive, o:list term, o:constructor, o:list term, o:term, o:term. injection? Ty GR TyArgs GRK KArgs A B :- do! [ whd Ty [] {{lib:@elpi.eq}} [T,A,B], whd T [] IndT TyArgs, whd A [] K KArgs, whd B [] KB _, coq.env.global (indt GR) IndT, coq.env.global (indc GRK) K, coq.env.global (indc GRB) KB, GRK = GRB ]. % Does the job pred injection! i:term, o:list term, i:inductive, i:list term, i:constructor, i:list term, i:term, i:term. injection! H PL GR TyArgs GRK KArgs A B :- do! [ coq.env.indt GR _ Pno _ _ _ _, length KArgs Argsno, Eqno is Argsno - Pno, ltac.injection.arg-i 0 Eqno {{lib:@elpi.derive.eq_f}} GR TyArgs Pno GRK KArgs A B H PL ]. % Main entry point with assertion that H can be injected pred injection i:term, i:term, i:term, o:list term. injection H EqAB _ PL :- if (injection? EqAB GR TyArgs GRK KArgs A B) (injection! H PL GR TyArgs GRK KArgs A B) (coq.error "injection:" {coq.term->string H} "of type" {coq.term->string EqAB} "does not equate equal constructors"). } % vim:set ft=lprolog spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/invert.elpi000066400000000000000000000070411523041753400220410ustar00rootroot00000000000000/* Hide indexes using non-uniform parameters */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, map-i, map}. namespace derive.invert { func the-inductive term -> int. func the-nup-for-idx int -> term. func the-suffix -> string. func invert indt-decl -> indt-decl. invert (parameter ID Imp Ty In) (parameter ID Imp Ty Out) :- @pi-parameter ID Ty p\ invert (In p) (Out p). invert (inductive ID IsInd Arity Ks) (inductive ID1 IsInd Arity1 Ks1) :- ID1 is ID ^ {the-suffix}, coq.arity->nparams Arity Nup, trivial-arity Arity 0 Arity1, coq.arity->term Arity ITy, @pi-parameter ID ITy i\ the-inductive i Nup => std.map (Ks i) (invert-c Nup Arity1) (Ks1 i). func invert-c int, arity, indc-decl -> indc-decl. invert-c Nup ArityI (constructor ID ArityK) (constructor ID1 ArityK1) :- ID1 is ID ^ {the-suffix}, invert-c-params Nup ArityI ArityK ArityK1. func invert-c-params int, arity, arity -> arity. invert-c-params Nup (parameter ID Imp Ty In) (parameter _ _ _ In1) (parameter ID Imp Ty Out):- Nup > 0, !, Nup1 is Nup - 1, @pi-parameter ID Ty p\ invert-c-params Nup1 (In p) (In1 p) (Out p). invert-c-params 0 Arity KArity Out :- invert-c-params-idx 0 Arity KArity Out. func invert-c-params-idx int, arity, arity -> arity. invert-c-params-idx Idx (parameter ID Imp Ty In) KArity (parameter ID Imp Ty Out) :- Idx1 is Idx + 1, @pi-parameter ID Ty p\ the-nup-for-idx Idx p =!=> invert-c-params-idx Idx1 (In p) KArity (Out p). invert-c-params-idx _ (arity _) KArity KArity1 :- invert-c-arity KArity KArity1. func invert-c-arity arity -> arity. invert-c-arity (parameter ID Imp Ty In) (parameter ID Imp Ty Out) :- @pi-parameter ID Ty p\ invert-c-arity (In p) (Out p). invert-c-arity (arity T) (arity T1) :- invert-c-ty T T1. func invert-c-ty term -> term. invert-c-ty (prod N S T) (prod N S T1) :- !, @pi-decl N S x\ invert-c-ty (T x) (T1 x). invert-c-ty I I :- the-inductive I _, !. invert-c-ty (app[I|Args]) Out :- the-inductive I Nup, !, std.split-at Nup Args NUArgs Indexes, invert-c-ty-eq Indexes 0 (app[I|NUArgs]) Out. func invert-c-ty-eq list term, int, term -> term. invert-c-ty-eq [] _ X X. invert-c-ty-eq [I|Idxs] N Acc {{ lp:V = lp:I -> lp:Out }} :- std.assert! (the-nup-for-idx N V) "no variable to equate to index expression", M is N + 1, invert-c-ty-eq Idxs M {coq.mk-app Acc [V]} Out. func trivial-arity arity, int -> arity. trivial-arity (parameter ID Imp Ty In) Ni (parameter ID Imp Ty Out) :- @pi-parameter ID Ty p\ trivial-arity (In p) Ni (Out p). trivial-arity (arity (prod Name Ty In)) Ni (parameter ID explicit Ty Out) :- !, ID is "idx" ^ {term_to_string Ni}, Ni1 is Ni + 1, @pi-decl Name Ty p\ trivial-arity (arity (In p)) Ni1 (Out p). trivial-arity (arity T) _ (arity T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main inductive, string -> list prop. main GR Suffix Clauses :- do! [ coq.env.indt-decl GR Decl, the-suffix Suffix => invert Decl Decl1, std.assert-ok! (coq.typecheck-indt-decl Decl1) "derive.invert generates illtyped term", coq.env.add-indt Decl1 Inv, coq.env.indt GR _ _ _ _ Ks _, coq.env.indt Inv _ _ _ _ KIs _, Clauses = [invert-db (indt GR) (indt Inv) | {std.map2 Ks KIs mk-k-clause}], std.forall Clauses (c\coq.elpi.accumulate _ "derive.invert.db" (clause _ _ c)) ]. func mk-k-clause constructor, constructor -> prop. mk-k-clause K1 K2 (invert-db (indc K1) (indc K2)). } % vim: set spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/isK.elpi000066400000000000000000000031701523041753400212570ustar00rootroot00000000000000/* Derive a function "isK t -> true" iif t is "K .." for K constructor */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, last, forall, map}. namespace derive.isK { func ty term, list term, list term -> term. ty _ _ _ {{ bool }}. % if the branch of the match (corresponding to KParams) is the one % for K (the constructor we are generating the isK function for) we say % true, else we say false. :index (1) func branch term, term, term, list term, list term -> term. branch K1 KParams _ _ _ {{ true }} :- coq.safe-dest-app KParams K2 _, coq.env.global (indc GRK1) K1, coq.env.global (indc GRK2) K2, GRK1 = GRK2, !. branch _ _ _ _ _ {{ false }}. func body term, term, list term, list term -> term. body K _ Vars Tys R :- last Vars X, last Tys TX, coq.build-match X TX ty (branch K) R. func main-K string, term, term, constructor -> prop. main-K Prefix Ity Arity GRK Clause :- coq.env.global (indc GRK) K, coq.bind-ind-arity Ity Arity (body K) TSek, (@keepunivs! => std.assert-ok! (coq.elaborate-skeleton TSek Ty T) "derive.isK generates illtyped term"), Name is Prefix ^ {coq.gref->id (indc GRK)}, coq.env.add-const Name T Ty _ IsK, Clause = (isK-db GRK (global (const IsK)) :- !). func main inductive, string -> list prop. main GR Prefix Clauses :- coq.env.global (indt GR) T, coq.env.indt GR _ _ _ Arity Kn _, map Kn (main-K Prefix T Arity) Clauses, forall Clauses (c\ coq.elpi.accumulate _ "derive.isK.db" (clause _ (before "isK-db:fail") c)). } % vim: set spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/lens.elpi000066400000000000000000000077711523041753400215050ustar00rootroot00000000000000/* A lens, to see better */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive.lens { :index (1 2) func build-lens record-decl, list (option constant), int, term -> list (pair id constant), list term. build-lens end-record [] _ _ [] []. build-lens (field _ _ _ Fields) [none|Projs] N RTy IDL BOL :- if (pi x\ occurs x (Fields x)) (stop "derive.lens: dependent records not supported") true, M is N + 1, Dummy = sort prop, build-lens (Fields Dummy) Projs M RTy IDL BOL. build-lens (field _ ID Ty Fields) [some P|Projs] N RTy [pr ID P|IDL] [Lens|BOL] :- if (pi x\ occurs x (Fields x)) (stop "derive.lens: dependent records not supported") true, View = {{ fun (r : lp:RTy) => lp:{{ % Coq term {coq.build-match {{r}} RTy (constant-rty Ty) (build-view N)} % Elpi "function" to build a match, see coq-lib.elpi }} }}, % we let Coq infer the type of f at type checking time Over = {{ fun f (r : lp:RTy) => lp:{{ {coq.build-match {{r}} RTy (constant-rty RTy) (build-over N {{f}})} }} }}, Lens = {{ lib:@elpi.derive.lens.make _ _ _ _ lp:View lp:Over }}, M is N + 1, Dummy = sort prop, build-lens (Fields Dummy) Projs M RTy IDL BOL. % builds the return type of the match func constant-rty term, term, list term, list term -> term. constant-rty X _ _ _ X. % builds the match branch for view, L is the list of arguments to % the record constructor func build-view int, term, term, list term, list term -> term. build-view N _ _ L _ R :- std.nth N L R. % builds the match branch for over, K is the record constructor (already % applied) to the record parameters func build-over int, term, term, term, list term, list term -> term. build-over N F K _ L _ R :- std.split-at N L Before [X|After], coq.mk-app K {std.append Before [{{ lp:F lp:X }}|After]} R. % moves under the paramters of the inductive type type and binds them back % as a lambd abstraction over all the lenses that were built :index (1) func params indt-decl, list (option constant), term -> list (pair id constant), list term. params (parameter ID _ Ty Decl) Projs RTy IL TL :- coq.id->name ID Name, (@pi-decl Name Ty x\ params (Decl x) Projs {coq.mk-app RTy [x]} IL (BL x)), distribute-abstraction Name Ty BL TL. params (record _ _ _ RD) Projs RTy IL TL :- build-lens RD Projs 0 RTy IL TL. params (inductive ID _ _ _) _ _ _ _ :- M is "derive.lens: " ^ ID ^ " is not a record", stop M. % distributes a lambda abstraction to all items in the list func distribute-abstraction name, term, (term -> list term) -> list term. distribute-abstraction _ _ (_\[]) [] :- !. distribute-abstraction Name Ty (x\[T x|L x]) [fun Name Ty T|L1] :- distribute-abstraction Name Ty L L1. % typechecks and declares the lens func declare-lens string, inductive, pair id constant, term -> prop. declare-lens Prefix I (pr FieldName Proj) RawBody (lens-db I Proj C):- Name is Prefix ^ FieldName, coq.env.indt I _ Nparams _ _ _ _, % In order to support primitive records we call the elaborator, which % eventually compiles the match into primitive projections std.assert-ok! (coq.elaborate-skeleton RawBody Ty Body) "derive.lens generates illtyped term", ((pi P P1 N\ copy (primitive (proj P N)) (primitive (proj P1 N)) :- coq.primitive.projection-unfolded P1 P, !) => copy Body Body1), coq.env.add-const Name Body1 Ty @transparent! C, std.map {std.iota Nparams} (_\r\ r = maximal) Implicits, if (Nparams > 0) (@global! => coq.arguments.set-implicit (const C) [Implicits, []]) true. func main inductive, string -> list prop. main I Prefix Clauses :- std.do! [ coq.env.indt-decl I Decl, % easy to recurse on coq.env.projections I Projs, params Decl Projs (global (indt I)) Names_Projs Defs, std.map2 Names_Projs Defs (declare-lens Prefix I) Clauses, std.forall Clauses (c\coq.elpi.accumulate _ "derive.lens.db" (clause _ _ c)), ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/lens_laws.elpi000066400000000000000000000123231523041753400225200ustar00rootroot00000000000000/* Equations on lenses */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace derive.lens-laws { func declare-law1 string, prop. declare-law1 Prefix (lens-db I FC C) :- std.do! [ coq.env.indt-decl I Decl, law1 Decl (global (const C)) (global (indt I)) Bo, coq.gref->id (const FC) F, Name is Prefix ^ F ^ "_view_set", coq.env.add-const Name Bo _ @opaque! _, ]. func law1 indt-decl, term, term -> term. law1 (parameter ID _ Ty Rest) Lens Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law1 (Rest p) {coq.mk-app Lens [p]} {coq.mk-app Ind [p]} (Bo p). law1 _ Lens IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law1-rty.aux Lens) law1-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.view_set lp:Lens }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law1 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law1 proof illtyped". func law1-rty.aux term, term, list term, list term -> term. law1-rty.aux L _ Vs _ {{ lib:elpi.derive.lens.view_set_on lp:L lp:R }} :- std.last Vs R. func law1-bo.aux term, term, list term, list term -> term. law1-bo.aux _ _ _ _ {{ fun x => lib:@elpi.erefl _ _ }}. func declare-law2 string, prop. declare-law2 Prefix (lens-db I FC C) :- std.do! [ coq.env.indt-decl I Decl, law2 Decl (global (const C)) (global (indt I)) Bo, coq.gref->id (const FC) F, Name is Prefix ^ F ^ "_set_set", coq.env.add-const Name Bo _ @opaque! _, ]. func law2 indt-decl, term, term -> term. law2 (parameter ID _ Ty Rest) Lens Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law2 (Rest p) {coq.mk-app Lens [p]} {coq.mk-app Ind [p]} (Bo p). law2 _ Lens IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law2-rty.aux Lens) law2-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.set_set lp:Lens }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law2 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law2 proof illtyped". func law2-rty.aux term, term, list term, list term -> term. law2-rty.aux L _ Vs _ {{ lib:elpi.derive.lens.set_set_on lp:L lp:R }} :- std.last Vs R. func law2-bo.aux term, term, list term, list term -> term. law2-bo.aux _ _ _ _ {{ fun x y => lib:@elpi.erefl _ _ }}. func declare-law3 string, prop. declare-law3 Prefix (lens-db I FC C) :- std.do! [ coq.env.indt-decl I Decl, law3 Decl (global (const C)) (global (indt I)) Bo, coq.gref->id (const FC) F, Name is Prefix ^ F ^ "_set_view", coq.env.add-const Name Bo _ @opaque! _, ]. func law3 indt-decl, term, term -> term. law3 (parameter ID _ Ty Rest) Lens Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law3 (Rest p) {coq.mk-app Lens [p]} {coq.mk-app Ind [p]} (Bo p). law3 _ Lens IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law3-rty.aux Lens) law3-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.set_view lp:Lens }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law3 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law3 proof illtyped". func law3-rty.aux term, term, list term, list term -> term. law3-rty.aux L _ Vs _ {{ lib:elpi.derive.lens.set_view_on lp:L lp:R }} :- std.last Vs R. func law3-bo.aux term, term, list term, list term -> term. law3-bo.aux _ _ _ _ {{ lib:@elpi.erefl _ _ }}. func declare-law4 string, prop, prop. declare-law4 _ (lens-db I F C) (lens-db I F C) :- !. declare-law4 Prefix (lens-db I FC1 C1) (lens-db I FC2 C2) :- std.do! [ coq.env.indt-decl I Decl, law4 Decl (global (const C1)) (global (const C2)) (global (indt I)) Bo, coq.gref->id (const FC1) F1, coq.gref->id (const FC2) F2, Name is Prefix ^ F1 ^ "_" ^ F2 ^ "_exchange", coq.env.add-const Name Bo _ @opaque! _, ]. func law4 indt-decl, term, term, term -> term. law4 (parameter ID _ Ty Rest) Lens1 Lens2 Ind {{ fun p : lp:Ty => lp:(Bo p) }} :- !, @pi-parameter ID Ty p\ law4 (Rest p) {coq.mk-app Lens1 [p]} {coq.mk-app Lens2 [p]} {coq.mk-app Ind [p]} (Bo p). law4 _ Lens1 Lens2 IT Bo :- BoS = {{ fun r => lp:{{ {coq.build-match {{r}} IT (law4-rty.aux Lens1 Lens2) law4-bo.aux } }} }}, TyS = {{ lib:elpi.derive.lens.exchange lp:Lens1 lp:Lens2 }}, std.assert-ok! (coq.elaborate-ty-skeleton TyS _ Ty) "derive.lens_laws: law4 statement illtyped", std.assert-ok! (coq.elaborate-skeleton BoS Ty Bo) "derive.lens_laws: law4 proof illtyped". func law4-rty.aux term, term, term, list term, list term -> term. law4-rty.aux L1 L2 _ Vs _ {{ lib:elpi.derive.lens.exchange_on lp:L1 lp:L2 lp:R }} :- std.last Vs R. func law4-bo.aux term, term, list term, list term -> term. law4-bo.aux _ _ _ _ {{ fun x y => lib:@elpi.erefl _ _ }}. func main inductive, string -> list prop. main I Prefix [lens-laws-done I] :- std.do! [ std.findall (lens-db I F_ L_) Lenses, std.forall Lenses (declare-law1 Prefix), std.forall Lenses (declare-law2 Prefix), std.forall Lenses (declare-law3 Prefix), std.forall Lenses (l1\ std.forall Lenses (l2\ declare-law4 Prefix l1 l2)), coq.elpi.accumulate _ "derive.lens_laws.db" (clause _ _ (lens-laws-done I)), ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/map.elpi000066400000000000000000000230061523041753400213060ustar00rootroot00000000000000/* map over a container */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{split-at, length, rev, append, do!, drop-last, assert!}. map-db (app[global (indt GR1)|A1]) (app[global (indt GR2)|A2]) R :- coq.env.indt GR1 _ Lno1 _ _ _ _, coq.env.indt GR2 _ Lno2 _ _ _ _, {length A1} > Lno1, {length A2} > Lno2, split-at Lno1 A1 Args1 Points1, split-at Lno2 A2 Args2 Points2, Points1 = Points2, !, map-db {coq.mk-app (global (indt GR1)) Args1} {coq.mk-app (global (indt GR2)) Args2} F, coq.mk-app F Points1 R. namespace derive.map { % Building the body %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred bo-idx i:term, % inductive arity (input) i:term, % inductive type (input) applied to params & idx handled so far i:term, % inductive type (output) applied to params & idx handled so far i:int, % current index no o:int, % Recno i:list term, % rev list of (output) parameters o:term, % body o:term. % type bo-idx (prod _ S1 T1) Ity1 Ity2 N M Ps (fun `x` S1 Bo) (prod `x` S1 Ty) :- !, pi x\ sigma Ity1x Ity2x\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [x] Ity2x, N1 is N + 1, decl x `x` S1 => bo-idx (T1 x) Ity1x Ity2x N1 M Ps (Bo x) (Ty x). bo-idx (sort _) Ity1 Ity2 N N Ps (fun `x` Ity1 Bo) (prod `_` Ity1 _\ Ity2) :- !, @pi-decl `x` Ity1 x\ coq.build-match x Ity1 (bo-idx-rty Ps Ity2) (bo-k-args Ps) (Bo x). bo-idx X Ity1 Ity2 N M Ps R1 R2 :- whd1 X X1, !, bo-idx X1 Ity1 Ity2 N M Ps R1 R2. pred bo-idx-rty i:list term, i:term, i:term, i:list term, i:list term, o:term. bo-idx-rty Ps ItyArgs _ Vs _ R :- rev Vs [_|IdxsRev], rev IdxsRev Idxs, coq.safe-dest-app ItyArgs HD _, coq.mk-app HD {append {rev Ps} Idxs} R. pred bo-k-args i:list term, i:term, i:term, i:list term, i:list term, o:term. bo-k-args ParamsRev K _ Args Tys R :- rev ParamsRev Params, coq.safe-dest-app K (global (indc GR)) _, coq.env.typeof (indc GR) T, coq.subst-prod Params T KT, (bo-k-args.aux {coq.mk-app (global (indc GR)) Params} Args Tys KT R). pred bo-k-args.aux i:term, i:list term, i:list term, i:term, o:term. bo-k-args.aux R [] [] _ R. bo-k-args.aux K [A|As] [T|Ts] (prod _ S Ty) R :- map-db T S F, coq.mk-app F [A] FA, bo-k-args.aux {coq.mk-app K [FA]} As Ts (Ty FA) R. bo-k-args.aux K [A|As] [_|Ts] (prod _ _ Ty) R :- !, bo-k-args.aux {coq.mk-app K [A]} As Ts (Ty A) R. bo-k-args.aux K As Ts X R :- whd1 X X1, !, bo-k-args.aux K As Ts X1 R. pred map-pi i:any, o:list prop. map-pi (x\ []) []. map-pi (x\ [X x| XS x]) [pi x\ X x | YS] :- map-pi XS YS. pred mk-map-ty i:term, % input variable i:term, % and its type i:term, % output variable i:term, % an its type o:term, % type of a mapping function from input to output i:term, % map function (having the type above) o:int, % arity of the predicate o:list prop. % map-db clause for map function mk-map-ty A (prod _ SA T1) B (prod _ SB T2) (prod `x` SA x\ R x) F N C1 :- map-db SA SB Fa, !, (pi x\ sigma Ax Fx BFx \ coq.mk-app A [x] Ax, coq.mk-app Fa [x] Fx, coq.mk-app B [Fx] BFx, mk-map-ty Ax (T1 x) BFx (T2 BFx) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty A (prod _ S1 T1) B (prod _ _ T2) (prod `x` S1 x\ R x) F N C1 :- (pi x\ sigma Ax Bx \ coq.mk-app A [x] Ax, coq.mk-app B [x] Bx, mk-map-ty Ax (T1 x) Bx (T2 x) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty (app[X|XS] as A) _ (app[Y|YS] as B) _ (prod `x` A _\ B) (app [G|GS] as F) 0 [map-db PLA PLB PLF,map-db A B F] :- drop-last 1 XS LA, drop-last 1 YS LB, drop-last 1 GS LF, coq.mk-app X LA PLA, coq.mk-app Y LB PLB, coq.mk-app G LF PLF. mk-map-ty A _ B _ (prod `x` A _\ B) F 0 [map-db A B F]. % Build a clause %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred mk-clause i:int, % current parameter i:int, % number of parameters i:term, % inductive type (input) i:term, % inductive type (output) i:term, % arity of the inductive i:list prop, % premises of the clause i:term, % map function o:prop. % clause for map-db mk-clause N N Ity1 Ity2 _ Todo Map (map-db Ity1 Ity2 Map :- Todo). mk-clause N Lno Ity1 Ity2 (prod _ _ T) Todo Map (pi x y f\ C x y f) :- !, N1 is N + 1, pi x y f\ sigma Ity1x Ity2y Mapf\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [y] Ity2y, coq.mk-app Map [x,y,f] Mapf, mk-clause N1 Lno Ity1x Ity2y (T x) [map-db x y f|Todo] Mapf (C x y f). mk-clause N Lno Ity1 Ity2 X Todo Map C :- whd1 X X1, !, mk-clause N Lno Ity1 Ity2 X1 Todo Map C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% kind mutual-spec type. type mutual-spec inductive -> string -> term -> term -> term -> term -> mutual-spec. func build-mutual-spec bool, string, inductive -> mutual-spec. build-mutual-spec Mutual Prefix GR (mutual-spec GR Prefix1 T T Arity Arity) :- T = global (indt GR), if (Mutual = tt) (Prefix1 is {coq.gref->id (indt GR)} ^ "_") (Prefix1 is Prefix), coq.env.indt GR _ _ _ Arity _ _. func mutual-spec-apply-param term, term, mutual-spec -> mutual-spec. mutual-spec-apply-param A B (mutual-spec GR Prefix Ity1 Ity2 (prod _ _ F1) (prod _ _ F2)) (mutual-spec GR Prefix Ity1A Ity2B (F1 A) (F2 B)) :- !, coq.mk-app Ity1 [A] Ity1A, coq.mk-app Ity2 [B] Ity2B. mutual-spec-apply-param _ _ _ _ :- stop "derive.map: mutual parameter mismatch". func mutual-map-clause mutual-spec, term -> prop. mutual-map-clause (mutual-spec _ _ Ity1 Ity2 _ _) F (map-db Ity1 Ity2 F). pred bo-fix-aux list term, mutual-spec -> triple term term int. bo-fix-aux _ (mutual-spec _ _ Ity1 Ity2 Arity _) (triple Body Ty Recno) :- coq.safe-dest-app Ity2 _ Params, std.rev Params ParamsRev, bo-idx Arity Ity1 Ity2 0 Recno ParamsRev Body Ty. func bo-mfix list mutual-spec, list mutual-spec, list term, list term, list term, list int -> mfix-block, list term, list int. bo-mfix All [] Ps RevF TysRev RecnosRev (mfix-bo Bodies) Tys Recnos :- !, std.do! [ std.rev RevF Funs, std.map2 All Funs mutual-map-clause Clauses, Clauses =!=> std.map All (bo-fix-aux Ps) Bodies_Tys_Recnos, std.map Bodies_Tys_Recnos triple_1 Bodies, std.map Bodies_Tys_Recnos triple_2 Tys, std.map Bodies_Tys_Recnos triple_3 Recnos, std.rev Recnos RecnosRev, std.rev Tys TysRev, ]. bo-mfix All [S|SS] Ps RevF Tys Recnos (mfix-ty N Recno Ty Rest) TysR RecnosR :- S = mutual-spec GR _ _ _ _ _, ID is {coq.gref->id (indt GR)} ^ "_map_rec", coq.id->name ID N, @pi-decl N Ty f\ bo-mfix All SS Ps [f|RevF] [Ty|Tys] [Recno|Recnos] (Rest f) TysR RecnosR. func bo-fix list mutual-spec, list term, int -> term. bo-fix [(mutual-spec GR _ _ _ _ _ as S)] Ps _ (fix N Recno Ty Bo) :- coq.env.recursive? GR, !, ID is {coq.gref->id (indt GR)} ^ "_map_rec", coq.id->name ID N, @pi-decl N Ty f\ mutual-map-clause S f (C f), C f =!=> bo-fix-aux Ps S (triple (Bo f) Ty Recno), coq.typecheck (Bo f) _ ok, !. % the first that typechecks bo-fix [S] Ps _ Bo :- !, std.assert! (bo-fix-aux Ps S (triple BoS _ _), coq.elaborate-skeleton BoS _ Bo ok) "derive.map: failed to generate mutual map body". % primitive records need elaboration bo-fix Specs Ps Focus (mfix Focus Recno Block) :- bo-mfix Specs Specs Ps [] [] [] Block Tys_ Recnos, std.nth Focus Recnos Recno, coq.typecheck (mfix Focus Recno Block) _ ok, !. % the first that typechecks func bo-params int, int, list mutual-spec, int, list term -> term. bo-params Lno Lno Specs Focus Ps R :- !, bo-fix Specs Ps Focus R. bo-params N Lno ([S|_] as Specs) Focus Ps R :- N < Lno, S = mutual-spec _ _ _ _ (prod A Sty1 _Rty1) (prod _ Sty2 _Rty2), !, coq.name-suffix A 1 A1, coq.name-suffix A 2 A2, coq.name-suffix A "f" Af, N1 is N + 1, (pi a b f\ std.assert! (mk-map-ty a Sty1 b Sty2 (FAB a b) f _ (Clause a b f)) "derive.map: failed to generate parameter map clause"), R = (fun A1 Sty1 a\ fun A2 Sty2 b\ fun Af (FAB a b) f\ Bo a b f), pi a b f\ sigma Specs1\ std.map Specs (mutual-spec-apply-param a b) Specs1, Clause a b f => decl a A1 Sty1 => decl b A2 Sty2 => decl f Af (FAB a b) => bo-params N1 Lno Specs1 Focus [b|Ps] (Bo a b f). bo-params _ _ _ _ _ _ :- stop "derive.map: mutual indexed data types not supported". func add-mutual-map-consts list mutual-spec, list mutual-spec, int, int -> list prop. add-mutual-map-consts _ [] _ _ [] :- !. add-mutual-map-consts All [S|SS] Lno Focus [map-done GR,Clause|CS] :- std.do! [ S = mutual-spec GR Prefix T T Arity _, bo-params 0 Lno All Focus [] RSkel, std.assert-ok! (coq.elaborate-skeleton RSkel Ty R) "derive.map generates illtyped mutual term", Name is Prefix ^ "map", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName R Ty @transparent! Funct, mk-clause 0 Lno T T Arity [] (global (const Funct)) Clause, coq.elpi.accumulate _ "derive.map.db" (clause _ _ Clause), coq.elpi.accumulate _ "derive.map.db" (clause _ _ (map-done GR)), Focus1 is Focus + 1, add-mutual-map-consts All SS Lno Focus1 CS ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main-mutual int, list inductive, string -> list prop. main-mutual Lno GRS Prefix C :- std.do! [ if (std.length GRS 1) (IsMutual = ff) (IsMutual = tt), std.map GRS (build-mutual-spec IsMutual Prefix) Specs, add-mutual-map-consts Specs Specs Lno 0 C ]. func main inductive, string -> list prop. main GR Prefix C :- coq.env.indt-block GR _ Lno Luno GRS _ _ _, assert! (Lno = Luno) "derive.map: Non-uniform parameters not supported", main-mutual Lno GRS Prefix C. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/param1.elpi000066400000000000000000000253131523041753400217150ustar00rootroot00000000000000/* Unary parametricity translation (Realizability) */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Author: Cyril Cohen shorten std.{forall, forall2, do!, rev, map2, map, append}. :before "subst-fun:fail" coq.subst-fun XS T TXS :- !, coq.mk-app T XS TXS. % this is outside the namespace since the predicate is also the db-one reali (sort prop as P) (fun `s` P x\ prod `s1` x _\ P) :- !. reali (sort _) (fun `s` (sort (typ U)) x\ prod `s1` x _\ (sort (typ V))) :- !, coq.univ.new U, coq.univ.new V. reali (fun N T B) (fun N T x\ fun N1 (TRsubst x) xR\ BR x xR) :- !, do! [ coq.name-suffix `P` N N1, reali T TR, (pi x xR\ reali x xR => reali (B x) (BR x xR)), (TRsubst = x\ {coq.subst-fun [x] TR}) ]. reali (prod N T P as Prod) ProdR :- !, do! [ coq.name-suffix `P` N N1, reali T TR, (pi x xR\ reali x xR => reali (P x) (PR x xR)), ProdR = fun `f` Prod f\ prod N T x\ prod N1 {coq.subst-fun [x] TR} xR\ {coq.subst-fun [{coq.mk-app f [x]}] (PR x xR)} ]. reali (app [A|Bs]) ARBsR :- !, do! [ reali A AR, derive.param1.reali-args Bs BsR, coq.mk-app AR BsR ARBsR ]. reali (let N T V B) LetR :- !, std.do! [ coq.name-suffix `P` N N1, reali T TR, reali V VR, (pi x xR\ reali x xR => reali (B x) (BR x xR)), LetR = let N T V x\ let N1 {coq.mk-app TR [x]} VR xR\ BR x xR ]. reali (match T P Bs) MR :- !, do! [ reali T TR, derive.param1.reali-match P PRM, reali T TR => derive.param1.reali-map Bs BsR, MR = match TR (PRM (x\ match x P Bs)) BsR ]. reali (fix N Rno T F as Fix) FixR :- !, std.do! [ RnoR is 2 * Rno + 1, RnoR1 is RnoR + 1, reali T TR, (pi x xR\ reali x xR => reali (F x) (FR x xR)), (TRsubst = f\ {coq.subst-fun [f] TR}), (pi f xR\ FixBody f xR = let N (TRsubst (F f)) (FR f xR) fr\ {paramX.mk-trivial-match RnoR (TRsubst f) [] fr}), (pi f xR\ coq.mk-eta RnoR1 (TRsubst f) (FixBody f xR) (EtaFixBody f xR)), coq.name-suffix N 1 N1, FixR = (let N T Fix f\ fix N1 RnoR (TRsubst f) xR\ EtaFixBody f xR), ]. namespace derive.param1 { pred reali-args o:list term, o:list term. reali-args [] []. reali-args [X|Xs] [X,XR|XsR] :- do! [ reali X XR, reali-args Xs XsR ]. pred reali-map o:list term, o:list term. reali-map [] []. reali-map [X|Xs] [XR|XsR] :- do! [ reali X XR, reali-map Xs XsR ]. % helpers for match return type pred reali-match i:term, o:((term -> term) -> term). reali-match (fun N T B) PRM :- pi x\ not (B x = fun _ _ _), !, do! [ reali T TR, (pi x xR\ reali x xR => reali (B x) (BR x xR)), coq.name-suffix `P` N N1, (pi z z1\ PRM z = fun N T x\ fun N1 {coq.subst-fun [x] TR} xR\ {coq.mk-app (BR x xR) [z x]}) ]. reali-match (fun N T B) PRM :- do! [ reali T TR, (pi x xR\ (reali x xR ==> reali-match (B x) (BR x xR))), coq.name-suffix N 1 N1, (pi z \ PRM z = fun N T x\ fun N1 {coq.subst-fun [x] TR} xR\ BR x xR z) ]. % Storage: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func reali-store string, % Name suffix for the type class term, % Term term -> . % Translation reali-store N X XR :- !, Nreali is "reali_" ^ N, Args = [_, _, X, XR], T1 = app [{{ lib:@param1.store_reali }}|Args], std.assert-ok! (coq.typecheck T1 T2) "reali-store: T1 illtyped", coq.ensure-fresh-global-id Nreali FNreali, coq.env.add-const FNreali T1 T2 _ GR, @global! => coq.TC.declare-instance (const GR) 0. pred reali-store-indc i:string, i:constructor, i:constructor. reali-store-indc Prefix K XR :- reali-store {calc (Prefix ^ {coq.gref->id (indc K)})} (global (indc K)) (global (indc XR)). kind raw-mindt-spec type. type raw-mindt-spec inductive -> id -> bool -> term -> list constructor -> list (pair constructor id) -> list term -> raw-mindt-spec. func build-raw-mutual-spec string, inductive -> raw-mindt-spec. build-raw-mutual-spec Prefix GR (raw-mindt-spec GR FNewName IsInd Ty KNames KNamesR KTypes) :- coq.env.indt GR IsInd _ _ Ty KNames KTypes, coq.gref->id (indt GR) ID, std.map KNames (prefix-indc Prefix) KNamesR, NewName is Prefix ^ ID, coq.ensure-fresh-global-id NewName FNewName. func translate-mutual-spec raw-mindt-spec, inductive -> coq.indt-spec. translate-mutual-spec (raw-mindt-spec GR FNewName IsInd Ty KNames KNamesR KTypes) NewGR (coq.indt-spec NewGR FNewName IsInd TyOut KNamesR KTypesR) :- Ind = global (indt GR), reali Ty TyR, coq.mk-app TyR [Ind] TyOut, map2 KNames KTypes (k\ ty\ r\ sigma tyr\ reali ty tyr, coq.mk-app tyr [global (indc k)] r) KTypesR. func main-mblock list raw-mindt-spec, list raw-mindt-spec, list inductive -> list prop. main-mblock All [] Acc Clauses :- !, rev Acc NewGRs, main-mblock-aux All NewGRs Clauses. main-mblock All [raw-mindt-spec GR _ _ _ _ _ _|Rest] Acc Clauses :- % a fresh name for each inductive pi newGR\ (reali (global (indt GR)) (global (indt newGR)) :- !) => main-mblock All Rest [newGR|Acc] Clauses. func reali-store-mutual-indt list raw-mindt-spec, list inductive -> . reali-store-mutual-indt [] []. reali-store-mutual-indt [raw-mindt-spec GR FNewName _ _ _ _ _|MoreInd] [RealGR|MoreGR] :- reali-store FNewName (global (indt GR)) (global (indt RealGR)), reali-store-mutual-indt MoreInd MoreGR. func reali-store-mutual-indcs string, list constructor, list constructor -> . reali-store-mutual-indcs _ [] []. reali-store-mutual-indcs Prefix [K|KS] [KR|KRS] :- N is Prefix ^ {coq.gref->id (indc K)}, reali-store N (global (indc K)) (global (indc KR)), reali-store-mutual-indcs Prefix KS KRS. func reali-store-mutual-indc list raw-mindt-spec, list inductive -> . reali-store-mutual-indc [] []. reali-store-mutual-indc [raw-mindt-spec _ FNewName _ _ KNames _ _|Raws] [RealGR|RealGRs] :- coq.env.indt RealGR _ _ _ _ RealKNames _, Prefix1 is FNewName ^ "_", reali-store-mutual-indcs Prefix1 KNames RealKNames, reali-store-mutual-indc Raws RealGRs. func build-and-accumulate-clauses list raw-mindt-spec, list inductive -> list prop. build-and-accumulate-clauses [] [] []. build-and-accumulate-clauses [raw-mindt-spec GR _ _ _ KNames _ _|Raws] [RealGR|RealGRs] Clauses :- coq.env.indt RealGR _ _ _ _ RealKNames _, map2 KNames RealKNames (a\ b\ r\ r = (reali (global (indc a)) (global (indc b)) :- !)) CK, CDone = reali-done (indt GR), CReali = (reali (global (indt GR)) (global (indt RealGR)) :- !), CRealiR = (realiR (global (indt GR)) (global (indt RealGR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ _ CDone), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "realiR:fail") CRealiR), std.forall [CReali|CK] (x\coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") x)), build-and-accumulate-clauses Raws RealGRs Rest, append[CDone, CReali, CRealiR | CK] Rest Clauses. func main-mblock-aux list raw-mindt-spec, list inductive -> list prop. main-mblock-aux Raws NewGRs Clauses :- std.do! [ map2 Raws NewGRs translate-mutual-spec Specs, coq.build-mindt-decl Specs 0 0 DeclR, std.assert-ok! (coq.typecheck-indt-decl DeclR) "derive.param1 generates illtyped mutual inductive", coq.env.add-indt DeclR RealGR, coq.env.indt-block RealGR _ _ _ RealGRs _ _ _, reali-store-mutual-indt Raws RealGRs, reali-store-mutual-indc Raws RealGRs, build-and-accumulate-clauses Raws RealGRs Clauses, ]. func prefix-indc string, constructor -> pair constructor id. prefix-indc Prefix K (pr K FNewName) :- coq.gref->id (indc K) Name, NewName is Prefix ^ Name, coq.ensure-fresh-global-id NewName FNewName. % toplevel predicates %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :index (1) func dispatch gref, % input of the translation string % the name -> list prop. % the clause dispatch (const GR) Prefix Clauses :- !, do! [ Term = global (const GR), Name is Prefix ^ {coq.gref->id (const GR)}, std.assert! (coq.env.const GR (some V) Ty) "param1: cannot handle axioms", reali V VR, reali Ty TyR, coq.mk-app TyR [Term] TyRV, % coq.typecheck is needed to add universe constraints std.assert-ok! (coq.typecheck TyRV _) "param1: illtyped param type", % apparently calling the type checker with the expected type is weaker in this case std.assert-ok! (coq.typecheck VR VRTy) "param1: illtyped constant", std.assert-ok! (coq.unify-leq VRTy TyRV) "param1: constant does not have the right type", coq.ensure-fresh-global-id Name FName, coq.env.add-const FName VR TyRV _ TermR, reali-store Name Term (global (const TermR)), C1 = (reali Term (global (const TermR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") C1), C2 = (realiR Term (global (const TermR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "realiR:fail") C2), coq.elpi.accumulate _ "derive.param1.db" (clause _ _ (reali-done (const GR))), Clauses = [C1, C2, reali-done (const GR)] ]. dispatch (indt GR) Prefix Clauses :- coq.env.indt-block GR _ Lno Luno GRS _ _ _, std.length GRS N, N > 1, !, do! [ map GRS (build-raw-mutual-spec Prefix) Raws, std.assert! (Lno = Luno) "derive.param1: Non-uniform parameters not supported", main-mblock Raws Raws [] Clauses ]. dispatch (indt GR) Prefix Clauses :- !, do! [ Ind = global (indt GR), coq.env.indt GR _ _ Lno Ty Knames Ktypes, LnoR is 2 * Lno, pi new_name\ sigma KnamesR KtypesR TyR\ ( (reali Ind (global (indt new_name)) ==> reali Ty TyR, map2 Knames Ktypes (k\ ty\ r\ sigma tyr\ reali ty tyr, coq.subst-fun [global (indc k)] tyr r) KtypesR), map Knames (prefix-indc Prefix) KnamesR, NewName is Prefix ^ {coq.gref->id (indt GR)}, coq.ensure-fresh-global-id NewName FNewName, coq.build-indt-decl (coq.indt-spec new_name FNewName tt {coq.subst-fun [Ind] TyR} KnamesR KtypesR) LnoR LnoR DeclR ), std.assert-ok! (coq.typecheck-indt-decl DeclR) "derive.param1 generates illtyped inductive", coq.env.add-indt DeclR GRR, reali-store NewName Ind (global (indt GRR)), coq.env.indt GRR _ _ _ _ RealNamesR _, Prefix1 is NewName ^ "_", forall2 Knames RealNamesR (reali-store-indc Prefix1), C1 = (reali Ind (global (indt GRR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") C1), C2 = (realiR Ind (global (indt GRR)) :- !), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "realiR:fail") C2), map2 Knames RealNamesR (a\ b\ r\ r = (reali (global (indc a)) (global (indc b)) :- !)) CK, forall CK (c\ coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") c)), coq.elpi.accumulate _ "derive.param1.db" (clause _ _ (reali-done (indt GR))), Clauses = [reali-done (indt GR), C1,C2|CK] ]. dispatch (indc _) _ _ :- coq.error "derive.param1: cannot translate a constructor". func main gref, string -> list prop. main T _ Clauses :- dispatch T "is_" Clauses. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/param1_congr.elpi000066400000000000000000000047661523041753400231160ustar00rootroot00000000000000/* param1 holds on the full type */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{forall, map2-filter, do!}. namespace derive.param1.congr { pred body-params i:int, i:term, i:term, i:term, i:term, o:term. body-params 0 (prod X TX x\ prod P (PX x) (Ty x)) KArgs1 KArgs2 R RT :- !, R = {{ fun (x : lp:TX) (p1 p2 : lp:(PX x)) (e : lib:@elpi.eq lp:(PX x) p1 p2) => lp:(Bo x p1 p2 e) }}, RT = {{ forall (x : lp:TX) (p1 p2 : lp:(PX x)) (e : lib:@elpi.eq lp:(PX x) p1 p2), lp:(BoTy x p1 p2 e) }}, @pi-decl X TX x\ @pi-decl P (PX x) p1\ sigma OTy\ @pi-decl P (PX x) p2\ @pi-decl `e` {{ lib:@elpi.eq lp:{{PX x}} lp:p1 lp:p2 }} e\ Bo x p1 p2 e = match e (OT x p1) [B x p1], body-params 0 (Ty x p1) {coq.mk-app KArgs1 [x,p1]} {coq.mk-app KArgs2 [x,p2]} (B1 x p1 p2 e) (RTB x p1 p2 e), OT x p1 = {{ fun (i : lp:{{PX x}}) (eq : lib:@elpi.eq lp:{{PX x}} lp:p1 i) => lp:(OTy i eq) }}, (pi i eq \ (copy p2 i :- !) => (copy e eq :- !) => copy (RTB x p1 p2 e) (OTy i eq)), !, ((copy p2 p1 :- !) => copy (B1 x p1 p2 e) (B x p1)), !, BoTy x p1 p2 e = OTy p2 e. body-params 0 Ty KArgs1 KArgs2 R RT :- !, R = {{ lib:@elpi.erefl lp:Ty lp:KArgs1 }}, RT = {{ lib:@elpi.eq lp:Ty lp:KArgs1 lp:KArgs2 }}. body-params N (prod X TX x\ prod P (PX x) (Ty x)) K1 K2 R RT :- N > 0, M is N - 2, R = {{ fun (x : lp:TX) (p : lp:(PX x)) => lp:(Bo x p) }}, RT = {{ forall (x : lp:TX) (p : lp:(PX x)), lp:(BT x p) }}, @pi-decl X TX x\ @pi-decl P (PX x) p\ body-params M (Ty x p) {coq.mk-app K1 [x,p]} {coq.mk-app K2 [x,p]} (Bo x p) (BT x p). func main-k string, int, constructor, term -> prop. main-k Prefix Lno K KT Clause :- do! [ Name is Prefix ^ {coq.gref->id (indc K)}, body-params Lno KT (global (indc K)) (global (indc K)) R RT_, % coq.say {coq.term->string R}, coq.typecheck R RT ok, coq.env.add-const Name R RT @transparent! Cst, Clause = param1-congr-db K (global (const Cst)) ]. func main gref, gref, string -> list prop. main _ (indt GR) Prefix Clauses2 :- coq.env.indt GR _ Lno _ _ K KT, map2-filter K KT (main-k Prefix Lno) Clauses, Clauses2 = [param1-congr-done (indt GR)|Clauses], forall Clauses2 (x\ coq.elpi.accumulate _ "derive.param1.congr.db" (clause _ _ x)). main _ (const IsGR) _Prefix [param1-congr-done (const IsGR)]. } % vim:set ft=lprolog spelllang=: LPCIC-coq-elpi-eb449d7/apps/derive/elpi/param1_functor.elpi000066400000000000000000000213461523041753400234570ustar00rootroot00000000000000/* map over a container */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, length, split-at, drop-last, rev, append}. param1-functor-db (app[global (indt GR1)|A1]) (app[global (indt GR2)|A2]) R :- coq.env.indt GR1 _ Lno1 _ _ _ _, coq.env.indt GR2 _ Lno2 _ _ _ _, {length A1} > Lno1, {length A2} > Lno2, split-at Lno1 A1 Args1 Points1, split-at Lno2 A2 Args2 Points2, Points1 = Points2, !, param1-functor-db {coq.mk-app (global (indt GR1)) Args1} {coq.mk-app (global (indt GR2)) Args2} F, coq.mk-app F Points1 R. namespace derive.param1.functor { pred skip i:int. % position of a parameter that has to be skipped % Building the body %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func self -> term. :functional pred bo-idx i:term, % inductive arity (input) i:term, % inductive type (input) applied to params & idx handled so far i:term, % inductive type (output) applied to params & idx handled so far i:int, % current index no o:int, % Recno i:list term, % rev list of (output) parameters o:term, % body o:term. % type bo-idx (prod _ S1 T1) Ity1 Ity2 N M Ps (fun `x` S1 Bo) (prod `x` S1 Ty) :- !, pi x\ sigma Ity1x Ity2x\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [x] Ity2x, N1 is N + 1, decl x `x` S1 => bo-idx (T1 x) Ity1x Ity2x N1 M Ps (Bo x) (Ty x). bo-idx (sort _) Ity1 Ity2 N N Ps (fun `x` Ity1 Bo) (prod `_` Ity1 _\ Ity2) :- !, @pi-decl `x` Ity1 x\ coq.build-match x Ity1 (bo-idx-rty Ps Ity2) (bo-k-args Ps) (Bo x). bo-idx X Ity1 Ity2 N M Ps R1 R2 :- whd1 X X1, !, bo-idx X1 Ity1 Ity2 N M Ps R1 R2. func bo-idx-rty list term, term, term, list term, list term -> term. bo-idx-rty Ps ItyArgs _ Vs _ R :- rev Vs [_|IdxsRev], rev IdxsRev Idxs, coq.safe-dest-app ItyArgs HD _, coq.mk-app HD {append {rev Ps} Idxs} R. func bo-k-args list term, term, term, list term, list term -> term. bo-k-args ParamsRev K _ Args Tys R :- rev ParamsRev Params, coq.safe-dest-app K (global (indc GR)) _, coq.env.typeof (indc GR) T, coq.subst-prod Params T KT, (bo-k-args.aux {coq.mk-app (global (indc GR)) Params} Args Tys KT R). func bo-k-args.aux term, list term, list term, term -> term. bo-k-args.aux K [A,PA|Args] [_,TPA|Types] {{ forall x (px : lp:(TPB x)), lp:(Ty x px) }} R :- not(same_term TPA (TPB A)), param1-functor-db TPA (TPB A) F, !, coq.mk-app K [A, {{ lp:F lp:PA }}] KAPFA, bo-k-args.aux KAPFA Args Types (Ty A KAPFA) R. bo-k-args.aux K [A,PA|Args] [_,_|Types] {{ forall x px, lp:(Ty x px) }} R :- coq.mk-app K [A,PA] KAPA, bo-k-args.aux KAPA Args Types (Ty A KAPA) R. bo-k-args.aux R [] [] _ R. % Take in input a mapping function for each parameter (not to be skipped) % and then do the fixpoint func bo-params int, % current parameter int, % number of parameters term, % inductive type (input) applied to parameters handled so far term, % inductive type (output) applied to parameters handled so far term, % inductive arity (input) term, % inductive arity (output) list term % output parameters so far -> term. % map function func mk-rec-clause term, term, term, term -> prop. mk-rec-clause (prod _ _ x\prod _ _ (P x)) T1 T2 F (pi x px\C x px) :- !, pi x px\ mk-rec-clause (P x px) {coq.mk-app T1 [x,px]} {coq.mk-app T2 [x,px]} {coq.mk-app F [x,px]} (C x px). mk-rec-clause (prod _ _ _\sort _) T1 T2 F (param1-functor-db T1 T2 F). func mk-rec-clause-app term, term, term, term -> prop. mk-rec-clause-app (prod _ _ x\prod _ _ (P x)) T1 T2 F (pi x px py\C x px py) :- !, pi x px py\ mk-rec-clause-app (P x px) {coq.mk-app T1 [x,px]} {coq.mk-app T2 [x,py]} {coq.mk-app F [x,px]} (C x px py). mk-rec-clause-app (prod _ _ _\sort S) T1 T2 F (pi x\C x) :- pi x \ mk-rec-clause-app (sort S) {coq.mk-app T1 [x]} {coq.mk-app T2 [x]} {coq.mk-app F [x]} (C x). mk-rec-clause-app (sort _) T1 T2 F (param1-functor-db T1 T2 F). bo-params Lno Lno Ity1 Ity2 A1 _ Ps (fix `f` Recno Fty Bo) :- !, @pi-decl `rec` Fty f\ mk-rec-clause A1 Ity1 Ity2 f (C f), mk-rec-clause-app A1 Ity1 Ity2 f (D f), (D f) =!=> (C f) =!=> bo-idx A1 Ity1 Ity2 0 Recno Ps (Bo f) Fty. bo-params N Lno Ity1 Ity2 {{ forall (a : lp:T1) (p : a -> Type), lp:(Rty1 a p) }} {{ forall (a : _) (p : a -> Type), lp:(Rty2 a p) }} Ps R :- whd T1 [] {{ Type }} [], !, N1 is N + 2, (pi a b f \ mk-map-ty a {{ lp:a -> Type }} b {{ lp:b -> Type }} (FAB a b) f _ (Clause a b f)), R = {{ fun (a : Type) (pa pb : a -> Type) (f : forall x : a, pa x -> pb x) => lp:(Bo a pa pb f) }}, pi a pa pb f\ sigma Ity1A Ity2A \ coq.mk-app Ity1 [a,pa] Ity1A, coq.mk-app Ity2 [a,pb] Ity2A, Clause pa pb f => decl a `a` {{ Type }} => decl pa `pa` {{ lp:a -> Type }} => decl pb `pb` {{ lp:a -> Type }} => decl f `f` (FAB pa pb) => bo-params N1 Lno Ity1A Ity2A (Rty1 a pa) (Rty2 a pb) [pb,a|Ps] (Bo a pa pb f). bo-params N Lno Ity1 Ity2 (prod A Sty1 Rty1) (prod _ _ Rty2) Ps R :- N1 is N + 1, R = (fun A Sty1 a\ Bo a), pi a\ sigma Ity1A Ity2A \ coq.mk-app Ity1 [a] Ity1A, coq.mk-app Ity2 [a] Ity2A, decl a A Sty1 => bo-params N1 Lno Ity1A Ity2A (Rty1 a) (Rty2 a) [a|Ps] (Bo a). func map-pi any -> list prop. map-pi (x\ []) [] :- !. map-pi (x\ [X x| XS x]) [pi x\ X x | YS] :- map-pi XS YS. :functional pred mk-map-ty i:term, % input variable i:term, % and its type i:term, % output variable i:term, % an its type o:term, % type of a mapping function from input to output i:term, % map function (having the type above) o:int, % arity of the predicate o:list prop. % param1-functor-db clause for map function mk-map-ty A (prod _ SA T1) B (prod _ SB T2) (prod `x` SA x\ R x) F N C1 :- param1-functor-db SA SB Fa, !, (pi x\ sigma Ax Fx BFx \ coq.mk-app A [x] Ax, coq.mk-app Fa [x] Fx, coq.mk-app B [Fx] BFx, mk-map-ty Ax (T1 x) BFx (T2 BFx) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty A (prod _ S1 T1) B (prod _ _ T2) (prod `x` S1 x\ R x) F N C1 :- !, (pi x\ sigma Ax Bx \ coq.mk-app A [x] Ax, coq.mk-app B [x] Bx, mk-map-ty Ax (T1 x) Bx (T2 x) (R x) {coq.mk-app F [x]} M (C x), N is M + 1), map-pi C C1. mk-map-ty (app[X|XS] as A) _ (app[Y|YS] as B) _ (prod `x` A _\ B) (app [G|GS] as F) 0 [param1-functor-db PLA PLB PLF,param1-functor-db A B F] :- !, drop-last 1 XS LA, drop-last 1 YS LB, drop-last 1 GS LF, coq.mk-app X LA PLA, coq.mk-app Y LB PLB, coq.mk-app G LF PLF. mk-map-ty A _ B _ (prod `x` A _\ B) F 0 [param1-functor-db A B F]. % Build a clause %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :functional pred mk-clause i:int, % current parameter i:int, % number of parameters i:term, % inductive type (input) i:term, % inductive type (output) i:term, % arity of the inductive i:list (func), % premises of the clause i:term, % map function o:prop, i:inductive, i:list bool, o:prop. % clause for param1-functor-db mk-clause N N Ity1 Ity2 _ Todo Map (param1-functor-db Ity1 Ity2 Map :- [!|Todo]) I Mask (param1-functor-for I F MaskRev) :- !, coq.safe-dest-app Map (global F) _, std.rev Mask MaskRev. mk-clause N Lno Ity1 Ity2 {{ forall (a : lp:Ty) (pa : a -> Type), lp:(T a pa) }} Todo Map (pi x px py f\ C x px py f) I M CF :- whd Ty [] {{ Type }} [], !, N1 is N + 2, pi x px py f\ sigma Ity1x Ity2y Mapf\ coq.mk-app Ity1 [x,px] Ity1x, coq.mk-app Ity2 [x,py] Ity2y, coq.mk-app Map [x,px,py,f] Mapf, mk-clause N1 Lno Ity1x Ity2y (T x px) [param1-functor-db px py f|Todo] Mapf (C x px py f) I [tt,ff|M] CF. mk-clause N Lno Ity1 Ity2 (prod _ _ T) Todo Map (pi x\ C x) I M CF :- !, N1 is N + 1, pi x\ sigma Ity1x Ity2x Mapf\ coq.mk-app Ity1 [x] Ity1x, coq.mk-app Ity2 [x] Ity2x, coq.mk-app Map [x] Mapf, mk-clause N1 Lno Ity1x Ity2x (T x) Todo Mapf (C x) I [ff|M] CF. mk-clause N Lno Ity1 Ity2 X Todo Map C I M CF :- whd1 X X1, !, mk-clause N Lno Ity1 Ity2 X1 Todo Map C I M CF. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func main gref, gref, string -> list prop. main _ (indt GR) Suffix C :- do! [ coq.env.indt GR _Ind Lno Luno Arity _ _, assert! (Lno = Luno) "derive.param1.functor: Non-uniform parameters not supported", % generate map and add to the env T = global (indt GR), bo-params 0 Lno T T Arity Arity [] R, std.assert-ok! (coq.typecheck R Rty) "derive.param1_functor generates illtyped term", Name is {coq.gref->id (indt GR)} ^ Suffix, coq.env.add-const Name R Rty @transparent! Funct, % generate clause and add to the db mk-clause 0 Lno T T Arity [] (global (const Funct)) Clause1 GR [] Clause2, C = [Clause1, Clause2], std.forall C (x\coq.elpi.accumulate _ "derive.param1.functor.db" (clause _ _ x)), ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/param1_inhab.elpi000066400000000000000000000130721523041753400230550ustar00rootroot00000000000000/* param1 holds on the full type */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{zip, assert!, do!, map, map2, rev}. namespace derive.param1.inhab { % local data base to map a constructor K of T (applied to params) to % the pair isK and its type, eg ({{Zero}} `-> pr {{isZero}} {{isNat Zero}})) func (`->) term -> pair term term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func search term, term -> term. % given T and isT it builds a proof forall x:T, isT x search _ Goal P :- std.assert! (param1-inhab-db Goal P) "derive.param1_inhab: cannot prove inhabitation". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func prove-args % for each (K x ..) we must produce (isK x x_isX ..) list term, % the variables (x in the example above) term % the type of isK -> list term. % x and x_isX prove-args [] _ []. prove-args [V|VS] (prod _ T x\ prod _ _ (px\ F x px)) [V,PV | RS] :- reali T TR, !, % out of the type of x we get isX search T TR PT, % PT is a proof that forall x, isX x PV = app[PT,V], % PV is the x_isX above (reali V PV :- !) => prove-args VS (F V PV) RS. func oty (term -> term), term, list term, list term -> term. oty F _ V _ R :- rev V [X|_], R = F X. func body term, term, list term, list term -> term. body K _ V _ R :- coq.safe-dest-app K Kname _, Kname `-> (pr KR KRT), prove-args V KRT Args, coq.mk-app KR Args R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func body-params int, % number of params left term, % inductive type applied to parameters treated so far term, % inductive type arity to process list term, % construcors applied to parameters treated so far list term % construcor's types instantiated to parameters treated so far -> term. body-params 0 IsT (prod _ T _\ sort _) K KT R :- coq.safe-dest-app T (global (indt GR)) _, coq.env.recursive? GR, !, RT = (x\ {coq.mk-app IsT [x]}), R = {{ fix IH (x : lp:T) {struct x} : lp:(RT x) := lp:(Bo IH x) }}, coq.env.indt GR _ _ _ _ KX _, map2 KX {zip K KT} (a\b\r\ r = (global (indc a)) `-> b) K2KR, K2KR =!=> % K `-> (pr isK isKtype) @pi-decl `IH` (prod `x` T x\ RT x) f\ @pi-decl `x` T x\ param1-inhab-db IsT f => coq.build-match x T (oty RT) body (Bo f x). body-params 0 IsT (prod _ T _\ sort _) K KT R :- !, RT = (x\ {coq.mk-app IsT [x]}), R = {{ fun (x : lp:T) => lp:(Bo x) }}, coq.safe-dest-app T (global (indt GR)) _, coq.env.indt GR _ _ _ _ KX _, map2 KX {zip K KT} (a\b\r\ r = (global (indc a)) `-> b) K2KR, K2KR =!=> % K `-> (pr isK isKtype) @pi-decl `x` T x\ coq.build-match x T (oty RT) body (Bo x). % param1 have the form : isT A (P : A -> Type) .. , so we process two % binders at a time and we assume (H : trivial P) for each A and P body-params N IsT (prod A TA a\ prod P (TP a) (F a)) K KT R :- N > 0, coq.sort? TA, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ fun _ {{ lib:elpi.derive.full lp:a lp:p }} pf\ Bo a p pf), @pi-decl A TA a\ @pi-decl P (TP a) p\ @pi-decl _ {{ lib:elpi.derive.full lp:a lp:p }} pf\ sigma KAP KTAP\ map K (k\ coq.mk-app k [a,p]) KAP, map KT (coq.subst-prod [a,p]) KTAP, (reali a p :- !) => param1-inhab-db p pf => % to prove (P x) use (H x) body-params M {coq.mk-app IsT [a,p]} (F a p) KAP KTAP (Bo a p pf). body-params N IsT (prod A TA a\ prod P (TP a) (F a)) K KT R :- N > 0, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ Bo a p), @pi-decl A TA a\ @pi-decl P (TP a) p\ sigma KAP KTAP\ map K (k\ coq.mk-app k [a,p]) KAP, map KT (coq.subst-prod [a,p]) KTAP, (reali a p :- !) => body-params M {coq.mk-app IsT [a,p]} (F a p) KAP KTAP (Bo a p). body-params _ IsT _ _ _ _ :- M is "derive.param1_inhab: wrong shape " ^ {coq.term->string IsT} ^ ". It does not look like a unary parametricity translation of an inductive with no indexes.", stop M. func main gref, gref, string -> list prop. main _ (indt GR) Suffix [ClauseW, param1-inhab-done (indt GR)] :- do! [ coq.env.indt GR Ind Lno Luno Arity K KT, assert! (Ind = tt) "derive.param1_inhab: Coinductive types are not supported", assert! (Lno = Luno) "derive.param1_inhab: Non-uniform parameters not supported", body-params Lno (global (indt GR)) Arity {std.map K (k\r\ r = global (indc k))} KT RSkel, % coq.say {coq.term->string R}, std.assert-ok! (coq.elaborate-skeleton RSkel RT R) "derive.param1_inhab generates illtyped term", Name is {coq.gref->id (indt GR)} ^ Suffix, coq.env.add-const Name R RT @transparent! Witness, ClauseW = (param1-inhab-db (global (indt GR)) (global (const Witness))), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ ClauseW), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-inhab-done (indt GR))), ]. main (const GR) (const IsGR) Suffix [ClauseW, param1-inhab-done (const IsGR)] :- do! [ coq.env.const GR (some T) _, coq.env.const IsGR (some IsT) _, search T IsT P, std.assert-ok! (coq.elaborate-skeleton P RT R) "derive.param1_inhab generates illtyped term", Name is {coq.gref->id (const IsGR)} ^ Suffix, coq.env.add-const Name R RT @transparent! Witness, ClauseW = (param1-inhab-db (global (const IsGR)) (global (const Witness))), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ ClauseW), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-inhab-done (const IsGR))), ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/param1_trivial.elpi000066400000000000000000000130761523041753400234520ustar00rootroot00000000000000/* param1 holds on the full type */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{assert!, do!, drop-last}. namespace derive.param1.trivial { func prove-args list term, list term -> list term. prove-args [] [] []. prove-args [X,PX|Rest] [TX,TPX_X|TRest] [X,P1,PX,P2|PRest] :- coq.safe-dest-app TPX_X HD ARGS, drop-last 1 ARGS ARG, coq.mk-app HD ARG TPX, param1-trivial-db TPX P, !, P1 = {{ lib:elpi.derive.trivial_full lp:TX lp:TPX lp:P lp:X }}, P2 = {{ lib:elpi.derive.trivial_uniq lp:TX lp:TPX lp:P lp:X lp:PX }}, prove-args Rest TRest PRest. func oty term, term, term, list term, list term -> term. oty IsT W _ [Idx,V] _ {{ lib:@elpi.eq lp:Ty lp:Wx lp:V }} :- Ty = app[IsT,Idx], Wx = app[W,Idx]. func body term, term, term, term, list term, list term -> term. body _ _ K (app _) V VT R :- std.do! [ /* coq.safe-dest-app K (global (indc Kname)) Params, prove-args V VT P, assert! (param1-congr-db Kname CongrK) "run derive.param1.congr first", coq.mk-app CongrK Params Rhd, coq.mk-app Rhd P R,*/ trivialize-param1 V VT Triv, do-args {std.rev V} {std.rev VT} {std.rev Triv} [] K R, ]. func trivialize-param1 list term, list term -> list term. trivialize-param1 [] [] []. trivialize-param1 [_,_|XS] [_,TPX|PS] [TPX1,T|TS] :- std.do! [ coq.safe-dest-app TPX HD ARGS, drop-last 1 ARGS ARG, coq.mk-app HD ARG TPX1, param1-trivial-db TPX1 T, trivialize-param1 XS PS TS, ]. func do-args list term, list term, list term, list term, term -> term. do-args [] [] [] _ _ {{ lib:@elpi.erefl _ _ }}. do-args [PX,X|XS] [_,TX|PS] [Triv,P|Trivs] Old K R :- std.do! [ Q = {{ lib:elpi.derive.trivial_uniq lp:TX lp:P lp:Triv lp:X lp:PX }}, F = {{ lib:elpi.derive.trivial_full lp:TX lp:P lp:Triv lp:X }}, std.assert-ok! (coq.typecheck Q TQ) "wtf", (pi v\ coq.mk-app K {std.rev {std.append {std.append Old [v,X]} XS}} (K1 v)), std.append Old [F,X] Old1, coq.build-match Q TQ (do-oty K1 PX) (do-body XS PS Trivs Old1 K) R, ]. func do-oty (term -> term), term, term, list term, list term -> term. do-oty K E _ [V,_] _ {{ lib:@elpi.eq _ _ lp:KV }} :- (copy E V :- !) => copy (K V) KV. func do-body list term, list term, list term, list term, term, term, term, list term, list term -> term. do-body XS PS Trivs Old K _ _ _ _ R :- do-args XS PS Trivs Old K R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func body-params int, % number of params left term, % inductive type applied to parameters treated so far term % inductive type arity to process -> term. body-params 0 IsT (prod _ T _\ sort _) R :- !, std.do! [ std.assert! (param1-inhab-db IsT W) "www", R = {{ fun x : lp:T => lib:elpi.derive.contracts lp:T lp:IsT x (lp:W x) ((fix IH (x : lp:T) (y : lp:IsT x) {struct y} : lib:@elpi.eq (lp:IsT x) (lp:W x) y := lp:{{ { param1-trivial-db IsT {{ fun x : lp:T => lib:elpi.derive.contracts lp:T lp:IsT x (lp:W x) (IH x) }} => coq.build-match {{y}} {{lp:IsT x}} (oty IsT W) (body IsT W) } }} ) x) }}, ]. % param1 have the form : isT A (P : A -> Type) .. , so we process two % binders at a time and we assume (H : trivial P) for each A and P body-params N T (prod A TA a\ prod P (TP a) (F a)) R :- N > 0, coq.sort? TA, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ fun _ {{ lib:elpi.derive.trivial lp:a lp:p }} pf\ { decl a A TA => decl p P (TP a) => decl pf `_` {{ lib:elpi.derive.trivial lp:a lp:p }} => (reali a p :- !) => param1-trivial-db p pf => % to prove (P x) use (H x) param1-inhab-db p {{ lib:elpi.derive.trivial_full lp:a lp:p lp:pf }} => % to prove (P x) use (H x) body-params M {coq.mk-app T [a,p]} (F a p)}). body-params N T (prod A TA a\ prod P (TP a) (F a)) R :- N > 0, !, M is N - 2, R = (fun A TA a\ fun P (TP a) p\ { decl a A TA => decl p P (TP a) => (reali a p :- !) => body-params M {coq.mk-app T [a,p]} (F a p)}). body-params _ T _ _ :- coq.say "derive.param1_trivial: wrong shape " {coq.term->string T} ". It does not look like a unary parametricity translation of an inductive with no indexes.", fail. func main gref, gref, string -> list prop. main _ (indt GR) Suffix [Clause,param1-trivial-done (indt GR)] :- do! [ coq.env.indt GR _ Lno _ Arity _ _, body-params Lno (global (indt GR)) Arity R, % coq.say {coq.term->string R}, std.assert-ok! (coq.typecheck R RT) "derive.param1_trivial generates illtyped term", Name is {coq.gref->id (indt GR)} ^ Suffix, coq.env.add-const Name R RT @transparent! Cst, Clause = (param1-trivial-db (global (indt GR)) (global (const Cst))), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ Clause), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-trivial-done (indt GR))), ]. main (const _GR) (const IsGR) Suffix [Clause,param1-trivial-done (const IsGR)] :- do! [ coq.env.const IsGR (some IsT) _, Name is {coq.gref->id (const IsGR)} ^ Suffix, std.assert! (param1-trivial-db IsT R) "derive.param1_trivial not already generated", std.assert-ok! (coq.typecheck R RT) "derive.param1_trivial generates illtyped term", coq.env.add-const Name R RT @transparent! Cst, Clause = (param1-trivial-db (global (const IsGR)) (global (const Cst))), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ Clause), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-trivial-done (const IsGR))), ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/param2.elpi000066400000000000000000000666221523041753400217260ustar00rootroot00000000000000/* Binary parametricity translation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Author: Cyril Cohen shorten std.{forall, forall2, do!, rev, map2, map}. :before "subst-fun:fail" coq.subst-fun XS T TXS :- !, coq.mk-app T XS TXS. % this is outside the namespace since the predicate is also the db-one param (sort prop as P) P (fun `s` P x\ fun `s` P y\ prod `s1` x _\ prod `s2` y _\ P) :- !. param (sort _ as P) P (fun `u` (sort (typ U)) x\ fun `v` (sort (typ V)) y\ prod `s1` x _\ prod `s2` y _\ P) :- !, coq.univ.new U, coq.univ.new V. param (fun N T B) (fun N T1 B1) (fun N1 T x\ fun N2 T1 x1\ fun NR (TRsubst x x1) xR\ BR x x1 xR) :- !, do! [ derive.param2.names12R N N1 N2 NR, param T T1 TR, (@pi-decl N T x\ @pi-decl N1 T1 x1\ @pi-decl NR TR xR\ param x x1 xR => param (B x) (B1 x1) (BR x x1 xR)), (TRsubst = x\ x1\ {coq.subst-fun [x,x1] TR}) ]. param (prod N T P as Prod) Prod1 ProdR :- !, do! [ param T T1 TR, (@pi-decl N T x\ @pi-decl N T1 x1\ @pi-decl N TR xR\ param x x1 xR => param (P x) (P1 x1) (PR x x1 xR)), Prod1 = prod N T1 P1, derive.param2.names12R N N1 N2 NR, ProdR = fun `f` Prod f\ fun `g` Prod1 g\ prod N1 T x\ prod N2 T1 x1\ prod NR {coq.subst-fun [x,x1] TR} xR\ {coq.subst-fun [{coq.mk-app f [x]}, {coq.mk-app g [x1]}] (PR x x1 xR)} ]. % Primitive projections are applied directly to the record instance, % without mentioning the record's parameters. The application node can % have more arguments if the record field is a function, in which case % the first argument should be treated specially, but then the rest % should be processed like a regular application param (app [primitive (proj Proj NoArgs), X | Xs]) (app [PP1, X1 | Xs1]) (app [PPR, XR | XsR]) :- !, % Can't use `as PP` to bind `PP` in the clause head, since param is declared % :index(3) and `PP` occurs at depth exactly 3, see % https://github.com/LPCIC/elpi/issues/410 % This is fixed in elpi >3.7, as of yet unreleased PP = primitive (proj Proj NoArgs), param PP PP1 PPR, param X X1 XR, derive.param2.param-args Xs Xs1 XsR. param (app [A|Bs]) (app [A1|Bs1]) ARBsR :- !, do! [ param A A1 AR, derive.param2.param-args Bs Bs1 BsR, coq.mk-app AR BsR ARBsR ]. param (let N T V B) Let1 LetR :- !, do! [ param T T1 TR, param V V1 VR, (@pi-decl N T x\ @pi-decl N T1 x1\ @pi-decl N TR xR\ param x x1 xR => param (B x) (B1 x1) (BR x x1 xR)), Let1 = let N T1 V1 B1, derive.param2.names12R N N1 N2 NR, LetR = let N1 T V x\ let N2 T1 V1 x1\ let NR {coq.mk-app TR [x,x1]} VR xR\ BR x x1 xR ]. param (match T P Bs) M1 MR :- !, do! [ param T T1 TR, derive.param2.param-match P P1 PRM, param T T1 TR => derive.param2.map-param Bs Bs1 BsR, M1 = match T1 P1 Bs1, MR = match TR (PRM (x\ match x P Bs) (x\ match x P1 Bs1)) BsR ]. param (fix N Rno T F as Fix) Fix1 FixR :- !, do! [ RnoR is 3 * Rno + 2, RnoR1 is RnoR + 1, param T T1 TR, (@pi-decl N T x\ @pi-decl N1 T1 x1\ @pi-decl N TR xR\ param x x1 xR => param (F x) (F1 x1) (FR x x1 xR)), Fix1 = fix N Rno T1 F1, (TRsubst = f\ f1\ {coq.subst-fun [f, f1] TR}), (pi f f1 xR\ FixBody f f1 xR = let N (TRsubst (F f) (F1 f1)) (FR f f1 xR) fr\ {paramX.mk-trivial-match RnoR (TRsubst f f1) [] fr}), (pi f f1 xR\ coq.mk-eta RnoR1 (TRsubst f f1) (FixBody f f1 xR) (EtaFixBody f f1 xR)), derive.param2.names12R N N1 N2 NR, FixR = (let N1 T Fix f\ let N2 T1 Fix1 f1\ fix NR RnoR (TRsubst f f1) xR\ EtaFixBody f f1 xR) ]. namespace derive.param2 { func names12R name -> name, name, name. names12R N N1 N2 NR :- !, coq.name-suffix N 1 N1, coq.name-suffix N 2 N2, coq.name-suffix N "_R" NR. func id12R id -> id, id, id. id12R N N1 N2 NR :- !, N1 is N ^ "1", N2 is N ^ "2", NR is N ^ "_R". func param-args -> list term, list term, list term. param-args [] [] [] :- !. param-args [X|Xs] [X1|Xs1] [X,X1,XR|XsR] :- !, param X X1 XR, !, param-args Xs Xs1 XsR, !. func map-param -> list term, list term, list term. map-param [] [] [] :- !. map-param [X|Xs] [X1|Xs1] [XR|XsR]:- !, param X X1 XR, !, map-param Xs Xs1 XsR, !. % helpers for match return type func param-match term -> term, ((term -> term) -> (term -> term) -> term). param-match (fun N T B) P1 PRM :- pi x\ not (B x = fun _ _ _), !, param T T1 TR, !, (pi x x1 xR\ (param x x1 xR :- !) => param (B x) (B1 x1) (BR x x1 xR)), !, P1 = fun N T1 B1, derive.param2.names12R N N1 N2 NR, (pi z z1\ PRM z z1 = fun N1 T x\ fun N2 T1 x1\ fun NR {coq.subst-fun [x,x1] TR} xR\ {coq.mk-app (BR x x1 xR) [z x, z1 x1]}). param-match (fun N T B) P1 PRM :- param T T1 TR, !, (pi x x1 xR\ (param x x1 xR :- !) => param-match (B x) (B1 x1) (BR x x1 xR)), !, P1 = fun N T1 B1, derive.param2.names12R N N1 N2 NR, (pi z z1\ PRM z z1 = fun N1 T x\ fun N2 T1 x1\ fun NR {coq.subst-fun [x,x1] TR} xR\ BR x x1 xR z z1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % translation of inductive declarations % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % helper to improve name hints func rename term, list (option id) -> term. rename (prod _ T P) [some Ni|LN] (prod Nn T P') :- !, pi x\ rename (P x) LN (P' x), coq.id->name Ni Nn. rename (prod N T P) [none|LN] (prod N T P') :- !, pi x\ rename (P x) LN (P' x). rename T _ T :- !. % Renames only the non-relevant names in the final sort, % while ignoring the new names for the relevant parameter names. func rename-arity-sort arity, list (option id) -> arity. rename-arity-sort (parameter N Expl T P) [_|LN] (parameter N Expl T P') :- !, pi x\ rename-arity-sort (P x) LN (P' x). rename-arity-sort (arity T) LN (arity T') :- !, rename T LN T'. rename-arity-sort A _ A :- !. % [param-arity A T1 T2 AR] returns in AR the translation of A applied to the terms % T1 and T2, which are expected to have the types P and P', respectively, P and P' % being the arities A and A' turned into types. func param-arity arity, % Arity (a : A).. | P a.. term, % Term T1 : forall (a : A).., P a.. term -> % Term T2 : forall (a' : A').., P' a'.. arity. % Arity [[ (a : A).. ]] | [[ P a.. ]] (T1 a..) (T2 a'..) param-arity A1 Hd1 Hd2 AR :- param-arity.aux A1 Hd1 Hd2 [] [] AR. func param-arity.aux arity, term, term, list term, list term -> arity. param-arity.aux (parameter N _ Ty1 Rest1) Hd1 Hd2 RevParams1 RevParams2 % Ignore the explicitness set in the untranslated arity. Reusing it leads % to inference failures, so let the user pick their preferred explicitness with % either Arguments or Set Implicit Arguments. (parameter N1 explicit Ty1 x1\ parameter N2 explicit Ty2 x2\ parameter NR explicit (TyRsubst x1 x2) xR\ RestR x1 x2 xR) :- id12R N N1 N2 NR, param Ty1 Ty2 TyR, (pi x x'\ coq.subst-fun [x, x'] TyR (TyRsubst x x')), do! [ @pi-parameter N1 Ty1 x1\ @pi-parameter N2 Ty2 x2\ @pi-parameter NR (TyRsubst x1 x2) xR\ param x1 x2 xR => param-arity.aux (Rest1 x1) Hd1 Hd2 [x1|RevParams1] [x2|RevParams2] (RestR x1 x2 xR) ]. param-arity.aux (arity T1) Hd1 Hd2 RevParams1 RevParams2 (arity TRSubst) :- param T1 _ TR, coq.mk-app Hd1 {rev RevParams1} Ty1, coq.mk-app Hd2 {rev RevParams2} Ty2, coq.subst-fun [Ty1, Ty2] TR TRSubst. % [param-indt-decl I S NR DeclR] accepts a name of an inductive I and a % string S, and returns the representation of the translated inductive DeclR and % its name NR. % The name of the inductive and constructors is generated by appending % S and ensuring freshness in the current context. func param-indt-decl inductive, % Name of the inductive string -> % Suffix to add to the name string, % Name of the translated inductive indt-decl. % Description of the translated inductive param-indt-decl I Suffix NR DeclR :- coq.env.indt-decl I Decl, % Issue: consider the humble Inductive Foo (A : Type) := foo : Foo A -> Foo A. % The arity of foo we get is (f\ "f -> f"), which we can choose to % instantiate either with "Foo", or separately with "Foo A" and "Foo A'". % If we do the translation for Foo, we try to translate (foo : Foo -> Foo), % which produces % (foo_R : ∀ (f : Foo) (f' : Foo), Foo_R f f' -> Foo_R (foo f) (foo f')) % and that's ill-typed, because Foo takes a type parameter, so it should be % (foo_R : ∀ (f : Foo A) (f' : Foo A'), ...). % On the other hand, if we do the translation for Hd1 and Hd2 and we translate % (foo : Foo A -> Foo A), we get % (foo_R : ∀ (f : Foo A) (f' : Foo A'), % Foo_R A A' A_R f f' -> Foo_R A A' A_R (foo f) (foo' f')). % Unfortunately, this is rejected as well, since A A' A_R are % uniform parameters, so the rocq-elpi encoding enforces that the user % treat Foo_R as already being pre-applied. What rocq-elpi expects is % something in the middle, namely % (foo_R : ∀ (f : Foo A) (f' : Foo A'), % Foo_R f f' -> Foo_R (foo f) (foo' f')). % We can avoid the issue by first converting all parameters to non-uniform % ones, since then passing the unapplied inductives everywhere still produces % well-typed arities. % In principle records don't have this problem, since their declarations only % specify the types of fields, and records can't be recursive, so the types % of fields don't ever need to refer to the record type itself. We do, however, % want to still "clean up" records without primitive projections, since those % are expected to be translated as if they were inductives, and this conversion % happens inside the translation to non-uniformly parameterized inductives. if (coq.env.record? I tt) (CleanDecl = Decl) (coq.indt-unif->indt-nonunif Decl CleanDecl), param-indt-decl.aux I Suffix [] [] CleanDecl NR DeclR. func param-indt-decl.aux inductive, string, list term, % Reversed list of "unprimed" parameters accumulated so far list term, % Reversed list of "primed" parameters accumulated so far indt-decl -> string, indt-decl. param-indt-decl.aux I Suffix RevParams1 RevParams2 % Ignore the explicitness set in the untranslated inductive. Reusing them leads % to inference failures, so let the user pick their preferred explicitness with % either Arguments or Set Implicit Arguments. (parameter N _ Ty Rest) NewName (parameter N1 explicit Ty x\ parameter N2 explicit Ty' x'\ parameter NR explicit (TyRsubst x x') xR\ RestR x x' xR) :- id12R N N1 N2 NR, param Ty Ty' TyR, (pi x x'\ coq.subst-fun [x,x'] TyR (TyRsubst x x')), do! [ @pi-parameter N1 Ty x\ @pi-parameter N2 Ty' x'\ @pi-parameter NR TyR xR\ param x x' xR => param-indt-decl.aux I Suffix [x|RevParams1] [x'|RevParams2] (Rest x) NewName (RestR x x' xR) ]. param-indt-decl.aux I Suffix RevParams1 RevParams2 (inductive N Ind IndexA Ks) NewName (inductive NewName Ind IndexAR (KRs HdTy)) :- coq.ensure-fresh-global-id {calc (N ^ Suffix)} NewName, coq.env.global (indt I) HdTy, rev RevParams1 Params1, rev RevParams2 Params2, param-arity IndexA {coq.mk-app HdTy Params1} {coq.mk-app HdTy Params2} IndexAR, % The indt-decl we get on the input doesn't give us the constructor names % we can actually use to form terms, so we need to fetch those separately coq.env.indt I _ _ _ _ Cs _, % Create a fresh variable for both the untranslated and translated inductives. % The constructors Ks already treat the untranslated inductive as an opaque % term. The alternative is to use HdTy directly instead of ty, but then the % local param rule would technically conflict with the default rule for (p)global, % so the "proper" local assumption would be on the param.gref predicate, % but we don't have a gref for the translated inductive yet. pi ty tyR\ param ty ty tyR =!=> map2 Cs (Ks ty) (param-indc-decl Suffix Params1 Params2) (KRs ty tyR). param-indt-decl.aux I Suffix RevParams1 RevParams2 (record Name Ty Kname Fields) FNameR (parameter C1 explicit Ty1 x \ parameter C2 explicit Ty2 x'\ record FNameR Ty FKnameR (FieldsR x x')) :- coq.env.global (indt I) HdTy, id12R Name C1 C2 _, coq.ensure-fresh-global-id {calc (Name ^ Suffix)} FNameR, coq.ensure-fresh-global-id {calc (Kname ^ Suffix)} FKnameR, coq.mk-app HdTy {rev RevParams1} Ty1, coq.mk-app HdTy {rev RevParams2} Ty2, % The input declaration does not carry the projection names which we need % to construct terms out of them. We know this record has primitive projections, % since records without primitive projections are treated as inductives. coq.env.primitive-projections I Projs, @pi-parameter C1 Ty1 x\ @pi-parameter C2 Ty2 x'\ param-prim-record-decl Fields Suffix Projs x x' (FieldsR x x'). func param-indc-decl string, % Suffix to add to the name list term, % "Unprimed" parameter instantiation of the inductive list term, % "Primed" parameter instantiation of the inductive constructor, % Name of the constructor being translated indc-decl -> % Declaration of the constructor being translated indc-decl. % Translated constructor param-indc-decl Suffix Params1 Params2 CHd (constructor N A) (constructor NR AR) :- coq.env.global (indc CHd) CT, % If the user changed argument names of the untranslated constructor, % we want to use those for pretty-printing hints in the translation. % We need to be careful, however, because when adding the inductive, % the names of non-uniform parameters in the inductive aritiy and in the % constructor arity need to match. We deal with this by ignoring the name % hints for the relevant names in rename-arity-sort. coq.arguments.name (indc CHd) Names, coq.ensure-fresh-global-id {calc (N ^ Suffix)} NR, param-arity {rename-arity-sort A Names} {coq.mk-app CT Params1} {coq.mk-app CT Params2} AR. func param-prim-record-decl record-decl, % Untranslated record declaration string, % Suffix to add to the record, constructor, and projections' names list % List of projection names of the untranslated record (option (pair projection int)), % Records with unnameable projections are not supported term, % "Unprimed" instance of the untranslated record term -> % "Primed" instance of the untranslated record record-decl. param-prim-record-decl end-record _ _ _ _ end-record. param-prim-record-decl (field Attrs Id Ty Rest) Suffix [OProj|Projs] X X' (field Attrs IdR TyRsubst (RestR Proj1 Proj2)) :- (OProj = some (pr Proj NoParams) ; std.fatal-error-w-data "Cannot translate records with unnameable projections" Id), !, coq.env.fresh-global-id {calc (Id ^ Suffix)} IdR, param Ty _Ty' TyR, Proj1 = app [primitive (proj Proj NoParams), X], Proj2 = app [primitive (proj Proj NoParams), X'], coq.subst-fun [Proj1, Proj2] TyR TyRsubst, % Similarly to the inductive case, instantiate the field continutations % with fresh elpi variables, since we prefer to avoid locally assuming % a translation of a complex term like a fully applied projection. pi proj1 proj2 projR\ param proj1 proj2 projR =!=> param-prim-record-decl (Rest proj1) Suffix Projs X X' (RestR proj1 proj2 projR). % [param-record-constr C N Ty CR Bo TyB] takes the constructor names of % a record and its translation, the number of parameters of the untranslated % record type, and the type of the untranslated constructor, and returns % a parametricity shim for the constructor, and its type. % % Generating a shim is necessary because the type of the constructor of % the translated record type does not have the type of a parametricity % translation of the original constructor: the type of mkFoo in % Record Foo (A : TyA) := mkFoo { fld : TyF } % is (forall A : TyA, TyF -> Foo A). The translation of Foo, however, is % Record Foo_R (A A' A_R) (f : Foo A) (f' : Foo A') := % mkFoo_R { fld_R : TyF_R f.(fld) f'.(fld) } % where mkFoo_R has the type % (forall A A' A_R f f', TyF_R f.(fld) f'.(fld) -> Foo_R A A' A_R f f'). % Meanwhile the expected type is a function type which has a triplet of arguments % for every field in the original record, and whose codomain ends in the translated % record type instantiated at instances constructed from the arguments, here % (forall A A' A_R fld fld', % TyF_R fld fld' -> Foo_R A A' A_R (mkFoo A fld) (mkFoo A' fld')). % The shim generated by this predicate does this transformation by wrapping % the appropriate arguments in constructor calls before forwarding them to % the translated constructor. func param-record-constr constructor, % Name of the untranslated constructor int, % Number of parameters term, % Type of the original constructor constructor -> % Name of the constructor of the translation term, % Body of the new compatibility constant term. % And its type param-record-constr C NParams Ty CR Bo TyR :- % Eta-expand the parameters of the constructor first; % This allows us to treat (ctor A0 ... AN) as a single unit to be % translated. It needs special treatment, because the arguments % which come after correspond to the record fields, which need to be % collected separately and wrapped in a constructor call when forwarding % to the translated constructor. % The expansion is entirely type-driven, and we abstract over the concrete % constructor term to enforce that. (pi ctor\ coq.mk-eta NParams Ty ctor (Exp ctor)), % Note: this still doesn't feel great, since we don't control mk-eta from here % and then we're matching on a non-atomic term (app [ctor | xs]). Maybe % we can locally assume a new term constructor similar to app and make our own % mk-eta which uses that instead of app? With that we could also remove the % second local assumption below. % Register the translation of (ctor A0 .. AN) to be a function taking % fld1 -> fld1' -> fld1R .. 's to the constructor call % ctorR A0 A0' A0R .. AN AN' ANR % (ctor A0 .. AN fld1 ..) % (ctor A0' .. AN' fld1' ..) % fld1R .. (pi ctor ctorR\ [(pi xs C x1s C1 OutR xRs Tele AppliedCR\ param (app [ctor | xs]) (app [ctor | x1s]) OutR :- !, do! [ param-args xs x1s xRs, % Substitute parameters to the constructor type, leaving just % the arguments corresponding to fields coq.subst-prod xs Ty Tele, % Pre-apply the translation of parameters coq.mk-app ctorR xRs AppliedCR, % Construct the output term by wrapping the rest of the arguments % in (ctor ..xs) and (ctor x1s..) calls param-record-constr.aux Tele (app [ctor | xs]) (app [ctor | x1s]) AppliedCR [] [] [] OutR ]), % If the record didn't have any parameters, then there was no eta % expansion, and the constructors are just ctor instead of (ctor) (pi OutR\ param ctor ctor OutR :- !, param-record-constr.aux Ty ctor ctor ctorR [] [] [] OutR)] => % Apply the above translation, together with the usual mechanism % for translating functions when translating parameters param (Exp ctor) _ (BoSubst ctor ctorR)), % Instantiate the body of the compatibility constant with concrete constructor terms coq.env.global (indc C) T, coq.env.global (indc CR) TR, Bo = BoSubst T TR, param Ty _ TyRUnsubst, coq.subst-fun [T, T] TyRUnsubst TyR, % Sanity check that the type of the shim has the type expected of a translation std.assert-ok! (coq.typecheck Bo TyR) "param-record-constr: Ill-typed translated constructor shim". func param-record-constr.aux term, % Rest of the constructor telescope term, % Untranslated constructor applied to "unprimed" parameters term, % Untranslated constructor applied to "primed" parameters term, % Constructor of the translated record applied to parameters list term, % Reverse "unprimed" arguments corresponding to % fields of the untranslated record list term, % Reverse "primed" arguments list term -> % Reverse arguments corresponding to fields of the translated record term. % Call to the translated constructor param-record-constr.aux (prod N T1 B) C1 C2 CR RevArgs1 RevArgs2 RevArgsR (fun N1 T1 x1\ fun N2 T2 x2\ fun NR (TRsubst x1 x2) (E x1 x2)) :- !, names12R N N1 N2 NR, param T1 T2 TR, (pi x1 x2\ coq.subst-fun [x1, x2] TR (TRsubst x1 x2)), (@pi-decl N1 T1 x1\ @pi-decl N2 T2 x2\ @pi-decl NR (TRsubst x1 x2) xR\ param x1 x2 xR =!=> param-record-constr.aux (B x1) C1 C2 CR [x1 | RevArgs1] [x2 | RevArgs2] [xR | RevArgsR] (E x1 x2 xR)). param-record-constr.aux _ C1 C2 CR RevArgs1 RevArgs2 RevArgsR Call :- rev RevArgs1 Args1, rev RevArgs2 Args2, rev RevArgsR ArgsR, coq.mk-app C1 Args1 CCall1, coq.mk-app C2 Args2 CCall2, coq.mk-app CR [CCall1, CCall2 | ArgsR] Call. %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Class storage functions: % %%%%%%%%%%%%%%%%%%%%%%%%%%%% func store-param string, term, term, term. store-param N X X1 XR :- !, Nparam is "param_" ^ N, Args = [_, _, _, X, X1, XR], T1 = app [{{ lib:@param2.store_param }}|Args], std.assert-ok! (coq.typecheck T1 T2) "store-param: T1 illtyped", coq.ensure-fresh-global-id Nparam FNparam, coq.env.add-const FNparam T1 T2 _ C, @global! => coq.TC.declare-instance (const C) 0. func store-param-indc string, constructor, constructor. store-param-indc Suffix K KR :- store-param {calc ({coq.gref->id (indc K)} ^ Suffix)} {coq.env.global (indc K)} {coq.env.global (indc K)} {coq.env.global (indc KR)}. %%%%%%%%%%%%%%%%%%%%%%% % toplevel predicates % %%%%%%%%%%%%%%%%%%%%%%% :index (1) func dispatch gref, string -> list prop. dispatch ((const GR) as C) Suffix Clauses :- do! [ % We need to check both projection and primitive-projection: a non-primitive % projection is still a projection, and a manual wrapper of a primitive projection % is succesfully checked as a compatibility constant. We want both of these cases % to be successfully translated, so we want to only rule out manual translations % of generated compatibility constants, which already have registered translations. (not (coq.env.projection? GR _, coq.env.primitive-projection? _ GR _) ; coq.error "derive.param2: cannot translate a projection"), coq.env.global C Term, NameR is {coq.gref->id C} ^ Suffix, coq.env.const GR OBo Ty, (OBo = (some X) ; std.fatal-error-w-data "Cannot translate local constant without body" GR), param Ty _ TyR, coq.mk-app TyR [Term, Term] TyRTermTerm, % coq.typecheck is needed to add universe constraints std.assert-ok! (coq.typecheck TyRTermTerm _) "param2: illtyped param type", param X _ XR, % apparently calling the type checker with the expected type is weaker in this case std.assert-ok! (coq.typecheck XR XRTy) "param2: illtyped constant", std.assert-ok! (coq.unify-leq XRTy TyRTermTerm) "param2: constant does not have the right type", coq.ensure-fresh-global-id NameR FNameR, coq.env.add-const FNameR XR TyRTermTerm _ TermR, store-param NameR Term Term {coq.env.global (const TermR)}, C1 = (param.gref C C (const TermR) :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") C1), coq.elpi.accumulate _ "derive.param2.db" (clause _ _ (param-done C)), Clauses = [param-done C, C1] ]. dispatch (indt I as GR) Suffix Clauses :- % Records with primitive projections get translated into records, % as opposed to records without primitive projections, which are % just glorified single-constructor inductives coq.env.record? I tt, !, do! [ param-indt-decl I Suffix NameR RecordDeclR, std.assert-ok! (coq.typecheck-indt-decl RecordDeclR) "derive.param2 generates illtyped record type", (@primitive! => coq.env.add-indt RecordDeclR IR), GRR = indt IR, coq.env.global GR Ind, coq.env.global GRR IndR, store-param NameR Ind Ind IndR, TypeClause = (param.gref GR GR GRR :- !), % All projections are guaranteed to be nameable, otherwise % generating the record declaration would have failed by now coq.env.projections I OProjs, map OProjs (p\ r\ (some r) = p) Projs, coq.env.projections IR OProjsR, map OProjsR (p\ r\ (some r) = p) ProjsR, % Primitive projections are different terms, % so we need to register their translations separately coq.env.primitive-projections I OPProjs, coq.env.primitive-projections IR OPProjsR, map OPProjs (p\ r\ sigma pproj args\ (some (pr pproj args)) = p, r = proj pproj args) PProjs, map OPProjsR (p\ r\ sigma pproj args\ (some (pr pproj args)) = p, r = proj pproj args) PProjsR, % store projection translations as witnesses forall2 Projs ProjsR (p\ pR\ sigma n fulln gp gpR \ coq.gref->id (const p) n, coq.gref->id (const pR) fulln, coq.env.global (const p) gp, coq.env.global (const pR) gpR, store-param fulln gp gp gpR), % projection translation clauses map2 Projs ProjsR (p\ pR\ r\ r = (param.gref (const p) (const p) (const pR) :- !)) ProjectionClauses, map2 PProjs PProjsR (p\ pR\ r\ r = (param (primitive p) (primitive p) (primitive pR) :- !)) PProjectionClauses, MostClauses = [TypeClause | {std.append PProjectionClauses ProjectionClauses}], coq.env.indt I _ NParams _ _ [C] [CTy], coq.env.indt IR _ _ _ _ [CR] _, % Generating the constructor shim needs to know about registered % translations (MostClauses =!=> param-record-constr C NParams CTy CR ShimCR ShimCRTy), coq.env.add-const {coq.env.fresh-global-id {calc ("shim_" ^ {coq.gref->id (indc CR)})}} ShimCR ShimCRTy @transparent! Shim, store-param {coq.gref->id (indc CR)} {coq.env.global (indc C)} {coq.env.global (indc C)} {coq.env.global (const Shim)}, ConstrClause = (param.gref (indc C) (indc C) (const Shim) :- !), Clauses = [param-done GR, ConstrClause | MostClauses], forall Clauses (c\ coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") c)), ]. dispatch (indt I as GR) Suffix Clauses :- !, param-indt-decl I Suffix NameR DeclR, std.assert-ok! (coq.typecheck-indt-decl DeclR) "derive.param2 generates illtyped inductive type", coq.env.add-indt DeclR IR, coq.env.global GR Ind, store-param NameR Ind Ind {coq.env.global (indt IR)}, coq.env.indt I _ _ _ _ Knames _, coq.env.indt IR _ _ _ _ KnamesR _, forall2 Knames KnamesR (store-param-indc Suffix), C1 = (param.gref GR GR (indt IR) :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") C1), map2 Knames KnamesR (a\ b\ r\ r = (param.gref (indc a) (indc a) (indc b) :- !)) CK, forall CK (c\ coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") c)), CD = (param-done GR :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ _ CD), Clauses = [CD, C1|CK]. dispatch (indc _) _ _ :- coq.error "derive.param2: cannot translate a constructor". func main gref, string -> list prop. main T _ Clauses :- dispatch T "_R" Clauses. func main_register gref, gref. main_register I R :- C1 = (param.gref I I R :- !), coq.elpi.accumulate _ "derive.param2.db" (clause _ (before "param:fail") C1), coq.elpi.accumulate _ "derive.param2.db" (clause _ _ (param-done I)). } /* %%%%%%%%%%%%%%%%%%%%% % Tactic entrypoint % %%%%%%%%%%%%%%%%%%%%% % We disable coq-refiner :before "refiner-assign-evar" evar _ _ _ :- !. pred ctx->TC i:(list prop), o:(list (pair term term)). ctx->TC [] [] :- !. ctx->TC [decl X _ Ty |Xs] [pr X Ty|Is] :- !, ctx->TC Xs Is. ctx->TC [def X _ _ _ Ty |Xs] [pr X Ty|Is] :- !, ctx->TC Xs Is. solve _ [goal Ctx Ev (app[{{@param}}, T, TR, X, XR]) _] _ :- !, coq.sigma.print, coq.say "goal->TC" {ctx->TC Ctx}, coq.say "searching param for" X, (param T _ TR), (param X _ XR), Ev = app [{{@Param}}, T, TR, X, XR], coq.typecheck Ev Ty ok, coq.say "Ty=" Ty. */ LPCIC-coq-elpi-eb449d7/apps/derive/elpi/paramX_lib.elpi000066400000000000000000000054271523041753400226160ustar00rootroot00000000000000/* rocq-elpi: Coq terms as the object language of elpi */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace paramX { func mk-trivial-match int, term, list term, term -> term. mk-trivial-match Rno (prod N T P) Args F (fun N T B) :- Rno >= 0, !, std.do! [ Rno' is Rno - 1, (pi x\ decl x N T => mk-trivial-match Rno' (P x) [x|Args] F (B x)), ]. mk-trivial-match Rno Prod Args F R :- Rno >= 0, whd1 Prod Prod1, !, mk-trivial-match Rno Prod1 Args F R. mk-trivial-match -1 P RArgs F Match :- std.do! [ RArgs = [RecArg|ROtherArgs], (decl RecArg _ T, unwind {whd T []} Twhd), % unneeded with elpi 1.13.7 coq.safe-dest-app Twhd (global (indt I)) IndArgs, coq.env.indt I _ Lno _ _ _ _, std.drop Lno IndArgs RIndArgs, coq.build-match RecArg T (mk-trivial-match.rty {std.append RIndArgs [RecArg]} P) (mk-trivial-match.branch Lno RIndArgs {std.rev ROtherArgs} F) Match, ]. func mk-trivial-match.rty list term, term, term, list term, list term -> term. mk-trivial-match.rty Args P _ Vars _ R :- std.do! [ std.map2 Args Vars (x\y\r\ r = copy x y) Subst, Subst =!=> copy P R, ]. func mk-trivial-match.branch int, list term, list term, term, term, term, list term, list term -> term. mk-trivial-match.branch Lno Args OtherArgs F K KTy Vars _ R1 :- std.do! [ coq.mk-app K Vars KArgs, coq.safe-dest-app KTy _ KTyArgs, std.drop Lno KTyArgs IdxVals, std.map2 Args IdxVals (x\y\r\ r = copy x y) Subst, (R = let `K` KTy KArgs x\ {coq.mk-app F {std.append OtherArgs [x]}}), Subst =!=> copy R R1, ]. % prove H G P finds a P : H => G func prove term, term -> term. func cross term. % prove-arg AppliedHyp AppliedGoal Argument ProofAppliedHyp Proof. func prove-arg term, term, term, term -> term. prove-arg X X _ P P :- !. prove-arg (app [H|Hs]) (app[G|Gs]) X PHX PGX :- std.appendR HArgs [X] Hs, !, coq.mk-app H HArgs Hyp, std.appendR GArgs [X] Gs, !, coq.mk-app G GArgs Goal, prove Hyp Goal Proof, coq.mk-app Proof [X,PHX] PGX. prove-arg (prod _ X x\ prod _ (PX x) (H x)) (prod _ _ y\ prod _ (PX y) (G y)) A PA (fun `x` X x\ fun `px` (PX x) (Proof x)) :- pi x px\ prove-arg (H x px) (G x px) {coq.mk-app A [x]} {coq.mk-app PA [x,px]} (Proof x px). func prove-args list term, list term -> list term. prove-args [] [] []. prove-args [X,Pr|Args] [_,PX|ArgsT] [X,Proof|QArgs] :- coq.safe-dest-app PX HD _, cross HD, !, copy PX Goal, (prove-arg PX Goal X Pr Proof ; Proof = Pr), !, prove-args Args ArgsT QArgs. prove-args [X|Args] [PX|ArgsT] [ProofX|QArgs] :- copy PX Goal, prove PX Goal Proof, !, coq.mk-app Proof [X] ProofX, prove-args Args ArgsT QArgs. prove-args [X|Args] [_|ArgsT] [X|QArgs] :- prove-args Args ArgsT QArgs. }LPCIC-coq-elpi-eb449d7/apps/derive/elpi/projK.elpi000066400000000000000000000127731523041753400216270ustar00rootroot00000000000000/* Derive a function "projnK t -> x" iif t is "K ..x.." */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{append, any->string, zip, map, map2, nth, do!, assert!, flatten}. % TODO: instead of using a context and integers one could % generate the product for the projected argument and use via subst-prod % rather than using copy like crazy namespace derive.projK { :index (1) func exT-close list int, list (pair term term), list term, term, term -> term, term. exT-close [] _ _ T Ty T Ty1 :- copy Ty Ty1. exT-close [N|Mask] Ctx Args T Ty {{ @existT lp:S lp:P lp:A lp:R1 }} {{ @sigT lp:S lp:P }} :- nth N Ctx (pr X TX), copy TX S, P = fun {coq.name-suffix `i` N} S B, nth N Args A, (pi x\ (copy X x :- !) => exT-close Mask Ctx Args T Ty (R x) (B x)), R1 = R A. :index (1) func sigT-close list int, list (pair term term), term -> term. sigT-close [] _ Ty Ty1 :- copy Ty Ty1. sigT-close [N|Mask] Ctx Ty {{ @sigT lp:S lp:P }} :- nth N Ctx (pr X TX), copy TX S, P = fun {coq.name-suffix `i` N} S B, pi x\ (copy X x :- !) => sigT-close Mask Ctx Ty (B x). func body-branch int, constructor, term, term, list term, list term -> term. body-branch J K K1 _ VS TS R :- default-output J Mask DfltCtx Dflt DfltTy, !, if (coq.safe-dest-app K1 K1HD _, coq.env.global (indc K) K1HD) (nth J VS X, nth J TS XT, zip VS TS Ctx, Args = VS) (X = Dflt, XT = DfltTy, Ctx = DfltCtx, map DfltCtx fst Args), exT-close Mask Ctx Args X XT R _RT. func body-ty int, term, list term, list term -> term. body-ty J _ _ _ SigT :- default-output J Mask Args _ T, !, sigT-close Mask Args T SigT. :index (1) func occurs-list list (pair term term), int, term -> list int. occurs-list [] _ _ []. occurs-list [pr X _|XS] I T [I|IS] :- occurs X T, !, J is I + 1, occurs-list XS J T IS. occurs-list [_|XS] I T IS :- J is I + 1, occurs-list XS J T IS. func mask-for term, list (pair term term) -> list int. mask-for T Args Mask :- occurs-list Args 0 T Mask. pred default-output i:int, % gather infos to generate the match o:list int, % mask: the position of the arguments that occur in the type % of the projected one o:list (pair term term), % a context (term,type) of default values o:term, % the default value for the projected argument o:term. % its type func body-default % makes lambdas for all default arguments + the projected term, % constructor type (begin processed) int, % current argument int, % argument to project term, % inductive type applied to parameters and indexes list (pair term term), % variables for default arguments constructor % constructor to project -> term. body-default (prod N T F) J OJ IT Args K (fun N T B) :- !, mask-for T Args Mask, J1 is J + 1, @pi-decl N T x\ sigma Def\ if (J = OJ) (Def = [default-output J Mask Args x T]) (Def = []), Def ==> body-default (F x) J1 OJ IT {append Args [pr x T]} K (B x). body-default X J OJ IT Args K F :- whd1 X X1, !, body-default X1 J OJ IT Args K F. body-default _ _ J IT _ K (fun `i` IT B) :- !, @pi-decl `i` IT i\ coq.build-match i IT (body-ty J) (body-branch J K) (B i). func body-param % makes lambdas for all parameters and indexes term, % arity of the inductive type term, % type of the constructor to project term, % inductive type applied to the arity processed so far int, % number of Parameters left to process int, % argument to project constructor % constructor to project -> term. body-param (sort _) KTy IT 0 J K R :- !, body-default KTy 0 J IT [] K R. body-param (prod N T F) KTy IT 0 J K (fun N T B) :- !, @pi-decl N T x\ body-param (F x) KTy {coq.mk-app IT [x]} 0 J K (B x). body-param (prod N T F) (prod _ _ FK) IT Pno J K (fun N T B) :- !, Pno1 is Pno - 1, @pi-decl N T x\ body-param (F x) (FK x) {coq.mk-app IT [x]} Pno1 J K (B x). body-param (prod _ _ _ as X) KTy IT N J K R :- whd1 KTy KTy1, !, body-param X KTy1 IT N J K R. body-param X (prod _ _ _ as KTy) IT N J K R :- whd1 X X1, !, body-param X1 KTy IT N J K R. body-param X KTy IT N J K R :- whd1 X X1, whd1 KTy KTy1, !, body-param X1 KTy1 IT N J K R. % --------------------------------------------------------------------- func allK-projs string, int, int, int, term, term, constructor, term -> list prop. allK-projs _ J J _ _ _ _ _ [] :- !. allK-projs Prefix J JN Paramsno Arity ITy K KTy Clauses :- do! [ (@dropunivs! => coq.elaborate-skeleton ITy _ IT ok), body-param Arity KTy IT Paramsno J K RSkel, J1 is J + 1, Name is Prefix ^ {coq.gref->id (indc K)} ^ {any->string J1}, if (coq.elaborate-skeleton RSkel TyR R ok) ((@dropunivs! => coq.env.add-const Name R TyR _ P), Clause = (projK-db K J1 (global (const P)) :- !), coq.elpi.accumulate _ "derive.projK.db" (clause _ (before "projK-db:fail") Clause), Clauses = [Clause|ClausesRest]) (coq.say "skip" Name R, Clauses = ClausesRest), allK-projs Prefix J1 JN Paramsno Arity IT K KTy ClausesRest ]. func for-K string, int, term, term, constructor, term -> list prop. for-K Prefix Paramsno Arity IT K KT Clauses :- do! [ coq.count-prods KT N, Argsno is N - Paramsno, allK-projs Prefix 0 Argsno Paramsno Arity IT K KT Clauses ]. func main inductive, string -> list prop. main GR Prefix Clauses :- do! [ coq.env.global (indt GR) T, coq.env.indt GR _ Paramsno _ Arity Kn Kt, map2 Kn Kt (for-K Prefix Paramsno Arity T) ClausesList, flatten ClausesList Clauses ]. } LPCIC-coq-elpi-eb449d7/apps/derive/elpi/tag.elpi000066400000000000000000000044611523041753400213100ustar00rootroot00000000000000/* constructor name first class representation */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % not necessary, but gives pointers to relevant files shorten std.{ fold-map , do! , last }. % from elpi-builtin.elpi shorten coq.{ build-match , bind-ind-arity }. % from coq-lib.elpi shorten coq.{ elaborate-skeleton }. % from coq-builtin.elpi % if we load this file together with others files, we avoid chlashes namespace derive.tag { % we return the clauses for the tag.db since we may need them right away % if we run other derivations immediately func main inductive, string -> list prop. main I Prefix CL :- do! [ % build fun params (x : I params) => ... do-match ... coq.env.indt I _ _ _ Arity _ _, bind-ind-arity (global (indt I)) Arity do-match BodyR, % typecheck (and infer univ constraints) std.assert-ok! (elaborate-skeleton BodyR Ty Body) "derive.tag generates illtyped code", % save constant coq.ensure-fresh-global-id (Prefix ^ "tag") Name, coq.env.add-const Name Body Ty ff C, % store in the DB the tag function, so that other Elpi commands can find it CL = [tag-for I C], std.forall CL (x\ coq.elpi.accumulate _ "derive.tag.db" (clause _ _ x)), ]. % We build the match with dummy branches (you get the lambdas for the % arguments of constructors, then Prop). Then we put the right number in place. func do-match term, list term, list term -> term. do-match _ Vars Tys (match X Rty BL1) :- do! [ last Vars X, % the last variable is the one for the inductive type last Tys XTy, build-match X XTy do-rty do-dummy-branch (match X Rty BL), fold-map BL {{ 1 }} do-branch BL1 _, ]. % builds the return clause of the match func do-rty term, list term,list term -> term. do-rty _ _ _ {{ lib:elpi.derive.positive }}. % build each branch func do-dummy-branch term, term, list term, list term -> term. do-dummy-branch _ _ _ _ {{ Prop }}. % dummy % [do-branch InTerm Acc NewTem NewAcc] descends into a branch and puts Acc % in place of the dummy func do-branch term, term -> term, term. do-branch {{ Prop }} X X Y :- coq.reduction.lazy.norm {{ Pos.add lp:X 1 }} Y. do-branch (fun N T F) X (fun N T R) Y :- @pi-decl N T x\ do-branch (F x) X (R x) Y. }LPCIC-coq-elpi-eb449d7/apps/derive/examples/000077500000000000000000000000001523041753400205425ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/examples/dune000066400000000000000000000001561523041753400214220ustar00rootroot00000000000000(coq.theory (name elpi.apps.derive.examples) (theories elpi elpi.apps.derive)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/derive/examples/readme.v000066400000000000000000000012251523041753400221660ustar00rootroot00000000000000(* README *) From elpi.apps Require Import derive.std. #[module] derive Inductive peano := Zero | Succ (p : peano). Print peano.peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano. *) Eval compute in peano.eqb Zero (Succ Zero). (* = false : bool *) About peano.eqb_OK. (* peano.eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (peano.eqb x1 x2) peano.eqb_OK is not universe polymorphic Arguments peano.eqb_OK x1 x2 peano.eqb_OK is opaque Expands to: Constant elpi.apps.derive.examples.readme.peano.eqb_OK *) #[verbose] derive Nat.add. Check is_add. (* : forall n : nat, is_nat n -> forall m : nat, is_nat m -> is_nat (n + m) *) LPCIC-coq-elpi-eb449d7/apps/derive/examples/usage.v000066400000000000000000000054241523041753400220420ustar00rootroot00000000000000(** This example shows how to use derive *) From elpi.apps Require Import derive.std. Set Uniform Inductive Parameters. (** The best way to call derive is to prefix an Inductive declaration. *) #[module] derive Inductive tickle A := stop | more : A -> tickle -> tickle. (** The command is elaborated to something like: Module tickle. Inductive tickle A := stop | more : A -> tickle -> tickle. derive tickle. End tickle. Notation tickle := tickle.tickle. Notation stop := tickle.stop. Notation more := tickle.more. *) Check more : forall A, A -> tickle A -> tickle A. (** Some goodies *) Check tickle.eqb : (* eq test *) forall A, (A -> A -> bool) -> tickle A -> tickle A -> bool. Check tickle.eqb_OK : (* eq test correctness proof *) forall A f, (forall x y, reflect (x = y) (f x y)) -> forall x y, reflect (x = y) (tickle.eqb A f x y). Check tickle.map : (* map the container *) forall A B, (A -> B) -> tickle A -> tickle B. Check tickle.tickle_R : (* relator (binary parametricity translation) *) forall A B, (A -> B -> Type) -> tickle A -> tickle B -> Type. (** This is a tricky case, since you need a good induction principle for the nested occurrence of tickle. #[verbose] prints all the derivations being run *) #[verbose,module] derive Inductive rtree A := Leaf (a : A) | Node (l : tickle rtree). Check rtree.induction : (* this is the key *) forall A PA P, (forall a, PA a -> P (Leaf A a)) -> (forall l, tickle.is_tickle (rtree A) P l -> P (Node A l)) -> forall x, rtree.is_rtree A PA x -> P x. (** You can also select which derivations you like *) #[verbose, only(lens_laws, eqb), module] derive Record Box A := { contents : A; tag : nat }. Check Box.eqb : forall A, (A -> A -> bool) -> Box A -> Box A -> bool. Import lens. Check @Box._tag : (* the Lens for the second field (A is implicit) *) forall A, Lens (Box A) (Box A) nat nat. Check Box._tag_set_set : (* a Lens law *) forall A (r : Box A) y x, set Box._tag x (set Box._tag y r) = set Box._tag x r. Check Box._tag_contents_exchange : (* another one *) forall A (r : Box A) x y, set Box._tag x (set Box._contents y r) = set Box._contents y (set Box._tag x r). (** Finally, one can derive an existing inductive type. Generated constants are prefixed with nat_ but won't be in the right place, which is where the type is defined. This means that two users may run derive for the same type in different files, leading to duplication. *) derive nat. Check nat_eqb_OK : forall x y, reflect (x = y) (nat_eqb x y). (** Once can also run derive recursively, but this has the same bad effect, all generated concepts will be out of place *) Inductive a := A. Inductive b := B : a -> b. #[recursive, only(eqbOK)] derive b. Check a_eqb. Check b_eqb. LPCIC-coq-elpi-eb449d7/apps/derive/tests-stdlib/000077500000000000000000000000001523041753400213455ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/tests-stdlib/dune000066400000000000000000000003421523041753400222220ustar00rootroot00000000000000(coq.theory (package rocq-elpi-tests-stdlib) (name elpi_apps_derive_tests_stdlib) (flags :standard -w -default-output-directory) (theories elpi elpi.apps.derive elpi.apps.derive.tests Stdlib)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/derive/tests-stdlib/test_derive.v000066400000000000000000000221461523041753400240560ustar00rootroot00000000000000From elpi.apps Require Import derive.std derive.legacy derive.experimental. From elpi.apps Require Import test_derive_corelib. Elpi derive Coverage.empty. Elpi derive Coverage.unit. Elpi derive Coverage.peano. Elpi derive Coverage.option. Elpi derive Coverage.pair. Elpi derive Coverage.seq. Elpi derive Coverage.box_peano. Elpi derive Coverage.rose. Elpi derive Coverage.rose_p. Elpi derive Coverage.rose_o. Elpi derive Coverage.nest. Elpi derive Coverage.w. Elpi derive Coverage.vect. Elpi derive Coverage.dyn. Fail Elpi derive Coverage.zeta. Elpi derive Coverage.beta. Elpi derive Coverage.iota. (* Elpi derive Coverage.large. search slow *) Elpi derive Coverage.prim_int. Elpi derive Coverage.fo_record. Elpi derive Coverage.pa_record. Elpi derive Coverage.pr_record. Elpi derive Coverage.dep_record. Elpi derive Coverage.enum. (* ---------------------------------------------------- *) Elpi derive bool. #[verbose] Elpi derive nat. Redirect "tmp" Check nat_eqb : nat -> nat -> bool. Redirect "tmp" Check is_nat : nat -> Type. Redirect "tmp" Check is_nat_inhab : forall x, is_nat x. Redirect "tmp" Check is_nat_functor : forall x, is_nat x -> is_nat x. Redirect "tmp" Check nat_induction : forall P, P 0 -> (forall n, P n -> P (S n)) -> forall x, is_nat x -> P x. Redirect "tmp" Check nat_tag : nat -> Numbers.BinNums.positive. Redirect "tmp" Check nat_fields_t : Numbers.BinNums.positive -> Type. Redirect "tmp" Check nat_fields : forall (n:nat), nat_fields_t (nat_tag n). Redirect "tmp" Check nat_construct : forall (p: Numbers.BinNums.positive), nat_fields_t p -> option nat. Redirect "tmp" Check nat_constructP : forall (n:nat), nat_construct (nat_tag n) (nat_fields n) = Some n. Redirect "tmp" Check nat_eqb : nat -> nat -> bool. Redirect "tmp" Check nat_eqb_correct. Redirect "tmp" Check nat_eqb_refl. (* ---------------------------------------------------- *) Elpi derive.param1 andb. (* Prelude: Elpi derive list. *) Redirect "tmp" Check list_map : forall A B, (A -> B) -> list A -> list B. Redirect "tmp" Check is_nil : forall A P, is_list A P (@nil A). Redirect "tmp" Check is_cons : forall A P x (Px : P x) tl (Ptl : is_list A P tl), is_list A P (cons x tl). Redirect "tmp" Check is_list_functor : forall A P Q, (forall x, P x -> Q x) -> forall l, is_list A P l -> is_list A Q l. Redirect "tmp" Check list_induction : forall A PA P, P nil -> (forall x, PA x -> forall xs, P xs -> P (cons x xs)) -> forall l, is_list A PA l -> P l. Redirect "tmp" Check list_tag : forall A, list A -> Numbers.BinNums.positive. Redirect "tmp" Check list_fields_t : (Type -> Numbers.BinNums.positive -> Type). Redirect "tmp" Check list_fields : forall (A:Type) (l:list A), list_fields_t A (list_tag A l). Redirect "tmp" Check list_construct : forall (A:Type) (p: Numbers.BinNums.positive), list_fields_t A p -> option (list A). Redirect "tmp" Check list_constructP : forall (A:Type) (l:list A), list_construct A (list_tag A l) (list_fields A l) = Some l. Redirect "tmp" Check list_eqb : forall A, (A -> A -> bool) -> list A -> list A -> bool. Redirect "tmp" Check list_eqb_correct. Redirect "tmp" Check list_eqb_refl. (* ---------------------------------------------------- *) From Stdlib Require Vector. Elpi Print derive "elpi.apps.derive.tests/derive". #[only(eqOK), verbose] derive nat. Module Vector. derive Vector.t. End Vector. Redirect "tmp" Check Vector.t_eq : forall A, (A -> A -> bool) -> forall n, Vector.t A n -> Vector.t A n -> bool. Redirect "tmp" Check Vector.t_isk_nil : forall A n, Vector.t A n -> bool. Redirect "tmp" Check Vector.t_isk_cons : forall A n, Vector.t A n -> bool. Redirect "tmp" Check Vector.t_map : forall A B, (A -> B) -> forall n, Vector.t A n -> Vector.t B n. Redirect "tmp" Check Vector.t_getk_cons1 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> A. Redirect "tmp" Check Vector.t_getk_cons2 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> nat. Redirect "tmp" Check Vector.t_getk_cons3 : forall A n, A -> forall m, Vector.t A m -> Vector.t A n -> { k : nat & Vector.t A k}. Redirect "tmp" Check Vector.is_t : forall A, (A -> Type) -> forall n, is_nat n -> Vector.t A n -> Type. Redirect "tmp" Check Vector.is_nil : forall A (PA : A -> Type), Vector.is_t A PA 0 is_O (Vector.nil A). Redirect "tmp" Check Vector.is_cons : forall A (PA : A -> Type) (a : A), PA a -> forall n (Pn : is_nat n) (H : Vector.t A n), Vector.is_t A PA n Pn H -> Vector.is_t A PA (S n) (is_S n Pn) (Vector.cons A a n H). Redirect "tmp" Check Vector.is_t_functor : forall A PA QA (H : forall x, PA x -> QA x), forall n nR v, Vector.is_t A PA n nR v -> Vector.is_t A QA n nR v. Redirect "tmp" Check Vector.t_induction : forall A PA (P : forall n, is_nat n -> Vector.t A n -> Type), P 0 is_O (Vector.nil A) -> (forall a, PA a -> forall m mR, forall (v : Vector.t A m), P m mR v -> P (S m) (is_S m mR) (Vector.cons A a m v)) -> forall n nR v, Vector.is_t A PA n nR v -> P n nR v. Redirect "tmp" Check Vector.t_tag : forall A i, Vector.t A i -> Numbers.BinNums.positive. Fail Check Vector.t_fields_t : (Type -> Numbers.BinNums.positive -> Type). Fail Check Vector.t_fields : forall (A:Type) (n:nat) (l:Vector.t A n), Vector.t_fields_t A (Vector.t_tag A l). Fail Check Vector.t_construct : forall (A:Type) (p: Numbers.BinNums.positive), Vector.t_fields_t A p -> option (Vector.t A). Fail Check Vector.t_constructP : forall (A:Type) (l:Vector.t A), Vector.t_construct A (Vector.t_tag A l) (Vector.t_fields A l) = Some l. Fail Check Vector.t_eqb : forall A, (A -> A -> bool) -> forall n, Vector.t A n -> Vector.t A n -> bool. (* ---------------------------------------------------- *) Inductive W A := B (f : A -> W). Elpi derive W. (* Not implemented yet :-/ *) Fail Check W_induction : forall A (P : W A -> Type), (forall f, (forall x, UnitPred A x -> P (f x)) -> P (B A f)) -> forall x, P x. Redirect "tmp" Check W_tag : forall A, W A -> Numbers.BinNums.positive. Fail Check W_fields_t : (Type -> Numbers.BinNums.positive -> Type). Fail Check W_fields : forall (A:Type) (l:W A), W_fields_t A (W_tag A l). Fail Check W_construct : forall (A:Type) (p: Numbers.BinNums.positive), W_fields_t A p -> option (W A). Fail Check W_constructP : forall (A:Type) (l:W A), W_construct A (W_tag A l) (W_fields A l) = Some l. (* ---------------------------------------------------- *) Inductive horror A (a : A) : forall T, T -> Type := K W w (k : horror W w) : horror W w. Fail #[only(eqbOK)] derive horror. (* TODO add test for fields? *) (* ---------------------------------------------------- *) Inductive rtree A : Type := Leaf (n : A) | Node (l : list rtree). Module XXX. derive list. derive rtree. End XXX. Fail Check XXX.rtree_is_rtree_map. Redirect "tmp" Check XXX.rtree_tag : forall A, rtree A -> Numbers.BinNums.positive. Redirect "tmp" Check XXX.rtree_fields_t : (Type -> Numbers.BinNums.positive -> Type). Redirect "tmp" Check XXX.rtree_fields : forall (A:Type) (l:rtree A), XXX.rtree_fields_t A (XXX.rtree_tag A l). Redirect "tmp" Check XXX.rtree_construct : forall (A:Type) (p: Numbers.BinNums.positive), XXX.rtree_fields_t A p -> option (rtree A). Redirect "tmp" Check XXX.rtree_constructP : forall (A:Type) (l:rtree A), XXX.rtree_construct A (XXX.rtree_tag A l) (XXX.rtree_fields A l) = Some l. Redirect "tmp" Check XXX.rtree_eqb : forall (A:Type), (A -> A -> bool) -> rtree A -> rtree A -> bool. (* bug #270 *) #[module] derive Inductive triv : Coverage.unit -> Prop := | one t : triv t | more x : triv x. Redirect "tmp" Check triv.induction : forall P : (forall H : Coverage.unit, is_unit H -> triv H -> Prop), (forall t (Pt : is_unit t), P t Pt (one t)) -> (forall x (Px : is_unit x), P x Px (more x)) -> forall u (p : is_unit u) (s : triv u), triv.is_triv u p s -> P u p s. (* #271 *) derive Inductive RoseTree : Type := | RT_ctr (branches : list RoseTree). Elpi derive.param1 is_list. #[module] derive Inductive Pred : RoseTree -> Type := | Pred_ctr branches : is_list _ Pred branches -> Pred (RT_ctr branches). Redirect "tmp" Check Pred.Pred_to_Predinv : forall T, Pred T -> Pred.Predinv T. (* #286 *) Module Import derive_container. Unset Implicit Arguments. Import XXX. derive Inductive wimpls {A} `{rtree A} := Kwi (x:A) (y : x = x) : wimpls | Kwa. End derive_container. About wimpls.wimpls. About wimpls.Kwi. Redirect "tmp" Check Kwi _ (refl_equal 3). Section TestRegister. Variable T : Type. Definition is_T : T -> Type := fun x => True. Definition is_T_inhab : forall x : T, is_T x := fun x => I. Variable eqb : T -> T -> bool. Variable eqb_correct : forall x y,eqb x y = true -> x = y. Variable eqb_refl : forall x, eqb x x = true. derive.eqbOK.register_axiom T is_T is_T_inhab eqb eqb_correct eqb_refl. Inductive foo := X : T -> foo. #[only(eqbOK),verbose] derive foo. Redirect "tmp" Print foo_eqb_OK. End TestRegister. Module TestAlias. Definition nat' := nat. #[only(eqb_alias)] derive nat'. Check nat'_eqb. End TestAlias. Module TestAlias2. Definition P := nat. derive P. (* Elpi derive.eqbOK.register_axiom P is_P is_nat_inhab P_eqb P_eqb_correct P_eqb_refl. *) Definition V := nat. derive V. (* Elpi derive.eqbOK.register_axiom V is_V is_nat_inhab V_eqb V_eqb_correct V_eqb_refl. *) Inductive C := | p of P | v of V. #[verbose] derive C. End TestAlias2. LPCIC-coq-elpi-eb449d7/apps/derive/tests/000077500000000000000000000000001523041753400200665ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/tests/dune000066400000000000000000000002661523041753400207500ustar00rootroot00000000000000(coq.theory (name elpi.apps.derive.tests) (package rocq-elpi-tests) (flags :standard -w -default-output-directory) (theories elpi elpi.apps.derive)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_bcongr.v000066400000000000000000000101531523041753400225660ustar00rootroot00000000000000From elpi.apps Require Import derive.bcongr. From elpi.apps Require Import test_derive_corelib test_projK. Import test_derive_corelib.Coverage. Import test_projK.Coverage. Module Coverage. Elpi derive.bcongr empty. Elpi derive.bcongr unit. Elpi derive.bcongr peano. Elpi derive.bcongr option. Elpi derive.bcongr pair. Elpi derive.bcongr seq. Elpi derive.bcongr box_peano. Elpi derive.bcongr rose. Elpi derive.bcongr rose_p. Elpi derive.bcongr rose_o. Elpi derive.bcongr nest. Elpi derive.bcongr w. Fail Elpi derive.bcongr vect. Fail Elpi derive.bcongr dyn. Elpi derive.bcongr zeta. Elpi derive.bcongr beta. Fail Elpi derive.bcongr iota. (* Elpi derive.bcongr large. *) Elpi derive.bcongr prim_int. Elpi derive.bcongr prim_float. Elpi derive.bcongr prim_string. Elpi derive.bcongr fo_record. Elpi derive.bcongr pa_record. Elpi derive.bcongr pr_record. Fail Elpi derive.bcongr dep_record. Elpi derive.bcongr enum. Elpi derive.bcongr eq. Elpi derive.bcongr bool. Fail Elpi derive.bcongr sigma_bool. Fail Elpi derive.bcongr val. Fail Elpi derive.bcongr ord. Elpi derive.bcongr mempty. Elpi derive.bcongr munit. Elpi derive.bcongr mpeano. Elpi derive.bcongr moption. Elpi derive.bcongr mtree. End Coverage. Import Coverage. Redirect "tmp" Check unit_bcongr_tt : reflect (tt = tt) true. Redirect "tmp" Check peano_bcongr_Zero : reflect (Zero = Zero) true. Redirect "tmp" Check peano_bcongr_Succ : forall x y b, reflect (x = y) b -> reflect (Succ x = Succ y) b. Redirect "tmp" Check option_bcongr_None : forall A, reflect (None A = None A) true. Redirect "tmp" Check option_bcongr_Some : forall A x y b, reflect (x = y) b -> reflect (Some A x = Some A y) b. Redirect "tmp" Check pair_bcongr_Comma : forall A B x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Comma A B x1 y1 = Comma A B x2 y2) (b1 && b2). Redirect "tmp" Check seq_bcongr_Nil : forall A, reflect (Nil A = Nil A) true. Redirect "tmp" Check seq_bcongr_Cons : forall A x y b1, reflect (x = y) b1 -> forall xs ys b2, reflect (xs = ys) b2 -> reflect (Cons A x xs = Cons A y ys) (b1 && b2). Redirect "tmp" Check rose_bcongr_Leaf : forall A x y b, reflect (x = y) b -> reflect (Leaf A x = Leaf A y) b. Redirect "tmp" Check rose_bcongr_Node : forall A l1 l2 b, reflect (l1 = l2) b -> reflect (Node A l1 = Node A l2) b. Redirect "tmp" Check nest_bcongr_NilN : forall A, reflect (NilN A = NilN A) true. Redirect "tmp" Check nest_bcongr_ConsN : forall A x y b1, reflect (x = y) b1 -> forall xs ys b2, reflect (xs = ys) b2 -> reflect (ConsN A x xs = ConsN A y ys) (b1 && b2). Redirect "tmp" Check w_bcongr_via : forall A f g b, reflect (f = g) b -> reflect (via A f = via A g) b. Fail Check vect_bcongr_VNil. Fail Check vect_bcongr_VCons. Fail Check dyn_bcongr_box. Redirect "tmp" Check zeta_bcongr_Envelope : forall A x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Envelope A x1 y1 = Envelope A x2 y2) (b1 && b2). Redirect "tmp" Check beta_bcongr_Redex : forall A x y b, reflect (x = y) b -> reflect (Redex A x = Redex A y) b. Fail Check iota_bcongr_Why. Redirect "tmp" Check prim_int_bcongr_PI : forall x y b, reflect (x = y) b -> reflect (PI x = PI y) b. Redirect "tmp" Check prim_float_bcongr_PF : forall x y b, reflect (x = y) b -> reflect (PF x = PF y) b. (* Check large_bcongr_K1. *) Redirect "tmp" Check fo_record_bcongr_Build_fo_record : forall x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Build_fo_record x1 y1 = Build_fo_record x2 y2) (b1 && b2). Redirect "tmp" Check pa_record_bcongr_Build_pa_record : forall A, forall x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Build_pa_record A x1 y1 = Build_pa_record A x2 y2) (b1 && b2). Redirect "tmp" Check pr_record_bcongr_Build_pr_record : forall A, forall x1 x2 b1, reflect (x1 = x2) b1 -> forall y1 y2 b2, reflect (y1 = y2) b2 -> reflect (Build_pr_record A x1 y1 = Build_pr_record A x2 y2) (b1 && b2). Redirect "tmp" Check enum_bcongr_E1 : reflect (E1 = E1) true. Redirect "tmp" Check enum_bcongr_E2 : reflect (E2 = E2) true. Redirect "tmp" Check enum_bcongr_E3 : reflect (E3 = E3) true. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_derive_corelib.v000066400000000000000000000155251523041753400243010ustar00rootroot00000000000000(* Some standard data types using different features *) From elpi Require elpi. From Corelib Require PrimInt63 PrimFloat. From elpi.apps.derive Require PrimStringEqb. Module Coverage. Inductive empty := . Inductive mempty := with mempty' := . Inductive unit := tt. Inductive munit := mtt with munit' := mtt'. Inductive peano := Zero | Succ (n : peano). Inductive mpeano := mZero | mSucc (n : mpeano') with mpeano' := mZero' | mSucc' (n' : mpeano). Inductive option A := None | Some (_ : A). Inductive moption A := mNone | mSome (_ : A) with moption' A := mNone' | mSome' (_ : A). Inductive pair A B := Comma (a : A) (b : B). Inductive seq A := Nil | Cons (x : A) (xs : seq A). Inductive box_peano := Box (n:peano). Inductive rose (A : Type) := Leaf (a : A) | Node (sib : seq (rose A)). Inductive rose_p (A B : Type) := Leafp (p : pair A B) | Nodep (sib : pair (rose_p A B) (rose_p A B)). Inductive rose_o (A : Type) := Leafo (a : A) | Nodeo (x: pair (rose A) (rose A)) (sib : option (seq (rose A))). Inductive mtree (A : Type) := mLeaf (a : A) | mNode (_ : mforest A) with mforest (A : Type) := mEnd | mTree (_ : mtree A) (_ : mforest A). Inductive nest A := NilN | ConsN (x : A) (xs : nest (pair A A)). Fail Inductive bush A := BNil | BCons (x : A) (xs : bush (bush A)). Inductive w A := via (f : A -> w A). Inductive vect A : peano -> Type := VNil : vect A Zero | VCons (x : A) n (xs : vect A n) : vect A (Succ n). Inductive dyn := box (T : Type) (t : T). Inductive zeta Sender (Receiver := Sender) := Envelope (a : Sender) (ReplyTo := a) (c : Receiver). Inductive beta (A : (fun x : Type => x) Type) := Redex (a : (fun x : Type => x) A). Inductive iota := Why n (a : match n in peano return Type with Zero => peano | Succ _ => unit end). Inductive large := | K1 (_ : unit) | K2 (_ : unit) (_ : unit) | K3 (_ : unit) (_ : unit) (_ : unit) | K4 (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K5 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K6 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K7 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K8 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K9 (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K10(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K11(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K12(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K13(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K14(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K15(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K16(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K17(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K18(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K19(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K20(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K21(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K22(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K23(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K24(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K25(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) | K26(_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit) (_ : unit). Inductive prim_int := PI (i : PrimInt63.int). Inductive prim_float := PF (f : PrimFloat.float). Inductive prim_string := PS (s : lib:elpi.pstring). Record fo_record := { f1 : peano; f2 : unit; }. Record pa_record A := { f3 : peano; f4 : A; }. Set Primitive Projections. Record pr_record A := { pf3 : peano; pf4 : A; }. Unset Primitive Projections. Record dep_record := { f5 : peano; f6 : vect unit f5; }. Variant enum := E1 | E2 | E3. Definition is_zero (n:peano) : bool := match n with | Zero => true | _ => false end. Record sigma_bool := { depn : peano; depeq : is_zero depn = true }. Record sigma_bool2 := { depn2 : peano; depeq2 : lib:elpi.is_true (is_zero depn2) }. Fixpoint is_leq (n m:peano) : bool := match n, m with | Zero, _ => true | Succ n, Succ m => is_leq n m | _, _ => false end. Inductive ord (p : peano) := mkOrd (n : peano) (l : is_leq n p = true). Inductive ord2 (p : peano) := mkOrd2 (o1 o2 : ord p). Inductive val := V (p : peano) (o : ord p). (* to make the coverage cound correct Inductive eq := ... Inductive bool := ... we don't have a copy here because some DBs have special rules*) Definition alias := seq peano. End Coverage. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_derive_vector.v.skip000066400000000000000000000105741523041753400251300ustar00rootroot00000000000000From elpi.apps Require Import derive derive.projK. From elpi.apps Require Import test_derive_corelib. Elpi derive.projK Coverage.vect. Check projVCons3 : forall A n, A -> forall m, Coverage.vect A m -> Coverage.vect A n -> {i1 : Coverage.peano & Coverage.vect A i1}. (* Elpi derive.bcongr Coverage.vect (* FIXME partial *). *) From mathcomp Require Import all_ssreflect. Elpi derive.eq Coverage.peano. Axiom peano_eqP : forall a b : Coverage.peano, reflect (a = b) (peano_eq a b). Print Equality.mixin_of. Canonical peano_eqMixin := Equality.Mixin peano_eqP. Canonical peano_eqType := Equality.Pack peano_eqMixin Coverage.peano. Lemma bcongr_VNil A : reflect (existT _ _ (Coverage.VNil A) = existT _ _ (Coverage.VNil A)) true. Proof. by constructor. Qed. Lemma bcongr_VCons : forall A, forall (a1 a2 : A) b1, reflect (a1 = a2) b1 -> forall (n1 n2 : Coverage.peano) b2, reflect (n1 = n2) b2 -> forall (v1 : Coverage.vect A n1) (v2 : Coverage.vect A n2) b3, reflect (existT _ n1 v1 = existT _ n2 v2) b3 -> reflect (existT _ _ (Coverage.VCons A a1 n1 v1) = existT _ _ (Coverage.VCons A a2 n2 v2)) [&& b1 , b2 & b3]. Proof. move=> A a1 a2 b1 [->|abs1] n1 n2 b2 [E2|abs2]; try case: _ / E2 => v1 v2 b3 [E3|abs3]; constructor. by have /= <- := (projT2_eq E3); rewrite [projT1_eq _]eq_axiomK /=. by move=> abs; apply: abs3; have /= := (projT2_eq abs); rewrite [projT1_eq _]eq_axiomK /= => [= -> ]. by move=> abs; apply: abs2; have [= -> ] := (projT1_eq abs). by move=> abs; apply: abs1; have /= := (projT2_eq abs); rewrite [projT1_eq _]eq_axiomK /= => [= -> ]. by move=> abs; apply: abs1; have /= := (projT2_eq abs); rewrite [projT1_eq _]eq_axiomK /= => [= -> ]. by move=> abs; apply: abs2; have [= -> ] := (projT1_eq abs). Qed. Elpi derive.eq Coverage.vect. Fixpoint vect_eq_sig A f (v1 v2 : {n & Coverage.vect A n}) : bool := let: existT n1 v1 := v1 in let: existT n2 v2 := v2 in if (peano_eqP n1 n2) is ReflectT e then vect_eq A f n2 (match e with erefl => v1 end) v2 else false. Elpi derive.param1 Coverage.peano. Elpi derive.param1 Coverage.vect. Elpi derive.induction Coverage.peano. Elpi derive.induction Coverage.vect. Elpi derive.projK sigT. Lemma bridge A f n v : axiom {n & Coverage.vect A n} (vect_eq_sig A f) (existT _ n v) -> axiom (Coverage.vect A n) (vect_eq A f n) v. Proof. move=> E y; move: (E (existT _ n y)) => /= {E}. case: peano_eqP => // p. rewrite [p]eq_axiomK /=. case=> [H|abs]; constructor. by move: (projT2_eq H); rewrite [projT1_eq _]eq_axiomK /= => <-. by move=> E; apply: abs; rewrite E. Qed. Lemma bridge2 A f n v : axiom (Coverage.vect A n) (vect_eq A f n) v -> axiom {n & Coverage.vect A n} (vect_eq_sig A f) (existT _ n v). Proof. move=> E [m w]; rewrite /vect_eq_sig /=. case: peano_eqP => //= e. case: _ / e w => /= w. case: (E w) => [->|abs]; constructor => // H. by apply: abs; move: (projT2_eq H); rewrite [projT1_eq _]eq_axiomK /= => <-. constructor=> abs; apply: e. apply: projT1_eq abs. Qed. Lemma axiom_VNil : forall (A : Type) (f : A -> A -> bool) x, axiom_at {n & Coverage.vect A n} (vect_eq_sig A f) (existT _ Coverage.Zero (Coverage.VNil A)) x. Proof. move=> A f [n1 [|*]]; rewrite /axiom_at /vect_eq_sig /=; case: peano_eqP => //= e. rewrite [e]eq_axiomK /=; constructor; exact: bcongr_VNil. by constructor=> abs; move: (projT1_eq abs) => /=. Qed. Lemma axiom_VCons : forall A f a n xs, axiom A f a -> axiom {n : Coverage.peano & Coverage.vect A n} (vect_eq_sig A f) (existT [eta Coverage.vect A] n xs) -> axiom {n0 : Coverage.peano & Coverage.vect A n0} (vect_eq_sig A f) (existT [eta Coverage.vect A] (Coverage.Succ n) (Coverage.VCons A a n xs)). Proof. move=> A f a n v Hf H [m [|b w]]; rewrite /vect_eq_sig; case: peano_eqP => //= e. by constructor=> abs; apply: e; move: (projT1_eq abs). move: {-}(e) => [= e1 ]. case: _ / e1 in e *. rewrite [e]eq_axiomK /= => ys. apply: bcongr_VCons. apply: Hf. apply: eqP. by have /= := H (existT _ n ys); case: peano_eqP => // p; rewrite [p]eq_axiomK /=. by move=> tl; constructor=> abs; apply: e; apply: projT1_eq abs. Qed. Lemma ok : forall (a : Type) (fa : a -> a -> bool) n pn (s1 : Coverage.vect a n), vectR a (axiom a fa) n pn s1 -> axiom (Coverage.vect a n) (vect_eq a fa n) s1. Proof. move=> A f; apply: vect_induction. apply: bridge; exact: axiom_VNil. move=> a Hf n nR xs /bridge2 IH; apply/bridge; exact: axiom_VCons. Qed. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eq.v000066400000000000000000000051431523041753400217240ustar00rootroot00000000000000From elpi.apps Require Import test_derive_corelib derive.eq. Import test_derive_corelib.Coverage. Module Coverage. Elpi derive.eq empty. Elpi derive.eq unit. Elpi derive.eq peano. Elpi derive.eq option. Elpi derive.eq pair. Elpi derive.eq seq. Elpi derive.eq box_peano. Elpi derive.eq rose. Elpi derive.eq rose_p. Elpi derive.eq rose_o. Fail Elpi derive.eq nest. Fail Elpi derive.eq w. (* expected *) Elpi derive.eq vect. Fail Elpi derive.eq dyn. (* expected *) Elpi derive.eq zeta. Elpi derive.eq beta. Fail Elpi derive.eq iota. Elpi derive.eq large. Elpi derive.eq prim_int. Elpi derive.eq prim_float. Elpi derive.eq prim_string. Elpi derive.eq fo_record. Elpi derive.eq pa_record. Elpi derive.eq pr_record. Fail Elpi derive.eq dep_record. Elpi derive.eq enum. Fail Elpi derive.eq eq. Elpi derive.eq bool. Fail Elpi derive.eq sigma_bool. Fail Elpi derive.eq ord. Fail Elpi derive.eq val. Elpi derive.eq mempty. Elpi derive.eq munit. Fail Elpi derive.eq mpeano. Elpi derive.eq moption. Fail Elpi derive.eq mtree. End Coverage. Import Coverage. Notation eq_test T := (T -> T -> bool). Redirect "tmp" Check empty_eq : eq_test empty. Redirect "tmp" Check unit_eq : eq_test unit. Redirect "tmp" Check peano_eq : eq_test peano. Redirect "tmp" Check option_eq : forall A, eq_test A -> eq_test (option A). Redirect "tmp" Check pair_eq : forall A, eq_test A -> forall B, eq_test B -> eq_test (pair A B). Redirect "tmp" Check seq_eq : forall A, eq_test A -> eq_test (seq A). Redirect "tmp" Check rose_eq : forall A, eq_test A -> eq_test (rose A). Fail Check nest_eq. Fail Check w_eq. Redirect "tmp" Check vect_eq : forall A, eq_test A -> forall i, eq_test (vect A i). Fail Check dyn_eq. Redirect "tmp" Check zeta_eq : forall A, eq_test A -> eq_test (zeta A). Redirect "tmp" Check beta_eq : forall A, eq_test A -> eq_test (beta A). Fail Check iota_eq : eq_test iota. Redirect "tmp" Check large_eq : eq_test large. Redirect "tmp" Check prim_int_eq : eq_test prim_int. Redirect "tmp" Check prim_float_eq : eq_test prim_float. Redirect "tmp" Check fo_record_eq : eq_test fo_record. Redirect "tmp" Check pa_record_eq : forall A, eq_test A -> eq_test (pa_record A). Redirect "tmp" Check pr_record_eq : forall A, eq_test A -> eq_test (pr_record A). Redirect "tmp" Check enum_eq : eq_test enum. Redirect "tmp" Check mempty_eq : eq_test mempty. Fail Redirect "tmp" Check mempty'_eq : eq_test mempty'. Redirect "tmp" Check munit_eq : eq_test munit. Fail Redirect "tmp" Check munit'_eq : eq_test munit'. Redirect "tmp" Check moption_eq : forall A, eq_test A -> eq_test (moption A). Fail Redirect "tmp" Check moption'_eq : eq_test (moption' A).LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqK.v000066400000000000000000000066231523041753400220430ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive.eqK. From elpi.apps.derive.tests Require Import test_derive_corelib test_isK test_projK test_bcongr test_eq. Import test_derive_corelib.Coverage. Import test_isK.Coverage. Import test_projK.Coverage. Import test_bcongr.Coverage. Import test_eq.Coverage. Module Coverage. Elpi derive.eqK empty. Elpi derive.eqK unit. Elpi derive.eqK peano. Elpi derive.eqK option. Elpi derive.eqK pair. Elpi derive.eqK seq. Elpi derive.eqK box_peano. Elpi derive.eqK rose. Elpi derive.eqK rose_p. Elpi derive.eqK rose_o. Fail Elpi derive.eqK nest. Fail Elpi derive.eqK w. Fail Elpi derive.eqK vect. Fail Elpi derive.eqK dyn. Elpi derive.eqK zeta. Elpi derive.eqK beta. Fail Elpi derive.eqK iota. (* Elpi derive.eqK large. *) Elpi derive.eqK prim_int. Elpi derive.eqK prim_float. Elpi derive.eqK prim_string. Elpi derive.eqK fo_record. Elpi derive.eqK pa_record. Elpi derive.eqK pr_record. Fail Elpi derive.eqK dep_record. Elpi derive.eqK enum. Fail Elpi derive.eqK sigma_bool. Fail Elpi derive.eqK eq. Elpi derive.eqK bool. Fail Elpi derive.eqK val. Fail Elpi derive.eqK ord. Elpi derive.eqK mempty. Elpi derive.eqK munit. Fail Elpi derive.eqK mpeano. Elpi derive.eqK moption. Fail Elpi derive.eqK mtree. End Coverage. Import Coverage. Import test_eq.Coverage. Redirect "tmp" Check eq_axiom_tt : eq_axiom_at unit unit_eq tt. Redirect "tmp" Check eq_axiom_Zero : eq_axiom_at peano peano_eq Zero. Redirect "tmp" Check eq_axiom_Succ : forall y, eq_axiom_at peano peano_eq y -> eq_axiom_at peano peano_eq (Succ y). Redirect "tmp" Check eq_axiom_None : forall A f, eq_axiom_at (option A) (option_eq A f) (None A). Redirect "tmp" Check eq_axiom_Some : forall A f x, eq_axiom_at A f x -> eq_axiom_at (option A) (option_eq A f) (Some A x). Redirect "tmp" Check eq_axiom_Comma: forall A f B g, forall x, eq_axiom_at A f x -> forall y, eq_axiom_at B g y -> eq_axiom_at (pair A B) (pair_eq A f B g) (Comma A B x y). Redirect "tmp" Check eq_axiom_Nil: forall A f, eq_axiom_at (seq A) (seq_eq A f) (Nil A). Redirect "tmp" Check eq_axiom_Cons : forall A f x, eq_axiom_at A f x -> forall xs, eq_axiom_at (seq A) (seq_eq A f) xs -> eq_axiom_at (seq A) (seq_eq A f) (Cons A x xs). Redirect "tmp" Check eq_axiom_Leaf: forall A f a, eq_axiom_at A f a -> eq_axiom_at (rose A) (rose_eq A f) (Leaf A a). Redirect "tmp" Check eq_axiom_Node: forall A f l, eq_axiom_at (seq (rose A)) (seq_eq (rose A) (rose_eq A f)) l -> eq_axiom_at (rose A) (rose_eq A f) (Node A l). Redirect "tmp" Check eq_axiom_Envelope. Redirect "tmp" Check eq_axiom_Redex. (*Check eq_axiom_K1.*) Redirect "tmp" Check eq_axiom_PI. Redirect "tmp" Check eq_axiom_PF. Redirect "tmp" Check eq_axiom_Build_fo_record : forall x, eq_axiom_at peano peano_eq x -> forall y, eq_axiom_at unit unit_eq y -> eq_axiom_at fo_record fo_record_eq (Build_fo_record x y). Redirect "tmp" Check eq_axiom_Build_pa_record : forall A f, forall x, eq_axiom_at peano peano_eq x -> forall y, eq_axiom_at A f y -> eq_axiom_at (pa_record A) (pa_record_eq A f) (Build_pa_record A x y). Redirect "tmp" Check eq_axiom_Build_pr_record : forall A f, forall x, eq_axiom_at peano peano_eq x -> forall y, eq_axiom_at A f y -> eq_axiom_at (pr_record A) (pr_record_eq A f) (Build_pr_record A x y). Redirect "tmp" Check eq_axiom_E1 : eq_axiom_at enum enum_eq E1. Redirect "tmp" Check eq_axiom_E2 : eq_axiom_at enum enum_eq E2. Redirect "tmp" Check eq_axiom_E3 : eq_axiom_at enum enum_eq E3. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqOK.v000066400000000000000000000064601523041753400221610ustar00rootroot00000000000000From elpi.apps Require Import derive.param1 derive.eqOK. From elpi.apps Require Import test_derive_corelib test_eqcorrect test_param1 test_param1_trivial. Import test_derive_corelib.Coverage. Import tests.test_eq.Coverage. Import test_eqcorrect.Coverage. Import test_param1.Coverage. Import test_param1_trivial.Coverage. Module Coverage. Elpi derive.eqOK empty. Elpi derive.eqOK unit. Elpi derive.eqOK peano. Elpi derive.eqOK option. Elpi derive.eqOK pair. Elpi derive.eqOK seq. Elpi derive.eqOK box_peano. Elpi derive.eqOK rose. Elpi derive.eqOK rose_p. Elpi derive.eqOK rose_o. Fail Elpi derive.eqOK nest. Fail Elpi derive.eqOK w. Fail Elpi derive.eqOK vect. Fail Elpi derive.eqOK dyn. Elpi derive.eqOK zeta. Elpi derive.eqOK beta. Fail Elpi derive.eqOK iota. (* Elpi derive.eqOK large. *) Elpi derive.eqOK prim_int. Fail Elpi derive.eqOK prim_float. Elpi derive.eqOK prim_string. Elpi derive.eqOK fo_record. Elpi derive.eqOK pa_record. Elpi derive.eqOK pr_record. Fail Elpi derive.eqOK dep_record. Elpi derive.eqOK enum. Elpi derive.eqOK bool. Fail Elpi derive.eqOK eq. Fail Elpi derive.eqOK sigma_bool. Fail Elpi derive.eqOK val. Fail Elpi derive.eqOK ord. Fail Elpi derive.eqOK mempty. Fail Elpi derive.eqOK munit. Fail Elpi derive.eqOK mpeano. Fail Elpi derive.eqOK moption. Fail Elpi derive.eqOK mtree. End Coverage. Import Coverage eqK. Local Notation ok T F := (forall x, eq_axiom_at T F x). Redirect "tmp" Check empty_eq_OK : ok empty empty_eq. Redirect "tmp" Check unit_eq_OK : ok unit unit_eq. Redirect "tmp" Check peano_eq_OK : ok peano peano_eq. Redirect "tmp" Check option_eq_OK : forall A f, ok A f -> ok (option A) (option_eq A f). Redirect "tmp" Check pair_eq_OK : forall A f, ok A f -> forall B g, ok B g -> ok (pair A B) (pair_eq A f B g). Redirect "tmp" Check seq_eq_OK : forall A f, ok A f -> ok (seq A) (seq_eq A f). Redirect "tmp" Check rose_eq_OK : forall A f, ok A f -> ok (rose A) (rose_eq A f). Fail Check nest_eq_OK. Fail Check w_eq_OK. Fail Check vect_eq_OK. Fail Check dyn_eq_OK. Redirect "tmp" Check zeta_eq_OK : forall A f, ok A f -> ok (zeta A) (zeta_eq A f). Redirect "tmp" Check beta_eq_OK : forall A f, ok A f -> ok (beta A) (beta_eq A f). Fail Check iota_eq_OK. (* Check large_eq_OK : ok large large_eq. *) Redirect "tmp" Check prim_int_eq_OK. Fail Check prim_float_eq_OK. Redirect "tmp" Check fo_record_eq_OK : ok fo_record fo_record_eq. Redirect "tmp" Check pa_record_eq_OK : forall A f, ok A f -> ok (pa_record A) (pa_record_eq A f). Redirect "tmp" Check pr_record_eq_OK : forall A f, ok A f -> ok (pr_record A) (pr_record_eq A f). Redirect "tmp" Check enum_eq_OK : ok enum enum_eq. From elpi.apps Require Import test_param1_functor. Import test_param1_functor.Coverage. Set Uniform Inductive Parameters. Module OtherTests. Import test_param1_functor.Coverage. Inductive dlist A := dnil | dcons (a : pair A peano) (l : dlist). Elpi derive.param1 dlist. Elpi derive.param1.congr is_dlist. Elpi derive.param1.trivial is_dlist. Elpi derive.induction dlist. Elpi derive.projK dlist. Elpi derive.bcongr dlist. Elpi derive.isK dlist. Elpi derive.param1.functor is_dlist. Elpi derive.eq dlist. Elpi derive.eqK dlist. Elpi derive.eqcorrect dlist. Elpi derive.eqOK dlist dlist_eqOK. Redirect "tmp" Check dlist_eqOK : forall A f (h : forall l, eq_axiom_at A f l) l, eq_axiom_at (dlist A) (dlist_eq A f) l. End OtherTests. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqType_ast.v000066400000000000000000000034201523041753400234310ustar00rootroot00000000000000From elpi.apps Require Import derive.eqType_ast. From elpi.apps.derive.tests Require Import test_derive_corelib. Import test_derive_corelib.Coverage. Module Coverage. Elpi derive.eqType.ast empty. Elpi derive.eqType.ast unit. Elpi derive.eqType.ast peano. Elpi derive.eqType.ast option. Elpi derive.eqType.ast pair. Elpi derive.eqType.ast seq. Elpi derive.eqType.ast box_peano. Elpi derive.eqType.ast rose. Elpi derive.eqType.ast rose_p. Elpi derive.eqType.ast rose_o. Fail Elpi derive.eqType.ast nest. Fail Elpi derive.eqType.ast w. Fail Elpi derive.eqType.ast vect. Fail Elpi derive.eqType.ast dyn. Fail Elpi derive.eqType.ast zeta. Elpi derive.eqType.ast beta. Fail Elpi derive.eqType.ast iota. Elpi derive.eqType.ast large. Elpi derive.eqType.ast prim_int. Fail Elpi derive.eqType.ast prim_float. Elpi derive.eqType.ast prim_string. Elpi derive.eqType.ast fo_record. Elpi derive.eqType.ast pa_record. Elpi derive.eqType.ast pr_record. Fail Elpi derive.eqType.ast dep_record. Elpi derive.eqType.ast enum. Elpi derive.eqType.ast bool. Fail Elpi derive.eqType.ast eq. Elpi derive.eqType.ast sigma_bool. Elpi derive.eqType.ast sigma_bool2. Elpi derive.eqType.ast ord. Elpi derive.eqType.ast ord2. Elpi derive.eqType.ast val. Fail Elpi derive.eqType.ast mempty. Fail Elpi derive.eqType.ast munit. Fail Elpi derive.eqType.ast mpeano. Fail Elpi derive.eqType.ast moption. Fail Elpi derive.eqType.ast mtree. End Coverage. Import Coverage. Inductive F1 := | K1 : (peano -> peano) -> F1. Fail Elpi derive.eqType.ast F1. Inductive F2 := | K2 : F1 -> F2. Fail Elpi derive.eqType.ast F2. Inductive S1 (x : F1) := | D1. Elpi derive.eqType.ast S1. Inductive S2 (x : F1) := | D2 : S1 x -> S2. Elpi derive.eqType.ast S2. Inductive S3 (f : peano -> peano) := | D3 x : f x = x -> S3. Elpi derive.eqType.ast S3. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqb.v000066400000000000000000000057221523041753400220710ustar00rootroot00000000000000From elpi.apps Require Import derive.eqb. From elpi.apps.derive.tests Require Import test_derive_corelib test_eqType_ast test_tag test_fields. Import test_derive_corelib.Coverage test_eqType_ast.Coverage test_tag.Coverage test_fields.Coverage. Module Coverage. Elpi derive.eqb empty. Elpi derive.eqb unit. Elpi derive.eqb peano. Elpi derive.eqb option. Elpi derive.eqb pair. Elpi derive.eqb seq. Elpi derive.eqb box_peano. Elpi derive.eqb rose. Elpi derive.eqb rose_p. Elpi derive.eqb rose_o. Fail Elpi derive.eqb nest. Fail Elpi derive.eqb w. Fail Elpi derive.eqb vect. Fail Elpi derive.eqb dyn. Fail Elpi derive.eqb zeta. Elpi derive.eqb beta. Fail Elpi derive.eqb iota. (* slow Elpi derive.eqb large. *) Elpi derive.eqb prim_int. Fail Elpi derive.eqb prim_float. Elpi derive.eqb prim_string. Elpi derive.eqb fo_record. Elpi derive.eqb pa_record. Elpi derive.eqb pr_record. Fail Elpi derive.eqb dep_record. Elpi derive.eqb enum. Fail Elpi derive.eqb eq. Elpi derive.eqb bool. Elpi derive.eqb sigma_bool. Elpi derive.eqb sigma_bool2. Elpi derive.eqb ord. Elpi derive.eqb ord2. Elpi derive.eqb val. Elpi derive.eqb alias. Fail Elpi derive.eqb mempty. Fail Elpi derive.eqb munit. Fail Elpi derive.eqb mpeano. Fail Elpi derive.eqb moption. Fail Elpi derive.eqb mtree. End Coverage. Import Coverage. From Corelib Require Import PosDef. Notation eq_test T := (T -> T -> bool). Notation eq_test2 T1 T2 := (T1 -> T2 -> bool). Redirect "tmp" Check empty_eqb : eq_test empty. Redirect "tmp" Check unit_eqb : eq_test unit. Redirect "tmp" Check peano_eqb : eq_test peano. Redirect "tmp" Check option_eqb : forall A, eq_test A -> eq_test (option A). Redirect "tmp" Check pair_eqb : forall A, eq_test A -> forall B, eq_test B -> eq_test (pair A B). Redirect "tmp" Check seq_eqb : forall A, eq_test A -> eq_test (seq A). Redirect "tmp" Check rose_eqb : forall A, eq_test A -> eq_test (rose A). Fail Check nest_eqb. (* Check w_eqb. (* Do something but it is stupide*) *) Fail Check vect_eqb : forall A, eq_test A -> forall i, eq_test (vect A i). Fail Check dyn_eqb. Fail Check zeta_eqb : forall A, eq_test A -> eq_test (zeta A). Redirect "tmp" Check beta_eqb : forall A, eq_test A -> eq_test (beta A). Fail Check iota_eqb : eq_test iota. (* Check large_eqb : eq_test large. *) (* FIXME : the definition of prim_int_eqb_fields*) Redirect "tmp" Check prim_int_eqb : eq_test prim_int. Fail Check prim_float_eqb : eq_test prim_float. Redirect "tmp" Check fo_record_eqb : eq_test fo_record. Redirect "tmp" Check pa_record_eqb : forall A, eq_test A -> eq_test (pa_record A). Redirect "tmp" Check pr_record_eqb : forall A, eq_test A -> eq_test (pr_record A). Redirect "tmp" Check enum_eqb : eq_test enum. Redirect "tmp" Check sigma_bool_eqb : eq_test sigma_bool. Redirect "tmp" Check ord_eqb : forall p1 p2, eq_test2 (ord p1) (ord p2). Redirect "tmp" Check ord2_eqb : forall p1 p2, eq_test2 (ord2 p1) (ord2 p2). Redirect "tmp" Check val_eqb : eq_test val. Redirect "tmp" Check alias_eqb : eq_test alias. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqbOK.v000066400000000000000000000035051523041753400223200ustar00rootroot00000000000000From elpi.apps Require Import derive.eqbOK. From elpi.apps.derive.tests Require Import test_derive_corelib test_eqb test_eqbcorrect. Import test_derive_corelib.Coverage test_eqType_ast.Coverage test_eqb.Coverage test_eqbcorrect.Coverage. Module Coverage. Elpi derive.eqbOK empty. Elpi derive.eqbOK unit. Elpi derive.eqbOK peano. Elpi derive.eqbOK option. Elpi derive.eqbOK pair. Elpi derive.eqbOK seq. Elpi derive.eqbOK box_peano. Elpi derive.eqbOK rose. Elpi derive.eqbOK rose_p. Elpi derive.eqbOK rose_o. Fail Elpi derive.eqbOK nest. Fail Elpi derive.eqbOK w. Fail Elpi derive.eqbOK vect. Fail Elpi derive.eqbOK dyn. Fail Elpi derive.eqbOK zeta. Elpi derive.eqbOK beta. Fail Elpi derive.eqbOK iota. (* Elpi derive.eqbOK large. *) Elpi derive.eqbOK prim_int. Fail Elpi derive.eqbOK prim_float. Elpi derive.eqbOK prim_string. Elpi derive.eqbOK fo_record. Elpi derive.eqbOK pa_record. Elpi derive.eqbOK pr_record. Fail Elpi derive.eqbOK dep_record. Elpi derive.eqbOK enum. Fail Elpi derive.eqbOK eq. Elpi derive.eqbOK bool. Elpi derive.eqbOK sigma_bool. Elpi derive.eqbOK sigma_bool2. Elpi derive.eqbOK ord. Elpi derive.eqbOK ord2. Elpi derive.eqbOK val. Elpi derive.eqbOK alias. Fail Elpi derive.eqbOK mempty. Fail Elpi derive.eqbOK munit. Fail Elpi derive.eqbOK mpeano. Fail Elpi derive.eqbOK moption. Fail Elpi derive.eqbOK mtree. End Coverage. Import Coverage. Redirect "tmp" Check peano_eqb_OK : forall n m, Datatypes.reflect (n = m) (peano_eqb n m). Redirect "tmp" Check seq_eqb_OK : forall A eqA (h : forall a1 a2 : A, Datatypes.reflect (a1 = a2) (eqA a1 a2)) l1 l2, Datatypes.reflect (l1 = l2) (seq_eqb A eqA l1 l2). Redirect "tmp" Check ord_eqb_OK : forall n (o1 o2 : ord n), Datatypes.reflect (o1 = o2) (ord_eqb n n o1 o2). Redirect "tmp" Check alias_eqb_OK : forall x y : alias, Datatypes.reflect (x = y) (alias_eqb x y). LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqbcorrect.v000066400000000000000000000055711523041753400234550ustar00rootroot00000000000000From elpi.apps Require Import derive.eqbcorrect. From elpi.apps.derive Require Import param1. (* FIXME, the clause is in param1 *) From elpi.apps.derive.tests Require Import test_derive_corelib test_eqType_ast test_tag test_fields test_eqb test_induction test_param1 test_param1_trivial test_param1_functor. Import test_derive_corelib.Coverage test_eqType_ast.Coverage test_tag.Coverage test_fields.Coverage test_eqb.Coverage test_induction.Coverage test_param1.Coverage test_param1_trivial.Coverage test_param1_functor.Coverage. Module Coverage. (* Elpi Trace (* "derive.eqbcorrect.*" "derive.param1.functor.*" "correct-lemma-for" *) "param1-functor-for". *) Elpi derive.eqbcorrect empty. Elpi derive.eqbcorrect unit. Elpi derive.eqbcorrect peano. Elpi derive.eqbcorrect option. Elpi derive.eqbcorrect pair. Elpi derive.eqbcorrect seq. Elpi derive.eqbcorrect box_peano. Elpi derive.eqbcorrect rose. Elpi derive.eqbcorrect rose_p. Elpi derive.eqbcorrect rose_o. Fail Elpi derive.eqbcorrect nest. (* Maybe fixable *) Fail Elpi derive.eqbcorrect w. (* Not fixable *) Fail Elpi derive.eqbcorrect vect. (* Can be done *) Fail Elpi derive.eqbcorrect dyn. (* Not Fixable *) Fail Elpi derive.eqbcorrect zeta. (* FIXME *) Elpi derive.eqbcorrect beta. Fail Elpi derive.eqbcorrect iota. (* Elpi derive.eqbcorrect large. *) Elpi derive.eqbcorrect prim_int. Fail Elpi derive.eqbcorrect prim_float. (* Can not work, we don't have a syntaxtic test *) Elpi derive.eqbcorrect prim_string. Elpi derive.eqbcorrect fo_record. Elpi derive.eqbcorrect pa_record. Elpi derive.eqbcorrect pr_record. Fail Elpi derive.eqbcorrect dep_record. Elpi derive.eqbcorrect enum. Fail Elpi derive.eqbcorrect eq. Elpi derive.eqbcorrect bool. Elpi derive.eqbcorrect sigma_bool. Elpi derive.eqbcorrect sigma_bool2. Elpi derive.eqbcorrect ord. Elpi derive.eqbcorrect ord2. Elpi derive.eqbcorrect val. Elpi derive.eqbcorrect alias. Fail Elpi derive.eqbcorrent mempty. Fail Elpi derive.eqbcorrent munit. Fail Elpi derive.eqbcorrent mpeano. Fail Elpi derive.eqbcorrent moption. Fail Elpi derive.eqbcorrent mtree. End Coverage. Import Coverage. Redirect "tmp" Check peano_eqb_correct : forall n m, peano_eqb n m = true -> n = m. Redirect "tmp" Check peano_eqb_refl : forall n, peano_eqb n n = true. Redirect "tmp" Check ord_eqb_correct : forall n, eqb_correct (ord_eqb n n). Redirect "tmp" Check ord_eqb_refl : forall n, eqb_reflexive (ord_eqb n n). Redirect "tmp" Check ord2_eqb_correct : forall n, eqb_correct (ord2_eqb n n). Redirect "tmp" Check ord2_eqb_refl : forall n, eqb_reflexive (ord2_eqb n n). Redirect "tmp" Check val_eqb_correct : eqb_correct val_eqb. Redirect "tmp" Check val_eqb_refl : eqb_reflexive val_eqb. Redirect "tmp" Check alias_eqb_correct : eqb_correct alias_eqb. Redirect "tmp" Check alias_eqb_refl : eqb_reflexive alias_eqb. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_eqcorrect.v000066400000000000000000000063261523041753400233120ustar00rootroot00000000000000From elpi.apps Require Import derive.eqcorrect. From elpi.apps Require Import test_derive_corelib derive.tests.test_eq test_param1 test_param1_functor test_induction test_eqK. Import test_derive_corelib.Coverage. Import tests.test_eq.Coverage. Import test_param1.Coverage. Import test_param1_functor.Coverage. Import test_induction.Coverage. Import test_eqK.Coverage. Module Coverage. Elpi derive.eqcorrect empty. Elpi derive.eqcorrect unit. Elpi derive.eqcorrect peano. Elpi derive.eqcorrect option. Elpi derive.eqcorrect pair. Elpi derive.eqcorrect seq. Elpi derive.eqcorrect box_peano. Elpi derive.eqcorrect rose. Elpi derive.eqcorrect rose_p. Elpi derive.eqcorrect rose_o. Fail Elpi derive.eqcorrect nest. Fail Elpi derive.eqcorrect w. Fail Elpi derive.eqcorrect vect. Fail Elpi derive.eqcorrect dyn. Elpi derive.eqcorrect zeta. Elpi derive.eqcorrect beta. Fail Elpi derive.eqcorrect iota. (* Elpi derive.eqcorrect large. *) Elpi derive.eqcorrect prim_int. Fail Elpi derive.eqcorrect prim_float. Elpi derive.eqcorrect prim_string. Elpi derive.eqcorrect fo_record. Elpi derive.eqcorrect pa_record. Elpi derive.eqcorrect pr_record. Fail Elpi derive.eqcorrect dep_record. Elpi derive.eqcorrect enum. Fail Elpi derive.eqcorrect eq. Elpi derive.eqcorrect bool. Fail Elpi derive.eqcorrect sigma_bool. Fail Elpi derive.eqcorrect ord. Fail Elpi derive.eqcorrect val. Fail Elpi derive.eqcorrenct mempty. Fail Elpi derive.eqcorrenct munit. Fail Elpi derive.eqcorrenct mpeano. Fail Elpi derive.eqcorrenct moption. Fail Elpi derive.eqcorrenct mtree. End Coverage. Import Coverage eqK. Local Notation correct X isX F := (forall x, isX x -> eq_axiom_at X F x). Redirect "tmp" Check empty_eq_correct : correct empty is_empty empty_eq. Redirect "tmp" Check unit_eq_correct : correct unit is_unit unit_eq. Redirect "tmp" Check peano_eq_correct : correct peano is_peano peano_eq. Redirect "tmp" Check option_eq_correct : forall A f, correct (option A) (is_option A (eq_axiom_at A f)) (option_eq A f). Redirect "tmp" Check pair_eq_correct : forall A f B g, correct (pair A B) (is_pair A (eq_axiom_at A f) B (eq_axiom_at B g)) (pair_eq A f B g). Redirect "tmp" Check seq_eq_correct : forall A f, correct (seq A) (is_seq A (eq_axiom_at A f)) (seq_eq A f). Redirect "tmp" Check rose_eq_correct : forall A f, correct (rose A) (is_rose A (eq_axiom_at A f)) (rose_eq A f). Fail Check nest_eq_correct. Fail Check w_eq_correct. Fail Check vect_eq_correct. Fail Check dyn_eq_correct. Redirect "tmp" Check zeta_eq_correct : forall A f, correct (zeta A) (is_zeta A (eq_axiom_at A f)) (zeta_eq A f). Redirect "tmp" Check beta_eq_correct : forall A f, correct (beta A) (is_beta A (eq_axiom_at A f)) (beta_eq A f). Fail Check iota_eq_correct. (* Check large_eq_correct : correct large is_large large_eq. *) Redirect "tmp" Check prim_int_eq_correct. Fail Check prim_float_eq_correct. Redirect "tmp" Check fo_record_eq_correct : correct fo_record is_fo_record fo_record_eq. Redirect "tmp" Check pa_record_eq_correct : forall A f, correct (pa_record A) (is_pa_record A (eq_axiom_at A f)) (pa_record_eq A f). Redirect "tmp" Check pr_record_eq_correct : forall A f, correct (pr_record A) (is_pr_record A (eq_axiom_at A f)) (pr_record_eq A f). Redirect "tmp" Check enum_eq_correct : correct enum is_enum enum_eq. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_fields.v000066400000000000000000000252611523041753400225700ustar00rootroot00000000000000From elpi.apps Require Import derive.fields. From elpi.apps.derive.tests Require Import test_derive_corelib test_eqType_ast test_tag. Import test_derive_corelib.Coverage test_eqType_ast.Coverage test_tag.Coverage. Module Coverage. Elpi derive.fields empty. Elpi derive.fields unit. Elpi derive.fields peano. Elpi derive.fields option. Elpi derive.fields pair. Elpi derive.fields seq. Elpi derive.fields box_peano. Elpi derive.fields rose. Elpi derive.fields rose_p. Elpi derive.fields rose_o. Fail Elpi derive.fields nest. Fail Elpi derive.fields w. Fail Elpi derive.fields vect. Fail Elpi derive.fields dyn. Fail Elpi derive.fields zeta. Elpi derive.fields beta. Fail Elpi derive.fields iota. Elpi derive.fields large. Elpi derive.fields prim_int. Fail Elpi derive.fields prim_float. Elpi derive.fields prim_string. Elpi derive.fields fo_record. Elpi derive.fields pa_record. Elpi derive.fields pr_record. Fail Elpi derive.fields dep_record. Elpi derive.fields enum. Elpi derive.fields bool. Fail Elpi derive.fields eq. Elpi derive.fields sigma_bool. Elpi derive.fields sigma_bool2. Elpi derive.fields ord. Elpi derive.fields ord2. Elpi derive.fields val. Fail Elpi derive.fields mempty. Fail Elpi derive.fields munit. Fail Elpi derive.fields mpeano. Fail Elpi derive.fields moption. Fail Elpi derive.fields mtree. End Coverage. Import Coverage. From Corelib Require Import PosDef. Redirect "tmp" Check empty_fields_t : positive -> Type. Redirect "tmp" Check empty_fields : forall (n:empty), empty_fields_t (empty_tag n). Redirect "tmp" Check empty_construct : forall (p: positive), empty_fields_t p -> Datatypes.option empty. Redirect "tmp" Check empty_constructP : forall (n:empty), empty_construct (empty_tag n) (empty_fields n) = Datatypes.Some n. Redirect "tmp" Check unit_fields_t : positive -> Type. Redirect "tmp" Check unit_fields : forall (n:unit), unit_fields_t (unit_tag n). Redirect "tmp" Check unit_construct : forall (p: positive), unit_fields_t p -> Datatypes.option unit. Redirect "tmp" Check unit_constructP : forall (n:unit), unit_construct (unit_tag n) (unit_fields n) = Datatypes.Some n. Redirect "tmp" Check peano_fields_t : positive -> Type. Redirect "tmp" Check peano_fields : forall (n:peano), peano_fields_t (peano_tag n). Redirect "tmp" Check peano_construct : forall (p: positive), peano_fields_t p -> Datatypes.option peano. Redirect "tmp" Check peano_constructP : forall (n:peano), peano_construct (peano_tag n) (peano_fields n) = Datatypes.Some n. Redirect "tmp" Check option_fields_t : Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check option_fields : forall (A:Type) (l:option A), option_fields_t A (option_tag A l). Redirect "tmp" Check option_construct : forall (A:Type) (p: Numbers.BinNums.positive), option_fields_t A p -> Datatypes.option (option A). Redirect "tmp" Check option_constructP : forall (A:Type) (l:option A), option_construct A (option_tag A l) (option_fields A l) = Datatypes.Some l. Redirect "tmp" Check pair_fields_t : Type -> Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check pair_fields : forall (A B :Type) (l:pair A B), pair_fields_t A B (pair_tag A B l). Redirect "tmp" Check pair_construct : forall (A B:Type) (p: Numbers.BinNums.positive), pair_fields_t A B p -> Datatypes.option (pair A B). Redirect "tmp" Check pair_constructP : forall (A B:Type) (l:pair A B), pair_construct A B (pair_tag A B l) (pair_fields A B l) = Datatypes.Some l. Redirect "tmp" Check seq_fields_t : Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check seq_fields : forall (A:Type) (l:seq A), seq_fields_t A (seq_tag A l). Redirect "tmp" Check seq_construct : forall (A:Type) (p: Numbers.BinNums.positive), seq_fields_t A p -> Datatypes.option (seq A). Redirect "tmp" Check seq_constructP : forall (A:Type) (l:seq A), seq_construct A (seq_tag A l) (seq_fields A l) = Datatypes.Some l. Redirect "tmp" Check rose_fields_t : Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check rose_fields : forall (A:Type) (l:rose A), rose_fields_t A (rose_tag A l). Redirect "tmp" Check rose_construct : forall (A:Type) (p: Numbers.BinNums.positive), rose_fields_t A p -> Datatypes.option (rose A). Redirect "tmp" Check rose_constructP : forall (A:Type) (l:rose A), rose_construct A (rose_tag A l) (rose_fields A l) = Datatypes.Some l. Fail Check nest_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check nest_fields : forall (A:Type) (l:nest A), nest_fields_t A (nest_tag A l). Fail Check nest_construct : forall (A:Type) (p: Numbers.BinNums.positive), nest_fields_t A p -> Datatypes.option (nest A). Fail Check nest_constructP : forall (A:Type) (l:nest A), nest_construct A (nest_tag A l) (nest_fields A l) = Datatypes.Some l. Fail Check w_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check w_fields : forall (A:Type) (l:w A), w_fields_t A (w_tag A l). Fail Check w_construct : forall (A:Type) (p: Numbers.BinNums.positive), w_fields_t A p -> Datatypes.option (w A). Fail Check w_constructP : forall (A:Type) (l:w A), w_construct A (w_tag A l) (w_fields A l) = Datatypes.Some l. Fail Check vect_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check vect_fields : forall (A:Type) (l:vect A), vect_fields_t A (vect_tag A l). Fail Check vect_construct : forall (A:Type) (p: Numbers.BinNums.positive), vect_fields_t A p -> Datatypes.option (vect A). Fail Check vect_constructP : forall (A:Type) (l:vect A), vect_construct A (vect_tag A l) (vect_fields A l) = Datatypes.Some l. Fail Check dyn_fields_t : positive -> Type. Fail Check dyn_fields : forall (n:dyn), dyn_fields_t (dyn_tag n). Fail Check dyn_construct : forall (p: positive), dyn_fields_t p -> Datatypes.option dyn. Fail Check dyn_constructP : forall (n:dyn), dyn_construct (dyn_tag n) (dyn_fields n) = Datatypes.Some n. Fail Check zeta_fields_t : Type -> Numbers.BinNums.positive -> Type. Fail Check zeta_fields : forall (A:Type) (l:zeta A), zeta_fields_t A (zeta_tag A l). Fail Check zeta_construct : forall (A:Type) (p: Numbers.BinNums.positive), zeta_fields_t A p -> option (zeta A). Fail Check zeta_constructP : forall (A:Type) (l:zeta A), zeta_construct A (zeta_tag A l) (zeta_fields A l) = Some l. Redirect "tmp" Check beta_fields_t : Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check beta_fields : forall (A:Type) (l:beta A), beta_fields_t A (beta_tag A l). Redirect "tmp" Check beta_construct : forall (A:Type) (p: Numbers.BinNums.positive), beta_fields_t A p -> Datatypes.option (beta A). Redirect "tmp" Check beta_constructP : forall (A:Type) (l:beta A), beta_construct A (beta_tag A l) (beta_fields A l) = Datatypes.Some l. Fail Check iota_fields_t : positive -> Type. Fail Check iota_fields : forall (n:iota), iota_fields_t (iota_tag n). Fail Check iota_construct : forall (p: positive), iota_fields_t p -> Datatypes.option iota. Fail Check iota_constructP : forall (n:iota), iota_construct (iota_tag n) (iota_fields n) = Datatypes.Some n. Redirect "tmp" Check large_fields_t : positive -> Type. Redirect "tmp" Check large_fields : forall (n:large), large_fields_t (large_tag n). Redirect "tmp" Check large_construct : forall (p: positive), large_fields_t p -> Datatypes.option large. Redirect "tmp" Check large_constructP : forall (n:large), large_construct (large_tag n) (large_fields n) = Datatypes.Some n. Redirect "tmp" Check prim_int_fields_t : positive -> Type. Redirect "tmp" Check prim_int_fields : forall (n:prim_int), prim_int_fields_t (prim_int_tag n). Redirect "tmp" Check prim_int_construct : forall (p: positive), prim_int_fields_t p -> Datatypes.option prim_int. Redirect "tmp" Check prim_int_constructP : forall (n:prim_int), prim_int_construct (prim_int_tag n) (prim_int_fields n) = Datatypes.Some n. Fail Check prim_float_fields_t : positive -> Type. Fail Check prim_float_fields : forall (n:prim_float), prim_float_fields_t (prim_float_tag n). Fail Check prim_float_construct : forall (p: positive), prim_float_fields_t p -> Datatypes.option prim_float. Fail Check prim_float_constructP : forall (n:prim_float), prim_float_construct (prim_float_tag n) (prim_float_fields n) = Datatypes.Some n. Redirect "tmp" Check pa_record_fields_t : Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check pa_record_fields : forall (A:Type) (l:pa_record A), pa_record_fields_t A (pa_record_tag A l). Redirect "tmp" Check pa_record_construct : forall (A:Type) (p: Numbers.BinNums.positive), pa_record_fields_t A p -> Datatypes.option (pa_record A). Redirect "tmp" Check pa_record_constructP : forall (A:Type) (l:pa_record A), pa_record_construct A (pa_record_tag A l) (pa_record_fields A l) = Datatypes.Some l. Redirect "tmp" Check pr_record_fields_t : Type -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check pr_record_fields : forall (A:Type) (l:pr_record A), pr_record_fields_t A (pr_record_tag A l). Redirect "tmp" Check pr_record_construct : forall (A:Type) (p: Numbers.BinNums.positive), pr_record_fields_t A p -> Datatypes.option (pr_record A). Redirect "tmp" Check pr_record_constructP : forall (A:Type) (l:pr_record A), pr_record_construct A (pr_record_tag A l) (pr_record_fields A l) = Datatypes.Some l. Redirect "tmp" Check sigma_bool_fields_t : Numbers.BinNums.positive -> Type. Redirect "tmp" Check sigma_bool_fields : forall (l:sigma_bool), sigma_bool_fields_t (sigma_bool_tag l). Redirect "tmp" Check sigma_bool_construct : forall (p: Numbers.BinNums.positive), sigma_bool_fields_t p -> Datatypes.option sigma_bool. Redirect "tmp" Check sigma_bool_constructP : forall (l:sigma_bool), sigma_bool_construct (sigma_bool_tag l) (sigma_bool_fields l) = Datatypes.Some l. Redirect "tmp" Check ord_fields_t : peano -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check ord_fields : forall (p:peano) (o:ord p), ord_fields_t p (ord_tag p o). Redirect "tmp" Check ord_construct : forall (n:peano) (p:Numbers.BinNums.positive), ord_fields_t n p -> Datatypes.option (ord n). Redirect "tmp" Check ord_constructP : forall (p:peano) (o:ord p), ord_construct p (ord_tag p o) (ord_fields p o) = Datatypes.Some o. Redirect "tmp" Check ord2_fields_t : peano -> Numbers.BinNums.positive -> Type. Redirect "tmp" Check ord2_fields : forall (p:peano) (o:ord2 p), ord2_fields_t p (ord2_tag p o). Redirect "tmp" Check ord2_construct : forall (n:peano) (p:Numbers.BinNums.positive), ord2_fields_t n p -> Datatypes.option (ord2 n). Redirect "tmp" Check ord2_constructP : forall (p:peano) (o:ord2 p), ord2_construct p (ord2_tag p o) (ord2_fields p o) = Datatypes.Some o. Redirect "tmp" Check val_fields_t : Numbers.BinNums.positive -> Type. Redirect "tmp" Check val_fields : forall i : val, val_fields_t (val_tag i). Redirect "tmp" Check val_construct : forall (p: Numbers.BinNums.positive), val_fields_t p -> Datatypes.option val. Redirect "tmp" Check val_constructP : forall (v:val), val_construct (val_tag v) (val_fields v) = Datatypes.Some v. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_idx2inv.v000066400000000000000000000004231523041753400226760ustar00rootroot00000000000000From elpi.apps Require Import derive.param1 derive.invert derive.induction derive.idx2inv. Elpi derive.param1 list. Elpi derive.invert is_list. Elpi derive.idx2inv is_list. Redirect "tmp" Check is_list_to_is_list_inv : forall A PA l, is_list A PA l -> is_list_inv A PA l.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_induction.v000066400000000000000000000114261523041753400233140ustar00rootroot00000000000000From elpi.apps Require Import derive.induction. From elpi.apps Require Import test_derive_corelib test_param1 test_param1_functor. Import test_derive_corelib.Coverage. Import derive.param1. (* for is_eq *) Import test_param1.Coverage. Import test_param1_functor.Coverage. Module Coverage. Elpi derive.induction empty. Elpi derive.induction unit. Elpi derive.induction peano. Elpi derive.induction option. Elpi derive.induction pair. Elpi derive.induction seq. Elpi derive.induction box_peano. Elpi derive.induction rose. Elpi derive.induction rose_p. Elpi derive.induction rose_o. Elpi derive.induction nest. Elpi derive.induction w. Elpi derive.induction vect. Elpi derive.induction dyn. Elpi derive.induction zeta. Elpi derive.induction beta. Elpi derive.induction iota. Elpi derive.induction large. Elpi derive.induction prim_int. Elpi derive.induction prim_float. Elpi derive.induction prim_string. Elpi derive.induction fo_record. Elpi derive.induction pa_record. Elpi derive.induction pr_record. Elpi derive.induction dep_record. Elpi derive.induction enum. Elpi derive.induction sigma_bool. Elpi derive.induction bool. Elpi derive.induction sigma_bool2. Elpi derive.induction ord. Elpi derive.induction ord2. Elpi derive.induction val. Elpi derive.induction mempty. Elpi derive.induction munit. Elpi derive.induction mpeano. Elpi derive.induction moption. Elpi derive.induction mtree. End Coverage. Import Coverage. Locate is_unit. Redirect "tmp" Check empty_induction : forall P : empty -> Prop, forall x, is_empty x -> P x. Redirect "tmp" Check unit_induction : forall P : unit -> Prop, P tt -> forall x, is_unit x -> P x. Redirect "tmp" Check peano_induction : forall P, P Zero -> (forall n, P n -> P (Succ n)) -> forall x, is_peano x -> P x. Redirect "tmp" Check option_induction : forall A PA P, (P (None A)) -> (forall a, PA a -> P (Some A a)) -> forall x, is_option A PA x -> P x. Redirect "tmp" Check pair_induction : forall A PA B PB P, (forall a, PA a -> forall b, PB b -> P (Comma A B a b)) -> forall x, is_pair A PA B PB x -> P x. Redirect "tmp" Check seq_induction : forall A PA P, P (Nil A) -> (forall x, PA x -> forall xs, P xs -> P (Cons A x xs)) -> forall l, is_seq A PA l -> P l. Redirect "tmp" Check rose_induction : forall A PA P, (forall x, PA x -> P (Leaf A x)) -> (forall l, is_seq (rose A) P l -> P (Node A l)) -> forall x, is_rose A PA x -> P x. Redirect "tmp" Check nest_induction : forall P : forall A : Type, (A -> Type) -> nest A -> Type, (forall A PA, P A PA (NilN A)) -> (forall A PA x, PA x -> forall xs, P (pair A A) (is_pair A PA A PA) xs -> P A PA (ConsN A x xs)) -> forall A PA n, is_nest A PA n -> P A PA n. Redirect "tmp" Check w_induction : forall A PA P, (forall f, (forall a, PA a -> P (f a)) -> P (via A f)) -> forall x, is_w A PA x -> P x. Redirect "tmp" Check vect_induction : forall A PA (P : forall n, is_peano n -> vect A n -> Type), P Zero is_Zero (VNil A) -> (forall a, PA a -> forall n, forall nR: is_peano n, forall v : vect A n, P n nR v -> P (Succ n) (is_Succ n nR) (VCons A a n v)) -> forall l lR x, is_vect A PA l lR x -> P l lR x. Redirect "tmp" Check dyn_induction : forall P, (forall T PT (t : T), PT t -> P (box T t)) -> forall x, is_dyn x -> P x. Redirect "tmp" Check zeta_induction : forall A PA P, (forall a, PA a -> forall c, PA c -> P (Envelope A a c)) -> forall x, is_zeta A PA x -> P x. Redirect "tmp" Check iota_induction. Redirect "tmp" Check large_induction. Redirect "tmp" Check prim_int_induction. Redirect "tmp" Check prim_float_induction. Redirect "tmp" Check fo_record_induction : forall P, (forall x, is_peano x -> forall y, is_unit y -> P (Build_fo_record x y)) -> forall x, is_fo_record x -> P x. Redirect "tmp" Check pa_record_induction : forall A PA P, (forall x, is_peano x -> forall y, PA y -> P (Build_pa_record A x y)) -> forall x, is_pa_record A PA x -> P x. Redirect "tmp" Check pr_record_induction : forall A pr P, (forall x, is_peano x -> forall y, pr y -> P (Build_pr_record A x y)) -> forall x, is_pr_record A pr x -> P x. Redirect "tmp" Check dep_record_induction : forall P, (forall x (px : is_peano x) y, is_vect unit is_unit x px y -> P (Build_dep_record x y)) -> forall x, is_dep_record x -> P x. Redirect "tmp" Check enum_induction : forall P, (P E1) -> (P E2) -> (P E3) -> forall x, is_enum x -> P x. Redirect "tmp" Check sigma_bool_induction. Redirect "tmp" Check sigma_bool2_induction. Redirect "tmp" Check ord_induction : forall p Pp P, (forall n Pn l, is_eq bool is_bool (is_leq n p) (is_is_leq n Pn p Pp) true is_true l -> P (mkOrd p n l)) -> forall (o : ord p), is_ord p Pp o -> P o. Redirect "tmp" Check ord2_induction : forall p Pp P, (forall (o1 : ord p), is_ord p Pp o1 -> forall (o2 : ord p), is_ord p Pp o2 -> P (mkOrd2 p o1 o2)) -> forall (o : ord2 p), is_ord2 p Pp o -> P o. Fail Redirect "tmp" Check mpeano'_induction. Fail Redirect "tmp" Check mforest_induction.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_invert.v000066400000000000000000000011531523041753400226230ustar00rootroot00000000000000From elpi.apps Require Import derive.invert. Inductive test A : bool -> Type := K1 : test true | K2 : forall x, A -> test (negb x) -> test (negb (negb x)). Elpi derive.invert test. Redirect "tmp" Check test_inv : Type -> bool -> Type. Redirect "tmp" Check K1_inv : forall A b, b = true -> test_inv A b. Redirect "tmp" Check K2_inv : forall A b, forall x, A -> test_inv A (negb x) -> b = negb (negb x) -> test_inv A b. Inductive listR A PA : list A -> Type := | nilR : listR (@nil A) | consR : forall a : A, PA a -> forall xs : list A, listR xs -> listR (cons a xs). Elpi derive.invert listR. Print listR_inv.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_isK.v000066400000000000000000000057321523041753400220510ustar00rootroot00000000000000From elpi.apps Require Import test_derive_corelib derive.isK. Import test_derive_corelib.Coverage. (* coverage *) Module Coverage. Elpi derive.isK empty. Elpi derive.isK unit. Elpi derive.isK peano. Elpi derive.isK option. Elpi derive.isK pair. Elpi derive.isK seq. Elpi derive.isK box_peano. Elpi derive.isK rose. Elpi derive.isK rose_p. Elpi derive.isK rose_o. Elpi derive.isK nest. Elpi derive.isK w. Elpi derive.isK vect. Elpi derive.isK dyn. Elpi derive.isK zeta. Elpi derive.isK beta. Elpi derive.isK iota. Elpi derive.isK large. Elpi derive.isK prim_int. Elpi derive.isK prim_float. Elpi derive.isK prim_string. Elpi derive.isK fo_record. Elpi derive.isK pa_record. Elpi derive.isK pr_record. Elpi derive.isK dep_record. Elpi derive.isK enum. Elpi derive.isK bool. Elpi derive.isK eq. Elpi derive.isK sigma_bool. Elpi derive.isK ord. Elpi derive.isK val. Elpi derive.isK mempty. Elpi derive.isK munit. Elpi derive.isK mpeano. Elpi derive.isK moption. Elpi derive.isK mtree. End Coverage. Import Coverage. Redirect "tmp" Check unit_is_tt : unit -> bool. Redirect "tmp" Check peano_is_Zero : peano -> bool. Redirect "tmp" Check peano_is_Succ : peano -> bool. Redirect "tmp" Check option_is_None : forall A, option A -> bool. Redirect "tmp" Check option_is_Some : forall A, option A -> bool. Redirect "tmp" Check pair_is_Comma : forall A B, pair A B -> bool. Redirect "tmp" Check seq_is_Nil : forall A, seq A -> bool. Redirect "tmp" Check seq_is_Cons : forall A, seq A -> bool. Redirect "tmp" Check rose_is_Leaf : forall A, rose A -> bool. Redirect "tmp" Check rose_is_Node : forall A, rose A -> bool. Redirect "tmp" Check nest_is_NilN : forall A, nest A -> bool. Redirect "tmp" Check nest_is_ConsN : forall A, nest A -> bool. Redirect "tmp" Check w_is_via : forall A, w A -> bool. Redirect "tmp" Check vect_is_VNil : forall A i, vect A i -> bool. Redirect "tmp" Check vect_is_VCons : forall A i, vect A i -> bool. Redirect "tmp" Check dyn_is_box : dyn -> bool. Redirect "tmp" Check zeta_is_Envelope : forall A, zeta A -> bool. Redirect "tmp" Check beta_is_Redex : forall A, beta A -> bool. Redirect "tmp" Check iota_is_Why : iota -> bool. Redirect "tmp" Check large_is_K1. Redirect "tmp" Check large_is_K2. Redirect "tmp" Check prim_int_is_PI. Redirect "tmp" Check prim_float_is_PF. Redirect "tmp" Check fo_record_is_Build_fo_record : fo_record -> bool. Redirect "tmp" Check pa_record_is_Build_pa_record : forall A, pa_record A -> bool. Redirect "tmp" Check pr_record_is_Build_pr_record : forall A, pr_record A -> bool. Redirect "tmp" Check enum_is_E1 : enum -> bool. Set Universe Polymorphism. Module UnivPoly. Inductive I := TT. Elpi derive.isK I. Inductive Wrap := K : I -> Wrap. Elpi derive.isK Wrap. Inductive Prod (A B : Type) := PR : A -> B -> Prod A B. Elpi derive.isK Prod. Inductive Sum (A B : Type) := InL : A -> Sum A B | InR : B -> Sum A B. Elpi derive.isK Sum. Inductive List (A : Type) := Nil | Cons : A -> List A -> List A. Elpi derive.isK List. End UnivPoly. Unset Universe Polymorphism.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_lens.v000066400000000000000000000026501523041753400222600ustar00rootroot00000000000000From elpi.apps Require Import test_derive_corelib derive.lens. Import test_derive_corelib.Coverage. (* coverage *) Module Coverage. Elpi derive.lens fo_record. Elpi derive.lens pa_record. Elpi derive.lens pr_record. Fail Elpi derive.lens dep_record. Fail Elpi derive.lens sigma_bool. End Coverage. Import Coverage. Redirect "tmp" Check _f1 : Lens fo_record fo_record peano peano. Redirect "tmp" Check _f2 : Lens fo_record fo_record unit unit. Redirect "tmp" Check @_f3 : forall A, Lens (pa_record A) (pa_record A) peano peano. Redirect "tmp" Check @_f4 : forall A, Lens (pa_record A) (pa_record A) A A. Redirect "tmp" Check @_pf3 : forall A, Lens (pr_record A) (pr_record A) peano peano. Redirect "tmp" Check @_pf4 : forall A, Lens (pr_record A) (pr_record A) A A. Goal forall A x, x = @_pf3 A. intros; unfold _pf3. match goal with | |- x = {| over := fun f r => {| pf3 := f (_ r); pf4 := _ r |} ; view := _ |} => idtac | |- _ => fail "not primitive" end. Abort. #[projections(primitive=yes)] Record R := MkR { proj : nat; }. Elpi derive.lens R "R__". Lemma failing r : r.(proj) = 0 -> view R__proj r = r.(proj). Proof. simpl. intros Hpr. rewrite Hpr. reflexivity. Abort. Lemma working r : match r with MkR r_proj => r_proj end = 0 -> view R__proj r = match r with MkR r_proj => r_proj end. Proof. simpl. intros Hpr. rewrite Hpr. Fail reflexivity. unfold proj. rewrite Hpr. reflexivity. Qed. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_lens_laws.v000066400000000000000000000035571523041753400233150ustar00rootroot00000000000000 From elpi.apps Require Import derive.lens_laws. From elpi.apps Require Import test_derive_corelib test_lens. Import test_derive_corelib.Coverage. Import test_lens.Coverage. (* coverage *) Module Coverage. Elpi derive.lens_laws fo_record. Elpi derive.lens_laws pa_record. Elpi derive.lens_laws pr_record. Elpi derive.lens_laws dep_record. Elpi derive.lens_laws sigma_bool. End Coverage. Import Coverage. Redirect "tmp" Check _f1_view_set : view_set _f1. Redirect "tmp" Check _f2_view_set : view_set _f2. Redirect "tmp" Check _f3_view_set : forall A, view_set (_f3 A). Redirect "tmp" Check _f4_view_set : forall A, view_set (_f4 A). Redirect "tmp" Check _pf3_view_set : forall A, view_set (_pf3 A). Redirect "tmp" Check _pf4_view_set : forall A, view_set (_pf4 A). Redirect "tmp" Check _f1_set_set : set_set _f1. Redirect "tmp" Check _f2_set_set : set_set _f2. Redirect "tmp" Check _f3_set_set : forall A, set_set (_f3 A). Redirect "tmp" Check _f4_set_set : forall A, set_set (_f4 A). Redirect "tmp" Check _pf3_set_set : forall A, set_set (_pf3 A). Redirect "tmp" Check _pf4_set_set : forall A, set_set (_pf4 A). Redirect "tmp" Check _f1_set_view : set_view _f1. Redirect "tmp" Check _f2_set_view : set_view _f2. Redirect "tmp" Check _f3_set_view : forall A, set_view (_f3 A). Redirect "tmp" Check _f4_set_view : forall A, set_view (_f4 A). Redirect "tmp" Check _pf3_set_view : forall A, set_view (_pf3 A). Redirect "tmp" Check _pf4_set_view : forall A, set_view (_pf4 A). Redirect "tmp" Check _f1_f2_exchange : exchange _f1 _f2. Redirect "tmp" Check _f2_f1_exchange : exchange _f2 _f1. Redirect "tmp" Check _f3_f4_exchange : forall A, exchange (_f3 A) (_f4 A). Redirect "tmp" Check _f4_f3_exchange : forall A, exchange (_f4 A) (_f3 A). Redirect "tmp" Check _pf3_pf4_exchange : forall A, exchange (_pf3 A) (_pf4 A). Redirect "tmp" Check _pf4_pf3_exchange : forall A, exchange (_pf4 A) (_pf3 A). LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_map.v000066400000000000000000000050041523041753400220700ustar00rootroot00000000000000From elpi.apps Require Import derive.map. From elpi.apps.derive.tests Require Import test_derive_corelib. Import test_derive_corelib.Coverage. Module Coverage. Elpi derive.map empty. Elpi derive.map unit. Elpi derive.map peano. Elpi derive.map option. Elpi derive.map pair. Elpi derive.map seq. Elpi derive.map box_peano. Elpi derive.map rose. Elpi derive.map rose_p. Elpi derive.map rose_o. Fail Elpi derive.map nest. Fail Elpi derive.map w. Elpi derive.map vect. Elpi derive.map dyn. Elpi derive.map zeta. Fail Elpi derive.map beta. Elpi derive.map iota. Elpi derive.map large. Elpi derive.map prim_int. Elpi derive.map prim_float. Elpi derive.map fo_record. Elpi derive.map pa_record. Elpi derive.map pr_record. Elpi derive.map dep_record. Elpi derive.map enum. Fail Elpi derive.map eq. Elpi derive.map bool. Elpi derive.map sigma_bool. Elpi derive.map sigma_bool2. Fail Elpi derive.map ord. Elpi derive.map val. Elpi derive.map mempty. Elpi derive.map munit. Elpi derive.map mpeano. Elpi derive.map moption. Elpi derive.map mtree. End Coverage. Import Coverage. Local Notation map T := (T -> T). Local Notation map1 T := (forall X Y, (X -> Y) -> T X%type -> T Y%type). Redirect "tmp" Check empty_map : map empty. Redirect "tmp" Check unit_map : map unit. Redirect "tmp" Check peano_map : map peano. Redirect "tmp" Check option_map : map1 option. Redirect "tmp" Check pair_map : forall A B (f : A -> B) C D (g : C -> D), (pair A C) -> (pair B D). Redirect "tmp" Check seq_map : map1 seq. Redirect "tmp" Check rose_map : map1 rose. Fail Check nest_map. Fail Check w_map. Redirect "tmp" Check vect_map : forall A B (f : A -> B) i, vect A i -> vect B i. Redirect "tmp" Check dyn_map : map dyn. Redirect "tmp" Check zeta_map : forall A B (f : A -> B), zeta A -> zeta B. Fail Check beta_map. Redirect "tmp" Check iota_map : map iota. Redirect "tmp" Check large_map : map large. Redirect "tmp" Check prim_int_map : map prim_int. Redirect "tmp" Check prim_float_map : map prim_float. Redirect "tmp" Check pa_record_map : map1 pa_record. Redirect "tmp" Check pr_record_map : map1 pr_record. Redirect "tmp" Check mempty_map : map mempty. Redirect "tmp" Check mempty'_map : map mempty'. Redirect "tmp" Check munit_map : map munit. Redirect "tmp" Check munit'_map : map munit'. Redirect "tmp" Check mpeano_map : map mpeano. Redirect "tmp" Check mpeano'_map : map mpeano'. Redirect "tmp" Check moption_map : map1 moption. Redirect "tmp" Check moption'_map : map1 moption'. Redirect "tmp" Check mtree_map : map1 mtree. Redirect "tmp" Check mforest_map : map1 mforest.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_param1.v000066400000000000000000000151671523041753400225070ustar00rootroot00000000000000From elpi.apps Require Import derive.param1. From elpi.apps.derive.tests Require Import test_derive_corelib. Import test_derive_corelib.Coverage. Module Coverage. Elpi derive.param1 empty. Elpi derive.param1 unit. Elpi derive.param1 peano. Elpi derive.param1 option. Elpi derive.param1 pair. Elpi derive.param1 seq. Elpi derive.param1 box_peano. Elpi derive.param1 rose. Elpi derive.param1 rose_p. Elpi derive.param1 rose_o. Elpi derive.param1 nest. Elpi derive.param1 w. Elpi derive.param1 vect. Elpi derive.param1 dyn. Elpi derive.param1 zeta. Elpi derive.param1 beta. Elpi derive.param1 iota. Elpi derive.param1 large. Elpi derive.param1 prim_int. Elpi derive.param1 prim_float. Elpi derive.param1 prim_string. Elpi derive.param1 fo_record. Elpi derive.param1 pa_record. Elpi derive.param1 pr_record. Elpi derive.param1 dep_record. Elpi derive.param1 enum. (* Elpi derive.param1 eq. (* done in param1.v *) Elpi derive.param1 bool. (* done in param1.v *) *) Elpi derive.param1 is_zero. Elpi derive.param1 sigma_bool. Elpi derive.param1 sigma_bool2. Elpi derive.param1 is_leq. Elpi derive.param1 ord. Elpi derive.param1 ord2. Elpi derive.param1 val. Elpi derive.param1 alias. Elpi derive.param1 mempty. Elpi derive.param1 munit. Elpi derive.param1 mpeano. Elpi derive.param1 moption. Elpi derive.param1 mtree. End Coverage. Import Coverage. Section Test. Local Notation pred X := (X -> Type). Redirect "tmp" Check is_empty : pred empty. Redirect "tmp" Check is_unit : pred unit. Redirect "tmp" Check is_peano : pred peano. Redirect "tmp" Check is_option : forall A, pred A -> pred (option A). Redirect "tmp" Check is_pair : forall A, pred A -> forall B, pred B -> pred (pair A B). Redirect "tmp" Check is_seq : forall A, pred A -> pred (seq A). Redirect "tmp" Check is_rose : forall A, pred A -> pred (rose A). Redirect "tmp" Check is_nest : forall A, pred A -> pred (nest A). Redirect "tmp" Check is_w : forall A, pred A -> pred (w A). Redirect "tmp" Check is_vect : forall A, pred A -> forall i, is_peano i -> pred (vect A i). Redirect "tmp" Check is_dyn : pred dyn. Redirect "tmp" Check is_zeta : forall A, pred A -> pred (zeta A). Redirect "tmp" Check is_beta : forall A, pred A -> pred (beta A). Redirect "tmp" Check is_iota : pred iota. Redirect "tmp" Check is_large : pred large. Redirect "tmp" Check is_prim_int : pred prim_int. Redirect "tmp" Check is_prim_float : pred prim_float. Redirect "tmp" Check is_fo_record : pred fo_record. Redirect "tmp" Check is_pa_record : forall A, pred A -> pred (pa_record A). Redirect "tmp" Check is_pr_record : forall A, pred A -> pred (pr_record A). Redirect "tmp" Check is_enum : pred enum. Redirect "tmp" Check is_ord : forall (p : peano) (pa : is_peano p), pred (ord p). Redirect "tmp" Check is_ord2 : forall (p : peano) (pa : is_peano p), pred (ord2 p). Redirect "tmp" Check is_val : pred val. Redirect "tmp" Check is_alias : pred alias. Redirect "tmp" Check is_mempty : pred mempty. Redirect "tmp" Check is_mempty' : pred mempty'. Redirect "tmp" Check is_munit : pred munit. Redirect "tmp" Check is_munit' : pred munit'. Redirect "tmp" Check is_moption : forall A, pred A -> pred (moption A). Redirect "tmp" Check is_moption' : forall A, pred A -> pred (moption' A). Redirect "tmp" Check is_mpeano : pred mpeano. Redirect "tmp" Check is_mpeano' : pred mpeano'. Redirect "tmp" Check is_mtree : forall A, pred A -> pred (mtree A). Redirect "tmp" Check is_mforest : forall A, pred A -> pred (mforest A). End Test. (* other tests by Cyril *) Set Uniform Inductive Parameters. Module OtherTests. Elpi derive.param1 unit. Elpi derive.param1 nat. Inductive fin : nat -> Type := FO : fin 0 | FS : forall n : nat, fin n -> fin (S n). Elpi derive.param1 fin. Fixpoint fin_length n (v : fin n) := match v with FO => 0 | FS _ w => S (fin_length _ w) end. Elpi derive.param1 fin_length. Inductive vec (A : Type) : nat -> Type := vnil : vec 0 | vcons : A -> forall n : nat, vec n -> vec (S n). Elpi derive.param1 vec. Fixpoint vec_length (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param1 vec_length. Elpi derive.param1 list. Elpi derive.param1 is_list. Fixpoint plus' m n := match n with 0 => m | S n => S (plus' m n) end. Elpi derive.param1 plus'. Elpi derive.param1 plus. Elpi derive.param1 prod. Elpi derive.param1 fst. Elpi derive.param1 snd. Elpi derive.param1 Nat.divmod. Elpi derive.param1 Nat.div. Definition test m n p q r := m + n + p + q + r. Elpi derive.param1 test. Definition vec_length_type := forall (A : Type) (n : nat), vec A n -> nat. Elpi derive.param1 vec_length_type. Definition vec_length_rec (vec_length : vec_length_type) (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param1 vec_length_rec. Redirect "tmp" Elpi Query derive.param1 lp:{{ reali {{O}} Y }}. Redirect "tmp" Elpi Query derive.param1 lp:{{ reali {{S (S 0)}} Y }}. Definition nat2nat := nat -> nat. Definition nat2nat2nat := nat -> nat -> nat. Elpi derive.param1 nat2nat. Elpi derive.param1 nat2nat2nat. Elpi derive.param1 pred. Redirect "tmp" Check (is_pred : is_nat2nat pred). Fixpoint predn n := match n with 0 => 0 | S n => S (predn n) end. Elpi derive.param1 predn. Redirect "tmp" Check (is_predn : is_nat2nat predn). Redirect "tmp" Check (is_add : is_nat2nat2nat plus). Fixpoint quasidn n m := S (match n with 0 => m | S n => S (quasidn n m) end). Elpi derive.param1 quasidn. Fixpoint weirdn n := match n with S (S n) => S (weirdn n) | _ => 0 end. Elpi derive.param1 weirdn. Inductive bla : nat -> Type := Bla : nat -> bla 0 | Blu n : bla n -> bla 1. Elpi derive.param1 bla. Redirect "tmp" Elpi Query derive.param1 lp:{{ coq.TC.db-for {coq.term->gref {{@reali_db}}} PDb }}. #[warning="-non-recursive"] Fixpoint silly (n : nat) := n. Elpi derive.param1 silly. (* issue #262 *) Definition foo (a : unit) : unit := let b := a in a. Elpi derive.param1 foo. (* issue #266 *) Elpi derive.param1 option. Definition upair : Set := unit * unit. Elpi derive.param1 upair. Definition uplist := list upair. Elpi derive.param1 uplist. Elpi Print derive.param1 "elpi.apps.derive.tests/derive.param1". #[warning="-non-recursive"] Fixpoint bar (pl : uplist) (id : unit) : option unit := None unit. Elpi derive.param1 bar. Fixpoint nat_eq (n m : nat) {struct n} : bool := match n, m with | O, O => true | S a, S b => nat_eq a b | _, _ => false end. Elpi derive.param1 nat_eq. Inductive Acc {A : Type} (R : A -> A -> Prop) | (x : A) : Prop := Acc_intro : (forall y : A, R y x -> Acc y) -> Acc x. Elpi derive.param1 Acc. Inductive a := ka with b := kb. Elpi derive.param1 a. Inductive c := kc : a -> kb = kb -> c. Elpi derive.param1 c. End OtherTests. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_param1_congr.v000066400000000000000000000075041523041753400236730ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_congr. From elpi.apps Require Import test_derive_corelib test_param1. Import test_derive_corelib.Coverage. Import test_param1.Coverage. Module Coverage. Elpi derive.param1.congr is_empty. Elpi derive.param1.congr is_unit. Elpi derive.param1.congr is_peano. Elpi derive.param1.congr is_option. Elpi derive.param1.congr is_pair. Elpi derive.param1.congr is_seq. Elpi derive.param1.congr is_box_peano. Elpi derive.param1.congr is_nest. Elpi derive.param1.congr is_rose. Elpi derive.param1.congr is_rose_p. Elpi derive.param1.congr is_rose_o. Elpi derive.param1.congr is_w. Elpi derive.param1.congr is_vect. Elpi derive.param1.congr is_dyn. Elpi derive.param1.congr is_zeta. Elpi derive.param1.congr is_beta. Elpi derive.param1.congr is_iota. (* Elpi derive.param1.congr is_large. (* slow *) *) Elpi derive.param1.congr is_prim_int. Elpi derive.param1.congr is_prim_float. Elpi derive.param1.congr is_prim_string. Elpi derive.param1.congr is_fo_record. Elpi derive.param1.congr is_pa_record. Elpi derive.param1.congr is_pr_record. Elpi derive.param1.congr is_dep_record. Elpi derive.param1.congr is_enum. Elpi derive.param1.congr is_bool. Elpi derive.param1.congr is_eq. Elpi derive.param1.congr is_sigma_bool. Elpi derive.param1.congr is_sigma_bool2. Elpi derive.param1.congr is_ord. Elpi derive.param1.congr is_val. Elpi derive.param1.congr is_mempty. Elpi derive.param1.congr is_munit. Elpi derive.param1.congr is_mpeano. Elpi derive.param1.congr is_moption. Elpi derive.param1.congr is_mtree. End Coverage. Import Coverage. Redirect "tmp" Check congr_is_tt : is_tt = is_tt. Redirect "tmp" Check congr_is_Zero : is_Zero = is_Zero. Redirect "tmp" Check congr_is_Succ : forall x p1 p2, p1 = p2 -> is_Succ x p1 = is_Succ x p2. Redirect "tmp" Check congr_is_None : forall A PA, is_None A PA = is_None A PA. Redirect "tmp" Check congr_is_Some : forall A PA x p1 p2, p1 = p2 -> is_Some A PA x p1 = is_Some A PA x p2. Redirect "tmp" Check congr_is_Comma : forall A PA B PB x p1 p2, p1 = p2 -> forall y q1 q2, q1 = q2 -> is_Comma A PA B PB x p1 y q1 = is_Comma A PA B PB x p2 y q2. Redirect "tmp" Check congr_is_Nil : forall A PA, is_Nil A PA = is_Nil A PA. Redirect "tmp" Check congr_is_Cons : forall A PA x p1 p2, p1 = p2 -> forall y q1 q2, q1 = q2 -> is_Cons A PA x p1 y q1 = is_Cons A PA x p2 y q2. Redirect "tmp" Check congr_is_Leaf : forall A PA x p1 p2, p1 = p2 -> is_Leaf A PA x p1 = is_Leaf A PA x p2. Redirect "tmp" Check congr_is_Node : forall A PA x p1 p2, p1 = p2 -> is_Node A PA x p1 = is_Node A PA x p2. Fail Check congr_is_NilN. Fail Check congr_is_ConsN. Redirect "tmp" Check congr_is_via : forall A PA x p1 p2, p1 = p2 -> is_via A PA x p1 = is_via A PA x p2. Redirect "tmp" Check congr_is_VNil : forall A PA, is_VNil A PA = is_VNil A PA. Fail Check congr_is_VCons. Fail Check congr_is_box. Redirect "tmp" Check congr_is_Envelope : forall A PA x p1 p2, p1 = p2 -> forall y q1 q2, q1 = q2 -> is_Envelope A PA x p1 y q1 = is_Envelope A PA x p2 y q2. Redirect "tmp" Check congr_is_Redex : forall A PA x p1 p2, p1 = p2 -> is_Redex A PA x p1 = is_Redex A PA x p2. Fail Check congr_is_Why. (* Check congr_is_K1 . *) Redirect "tmp" Check congr_is_PI. Redirect "tmp" Check congr_is_PF. Redirect "tmp" Check congr_is_Build_fo_record : forall n p1 p2, p1 = p2 -> forall b q1 q2, q1 = q2 -> is_Build_fo_record n p1 b q1= is_Build_fo_record n p2 b q2. Redirect "tmp" Check congr_is_Build_pa_record : forall A PA n p1 p2, p1 = p2 -> forall b q1 q2, q1 = q2 -> is_Build_pa_record A PA n p1 b q1= is_Build_pa_record A PA n p2 b q2. Redirect "tmp" Check congr_is_Build_pr_record : forall A pr n p1 p2, p1 = p2 -> forall b q1 q2, q1 = q2 -> is_Build_pr_record A pr n p1 b q1= is_Build_pr_record A pr n p2 b q2. Redirect "tmp" Check congr_is_E1 : is_E1 = is_E1. Fail Redirect "tmp" Check congr_is_mpeano'. Fail Redirect "tmp" Check congr_is_mforest.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_param1_functor.v000066400000000000000000000067101523041753400242410ustar00rootroot00000000000000From elpi.apps Require Import derive.param1 derive.param1_functor. From elpi.apps.derive.tests Require Import test_derive_corelib test_param1. Import test_derive_corelib.Coverage. Import test_param1.Coverage. Module Coverage. Elpi derive.param1.functor is_empty. Elpi derive.param1.functor is_unit. Elpi derive.param1.functor is_peano. Elpi derive.param1.functor is_option. Elpi derive.param1.functor is_pair. Elpi derive.param1.functor is_seq. Elpi derive.param1.functor is_box_peano. Elpi derive.param1.functor is_rose. Elpi derive.param1.functor is_rose_p. Elpi derive.param1.functor is_rose_o. Elpi derive.param1.functor is_nest. Fail Elpi derive.param1.functor is_w. Elpi derive.param1.functor is_vect. Elpi derive.param1.functor is_dyn. Elpi derive.param1.functor is_zeta. Elpi derive.param1.functor is_beta. Elpi derive.param1.functor is_iota. Elpi derive.param1.functor is_large. Elpi derive.param1.functor is_prim_int. Elpi derive.param1.functor is_prim_float. Elpi derive.param1.functor is_prim_string. Elpi derive.param1.functor is_fo_record. Elpi derive.param1.functor is_pa_record. Elpi derive.param1.functor is_pr_record. Elpi derive.param1.functor is_dep_record. Elpi derive.param1.functor is_enum. Fail Elpi derive.param1.functor derive.param1.exports.is_eq. Elpi derive.param1.functor derive.param1.exports.is_bool. Elpi derive.param1.functor is_sigma_bool. Elpi derive.param1.functor is_sigma_bool2. Elpi derive.param1.functor is_ord. Elpi derive.param1.functor is_ord2. Elpi derive.param1.functor is_val. Fail Elpi derive.param1.functor mempty. Fail Elpi derive.param1.functor munit. Fail Elpi derive.param1.functor mpeano. Fail Elpi derive.param1.functor moption. Fail Elpi derive.param1.functor mtree. End Coverage. Local Notation func isT := (forall x, isT x -> isT x). Local Notation func1 isT := (forall A P Q, (forall y : A, P y -> Q y) -> forall x, isT A P x -> isT A Q x). Local Notation func2 isT := (forall A P Q, (forall y : A, P y -> Q y) -> forall A1 P1 Q1, (forall y : A1, P1 y -> Q1 y) -> forall x, isT A P A1 P1 x -> isT A Q A1 Q1 x). Import Coverage. Redirect "tmp" Check is_empty_functor : func is_empty. Redirect "tmp" Check is_unit_functor : func is_unit. Redirect "tmp" Check is_peano_functor : func is_peano. Redirect "tmp" Check is_option_functor : func1 is_option. Redirect "tmp" Check is_pair_functor : func2 is_pair. Redirect "tmp" Check is_seq_functor : func1 is_seq. Redirect "tmp" Check is_rose_functor : func1 is_rose. Fail Check is_nest_functor : func1 is_nest. Fail Check is_w_functor. Redirect "tmp" Check is_vect_functor : forall A P Q, (forall y : A, P y -> Q y) -> forall i p (v : vect A i), is_vect A P i p v -> is_vect A Q i p v. Redirect "tmp" Check is_dyn_functor : func is_dyn. Redirect "tmp" Check is_zeta_functor : func1 is_zeta. Redirect "tmp" Check is_beta_functor : func1 is_beta. Redirect "tmp" Check is_iota_functor : func is_iota. Redirect "tmp" Check is_large_functor : func is_large. Redirect "tmp" Check is_prim_int_functor : func is_prim_int. Redirect "tmp" Check is_prim_float_functor : func is_prim_float. Redirect "tmp" Check is_fo_record_functor : func is_fo_record. Redirect "tmp" Check is_pa_record_functor : func1 is_pa_record. Redirect "tmp" Check is_pr_record_functor : func1 is_pr_record. Redirect "tmp" Check is_enum_functor : func is_enum. Redirect "tmp" Check is_ord_functor : forall n pn, func (is_ord n pn). Redirect "tmp" Check is_ord2_functor : forall n pn, func (is_ord2 n pn). Redirect "tmp" Check is_val_functor : func is_val. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_param1_trivial.v000066400000000000000000000133671523041753400242410ustar00rootroot00000000000000From elpi.apps Require Import derive.param1_trivial. From elpi.apps Require Import test_derive_corelib test_param1 test_param1_congr. Import derive.param1. (* for is_eq *) Import test_derive_corelib.Coverage. Import test_param1.Coverage. Import test_param1_congr.Coverage. Module Coverage. Elpi derive.param1.trivial is_empty. Elpi derive.param1.trivial is_unit. Elpi derive.param1.trivial is_peano. Elpi derive.param1.trivial is_option. Elpi derive.param1.trivial is_pair. Elpi derive.param1.trivial is_seq. Elpi derive.param1.trivial is_box_peano. Fail Elpi derive.param1.trivial is_nest. Elpi derive.param1.trivial is_rose. Elpi derive.param1.trivial is_rose_p. Elpi derive.param1.trivial is_rose_o. Fail Elpi derive.param1.trivial is_w. Fail Elpi derive.param1.trivial is_vect. Fail Elpi derive.param1.trivial is_dyn. Elpi derive.param1.trivial is_zeta. Elpi derive.param1.trivial is_beta. Fail Elpi derive.param1.trivial is_iota. Elpi derive.param1.trivial is_large. Elpi derive.param1.trivial is_prim_int. Elpi derive.param1.trivial is_prim_float. Elpi derive.param1.trivial is_prim_string. Elpi derive.param1.trivial is_fo_record. Elpi derive.param1.trivial is_pa_record. Elpi derive.param1.trivial is_pr_record. Fail Elpi derive.param1.trivial is_dep_record. Elpi derive.param1.trivial is_enum. (* Elpi derive.param1.trivial is_bool. done in param1_trivial.v *) (* Elpi derive.param1.trivial is_eq. (* ad-hoc *) *) Elpi derive.param1.trivial is_sigma_bool. Elpi derive.param1.trivial is_sigma_bool2. Elpi derive.param1.trivial is_ord. Elpi derive.param1.trivial is_ord2. Elpi derive.param1.trivial is_val. Elpi derive.param1.trivial is_alias. Elpi derive.param1.trivial is_mempty. Elpi derive.param1.trivial is_munit. Fail Elpi derive.param1.trivial is_mpeano. Fail Elpi derive.param1.trivial is_moption. Fail Elpi derive.param1.trivial is_mtree. End Coverage. Import Coverage. Export param1_trivial.exports. (* for is_bool, done in param1_trivial.v *) Redirect "tmp" Check is_empty_trivial : trivial empty is_empty. Redirect "tmp" Check is_unit_trivial : trivial unit is_unit. Redirect "tmp" Check is_peano_trivial : trivial peano is_peano. Redirect "tmp" Check is_option_trivial : forall A P, trivial A P -> trivial (option A) (is_option A P). Redirect "tmp" Check is_pair_trivial : forall A P, trivial A P -> forall B Q, trivial B Q -> trivial (pair A B) (is_pair A P B Q). Redirect "tmp" Check is_seq_trivial : forall A P, trivial A P -> trivial (seq A) (is_seq A P). Redirect "tmp" Check is_rose_trivial : forall A P, trivial A P -> trivial (rose A) (is_rose A P). Fail Check is_nest_trivial. Fail Check is_w_trivial : forall A P, trivial A P -> trivial (w A) (is_w A P). Fail Check is_vect_trivial : forall A P, trivial A P -> forall i pi, trivial (vect A i) (is_vect A P i pi). Fail Check is_dyn_trivial. Redirect "tmp" Check is_zeta_trivial : forall A P, trivial A P -> trivial (zeta A) (is_zeta A P). Redirect "tmp" Check is_beta_trivial : forall A P, trivial A P -> trivial (beta A) (is_beta A P). Fail Check is_iota_trivial. Redirect "tmp" Check is_large_trivial : trivial large is_large. Redirect "tmp" Check is_prim_int_trivial : trivial prim_int is_prim_int. Redirect "tmp" Check is_prim_float_trivial : trivial prim_float is_prim_float. Redirect "tmp" Check is_fo_record_trivial : trivial fo_record is_fo_record. Redirect "tmp" Check is_pa_record_trivial : forall A P, trivial A P -> trivial (pa_record A) (is_pa_record A P). Redirect "tmp" Check is_pr_record_trivial : forall A P, trivial A P -> trivial (pr_record A) (is_pr_record A P). Redirect "tmp" Check is_enum_trivial : trivial enum is_enum. Redirect "tmp" Check is_sigma_bool_trivial : trivial sigma_bool is_sigma_bool. Redirect "tmp" Check is_ord_trivial : forall p px, trivial (ord p) (is_ord p px). Redirect "tmp" Check is_ord2_trivial : forall p px, trivial (ord2 p) (is_ord2 p px). Redirect "tmp" Check is_val_trivial : trivial val is_val. Redirect "tmp" Check is_alias_trivial : trivial alias is_alias. Redirect "tmp" Check is_empty_inhab : full empty is_empty. Redirect "tmp" Check is_unit_inhab : full unit is_unit. Redirect "tmp" Check is_peano_inhab : full peano is_peano. Redirect "tmp" Check is_option_inhab : forall A P, full A P -> full (option A) (is_option A P). Redirect "tmp" Check is_pair_inhab : forall A P, full A P -> forall B Q, full B Q -> full (pair A B) (is_pair A P B Q). Redirect "tmp" Check is_seq_inhab : forall A P, full A P -> full (seq A) (is_seq A P). Redirect "tmp" Check is_rose_inhab : forall A P, full A P -> full (rose A) (is_rose A P). Fail Check is_nest_inhab. Fail Check is_w_inhab : forall A P, full A P -> full (w A) (is_w A P). Fail Check is_vect_inhab : forall A P, full A P -> forall i pi, full (vect A i) (is_vect A P i pi). Fail Check is_dyn_inhab. Redirect "tmp" Check is_zeta_inhab : forall A P, full A P -> full (zeta A) (is_zeta A P). Redirect "tmp" Check is_beta_inhab : forall A P, full A P -> full (beta A) (is_beta A P). Fail Check is_iota_inhab. Redirect "tmp" Check is_large_inhab : full large is_large. Redirect "tmp" Check is_prim_int_inhab : full prim_int is_prim_int. Redirect "tmp" Check is_prim_float_inhab : full prim_float is_prim_float. Redirect "tmp" Check is_fo_record_inhab : full fo_record is_fo_record. Redirect "tmp" Check is_pa_record_inhab : forall A P, full A P -> full (pa_record A) (is_pa_record A P). Redirect "tmp" Check is_pr_record_inhab : forall A P, full A P -> full (pr_record A) (is_pr_record A P). Redirect "tmp" Check is_enum_inhab : full enum is_enum. Redirect "tmp" Check is_sigma_bool_inhab : full sigma_bool is_sigma_bool. Redirect "tmp" Check is_ord_inhab : forall p px, full (ord p) (is_ord p px). Redirect "tmp" Check is_ord2_inhab : forall p px, full (ord2 p) (is_ord2 p px). Redirect "tmp" Check is_val_inhab : full val is_val. Redirect "tmp" Check is_alias_inhab : full alias is_alias. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_param2.v000066400000000000000000000100511523041753400224730ustar00rootroot00000000000000From elpi.apps Require Import derive.param2. Set Uniform Inductive Parameters. Elpi derive.param2 unit. Elpi derive.param2 unit. Elpi derive.param2 nat. Elpi derive.param2 list. (* The Parametricty plugin of K & L asks for an interactive proof here (the proof to be produced is the match over n in the nil branch) *) Definition nth T (x0 : T) := fix rec (n : nat) (l : list T) {struct n} : T := match l, n with | nil, _ => x0 | cons x _, 0 => x | cons _ xs, S m => rec m xs end. Elpi derive.param2 nth. Print nth_R. Inductive fin : nat -> Type := FO : fin 0 | FS : forall n : nat, fin n -> fin (S n). Elpi derive.param2 fin. Fixpoint fin_length n (v : fin n) := match v with FO => 0 | FS _ w => S (fin_length _ w) end. Elpi derive.param2 fin_length. Inductive vec (A : Type) : nat -> Type := vnil : vec 0 | vcons : A -> forall n : nat, vec n -> vec (S n). Elpi derive.param2 vec. Fixpoint vec_length (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param2 vec_length. Elpi derive.param2 eq. Elpi derive.param2 list_R. Fixpoint plus' m n := match n with 0 => m | S n => S (plus' m n) end. Elpi derive.param2 plus'. Elpi derive.param2 plus. Elpi derive.param2 prod. Elpi derive.param2 fst. Elpi derive.param2 snd. Elpi derive.param2 Nat.divmod. Elpi derive.param2 Nat.div. Definition test m n p q r := m + n + p + q + r. Elpi derive.param2 test. Definition vec_length_type := forall (A : Type) (n : nat), vec A n -> nat. Elpi derive.param2 vec_length_type. Definition vec_length_rec (vec_length : vec_length_type) (A : Type) n (v : vec A n) := match v with vnil _ => 0 | vcons _ _ _ w => S (vec_length _ _ w) end. Elpi derive.param2 vec_length_rec. Definition nat2nat := nat -> nat. Definition nat2nat2nat := nat -> nat -> nat. Elpi derive.param2 nat2nat. Elpi derive.param2 nat2nat2nat. Elpi derive.param2 pred. Print pred_R. Redirect "tmp" Check (pred_R : nat2nat_R pred pred). Fixpoint predn n := match n with 0 => 0 | S n => S (predn n) end. Elpi derive.param2 predn. Redirect "tmp" Check (predn_R : nat2nat_R predn predn). Redirect "tmp" Check (add_R : nat2nat2nat_R plus plus). Fixpoint quasidn n m := S (match n with 0 => m | S n => S (quasidn n m) end). Elpi derive.param2 quasidn. Fixpoint weirdn n := match n with S (S n) => S (weirdn n) | _ => 0 end. Elpi derive.param2 weirdn. Inductive bla : nat -> Type := Bla : nat -> bla 0 | Blu n : bla n -> bla 1. Elpi derive.param2 bla. Fixpoint silly (n : nat) := n. Elpi derive.param2 silly. Definition size_of (A : Type) := A -> nat. Definition size_seq (A : Type) : size_of (list A) := fun _ => 0. Elpi derive.param2 size_of. Elpi derive.param2 size_seq. (* Fixed by https://github.com/LPCIC/coq-elpi/pull/754 *) Definition fa := 0. Definition fb := fa. Fail Elpi derive.param2 fb. Definition fa_R := O_R. Elpi derive.param2.register fa fa_R. Elpi derive.param2 fb. Inductive Acc {A : Type} (R : A -> A -> Prop) | (x : A) : Prop := Acc_intro : (forall y : A, R y x -> Acc y) -> Acc x. Elpi derive.param2 Acc. Definition fi T := fix g (s : list T) := tt. Elpi derive.param2 fi. Set Universe Polymorphism. Inductive Nat := | O' | S' (n : Nat). Elpi derive.param2 Nat. Definition Wrap := nat. Definition WrapR := nat_R. Elpi derive.param2.register "Wrap" "WrapR". Definition Wrap2Wrap := Wrap -> Wrap. Elpi derive.param2 Wrap2Wrap. Unset Universe Polymorphism. Inductive RenamedParam (n : nat) := renamedParam (_ : unit). Arguments renamedParam m t : rename. Elpi derive.param2 RenamedParam. Fail Elpi derive.param2 mempty. Fail Elpi derive.param2 munit. Fail Elpi derive.param2 mpeano. Fail Elpi derive.param2 moption. Fail Elpi derive.param2 mtree. Record Box (A : Type) := mkBox { unbox : A }. Elpi derive.param2 Box. Elpi derive.param2 unbox. Definition box := mkBox. Elpi derive.param2 box. Set Primitive Projections. Record BoxP (A : Type) := mkBoxP { unboxP : A }. Elpi derive.param2 BoxP. Fail Elpi derive.param2 unboxP. Definition boxP := mkBoxP. Elpi derive.param2 boxP. Unset Primitive Projections. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_projK.v000066400000000000000000000077551523041753400224170ustar00rootroot00000000000000From elpi.apps Require Import derive.projK. From elpi.apps.derive.tests Require Import test_derive_corelib. Import test_derive_corelib.Coverage. Module Coverage. Elpi derive.projK empty. Elpi derive.projK unit. Elpi derive.projK peano. Elpi derive.projK option. Elpi derive.projK pair. Elpi derive.projK seq. Elpi derive.projK box_peano. Elpi derive.projK rose. Elpi derive.projK rose_p. Elpi derive.projK rose_o. Elpi derive.projK nest. Elpi derive.projK w. Elpi derive.projK vect. Elpi derive.projK dyn. Elpi derive.projK zeta. Elpi derive.projK beta. Elpi derive.projK iota. Elpi derive.projK large. Elpi derive.projK prim_int. Elpi derive.projK prim_float. Elpi derive.projK prim_string. Elpi derive.projK fo_record. Elpi derive.projK pa_record. Elpi derive.projK pr_record. Elpi derive.projK dep_record. Elpi derive.projK enum. Elpi derive.projK eq. Elpi derive.projK bool. Elpi derive.projK sigma_bool. Elpi derive.projK ord. Elpi derive.projK val. Elpi derive.projK mempty. Elpi derive.projK munit. Elpi derive.projK mpeano. Elpi derive.projK moption. Elpi derive.projK mtree. End Coverage. Import Coverage. Redirect "tmp" Check projSucc1 : peano -> peano -> peano. Redirect "tmp" Check projSome1 : forall A, A -> option A -> A. Redirect "tmp" Check projComma1 : forall A B, A -> B -> pair A B -> A. Redirect "tmp" Check projComma2 : forall A B, A -> B -> pair A B -> B. Redirect "tmp" Check projCons1 : forall A, A -> seq A -> seq A -> A. Redirect "tmp" Check projCons2 : forall A, A -> seq A -> seq A -> seq A. Redirect "tmp" Check projLeaf1 : forall A, A -> rose A -> A. Redirect "tmp" Check projNode1 : forall A, seq (rose A) -> rose A -> seq (rose A). Redirect "tmp" Check projConsN1 : forall A, A -> nest (pair A A) -> nest A -> A. Redirect "tmp" Check projConsN2 : forall A, A -> nest (pair A A) -> nest A -> nest (pair A A). Redirect "tmp" Check projvia1 : forall A, (A -> w A) -> w A -> (A -> w A). Redirect "tmp" Check projVCons1 : forall A i, A -> forall j, vect A j -> vect A i -> A. Redirect "tmp" Check projVCons2 : forall A i, A -> forall j, vect A j -> vect A i -> peano. Redirect "tmp" Check projVCons3 : forall A i, A -> forall j, vect A j -> vect A i -> { w & vect A w }. Redirect "tmp" Check projbox1 : forall T, T -> dyn -> Type. Redirect "tmp" Check projbox2 : forall T, T -> dyn -> { T : Type & T }. Redirect "tmp" Check projEnvelope1 : forall A, A -> A -> zeta A -> A. Redirect "tmp" Check eq_refl 0 : projEnvelope1 nat 1 1 (Envelope nat 0 1) = 0. Redirect "tmp" Check projEnvelope2 : forall A, A -> A -> zeta A -> A. Redirect "tmp" Check eq_refl 0 : projEnvelope2 nat 1 1 (Envelope nat 1 0) = 0. Redirect "tmp" Check projRedex1 : forall A, A -> beta A -> A. Redirect "tmp" Check projWhy1 : forall n : peano, match n return Type with | Zero => peano | Succ _ => unit end -> iota -> peano. Redirect "tmp" Check projWhy2 : forall n : peano, match n return Type with | Zero => peano | Succ _ => unit end -> iota -> { i : peano & match i with Zero => peano | Succ _ => unit end }. Redirect "tmp" Check projPI1. Redirect "tmp" Check projPF1. Redirect "tmp" Check projBuild_fo_record1 : peano -> unit -> fo_record -> peano. Redirect "tmp" Check projBuild_fo_record2 : peano -> unit -> fo_record -> unit. Redirect "tmp" Check projBuild_pa_record2 : forall A, peano -> A -> pa_record A -> A. Redirect "tmp" Check projBuild_pr_record2 : forall A, peano -> A -> pr_record A -> A. Fail Redirect "tmp" Check projmpeano'1. Fail Redirect "tmp" Check projmoption'1. Fail Redirect "tmp" Check projmtree'1. Set Universe Polymorphism. Unset Universe Minimization ToSet. Module UnivPoly. Inductive Wrap := K : bool -> Wrap. Elpi derive.projK Wrap. Redirect "tmp" Compute (eq_refl (projK1 false (K true))) : true = true. Inductive List (A : Type) := Nil | Cons : A -> List A -> List A. Elpi derive.projK List. Inductive Prod (A B : Type) := c : A -> B -> Prod A B. Elpi derive.projK Prod. End UnivPoly. Unset Universe Polymorphism. LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_projK_isK.v000066400000000000000000000005701523041753400232110ustar00rootroot00000000000000From elpi.apps Require Import derive.isK derive.projK. Set Universe Polymorphism. Module ProjK_IsK. Inductive Sum (A B : Type) := InL : A -> Sum A B | InR : B -> Sum A B. Elpi derive Sum. Redirect "tmp" Check Sum_isk_InL. Redirect "tmp" Check Sum_isk_InR. Redirect "tmp" Check Sum_getk_InL1. Redirect "tmp" Check Sum_getk_InR1. End ProjK_IsK. Unset Universe Polymorphism.LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_readme.v000066400000000000000000000047321523041753400225570ustar00rootroot00000000000000From elpi.apps Require Import derive.std. Module example1. derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano *) Eval compute in peano_eqb Zero (Succ Zero). (* = false : bool *) Check peano_eqb_OK. (* peano_eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (eqb x1 x2) *) End example1. Module example2. #[module] derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Notation peano := peano.peano *) Print peano.peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano *) Eval compute in peano.eqb Zero (Succ Zero). (* = false : bool *) Check peano.eqb_OK. (* peano.eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (eqb x1 x2) *) End example2. Module example3. #[module="Peano"] derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Notation peano := Peano.peano *) Print Peano.peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano *) Eval compute in Peano.eqb Zero (Succ Zero). (* = false : bool *) Check Peano.eqb_OK. (* Peano.eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (eqb x1 x2) *) End example3. Module example4. #[module="Peano",prefix="Peano_"] derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Notation Peano := Peano.peano *) Print Peano.peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano *) Print Module Peano. Eval compute in Peano.Peano_eqb Zero (Succ Zero). (* = false : bool *) Check Peano.Peano_eqb_OK. (* Peano.Peano_eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (eqb x1 x2) *) End example4. Module example5. #[prefix=""] derive Inductive peano := Zero | Succ (p : peano). Print peano. (* Inductive peano : Set := Zero : peano | Succ : peano -> peano *) Eval compute in eqb Zero (Succ Zero). (* = false : bool *) Check eqb_OK. (* eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (eqb x1 x2) *) End example5. Module example6. #[module=Peano,no_alias] derive Inductive peano := Zero | Succ (p : peano). Fail Print peano. Print Peano.peano. (* Inductive peano : Set := Peano.Zero : peano | Peano.Succ : peano -> peano *) Eval compute in Peano.eqb Peano.Zero (Peano.Succ Peano.Zero). (* = false : bool *) Check Peano.eqb_OK. (* Peano.eqb_OK : forall x1 x2 : peano, reflect (x1 = x2) (eqb x1 x2) *) End example6. Fail #[no_alias] derive Inductive peano := Zero | Succ (p : peano). LPCIC-coq-elpi-eb449d7/apps/derive/tests/test_tag.v000066400000000000000000000044401523041753400220710ustar00rootroot00000000000000From elpi.apps Require Import derive.tag. From elpi.apps.derive.tests Require Import test_derive_corelib. Import test_derive_corelib.Coverage. Module Coverage. Elpi derive.tag empty. Elpi derive.tag unit. Elpi derive.tag peano. Elpi derive.tag option. Elpi derive.tag pair. Elpi derive.tag seq. Elpi derive.tag box_peano. Elpi derive.tag rose. Elpi derive.tag rose_p. Elpi derive.tag rose_o. Elpi derive.tag nest. Elpi derive.tag w. Elpi derive.tag vect. Elpi derive.tag dyn. Fail Elpi derive.tag zeta. Elpi derive.tag beta. Elpi derive.tag iota. Elpi derive.tag large. Elpi derive.tag prim_int. Elpi derive.tag prim_float. Elpi derive.tag prim_string. Elpi derive.tag fo_record. Elpi derive.tag pa_record. Elpi derive.tag pr_record. Elpi derive.tag dep_record. Elpi derive.tag enum. Elpi derive.tag eq. Elpi derive.tag bool. Elpi derive.tag sigma_bool. Elpi derive.tag sigma_bool2. Elpi derive.tag ord. Elpi derive.tag ord2. Elpi derive.tag val. Elpi derive.tag mempty. Elpi derive.tag munit. Elpi derive.tag mpeano. Elpi derive.tag moption. Elpi derive.tag mtree. End Coverage. Import Coverage. From Corelib Require Import PosDef. Local Notation tag X := (X -> positive). Redirect "tmp" Check empty_tag : tag empty. Redirect "tmp" Check unit_tag : tag unit. Redirect "tmp" Check peano_tag : tag peano. Redirect "tmp" Check option_tag : forall A, tag (option A). Redirect "tmp" Check pair_tag : forall A B, tag (pair A B). Redirect "tmp" Check seq_tag : forall A, tag (seq A). Redirect "tmp" Check rose_tag : forall A, tag (rose A). Redirect "tmp" Check nest_tag : forall A, tag (nest A). Redirect "tmp" Check w_tag : forall A, tag (w A). Redirect "tmp" Check vect_tag : forall A i, tag (vect A i). Redirect "tmp" Check dyn_tag : tag dyn. Fail Check zeta_tag : forall A, tag (zeta A). Redirect "tmp" Check beta_tag : forall A, tag (beta A). Redirect "tmp" Check iota_tag : tag iota. Redirect "tmp" Check large_tag : tag large. Redirect "tmp" Check prim_int_tag : tag prim_int. Redirect "tmp" Check prim_float_tag : tag prim_float. Redirect "tmp" Check pa_record_tag : forall A, tag (pa_record A). Redirect "tmp" Check pr_record_tag : forall A, tag (pr_record A). Redirect "tmp" Check ord_tag : forall p : peano, tag (ord p). Redirect "tmp" Check ord2_tag : forall p : peano, tag (ord2 p). Redirect "tmp" Check val_tag : tag val. LPCIC-coq-elpi-eb449d7/apps/derive/theories/000077500000000000000000000000001523041753400205465ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive.v000066400000000000000000000067531523041753400222260ustar00rootroot00000000000000(* Generates a module containing all the derived constants. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) (* since non-uniform inductive parameters are rarely used and the inference code from the kernel is not easily accessible, we require the user to be explicit about them, eg Inductive foo U1 U2 | NU1 NU2 := ... *) #[export] Set Uniform Inductive Parameters. (** The derive command The derive command can be invoked in two ways. - [derive ] - [derive Inductive ] [derive Record ] The first command runs all the derivations on an alerady declared inductive type named [] and all generated constants are named after the prefix [] (by default the inductive type name followed by [_]). Example: << derive nat. (* default prefix nat_ *) derive nat my_nat_stuff_. >> The second command takes as argument an inductive type declaration, it creates a module named after the inductive type and puts inside id both the inductive types and the output of the derivations. Example: << derive Inductive tickle A := stop | more : A -> tickle-> tickle. >> is equivalent to << Module tickle. Inductive tickle A := stop | more : A -> tickle-> tickle. derive tickle "". End tickle. Notation tickle := tickle.tickle. Notation stop := tickle.stop. Notation more := tickle.more. >> Both commands honor the [#[verbose]] attribute. If set they print all the derivations that are run, and if they fail or succeed. A derivation d can be skipped by using the [#[skip(d)]] attribute. A derivation different from d can be skipped [#[only(d)]] attribute. *) From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi.apps.derive.elpi Extra Dependency "derive.elpi" as derive. From elpi.apps.derive.elpi Extra Dependency "derive_synterp.elpi" as derive_synterp. From elpi Require Import elpi. Elpi Command derive. #[phase="both"] Elpi Accumulate lp:{{ % runs P in a context where Coq #[attributes] are parsed pred with-attributes i:prop. with-attributes P :- attributes A, coq.parse-attributes A [ att "verbose" bool, att "only" attmap, att "recursive" bool, att "prefix" string, att "module" string, att "no_alias" bool, ] Opts, !, Opts => P. pred get_name i:indt-decl, o:string. get_name (parameter _ _ _ F) N :- pi p\ get_name (F p) N. get_name (inductive N _ _ _) N. get_name (minductive N _ _ _) N. get_name (record N _ _ _) N. }}. #[synterp] Elpi Accumulate File derive_synterp_hook. #[synterp] Elpi Accumulate File derive_synterp. #[synterp] Elpi Accumulate lp:{{ main [str TypeName] :- !, with-attributes (derive.main TypeName). main [indt-decl D] :- !, get_name D TypeName, with-attributes (derive.main TypeName). main _. }}. Elpi Accumulate File derive_hook. Elpi Accumulate File derive. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, with-attributes (derive.main GR _). main [indt-decl D] :- !, get_name D TypeName, with-attributes (derive.decl+main TypeName D). main _ :- usage. usage :- coq.error "Usage: derive \n\tderive Inductive name Params : Arity := Constructors.". }}. Elpi Export derive. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/000077500000000000000000000000001523041753400220245ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/EqdepFacts.v000066400000000000000000000120311523041753400242270ustar00rootroot00000000000000(* Borrowed from Stdlib.Logic.EqdepFacts *) Section Dependent_Equality. Variables (U : Type) (P : U -> Type). (** Dependent equality *) Inductive eq_dep (p : U) (x : P p) : forall q : U, P q -> Prop := eq_dep_intro : eq_dep p x p x. #[local] Hint Constructors eq_dep: core. Lemma eq_dep_sym (p q : U) (x : P p) (y : P q) : eq_dep p x q y -> eq_dep q y p x. Proof. destruct 1; auto. Qed. Scheme eq_indd := Induction for eq Sort Prop. Inductive eq_dep1 (p : U) (x : P p) (q : U) (y : P q) : Prop := eq_dep1_intro : forall h : q = p, x = eq_rect _ _ y _ h -> eq_dep1 p x q y. Lemma eq_dep_dep1 (p q : U) (x : P p) (y : P q) : eq_dep p x q y -> eq_dep1 p x q y. Proof. revert q x y; destruct 1. apply eq_dep1_intro with (eq_refl p). simpl; trivial. Qed. End Dependent_Equality. Arguments eq_dep [U P] p x q _. Arguments eq_dep1 [U P] p x q y. Section Equivalences. Variable U : Type. Definition Eq_rect_eq_on (p : U) (Q : U -> Type) (x : Q p) := forall (h : p = p), x = eq_rect p Q x p h. Definition Eq_rect_eq := forall p Q x, Eq_rect_eq_on p Q x. Definition Eq_dep_eq_on (P : U -> Type) (p : U) (x : P p) := forall (y : P p), eq_dep p x p y -> x = y. Definition Eq_dep_eq := forall P p x, Eq_dep_eq_on P p x. Definition UIP_on_ (x y : U) (p1 : x = y) := forall (p2 : x = y), p1 = p2. Definition UIP_ := forall x y p1, UIP_on_ x y p1. Definition Streicher_K_on_ (x : U) (P : x = x -> Prop) := P (eq_refl x) -> forall p : x = x, P p. Definition Streicher_K_ := forall x P, Streicher_K_on_ x P. Lemma eq_rect_eq_on__eq_dep1_eq_on (p : U) (P : U -> Type) (y : P p) : Eq_rect_eq_on p P y -> forall (x : P p), eq_dep1 p x p y -> x = y. Proof. intro eq_rect_eq. simple destruct 1; intro. rewrite <- eq_rect_eq; auto. Qed. Lemma eq_rect_eq__eq_dep1_eq : Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y. Proof. exact (fun eq_rect_eq P p y x => @eq_rect_eq_on__eq_dep1_eq_on p P x (eq_rect_eq p P x) y). Qed. Lemma eq_rect_eq_on__eq_dep_eq_on (p : U) (P : U -> Type) (x : P p) : Eq_rect_eq_on p P x -> Eq_dep_eq_on P p x. Proof. intros eq_rect_eq; red; intros y H. symmetry; apply (eq_rect_eq_on__eq_dep1_eq_on _ _ _ eq_rect_eq). apply eq_dep_sym in H; apply eq_dep_dep1; trivial. Qed. Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq. Proof. exact (fun eq_rect_eq P p x y => @eq_rect_eq_on__eq_dep_eq_on p P x (eq_rect_eq p P x) y). Qed. Lemma eq_dep_eq_on__UIP_on (x y : U) (p1 : x = y) : Eq_dep_eq_on (fun y => x = y) x eq_refl -> UIP_on_ x y p1. Proof. intro eq_dep_eq; red. elim p1 using eq_indd. intros p2; apply eq_dep_eq. elim p2 using eq_indd. apply eq_dep_intro. Qed. Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_. Proof. exact (fun eq_dep_eq x y p1 => @eq_dep_eq_on__UIP_on x y p1 (eq_dep_eq _ _ _)). Qed. Lemma Streicher_K_on__eq_rect_eq_on (p : U) (P : U -> Type) (x : P p) : Streicher_K_on_ p (fun h => x = eq_rect _ P x _ h) -> Eq_rect_eq_on p P x. Proof. intro Streicher_K; red; intros. apply Streicher_K. reflexivity. Qed. Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq. Proof. exact (fun Streicher_K p P x => @Streicher_K_on__eq_rect_eq_on p P x (Streicher_K p _)). Qed. End Equivalences. Arguments eq_dep U P p x q _ : clear implicits. Set Implicit Arguments. Section EqdepDec. Variable A : Type. Let comp (x y y' : A) (eq1 : x = y) (eq2 : x = y') : y = y' := eq_ind _ (fun a => a = y') eq2 _ eq1. Remark trans_sym_eq (x y : A) (u : x = y) : comp u u = eq_refl y. Proof. now case u. Qed. Variables (x : A) (eq_dec : forall y : A, x = y \/ x <> y). Let nu (y : A) (u : x = y) : x = y := match eq_dec y with | or_introl eqxy => eqxy | or_intror neqxy => False_ind _ (neqxy u) end. #[local] Lemma nu_constant (y:A) (u v:x = y) : nu u = nu v. Proof. unfold nu; destruct (eq_dec y) as [Heq|Hneq]; [reflexivity|]. now case Hneq. Qed. Let nu_inv (y : A) (v : x = y) : x = y := comp (nu (eq_refl x)) v. Remark nu_left_inv_on (y : A) (u : x = y) : nu_inv (nu u) = u. Proof. case u; unfold nu_inv; apply trans_sym_eq. Qed. Theorem eq_proofs_unicity_on (y : A) (p1 p2 : x = y) : p1 = p2. Proof. elim (nu_left_inv_on p1). elim (nu_left_inv_on p2). now elim nu_constant with y p1 p2. Qed. Theorem K_dec_on (P : x = x -> Prop) (H : P (eq_refl x)) (p : x = x) : P p. Proof. now elim eq_proofs_unicity_on with x (eq_refl x) p. Qed. End EqdepDec. Theorem K_dec A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A) : forall P : x = x -> Prop, P (eq_refl x) -> forall p : x = x, P p. Proof. exact (@K_dec_on A x (eq_dec x)). Qed. Section Eq_dec. Variables (A : Type) (eq_dec : forall x y : A, {x = y} + {x <> y}). Theorem K_dec_type (x : A) (P : x = x -> Prop) (H : P (eq_refl x)) (p : x = x) : P p. Proof. elim p using K_dec; [|now trivial]. now intros x0 y; case (eq_dec x0 y); [left|right]. Qed. Theorem eq_rect_eq_dec : forall (p : A) (Q : A -> Type) (x : Q p) (h : p = p), x = eq_rect p Q x p h. Proof. exact (Streicher_K__eq_rect_eq A K_dec_type). Qed. Theorem eq_dep_eq_dec : forall (P : A->Type) (p : A) (x y : P p), eq_dep A P p x p y -> x = y. Proof. exact (eq_rect_eq__eq_dep_eq A eq_rect_eq_dec). Qed. End Eq_dec. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/PrimStringEqb.v000066400000000000000000000024601523041753400247430ustar00rootroot00000000000000From Corelib Require Import ssreflect ssrbool. From Corelib Require Export PrimString Uint63Axioms PrimStringAxioms. Register PrimString.string as elpi.pstring. Definition eqb (s1 s2 : PrimString.string) := match PrimString.compare s1 s2 with Eq => true | _ => false end. Register eqb as elpi.pstring_eqb. Lemma compare_Eq_refl (s : string) : compare s s = Eq. Proof. rewrite PrimStringAxioms.compare_spec. elim: (to_list s) => //= x xs ->. rewrite Uint63Axioms.compare_def_spec /compare_def eqb_refl. suff: ltb x x = false by move->. have [+ _] := ltb_spec x x. by case: ltb => // /(_ isT); case: (to_Z x) => //=; elim. Qed. Lemma compare_Eq_correct (s1 s2 : string) : compare s1 s2 = Eq -> s1 = s2. Proof. move=> E; rewrite -[s1]of_to_list -[s2]of_to_list; congr (of_list _). move: E; rewrite compare_spec. elim: (to_list s1) (to_list s2) => [[]//|x xs IH [|y ys] //=]. rewrite Uint63Axioms.compare_def_spec /compare_def. move: (eqb_correct x y); case: PrimInt63.eqb => [/(_ isT)->|_]. suff: ltb y y = false by move=> -> /IH ->. have [+ _] := ltb_spec y y. by case: ltb => // /(_ isT); case: (to_Z y) => //=; elim. by case: ltb. Qed. Lemma compare_ok (s1 s2 : string) : compare s1 s2 = Eq <-> s1 = s2. Proof. split; [apply compare_Eq_correct|intros []; apply compare_Eq_refl]. Qed. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/bcongr.v000066400000000000000000000040231523041753400234640ustar00rootroot00000000000000(* Generates congruence lemmas using reflect license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "injection.elpi" as injection. From elpi.apps.derive.elpi Extra Dependency "bcongr.elpi" as bcongr. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Export elpi. From elpi.apps Require Export derive. From elpi.apps Require Export derive.projK. Lemma eq_f (T1 : Type) (T2 : Type) (f : T1 -> T2) a b : a = b -> f a = f b. Proof. exact (fun h => eq_rect a (fun x => f a = f x) (eq_refl (f a)) b h). Defined. Register eq_f as elpi.derive.eq_f. Elpi Db derive.bcongr.db lp:{{ func bcongr-db constructor -> term. }}. #[superglobal] Elpi Accumulate derive.bcongr.db lp:{{ :name "bcongr-db:fail" bcongr-db K _ :- M is "derive.bcongr: can't find the boolean congruence for constructor " ^ {std.any->string K}, stop M. }}. (* standalone *) Elpi Command derive.bcongr. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File injection. Elpi Accumulate File bcongr. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", derive.bcongr.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.bcongr ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.bcongr.db. Elpi Accumulate derive File injection. Elpi Accumulate derive File bcongr. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "bcongr" "projK". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "bcongr" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) N ff (derive "bcongr" (derive.bcongr.main T N) (derive.exists-indc T (K\bcongr-db K _))). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/cast.v000066400000000000000000000012221523041753400231420ustar00rootroot00000000000000(* Generates (once and forall) cast operators (trasport). license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "cast.elpi" as cast. From elpi Require Export elpi. Elpi Db derive.cast.db lp:{{ func cast-db int -> term. }}. Elpi Command derive.cast. Elpi Accumulate Db derive.cast.db. Elpi Accumulate File cast. Elpi Accumulate lp:{{ main [int N] :- derive.cast.main N. }}. Elpi derive.cast 2. Elpi derive.cast 3. Elpi derive.cast 4. Elpi derive.cast 5. Elpi derive.cast 6. Elpi derive.cast 7. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eq.v000066400000000000000000000044371523041753400226300ustar00rootroot00000000000000(* Generates equality tests. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "eq.elpi" as eq. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From Corelib Require Import PrimInt63 PrimFloat. From elpi.apps.derive Require Import PrimStringEqb. Register Corelib.Numbers.Cyclic.Int63.PrimInt63.eqb as elpi.derive.eq_unit63. Register Corelib.Floats.PrimFloat.eqb as elpi.derive.eq_float64. Elpi Db derive.eq.db lp:{{ % full resolution (composes with eq functions for parameters) func eq-db term, term -> term. eq-db {{ lib:num.int63.type }} {{ lib:num.int63.type }} {{ lib:elpi.derive.eq_unit63 }} :- !. eq-db {{ lib:num.float.type }} {{ lib:num.float.type }} {{ lib:elpi.derive.eq_float64 }} :- !. eq-db {{ lib:elpi.pstring }} {{ lib:elpi.pstring }} {{ lib:elpi.pstring_eqb }} :- !. % quick access type eq-for inductive -> constant -> prop. }}. #[superglobal] Elpi Accumulate derive.eq.db lp:{{ func whd1 term -> term. :name "eq-db:fail" eq-db A B F :- ((whd1 A A1, B1 = B); (whd1 B B1, A1 = A)), !, eq-db A1 B1 F. eq-db A B _ :- M is "derive.eq: can't find the comparison function for terms of type " ^ {coq.term->string A} ^ " and " ^ {coq.term->string B} ^ " respectively", stop M. }}. Elpi Command derive.eq. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eq.db. Elpi Accumulate File eq. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.eq.main GR O _. main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Id, O is Id ^ "_eq", derive.eq.main GR O _. main _ :- usage. usage :- coq.error "Usage: derive.eq []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.eq.db. Elpi Accumulate derive File eq. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eq" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eq" (derive.eq.main T N) (eq-for T _)) :- N is Prefix ^ "eq". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqK.v000066400000000000000000000051151523041753400227350ustar00rootroot00000000000000(* Generates a branch of the correctness proof for comparison functions generated by derive.eq. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "discriminate.elpi" as discriminate. From elpi.apps.derive.elpi Extra Dependency "eqK.elpi" as eqK. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps Require Import derive.bcongr derive.eq derive.isK. Definition eq_axiom T eqb := forall (x y : T), Datatypes.reflect (x = y) (eqb x y). Definition eq_axiom_at T eqb (x : T) := forall y, Datatypes.reflect (x = y) (eqb x y). Definition eq_axiom_on T eqb (x y : T) := Datatypes.reflect (x = y) (eqb x y). Register eq_axiom as elpi.derive.eq_axiom. Register eq_axiom_at as elpi.derive.eq_axiom_at. Register eq_axiom_on as elpi.derive.eq_axiom_on. Lemma bool_discr : true = false -> forall T : Type, T. Proof. exact (fun h T => eq_rect true (fun x => match x with false => T | _ => True end) I false h). Qed. Register bool_discr as elpi.bool_discr. Elpi Db derive.eqK.db lp:{{ func eqK-db constructor -> term. }}. #[superglobal] Elpi Accumulate derive.eqK.db lp:{{ :name "eqK-db:fail" eqK-db K _ :- M is "derive.eqK: can't find the eq.axiom for constructor " ^ {std.any->string K}, stop M. }}. (* standalone *) Elpi Command derive.eqK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File discriminate. Elpi Accumulate Db derive.bcongr.db. Elpi Accumulate Db derive.eq.db. Elpi Accumulate Db derive.eqK.db. Elpi Accumulate File eqK. Elpi Accumulate lp:{{ main [str I, str Prefix] :- !, coq.locate I (indt GR), derive.eqK.main GR Prefix _. main [str I] :- !, coq.locate I (indt GR), derive.eqK.main GR "eq_axiom_" _. main _ :- usage. usage :- coq.error "Usage: derive.eqK []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.eqK.db. Elpi Accumulate derive File discriminate. Elpi Accumulate derive File eqK. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "eqK" "bcongr". dep1 "eqK" "isK". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqK" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eqK" (derive.eqK.main T N) (derive.exists-indc T (K\ eqK-db K _))) :- N is Prefix ^ "eq_axiom_". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqOK.v000066400000000000000000000040121523041753400230470ustar00rootroot00000000000000(* Generates the final, correctness lemma, for equality tests by combinig the output of eqcorrect and param1_inhab. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1.elpi" as param1. From elpi.apps.derive.elpi Extra Dependency "eqOK.elpi" as eqOK. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps Require Import derive.param1 derive.param1_congr derive.param1_trivial derive.eqK derive.eqcorrect. Elpi Db derive.eqOK.db lp:{{ pred eqOK-done i:inductive. }}. (* standalone *) Elpi Command derive.eqOK. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param1.db. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate Db derive.eqcorrect.db. Elpi Accumulate Db derive.eqOK.db. Elpi Accumulate File eqOK. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.eqOK.main GR O _. main [str I] :- !, coq.locate I (indt GR), Name is {coq.gref->id (indt GR)} ^ "_eq_OK", derive.eqOK.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.eqOK []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.eqOK.db. Elpi Accumulate derive File eqOK. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "eqOK" "eqcorrect". dep1 "eqOK" "param1_trivial". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqOK" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eqOK" (derive.eqOK.main T N) (eqOK-done T)) :- N is Prefix ^ "eq_OK". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqOK_trivial.v.skip000066400000000000000000000030471523041753400255550ustar00rootroot00000000000000(* Draft: trivil eq_axiom (needed for indexes) license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From mathcomp Require Import all_ssreflect. From elpi.apps Require Import elpi. Definition transp {T} (Ctx : T -> Type) {t1 t2} (e : t2 = t1) : Ctx t1 -> Ctx t2. Proof. by case: _/e. Defined. Axiom dep_fun_ext : forall T (P : T -> Type) (f g: forall t:T, P t), (forall x, f x = g x) -> f = g. Lemma reflect_irrelevance (T : eqType) (x y : T) b (p1 p2 : reflect (x = y) b) : p1 = p2. Proof. case: p2 p1 => {b} [e| ne] r. refine (match r as r in reflect _ t return forall p : t = true, r = transp (reflect (x = y)) p (ReflectT (x = y) e) with | ReflectT e' => _ | ReflectF ne' => _ end (erefl true)) => // p {r}. rewrite (eq_irrelevance p (erefl true)) {p}. congr (ReflectT (x = y)). by apply: eq_irrelevance. refine (match r as r in reflect _ t return forall p : t = false, r = transp (reflect (x = y)) p (ReflectF (x = y) ne) with | ReflectT e' => _ | ReflectF ne' => _ end (erefl false)) => // p {r}. rewrite (eq_irrelevance p (erefl false)) {p}. congr (ReflectF (x = y)). apply: dep_fun_ext. by case/ne. Qed. Lemma eq_axiom_trivial (a : eqType) fa : full a (eq_axiom a fa) -> trivial a (eq_axiom a fa). Proof. rewrite /eq_axiom /full. move=> p1 x; exists (p1 x) => p2. apply: dep_fun_ext => w. apply: reflect_irrelevance. Qed. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqType_ast.v000066400000000000000000000041411523041753400243310ustar00rootroot00000000000000From elpi Require Import elpi. From Corelib Require Import PrimInt63 PrimFloat. From elpi.apps.derive Require Import PrimStringEqb. From elpi.apps Require Export derive. From elpi.apps.derive.elpi Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. Elpi Db derive.eqType.db lp:{{ kind eqb.arguments type. kind eqb.trm type. kind eqb.eqType type. kind eqb.constructor type. type eqb.app gref -> eqb.trm -> list eqb.trm -> eqb.trm. type eqb.global gref -> eqb.trm. type eqb.regular eqb.trm -> eqb.arguments -> eqb.arguments. type eqb.irrelevant eqb.trm -> eqb.arguments -> eqb.arguments. type eqb.dependent eqb.trm -> (eqb.trm -> eqb.arguments) -> eqb.arguments. type eqb.stop eqb.trm -> eqb.arguments. type eqb.type-param (eqb.trm -> eqb.eqType) -> eqb.eqType. type eqb.value-param eqb.trm -> (eqb.trm -> eqb.eqType) -> eqb.eqType. type eqb.inductive inductive -> (eqb.trm -> list eqb.constructor) -> eqb.eqType. type eqb.axiom eqb.eqType. type eqb.constructor constructor -> eqb.arguments -> eqb.constructor. pred eqType i:gref, o:eqb.eqType. eqType {{:gref PrimInt63.int }} eqb.axiom :- !. eqType {{:gref lib:elpi.pstring }} eqb.axiom :- !. }}. Definition arrow T1 T2 := T1 -> T2. Register arrow as elpi.derive.arrow. Definition apply {T1 T2} (f : T1 -> T2) x := f x. Register apply as elpi.derive.apply. (* standalone *) Elpi Command derive.eqType.ast. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate File eqType. Elpi Accumulate lp:{{ main [str S] :- std.assert! (coq.locate S (indt I)) "derive.eqType.ast: not an inductive", derive.eqType.ast.main I _. }}. (* hook into derive *) Elpi Accumulate derive Db derive.eqType.db. Elpi Accumulate derive File eqType. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqType_ast" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) _ ff (derive "eqType_ast" (derive.eqType.ast.main T) (eqType (indt T) _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqb.v000066400000000000000000000045121523041753400227640ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive derive.param1. From Corelib Require Import ssrbool ssreflect PrimInt63. From Corelib Require Import PosDef. From elpi.apps.derive.elpi Extra Dependency "fields.elpi" as fields. From elpi.apps.derive.elpi Extra Dependency "eqb.elpi" as eqb. From elpi.apps.derive.elpi Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. Require Import eqb_core_defs. Require Import eqType_ast tag fields. Register eqb_body as elpi.derive.eqb_body. Elpi Db derive.eqb.db lp:{{ func whd1 term -> term. pred eqb-done o:gref. pred eqb-for o:term, % type1 o:term, % type2 o:term. % comparison function pred eqb-fields o:term, % type1 o:term, % type2 o:term. % eq_fields_type eqb-for {{ PrimFloat.float }} {{ PrimFloat.float }} {{ PrimFloat.eqb }}. eqb-for {{ PrimInt63.int }} {{ PrimInt63.int }} {{ PrimInt63.eqb }}. eqb-for {{ lib:elpi.pstring }} {{ lib:elpi.pstring }} {{ lib:elpi.pstring_eqb }}. :name "eqb-for:whd" eqb-for T1 T2 X :- whd1 T1 T1', !, eqb-for T1' T2 X. eqb-for T1 T2 X :- whd1 T2 T2', !, eqb-for T1 T2' X. }}. (* standalone *) Elpi Command derive.eqb. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.tag.db. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.fields.db. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate File eqType. Elpi Accumulate File fields. Elpi Accumulate File eqb. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.eqb.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.eqb ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.eqb.db. Elpi Accumulate derive File eqb. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "eqb" "fields". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqb" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eqb" (derive.eqb.main (indt T) Prefix) (eqb-done (indt T))). derivation (const C) Prefix ff (derive "eqb_alias" (derive.eqb.main (const C) Prefix) (eqb-done (const C))). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqbOK.v000066400000000000000000000107071523041753400232210ustar00rootroot00000000000000(* Generates soudness proofs given correctness and reflexivity. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive Require Import eqb_core_defs. From elpi.apps.derive Require Import tag eqType_ast fields eqb eqbcorrect derive. From elpi.apps.derive.elpi Extra Dependency "eqbOK.elpi" as eqbOK. From elpi.apps.derive.elpi Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. Elpi Db derive.eqbOK.db lp:{{ pred eqbok-for o:gref, o:constant. }}. Lemma reflectEq {A} {x y : A} : reflect (x = y) true -> x = y. Proof. by intro H; inversion H. Qed. Lemma reflectNEq {A} {x y : A} : reflect (x = y) false -> x <> y. Proof. by intro H; inversion H. Qed. Definition reflect_dec a b (F : forall x y : a, reflect (x=y) (b x y)) x y : {x=y}+{x<>y} := match b x y with | true => fun H => left (reflectEq H) | false => fun H => right (reflectNEq H) end (F x y). Definition eqb_of_dec : forall a (H : forall x y : a, {x=y}+{x<>y}), a -> a -> bool := fun a H x y => (match H x y with left _ => true | right _ => false end). Definition dec_reflect : forall a (H : forall x y : a, {x=y}+{x<>y}), forall x y : a, reflect (x=y) (eqb_of_dec a H x y) := fun a H x y => match H x y as H return reflect (x=y) (match H with left _ => true | right _ => false end) with left p => ReflectT _ p | right p => ReflectF _ p end. (* standalone *) Elpi Command derive.eqbOK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate Db derive.eqbcorrect.db. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.eqbOK.db. Elpi Accumulate File eqbOK. Elpi Accumulate File eqType. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.eqbOK.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.eqbOK ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.eqbOK.db. Elpi Accumulate derive File eqbOK. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "eqbOK" "eqbcorrect". dep1 "eqbOK_alias" "eqbcorrect_alias". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqbOK" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eqbOK" (derive.eqbOK.main (indt T) Prefix) (eqbok-for (indt T) _)). derivation (const T) Prefix ff (derive "eqbOK_alias" (derive.eqbOK.main (const T) Prefix) (eqbok-for (const T) _)). }}. Elpi Command derive.eqbOK.register_axiom. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate Db derive.eqbcorrect.db. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate File eqType. Elpi Accumulate lp:{{ main [str Type, str IsT, str IsTinhab, str Eqb, str Correct, str Refl] :- !, coq.locate Type GrType, coq.locate IsT GRisT, coq.locate IsTinhab GRisTinhab, coq.locate Eqb GrEqb, coq.locate Correct GrCorrect, coq.locate Refl GrRefl, GrRefl = const R, GrCorrect = const C, coq.elpi.accumulate _ "derive.eqb.db" (clause _ _ (eqb-done GrType)), coq.elpi.accumulate _ "derive.eqb.db" (clause _ (before "eqb-for:whd") (eqb-for (global GrType) (global GrType) (global GrEqb))), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ (eqcorrect-for GrType C R)), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ (correct-lemma-for (global GrType) (global GrCorrect))), coq.elpi.accumulate _ "derive.eqbcorrect.db" (clause _ _ (refl-lemma-for (global GrType) (global GrRefl))), coq.elpi.accumulate _ "derive.eqType.db" (clause _ _ (eqType GrType eqb.axiom)), coq.elpi.accumulate _ "derive.param1.db" (clause _ _ (reali-done GrType)), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "reali:fail") (reali (global GrType) (global GRisT) :- !)), coq.elpi.accumulate _ "derive.param1.db" (clause _ (before "realiR:fail") (realiR (global GrType) (global GRisT) :- !)), coq.elpi.accumulate _ "derive.param1.trivial.db" (clause _ _ (param1-inhab-db (global GRisT) (global GRisTinhab))). main _ :- coq.error "usage: derive.eqbOK.register_axiom T is_T is_T_inhab eqb eqb_correct eqb_refl.". }}. Elpi Export derive.eqbOK.register_axiom. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqb_core_defs.v000066400000000000000000000110761523041753400250000ustar00rootroot00000000000000From Corelib Require Import PosDef. Require Import ssreflect ssrbool. From elpi.apps.derive Require Import EqdepFacts. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Section. Context {A:Type}. Definition eqb_correct_on (eqb : A -> A -> bool) (a1:A) := forall a2, eqb a1 a2 -> a1 = a2. Definition eqb_refl_on (eqb : A -> A -> bool) (a:A) := is_true (eqb a a). Definition eqb_correct (eqb : A -> A -> bool) := forall (a1:A), eqb_correct_on eqb a1. Definition eqb_reflexive (eqb : A -> A -> bool) := forall (a:A), eqb_refl_on eqb a. Lemma iffP2 (f : A -> A -> bool) (H1 : eqb_correct f) (H2 : eqb_reflexive f) (x1 x2 : A) : reflect (x1 = x2) (f x1 x2). Proof. apply (iffP idP);[ apply H1 | move->; apply H2 ]. Qed. Definition eqax_on (eqb : A -> A -> bool) (a1:A) := forall a2, reflect (a1 = a2) (eqb a1 a2). End Section. Lemma pos_eq_dec : forall x y:positive, {x = y} + {x <> y}. Proof. decide equality. Defined. Theorem UIP_dec (A : Type) (eq_dec : forall x y : A, {x = y} + {x <> y}) : forall (x y : A) (p1 p2 : x = y), p1 = p2. Proof. exact (eq_dep_eq__UIP A (eq_dep_eq_dec eq_dec)). Qed. Theorem bool_dec (b1 b2 : bool) : {b1 = b2} + {b1 <> b2}. Proof. decide equality. Qed. Section Section. Context {A B:Type}. Variable tagA : A -> positive. Variable tagB : B -> positive. Variable fields_tA : positive -> Type. Variable fields_tB : positive -> Type. Variable fieldsA : forall a, fields_tA (tagA a). Variable fieldsB : forall a, fields_tB (tagB a). Variable constructA : forall t, fields_tA t -> option A. Variable constructB : forall t, fields_tB t -> option B. Variable constructPA : forall a, constructA (fieldsA a) = Some a. Variable constructPB : forall a, constructB (fieldsB a) = Some a. Variable eqb_fields : forall t, fields_tA t -> fields_tB t -> bool. Definition eqb_body (t1:positive) (f1:fields_tA t1) (x2:B) := let t2 := tagB x2 in match pos_eq_dec t2 t1 with | left heq => let f2 : fields_tB t2 := fieldsB x2 in @eqb_fields t1 f1 (match heq with eq_refl => f2 end) | right _ => false end. #[global] Arguments eqb_body _ _ _ /. End Section. Section Section. Context {A:Type}. Variable tag : A -> positive. Variable fields_t : positive -> Type. Variable fields : forall a, fields_t (tag a). Variable construct : forall t, fields_t t -> option A. Variable constructP : forall a, construct (fields a) = Some a. Variable eqb_fields : forall t, fields_t t -> fields_t t -> bool. Definition eqb_fields_correct_on (a:A) := forall f : fields_t (tag a), eqb_fields (fields a) f -> Some a = construct f. Lemma eqb_body_correct a1 : eqb_fields_correct_on a1 -> forall a2, eqb_body fields eqb_fields (fields a1) a2 -> a1 = a2. Proof. move=> hf a2 hb. suff : Some a1 = Some a2 by move=> [->]. rewrite -(constructP a2); move: hb; rewrite /eqb_body. case: pos_eq_dec => // heq. move: (tag a2) heq (fields a2) => t2 ?; subst t2 => f2 /=; apply hf. Qed. Definition eqb_fields_refl_on (a:A) := eqb_fields (fields a) (fields a). Lemma eqb_body_refl a : eqb_fields_refl_on a -> eqb_body fields eqb_fields (fields a) a. Proof. pose h := constructP. (* dummy dependence to have the same type as eqb_body_correct *) rewrite /eqb_body => hf. case: pos_eq_dec => // heq. have -> /= := UIP_dec pos_eq_dec heq eq_refl; apply hf. Qed. Inductive blist := bnil | bcons (b : bool) (bs : blist). Fixpoint eqb_refl_statement (acc : bool) (l : blist) {struct l} := match l with | bnil => acc = true | bcons b bs => b = true -> eqb_refl_statement (b && acc) bs end. Lemma eqb_refl_statementP l : eqb_refl_statement true l. Proof. elim: l => //= b l hrec ->; apply hrec. Qed. Fixpoint implies (l : blist) (P : Prop) : Prop := match l with | bnil => P | bcons b bs => b = true -> implies bs P end. Fixpoint allr (l : blist) := match l with | bnil => true | bcons b bs => b && allr bs end. Lemma impliesP (l:blist) (P:Prop) : implies l P -> allr l = true -> P. Proof. by elim: l => //= b l hrec hall /andP[/hall]. Qed. Inductive tlist := tnil | tcons (T : Type) (TS : tlist). Fixpoint p_type (T : tlist) := match T with | tnil => Prop | tcons T Ts => T -> p_type Ts end. Fixpoint eq_ind_r_n (T : tlist) : p_type T -> p_type T -> Prop := match T return p_type T -> p_type T -> Prop with | tnil => fun p q => p -> q | tcons T Ts => fun p q => forall (x y : T), x = y -> @eq_ind_r_n Ts (p x) (q y) end. Lemma eq_ind_r_nP (T : tlist) (p : p_type T) : @eq_ind_r_n T p p. Proof. elim: T p => //= T Ts hrec f a1 a2 ->; apply hrec. Qed. End Section. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqbcorrect.v000066400000000000000000000103171523041753400243460ustar00rootroot00000000000000From Corelib Require Import ssreflect ssrfun ssrbool. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps.derive Require Import induction param1_functor param1_trivial eqb_core_defs tag fields eqb. From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1.elpi" as param1. From elpi.apps.derive.elpi Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive.elpi Extra Dependency "eqbcorrect.elpi" as eqbcorrect. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. Module Export exports. Export ssreflect ssrbool eqb_core_defs. (* go ask the ltac gurus... *) Ltac solver_regular_or_dependent := match reverse goal with | View : @eqb_correct_on _ ?f ?y |- is_true (?f ?y ?x && _) -> _ => case/andP => /View => ? {View}; subst x end. Ltac solver_irrelevant := match goal with | p1 : ?x = true , p2 : ?x = true |- _ => let top := fresh "x" in have top := @eqb_core_defs.UIP_dec bool eqb_core_defs.bool_dec _ _ p1 p2; subst p1 end. Ltac eqb_correct_on__solver := let x := fresh "x" in case=> [^ x] /=; by repeat (solver_regular_or_dependent || solver_irrelevant). Ltac eqb_refl_on__solver := by rewrite /eqb_fields_refl_on /=; repeat ((apply /andP; split) || reflexivity || assumption). End exports. From Corelib Require Uint63Axioms. Lemma uint63_eqb_correct i : eqb_correct_on PrimInt63.eqb i. Proof. exact: Uint63Axioms.eqb_correct. Qed. Lemma uint63_eqb_refl i : eqb_refl_on PrimInt63.eqb i. Proof. exact: Uint63Axioms.eqb_refl. Qed. From elpi.apps.derive Require PrimStringEqb. Lemma pstring_eqb_correct i : eqb_correct_on PrimStringEqb.eqb i. Proof. move=> j; rewrite /PrimStringEqb.eqb; have [] := PrimStringEqb.compare_ok i j. by case: PrimString.compare => // /(_ erefl). Qed. Lemma pstring_eqb_refl i : eqb_refl_on PrimStringEqb.eqb i. Proof. rewrite /PrimStringEqb.eqb /eqb_refl_on; have [] := PrimStringEqb.compare_ok i i. by case: PrimString.compare => // _ /(_ erefl). Qed. Elpi Db derive.eqbcorrect.db lp:{{ func eqcorrect-for gref -> constant, % correct constant. % reflexive eqcorrect-for {{:gref PrimInt63.int }} C R :- {{:gref uint63_eqb_correct}} = const C, {{:gref uint63_eqb_refl}} = const R. :index(2) pred correct-lemma-for i:term, o:term. correct-lemma-for {{ PrimInt63.int }} {{ @uint63_eqb_correct }}. correct-lemma-for {{ PrimString.string }} {{ @pstring_eqb_correct }}. :index(2) pred refl-lemma-for i:term, o:term. refl-lemma-for {{ PrimInt63.int }} {{ @uint63_eqb_refl }}. refl-lemma-for {{ PrimString.string }} {{ @pstring_eqb_refl }}. }}. (* standalone *) Elpi Command derive.eqbcorrect. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.tag.db. Elpi Accumulate Db derive.eqb.db. Elpi Accumulate Db derive.fields.db. Elpi Accumulate Db derive.eqbcorrect.db. Elpi Accumulate Db derive.induction.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File eqbcorrect. Elpi Accumulate File paramX. Elpi Accumulate File param1. Elpi Accumulate File eqType. Elpi Accumulate Db derive.param1.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, coq.gref->id GR Tname, Prefix is Tname ^ "_", derive.eqbcorrect.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.eqbcorrect ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.eqbcorrect.db. Elpi Accumulate derive File eqbcorrect. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "eqbcorrect" "eqb". dep1 "eqbcorrect" "induction". dep1 "eqbcorrect" "param1_inhab". dep1 "eqbcorrect_alias" "eqb_alias". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqbcorrect" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eqbcorrect" (derive.eqbcorrect.main (indt T) Prefix) (eqcorrect-for (indt T) _ _)). derivation (const C) Prefix ff (derive "eqbcorrect_alias" (derive.eqbcorrect.main (const C) Prefix) (eqcorrect-for (const C) _ _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/eqcorrect.v000066400000000000000000000066531523041753400242140ustar00rootroot00000000000000(* Generates correctness proofs for comparison functions generated by derive.eq. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "eqcorrect.elpi" as eqcorrect. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. From elpi.apps Require Import derive.eq derive.induction derive.eqK derive.param1. From Corelib Require Import ssreflect. From Corelib Require PrimInt63 Uint63Axioms. Lemma uint63_eq_correct i : is_uint63 i -> eq_axiom_at PrimInt63.int PrimInt63.eqb i. Proof. move=> _ j; have [] : (PrimInt63.eqb i j) = true <-> i = j. split; first exact: Uint63Axioms.eqb_correct. by move=> ->; rewrite Uint63Axioms.eqb_refl. by case: PrimInt63.eqb => [-> // _| _ abs]; constructor=> // /abs. Qed. Register uint63_eq_correct as elpi.derive.uint63_eq_correct. From elpi.apps.derive Require PrimStringEqb. Lemma pstring_eq_correct i : is_pstring i -> eq_axiom_at PrimString.string PrimStringEqb.eqb i. Proof. move=> _ j; have [] : (PrimStringEqb.eqb i j) = true <-> i = j. rewrite /PrimStringEqb.eqb; have := PrimStringEqb.compare_ok i j. case: PrimString.compare => - [c r] //; split => //; [move=> _| by move=>/r ..]. by apply: c. by case: PrimStringEqb.eqb => [-> // _| _ abs]; constructor=> // /abs. Qed. Register pstring_eq_correct as elpi.derive.pstring_eq_correct. Elpi Db derive.eqcorrect.db lp:{{ type eqcorrect-db gref -> term -> prop. }}. #[superglobal] Elpi Accumulate derive.eqcorrect.db lp:{{ eqcorrect-db {{:gref lib:num.int63.type }} {{ lib:elpi.derive.uint63_eq_correct }} :- !. eqcorrect-db {{:gref lib:elpi.pstring }} {{ lib:elpi.derive.pstring_eq_correct }} :- !. eqcorrect-db X _ :- {{ lib:num.float.type }} = global X, !, stop "float64 comparison is not syntactic". :name "eqcorrect-db:fail" eqcorrect-db T _ :- M is "derive.eqcorrect: can't find the correctness proof for the comparison function on " ^ {coq.gref->string T}, stop M. }}. (* standalone *) Elpi Command derive.eqcorrect. Elpi Accumulate Db derive.param1.db. (* TODO: understand which other db needs this *) Elpi Accumulate Db derive.induction.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate Db derive.eq.db. Elpi Accumulate Db derive.eqK.db. Elpi Accumulate Db derive.eqcorrect.db. Elpi Accumulate File eqcorrect. Elpi Accumulate lp:{{ main [str I, str Name] :- !, coq.locate I (indt GR), derive.eqcorrect.main GR Name _. main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) ID, Name is ID ^ "_eq_correct", derive.eqcorrect.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.eqcorrect []". }}. (* hook into derive *) Elpi Accumulate derive File derive_hook. Elpi Accumulate derive Db derive.eqcorrect.db. Elpi Accumulate derive File eqcorrect. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "eqcorrect" "induction". dep1 "eqcorrect" "eq". dep1 "eqcorrect" "eqK". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "eqcorrect" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "eqcorrect" (derive.eqcorrect.main T N) (eqcorrect-db (indt T) _)) :- N is Prefix ^ "eq_correct". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/experimental.v000066400000000000000000000004371523041753400247140ustar00rootroot00000000000000(* Experimental set of derivations license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps Require Export derive. From elpi.apps Require Export derive.invert derive.idx2inv . LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/fields.v000066400000000000000000000037251523041753400234700ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive. From Corelib Require Import PosDef. From elpi.apps Require Export derive.eqType_ast derive.tag. From elpi.apps.derive.elpi Extra Dependency "fields.elpi" as fields. From elpi.apps.derive.elpi Extra Dependency "eqType.elpi" as eqType. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. Register unit as elpi.derive.unit. Local Open Scope positive_scope. Elpi Db derive.fields.db lp:{{ % this is how one registers the fields_t, fields and construct[P] % constants to an inductive and let other elpi commands use that piece of info pred fields-for o:inductive, o:constant, % fields_t o:constant, % fields o:constant, % construct o:constant. % constructP func box-for constructor -> inductive, constructor. }}. (* standalone *) Elpi Command derive.fields. Elpi Accumulate Db Header derive.eqType.db. Elpi Accumulate Db Header derive.tag.db. Elpi Accumulate File eqType. Elpi Accumulate Db Header derive.fields.db. Elpi Accumulate File derive_hook. Elpi Accumulate File fields. Elpi Accumulate Db derive.eqType.db. Elpi Accumulate Db derive.tag.db. Elpi Accumulate Db derive.fields.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", derive.fields.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.fields []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.fields.db. Elpi Accumulate derive File fields. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "fields" "tag". dep1 "fields" "eqType_ast". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "fields" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "fields" (derive.fields.main T Prefix) (fields-for T _ _ _ _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/idx2inv.v000066400000000000000000000037321523041753400236030ustar00rootroot00000000000000(* Generates lemmas linking an inductive with indexes and its structural copy without indexes but equations instead. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1_functor.elpi" as param1_functor. From elpi.apps.derive.elpi Extra Dependency "idx2inv.elpi" as idx2inv. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Export elpi. From elpi.apps Require Export derive. From elpi.apps Require Export derive.param1 derive.param1_functor derive.invert. Elpi Db derive.idx2inv.db lp:{{ type idx2inv-db inductive -> inductive -> constant -> constant -> prop. }}. (* standalone *) Elpi Command derive.idx2inv. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File param1_functor. Elpi Accumulate Db derive.invert.db. Elpi Accumulate Db derive.idx2inv.db. Elpi Accumulate File idx2inv. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.idx2inv.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.idx2inv.main GR "_to_" _. main _ :- usage. usage :- coq.error "Usage: derive.idx2inv []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.idx2inv.db. Elpi Accumulate derive File idx2inv. Elpi Accumulate File paramX. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "idx2inv" "invert". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "idx2inv" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) _ ff (derive "idx2inv" (derive.idx2inv.main T "_to_") (idx2inv-db T _ _ _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/induction.v000066400000000000000000000037161523041753400242160ustar00rootroot00000000000000(* Generates the induction principle. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1.elpi" as param1. From elpi.apps.derive.elpi Extra Dependency "induction.elpi" as induction. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive derive.param1 derive.param1_functor. Elpi Db derive.induction.db lp:{{ pred induction-db i:inductive, o:term. }}. #[superglobal] Elpi Accumulate derive.induction.db lp:{{ :name "induction-db:fail" induction-db T _ :- M is "derive.induction: can't find the induction principle for " ^ {std.any->string T}, stop M. }}. (* standalone *) Elpi Command derive.induction. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param1.db. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate Db derive.induction.db. Elpi Accumulate File induction. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), Name is {coq.gref->id (indt GR)} ^ "_", derive.induction.main GR Name _. main _ :- usage. usage :- coq.error "Usage: derive.induction ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.induction.db. Elpi Accumulate derive File induction. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "induction" "param1_functor". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "induction" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) N ff (derive "induction" (derive.induction.main T N) (induction-db T _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/invert.v000066400000000000000000000025501523041753400235240ustar00rootroot00000000000000(* Generates inversion lemmas by encoding indexes with equations and non uniform parameters. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "invert.elpi" as invert. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Export elpi. From elpi.apps Require Export derive. Elpi Db derive.invert.db lp:{{ type invert-db gref -> gref -> prop. }}. Elpi Command derive.invert. Elpi Accumulate Db derive.invert.db. Elpi Accumulate File invert. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.invert.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.invert.main GR "_inv" _. main _ :- usage. usage :- coq.error "Usage: derive.invert []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.invert.db. Elpi Accumulate derive File invert. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "invert" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "invert" (derive.invert.main T N) (invert-db (indt T) _)) :- N is Prefix ^ "inv". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/isK.v000066400000000000000000000033331523041753400227430ustar00rootroot00000000000000(* For each constructor K the function isK returns true iff it is applied to K. These helpers are use to implement "discriminate". license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "isK.elpi" as isK. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* Links the @gref of the constructor K to the isK constant *) Elpi Db derive.isK.db lp:{{ func isK-db constructor -> term. }}. #[superglobal] Elpi Accumulate derive.isK.db lp:{{ :name "isK-db:fail" isK-db K _ :- M is "No isK entry for constructor " ^ {std.any->string K} ^ ". Did you run derive.isK?", stop M. }}. Elpi Command derive.isK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File isK. Elpi Accumulate lp:{{ main [str I,str O] :- !, coq.locate I (indt GR), derive.isK.main GR O _. main [str I] :- !, coq.locate I (indt GR), Prefix is {coq.gref->id (indt GR)} ^ "_is_", derive.isK.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.isK []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.isK.db. Elpi Accumulate derive File isK. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "isK" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "isK" (derive.isK.main T N) (derive.exists-indc T (K\ isK-db K _))) :- N is Prefix ^ "isk_". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/legacy.v000066400000000000000000000005131523041753400234560ustar00rootroot00000000000000(* Legacy set of derivations license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps Require Export derive. From elpi.apps Require Export derive.projK derive.isK derive.eq derive.eqK derive.bcongr derive.eqOK . LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/lens.v000066400000000000000000000042271523041753400231610ustar00rootroot00000000000000(* A lens, to see better. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "lens.elpi" as lens. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Export derive. (* Coq stdlib has no lens data type so we declare one here. To override with your own "copy", use Register as below *) Local Set Primitive Projections. Record Lens (a b c d : Type) : Type := mkLens { view : a -> c ; over : (c -> d) -> a -> b }. Register mkLens as elpi.derive.lens.make. Arguments view {_ _ _ _} _ _. Arguments over {_ _ _ _} _ _ _. Definition set {a b c d} (l : Lens a b c d) new := over l (fun _ => new). Register set as elpi.derive.lens.set. Register view as elpi.derive.lens.view. Definition compose {a b c d e f} (l1 : Lens a b c d) (l2 : Lens c d e f) : Lens a b e f := mkLens a b e f (fun x => view l2 (view l1 x)) (fun u => over l1 (over l2 u)). Register compose as elpi.derive.lens.compose. (* Links the record, a field name (projection) and the lens focusing on that field *) Elpi Db derive.lens.db lp:{{ pred lens-db o:inductive, o:constant, o:constant. }}. (* standalone command *) Elpi Command derive.lens. Elpi Accumulate Db Header derive.lens.db. Elpi Accumulate File derive_hook. Elpi Accumulate File lens. Elpi Accumulate Db derive.lens.db. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.lens.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.lens.main GR "_" _. main _ :- usage. usage :- coq.error "Usage: derive.lens []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.lens.db. Elpi Accumulate derive File lens. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "lens" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "lens" (derive.lens.main T N) (lens-db T _ _)) :- N is Prefix ^ "_". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/lens_laws.v000066400000000000000000000052721523041753400242100ustar00rootroot00000000000000(* Equations for lenses license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "lens_laws.elpi" as lens_laws. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive.lens. Definition view_set_on {a c} (l : Lens a a c c) r := forall x, view l (set l x r) = x. Definition view_set {a c} (l : Lens a a c c) := forall r, view_set_on l r. Definition set_set_on {a c d} (l : Lens a a c d) r := forall x y, set l y (set l x r) = set l y r. Definition set_set {a c d} (l : Lens a a c d) := forall r, set_set_on l r. Definition set_view_on {a c} (l : Lens a a c c) r := set l (view l r) r = r. Definition set_view {a c} (l : Lens a a c c) := forall r, set_view_on l r. Definition exchange_on {a b d e f} (l1 : Lens a a b d) (l2 : Lens a a e f) r := forall x y, set l1 x (set l2 y r) = set l2 y (set l1 x r). Definition exchange {a b d e f} (l1 : Lens a a b d) (l2 : Lens a a e f) := forall r, exchange_on l1 l2 r. Register view_set as elpi.derive.lens.view_set. Register view_set_on as elpi.derive.lens.view_set_on. Register set_set as elpi.derive.lens.set_set. Register set_set_on as elpi.derive.lens.set_set_on. Register set_view as elpi.derive.lens.set_view. Register set_view_on as elpi.derive.lens.set_view_on. Register exchange as elpi.derive.lens.exchange. Register exchange_on as elpi.derive.lens.exchange_on. Elpi Db derive.lens_laws.db lp:{{ pred lens-laws-done i:inductive. }}. (* standalone *) Elpi Command derive.lens_laws. Elpi Accumulate Db Header derive.lens.db. Elpi Accumulate Db Header derive.lens_laws.db. Elpi Accumulate File derive_hook. Elpi Accumulate File lens_laws. Elpi Accumulate Db derive.lens.db. Elpi Accumulate Db derive.lens_laws.db. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.lens-laws.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.lens-laws.main GR "_" _. main _ :- usage. usage :- coq.error "Usage: derive.lens_laws []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.lens_laws.db. Elpi Accumulate derive File lens_laws. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "lens_laws" "lens". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "lens_laws" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "lens_laws" (derive.lens-laws.main T N) (lens-laws-done T)) :- N is Prefix ^ "_". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/map.v000066400000000000000000000026511523041753400227740ustar00rootroot00000000000000(* A map over a container. For non containers it produces the copy function. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "map.elpi" as map. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* Links the source and target type with the corresponding map function, eg. "map-db (list A) (list B) (list_map f_A_B)" *) Elpi Db derive.map.db lp:{{ pred map-done i:inductive. pred map-db i:term, i:term, o:term. }}. (* standalone command *) Elpi Command derive.map. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.map.db. Elpi Accumulate File map. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), derive.map.main GR {calc ({coq.gref->id (indt GR)} ^ "_")} _. main _ :- usage. usage :- coq.error "Usage: derive.map ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.map.db. Elpi Accumulate derive File map. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "map" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) N ff (derive "map" (derive.map.main T N) (map-done T)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/param1.v000066400000000000000000000106351523041753400234010ustar00rootroot00000000000000(* Unary parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1.elpi" as param1. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. Definition contractible T := { x : T & forall y, @eq T x y }. Register contractible as elpi.derive.contractible. Definition contracts T P (x : T) w u := (@existT (P x) (fun u : P x => forall v : P x,@eq (P x) u v) w u). Register contracts as elpi.derive.contracts. Definition full T P := forall x : T, P x. Register full as elpi.derive.full. Definition trivial T P := forall x : T, contractible (P x). Register trivial as elpi.derive.trivial. Definition trivial_full T P (e : trivial T P) (x : T) : P x := projT1 (e x). Register trivial_full as elpi.derive.trivial_full. Definition trivial_uniq T P (e : trivial T P) (x : T) (p : P x) : trivial_full T P e x = p := projT2 (e x) p. Register trivial_uniq as elpi.derive.trivial_uniq. (* To be removed. Like the param1-db below, but readable from Coq *) Class reali_db {X XR : Type} (x : X) (xR : XR) := store_reali {}. Class reali {X : Type} {XR : X -> Type} (x : X) (xR : XR x) := Reali {}. Register store_reali as param1.store_reali. From Corelib Require Import PrimInt63 PrimFloat. From elpi.apps.derive Require Import PrimStringEqb. Inductive is_uint63 : PrimInt63.int -> Type := uint63 (i : PrimInt63.int) : is_uint63 i. Register is_uint63 as elpi.derive.is_uint63. Inductive is_float64 : PrimFloat.float -> Type := float64 (f : PrimFloat.float ) : is_float64 f. Register is_float64 as elpi.derive.is_float64. Inductive is_pstring : PrimString.string -> Type := pstring (s : PrimString.string) : is_pstring s. Register is_pstring as elpi.derive.is_pstring. (* Links a term (constant, inductive type, inductive constructor) with its parametricity translation *) Elpi Db derive.param1.db lp:{{ :index(3) func reali term -> term. type realiR term -> term -> prop. pred reali-done i:gref. }}. #[superglobal] Elpi Accumulate derive.param1.db lp:{{ reali {{ lib:num.int63.type }} {{ lib:elpi.derive.is_uint63 }} :- !. reali {{ lib:num.float.type }} {{ lib:elpi.derive.is_float64 }} :- !. reali {{ lib:elpi.pstring }} {{ lib:elpi.derive.is_pstring }} :- !. :name "reali:fail" reali X _ :- M is "derive.param1: No unary parametricity translation for " ^ {coq.term->string X}, stop M. realiR {{ lib:num.int63.type }} {{ lib:elpi.derive.is_uint63 }} :- !. realiR {{ lib:num.float.type }} {{ lib:elpi.derive.is_float64 }} :- !. realiR {{ lib:elpi.pstring }} {{ lib:elpi.derive.is_pstring }} :- !. :name "realiR:fail" realiR T TR :- M is "derive.param1: No unary parametricity translation linking " ^ {coq.term->string T} ^ " and " ^ {coq.term->string TR}, stop M. }}. (* standalone *) Elpi Command derive.param1. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param1.db. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, derive.param1.main GR "" _. main _ :- usage. usage :- coq.error "Usage: derive.param1 ". }}. Module Export exports. Local Notation core_is_true := is_true. (* avoid shadowing by param1 is_true *) Elpi derive.param1 eq. Elpi derive.param1 bool. Elpi derive.param1 core_is_true. End exports. Register is_eq as elpi.derive.is_eq. Register is_bool as elpi.derive.is_bool. Register is_true as elpi.derive.is_true. Register is_false as elpi.derive.is_false. Register is_is_true as elpi.derive.is_is_true. (* hook into derive *) Elpi Accumulate derive File paramX. Elpi Accumulate derive Db Header derive.param1.db. Elpi Accumulate derive File param1. Elpi Accumulate derive Db derive.param1.db. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "param1" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ func derive.on_param1 gref, (func gref, gref, string -> list prop), string -> list prop. derive.on_param1 GR F N C :- reali (global GR) (global P), !, F GR P N C. derivation T N ff (derive "param1" (derive.param1.main T N ) (reali-done T)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/param1_congr.v000066400000000000000000000041331523041753400245650ustar00rootroot00000000000000(* Given an inductive type I and its unary parametricity translation is_I it generates for is constructor is_K a lemma like px = qx -> is_K x px .. = is_K x qx .. where px is the extra argument (about x) introduces by the parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1_congr.elpi" as param1_congr. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Export elpi. From elpi.apps Require Export derive.param1. Elpi Db derive.param1.congr.db lp:{{ func param1-congr-db constructor -> term. func param1-congr-done gref. }}. Elpi Command derive.param1.congr. Elpi Accumulate File paramX. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate File param1_congr. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt IsGR), realiR T {coq.env.global (indt IsGR)}, coq.env.global (indt GR) T, derive.param1.congr.main (indt GR) (indt IsGR) O _. main [str I] :- !, coq.locate I (indt IsGR), realiR T {coq.env.global (indt IsGR)}, coq.env.global (indt GR) T, derive.param1.congr.main (indt GR) (indt IsGR) "congr_" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.congr []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.param1.congr.db. Elpi Accumulate derive File param1_congr. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "param1_congr" "param1". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "param1_congr" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation T _ ff (derive "param1_congr" (derive.on_param1 T derive.param1.congr.main "congr_") (derive.on_param1 T (_\T\_\_\param1-congr-done T) _ _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/param1_functor.v000066400000000000000000000042001523041753400251300ustar00rootroot00000000000000(* Functorial property of params in param1 translation. Inductive I A PA : A -> Type := K : forall a b, I A PA a. Elpi derive.param1.functor is_I. Definition is_I_functor A PA PB (f : forall x, PA x -> PB x) a : I A PA a -> I A PB a. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "param1_functor.elpi" as param1_functor. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive derive.param1. Elpi Db derive.param1.functor.db lp:{{ func param1-functor-db term, term -> term. func param1-functor-for inductive -> gref, list bool. }}. Elpi Command derive.param1.functor. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.functor.db. Elpi Accumulate File param1_functor. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt IsGR), realiR T {coq.env.global (indt IsGR)}, coq.env.global (indt GR) T, derive.param1.functor.main (indt GR) (indt IsGR) O _. main [str I] :- !, coq.locate I (indt IsGR), realiR T {coq.env.global (indt IsGR)}, coq.env.global (indt GR) T, derive.param1.functor.main (indt GR) (indt IsGR) "_functor" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.functor []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.param1.functor.db. Elpi Accumulate derive File param1_functor. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "param1_functor" "param1". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "param1_functor" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) _ ff (derive "param1_functor" (derive.on_param1 (indt T) derive.param1.functor.main "_functor") (derive.on_param1 (indt T) (_\T\_\_\sigma I\ T = indt I, param1-functor-for I _ _) _ _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/param1_trivial.v000066400000000000000000000240021523041753400251240ustar00rootroot00000000000000(* Given an inductive type I and its unary parametricity translation is_ it generates a proof of forall i : I, is_U i and then a proof of forall i : I, { p : is_I i & forall q, p = q }. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param1.elpi" as param1. From elpi.apps.derive.elpi Extra Dependency "param1_inhab.elpi" as param1_inhab. From elpi.apps.derive.elpi Extra Dependency "param1_trivial.elpi" as param1_trivial. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive.param1 derive.param1_congr. Elpi Db derive.param1.trivial.db lp:{{ func param1-trivial-done gref ->. type param1-trivial-db term -> term -> prop. type param1-trivial-db-args list term -> list term -> prop. func param1-inhab-done gref ->. type param1-inhab-db term -> term -> prop. type param1-inhab-db-args list term -> list term -> prop. }}. #[superglobal] Elpi Accumulate derive.param1.trivial.db Db Header derive.param1.db. #[superglobal] Elpi Accumulate derive.param1.trivial.db lp:{{ :name "param1:inhab:start" param1-inhab-db (fun `f` (prod `_` S _\ T) f\ prod `x` S x\ prod `px` (RS x) _) (fun `f` (prod `_` S _\ T) f\ fun `x` S x\ fun `px` (RS x) _\ P f x) :- pi f x\ reali T R, param1-inhab-db R PT, coq.mk-app PT [{coq.mk-app f [x]}] (P f x). param1-inhab-db (app [Hd|Args]) (app[P|PArgs]) :- param1-inhab-db Hd P, !, param1-inhab-db-args Args PArgs. param1-inhab-db-args [] []. param1-inhab-db-args [T,P|Args] R :- std.assert-ok! (coq.typecheck T Ty) "param1-inhab-db: cannot work illtyped term", if (coq.sort? Ty) (param1-inhab-db P Q, R = [T,P,Q|PArgs], param1-inhab-db-args Args PArgs) (R = [T,P|PArgs], param1-inhab-db-args Args PArgs). :name "param1:trivial:start" param1-trivial-db (fun `f` (prod `_` S _\ T) f\ prod `x` S x\ prod `px` (RS x) _) (fun `f` (prod `_` S _\ T) f\ fun `x` S x\ fun `px` (RS x) _\ P f x) :- pi f x\ reali T R, param1-trivial-db R PT, coq.mk-app PT [{coq.mk-app f [x]}] (P f x). param1-trivial-db (app [Hd|Args]) (app[P|PArgs]) :- param1-trivial-db Hd P, !, param1-trivial-db-args Args PArgs. param1-trivial-db-args [] []. param1-trivial-db-args [T,P|Args] R :- std.assert-ok! (coq.typecheck T Ty) "param1-trivial-db: cannot work on illtyped term", if (coq.sort? Ty) (param1-trivial-db P Q, R = [T,P,Q|PArgs], param1-trivial-db-args Args PArgs) (R = [T,P|PArgs], param1-trivial-db-args Args PArgs). }}. (* standalone *) Elpi Command derive.param1.trivial. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param1.db. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate File param1_inhab. Elpi Accumulate File param1_trivial. Elpi Accumulate lp:{{ main [str I] :- coq.locate I IsGR, !, realiR T {coq.env.global IsGR}, coq.env.global GR T, derive.param1.inhab.main GR IsGR "_inhab" CL, CL =!=> derive.param1.trivial.main GR IsGR "_trivial" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.trivial ". }}. Elpi Command derive.param1.inhab. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param1.db. Elpi Accumulate File param1. Elpi Accumulate Db derive.param1.db. Elpi Accumulate Db derive.param1.congr.db. Elpi Accumulate Db derive.param1.trivial.db. Elpi Accumulate File param1_inhab. Elpi Accumulate lp:{{ main [str I] :- coq.locate I IsGR, !, realiR T {coq.env.global IsGR}, coq.env.global GR T, derive.param1.inhab.main GR IsGR "_inhab" _. main _ :- usage. usage :- coq.error "Usage: derive.param1.inhab ". }}. (* ad-hoc rules for primitive data, eq and is_true *) Module Export exports. Elpi derive.param1.trivial is_bool. End exports. Definition is_uint63_inhab x : is_uint63 x. Proof. constructor. Defined. Register is_uint63_inhab as elpi.derive.is_uint63_inhab. Definition is_float64_inhab x : is_float64 x. Proof. constructor. Defined. Register is_float64_inhab as elpi.derive.is_float64_inhab. Definition is_pstring_inhab s : is_pstring s. Proof. constructor. Defined. Register is_pstring_inhab as elpi.derive.is_pstring_inhab. Definition is_eq_inhab A (PA : A -> Type) (HA : trivial A PA) (x : A) (px: PA x) y (py : PA y) (eq_xy : x = y) : is_eq A PA x px y py eq_xy. Proof. revert py. case eq_xy; clear eq_xy y. intro py. rewrite <- (trivial_uniq A PA HA x px); clear px. rewrite <- (trivial_uniq A PA HA x py); clear py. apply (is_eq_refl A PA x (trivial_full A PA HA x)). Defined. Register is_eq_inhab as elpi.derive.is_eq_inhab. Definition is_true_inhab b (H : is_bool b) p : is_is_true b H p := is_eq_inhab bool is_bool is_bool_trivial b H true is_true p. Register is_true_inhab as elpi.derive.is_true_inhab. Elpi Accumulate derive.param1.trivial.db lp:{{ :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_uint63 }} {{ lib:elpi.derive.is_uint63_inhab }}. :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_float64 }} {{ lib:elpi.derive.is_float64_inhab }}. :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_pstring }} {{ lib:elpi.derive.is_pstring_inhab }}. :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_eq }} {{ lib:elpi.derive.is_eq_inhab }}. :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_true }} {{ lib:elpi.derive.is_true_inhab }}. :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_eq lp:A lp:PA lp:X lp:PX lp:Y lp:PY }} {{ lib:elpi.derive.is_eq_inhab lp:A lp:PA lp:QA lp:X lp:PX lp:Y lp:PY }} :- !, param1-trivial-db PA QA. :before "param1:inhab:start" param1-inhab-db {{ lib:elpi.derive.is_is_true lp:B lp:PB }} R :- !, param1-inhab-db {{ lib:elpi.derive.is_eq lib:elpi.bool lib:elpi.derive.is_bool lp:B lp:PB lib:elpi.true lib:elpi.derive.is_true }} R. }}. Definition is_uint63_trivial : trivial PrimInt63.int is_uint63 := fun x => contracts _ is_uint63 x (is_uint63_inhab x) (fun y => match y with uint63 i => eq_refl end). Register is_uint63_trivial as elpi.derive.is_uint63_trivial. Definition is_float64_trivial : trivial PrimFloat.float is_float64 := fun x => contracts _ is_float64 x (is_float64_inhab x) (fun y => match y with float64 i => eq_refl end). Register is_float64_trivial as elpi.derive.is_float64_trivial. Definition is_pstring_trivial : trivial lib:elpi.pstring is_pstring := fun x => contracts _ is_pstring x (is_pstring_inhab x) (fun y => match y with pstring i => eq_refl end). Register is_pstring_trivial as elpi.derive.is_pstring_trivial. Lemma is_eq_trivial A (PA : A -> Type) (HA : trivial A PA) (x : A) (px: PA x) y (py : PA y) : trivial (x = y) (is_eq A PA x px y py). Proof. intro p. apply (contracts (x = y) (is_eq A PA x px y py) p (is_eq_inhab A PA HA x px y py p)). revert py. case p; clear p y. rewrite <- (trivial_uniq _ _ HA x px). clear px. intros py. rewrite <- (trivial_uniq _ _ HA x py). clear py. intro v; case v; clear v. unfold is_eq_inhab. unfold trivial_full. unfold trivial_uniq. case (HA x); intros it def_it; compute. case (def_it it). reflexivity. Defined. Register is_eq_trivial as elpi.derive.is_eq_trivial. Definition is_true_trivial b (H : is_bool b) : trivial (lib:elpi.is_true b) (is_is_true b H) := is_eq_trivial bool is_bool is_bool_trivial b H true is_true. Register is_true_trivial as elpi.derive.is_true_trivial. Elpi Accumulate derive.param1.trivial.db lp:{{ :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_uint63 }} {{ lib:elpi.derive.is_uint63_trivial }}. :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_float64 }} {{ lib:elpi.derive.is_float64_trivial }}. :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_pstring }} {{ lib:elpi.derive.is_pstring_trivial }}. :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_eq }} {{ lib:elpi.derive.is_eq_trivial }}. :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_true }} {{ lib:elpi.derive.is_true_trivial }}. :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_eq lp:A lp:PA lp:X lp:PX lp:Y lp:PY }} {{ lib:elpi.derive.is_eq_trivial lp:A lp:PA lp:QA lp:X lp:PX lp:Y lp:PY }} :- param1-trivial-db PA QA. :before "param1:trivial:start" param1-trivial-db {{ lib:elpi.derive.is_is_true lp:B lp:PB }} R :- !, param1-trivial-db {{ lib:elpi.derive.is_eq lib:elpi.bool lib:elpi.derive.is_bool lp:B lp:PB lib:elpi.true lib:elpi.derive.is_true }} R. }}. (* hook into derive *) Elpi Accumulate derive Db derive.param1.trivial.db. Elpi Accumulate derive File param1_inhab. Elpi Accumulate derive File param1_trivial. #[phases="both"] Elpi Accumulate derive lp:{{ dep1 "param1_trivial" "param1_inhab". dep1 "param1_trivial" "param1_congr". dep1 "param1_inhab" "param1". }}. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "param1_inhab" (cl\ cl = []) true). derivation _ _ (derive "param1_trivial" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation T _ ff (derive "param1_inhab" (derive.on_param1 T derive.param1.inhab.main "_inhab") (derive.on_param1 T (_\T\_\_\param1-inhab-done T) _ _)). derivation T _ ff (derive "param1_trivial" (derive.on_param1 T derive.param1.trivial.main "_trivial") (derive.on_param1 T (_\T\_\_\param1-trivial-done T) _ _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/param2.v000066400000000000000000000066321523041753400234040ustar00rootroot00000000000000(* Binary parametricity translation. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "paramX_lib.elpi" as paramX. From elpi.apps.derive.elpi Extra Dependency "param2.elpi" as param2. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. (* To be removed *) Class param_db {X X1 XR : Type} (x : X) (x : X1) (xR : XR) := store_param {}. Class param {X : Type} {XR : X -> X -> Type} (x : X) (xR : XR x x) := Param {}. Register store_param as param2.store_param. (* Links a term (constant, inductive type, inductive constructor, record type, projection) with its parametricity translation *) Elpi Db derive.param2.db lp:{{ :index(3) % param (t : T) is a function that returns t' and tr such that tr : [| T |] t t' func param term -> term, term. % param.gref implements param for global references. % It is introduced to handle param on universe polymorphic definitions func param.gref gref -> gref, gref. % a database to store triples t, t', tr, such that tr : [| T |] t t'. type paramR term -> term -> term -> prop. pred param-done i:gref. }}. #[superglobal] Elpi Accumulate derive.param2.db lp:{{ % queries param.gref and lifts answer to terms. func dispatch-gref gref -> term,term. dispatch-gref GRT U TR :- param.gref GRT GRU GRR, coq.env.global GRU U, coq.env.global GRR TR. :name "param:gref" param T U TR :- coq.env.global GRT T, dispatch-gref GRT U TR, !. :name "paramR:gref" paramR T U TR :- coq.env.global GRT T, dispatch-gref GRT U TR, !. :name "param:fail" param X _ _ :- M is "derive.param2: No binary parametricity translation for " ^ {coq.term->string X}, stop M. :name "paramR:fail" paramR T T1 TR :- M is "derive.param2: No binary parametricity translation linking " ^ {coq.term->string T} ^ " and " ^ {coq.term->string T1} ^ " and " ^ {coq.term->string TR}, stop M. }}. Elpi Command derive.param2. Elpi Accumulate File derive_hook. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param2.db. Elpi Accumulate File param2. Elpi Accumulate Db derive.param2.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I GR, derive.param2.main GR "" _. main _ :- usage. usage :- coq.error "Usage: derive.param2 ". }}. Elpi Command derive.param2.register. Elpi Accumulate File paramX. Elpi Accumulate Db Header derive.param2.db. Elpi Accumulate File param2. Elpi Accumulate Db derive.param2.db. Elpi Accumulate lp:{{ main [str I, str R] :- !, coq.locate I GRI, coq.locate R GRR, derive.param2.main_register GRI GRR. main _ :- usage. usage :- coq.error "Usage: derive.param2.register ". }}. (* hook into derive *) Elpi Accumulate derive File paramX. Elpi Accumulate derive Db Header derive.param2.db. Elpi Accumulate derive File param2. Elpi Accumulate derive Db derive.param2.db. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "param2" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation T N ff (derive "param2" (derive.param2.main T N) (param-done T)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/projK.v000066400000000000000000000033471523041753400233070ustar00rootroot00000000000000(* Generates a projection for each argument of each constructor. The projection is expected to be applied to an explicit construcor and all its arguments. It is used to implement "injection". license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.derive.elpi Extra Dependency "projK.elpi" as projK. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. From elpi Require Import elpi. From elpi.apps Require Import derive. Elpi Db derive.projK.db lp:{{ func projK-db constructor -> int, term. }}. #[superglobal] Elpi Accumulate derive.projK.db lp:{{ :name "projK-db:fail" projK-db GR N _ :- M is "derive.projK: can't find the projection " ^ {std.any->string N} ^ " for constructor " ^ {std.any->string GR}, stop M. }}. Elpi Command derive.projK. Elpi Accumulate File derive_hook. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File projK. Elpi Accumulate lp:{{ main [str I, str O] :- !, coq.locate I (indt GR), derive.projK.main GR O _. main [str I] :- !, coq.locate I (indt GR), derive.projK.main GR "proj" _. main _ :- usage. usage :- coq.error "Usage: derive.projK []". }}. (* hook into derive *) Elpi Accumulate derive Db derive.projK.db. Elpi Accumulate derive File projK. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "projK" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "projK" (derive.projK.main T N) (derive.exists-indc T (K\ projK-db K _ _))) :- N is Prefix ^ "getk_". }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/std.v000066400000000000000000000015061523041753400230070ustar00rootroot00000000000000(* Standard set of derivations license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps Require Export derive. From elpi.apps Require Export derive.map derive.lens derive.lens_laws derive.param1 derive.param1_congr derive.param1_trivial derive.param1_functor derive.param2 derive.induction derive.tag derive.fields derive.eqb derive.eqbcorrect derive.eqbOK . (* we derive the Coq prelude *) Module Prelude. derive Init.Datatypes.Empty_set. derive Init.Datatypes.unit. derive Init.Datatypes.bool. derive Init.Datatypes.nat. derive Init.Datatypes.option. derive Init.Datatypes.sum. derive Init.Datatypes.prod. derive Init.Datatypes.list. derive Init.Datatypes.comparison. End Prelude. Export Prelude. LPCIC-coq-elpi-eb449d7/apps/derive/theories/derive/tag.v000066400000000000000000000025211523041753400227660ustar00rootroot00000000000000From elpi Require Import elpi. From elpi.apps Require Import derive. From Corelib Require Import PosDef. From elpi.apps.derive.elpi Extra Dependency "tag.elpi" as tag. From elpi.apps.derive.elpi Extra Dependency "derive_hook.elpi" as derive_hook. From elpi.apps.derive.elpi Extra Dependency "derive_synterp_hook.elpi" as derive_synterp_hook. Register positive as elpi.derive.positive. Local Open Scope positive_scope. Elpi Db derive.tag.db lp:{{ % this is how one registers the tag function to an inductive and let other % elpi commands use that piece of info pred tag-for o:inductive, o:constant. }}. (* standalone *) Elpi Command derive.tag. Elpi Accumulate Db Header derive.tag.db. Elpi Accumulate File derive_hook. Elpi Accumulate File tag. Elpi Accumulate Db derive.tag.db. Elpi Accumulate lp:{{ main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) Tname, Prefix is Tname ^ "_", derive.tag.main GR Prefix _. main _ :- usage. usage :- coq.error "Usage: derive.tag ". }}. (* hook into derive *) Elpi Accumulate derive Db derive.tag.db. Elpi Accumulate derive File tag. #[synterp] Elpi Accumulate derive lp:{{ derivation _ _ (derive "tag" (cl\ cl = []) true). }}. Elpi Accumulate derive lp:{{ derivation (indt T) Prefix ff (derive "tag" (derive.tag.main T Prefix) (tag-for T _)). }}. LPCIC-coq-elpi-eb449d7/apps/derive/theories/dune000066400000000000000000000001771523041753400214310ustar00rootroot00000000000000(coq.theory (name elpi.apps.derive) (package rocq-elpi) (theories elpi elpi.apps.derive.elpi)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/eltac/000077500000000000000000000000001523041753400165365ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/eltac/examples/000077500000000000000000000000001523041753400203545ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/eltac/examples/dune000066400000000000000000000001541523041753400212320ustar00rootroot00000000000000(coq.theory (name elpi.apps.eltac.examples) (theories elpi elpi.apps.eltac)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/eltac/examples/usage_eltac.v000066400000000000000000000004701523041753400230200ustar00rootroot00000000000000From elpi.apps Require Import derive. From elpi.apps Require Import eltac.tactics. derive nat. Lemma example : forall x y : nat, S x = S y -> 0 = 1 -> False. Proof. eltac.intro "x". eltac.intro "y". eltac.intro "I". eltac.intro "D". eltac.injection I. eltac.intro "E". eltac.clear E. eltac.discriminate D. Qed.LPCIC-coq-elpi-eb449d7/apps/eltac/tests-stdlib/000077500000000000000000000000001523041753400211575ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/eltac/tests-stdlib/dune000066400000000000000000000002311523041753400220310ustar00rootroot00000000000000(coq.theory (package rocq-elpi-tests-stdlib) (name elpi_apps_eltac_tests_stdlib) (theories elpi elpi.apps.eltac Stdlib)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/eltac/tests-stdlib/test_injection.v000066400000000000000000000017301523041753400243700ustar00rootroot00000000000000From elpi.apps Require Import eltac.injection. Set Implicit Arguments. Elpi derive.projK nat. Lemma test_nat (a b :nat) : S a = S b -> a = b. Proof. intro H. eltac.injection (H). intro E. assumption. Qed. From Stdlib Require Vector. From Corelib Require Import ssreflect. From Stdlib Require Import Arith. Elpi derive.projK Vector.t. Lemma test_vect A a b n (v1 v2 : Vector.t A n) : Vector.cons A a n v1 = Vector.cons A b n v2 -> a = b /\ v1 = v2. Proof. intro H. eltac.injection (H). move=> /= Eab _ Esigv12. split. exact Eab. rewrite -[v2](projT2_eq Esigv12) /=. by rewrite (UIP_nat _ _ (projT1_eq Esigv12) (eq_refl n)). Qed. Set Universe Polymorphism. Unset Universe Minimization ToSet. Module UnivPoly. Inductive List (A : Type) := Nil | Cons (a : A) (ls : List). Elpi derive.projK List. Goal forall (u1 u2 : unit), (Cons u1 (Nil _) = Cons u2 (Nil _)) -> u1 = u2. intros u1 u2 e. eltac.injection (e). Abort. End UnivPoly. Unset Universe Polymorphism. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/000077500000000000000000000000001523041753400177005ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/eltac/tests/dune000066400000000000000000000002041523041753400205520ustar00rootroot00000000000000(coq.theory (name elpi.apps.eltac.tests) (package rocq-elpi-tests) (theories elpi elpi.apps.eltac)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_apply.v000066400000000000000000000004101523041753400222460ustar00rootroot00000000000000From elpi.apps Require Import eltac.apply. Goal (forall (x y : nat), x + y = y + x) -> (forall y, 3 + y = y + 3). Proof. intro H. eltac.apply H. Qed. Axiom add_comm : forall x y, x + y = y + x. Goal (3 + 4 = 4 + 3). Proof. eltac.apply add_comm. Qed. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_assumption.v000066400000000000000000000003041523041753400233250ustar00rootroot00000000000000From elpi.apps Require Import eltac.assumption. Lemma test1 x (H : x = 0) : x = 0. Proof. eltac.assumption. Qed. Example test_assumption : True -> True. Proof. intro x. eltac.assumption. Qed. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_case.v000066400000000000000000000012661523041753400220460ustar00rootroot00000000000000From elpi.apps Require Import eltac.case. Lemma test1 (n : nat) : n = n. Proof. eltac.case n. exact (refl_equal 0). exact (refl_equal (S _)). Qed. Inductive is_even : nat -> Prop := | even0 : is_even 0 | evenS : forall x, is_even x -> is_even (S (S x)). Lemma test2 (n : nat) (H : is_even n) : n = n. Proof. eltac.case H. exact (refl_equal 0). exact (refl_equal (S (S _))). Qed. Axiom q : nat -> Prop. Axiom p0 : q 0. (* The last 0 must not be abstracted or the goal is illtyped *) Lemma test3 (H : is_even 0) : 0 = 0 /\ (@eq (q 0) p0 p0). Proof. eltac.case H. split. exact (refl_equal 0). exact (refl_equal p0). split; [ exact (refl_equal (S (S _))) | exact (refl_equal p0) ]. Qed. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_clear.v000066400000000000000000000005221523041753400222130ustar00rootroot00000000000000From elpi.apps Require Import eltac.clear. Example test_generalize_dependent x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) (w := 3): x + d + y = 2. Proof. generalize dependent x. Fail eltac.clear x. eltac.clear H2. Fail match goal with Hyp : y = 1 |- _ => idtac end. intros. eltac.clearbody d w. Fail unfold d. Check d. Abort. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_constructor.v000066400000000000000000000003741523041753400235170ustar00rootroot00000000000000From elpi.apps Require Import eltac.constructor. Lemma test1 : 1 = 1. Proof. eltac.constructor. Qed. Example test_constructor : Type -> True * Type. Proof. intro x. eltac.constructor. - eltac.constructor. - try eltac.constructor. assumption. Qed. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_cycle.v000066400000000000000000000004771523041753400222350ustar00rootroot00000000000000From elpi.apps Require Import eltac.cycle. Goal True /\ False /\ 1=1. split;[|split]. all: eltac.cycle 1. admit. reflexivity. exact I. Abort. Goal True /\ False /\ 1=1. split;[|split]. all: eltac.cycle -1. reflexivity. exact I. admit. Abort. Goal True /\ False /\ 1=1. split;[|split]. Fail all: eltac.cycle 3. Abort.LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_discriminate.v000066400000000000000000000017311523041753400236030ustar00rootroot00000000000000From elpi.apps Require Import eltac.discriminate. Set Implicit Arguments. Inductive foo (A : Type) | (B : Type) : nat -> Type := | K : foo B 0 | K1 : forall n, foo B n -> foo B (S n) | K2 : forall n, (A -> foo (B*B) n) -> foo B (n+n). Elpi derive.isK foo. (* Let's test a little that we are not too syntactic *) Definition AliasK2 A B n (f : A -> foo A (B*B) n) := K2 f. Definition AliasEQ := @eq. Example test_discriminate (k : foo nat nat 0) (f : nat -> foo nat (nat*nat) 1) : AliasEQ (AliasK2 f) (K1 (K1 k)) -> K nat nat = K nat nat -> { Type = Prop } + { True = False }. Proof. intros H F. Fail eltac.discriminate (F). eltac.discriminate (H). Qed. Set Universe Polymorphism. Inductive Bool := TT | FF. Elpi derive.isK Bool. Goal (TT = FF) -> False. intros p. eltac.discriminate (p). Abort. Inductive Nat := O' | S' : Nat -> Nat. Elpi derive.isK Nat. Goal forall (n : Nat), (S' n = O') -> False. intros n p. eltac.discriminate (p). Abort. Unset Universe Polymorphism.LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_fail.v000066400000000000000000000001531523041753400220400ustar00rootroot00000000000000From elpi.apps Require Import eltac.fail. Goal False. try (eltac.fail 0). Fail try (eltac.fail 1). Abort. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_generalize.v000066400000000000000000000003101523041753400232450ustar00rootroot00000000000000From elpi.apps Require Import eltac.generalize. Example test_generalize x y (H : x = y) (H1 : 0 <= x) (d := x + 1) (H2 : y = 1) : x + d + y = 2. Proof. eltac.generalize (x). intros x0 T0 T1. Abort. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_intro.v000066400000000000000000000002631523041753400222620ustar00rootroot00000000000000From elpi.apps Require Import eltac.intro. Lemma test1 : forall x, x = 1. Proof. eltac.intro "a". Abort. Example test_intro : True -> True. Proof. eltac.intro x. exact x. Qed. LPCIC-coq-elpi-eb449d7/apps/eltac/tests/test_rewrite.v000066400000000000000000000022711523041753400226110ustar00rootroot00000000000000From elpi.apps Require Import eltac.rewrite. Axiom add_comm : forall x y, x + y = y + x. Axiom mul_comm : forall x y, x * y = y * x. Goal (forall x : nat, 1 + x = x + 1) -> forall y, 2 * ((y+y) + 1) = ((y + y)+1) * 2. Proof. intro H. intro x. eltac.rewrite H. eltac.rewrite mul_comm. exact eq_refl. Defined. Section Example_rewrite. Variable A : Type. Variable B : A -> Type. Variable C : forall (a : A) (b : B a), Type. Variable add : forall {a : A} {b : B a}, C a b -> C a b -> C a b. Variable sym : forall {a : A} {b : B a} (c c' : C a b), add c c' = add c' c. Goal forall (a : A) (b : B a) (x y : C a b), add x y = add y x /\ add x y = add y x. Proof. intros a b x y. eltac.rewrite @sym. (* @sym is a gref *) (** [add y x = add y x /\ add y x = add y x] *) easy. Defined. Goal forall (a : A) (b : B a) (x y : C a b), add x y = add y x /\ add x y = add y x. Proof. intros a b x y. eltac.rewrite sym. (* because of implicit arguments, this is sym _ _, which is a term *) easy. Defined. Goal forall n, 2 * n = n * 2. Proof. intro n. Fail eltac.rewrite add_comm. eltac.rewrite add_comm "strong". Abort. End Example_rewrite. LPCIC-coq-elpi-eb449d7/apps/eltac/theories/000077500000000000000000000000001523041753400203605ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/eltac/theories/apply.v000066400000000000000000000011121523041753400216670ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic apply. Elpi Accumulate lp:{{ pred apply i:term, i:term, o:goal, o:list sealed-goal. apply T _ G GL :- refine T G GL, !. apply Term Ty G GL :- whd Ty [] (prod _ _ B) [], apply {coq.mk-app Term [Hole]} (B Hole) G GL. apply _ _ _ _ :- coq.ltac.fail _ "Couldn't unify type of term with goal". solve (goal Ctx _ _ _ [trm T] as G) GL :- std.assert-ok! (coq.typecheck T Ty) "Illtyped argument", apply T Ty G GL. }}. Tactic Notation "eltac.apply" constr(T) := elpi apply ltac_term:(T).LPCIC-coq-elpi-eb449d7/apps/eltac/theories/assumption.v000066400000000000000000000004631523041753400227540ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic assumption. Elpi Accumulate lp:{{ solve (goal Ctx Ev _ _ _) [] :- std.exists Ctx (x\ x = decl Ev _ _ ; x = def Ev _ _ _). solve _ _ :- coq.ltac.fail _ "No assumption unifies with the goal". }}. Tactic Notation "eltac.assumption" := elpi assumption. LPCIC-coq-elpi-eb449d7/apps/eltac/theories/case.v000066400000000000000000000022171523041753400214640ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic case. Elpi Accumulate lp:{{ pred mk-abstracted-goal i:list term, i:term, i:term, i:list term, i:list term, o:term. mk-abstracted-goal ToAbstract Goal _IndSort Vars _VarsTys Out :- std.map2 ToAbstract Vars (t\v\r\ r = copy t v) Subst, % Non deterministically we abstract until we obtain a well typed term (Subst ==> copy Goal Out), coq.say "trying" {coq.term->string Out}, coq.typecheck Out _ ok. pred mk-empty-branches i:term, i:term, i:list term, i:list term, o:term. mk-empty-branches _K _KTy _Vars _VarsTys HOLE_. solve (goal _ _ GTy _ [trm T] as G) NG :- !, std.do! [ std.assert-ok! (coq.typecheck T Ty) "input term illtyped", std.assert! (coq.safe-dest-app Ty (global (indt I)) Args) "the type is not inductive", coq.env.indt I _ ParamsNo _ _ _ _, std.drop ParamsNo Args Idxs, std.append Idxs [T] ToAbstract, coq.build-match T Ty (mk-abstracted-goal ToAbstract GTy) mk-empty-branches M, refine M G NG ]. solve _ _ :- usage. usage :- coq.error "Usage: eltac.case ". }}. Tactic Notation "eltac.case" constr(T) := elpi case ltac_term:(T). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/clear.v000066400000000000000000000035611523041753400216420ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic clear. Elpi Accumulate lp:{{ pred not-hyp i:term, i:prop, o:term. not-hyp X (decl Y _ Ty) Y :- not (occurs X Ty), not (X = Y). not-hyp X (def Y _ Ty Bo) Y :- not (occurs X Ty ; occurs X Bo), not (X = Y). solve (goal Ctx R T E [trm X]) [seal (goal Ctx R T E [])] :- name X, !, std.do! [ std.map-filter Ctx (not-hyp X) VisibleRev, prune E1 {std.rev VisibleRev}, % preserve the order std.assert-ok! (coq.typecheck E1 T) "cannot clear", E = E1 ]. solve (goal _ _ _ _ Args) _ :- coq.error "clear expects 1 name, you passed:" Args. }}. Tactic Notation "eltac.clear" hyp(V) := elpi clear ltac_term:(V). Elpi Tactic clearbody. Elpi Accumulate lp:{{ pred drop-body i:list argument, i:prop, o:prop. drop-body ToBeCleared (def V Name Ty _Bo) (decl V Name Ty) :- std.mem ToBeCleared (trm V), !. drop-body _ (decl _ _ _ as X) X. drop-body _ (def _ _ _ _ as X) X. msolve [nabla G] [nabla G1] :- pi x\ msolve [G x] [G1 x]. msolve [seal (goal Ctx _ T E ToBeCleared)] [seal (goal Ctx1 _ T E1 [])] :- std.map Ctx (drop-body ToBeCleared) Ctx1, (@ltacfail! 0 ==> % this failure can be catch by ltac Ctx1 ==> % in the new context, do... std.assert-ok! (coq.typecheck-ty T _) "cannot clear since the goal does not typecheck in the new context"), (Ctx1 ==> std.assert-ok! (coq.typecheck E1 T) "should not happen"), % E1 see all the proof variables (the pi x in the nabla case) and T is OK in Ctx1 E = {{ lp:E1 : lp:T }}. % we make progress by saying that the old goal/evar is solved by the new one (which has the same type thanks to the line above) % note that E = E1 would be "unstable" since elpi could decide to % actually do E1 := E, while E = (let `x` T E1 x\x) forces elpi % to go the other way around }}. Tactic Notation "eltac.clearbody" hyp_list(V) := elpi clearbody ltac_term_list:(V). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/constructor.v000066400000000000000000000010001523041753400231230ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic constructor. Elpi Accumulate lp:{{ solve (goal _ _ Ty _ _ as G) GS :- std.do! [ @ltacfail! _ => std.assert! (whd Ty [] (global (indt GR)) _) "The goal is not an inductive type", coq.env.indt GR _ _ _ _ Ks Kt, std.exists2 Ks Kt (k\ t\ sigma P\ coq.saturate t (global (indc k)) P, refine P G GS) ]. solve _ _ :- coq.error "eltac.constructor: this should never happen". }}. Tactic Notation "eltac.constructor" := elpi constructor. LPCIC-coq-elpi-eb449d7/apps/eltac/theories/cycle.v000066400000000000000000000012301523041753400216420ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic cycle. Elpi Accumulate lp:{{ pred read-arg i:sealed-goal, o:list argument. read-arg (nabla G) X :- pi x\ read-arg (G x) X. read-arg (seal (goal _ _ _ _ A)) A. pred cycle i:int, i:list sealed-goal, o:list sealed-goal. cycle N L PL :- N > 0, std.length L M, std.assert! (N < M) "not enough goals", std.split-at N L B A, std.append A B PL. cycle N L PL :- N < 0, std.length L M, N' is M + N, cycle N' L PL. msolve GL GS :- GL = [G|_], read-arg G [int N], if (N = 0) (GS = GL) (cycle N GL GS). }}. Tactic Notation "eltac.cycle" int(n) := elpi cycle ltac_int:(n). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/discriminate.v000066400000000000000000000011301523041753400232150ustar00rootroot00000000000000From elpi.apps.derive.elpi Extra Dependency "discriminate.elpi" as discriminate. From elpi.apps Require Export derive.isK derive.bcongr derive.eqK. (** A tactic proving the current goal out of a false equation *) Elpi Tactic discriminate. Elpi Accumulate Db derive.isK.db. Elpi Accumulate File discriminate. Elpi Accumulate lp:{{ solve (goal _ Ev Ty _ [trm E] ) [] :- !, of E Eq ER, !, ltac.discriminate ER Eq Ty Ev. solve _ _ :- usage. usage :- coq.error "Usage: eltac.discriminate ". }}. Tactic Notation "eltac.discriminate" constr(T) := elpi discriminate ltac_term:(T). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/dune000066400000000000000000000001711523041753400212350ustar00rootroot00000000000000(coq.theory (name elpi.apps.eltac) (package rocq-elpi) (theories elpi elpi.apps.derive)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/eltac/theories/fail.v000066400000000000000000000004401523041753400214600ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic fail. Elpi Accumulate lp:{{ solve (goal _ _ _ _ [int N]) _ :- coq.ltac.fail N. solve (goal _ _ _ _ Args) _ :- coq.error "eltac.fail expects 1 integer, you passed:" Args. }}. Tactic Notation "eltac.fail" int(n) := elpi fail ltac_int:(n). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/generalize.v000066400000000000000000000010751523041753400226770ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic generalize. Elpi Accumulate lp:{{ pred occurs-hyp i:term, i:prop, o:term. occurs-hyp X (decl Y _ Ty) Y :- occurs X Ty. occurs-hyp X (def Y _ Ty Bo) Y :- occurs X Ty ; occurs X Bo. solve (goal Ctx _ _ _ [trm X] as G) GS :- name X, !, std.do! [ std.map-filter Ctx (occurs-hyp X) Generalize, refine (app[NEW_,X|Generalize]) G GS, ]. solve (goal _ _ _ _ Args) _ :- coq.error "eltac.generalize expects 1 name, you passed:" Args. }}. Tactic Notation "eltac.generalize" constr(V) := elpi generalize ltac_term:(V). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/injection.v000066400000000000000000000012231523041753400225270ustar00rootroot00000000000000From elpi.apps.derive.elpi Extra Dependency "injection.elpi" as injection. From elpi.apps Require Export derive.projK derive.bcongr. (** A tactic pushing an equation under a constructor *) Elpi Tactic injection. Elpi Accumulate Db derive.projK.db. Elpi Accumulate File injection. Elpi Accumulate lp:{{ solve (goal _ _ _ _ [trm E] as G) NG :- !, of E Eq ER, !, ltac.injection ER Eq _ P, if (P = []) (coq.error "Could not generate new equations") (refine (app[New_|P]) G NG). solve _ _ :- usage. usage :- coq.error "Usage: eltac.injection ". }}. Tactic Notation "eltac.injection" constr(T) := elpi injection ltac_term:(T). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/intro.v000066400000000000000000000007111523041753400217010ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic intro. Elpi Accumulate lp:{{ solve (goal _ _ _ _ [str ID] as G) GS :- !, std.assert! (coq.ltac.id-free? ID G) "name already taken", coq.id->name ID N, refine (fun N _ _) G GS. solve _ _ :- usage. usage :- coq.error "Usage: eltac.intro". }}. Tactic Notation "eltac.intro" string(ID) := elpi intro ltac_string:(ID). Tactic Notation "eltac.intro" ident(ID) := elpi intro ltac_string:(ID). LPCIC-coq-elpi-eb449d7/apps/eltac/theories/rewrite.v000066400000000000000000000041011523041753400222240ustar00rootroot00000000000000From elpi Require Export elpi. Elpi Tactic rewrite. Elpi Accumulate lp:{{ % Second argument is a type of the form forall x1 x2 x3... P = Q. % First argument is a term of that type. % This tactic finds a subterm of the goal that Q unifies with % and rewrites all instances of that subterm from right to left. pred rewrite i:list argument, i:term, i:term, o:goal, o:list sealed-goal. % The copy predicate used below is discussed in the tutorial here: % https://lpcic.github.io/coq-elpi/tutorial_coq_elpi_tactic.html#let-s-code-set-in-elpi rewrite Strong Eqpf {{@eq lp:S lp:P lp:Q }} (goal _ _ GoalType _ _ as G) GL :- % First, introduce a rule that causes "copy" to act as a function % sending a type T to the same type, but with all % subterms of T unifiable with Q to be replaced with a fresh constant x. pi x\ (pi J\ copy J x :- Strong = [str "strong"| _], coq.unify-leq Q J ok, !) => (pi J\ copy J x :- [] = Strong, Q = J, !) => % Apply this copy function to the goal type. (copy GoalType (A x), % If the subterm Q did indeed appear in the goal, % then pattern match on the given equality assumption P = Q, % causing Q to be replaced with P everywhere. if (occurs x (A x)) (refine (match Eqpf {{ fun a (e : @eq lp:S lp:P a) => lp:(A a) }} % We only want to create one hole, % the one corresponding to the % contents of the (single) branch of the match. [Hole_]) G GL ) (coq.ltac.fail _ "Couldn't unify")). solve (goal _ _ _ _ [trm Eq | Strong] as G) GL :- coq.typecheck Eq Ty ok, coq.saturate Ty Eq Eq', coq.typecheck Eq' Ty' ok, rewrite Strong Eq' Ty' G GL. }}. Tactic Notation "eltac.rewrite" ident(T) := elpi rewrite ltac_term:(T). Tactic Notation "eltac.rewrite" uconstr(T) := elpi rewrite ltac_term:(T). Tactic Notation "eltac.rewrite" uconstr(T) string(s) := elpi rewrite ltac_term:(T) ltac_string:(s).LPCIC-coq-elpi-eb449d7/apps/eltac/theories/tactics.v000066400000000000000000000002401523041753400221750ustar00rootroot00000000000000From elpi.apps.eltac Require Export apply intro rewrite constructor assumption discriminate injection case generalize fail clear cycle .LPCIC-coq-elpi-eb449d7/apps/json/000077500000000000000000000000001523041753400164175ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/json/README.md000066400000000000000000000017001523041753400176740ustar00rootroot00000000000000Binding to Yojson ================= This Rocq-Elpi plugin gives access to json files. ```bash opam install rocq-elpi-json # pulls in yojson ``` Then you can access the APIs in [doc/json.elpi](doc/json.elpi) this way: ```coq From elpi Require Import elpi json. From elpi.json.tests Extra Dependency "test.json" as json_test_file. Elpi Command hello_json. Elpi Accumulate Plugin "json.elpi". Elpi Accumulate lp:{{ main [str D] :- std.assert-ok! (coq.extra-dep->json D J) "bad file", coq.say "json AST:" J, coq.json->string J S, coq.say "pretty:" S, coq.string->json S J', coq.say "json AST:" J', std.assert! (J = J') "this would be bad". }}. Elpi Export hello_json. hello_json "json_test_file". ``` Note: At the time of writing `rocq_makefile` fully supports this directive and considers `` as a dependency of the `.v` file. Dune does not yet support this. For a workaround see the [tests/](tests-plugin/) directory. LPCIC-coq-elpi-eb449d7/apps/json/doc/000077500000000000000000000000001523041753400171645ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/json/doc/dune000066400000000000000000000003451523041753400200440ustar00rootroot00000000000000(executable (name gen_doc) (libraries elpi_json_plugin)) (rule (targets json.elpi) (deps gen_doc.exe) (mode promote) (action (run ./gen_doc.exe))) (install (files json.elpi) (section doc) (package rocq-elpi-json)) LPCIC-coq-elpi-eb449d7/apps/json/doc/gen_doc.ml000066400000000000000000000001601523041753400211110ustar00rootroot00000000000000 let _ = Elpi.API.BuiltIn.document_file ~header:"% Generated" Elpi_json_plugin.Rocq_elpi_json_plugin.builtins LPCIC-coq-elpi-eb449d7/apps/json/doc/json.elpi000066400000000000000000000042261523041753400210140ustar00rootroot00000000000000 % Yojson bindings for Elpi % license: GNU Lesser General Public License Version 2.1 or later % ------------------------------------------------------------------------ % This code is not Rocq specific, i.e. could go to an Elpi specific % package. % Yojson.Basic.t kind json type. external symbol json.null : json = "1". external symbol json.bool : bool -> json = "1". external symbol json.int : int -> json = "1". external symbol json.float : float -> json = "1". external symbol json.string : string -> json = "1". external symbol json.assoc : list (pair string json) -> json = "1". % key value pairs. When generated from built-in predicates, keys are sorted external symbol json.list : list json -> json = "1". % [json.from_file File J D] like Yojson.Basic.from_file reads J from File. % If D is error then J is not assigned. external func json.from_file string -> json, diagnostic. % [json.from_string String J D] like Yojson.Basic.from_string reads J from % String. % If D is error then J is not assigned. external func json.from_string string -> json, diagnostic. % [json.to_file File J D] like Yojson.Basic.to_file write J to File. external func json.to_file string, json -> diagnostic. % [json.to_string J S D] like Yojson.Basic.to_string write J to a compact % string S. external func json.to_string json -> string, diagnostic. % [json.pretty_to_string J S D] like Yojson.Basic.pretty_to_string write J % to a nice string S. external func json.pretty_to_string json -> string, diagnostic. % ------------------------------------------------------------------------ % Rocq-Elpi APIs % ------------------------------------------------------------------------ func coq.json->string json -> string. coq.json->string J S :- json.pretty_to_string J S ok. func coq.string->json string -> json. coq.string->json S J :- json.from_string S J ok. % [coq.extra-dep->json Dep J D] reads a json file declared as an extra % dependency, see the coq.extra-dep API. func coq.extra-dep->json string -> json, diagnostic. coq.extra-dep->json S J D :- coq.extra-dep S (some P), !, json.from_file P J D. coq.extra-dep->json S _ (error Msg) :- Msg is "unknown Extra Dependency " ^ S. LPCIC-coq-elpi-eb449d7/apps/json/examples/000077500000000000000000000000001523041753400202355ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/json/examples/dune000066400000000000000000000001601523041753400211100ustar00rootroot00000000000000(coq.theory (name elpi.json.examples) (theories elpi elpi.json elpi.json.tests)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/json/examples/usage_json.v000066400000000000000000000007661523041753400225720ustar00rootroot00000000000000From elpi Require Import elpi json. From elpi.json.tests Extra Dependency "test.json" as json_test_file. Elpi Command hello_json. Elpi Accumulate Plugin "json.elpi". Elpi Accumulate lp:{{ main [str D] :- std.assert-ok! (coq.extra-dep->json D J) "bad file", coq.say "json AST:" J, coq.json->string J S, coq.say "pretty:" S, coq.string->json S J', coq.say "json AST:" J', std.assert! (J = J') "this would be bad". }}. Elpi Export hello_json. hello_json "json_test_file". LPCIC-coq-elpi-eb449d7/apps/json/src/000077500000000000000000000000001523041753400172065ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/json/src/dune000066400000000000000000000005001523041753400200570ustar00rootroot00000000000000(library (name elpi_json_plugin) (public_name rocq-elpi-json.elpi_json_plugin) (flags :standard -w -27) (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) (libraries rocq-runtime.plugins.ltac rocq-runtime.vernac rocq-elpi.elpi elpi yojson)) LPCIC-coq-elpi-eb449d7/apps/json/src/elpi_json_plugin.mlpack000066400000000000000000000000261523041753400237350ustar00rootroot00000000000000Rocq_elpi_json_plugin LPCIC-coq-elpi-eb449d7/apps/json/src/rocq_elpi_json_plugin.ml000066400000000000000000000117631523041753400241340ustar00rootroot00000000000000open Elpi.API (* todo, move this in Elpi, there are already two copies of this code in rocq-elpi *) let listC (d : ('a,'h,'cst) ContextualConversion.t) = let embed ~depth h cst s l = let s, l, eg = Utils.map_acc (d.ContextualConversion.embed ~depth h cst ) s l in s, Utils.list_to_lp_list l, eg in let readback ~depth h cst s t = Utils.map_acc (d.ContextualConversion.readback ~depth h cst) s (Utils.lp_list_to_list ~depth t) in let pp fmt l = Format.fprintf fmt "[%a]" (RawPp.list d.ContextualConversion.pp ~boxed:true "; ") l in { ContextualConversion.embed; readback; ty = TyApp ("list",d.ContextualConversion.ty,[]); pp; pp_doc = (fun fmt () -> ()) } let pairC = ContextualConversion.(!>>> ) Elpi.Builtin.pair let stringC = ContextualConversion.(!> ) BuiltInData.string let json : Yojson.Basic.t Conversion.t = AlgebraicData.(declare { ty = Conversion.TyName "json"; doc = "Yojson.Basic.t"; pp = Yojson.Basic.pp; constructors = [ K("json.null","",N,B `Null,M (fun ~ok ~ko -> function `Null -> ok | _ -> ko ())); K("json.bool","",A(Elpi.Builtin.bool,N),B (function x -> `Bool x),M (fun ~ok ~ko -> function `Bool x -> ok x | _ -> ko ())); K("json.int","",A(BuiltInData.int,N),B (function x -> `Int x),M (fun ~ok ~ko -> function `Int x -> ok x | _ -> ko ())); K("json.float","",A(BuiltInData.float,N),B (function x -> `Float x),M (fun ~ok ~ko -> function `Float x -> ok x | _ -> ko ())); K("json.string","",A(BuiltInData.string,N),B (function x -> `String x),M (fun ~ok ~ko -> function `String x -> ok x | _ -> ko ())); K("json.assoc","key value pairs. When generated from built-in predicates, keys are sorted",C((fun x -> listC (pairC stringC x)),N), B (function x -> `Assoc x), M (fun ~ok ~ko -> function `Assoc x -> let sx = List.stable_sort (fun (x,_) (y,_) -> String.compare x y) x in ok sx | _ -> ko ())); K("json.list","",C(listC,N),B (function x -> `List x),M (fun ~ok ~ko -> function `List x -> ok x | _ -> ko ())); ]; } ) |> ContextualConversion.(!<) open BuiltIn open BuiltInPredicate open BuiltInPredicate.Notation open BuiltInData open Elpi.Builtin let json_from_file = MLCode(Pred("json.from_file", In(string,"File", Out(json,"J", Out(diagnostic,"D", Easy {|like Yojson.Basic.from_file reads J from File. If D is error then J is not assigned.|}))), (fun f _ _ ~depth -> try !: (Yojson.Basic.from_file ~fname:f f) +! mkOK with Yojson.Json_error s | Sys_error s -> ?: None +! (mkERROR s) )),DocAbove) let json_from_string = MLCode(Pred("json.from_string", In(string,"String", Out(json,"J", Out(diagnostic,"D", Easy {|like Yojson.Basic.from_string reads J from String. If D is error then J is not assigned.|}))), (fun f _ _ ~depth -> try !: (Yojson.Basic.from_string f) +! mkOK with Yojson.Json_error s -> ?: None +! (mkERROR s) )),DocAbove) let json_to_file = MLCode(Pred("json.to_file", In(string,"File", In(json,"J", Out(diagnostic,"D", Easy {|like Yojson.Basic.to_file write J to File.|}))), (fun f j _ ~depth -> try Yojson.Basic.to_file f j; !: mkOK with Yojson.Json_error s | Sys_error s -> !: (mkERROR s) )),DocAbove) let json_to_string = MLCode(Pred("json.to_string", In(json,"J", Out(string,"S", Out(diagnostic,"D", Easy {|like Yojson.Basic.to_string write J to a compact string S.|}))), (fun j _ _ ~depth -> try !: (Yojson.Basic.to_string ~std:true j) +! mkOK with Yojson.Json_error s -> ?: None +! (mkERROR s) )),DocAbove) let json_to_string_pretty = MLCode(Pred("json.pretty_to_string", In(json,"J", Out(string,"S", Out(diagnostic,"D", Easy {|like Yojson.Basic.pretty_to_string write J to a nice string S.|}))), (fun j _ _ ~depth -> try !: (Yojson.Basic.pretty_to_string ~std:true j) +! mkOK with Yojson.Json_error s -> ?: None +! (mkERROR s) )),DocAbove) let builtins = declare ~file_name:"json.elpi" [ LPDoc {|Yojson bindings for Elpi|}; LPDoc {|license: GNU Lesser General Public License Version 2.1 or later|}; LPDoc {|------------------------------------------------------------------------|}; LPDoc {|This code is not Rocq specific, i.e. could go to an Elpi specific package.|}; MLData json; json_from_file; json_from_string; json_to_file; json_to_string; json_to_string_pretty; LPDoc {|------------------------------------------------------------------------|}; LPDoc {|Rocq-Elpi APIs|}; LPDoc {|------------------------------------------------------------------------|}; LPCode {| func coq.json->string json -> string. coq.json->string J S :- json.pretty_to_string J S ok. func coq.string->json string -> json. coq.string->json S J :- json.from_string S J ok. % [coq.extra-dep->json Dep J D] reads a json file declared as an extra % dependency, see the coq.extra-dep API. func coq.extra-dep->json string -> json, diagnostic. coq.extra-dep->json S J D :- coq.extra-dep S (some P), !, json.from_file P J D. coq.extra-dep->json S _ (error Msg) :- Msg is "unknown Extra Dependency " ^ S. |} ] LPCIC-coq-elpi-eb449d7/apps/json/tests-plugin/000077500000000000000000000000001523041753400210555ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/json/tests-plugin/dune000066400000000000000000000005561523041753400217410ustar00rootroot00000000000000(coq.theory (name elpi.json.tests) (package rocq-elpi-json-tests) (theories elpi elpi.json)) ; work around missing dune support for Extra Dependency ; https://github.com/ocaml/dune/pull/9591 (rule (target dummy.v) (deps (glob_files *.json)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (include_subdirs qualified)LPCIC-coq-elpi-eb449d7/apps/json/tests-plugin/test.json000066400000000000000000000007131523041753400227300ustar00rootroot00000000000000{ "first_name": "John", "last_name": "Smith", "is_alive": true, "age": 27, "address": { "street_address": "21 2nd Street", "city": "New York", "state": "NY", "postal_code": "10021-3100" }, "phone_numbers": [ { "type": "home", "number": "212 555-1234" }, { "type": "office", "number": "646 555-4567" } ], "children": [ "Catherine", "Thomas", "Trevor" ], "spouse": null }LPCIC-coq-elpi-eb449d7/apps/json/tests-plugin/test.v000066400000000000000000000012551523041753400222260ustar00rootroot00000000000000 From elpi Require Import elpi json. From elpi Require json.tests.dummy. (* work around missing dune support for Extra Dependency *) Elpi Command test. Elpi Accumulate Plugin "json.elpi". Fail Elpi Query lp:{{ std.assert-ok! (json.from_file "foo.json" X) "json" }}. From elpi.json.tests Extra Dependency "test.json" as json_test_file. Elpi Query lp:{{ coq.extra-dep "json_test_file" (some Path), std.assert-ok! (json.from_file Path X) "json", coq.say X, std.assert! ( X = json.assoc [pr "address" A| _]) "json", std.assert! ( A = json.assoc [pr "city" (json.string "New York")| _]) "json", Path1 is Path ^ ".out", std.assert-ok! (json.to_file Path1 X) "json" }}. LPCIC-coq-elpi-eb449d7/apps/json/theories/000077500000000000000000000000001523041753400202415ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/json/theories/dune000066400000000000000000000002341523041753400211160ustar00rootroot00000000000000(coq.theory (name elpi.json) (theories elpi_elpi elpi) (plugins rocq-elpi-json.elpi_json_plugin) (package rocq-elpi-json)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/json/theories/json.v000066400000000000000000000001251523041753400213770ustar00rootroot00000000000000Declare ML Module "rocq-elpi-json.elpi_json_plugin". From elpi Require Import elpi. LPCIC-coq-elpi-eb449d7/apps/locker/000077500000000000000000000000001523041753400167255ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/locker/README.md000066400000000000000000000027751523041753400202170ustar00rootroot00000000000000# Locker The `lock` and `mlock` commands let you lock definitions. ## Example of `lock` ```coq lock Definition x := 3. ``` is elaborated to ```coq Lemma x_key_subproof : unit. Proof. exact: tt. Qed. Definition x := locked_with x_key_subproof 3. Canonical x_unlock_subterm := Unlockable ... ``` Here `locked_with` comes from `ssreflect.v` and protects the body of `x` under a match on `x_key_subproof` which is `Qed` opaque. Hence `x` is provably equal to 3, but not computationally equal to it. Given the canonical structure registration, `rewrite unlock` will replace `x` by `3`. ## Example of `mlock` ```coq mlock Definition x := 3. ``` is elaborated to ```coq Module Type x_Locked. Axiom body : nat. Axiom unlock : body = 3. End x_Locked. Module x : x_Locked. ... End x. Notation x := x.body. Canonical x_unlock_subterm := Unlockable x.unlock. ``` Hence `x` (actually `x.body`) is a new symbol and `x.unlock` is its defining equation. Given the canonical structure registration, `rewrite unlock` will replace `x` by `3`. ## Limitations `mlock` uses a module based locking. The body is really sealed but this command cannot be used inside sections (since modules cannot be declared inside sections). `lock` uses opaque key based locking. It can be used everywhere, even inside sections, but conversion (term comparison) may cross the lock (by congruence) and hence compare possibly large terms. See also the section about locking in [ssereflect.v](https://github.com/coq/coq/blob/master/theories/ssr/ssreflect.v). LPCIC-coq-elpi-eb449d7/apps/locker/elpi/000077500000000000000000000000001523041753400176565ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/locker/elpi/dune000066400000000000000000000005511523041753400205350ustar00rootroot00000000000000(coq.theory (name elpi.apps.locker.elpi) (package rocq-elpi) (theories elpi)) (rule (target dummy.v) (deps (glob_files *.elpi)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (install (files (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/locker/elpi/))) (section lib_root) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/apps/locker/elpi/locker.elpi000066400000000000000000000113541523041753400220140ustar00rootroot00000000000000/* Locker */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace locker { func key-lock id, term, arity, option upoly-decl ->. key-lock ID Bo Arity UnivDecl :- std.do! [ make-key ID Key, coq.arity->term Arity Ty, Def = {{ @locked_with lp:Key lp:Ty lp:Bo }}, std.assert-ok! (coq.typecheck Def _) "locker: illtyped definition", if (UnivDecl = some UD) (coq.upoly-decl->attribute UD Poly!) (Poly! = true), Poly! => coq.env.add-const ID Def Ty @transparent! C, coq.arity->implicits Arity CImpls, if (coq.any-implicit? CImpls) (@global! => coq.arguments.set-implicit (const C) [CImpls]) true, make-key-unlockable ID Def Ty {coq.env.global (const C)} Key, ]. func make-key id -> term. make-key ID (global (const C)) :- std.do! [ if (get-option "key" KID) true (KID is ID ^ "_key_subproof"), coq.env.add-const KID {{ tt }} {{ unit }} @opaque! C, ]. % ------------------------------------------------------------------------- func module-lock id, term, arity, option upoly-decl ->. module-lock ID Bo Arity UnivDecl :- std.do! [ coq.arity->term Arity Ty, std.assert-ok! (coq.typecheck-ty Ty _) "locker: definition type illtyped", std.assert-ok! (coq.typecheck Bo Ty) "locker: definition body illtyped", % we craft all constants now since we need to put *in the interface* the % extra universe constraints (if upoly) which are necessary for the body! if (UnivDecl = some UD) (std.do![ PTY = {{ @eq lp:Ty lp:Bo lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "lock: unlock statement illtyped", P = {{ @refl_equal lp:Ty lp:Bo }}, std.assert-ok! (coq.typecheck P PTY) "locker: unlock proof illtyped", coq.upoly-decl.complete-constraints UD UD1, UnivDecl1 = some UD1]) (UnivDecl1 = none), lock-module-type ID Ty Bo UnivDecl1 Signature, lock-module-body Signature ID Ty Bo UnivDecl1 Symbol Module, @global! => coq.notation.add-abbreviation ID 0 Symbol ff _, coq.arity->implicits Arity CImpls, if (coq.any-implicit? CImpls) (Symbol = global GR, @global! => coq.arguments.set-implicit GR [CImpls]) true, make-module-unlockable ID Module, ]. func lock-module-type id, term, term, option upoly-decl -> modtypath. lock-module-type ID Ty Bo UnivDecl M :- std.do! [ Module is ID ^ "_Locked", coq.env.begin-module-type Module, if (UnivDecl = some UD) (coq.upoly-decl->attribute UD Poly!) (Poly! = true), Poly! => coq.env.add-axiom "body" Ty C, coq.env.global (const C) B, PTY = {{ lp:B = lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "lock: unlock statement illtyped", if (UnivDecl = some UD) (coq.upoly-decl.complete-constraints UD UD1, coq.upoly-decl->attribute UD1 Poly1!) (Poly1! = true), Poly1! => coq.env.add-axiom "unlock" PTY _, coq.env.end-module-type M, ]. :functional pred lock-module-body o:modtypath, i:id, i:term, i:term, i:option upoly-decl, o:term, o:modpath. lock-module-body Signature ID Ty Bo UnivDecl B M :- std.do! [ coq.env.begin-module ID (some Signature), if (UnivDecl = some UD) (coq.upoly-decl->attribute UD Poly!) (Poly! = true), Poly! => coq.env.add-const "body" Bo Ty @transparent! C, coq.env.global (const C) B, PTY = {{ lp:B = lp:Bo }}, std.assert-ok! (coq.typecheck-ty PTY _) "locker: unlock statement illtyped", P = {{ @refl_equal lp:Ty lp:B }}, std.assert-ok! (coq.typecheck P PTY) "locker: unlock proof illtyped", if (UnivDecl = some UD) (coq.upoly-decl.complete-constraints UD UD1, coq.upoly-decl->attribute UD1 Poly1!) (Poly1! = true), Poly1! => coq.env.add-const "unlock" P PTY @opaque! _, coq.env.end-module M, ]. % ------------------------------------------------------------------------- % Unlocking via the ssreflect Unlockable interface (CS instance) func make-key-unlockable string, term, term, term, term. make-key-unlockable ID DefBo Ty LockedDef Key :- std.do! [ % we extract the real body in order to be precise in the unlocking equation DefBo = {{ @locked_with _ _ lp:Bo }}, UnlockEQ = {{ @locked_withE lp:Ty lp:Key lp:Bo }}, Unlock = {{ @Unlockable _ _ lp:LockedDef lp:UnlockEQ }}, make-unlockable ID Unlock, ]. func make-module-unlockable id, modpath ->. make-module-unlockable ID Module :- std.do! [ coq.env.module Module [_,gref UnlockEQ], coq.env.global UnlockEQ UnlockEQT, Unlock = {{ Unlockable lp:UnlockEQT }}, make-unlockable ID Unlock, ]. func make-unlockable id, term ->. make-unlockable ID Unlock :- std.do! [ std.assert-ok! (coq.typecheck Unlock UnlockTy) "locker: unlocking instance illtyped", UID is ID ^ "_unlock_subterm", coq.env.add-const UID Unlock UnlockTy _ U, coq.CS.declare-instance (const U), ]. } LPCIC-coq-elpi-eb449d7/apps/locker/tests/000077500000000000000000000000001523041753400200675ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/locker/tests/dune000066400000000000000000000002061523041753400207430ustar00rootroot00000000000000(coq.theory (name elpi.apps.locker.tests) (package rocq-elpi-tests) (theories elpi elpi.apps.locker)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/locker/tests/test_locker.v000066400000000000000000000063641523041753400226050ustar00rootroot00000000000000From Corelib Require Import ssreflect. From elpi.apps Require Import locker. (* ----------------------- *) lock Definition d1 := 3. Lemma test_1_0 : d1 = 3. Proof. rewrite unlock. match goal with |- 3 = 3 => by [] end. Qed. Lemma test_1_1 : d1 = 3. Proof. unfold d1. match goal with |- locked_with d1_key_subproof 3 = 3 => by rewrite unlock end. Qed. (* ----------------------- *) Fail lock Axiom d2 : nat. (* ----------------------- *) Section S1. Variable T : Type. #[key="foo"] lock Definition d2 (x : T) := x. End S1. Lemma test_2_0 : d2 nat 3 = 3. Proof. unfold d2. match goal with |- locked_with foo (fun x => x) 3 = 3 => by rewrite unlock end. Qed. (* ----------------------- *) mlock Definition d3 := 3. Print Module d3. Print Module Type d3_Locked. Lemma test_3_0 : d3 = 3. Proof. rewrite unlock. match goal with |- 3 = 3 => by [] end. Qed. Lemma test_3_1 : d3 = 3. Proof. Fail unfold d3. rewrite d3.unlock. by []. Qed. (* ----------------------- *) Section S2. Fail mlock Definition d4 := 3. End S2. (* #286 ----------------------- *) Module Bug_286. Module Import lock_container. Unset Implicit Arguments. lock Definition cons2 {A} x xs := @cons A x xs. End lock_container. About cons2. Definition foo := cons2 0 nil. Class EqDecision (A : Type) := { f : A -> A -> bool }. #[local] Instance xx : EqDecision nat := {| f := (fun _ _ => true) |}. Module Import lock_container2. lock Definition cons3 [A] `{EqDecision A} x xs := @cons A x xs. End lock_container2. Definition foo3 := cons3 0 nil. About cons3. End Bug_286. Module test_286_global_implicits. Unset Implicit Arguments. Module mlock_container. mlock Definition def {A} (a : A) := a. End mlock_container. Fail Definition user1 {A} (a : A) := mlock_container.def _ a. Definition user1 {A} (a : A) := mlock_container.def a. Import mlock_container. Fail Definition user2 {A} (a : A) := def _ a. Definition user2 {A} (a : A) := def a. End test_286_global_implicits. (* https://coq.zulipchat.com/#narrow/stream/253928-Elpi-users-.26-devs/topic/Reifying.20terms.20with.20ltac.20.2F.20if-then-else.20.2F.20complex.20match *) Module elab. mlock Definition y (z : nat) := ltac:(exact z). mlock Definition q (b : bool) := if b then 1 else 0. End elab. (* ----------------------- *) Elpi Command test. (* for queries *) Set Printing Universes. lock #[universes(polymorphic)] Definition id1@{u} (T : Type@{u}) (x : T) := x. About id1. Elpi Query lp:{{ coq.locate "id1" GR, coq.env.univpoly? GR 1 }}. mlock #[universes(polymorphic)] Definition id2@{u} (T : Type@{u}) (x : T) := x. About id2.body. Elpi Query lp:{{ coq.locate "id2" GR, coq.env.univpoly? GR 1 }}. Set Universe Polymorphism. mlock Definition up1 (T : Type) (x : T) := x. About up1.body. Elpi Query lp:{{ coq.locate "up1" GR, coq.env.univpoly? GR 1 }}. mlock #[universes(polymorphic=no)] Definition nup1 (T : Type) (x : T) := x. About nup1.body. Elpi Query lp:{{ coq.locate "nup1" GR, not(coq.env.univpoly? GR _) }}. mlock Definition up2@{u +} (T : Type@{u}) (W : Type) (x : T) := x. About up2.body. Elpi Query lp:{{ coq.locate "up2" GR, coq.env.univpoly? GR 2 }}. Fail mlock Definition up3@{u} (T : Type@{u}) (W : Type) (x : T) := x. (* #704 ----------------------- *) Set Universe Polymorphism. mlock Definition Bla (T : bool) : Type := nat. LPCIC-coq-elpi-eb449d7/apps/locker/theories/000077500000000000000000000000001523041753400205475ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/locker/theories/dune000066400000000000000000000001771523041753400214320ustar00rootroot00000000000000(coq.theory (name elpi.apps.locker) (package rocq-elpi) (theories elpi elpi.apps.locker.elpi)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/locker/theories/locker.v000066400000000000000000000046721523041753400222260ustar00rootroot00000000000000(* Locking mechanisms. license: GNU Lesser General Public License Version 2.1 or later ------------------------------------------------------------------------- *) From elpi.apps.locker.elpi Extra Dependency "locker.elpi" as locker. From Corelib Require Import ssreflect. From elpi Require Import elpi. (** [lock] locks a definition on an opaque key + can be used everywhere - conversion may cross the lock (by congruence), while reduction will not Example: [[ lock Definition foo : T := bo. ]] Synthesizes: - [foo_key_subproof] an opaque term of type unit - [foo] unfolds to [locked_with foo_key_subproof bo] - [Canonical foo_unlock_subterm := Unlockable ...] so that [rewrite unlock] exposes the real body Supported attributes: - [#[key]] lets one override the name of the key *) Elpi Command lock. Elpi Accumulate File locker. Elpi Accumulate lp:{{ main [const-decl ID (some Bo) Ty] :- !, attributes A, coq.parse-attributes A [ att "key" string, ] Opts, !, Opts => locker.key-lock ID Bo Ty none. main [upoly-const-decl ID (some Bo) Ty UnivDecl] :- !, attributes A, coq.parse-attributes A [ att "key" string, ] Opts, !, Opts => locker.key-lock ID Bo Ty (some UnivDecl). main _ :- coq.error "Usage: lock Definition ...". }}. Elpi Export lock. (** [mlock] locks a definition behind a module type + hard locking (the body is really sealed) - cannot be used inside sections Example: [[ mlock Definition foo : T := bo. ]] Synthesizes: - [Module Type foo_Locked] with fields [body] and [unlock] where [body : T] and [unlock : body = bo] - [Module foo : foo_Locked] - [foo] a notation for [foo.body] - [Canonical foo_unlock_subterm := Unlockable ...] so that [rewrite unlock] exposes the real body *) Elpi Command mlock. Elpi Accumulate File locker. #[synterp] Elpi Accumulate lp:{{ pred synterp-action i:id. synterp-action ID :- Module is ID ^ "_Locked", coq.env.begin-module-type Module, coq.env.end-module-type TY, coq.env.begin-module ID (some TY), coq.env.end-module _. main [const-decl ID _ _] :- synterp-action ID. main [upoly-const-decl ID _ _ _] :- synterp-action ID. }}. Elpi Accumulate lp:{{ main [const-decl ID (some Bo) Ty] :- !, locker.module-lock ID Bo Ty none. main [upoly-const-decl ID (some Bo) Ty UD] :- !, locker.module-lock ID Bo Ty (some UD). main _ :- coq.error "Usage: mlock Definition ...". }}. Elpi Export mlock. LPCIC-coq-elpi-eb449d7/apps/rbuild/000077500000000000000000000000001523041753400167275ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/rbuild/README.md000066400000000000000000000015661523041753400202160ustar00rootroot00000000000000## RBuild RBuild implements a handy syntax to build/update records, see the [example](examples/usage_rbuild.v) file. In short `« a .= v; b .= r »` and `« r with a .= v »` without an explicit mention of the recrod type/constructor. On linux, `«` can be typed via `compose` + `<` + `<`. This app is experimental. ### Ideas - update not based on lenses, i.e. `« x with a .= v »` epands to `« a .= v; ... fi .= x.(fi) ... »` that is a special case of `« ... »` when some fields are missing (instead of error user a default): - pros: works even if lenses don't (dependent records) - cons: no lemmas from lenses - when a record is dependent, eg `Record r .= { t : Type; op : t -> t -> t }` one could accept `« r with op .= f »` and expand it to `« r with t .= _ ; op .= f »` - liquid fields, eg `« .b .= v »` to mean any field called `b` (possibly deep) LPCIC-coq-elpi-eb449d7/apps/rbuild/elpi/000077500000000000000000000000001523041753400176605ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/rbuild/elpi/dune000066400000000000000000000005741523041753400205440ustar00rootroot00000000000000(coq.theory (name elpi.apps.rbuild.elpi) (package rocq-elpi) (theories elpi elpi.apps.coercion)) (rule (target dummy.v) (deps (glob_files *.elpi)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (install (files (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/rbuild/elpi/))) (section lib_root) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/apps/rbuild/elpi/rbuild.elpi000066400000000000000000000051321523041753400220150ustar00rootroot00000000000000namespace rbuild { func unresolved_record->list term -> list term. unresolved_record->list {{ Stop }} []. unresolved_record->list {{ More _ lp:X lp:XS }} [X|Rest] :- unresolved_record->list XS Rest. func find constant, list term -> term, list term. find C [ {{ Label _ _ lp:P lp:T }} |TS] T TS :- coq.safe-dest-app P (global (const C)) _, !. find C [X|XS] T [X|YS] :- find C XS T YS. func check-no-label list term. check-no-label []. check-no-label [ {{ Label _ _ lp:P _ }} | _] :- !, coq.error "Unknown label" P. check-no-label [_|XS] :- check-no-label XS. func pad-with-holes int, list A -> list A. pad-with-holes N L L1 :- std.length L M, Diff is N - M, if2 (Diff = 0) (L = L1) (Diff > 0, not(L = []), var {std.last L}) (std.append L {coq.mk-n-holes Diff} L1) (if (Diff < 0) (coq.error "too many fields") (coq.error "not enough fields, maybe use « ... ; _ »")). % we the projection names to build a list of arguments of the right lenght % and we place in there the named ones, the others are placed in their order % in the remaining slots (carries by ACC) func reorder list (option constant), list term, list term -> list term. reorder [some P|PL] L ACC [X|XS] :- find P L X L', !, reorder PL L' ACC XS. reorder [_|PL] L ACC [X|XS] :- reorder PL L [X|ACC] XS. reorder [] L ACC [] :- check-no-label L, {std.rev ACC} = {pad-with-holes {std.length ACC} L}. func find-constructor term -> term, list (option constant). find-constructor Ty KParams PL :- not(var Ty), !, coq.safe-dest-app Ty Hd _, coq.env.global (indt I) Hd, coq.env.indt I _ N _ _ [K] _, coq.mk-n-holes N Params, coq.mk-app {coq.env.global (indc K)} Params KParams, coq.env.projections I PL. func find-inductive list term -> term. find-inductive [ {{ Label lp:S _ _ _ }} | _] S :- !. find-inductive [_|XS] S :- find-inductive XS S. func focus term, list constant -> term. focus {{ ssrfun.catcomp lp:G lp:F }} Acc R :- !, coq.safe-dest-app G P _, coq.env.global (const PC) P, coq.env.projection? PC _, focus F [PC|Acc] R. focus G Acc R :- coq.safe-dest-app G P _, coq.env.global (const PC) P, coq.env.projection? PC _, compose-lens [PC|Acc] R. func compose-lens list constant -> term. compose-lens [] _ :- coq.error "not a (composed) projection". compose-lens [PC] L :- !, find-lens PC L. compose-lens [PC|Rest] {{ lib:elpi.derive.lens.compose lp:L2 lp:L1 }} :- find-lens PC L1, compose-lens Rest L2. func find-lens constant -> term. find-lens PC TArgs :- std.assert! (lens-db _ PC C) "no Lens, did you derive the record?", coq.env.global (const C) T, coq.env.typeof (const C) Ty, coq.saturate Ty T TArgs. } LPCIC-coq-elpi-eb449d7/apps/rbuild/examples/000077500000000000000000000000001523041753400205455ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/rbuild/examples/dune000066400000000000000000000001771523041753400214300ustar00rootroot00000000000000(coq.theory (name elpi.apps.rbuild.examples) (theories elpi elpi.apps.rbuild elpi.apps.derive)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/rbuild/examples/usage_rbuild.v000066400000000000000000000026301523041753400234020ustar00rootroot00000000000000From elpi.apps Require Import derive.std rbuild. Record foo {A} := { a : nat; b : bool; c : A }. #[only(lens)] derive foo. (* Build a record without mentioning its constructor name *) Check « 3 ; false; tt » : foo. (* This time using labels to change the order of fields *) Check « false ; a .= 1 + 2; tt » : foo. Check « c .= tt ; a .= 1 + 2; false » : foo. (* This time ; _ enables padding *) Check « c .= tt ; _ » : foo. (* No type annotation but label *) Check « c .= tt; _ ». (* Update with a lens *) Check fun x : foo => « x with a .= 3 ». (* Errors: *) Fail Check « c .= tt ». (* Error: not enough fields, maybe use « ... ; _ » *) Fail Check « c .= tt; 1; 2; 3; 4 ». (* Error: too many fields *) Check « false ». (* « unresolved record » *) Fail Check « c .= tt; 1; 2 ». (* Error: Illtyped record: Illegal application: The term "Build_foo" of type "forall A : Type, nat -> bool -> A -> foo" cannot be applied to the terms "?e0" : "Type" "1" : "nat" "2" : "nat" "tt" : "unit" The 3rd term has type "nat" which should be a subtype of "bool". *) Record bar := { f : @foo nat; d : nat }. #[only(lens)] derive bar. Record baz := { w : bar }. #[only(lens)] derive baz. (* Update with a composed lens *) Check fun x : baz => « x with w#f#c .= 3 ». (* # is just catcomp from ssrfun *) Import ssrfun. Check fun x : baz => « x with (w \; f \; c) .= 3 ». LPCIC-coq-elpi-eb449d7/apps/rbuild/theories/000077500000000000000000000000001523041753400205515ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/rbuild/theories/dune000066400000000000000000000002201523041753400214210ustar00rootroot00000000000000(coq.theory (name elpi.apps.rbuild) (package rocq-elpi) (theories elpi elpi.apps.rbuild.elpi elpi.apps.derive)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/rbuild/theories/rbuild.v000066400000000000000000000061621523041753400222260ustar00rootroot00000000000000From elpi.apps.rbuild.elpi Extra Dependency "rbuild.elpi" as rbuild. From elpi Require Import elpi. From elpi.apps.derive Require Export lens. From elpi.apps Require Export coercion. Require ssr.ssrfun. Inductive unresolved_record := | Stop | More (T : Type) : T -> unresolved_record -> unresolved_record. Inductive named_field (S: Type) := | Label (T : Type) : (S -> T) -> T -> named_field. Declare Scope label_scope. Delimit Scope label_scope with lbl. Declare Scope labeled_scope. Delimit Scope labeled_scope with lbled. Notation " a # b" := (ssrfun.catcomp a b) (at level 0, b at level 0) : label_scope. Notation " l .= v " := (Label _ _ l%lbl v) (at level 51, v at level 98) : labeled_scope. Notation "« x ; .. ; y »" := (More _ x%lbled .. (More _ y%lbled Stop) .. (* stage 1 : field rearranging / padding *) :> (* ignition: More .. is not a type *) More _ x%lbled .. (More _ y%lbled Stop) ..) (* stage 0 : indtype resolution *) (at level 0, x, y at level 100, only parsing). Notation "« 'unresolved record' »" := (More _ _ _) (at level 0, only printing). Inductive update := With (T : Type) : T -> named_field T -> update. Notation "« x 'with' l .= v »" := (With _ x (Label _ _ l%lbl v) : With _ x (Label _ _ l%lbl v)) (at level 0, x at level 100, l at level 0, v at level 98, only parsing). Elpi Accumulate coercion Db derive.lens.db. Elpi Accumulate coercion File rbuild. Elpi Accumulate coercion.db lp:{{ % workaround: this should work: Elpi Accumulate coercion.db File Signature rbuild. func rbuild.find-inductive list term -> term. func rbuild.reorder list (option constant), list term, list term -> list term. func rbuild.unresolved_record->list term -> list term. func rbuild.focus term, list constant -> term. func rbuild.find-constructor term -> term, list (option constant). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stage 0: we figure out the inductive type and move to stage 1 % we have labels, we use them to infer the type coercion _ L {{ unresolved_record }} (sort _) R :- rbuild.find-inductive {rbuild.unresolved_record->list L} R, !. % no labels, we hope the type is imposed by the context coercion _ _ {{ unresolved_record }} (sort _) R :- R = {{ unresolved_record }}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stage 1: we find the constructor from the type and we apply it coercion _ L {{ unresolved_record }} Ty R :- rbuild.find-constructor Ty K PL, !, rbuild.unresolved_record->list L Args, rbuild.reorder PL Args [] SortedArgs, coq.mk-app K SortedArgs Candidate, std.assert-ok! (coq.typecheck Candidate Ty) "Illtyped record", R = Candidate. % this type checks R again, maybe we can do as in refine to avoid that % stage 0, we schedule the update for stage 1 coercion _ {{ With lp:R _ _}} {{ update }} (sort _) R. % stage 1, we update X via a lens on L coercion _ {{ With lp:R lp:X (Label _ _ lp:L lp:V )}} {{ update }} R O :- std.do! [ rbuild.focus L [] Focus, Candidate = {{ over lp:Focus (fun _ => lp:V) lp:X }}, std.assert-ok! (coq.typecheck Candidate R) "illtyped update", O = Candidate, ]. }}. LPCIC-coq-elpi-eb449d7/apps/tc/000077500000000000000000000000001523041753400160545ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/README.md000066400000000000000000000541171523041753400173430ustar00rootroot00000000000000# Type class solver This folder contains an alternative implementation of a type class solver for coq written in elpi. This solver is composed by two main parts, the **compiler** and the **solver**. The former takes coq classes and instances and "translates" them into the elpi representation, whereas the latter is the elpi tactic aiming to make instance search on coq goals. - [The compiler](#the-compiler) - [Class compilation](#class-compilation) - [Deterministic search](#deterministic-search) - [Hint modes](#hint-modes) - [Instance compilation](#instance-compilation) - [Instance priorities](#instance-priorities) - [Technical details](#technical-details) - [Instance locality](#instance-locality) - [Goal resolution](#goal-resolution) - [Commands](#commands) - [Flags](#flags) - [WIP](#wip) ## The compiler In our implementation by compiler we mean the set of rules abstracting coq terms, *1.* classes and *2* instances, in the elpi world. In the next two paragraphs, we briefly explain these two phases of the compilation, where, intuitively, a type class can be seen as a prolog predicate and the instances of a type class $C$ as rule (clause or fact) of the elpi predicate for $C$. For instance, if ```coq Class Eqb (T: Type) := { eqb : T -> T -> bool; eq_leibniz : forall (A B: T), eqb A B = true -> A = B }. ``` is the type class representing the leibniz equality between two objects of type $T$, and ```coq Program Instance eqBool : Eqb bool := { eqb A B := if A then B else negb B }. Next Obligation. now intros [] []. Qed. ``` is an implementation of `Eqb` for the type `bool`, their corresponding elpi representation will be: ```prolog pred tc-Eqb i:term, o:term. tc-Eqb {{bool}} {{eqBool}}. ``` ### Class compilation The compilation of a type class creates dynamically (thanks to the `coq.elpi.add-predicate` API) a new predicate called `tc-Path.tc-ClassName` with $N + 1$ terms where: - `Path` is the is the logical path in which the type class `ClassName` is located - $N$ is the number of parameter of the `ClassName`. In particular, if a type class $C$ as the parameters $P_1,\dots, P_n$ then the corresponding predicate will have $N$ parameters of type `term` ($1$ per parameter) and a last parameter in output mode containing the result of the instance search. By default, all the first $P_1,\dots,P_n$ parameters are in output mode. The set of rules allowing to add new type-class predicates in elpi are grouped in [create_tc_predicate.elpi](elpi/create_tc_predicate.elpi). #### Deterministic search Sometimes, it could be interesting to disable the backtracking search for some type classes, for performances issues or design choices. In coq the flag *Typeclasses Unique Instances* (see [here](https://coq.inria.fr/refman/addendum/type-classes.html#coq:flag.Typeclasses-Unique-Instances)) allows to block any kind of a backtrack on instance search: in this case type classes are supposed to be canonical. In the example below, we want the `NoBacktrack` type class not to backtrack if a solution is found. ```coq #[deterministic] TC.declare Class NoBacktrack (n: nat). Class A (n: nat). Instance a0 : A 0. Qed. Instance nb0 : NoBacktrack 0. Qed. Instance nb1 : NoBacktrack 1. Qed. Instance a3 n : NoBacktrack n -> A n -> A 3. Qed. Goal A 3. Fail apply _. Abort. ``` The goal `A 3` fails since the only instance matching it is `a3`, but we are not able to satisfy both its premises. In particular, the instance `nb1` is applied first, which fixes the parameter `n` of `a3` to `1`. Then the algorithm tries to find a solution for `A 1` (the second premise), but no implementation of `A` can solve it. In the classic approach, the type class solver would backtrack on the premise `NoBacktrack n` and try to apply `nb0` (this would find a solution), but since the type class `NoBacktrack` is deterministic, then `nb0` is discarded. In this implementation, the elpi rule for the instance `a3` is: ```elpi tc-A {{3}} {{a3 lp:A lp:B lp:C}} :- do-once (tc-NoBacktrack A B), tc-A A C. ``` The predicate `do-once i:prop` has ```prolog do-once P :- P, !. ``` as implementation. The cut (`!`) operator is in charge to avoid backtracking on the query `tc-NoBacktrack A B` #### Hint modes Instance search is done looking to the arguments passed to the class. If there is an instance $I$ unifying to it, the premises of $I$ are tried to be solved to commit $I$ as the solution of the current goal (modulo backtracking). Concerning the parameters of a type class, coq type class solver allows to constrain the argument to be ground, in input or output modes (see [here](https://coq.inria.fr/refman/proofs/automatic-tactics/auto.html#coq:cmd.Hint-Mode)). We provide a similar behavior in elpi: classes represent elpi predicates where the parameters can be in input `i` or output `o` mode (see [here](https://github.com/LPCIC/elpi/blob/master/ELPI.md#modes)). We translate coq modes in the following way: `+` and `!` become `i` in elpi and `-` becomes `o` (see [here](https://github.com/FissoreD/coq-elpi/blob/c3cce183c3b2727ef82178454f0c583196ee2c21/apps/tc/elpi/create_tc_predicate.elpi#L12)). In elpi we allow type classes to have at most one mode, if that mode is not defined, all parameters are considered in `o` mode. The command to be used to let elpi compile classes with modes is done via the command `TC.Declare`. ```coq #[mode(i, o, i)] TC.Declare Class (T1: Type) (T2: Type) (N : nat). ``` The pragma `mode` is taken into account to make `T1` and `N` in input mode and `T2` in output mode. The command `TC.Declare` both create the class in elpi and in coq. Note that the accepted list arguments for the attribute `mode` are `i, o, +, -` and `!` with their respective meaning. ### Instance compilation Instances are compiled in elpi from their type. In particular, since the $\forall$-quantification and the left hand side of implications of coq are both represented with the `prod` type in elpi, we can say that the type of an instance $I$ is essentially a tower of 
prod N_1 T_1 (x_1\ 
  prod N_2 T_2 (x_2\ 
    ... 
      prod N_n T_n (x_n\ 
        app [global GR, A_1, A_2, ... A_M])))
where $\forall i \in [1, N],\ T_i$ is the type of the quantified variable $x_i$. Each $x_1$ represents a premise $P$ of the current instance and, if its type $T_i$ is a type class, then $P$ is recursively compiled and added to the final clause as a premise. The last `prod` contains `app [global GR, A_1, ..., A_M]` where `GR` is the gref of the type class implemented by $I$ and each $A_j$ is an argument applied to `GR` which sees every $x_i$. Note that during the compilation of the instance the binders $x_i$ are recursively replaced by fresh `pi` elpi variables. For example, the instance `eqBool` showed before, has type `Eqb bool`, it has no quantified variable and it is directly compiled in the clause `tc-Eqb {{bool}} {{eqBool}}`. On the other hand, if we take the instance below, ```coq Instance eqProd (A B: Type) : Eqb A -> Eqb B -> Eqb (A * B) := { ... } ``` we see that its type is ``` prod `A` (sort (typ eqProd.u0»)) c0 \ prod `B` (sort (typ eqProd.u1»)) c1 \ prod `H0` (app [global (indt «Eqb»), c0]) c2 \ prod `H1` (app [global (indt «Eqb»), c1]) c3 \ app [global (indt «Eqb»), app [global (indt «prod»), c0, c1]] ``` there are in fact four variables that produce the elpi clause: ``` pi x0 x1 x2 x3\ tc-Eqb {{prod lp:A lp:B}} Sol :- tc-Eqb A S1, tc-Eqb B S2, Sol = {{eqProd lp:A lp:B lp:S1 lp:S2}}. ``` the four variable $c_0,...,c_3$ are quantified with `pi`, the two premises `H0` and `H1` are compiled as premises of the current goal (we need to find a proof that there exists an implementation of the class `Eqb` for the types of $c_0$ and $c_1$). Then the application of `«Eqb»` is used to create the head of the clause with its arguments and `eqProd`, the gref of the current instance, is used as the solution of the current goal applied to all of the quantified variables. The set of rules allowing to compile instances in elpi are grouped in [compiler.elpi](elpi/compiler.elpi). **** #### Instance priorities To reproduce coq behavior, instances need to respect a notion of priority: sometime multiple instances can be applied on a goal, but, for sake of performances, the order in which they are tried is essential. In the previous example, the goal `Eqb ?V` where `?V` is a meta-variable, it is important to first use the rules `eqBool` and then `eqProd`, the latter causing an infinite loop. In elpi, we have the possibility to create rules with names and, then, new rules can be added with respect to a particular grafting (see [here](https://github.com/FissoreD/coq-elpi/blob/a11558758de0a1283bd9224b618cc75e40f118fb/coq-builtin.elpi#L1679)). Our strategy of instance insertion in the elpi database reposes on a predicate `pred hook o:string` having, by default, $1.001$ implementations each of them having a name going from `"0"` to `"1000"` (bounds included). Roughly what we have is the following: ```prolog :name "0" hook "0". :name "1" hook "1". ... :name "999" hook "999". :name "1000" hook "1000". ``` In this way an instance can be added at the wanting position to respect its priority. In particular, the priority of an instance can be defined in two different ways by the user by coq and we retrieve this piece of information via the `Event` listener from `coq` (see [here](https://github.com/coq/coq/blob/f022d5d194cb42c2321ea91cecbcce703a9bcad3/vernac/classes.mli#L81)). This event contains either a class or an instance and in the latter case we can get its priority (see [here](https://github.com/FissoreD/coq-elpi/blob/a11558758de0a1283bd9224b618cc75e40f118fb/apps/tc/src/coq_elpi_tc_register.ml#L57)). #### Technical details 1. If the instance has no user defined priority, the attribute containing the priority of the instance is set to `None`. In this case, the priority is computed as the number of premises the instance has. For example, `eqBool` has priority $2$, since it has two hypothesis triggering recursive instance search. 2. If $P$ is the priority of both the instance $I_1$ and the instance $I_2$ of a class $C$, then the instance that should be tried before is the one which has been defined later (this is coq default behavior). To respect this order, the grafting we use is `after P` for both instances, in this way, elpi will put the second-defined instance before the first one. 3. The number of hook in elpi is bounded to $1.000$, it is however possible to extend it via the command `Elpi TC.AddHook G OldName NewName` where `G` is either after or before and `NewName` is the new hook that will be grafted after\before the hook called `OldName`. For instance, `Elpi TC.AddHook after 1000 1002` creates a hook named `1002` after `1000` and `Elpi TC.AddHook before 1002 1001` insert the hook `1001` before `1002`. Note that `OldName` should be an existing name, otherwise, a blocking error will be thrown at the next invocation of an elpi code. 4. The event listener for instance/class creation can be extended with new elpi programs via the command `Elpi Register TC Compiler PROG`, where `PROG` is the name of the new elpi program called by the `Event` listener of coq. Note that in the case of the creation of a - Type class $C$, `PROG` is called with `[str C]` as argument where `C` is the name of the class - Instance $I$, `PROG` is called with `[str I, str C, str Loc, int Prio]` where `I` is the name of the instance, `C` the name of the class it implements, `Loc` is its `Locality` (one among `Local`, `Global`, `Export`) and `Prio` is its priority. The default elpi program for instance and class insertion is called `auto_compiler` (see [here](https://github.com/FissoreD/coq-elpi/blob/a11558758de0a1283bd9224b618cc75e40f118fb/apps/tc/theories/tc.v#L61)) 5. A registered event listener for instance/class can be deactivated, activated respectively with 1. `Elpi TC Activate Observer PROG.` 2. `Elpi TC Deactivate Observer PROG.` by default, once registered, the elpi program `PROG` is activated #### Instance locality The instances in the elpi database respect the locality given by the user. This is possible thanks to the attributes from [here](https://github.com/FissoreD/coq-elpi/blob/ac036a71f359bc1c1ee3893949d3371df10b0aef/coq-builtin.elpi#L355). When an instance is created the `Event` listener transfer the locality of the instance to the elpi program in charge to make the insertion (see [here](https://github.com/FissoreD/coq-elpi/blob/ac036a71f359bc1c1ee3893949d3371df10b0aef/apps/tc/elpi/compiler.elpi#L154) and [here](https://github.com/FissoreD/coq-elpi/blob/ac036a71f359bc1c1ee3893949d3371df10b0aef/apps/tc/src/coq_elpi_tc_register.ml#L37)). As a small remark, we should consider that instances depending on section variables should be *recompiled* on section end in order to abstract them. In the example below ```coq Section Foo. Variable (A B: Type) (HA : Eqb A) (HB : Eqb B). Global Instance eqProd' : Eqb (A * B) := {...}. Elpi TC.Print_instances eqb. (* Here the elpi database has the instances HA, HB and eqProd' *) (* And the rules for eqProd' is tc-Eqb {{prod A B}} {{eqProd'}}. Remark: Here A and B are not elpi variables, but the coq variables from the context *) End Foo. Elpi TC.Print_instances eqb. (* Here HA and HB are removed since local to Foo and eqProd' has been recompiled abstracting and A, B, HA and HB. They are now arguments of this instance *) (* The new rules for eqProd' is now tc-Eqb {{prod lp:A lp:B}} {{eqProd' lp:A lp:B lp:HA lp:HB}} :- tc-Eqb A HA, tc-Eqb B HB. Remark: Here A and B are elpi variables and HA, PB are the proof that we can prove {{Eqb lp:A}} and {{Eqb lp:B}} *) ``` Concretely, in a section, we consider all instances as **local** in elpi. On section end, the `Event` listener for instance creation triggers a new call to the elpi program for instance compilation. This trigger contains the same event as the one for the instance creation, but now elpi is capable to compile the instance abstracting the section variable. Finally, if we are not in a section, instance locality will depend on the "real" locality of that instance: 1. If the instance is *local*, then we accumulate the attribute *@local! =>* 2. If the instance is *global*, then we accumulate the attribute *@global! =>* 3. If the instance is in *export* mode, then we pass no attribute, since by default, elpi rules have this particular locality ## Goal resolution The resolution of type class goals is done via the `TC_solver` tactic (see [here](https://github.com/FissoreD/coq-elpi/blob/d674089e5f5773d5d922f185e2ff058e595fa8b8/apps/tc/theories/tc.v#L29) and [here](elpi/solver.elpi)). This tactic take the goal and start by introducing the quantified variables if any, then it compiles the hypotheses whose type is a type class and finally start by solving the goal by looking for the instances in the elpi database. Note that the tactic, per se, is not complicated since the search of instances is based on a DFS backtracking on failure which is the builtin search mode of query resolution in elpi. The elpi tactic can be called by the classic `elpi TC_solver` on the current goal, however, this can be done implicitly done using the classic tactics of coq doing type class resolution. In particular, we want to make our solver and coq one coexist. The user may whish the elpi solver to solve `Only` goals concerning particular type classes (for example, those defined in its library) and leave coq to solve the other otherwise. To do so we can call the command `Elpi Override TC TC_solver Only Eqb` which activates the resolution of goal of goal concerning `Eqb` which the solver `TC_solver`. Note that multiple solvers can be created and activated to solve different tasks. To do so, we take advantage of the `Typeclasses.set_solve_all_instances` function from coq (see [here](https://github.com/coq/coq/blob/f022d5d194cb42c2321ea91cecbcce703a9bcad3/pretyping/typeclasses.mli#L141)) which allows to set a solver to be called on type class goals. We have taken the file [`classes.ml`] from [here](https://github.com/coq/coq/blob/f022d5d194cb42c2321ea91cecbcce703a9bcad3/vernac/classes.ml#L1) and slightly modified the function [`resolve_all_evars`](https://github.com/FissoreD/coq-elpi/blob/17d1f20d3d4f37abfeee7edcf31f3757fd515ff3/apps/tc/src/rocq_elpi_class_tactics_hacked.ml#L1165). Now that function, before solving a goal verifies if the current goal contains only type classes overriden by the user and if so, it uses the elpi solver for its resolution, otherwise, it calls the default coq solver. Note that the choice of using elpi or coq solver is done [here](src/rocq_elpi_class_tactics_takeover.ml). Moreover, we provide different commands to 1. Override all type class goals and solve them by the solver of elpi, that command is `Elpi Override TC TC_solver All`. 2. Override only some type classes, that command is `Elpi Override TC TC_solver Only ClassQualid+` where `ClassQualid+` is a non empty list of type class names. A valid call to this command is, for example, `Elpi Override TC TC_solver Only Eqb Decidable`. 3. Override no type class, *i.e.* solve all goals with coq solver with the command `Elpi Override TC TC_solver None`. 4. Blacklist some type classes from elpi solver, `Elpi Override TC - ClassQualid+`. For instance `Elpi Override TC TC_solver Only Eqb Decidable. Elpi Override TC - Decidable` in equivalent to `Elpi Override TC TC_solver Only Eqb`. 5. Add type classes to be solved by the solver of elpi `Elpi Override TC + ClassQualid+`. For instance, `Elpi Override TC TC_solver Only Eqb. Elpi Override TC + Decidable` is equivalent to `Elpi Override TC TC_solver Only Eqb Decidable`. All of these commands are meant to dynamically change the resolution of type classes goal in `.v` files. ## Commands A small recap of the available elpi commands:
TC.Print_instances (click to expand) This commands prints the list of instances inside the elpi database grouped by type class and in order of priority. Note that custom rules will not appear in this list. This command can also be called with the name of a type class to print only the implementation of that type class in elpi. An example of the result for the command `Elpi print_instance Eqb.` ``` Instances list for const «Eqb» is: const «eqBool» const «eqProd» ```
TC.Set_deterministic (click to expand) Take the name of a type class in parameter and sets the search mode of that class to deterministic (see [here](#deterministic-search))
TC.Get_class_info ClassName (click to expand) Prints the name of the predicate associated to the class `ClassName` and its search mode (`deterministic|classic`). This command is useful especially when you want to add a new custom rule for a goal resolution and want to know the name of the predicate of the targeted class. Example: ```coq Elpi TC.Get_class_info Eqb. (* Output: The predicate of indt «Eqb» is tc-Eqb and search mode is classic *) ```
TC.AddHook G OldName NewName (click to expand) See [here](#technical-details)
TC.Declare ClassDef (click to expand) See [here](#deterministic-search) and [here](#hint-modes) for respectively deterministic type class and mode declaration
**Note:** in a new library you may wish to automatically compile into your elpi database the existing classes and instances on which you library depends. To do so, the $4$ following commands may be useful: - `TC.AddAllClasses`: look for all the defined classes and creates their predicate - `TC.AddClasses ClassName+`: compile the predicate for the classes in argument - `TC.AddAllInstances`: look for all the defined instances and compile them - `TC.AddInstances InstName+`: compiles al the instances passed in argument **Note:** it is important to create the predicate of type classes (if not already done) before the insertion of instances otherwise this would throw an exception. ## Flags Here the list of the flags available (all of them are `off` by default):
TC IgnoreEtaReduction (click to expand) Solves the goal ignoring eta-reduction, in that case it will no longer possible to unify `fun x => F x` with `F`
TC ResolutionTime (click to expand) Print the time taken to solve a goal by looking into the set of rules in the database of elpi
TC NameShortPath (click to expand) Experimental and discouraged, it can be used to compile the predicate of type classes without putting the `tc-Path.` prefix before `tc-ClassName` (see [here](#class-compilation)). For example, the type class `Decidable` from `Coq.Classes` is compiled into the predicate `tc-Coq.Classes.DecidableClass.tc-Decidable`. For small tests, if you want a predicate called simply `tc-Decidable` you can either use the namespace of elpi (see [here](https://github.com/LPCIC/elpi/blob/master/ELPI.md#namespaces)) or activate the option `NameShortPat` which creates the predicate with the short name `tc-Decidable`
TC TimeRefine (click to expand) Prints the time taken by coq to refine the elpi solution in to the coq term
Experimental: TC CompilerWithPatternFragment (click to expand) Compile instances using the pattern fragment unification of elpi: the coq term applications (`app [HD | TL]`) are replaced with the elpi application `(HDe TLe)` where `HDe` is the elpi representation of `HD` (similarly for `TLe`)
## WIP 1. Mode management: - Classes with multiple modes 2. Clarify pattern fragment unification 3. Topological sort of premises in modes are activated LPCIC-coq-elpi-eb449d7/apps/tc/elpi/000077500000000000000000000000001523041753400170055ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/elpi/WIP/000077500000000000000000000000001523041753400174445ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/elpi/WIP/deactivate_evar.elpi000066400000000000000000000021011523041753400234370ustar00rootroot00000000000000/* when solving a goal in tc, we want to trigger the declared evar only after the proof search. This means that, while the search is performed, we do not risk to assign too early incorrect types (for example with wrong universes). The evar typechecking is triggered after the search, just before refining the proof with the original goal. We use the guard declare-evars-now that to trigger the constraints to reproduce this behavior. */ % pred declare-evar-later i:list prop, i:term, i:term, i:term. % pred declare-evars-now. % constraint declare-evar-later declare-evars-now { % rule declare-evars-now \ (declare-evar-later Ctx RawEv Ty Ev) <=> (declare-evars-now, Ctx => evar RawEv Ty Ev). % rule \ declare-evars-now. % } % declare-evars-now :- % declare_constraint declare-evars-now [_]. % We want to deactivate the evar declaration if coming from the % original goal (the original type class problem to be solved) % :before "default-declare-evar" % :name "tc-solver-declare-evar" % declare-evar Ctx X Ty E :- !, % declare_constraint (declare-evar-later Ctx X Ty E) [_]. LPCIC-coq-elpi-eb449d7/apps/tc/elpi/WIP/force_llam.elpi000066400000000000000000000130401523041753400224200ustar00rootroot00000000000000% % This is an effort for forcing llam links when used as input variables % % in a premise call. However, this brings several issues to find % % the right variable to activate the right link.s % namespace force-llam { % pred is-uvar-destruct i:term, o:term. % is-uvar-destruct T R :- name T Hd _, name-pair R Hd _, !. % is-uvar-destruct T T :- is-uvar T. % % At compile time, given a premise p with a flexible argument X. % % If X is expected to be in input mode, we add the auxiliary clause % % `solve-llam-t X`, so that, if any suspended % % llam link on X exists, then it is forced before solving p % pred modes i:list string, i:list term, o:list prop. % modes ["o"] [] [] :- !. % modes ["+" | Ms] [X | Xs] [P | Ps] :- is-uvar-destruct X R, !, % P = tc.link.solve-llam-t R, modes Ms Xs Ps. % modes ["!" | Ms] [X | Xs] [P | Ps] :- is-uvar-destruct X R, !, % P = tc.link.solve-llam-t R, modes Ms Xs Ps. % modes [_ | Ms] [_ | Xs] Ps :- % modes Ms Xs Ps. % % The following rule represents a try to force llam links when input of % % of other premises. % compile-conclusion ff Goal Proof HOPremisesIn HOPremisesOut Premises Clause :- % coq.safe-dest-app Goal Class Args, % tc.get-mode {tc.get-TC-of-inst-type Class} Modes, % force-llam.modes Modes Args ForceLlam, % tc.make-tc Goal Proof Premises ff Clause1, % Prems = [HOPremisesIn, ForceLlam, [Clause1], HOPremisesOut], % std.flatten Prems AllPremises, % Clause = do AllPremises. % % Scope Var Args Rhs % pred progress-llam-refine i:list term, i:term, i:list term, o:term. % progress-llam-refine S V [A|As] R :- name A, not (std.mem! S A), !, % % prune (V' A) [A|S], % eta V (fun _ _ (x\ V' x)), % progress-llam-refine [A|S] (V' A) As R. % progress-llam-refine _ V [] V. % progress-llam-refine _ V As (app [V|As]). % pred split-pf i:list term, i:list term, o:list term, o:list term. % split-pf [] _ [] [] :- !. % split-pf [X|Xs] Old [X|Ys] L :- name X, not (std.mem! Old X), !, split-pf Xs [X|Old] Ys L. % split-pf Xs _ [] Xs. % pred lam->fun i:term, i:list term, i:any. % lam->fun T [] R :- !, std.unsafe-cast R R', copy T T', R' = T'. % lam->fun Hd [H|L] R :- !, % pi x\ (copy H x :- !) => lam->fun Hd L (R' x), % std.unsafe-cast R Rx, Rx = R'. % pred unify-align i:term, i:term, i:list term, i:list term. % unify-align (app L) Hd PF NPF :- % Len is {std.length L} - {std.length NPF}, Len >= 0, % std.split-at Len L L' NPF, % Z = app L', % coq.mk-app Z NPF TT, % lam->fun TT {std.append PF NPF} Hd. % pred unify-const i:term, i:term, i:list term. % unify-const N R [] :- !, copy N X, R = X. % unify-const N R [A|As] :- not found.aux, A == N, !, % pi x\ found.aux => (copy N x :- !) => unify-const N (R' x) As, % std.unsafe-cast R Rx, Rx = R'. % unify-const N R [_|As] :- % pi x\ unify-const N (R' x) As, % std.unsafe-cast R Rx, Rx = R'. % pred unify-heuristics i:term, i:term. % unify-heuristics A T :- tc.unify-eq A T. % % unify-heuristics (app _ as A) (fun _ _ B) :- !, % % coq.error "A", % % eta-expand A (fun _ _ A'), pi x\ unify-heuristics (A' x) (B x). % % unify-heuristics (app _ as A) B :- var B Hd Tl, !, % % split-pf Tl [] PF NPF, % % unify-align A Hd PF NPF. % % unify-heuristics A B :- name A, var B Hd Tl, !, % TODO: also const % % unify-const A Hd Tl. % % unify-heuristics (app L) (app[X|L']) :- % % var X, !, % % Len is {std.length L} - {std.length L'}, Len > 0, % % std.split-at Len L Hd L', % % if (Hd = [X]) true (X = app Hd). % % unify-heuristics (app L) (app L') :- % % std.forall2 L L' unify-heuristics. % % % The following rule leaves elpi uvars outside PF in coq % % % unify-heuristics A B :- A = B. % % % The following seems to solve the problem of the previous rule % % % TODO: I don't understand why the following rule cant be written as: % % % unify-heuristics A B :- var B Hb Lb, A = app[Hb|Lb] % % % without breaking test CoqUvar2 % % unify-heuristics (uvar Ha []) (uvar Hb Lb) :- !, % % Ha = app[Hb|Lb]. % % unify-heuristics (fun _ _ Bo) (uvar Hb_ Lb1) :- not (distinct_names Lb1), !, % % Lb1 = [_ | Lb], % % std.spy-do![prune Z Lb, % % % std.unsafe-cast Hb Hb1, % % (pi x\ unify-heuristics (Bo x) Z), % % Hb_ = % % coq.error "TODO" Z]. % % unify-heuristics A B :- A = B. % pred llam-aux i:term, i:term. % llam-aux A (uvar _ S as T) :- distinct_names S, !, A = T. % Here, both A and T are in PF % llam-aux A (uvar _ _ as T) :- !, A = T. % llam-aux A (app [H|L] as T) :- var A, var H, !, get-vars T Vars, declare_constraint (llam A (app [H|L])) [_,A|Vars]. % llam-aux A (app [H|L] as T) :- var H, !, get-vars T Vars, declare_constraint (llam A (app [H|L])) [_|Vars]. % llam-aux A (app [H|L]) :- coq.mk-app H L T, !, unify-heuristics A T. % llam L (app [H|As]) :- var H _ S, !, % progress-llam-refine S H As Rhs, % llam-aux L Rhs. % llam L Rhs :- llam-aux L Rhs. % pred solve-llam-t-cond i:term, i:term. % :name "solve-llam-t-cond" % solve-llam-t-cond (uvar A _) (app [uvar B _ | _]) :- A = B. % % Aims to force a llam link suspended on the given variable % pred solve-llam-t o:term. % solve-llam-t X :- var X, !, declare_constraint (solve-llam-t X) [X]. % solve-llam-t _. % constraint solve-llam solve-llam-t llam { % rule \ (solve-llam-t X) (llam A B) | (solve-llam-t-cond X B) <=> (unify-heuristics A B). % rule solve-llam \ (llam A B) <=> (unify-heuristics A B). % rule \ solve-llam. % } % } LPCIC-coq-elpi-eb449d7/apps/tc/elpi/WIP/modes.elpi000066400000000000000000000036111523041753400214270ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % pred make-modes-cl i:gref, i:list term, i:term, i:list (list hint-mode), i:list (list term), o:prop. % make-modes-cl T V (prod _ _ X) HintModes L (pi x\ C x):- % std.map HintModes (x\r\ [r|_] = x) FST, % std.map HintModes (x\r\ [_|r] = x) LAST, % pi x\ sigma NewL\ % std.map2 L FST (l\m\r\ if (m = mode-input) (r = [x | l]) (r = l)) NewL, % make-modes-cl T [x | V] (X x) LAST NewL (C x). % make-modes-cl T V _ _ L Clause :- % Ty = {coq.mk-app (global T) {std.rev V}}, % Clause = (pi s\ tc T Ty s :- std.forall L (x\ std.exists x var), !, coq.error "Invalid mode for" Ty). % takes the type of a class and build a list % of hint mode where the last element is mandatory func make-last-hint-mode-input term -> list hint-mode. make-last-hint-mode-input (prod _ _ (x\ (prod _ _ _) as T)) [mode-output | L] :- pi x\ make-last-hint-mode-input (T x) L. make-last-hint-mode-input (prod _ _ _) [mode-input]. make-last-hint-mode-input (sort _) []. % build a list of the seme langht as the the passed one % where all the elements are [] func build-empty-list list B -> list (list A). build-empty-list [] []. build-empty-list [_ | TL] [[] | L] :- build-empty-list TL L. % add the hint modes of a Class to the database. % note that if the Class has not specified hint mode % then we assume the hint mode to be - - - ... ! func add-modes gref ->. :if "add-modes" add-modes GR :- % the hint mode is added only if not exists if (not (tc.class GR _ _)) ( coq.env.typeof GR Ty, coq.hints.modes GR "typeclass_instances" ModesProv, if (ModesProv = []) (Modes = [{make-last-hint-mode-input Ty}]) (Modes = ModesProv), % make-modes-cl GR [] Ty Modes {build-empty-list Modes} Cl, % add-tc-db _ (after "firstHook") Cl, ) true. add-modes _.LPCIC-coq-elpi-eb449d7/apps/tc/elpi/alias.elpi000066400000000000000000000014031523041753400207470ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace tc { pred alias i:term, o:term. func replace-with-alias.aux list term -> list term, bool. replace-with-alias.aux [] [] ff. replace-with-alias.aux [X | Xs] [Y | Ys] B :- replace-with-alias X Y B', replace-with-alias.aux Xs Ys B'', or B' B'' B. % [replace-with-alias T T1 Changed] T1 is T where aliases are replaced func replace-with-alias term -> term, bool. replace-with-alias A Sol tt :- alias A Sol', replace-with-alias Sol' Sol _. replace-with-alias (app ToReplace) (app Sol) A :- replace-with-alias.aux ToReplace Sol A. replace-with-alias A A ff. }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/base.elpi000066400000000000000000000101011523041753400205630ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % [count L X R] counts the occurrences of X in L func count list A, A -> int. count [] _ 0. count [A | TL] A R :- !, count TL A X, R is (X + 1). count [_ | TL] A R :- count TL A R. func expected-found A, A ->. expected-found Expected Found :- if (Expected = Found) true (halt "Assertion error" "\nExpected :" Expected "\nFound :" Found). func last-no-error list A -> A. last-no-error A B :- (std.last [] _ :- !, fail) => std.last A B. % [find L F R] returns the first R in L such that (F R) is valid func find list A, (pred i:A) -> A. find [R | _] F R :- F R, !. find [_ | L] F R :- find L F R. func find-opt list A, (pred i:A) -> (option A). find-opt [] _ none. find-opt [R | _] F (some R) :- F R, !. find-opt [_ | L] F R :- find-opt L F R. func args->str-list list argument -> list string. args->str-list L Res :- std.map L (x\r\ str r = x) Res. func or bool, bool -> bool. or ff ff ff :- !. or _ _ tt. func neg bool -> bool. neg tt ff. neg ff tt. func fail->bool prop -> bool. fail->bool P ff :- P, !. fail->bool _ tt. func sep. sep :- coq.say "---------------------------------". func do (list (func)) ->. do []. do [P|PS] :- P, do PS. func if-true (pred), (func) ->. if-true A B :- if A B true. func if-false (pred), (func) ->. if-false A B :- if A true B. func std.findall-unary (pred o:A) -> list A. std.findall-unary P L :- std.findall (P _) V, std.map V (x\y\ P y = x) L. func print-repeat-aux int, string -> string. print-repeat-aux 0 _ S :- !, coq.say S. print-repeat-aux N A S :- N > 0, N1 is N - 1, S' is A ^ S, print-repeat-aux N1 A S'. func print-repeat int, string ->. print-repeat I S :- print-repeat-aux I S "". func split-at-not-fatal int, list A -> list A, list A. split-at-not-fatal 0 L [] L :- !. split-at-not-fatal N [X|XS] [X|LN] LM :- !, N1 is N - 1, split-at-not-fatal N1 XS LN LM. func undup-same list A -> list A. undup-same [] []. undup-same [X|Xs] [X|Ys] :- std.forall Xs (x\ not (x == X)), !, undup-same Xs Ys. undup-same [_|Xs] Ys :- undup-same Xs Ys. :index (1) func is-coq-term any ->. is-coq-term (sort _). is-coq-term (global _). is-coq-term (pglobal _ _). is-coq-term (app _). is-coq-term (fun _ _ _). is-coq-term (prod _ _ _ ). is-coq-term (fix _ _ _ _ ). is-coq-term (match _ _ _). is-coq-term (let _ _ _ _). is-coq-term (primitive _). kind nat type. type z nat. type s nat -> nat. type inf nat. :index (1) func add-nat nat, nat -> nat. add-nat inf _ inf :- !. add-nat _ inf inf :- !. add-nat z N N. add-nat (s N) M (s P) :- add-nat N M P. func max-nat nat, nat -> nat. max-nat z N N :- !. max-nat N z N :- !. max-nat inf _ inf :- !. max-nat _ inf inf :- !. max-nat (s N) (s M) (s P) :- max-nat N M P. func min-nat nat, nat -> nat. min-nat z _ z :- !. min-nat _ z z :- !. min-nat inf A A :- !. min-nat A inf A :- !. min-nat (s N) (s M) (s P) :- min-nat N M P. func length-nat list A -> nat. length-nat [] z. length-nat [_|L] (s N) :- length-nat L N. func count-prod term -> nat. count-prod (prod _ _ B) (s N) :- !, pi x\ count-prod (B x) N. count-prod _ z. func close-prop (A -> list prop) -> list prop. close-prop (x\ []) [] :- !. close-prop (x\ [X | Xs x]) [X| Xs'] :- !, close-prop Xs Xs'. close-prop (x\ [X x | Xs x]) [pi x\ X x | Xs'] :- !, close-prop Xs Xs'. func close-prop-no-prune (A -> list prop) -> list prop. close-prop-no-prune (x\ []) [] :- !. close-prop-no-prune (x\ [X x | Xs x]) [pi x\ X x | Xs'] :- !, close-prop-no-prune Xs Xs'. % [close-term-ty (x\ L) Ty R] Ty is the type of x func close-term-ty (term -> list prop), term -> list prop. close-term-ty (x\ []) _ [] :- !. close-term-ty (x\ [X | Xs x]) Ty [X| Xs'] :- !, close-term-ty Xs Ty Xs'. close-term-ty (x\ [X x | Xs x]) Ty [@pi-decl `x` Ty x\ X x | Xs'] :- !, close-term-ty Xs Ty Xs'. func close-term-no-prune-ty (term -> list prop), term -> list prop. close-term-no-prune-ty (x\ []) _ [] :- !. close-term-no-prune-ty (x\ [X x | Xs x]) Ty [@pi-decl `x` Ty x\ X x | Xs'] :- !, close-term-no-prune-ty Xs Ty Xs'. LPCIC-coq-elpi-eb449d7/apps/tc/elpi/compiler1.elpi000066400000000000000000000120451523041753400215550ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace tc { % returns the classes on which the current gref depends func get-class-dependencies gref -> list gref. get-class-dependencies GR Res :- coq.env.dependencies GR _ DepSet, coq.gref.set.elements DepSet DepList, std.filter DepList coq.TC.class? Res. func has-context-deps gref -> . has-context-deps GR :- coq.env.section-variables SectionVars, coq.env.dependencies GR _ Deps, std.exists! SectionVars (x\ coq.gref.set.mem (const x) Deps). func get-locality string -> list prop. get-locality "Local" [@local!] :- !. get-locality _ [@local!] :- coq.env.current-section-path [_ | _], !. get-locality "Global" [@global!]. get-locality "Export" []. func add-inst.aux gref, gref, list prop, grafting ->. add-inst.aux Inst TC Locality Grafting :- coq.env.current-section-path SectionPath, tc.compile.instance-gr Inst Clause, tc.get-full-path Inst ClauseName, !, (Locality => ( tc.add-tc-db ClauseName Grafting Clause, tc.add-tc-db _ Grafting (tc.instance SectionPath Inst TC Locality))). add-inst.aux Inst _ _ _ :- (@global! => tc.add-tc-db _ _ (tc.banned Inst)), coq.error "Not-added" "TC_solver" "[TC] Not yet able to compile" Inst "...". func add-inst gref, gref, string, int ->. add-inst Inst TC LocalityStr Prio :- get-locality LocalityStr Locality, if (Prio = -1) (tc.get-inst-prio Inst Prio1) (Prio1 = Prio), Grafting is after (int_to_string Prio1), add-inst.aux Inst TC Locality Grafting. func is-local. is-local :- std.mem! {attributes} (attribute "local" _). func add-inst>db.aux gref ->. add-inst>db.aux Inst :- tc.get-inst-prio Inst Prio, tc.get-TC-of-inst-type {coq.env.typeof Inst} TC, % Note: this is an approximation of instance locality when added with % TC.AddAllInstances or TC.AddInstances InstName if (is-local; has-context-deps Inst) (LocalityStr = "Local") (LocalityStr = "Export"), add-inst Inst TC LocalityStr Prio. % [add-inst->db IgnoreClassDepL ForceAdd Inst] compiles and add the Inst to % the database if the instance is not tc.banned or if it does not depend on a TC % inside the list IgnoreClassDepL. func add-inst->db list gref, bool, gref. add-inst->db _ tt Inst :- !, add-inst>db.aux Inst. add-inst->db _ _ Inst :- tc.banned Inst, !, (coq.warning "tc.banned-inst" "TC-warning" Inst "is tc.banned"). add-inst->db _ _ Inst :- tc.instance _ Inst _ _, !. % the instance has already been added add-inst->db IgnoreClassDepL _ Inst :- get-class-dependencies Inst Dep, std.exists Dep (std.mem IgnoreClassDepL), !, coq.warning "invalid-dependency-inst" "TC-warning" Inst "depneds on a tc.banned TC". add-inst->db _ _ Inst :- !, add-inst>db.aux Inst. % add all the instances of a TC func add-inst-of-tc list gref, list gref, gref ->. add-inst-of-tc IgnoreDepClassGR IgnoreInstsGR GR:- tc.get-inst-by-tc-name GR InstL, std.filter InstL (x\ not (std.mem IgnoreInstsGR x)) InstLF, std.forall InstLF (add-inst->db IgnoreDepClassGR ff). func add-tc-or-inst-gr list string, list string, list gref ->. add-tc-or-inst-gr IgnoreDepClass IgnoreInsts Names :- std.map IgnoreDepClass coq.locate IgnoreDepClassGR, std.map IgnoreInsts coq.locate IgnoreInstsGR, std.forall Names (GR\ if2 (coq.TC.class? GR)(add-inst-of-tc IgnoreDepClassGR IgnoreInstsGR GR) (tc.is-instance-gr GR)(add-inst->db IgnoreDepClassGR ff GR) (coq.warning "not-inst-nor-tc" "TC-warning" GR "is neither a TC nor a instance") ). func build-args term -> list term. build-args (prod _ _ Bo) [{{0}} | TL] :- !, build-args (Bo _) TL. build-args _ [{{0}}]. % [remove-inst GR] remove an instance from the DB func remove-inst gref ->. remove-inst InstGR :- tc.get-full-path InstGR ClauseName, std.once(tc.instance _ InstGR ClassGR Locality), tc.gref->pred-name ClassGR PredName, coq.env.typeof ClassGR ClassTy, coq.elpi.predicate PredName {build-args ClassTy} Clause, tc.remove-clause ClauseName Clause Locality. func is-in-path string, gref ->. is-in-path Path GR :- std.mem! {coq.gref->path GR} Path. % [add-path ClassName Path] adds only the instances from a given path name func add-path string, string ->. add-path ClassName Path :- coq.locate ClassName GR, std.filter {tc.get-inst-by-tc-name GR} (is-in-path Path) InstInPath, std.forall InstInPath (add-inst->db [] ff). namespace class-coercion { kind task type. type add task. type remove task. func do-task task, gref ->. do-task add GR :- add-inst->db [] tt GR. do-task remove GR :- remove-inst GR. :index (_ 1) func loop-proj task, list argument ->. loop-proj _ []. loop-proj Task [str Proj | TL] :- coq.locate Proj GRProj, tc.existing-instance GRProj, !, do-task Task GRProj, loop-proj Task TL. loop-proj Task [_|TL] :- loop-proj Task TL. } }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/create_tc_predicate.elpi000066400000000000000000000122541523041753400236350ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace tc { shorten tc.{search-mode}. % The predicate of a class is local if inside a section and readded at section end. % This way, section variables are generalized func get-class-locality -> list prop. get-class-locality [@local!] :- coq.env.current-section-path [_ | _], !. get-class-locality [@global!]. % [add-class-gr SearchMode ClassGR RModes] adds the predicate for the class with its corresponing mode % NOTE: the mode inside TC.declare_mode has the priority over Coq mode or #[mode=(...)] TC.Declare % RModes is a raw list of string containing rocq modes func add-class-gr search-mode, gref, list string ->. % the predicate for the class has alread been added add-class-gr _ ClassGR _ :- tc.class ClassGR _ _ _, !. add-class-gr SearchMode ClassGR SMR :- std.assert! (coq.TC.class? ClassGR) "Only gref of type classes can be added as new predicates", tc.get-elpi-mode ClassGR SMR EM SM, if (std.forall EM (m\ sigma a s\ m = pr a s, a = out)) (true) ( std.fold EM "" (m\s\r\ sigma a s'\ m = pr a s', if (a = in) (calc (s ^ " 10") r) (calc (s ^ " _") r)) Indexing), tc.gref->pred-name ClassGR PredName, get-class-locality Locality, Locality => ( coq.elpi.add-predicate "tc.db" Indexing PredName EM, tc.add-tc-db _ _ (tc.class ClassGR PredName SearchMode SM)). func add-class-str search-mode, string ->. add-class-str SearchMode ClassStr :- coq.locate ClassStr ClassGR, add-class-gr SearchMode ClassGR []. func attr->search-mode -> search-mode. attr->search-mode tc.deterministic :- get-option "deterministic" tt, !. attr->search-mode tc.classic. func attr->modes -> list hint-mode. attr->modes CoqModes :- get-option "mode" L, std.map L get-key-from-option RawModes, std.map RawModes tc.string->coq-mode CoqModes, !. attr->modes []. func get-key-from-option prop -> string. get-key-from-option (get-option A tt) A :- !. get-key-from-option (get-option "i" ff) "o" :- !. get-key-from-option (get-option "o" ff) "i" :- !. get-key-from-option A _ :- coq.error A "should be an option". func declare-class-in-coq gref ->. declare-class-in-coq ClassGR :- attr->modes CoqModes, if (CoqModes = []) ( tc.modes-of-class ClassGR EM, std.map EM tc.elpi->string-mode SM )( coq.hints.add-mode ClassGR "typeclass_instances" CoqModes, std.map CoqModes (x\y\tc.string->coq-mode y x) SM', std.append SM' ["o"] SM ), % CAVEAT: this triggers the observer coq.TC.declare-class ClassGR, attr->search-mode SearchMode, tc.gref->pred-name ClassGR PredName, % HACK: we override the clauses added by the observer, since it does not know % the SearchMode. get-class-locality Locality, Locality => tc.add-tc-db _ (after "0") (tc.class ClassGR PredName SearchMode SM :- !). func declare-class indt-decl ->. declare-class D :- !, coq.env.add-indt D I, coq.parse-attributes {attributes} [ att "mode" attlist, att "deterministic" bool ] Opts, Opts => declare-class-in-coq (indt I). % Contains some instruction that are executed just after the creation of % the predicate for the class namespace eta-reduction-aux { func is-functional term ->. is-functional (prod _ _ _). func replace list term, term -> list term, term. replace [] _ [] _ :- !. replace [(fun _ _ _ as T) | Xs] X' [X' | Xs] T :- !. replace [X | XS] NEW [X | YS] S :- replace XS NEW YS S. % a call to compile builds a new rule for the given class where only one % parameter P of function type is crafted. Compiled rules have only one % premise where P is possibly eta-contructed at runtime. The absence of bang % in the first rule (after is-functional T) allows to get all rules for and % functional parameter through the std.findall in the main predicate below. func compile gref, term, bool, list term -> prop. compile ClassGR (prod _ T Bo) ff L (pi name ty body\ Cl body ty name) :- is-functional T, !, pi name ty body x\ sigma Inp\ Inp = (fun name ty body), compile ClassGR (Bo x) tt [Inp|L] (Cl name ty body). compile ClassGR (prod _ _ Bo) S L (pi x\ Cl x) :- pi x\ compile ClassGR (Bo x) S [x|L] (Cl x). compile ClassGR (sort _) tt L (pi sol new-term\ Cl new-term sol) :- pi solution new-term\ sigma Args Args' Q Q'\ std.do![ tc.gref->pred-name ClassGR PredName, std.rev [solution | L] Args, replace Args new-term Args' T, coq.elpi.predicate PredName Args Q, coq.elpi.predicate PredName Args' Q', (Cl new-term solution) = (Q :- [coq.reduction.eta-contract T new-term, if (T == new-term) fail (Q')]) ]. % A debug predicate to print the genereted clauses func generated-clauses. func main string ->. main S :- coq.locate S ClassGR, coq.env.typeof ClassGR ClassTy, % a clause for eta contruction per argument of functional type is created % we get all the rules with the finall std.findall (compile ClassGR ClassTy ff [] _) SFindall, std.map SFindall (x\r\ compile _ _ _ _ r = x) SMap, if generated-clauses (coq.say SMap) true, std.forall SMap (tc.add-tc-db _ _). } }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/dune000066400000000000000000000005411523041753400176630ustar00rootroot00000000000000(coq.theory (name elpi.apps.tc.elpi) (package rocq-elpi) (theories elpi)) (rule (target dummy.v) (deps (glob_files *.elpi)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (install (files (glob_files (*.elpi with_prefix coq/user-contrib/elpi/apps/tc/elpi/))) (section lib_root) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/apps/tc/elpi/ho_compile.elpi000066400000000000000000000452251523041753400220060ustar00rootroot00000000000000namespace tc { shorten tc.{r-ar, range-arity}. namespace compile { namespace instance { func is-name term ->. func is-uvar term ->. % [name-pair H0 Hn Ar] % the variable H0 (applied 0 time) is associated to the variable Hn which is % applied Ar times. pred name-pair o:term, o:term, o:nat. namespace decompile { func decompile-term-aux term, pair (list term) (list prop) -> term, pair (list term) (list prop). decompile-term-aux X A Y A :- name X, !, X = Y, !. % avoid loading "decompile-term-aux x A x A" at binders decompile-term-aux (global _ as C) A C A :- !. decompile-term-aux (pglobal _ _ as T) L T' L :- !, copy T T', !. decompile-term-aux (sort _ as T) L T' L :- !, copy T T', !. decompile-term-aux (uvar as X) L X L :- !. decompile-term-aux (primitive _ as P) L P L :- !. decompile-term-aux (tc.maybe-eta-tm T S) (pr [X|XS] L1) Y (pr XS' [NL | L2]) :- !, name Y X S, decompile-term-aux T (pr XS L1) T' (pr XS' L2), NL = tc.link.eta Y T'. decompile-term-aux (tc.prod-range T _) A T' A' :- !, decompile-term-aux T A T' A'. % Maybe-llam when H is a coq unif variable quantified in the instance type % In the following instance, X is a HO variable applied to a constant (not a name) % Instance i : forall (X : T1 -> T2) (a : T1), c (X a). decompile-term-aux (tc.maybe-llam-tm (app[app[H | PF] | NPF]) S) (pr [X|XS] L1) Y (pr XS' [NL | L2]) :- not (var H), !, % is-uvar H, holds name Y X S, length-nat PF Len, std.assert!(name-pair H V Len) "[TC] fail to find name-pair", name Hd V PF, std.fold-map NPF (pr XS L1) decompile-term-aux Tl (pr XS' L2), NL = tc.link.llam Y (app [Hd|Tl]). % Maybe-llam when H is a hole appearing in the shelved goals % This happens when the instance to be compiled comes from the context % Example: Goal exists (X : T1 -> T2), forall a, c (X a) -> ... % intros; eexists. (* In the context we have the instance `H: c (?X a)` *) decompile-term-aux (tc.maybe-llam-tm (app[app[H | PF] | NPF]) S) A Z (pr XS' [NL | L3]) :- !, var H _ Scope, !, std.append Scope S S', prune Z S', tc.compile.goal.make-pairs [T] Pairs, % We build on the fly the eta-links for T (Pairs => (tc.compile.goal.build-eta-links-of-vars [T] P, tc.compile.goal.get-uva-pair-arity T PF Y)), std.fold-map NPF A decompile-term-aux Tl (pr XS' L2), std.append P L2 L3, NL = tc.link.llam Z (app [Y|Tl]). decompile-term-aux (fun Name Ty Bo) (pr XS L) (fun Name Ty' Bo') (pr XS2 L3) :- !, (pi x\ is-name x => decompile-term-aux (Bo x) (pr XS []) (Bo' x) (pr XS1 (L1x x))), close-term-no-prune-ty L1x Ty L1, decompile-term-aux Ty (pr XS1 L) Ty' (pr XS2 L2), std.append L1 L2 L3. decompile-term-aux (prod Name Ty Bo) (pr XS L) (prod Name Ty' Bo') (pr XS2 L3) :- !, (pi x\ is-name x => decompile-term-aux (Bo x) (pr XS []) (Bo' x) (pr XS1 (L1x x))), close-term-no-prune-ty L1x Ty L1, decompile-term-aux Ty (pr XS1 L) Ty' (pr XS2 L2), std.append L1 L2 L3. % HO var when H is a quantified variable in the instance type being in PF % Example: Instance i: forall (X : T1 -> T2), (forall a, c1 (X a)) -> c2. % Note: X is the HO var taken into account which is applied to the list of % distinct_names [a] decompile-term-aux (app [H|L]) N R N :- is-uvar H, std.forall L is-name, % Not needed, since precompile does this check distinct_names L, !, % Not needed, since precompile does this check length-nat L Len, std.assert! (name-pair H V Len) "[TC] name-pair not found", name R V L. % HO var when H is a hole appearing in the shelved goals decompile-term-aux (app [T|L]) (pr A B) Z (pr A B') :- var T _ Scope, std.forall L is-name, % Not needed, since decompile for llam leaves only PF distinct_names L, !, % Not needed, since decompile for llam leaves only PF std.append Scope L Scope', prune Z Scope', tc.compile.goal.make-pairs [T] Pairs, % We build on the fly the eta-links for `T` (Pairs => (tc.compile.goal.build-eta-links-of-vars [T] P, tc.compile.goal.get-uva-pair-arity T L Y)), var Z Y Scope', std.append P B B'. decompile-term-aux (app L) PR (app L') PR' :- !, std.fold-map L PR decompile-term-aux L' PR'. decompile-term-aux (let N T Ty Bo) PR (let N T' Ty' Bo') PR3 :- !, decompile-term-aux T PR T' PR1, decompile-term-aux Ty PR1 Ty' PR2, (pi x\ is-name x => decompile-term-aux (Bo x) PR2 (Bo' x) PR3). decompile-term-aux A B _ _ :- coq.error "[TC] cannot decompile-term-aux of" A B. :functional pred decompile-term i:list term, o:list term, i:term, o:term, o:list prop. decompile-term L L' T R Links :- decompile-term-aux T (pr L []) R (pr L' Links). } % TODO: also replace (sort (typ X)) and (pglobal _ X) with holes in the place of X func clean-term term -> term. clean-term A B :- (pi t s r \ copy (tc.maybe-eta-tm t s) r :- !, copy t r, !) => (pi t s r \ copy (tc.prod-range t s) r :- !, copy t r, !) => (pi t s r \ copy (tc.maybe-llam-tm t s) r :- !, copy t r, !) => std.assert! (copy A B) "[TC] clean-term error". func main nat, % the number of problematic terms term, % the type of the instance term, % the global gref of the instance list univ, % the list of univ variable to be replaced with elpi fresh vars list univ-instance % the list of univ-instance to be replaced with elpi fresh vars -> prop. % the compiled clause for the instance main N Ty ProofHd [] [] Clause :- add-pi-problematic-terms N [] Ty ProofHd Clause. main N Ty ProofHd [Univ | UnivL] UnivInstL (pi x\ Clause x) :- !, pi x\ (copy (sort (typ Univ)) (sort (typ x)) :- !) => main N Ty ProofHd UnivL UnivInstL (Clause x). main N Ty ProofHd [] [UnivInst | UnivInstL] (pi x\ Clause x) :- !, pi x\ (copy (pglobal A UnivInst) (pglobal A x) :- !) => main N Ty ProofHd [] UnivInstL (Clause x). % Start to charge the right number of pi for the resulting clause: % This number is equal to the number of problematic terms + number of subterms with shape `sort _` and `pglobal _ _` func add-pi-problematic-terms nat, % the number of pi to quantify list term, % the list of quantified pi term, % the fuel of the compilation (the type of the instance) term % the global gref of the current instance -> prop. % the compiled clause for the instance add-pi-problematic-terms z L Ty ProofHd Clause :- compile-ty L _ ProofHd tt Ty [] [] Clause. add-pi-problematic-terms (s N) L Ty ProofHd (pi x\ Clause x) :- pi x\ is-uvar x => add-pi-problematic-terms N [x|L] Ty ProofHd (Clause x). % Builds a eta link between the varibale A whose type _must_ be of type `prod` % A is linked with B : A =_eta (fun (x : Ty) => B_x) func make-eta-link-aux term, % A : The variable to eta-expand term, % prod _ Ty Bo : The type of A pair term name, % pr B Bn : The eta-expanded version of B with its name (they are fresh names) list term % L : The list of name in the scope of A and B -> prop, % Link : The new eta-link term, % Ty' : The cleaned version of the binder in Ty (term -> term). % Bo : the body of the type of A make-eta-link-aux A (prod _ Ty Bo) (pr B Name) L Link Ty' Bo :- !, clean-term Ty Ty', name A' A {std.rev L}, Link = tc.link.eta A' (fun Name Ty' B'), pi x\ sigma L'\ std.rev [x|L] L', name (B' x) B L'. % Going under prod-range make-eta-link-aux A (tc.prod-range Prod _) BN L Link Ty' Bo :- !, make-eta-link-aux A Prod BN L Link Ty' Bo. % The type of a higher order variable can be hidden behind a definition % In this case we unfold this definition to get the prod constructor make-eta-link-aux A T BN L Link Ty' Bo :- coq.safe-dest-app T Hd Ag, (@redflags! coq.redflags.delta => coq.reduction.lazy.whd Hd Hd'), not (Hd = Hd'), !, coq.mk-app Hd' Ag TT', make-eta-link-aux A TT' BN L Link Ty' Bo. make-eta-link-aux _ T _ _ _ _ _ :- coq.error "[TC] make-eta-link-aux of" T. % Create spine of eta-links :index (_ _ 1) func make-eta-link term, term, list (pair term name), list term, list prop -> prop. make-eta-link P PTy [Hd] L Links (do [Link1|Links]) :- !, make-eta-link-aux P PTy Hd L Link1 _ _. make-eta-link P PTy [(pr B _ as Hd)|Tl] L Links (pi x\ decl x `x` PTy' => Res x) :- !, make-eta-link-aux P PTy Hd L Link1 PTy' Bo, pi x\ make-eta-link B (Bo x) Tl [x|L] [Link1|Links] (Res x). make-eta-link P PTy _ _ _ _ :- coq.error "[TC] make-eta-link error : empty list of pairs" P PTy. % Accumulates pi for eta-links :index (_ 1) func add-link-eta-dedup (func list prop -> prop), range-arity, term, term, (list (pair term name)), list prop -> prop. % Base case when the variable is always used at same arity add-link-eta-dedup F (r-ar _ z) _ _ [] PremR Clause :- !, F PremR Clause. add-link-eta-dedup F (r-ar _ z) P Pty Acc PremR Clause :- !, make-eta-link P Pty Acc [] [] LinkEtaDedup, F [LinkEtaDedup|PremR] Clause. add-link-eta-dedup F (r-ar M (s N)) P PTy Acc PremR (pi x y\ Clause x y) :- !, pi x y\ name-pair P x (s N) => is-uvar x => add-link-eta-dedup F (r-ar M N) P PTy [pr x y|Acc] PremR (Clause x y). add-link-eta-dedup _ Ar P PTy _ _ _ :- coq.error "[TC] add-link-eta-dedup error" Ar P PTy. :functional pred compile-premise i:list term, o:list term, i:term, i:term, i:term, i:bool, i:term, i:list term, i:list prop, o:prop. compile-premise L L2 P PTy ProofHd IsPositive ITy ProofTlR PremR Clause :- ((pi a b c\ tc.get-TC-of-inst-type (tc.prod-range a c) b :- !, tc.get-TC-of-inst-type a b) => tc.get-TC-of-inst-type PTy TC), !, compile-ty L L1 P {neg IsPositive} PTy [] [] NewPrem, if (tc.class TC _ tc.deterministic _) (NewPrem' = std.once NewPrem) (NewPrem' = NewPrem), !, compile-ty L1 L2 ProofHd IsPositive ITy ProofTlR [NewPrem' | PremR] Clause. compile-premise L L1 _ _ ProofHd IsPositive ITy ProofTlR PremR Clause :- compile-ty L L1 ProofHd IsPositive ITy ProofTlR PremR Clause. :index (_ _ _ _ 1) func compile-ty list term, list term, term, bool, term, list term, list prop -> prop. compile-ty L L1 ProofHd IsPositive (tc.prod-range (prod N Ty Bo) Arity) ProofTlR PremR Clause :- !, std.do![ if (IsPositive = tt) (Clause = (pi x\ C x), E = is-uvar) (clean-term Ty Ty', Clause = (pi x\ decl x N Ty' => C x), E = is-name), pi p\ sigma F\ F = compile-premise L L1 p Ty ProofHd IsPositive (Bo p) [p|ProofTlR], decl p N Ty' => name-pair p p z => E p => add-link-eta-dedup F Arity p Ty [] PremR (C p) ]. compile-ty L L1 ProofHd IsPositive (let _ Ty T Bo) ProofTlR PremR Clause :- !, if (IsPositive = tt) (Clause = (pi x\ C x), E = is-uvar) (clean-term Ty Ty', Clause = (pi x\ decl x N Ty' => C x), E = is-name), !, pi p\ sigma F NewPrem\ (decl p N Ty' :- !) => (E p :- !) => ( NewPrem = tc.link.unif-eq T p, compile-premise L L1 p Ty ProofHd IsPositive (Bo p) ProofTlR [NewPrem | PremR] (C p) ). compile-ty L L2 ProofHd IsPositive Goal ProofTlR PremR Clause :- std.do![ coq.mk-app ProofHd {std.rev ProofTlR} Proof, decompile.decompile-term L L1 Proof Proof' Prem1, decompile.decompile-term L1 L2 Goal Goal' Prem2, compile-conclusion IsPositive Goal' Proof' Prem2 Prem1 {std.rev PremR} Clause ]. func compile-conclusion bool, % tt if the term is in positive position term, % the goal (invariant: it is a constant or a application) term, % the proof list prop, % the list of HOPremises in input mode list prop, % the list of HOPremises in output mode list prop % the premises -> prop. % the compiled clause for the instance compile-conclusion tt Goal Proof HOPremisesIn HOPremisesOut Premises Clause :- std.append {std.append HOPremisesIn Premises} HOPremisesOut AllPremises, tc.make-tc Goal Proof AllPremises tt Clause. compile-conclusion ff Goal Proof HOPremisesIn HOPremisesOut Premises Clause :- tc.make-tc Goal Proof Premises ff Clause1, Clause = (do HOPremisesIn, Clause1, do HOPremisesOut). func context goal-ctx -> list prop. context [] []. context [X | Xs] [Clause | ResTl] :- (decl Var _ Ty = X; def Var _ Ty _ = X), tc.is-instance-term Ty, !, std.assert! (compile.instance Ty Var Clause) "[TC] cannot compile instance of context", context Xs ResTl. context [_ | Tl] L :- context Tl L. } % build a list of Clauses of type tc to be temporarly added to the % database, used in theorems having assumptions. func context goal-ctx -> list prop. :name "tc-compile-context" context Ctx Clauses :- std.assert! (instance.context Ctx Clauses) "[TC] cannot compile context". func instance term, term -> prop. instance Ty ProofHd Clause :- tc.time-it tc.oTC-time-compile-instance ( tc.normalize-ty Ty Ty', tc.precomp.instance Ty' Ty'' N UnivConst UnivInst, instance.main N Ty'' ProofHd UnivConst UnivInst Clause ) "Compile Instance", !. func instance-gr gref -> prop. % If the instance is polymorphic, we wrap its gref into the pglobal constructor instance-gr InstGR (pi x\ Clause x) :- coq.env.univpoly? InstGR _, !, coq.env.typeof InstGR Ty, pi x\ tc.compile.instance Ty (pglobal InstGR x) (Clause x). instance-gr InstGR Clause :- coq.env.typeof InstGR Ty, tc.compile.instance Ty (global InstGR) Clause. namespace goal { % [uvar-pair V1 Ty V2] List of uvar for link-eta-dedup % V1 has arity n and V2 has arity n+1 % If V1 has type A -> B, then A = Ty pred uvar-pair i:term, o:term, o:term. % Type Var Cnt uvar-pair-list func make-pairs-aux term, term -> list prop. make-pairs-aux (prod _ Ty Bo) V [pi x\ uvar-pair x Ty X' :- x == V, ! | L] :- !, pi x\ make-pairs-aux (Bo x) X' L. make-pairs-aux _ _ []. func make-pairs list term -> list prop. make-pairs [] [] :- !. make-pairs [X|Xs] L :- !, coq.typecheck X Ty ok, make-pairs-aux Ty X L', make-pairs Xs L'', std.append L' L'' L. func get-uva-pair-arity term, list term -> term. get-uva-pair-arity X [] X :- !. get-uva-pair-arity X [_|L] Z :- uvar-pair X _ Y, !, get-uva-pair-arity Y L Z. func decompile-problematic-term term, list prop -> term, list prop. decompile-problematic-term (tc.maybe-eta-tm T S) L V [tc.link.eta V T' | L2] :- prune V S, !, fold-map T L T' L2. decompile-problematic-term (tc.prod-range T _) A T' A' :- !, fold-map T A T' A'. decompile-problematic-term (tc.maybe-llam-tm (app [app[H|S] | NPF]) Sc) L Z [NL|L'] :- !, prune Z Sc, get-uva-pair-arity H S Y, std.fold-map NPF L fold-map Tl L', NL = tc.link.llam Z (app[Y | Tl]). % TODO: complete this fold decompile-problematic-term (app[X|S]) L Z L :- var X _ Scope, std.append Scope S Scope', distinct_names Scope', !, get-uva-pair-arity X S Y, prune Z Scope', var Z Y Scope'. decompile-problematic-term A L A L :- var A, !. decompile-problematic-term (fun N Ty Bo) L (fun N Ty' Bo') L3 :- fold-map Ty L Ty' L1, (pi x\ fold-map (Bo x) [] (Bo' x) (Lx x)), close-term-no-prune-ty Lx Ty' L2, std.append L1 L2 L3. decompile-problematic-term (prod N Ty Bo) L (prod N Ty' Bo') L3 :- (pi x\ fold-map (Bo x) [] (Bo' x) (Lx x)), close-term-no-prune-ty Lx Ty L1, fold-map Ty L Ty' L2, std.append L2 L1 L3. func compile term, list prop -> term, list prop. compile T L T' L' :- (pi t l t' l'\ fold-map t l t' l' :- decompile-problematic-term t l t' l', !) => fold-map T L T' L'. % Uva Binders LinkEta func build-eta-links-of-vars-aux term, list term -> list prop. build-eta-links-of-vars-aux Old L [Hd | Xs] :- uvar-pair Old Ty Next, !, prune OldScope L, prune Name L, var OldScope Old L, Hd = tc.link.eta OldScope (fun Name Ty (x\ NextScope x)), pi x\ sigma L'\ std.append L [x] L', prune (NextScope x) L', var (NextScope x) Next L', build-eta-links-of-vars-aux Next L' (Ys x), !, sigma Closed\ (close-term-no-prune-ty Ys Ty Closed), Xs = Closed. build-eta-links-of-vars-aux _ _ []. func build-eta-links-of-vars list term -> list prop. build-eta-links-of-vars [] []. build-eta-links-of-vars [V|Vars] L :- var V Hd S, build-eta-links-of-vars-aux Hd S L', build-eta-links-of-vars Vars L'', std.append L' L'' L. } % Goal Goal' Links func goal term -> term, list prop. :name "compile-goal" goal Goal Goal' Links :- tc.precomp.goal Goal GoalPrecomp Vars, !, goal.make-pairs Vars Pairs, Pairs => ( std.assert!(goal.build-eta-links-of-vars Vars EtaLinks) "[TC] cannot build eta-links", std.assert!(goal.compile GoalPrecomp EtaLinks Goal' Links) "[TC] cannot compile goal" ). } } LPCIC-coq-elpi-eb449d7/apps/tc/elpi/ho_link.elpi000066400000000000000000000143071523041753400213100ustar00rootroot00000000000000namespace tc { namespace link { func get-vars term -> list term. get-vars T R :- (pi X H L Ign\ fold-map X L X [H|L] :- var X H Ign, !) => fold-map T [] _ R. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % ETA LINK % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% namespace eta { func eta-expand term -> term. eta-expand T1 (fun _ _ B) :- (name T1; is-coq-term T1), !, pi x\ coq.mk-app T1 [x] (B x). eta-expand T1 (fun _ _ R) :- pi x\ name (R x) T1 [x]. :index (_ _ 1) func may-contract-to list term, term, term ->. may-contract-to _ N N :- name N, !. may-contract-to L N V :- var V _ S, !, std.forall [N|L] (x\ std.exists! S (may-contract-to [] x)). may-contract-to L N (app [N|A]) :- std.length A {std.length L}, std.forall2 {std.rev L} A (may-contract-to []). may-contract-to L N (fun _ _ B) :- pi x\ may-contract-to [x|L] N (B x). :index (_ 1) func occurs-rigidly term, term ->. occurs-rigidly N N :- name N, !. occurs-rigidly _ V :- var V, !, fail. occurs-rigidly N (app A) :- std.exists! A (occurs-rigidly N). occurs-rigidly N (fun _ _ B) :- pi x\ occurs-rigidly N (B x). :index (1) func maybe-eta-aux term, list term ->. maybe-eta-aux V L :- var V _ S, !, std.forall L (std.mem! S). maybe-eta-aux (app [_|A]) L :- SplitLen is {std.length A} - {std.length L}, split-at-not-fatal SplitLen A HD TL, std.forall L (x\ not (std.exists! HD (occurs-rigidly x))), std.forall2 {std.rev L} TL (may-contract-to []). maybe-eta-aux (fun _ _ B) L :- pi x\ maybe-eta-aux (B x) [x|L]. func maybe-eta term ->. maybe-eta (fun _ _ B) :- pi x\ maybe-eta-aux (B x) [x]. func unify-left-right term, term ->. unify-left-right (fun _ _ A) (fun _ _ A') :- !, pi x\ unify-left-right (A x) (A' x). unify-left-right A (fun _ _ _ as T) :- !, eta-expand A Ae, pi x\ unify-left-right Ae T. unify-left-right A A' :- A = A'. func progress-eta-left term -> term. progress-eta-left A _ :- var A, !, fail. progress-eta-left (fun _ _ A) (fun _ _ A) :- !. progress-eta-left A A' :- (name A; is-coq-term A), !, eta-expand A A'. func progress-eta-right term -> term. progress-eta-right (fun _ _ B as T) T :- pi x\ var (B x), !, fail. progress-eta-right A A' :- coq.reduction.eta-contract A A', not (A = A'), !. progress-eta-right A A :- not (maybe-eta A), !. func scope-check term, term ->. scope-check (uvar _ L) T :- prune A L, A = T, !. :index (1) func relocate list term, list term, term -> term. relocate [] [] T T' :- copy T T', coq.say "Copy result is" T T'. relocate [X|Xs] [Y|Ys] T T' :- coq.say "Charging" (copy Y X), (copy Y X :- !) => relocate Xs Ys T T'. pred collect-store o:list prop. func collect-store-aux list prop -> list prop. collect-store L :- collect-store-aux [] L. collect-store-aux X L :- declare_constraint (collect-store-aux X L) [_]. func unify-eta term, term ->. % unify-eta A B :- coq.say "Unify-eta" "A"A"B"B, fail. unify-eta A B :- var A, !, A = B, !. unify-eta (fun _ _ A) (fun _ _ B) :- !, pi x\ unify-eta (A x) (B x). unify-eta A (fun _ _ _ as B) :- !, eta-expand A A', unify-eta A' B. unify-eta A B :- A = B. constraint eta uvar relocate fun collect-store-aux solve-eta { rule solve-eta \ (eta A B) <=> (unify-eta A B). rule \ solve-eta. % rule (N1 : G1 ?- eta (uvar X L1) (fun _ T1 B1)) % \ (N2 : G2 ?- eta (uvar X L2) (fun _ T2 B2)) % | ( % pi x\ relocate L1 L2 (B2 x) (B2' x) % % coq.say "Deduplicating" % % (eta (uvar X L1) (fun _ T1 B1)) % % (eta (uvar X L2) (fun _ T2 B2)) % % "B2' is" (B2') % ) % <=> (N1 : G1 ?- B1 = B2'). % TODO: link collect do not work since it closes links and % therefore variables are prune % rule \ (tc.link.eta A B) (collect-store-aux L R) | (coq.say A B {names}) <=> (collect-store-aux [tc.link.eta A B|L] R). % rule \ (collect-store-aux L R) <=> (R = L). } func eta term, term ->. eta _ uvar :- !, coq.error "[TC] link.eta error, flexible rhs". eta A (fun _ _ B as T) :- not (var A), not (var B), !, unify-left-right A T. eta A B :- progress-eta-right B B', !, A = B'. eta A B :- progress-eta-left A A', !, A' = B. eta A B :- scope-check A B, get-vars B Vars, declare_constraint (eta A B) [_,A|Vars]. } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % LLAM LINK % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% namespace llam { func llam term, term ->. llam A (uvar _ S as T) :- distinct_names S, !, A = T. llam A (app [H|L] as T) :- var A, var H, !, get-vars T Vars, declare_constraint (llam A (app [H|L])) [_,A|Vars]. llam (fun _ _ _ as F) (app [H | TL]) :- var H _ Scope, !, std.drop-last 1 TL TL', H = fun _ _Ty (x\ Bo'), % TODO give a valid _Ty: should be: (Ty of dropped -> Ty of F) prune H' Scope, coq.mk-app H' TL' Bo', pi x\ llam F Bo'. llam A B :- !, std.once(tc.unify-eq A B). constraint solve-llam llam { rule solve-llam \ (llam A B) <=> (A = B). rule \ solve-llam. } } namespace unif-eq { func unif-eq term, term. unif-eq T1 (uvar as T2) :- !, declare_constraint (unif-eq T1 T2) [_,T2]. unif-eq T1 T2 :- !, coq.unify-eq T1 T2 ok. } func unif-eq term, term ->. unif-eq T1 T2 :- unif-eq.unif-eq T1 T2. func eta term, term -> . eta A B :- eta.eta A B. func solve-eta. solve-eta :- declare_constraint solve-eta [_]. func llam term, term ->. llam A B :- llam.llam A B. func solve-llam. solve-llam :- declare_constraint solve-llam [_]. } }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/ho_precompile.elpi000066400000000000000000000314531523041753400225130ustar00rootroot00000000000000namespace tc { shorten tc.{r-ar, range-arity}. namespace precomp { namespace instance { % Tells if the current name is a bound variables pred is-name o:term. % Tells if the current name stands for a uvar pred is-uvar o:term. :index (_ _ 1) func may-contract-to list term, term, term ->. may-contract-to _ N N :- !. may-contract-to L N (app [V|S]) :- var V, !, std.forall [N|L] (x\ std.exists! S (may-contract-to [] x)). may-contract-to L N (app [V|S]) :- is-uvar V, !, std.forall [N|L] (x\ std.exists! S (may-contract-to [] x)). may-contract-to L N (app [N|A]) :- std.length A {std.length L}, std.forall2 {std.rev L} A (may-contract-to []). may-contract-to L N (fun _ _ B) :- pi x\ may-contract-to [x|L] N (B x). :index (_ 1) func occurs-rigidly term, term ->. occurs-rigidly N N :- name N, !. occurs-rigidly _ (app [N|_]) :- is-uvar N, !, fail. occurs-rigidly _ (app [N|_]) :- var N, !, fail. occurs-rigidly N (app A) :- std.exists! A (occurs-rigidly N). occurs-rigidly N (fun _ _ B) :- pi x\ occurs-rigidly N (B x). func maybe-eta-aux term, list term ->. maybe-eta-aux (app[V|S]) L :- is-uvar V, !, std.forall L (x\ std.exists! S (y\ may-contract-to [] x y)). maybe-eta-aux (app[V|S]) L :- var V, !, std.forall L (x\ std.exists! S (y\ may-contract-to [] x y)). maybe-eta-aux (app [_|A]) L :- SplitLen is {std.length A} - {std.length L}, split-at-not-fatal SplitLen A HD TL, std.forall L (x\ not (std.exists! HD (occurs-rigidly x))), std.forall2 {std.rev L} TL (may-contract-to []). maybe-eta-aux (fun _ _ B) L :- pi x\ maybe-eta-aux (B x) [x|L]. func maybe-eta term ->. maybe-eta (fun _ _ B) :- pi x\ maybe-eta-aux (B x) [x]. func free-var -> list term. free-var L :- std.findall (is-name _) T, std.map T (x\y\ x = is-name y) L. func split-pf list term, list term -> list term, list term. split-pf [] _ [] [] :- !. split-pf [X|Xs] Old [X|Ys] L :- is-name X, not (std.mem! Old X), !, split-pf Xs [X|Old] Ys L. split-pf Xs _ [] Xs. kind positivity type. type is_pos positivity. type is_neg positivity. type is_neg_fix positivity. :index (1 _) func neg positivity -> positivity. neg is_pos is_neg :- !. neg is_neg is_pos :- !. neg is_neg_fix is_neg_fix :- !. macro @max-min :- r-ar inf z. func min-max-nat range-arity, range-arity -> range-arity. min-max-nat (r-ar A B) (r-ar A' B') (r-ar A'' B'') :- !, min-nat A A' A'', max-nat B B' B''. % TODO: this is incomplete: it lacks of some term constructors :index (_ 1) func get-range-arity-aux term, term -> range-arity. get-range-arity-aux N N (r-ar z z) :- !. get-range-arity-aux _ N @max-min :- name N, !. get-range-arity-aux T (app [T|L]) R :- !, length-nat L Len, std.fold L (r-ar Len Len) (x\y\w\ sigma M\ get-range-arity-aux T x M, min-max-nat y M w) R. get-range-arity-aux T (app [_|L]) R :- !, std.fold L @max-min (x\y\w\ sigma M\ get-range-arity-aux T x M, min-max-nat y M w) R. get-range-arity-aux T (fun _ Ty B) R2 :- !, get-range-arity-aux T Ty R, (pi x\ get-range-arity-aux T (B x) R1), min-max-nat R R1 R2. get-range-arity-aux T (prod _ Ty B) R2 :- !, get-range-arity-aux T Ty R, (pi x\ get-range-arity-aux T (B x) R1), min-max-nat R R1 R2. get-range-arity-aux _ (global _) @max-min :- !. get-range-arity-aux _ uvar @max-min :- !. get-range-arity-aux _ (sort _) @max-min :- !. get-range-arity-aux _ (pglobal _ _) @max-min :- !. get-range-arity-aux X (let _ T Ty B) R4 :- !, get-range-arity-aux X Ty R1, get-range-arity-aux X T R2, (pi x\ get-range-arity-aux T (B x) R3), min-max-nat R1 R2 R12, min-max-nat R12 R3 R4. get-range-arity-aux A B _ :- coq.error "Count maximal arity failure" A B. func get-range-arity term, term, term -> range-arity. get-range-arity _ Ty _ (r-ar z N) :- tc.get-TC-of-inst-type Ty _, !, count-prod Ty N. get-range-arity B _ T N :- !, get-range-arity-aux B T N. :index (_ 1) func precompile-aux positivity, term, nat -> term, nat. precompile-aux _ X A Y A :- name X, !, X = Y, !. % avoid loading "precompile-aux x A x A" at binders precompile-aux _ (global _ as C) A C A :- !. precompile-aux _ (pglobal _ _ as C) A C A :- !. precompile-aux _ (sort _ as C) A C A :- !. % Detect maybe-eta term % TODO: should I precompile also the type of the fun and put it in the output term precompile-aux _ (fun Name Ty B as T) N (tc.maybe-eta-tm (fun Name Ty B') Scope) (s M) :- maybe-eta T, !, free-var Scope, precompile-aux is_neg_fix Ty N _ N', (pi x\ is-name x => precompile-aux is_neg_fix (B x) N' (B' x) M). precompile-aux _ (app [X|XS]) N (tc.maybe-llam-tm (app [app[X | PF] | NPF1]) Scope) (s M) :- if (is-uvar X) (Sc = []) (var X _ Sc), split-pf XS Sc PF NPF, not (NPF = []), !, % else XS is a list of distinct names, i.e. `app [X|XS]` is in PF free-var Scope, std.fold-map NPF N (precompile-aux is_neg_fix) NPF1 M. % Charge if we work with unification variable or local name % And returns the subterms is a prod-range precompile-aux IsP (prod Name Ty B) N (tc.prod-range (prod Name Ty' B') MaxAr) P :- !, std.assert! (pi x\ get-range-arity x Ty (B x) MaxAr) "[TC] get-range-arity should not fail", if (IsP = is_pos) (C = x\ is-uvar x) (C = x\ is-name x), std.assert! (pi x\ C x => precompile-aux IsP (B x) N (B' x) M) "[TC] should not fail", precompile-aux {neg IsP} Ty M Ty' P. % Working with fun precompile-aux _ (fun N T F) A (fun N T1 F1) A2 :- !, precompile-aux is_neg_fix T A T1 A1, pi x\ is-name x => precompile-aux is_neg_fix (F x) A1 (F1 x) A2. precompile-aux _ (app L) A (app L1) A1 :- !, std.fold-map L A (precompile-aux is_neg_fix) L1 A1. precompile-aux _ X A X A :- var X, !. precompile-aux _ (let N T Ty Bo) A (let N T' Ty' Bo') A3 :- !, precompile-aux is_neg_fix T A T' A1, precompile-aux is_neg_fix Ty A1 Ty' A2, pi x\ is-name x => precompile-aux is_neg_fix (Bo x) A2 (Bo' x) A3. % TODO: what about the following constructors? % precompile-aux IsP (let N T B F) A (let N T1 B1 F1) A3 :- !, % precompile-aux IsP T A T1 A1, precompile-aux IsP B A1 B1 A2, pi x\ is-name x => precompile-aux IsP (F x) A2 (F1 x) A3. % precompile-aux IsP (fix N Rno Ty F) A (fix N Rno Ty1 F1) A2 :- !, % precompile-aux IsP Ty A Ty1 A1, pi x\ is-name x => precompile-aux IsP (F x) A1 (F1 x) A2. % precompile-aux IsP (match T Rty B) A (match T1 Rty1 B1) A3 :- !, % precompile-aux IsP T A T1 A1, precompile-aux IsP Rty A1 Rty1 A2, std.fold-map B A2 (precompile-aux IsP) B1 A3. precompile-aux _ (primitive _ as C) A C A :- !. % precompile-aux IsP (uvar M L as X) A W A1 :- var X, !, std.fold-map L A (precompile-aux IsP) L1 A1, coq.mk-app-uvar M L1 W. % % when used in CHR rules % precompile-aux IsP (uvar X L) A (uvar X L1) A1 :- std.fold-map L A (precompile-aux IsP) L1 A1. func get-univ-instances term -> list univ-instance. get-univ-instances T L :- (pi x L\ fold-map (pglobal _ x) L _ [x | L] :- !) => fold-map T [] _ L, !. func get-univ term -> list univ. get-univ T L :- coq.univ.variable.set.elements {coq.univ.variable.of-term T} Vars, std.map Vars (x\r\ coq.univ.variable r x) L. } /* [tc.precomp.instance T T' N] Returns T' N from T, where: T' is obtained by the replacement of - all maybe-eta term `t1` with (tc.maybe-eta-tm `t1` `s`) where `s` = FV(`t1`) ==> This helps knowing if a subterm should be replaced with a `eta-link` - all `prod _ Ty (x\ Bo x)` with (tc.prod-range (prod _ Ty (x\ Bo x)) N), where N is represent the "maximal" application of `x` in `Bo` for example: let Ty = {{Type -> Type -> Type -> Type -> Type}}, and Bo = x\ c1 (x nat bool) (x nat) (x nat nat bool) the term `prod _ Ty Bo` is replaced with (tc.prod-range (prod _ T Bo) 3) since x is applied at most 3 times in Bo ==> This helps charging the right number of `eta-link` for map-deduplication rule N is the number of problematic terms in T */ func instance term -> term, nat, list univ, list univ-instance. instance T T' N UnivConstL UnivInstL :- tc.precomp.instance.get-univ T UnivConstL, tc.precomp.instance.get-univ-instances T UnivInstL, std.assert!(instance.precompile-aux instance.is_pos T z T' N) "[TC] cannot precompile instance". namespace goal { :index (_ _ 1) func may-contract-to list term, term, term ->. may-contract-to _ N N :- !. % TODO: here we should do var V _ Scope and use scope: N can be in Scope but not in S may-contract-to L N (app [V|S]) :- var V, !, std.forall [N|L] (x\ std.exists! S (may-contract-to [] x)). may-contract-to L N (app [N|A]) :- std.length A {std.length L}, std.forall2 {std.rev L} A (may-contract-to []). may-contract-to L N (fun _ _ B) :- pi x\ may-contract-to [x|L] N (B x). :index (_ 1) func occurs-rigidly term, term ->. occurs-rigidly N N :- name N, !. occurs-rigidly _ (app [N|_]) :- var N, !, fail. occurs-rigidly N (app A) :- std.exists! A (occurs-rigidly N). occurs-rigidly N (fun _ _ B) :- pi x\ occurs-rigidly N (B x). func maybe-eta-aux term, list term ->. % TODO: here we should do var V _ Scope and use Scope: an elt in L can appear in Scope maybe-eta-aux (app[V|S]) L :- var V, !, std.forall L (x\ std.exists! S (y\ may-contract-to [] x y)). maybe-eta-aux (app [_|A]) L :- SplitLen is {std.length A} - {std.length L}, split-at-not-fatal SplitLen A HD TL, std.forall L (x\ not (std.exists! HD (occurs-rigidly x))), std.forall2 {std.rev L} TL (may-contract-to []). maybe-eta-aux (fun _ _ B) L :- pi x\ maybe-eta-aux (B x) [x|L]. func maybe-eta term ->. maybe-eta (fun _ _ B) :- pi x\ maybe-eta-aux (B x) [x]. func split-pf list term, list term -> list term, list term. split-pf [] _ [] [] :- !. split-pf [X|Xs] Old [X|Ys] L :- name X, not (std.mem! Old X), !, split-pf Xs [X|Old] Ys L. split-pf Xs _ [] Xs. func precompile-aux term, list term -> term, list term. precompile-aux X A Y A :- name X, !, X = Y, !. % avoid loading "precompile-aux x A x A" at binders precompile-aux (global _ as C) A C A :- !. precompile-aux (pglobal _ _ as C) A C A :- !. precompile-aux (sort _ as C) A C A :- !. % Detect maybe-eta term precompile-aux (fun Name Ty B as T) N (tc.maybe-eta-tm (fun Name Ty' B') Scope) M :- maybe-eta T, !, names Scope, (pi x\ precompile-aux (B x) N (B' x) M'), precompile-aux Ty M' Ty' M. % Detect maybe-beta term precompile-aux (app [X|XS]) N (tc.maybe-llam-tm (app [app[X | PF] | NPF1]) Scope1) [X|M] :- var X _ Scope, split-pf XS Scope PF NPF, not (NPF = []), !, % else XS is a list of distinct names, i.e. `app [X|XS]` is in PF names Scope1, std.fold-map NPF N precompile-aux NPF1 M. % In the goal there are precompile-aux (prod Name Ty B) N (tc.prod-range (prod Name Ty' B') (r-ar z MaxAr)) P :- !, count-prod Ty MaxAr, std.assert! (pi x\ precompile-aux (B x) N (B' x) M) "[TC] should not fail", precompile-aux Ty M Ty' P. % Working with fun precompile-aux (fun N T F) A (fun N T F1) A2 :- !, A = A1, /*precompile-aux IsP T A T1 A1,*/ pi x\ precompile-aux (F x) A1 (F1 x) A2. precompile-aux (app L) A (app L1) A1 :- !, std.fold-map L A precompile-aux L1 A1. precompile-aux (let N T B F) A (let N T1 B1 F1) A3 :- !, precompile-aux T A T1 A1, precompile-aux B A1 B1 A2, pi x\ precompile-aux (F x) A2 (F1 x) A3. precompile-aux (fix N Rno Ty F) A (fix N Rno Ty1 F1) A2 :- !, precompile-aux Ty A Ty1 A1, pi x\ precompile-aux (F x) A1 (F1 x) A2. precompile-aux (match T Rty B) A (match T1 Rty1 B1) A3 :- !, precompile-aux T A T1 A1, precompile-aux Rty A1 Rty1 A2, std.fold-map B A2 precompile-aux B1 A3. precompile-aux (primitive _ as C) A C A :- !. precompile-aux X A X [X|A] :- var X, !. } func goal term -> term, list term. goal T T' Vars' :- std.assert!(goal.precompile-aux T [] T' Vars) "[TC] cannot precompile goal", undup-same Vars Vars'. } }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/modes.elpi000066400000000000000000000126731523041753400210000ustar00rootroot00000000000000namespace tc { shorten tc.{pending-mode}. typeabbrev elpi-mode (pair argument_mode string). typeabbrev elpi-modeL (list elpi-mode). typeabbrev string-modeL (list string). macro @pending-mode! :- "pending mode". func string->coq-mode -> string, hint-mode. string->coq-mode uvar uvar :- !, coq.error "[TC] string->coq-mode". string->coq-mode "!" mode-input :- !. string->coq-mode "+" mode-ground :- !. string->coq-mode "-" mode-output :- !. string->coq-mode "bang" mode-ground :- !. string->coq-mode "plus" mode-input :- !. string->coq-mode "minus" mode-output :- !. string->coq-mode "i" mode-input :- !. string->coq-mode "o" mode-output :- !. string->coq-mode A _ :- coq.error A "is not a valid mode". func coq->elpi-mode hint-mode -> elpi-mode. :name "coq->elpi-mode" coq->elpi-mode mode-ground (pr in "term"). % approximation /* The coq input-mode corresponds to the elpi mode out Instance : option_equiv : ∀ {A : Type}, Equiv A → Equiv (option A) Mode: Equiv ! Check _ : forall x, Equiv A -> Equiv (option _). In coq, the Check gives the instance option_equiv In elpi, we would have the rule: `tc-Equiv (option A) (option_equiv A B) :- tc-equiv A B.` since the argument in first position of the premise is flexible, then we have a failure */ coq->elpi-mode mode-input (pr in "term"). coq->elpi-mode mode-output (pr out "term"). func string->elpi-mode string -> elpi-mode. string->elpi-mode S R :- coq->elpi-mode {string->coq-mode S} R, !. string->elpi-mode _ (pr out "term"). func elpi->string-mode elpi-mode -> string. elpi->string-mode (pr in _) "i" :- !. elpi->string-mode (pr out _) "o". % Here we build the elpi modes a class CL. If CL has either zero or more than % one mode, then we consider all its parameter to be in output mode. If the % class has exactly one mode, then it is considered for the signature of the % predicate for CL func modes-of-class gref -> list (elpi-mode). modes-of-class ClassGR Modes :- coq.hints.modes ClassGR "typeclass_instances" CoqModesList, not (CoqModesList = []), not (CoqModesList = [_,_|_], coq.warning "TC.Modes" "At the moment we only allow TC with at most 1 hint Mode (caused by class" {coq.gref->string ClassGR} ")"), CoqModesList = [HintModesFst], std.append {std.map HintModesFst coq->elpi-mode} [pr out "term"] Modes, !. modes-of-class ClassGR Modes :- coq.env.typeof ClassGR ClassTy, N is {coq.count-prods ClassTy} + 1, % + 1 for the solution std.list.init N (x\r\ r = (pr out "term")) Modes. func add-pending-mode list string ->. add-pending-mode _ :- pending-mode _, !, coq.error "[TC] A pending mode already exists. Build a class with that mode to avoid this error". add-pending-mode M :- tc.add-tc-db @pending-mode! _ (pending-mode M). func remove-pending-mode ->. remove-pending-mode :- tc.remove-clause @pending-mode! (pending-mode []) []. func check-pending-mode-arity gref, list A ->. check-pending-mode-arity GR L :- coq.env.typeof GR Ty, coq.count-prods Ty N, N' is N + 1, std.assert! (std.length L N') "Pending mode invalid for class GR". % [get-elpi-mode GR RSM EM SM] % GR is a term gref. % RSM represents the raw modes of the GR that have been passed as attributes. % If the length of RSM is N and greater than 0, then the arity of the type of GR is exactly N. % Otherwise, it means that the user has not passed the attribute to the GR. % EM represents the Elpi modes. % SM represents the Rocq modes; it is RSM if RSM is not empty, otherwise it is a list [-,-,..,-] % with the length equal to the arity of the type of GR. func get-elpi-mode gref, string-modeL -> elpi-modeL, string-modeL. get-elpi-mode ClassGR _ EM SM :- pending-mode SM, !, check-pending-mode-arity ClassGR SM, remove-pending-mode, std.map SM string->elpi-mode EM. get-elpi-mode ClassGR [] EM SM :- !, modes-of-class ClassGR EM, std.map EM elpi->string-mode SM. get-elpi-mode ClassGR SM EM SM :- std.append {std.map SM string->elpi-mode} [pr out "term"] EM. func get-evars term -> list term. get-evars T L :- (pi hd T L\ fold-map T L _ [hd | L] :- var T hd _, !) => fold-map T [] _ L. pred evars o:term. func action-to-accumulate string, term -> list prop. action-to-accumulate _ T [evars HD] :- var T HD _, !. action-to-accumulate _ _ []. func mode-check string, term ->. % heuristic: if we are in "+" mode, then all evars in T should only be % in that argument mode-check "+" T :- !, std.findall-unary evars L, get-evars T EV, std.forall EV (x\ std.forall L (x'\ not (x == x'))). mode-check "!" uvar :- !, fail. mode-check _ _. func modes-check.aux list string, list term ->. modes-check.aux [] [_|_] :- coq.error "[TC] modes-check invalid list length". modes-check.aux [_|_] [] :- coq.error "[TC] modes-check invalid list length". modes-check.aux [] []. modes-check.aux [X|XS] [Y|YS] :- std.do![ mode-check X Y, % check on argument X wrt mode Y action-to-accumulate X Y P, % action P to accumulate P => modes-check.aux XS YS % accumulate P and iterate of XS YS ]. func modes-check term ->. modes-check (global _). modes-check (pglobal _ _). modes-check (app [ClassTerm | Args]) :- tc.class-gref ClassTerm ClassGR, tc.get-mode ClassGR M, std.drop-last 1 M M', modes-check.aux M' Args. } LPCIC-coq-elpi-eb449d7/apps/tc/elpi/parser_addInstances.elpi000066400000000000000000000031241523041753400236340ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace tc { kind enum type. type path string -> string -> enum. type addInstPrio int -> string -> enum. type tcOrInst list string -> enum. type ignoreInstances, ignoreClasses string -> list string -> enum. func parse list argument -> enum. parse [int N, str Instance] (addInstPrio N Instance) :- !. parse [str ClassName, str "path", str Path] (path ClassName Path) :- !. parse [str ClassName, str "ignoreInstances" | InstNames] (ignoreInstances ClassName Res) :- !, args->str-list InstNames Res. parse [str ClassName, str "ignoreClasses" | ClassNames] (ignoreClasses ClassName Res) :- !, args->str-list ClassNames Res. parse ClassNames (tcOrInst Res) :- !, args->str-list ClassNames Res. func run-command enum ->. :if "debug" run-command A :- coq.say A, fail. run-command (ignoreClasses ClassName IgnoreClasses) :- coq.locate ClassName ClassGR, tc.add-tc-or-inst-gr IgnoreClasses [] [ClassGR]. run-command (tcOrInst InstNames) :- std.map InstNames coq.locate InstGR, tc.add-tc-or-inst-gr [] [] InstGR. run-command (path ClassName Path):- tc.add-path ClassName Path. run-command (ignoreInstances ClassName InstNames):- coq.locate ClassName ClassGR, tc.add-tc-or-inst-gr [] InstNames [ClassGR]. run-command (addInstPrio Prio InstanceName) :- coq.locate InstanceName InstGr, tc.compile.instance-gr InstGr C, S is int_to_string Prio, tc.add-tc-db _ (before S) C. }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/rewrite_forward.elpi000066400000000000000000000063251523041753400230730ustar00rootroot00000000000000% /* license: GNU Lesser General Public License Version 2.1 or later */ % /* ------------------------------------------------------------------------- */ % namespace tc { % pred forward i:term, o:term, o:list (pair (list term) term). % % Auxiliary function for rewrite-forward % pred rewrite-forward->list i:term, i:name, i:prop, o:list prop. % rewrite-forward->list P N (forward _ Lemma RewL) L :- % coq.mk-app Lemma [P] LemmaApp, % % coq.typecheck LemmaApp T ok, % % coq.say T, % std.map RewL (x\r\ sigma ProjL Ty Pr\ % pr ProjL Ty = x, % make-proj-app ProjL LemmaApp Pr, % r = decl Pr N Ty) L. % % Takes a decl from the context and returns the list of its atomic % % representations by looking in the forward clauses % pred rewrite-forward i:prop, o:list prop. % rewrite-forward (decl P N Ty) L :- % std.findall (forward Ty _ _) FwdL, % std.map FwdL (rewrite-forward->list P N) RewFdw, % std.flatten RewFdw L. % rewrite-forward _ []. % % Takes a list of projections ([proj1|proj2]*) and a term T % % and returns the coq's term (projX (projY (... (projZ T)))) % % Note that app [Proj, _, _, Rest] has two holes for the types % % of the left and right side of Rest % pred make-proj-app i:list term, i:term, o:term. % make-proj-app [Proj | Projs] T (app [Proj, L, R, Rest]) :- % make-proj-app Projs T Rest, % % TODO: here we do a naive typecheck to get the types L and R of Rest, % % it can be done in a faster way % coq.typecheck Rest {{and lp:L lp:R}} ok. % make-proj-app [] T T. % % Takes a conjunction C of terms and []. It returns a list of pair: % % The paths to the conjunct c in C and the path to reach it in C % pred rec-split-and i:term, i:(list term), o:list (pair (list term) term). % rec-split-and {{lp:A /\ lp:B}} DL L :- % LEFT = [{{proj1}} | DL], % RIGHT = [{{proj2}} | DL], % rec-split-and A LEFT AL, % rec-split-and B RIGHT BL, % std.append AL BL L. % rec-split-and A P [pr P A]. % % It takes a rewriting-lemma and abstract it into elpi in a forward % % clause of type forward. The base case wants a ∀(x : T).f x, since % % we want to keep trace of the type T of x. % pred compile-rewrite i:term, i:term, i:list term, o:prop. % compile-rewrite (prod _ Ty ((x\ app _) as Bo)) Lemma L (pi x\ forward Ty LemmaApp (TL x)) :- % pi x\ % coq.mk-app Lemma {std.rev L} LemmaApp, % rec-split-and (Bo x) [] (TL x). % compile-rewrite (prod _ _ Bo) Lemma L (pi x\ C x) :- % pi x\ compile-rewrite (Bo x) Lemma [x | L] (C x). % % Takes a string (the name of a rewriting-lemma), % % compiles and adds it as a forward clause in tc.db % pred add-lemma->forward i:string. % add-lemma->forward Lemma :- % coq.locate Lemma Gr, % coq.env.typeof Gr Type, % compile-rewrite Type (global Gr) [] Cl, % coq.elpi.accumulate _ "tc.db" (clause Lemma _ Cl). % % TODO: @FissoreD @gares should make a set in output? % pred rewrite-dep i:list prop, o:list prop. % rewrite-dep [] []. % rewrite-dep [A | B] L :- % rewrite-forward A NewA, not (NewA = []), % std.append NewA B ToTreat, % rewrite-dep ToTreat L. % rewrite-dep [A | TL] [A | L] :- rewrite-dep TL L. % }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/solver.elpi000066400000000000000000000056121523041753400211760ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ main _. msolve L N :- tc.time-it tc.oTC-time-msolve (coq.ltac.all (coq.ltac.open tc.solve-aux) L N) "msolve". msolve L _ :- coq.ltac.fail _ "[TC] fail to solve" L. namespace tc { pred build-query-from-goal i:term, i:term, o:prop, o:list prop. build-query-from-goal Goal Proof Q PostProcess :- tc.compile.goal Goal Goal' PostProcess, !, coq.safe-dest-app Goal' (global TC) TL', std.append TL' [Proof] TL, !, coq.elpi.predicate {tc.gref->pred-name TC} TL Q. type tc.mode_fail term. pred refine-proof i:term, i:goal, o:list sealed-goal. refine-proof tc.mode_fail G [seal G] :- !. refine-proof Proof G GL :- if-true print-solution (coq.say "[TC] The proof is <<<" Proof ">>>"), if-true print-solution-pp (coq.say "[TC] The proof is <<<" {coq.term->string Proof} ">>>"), /*********** CHECK IF THE PROOF TYPECHECKS ***********/ tc.time-it tc.oTC-time-refine (@no-tc! => refine.typecheck Proof G GL) "refine.typecheck", if-true print-solution (coq.say "[TC] The proof typechecks"). pred solve-under-context i:term, o:term. solve-under-context Ty Proof :- tc.time-it tc.oTC-time-compile-goal (build-query-from-goal Ty Proof Q PostProcess) "build query", !, if-true print-compiled-goal (coq.say "[TC] the compiled goal is" Q), !, tc.time-it tc.oTC-time-instance-search ( do PostProcess, Q, tc.link.solve-eta, % Trigger eta links tc.link.solve-llam % Trigger llam links ) "instance search". pred solve-aux i:goal, o:list sealed-goal. solve-aux (goal Ctx _ Ty P_ Ag_ as G) GL :- tc.time-it _ (solve-aux1 Ctx Ty Proof) "full instance search", refine-proof Proof G GL. pred solve-aux1 i:goal-ctx, i:term, o:term. :name "solve-aux-intros" solve-aux1 Ctx (prod N X T) Proof :- !, @pi-decl _ X x\ solve-aux1 [decl x N X | Ctx] (T x) (Proof' x), if (Proof' x = tc.mode_fail) (Proof = tc.mode_fail) (Proof = fun N X Proof'). :name "solve-aux-conclusion" solve-aux1 Ctx TyRaw Proof :- tc.time-it _ (tc.normalize-ty TyRaw Ty) "normalize ty", if-true print-goal (coq.say "The goal is <<<" Ty ">>>"), if-true print-goal-pp (coq.say "The goal is <<<" {coq.term->string Ty} ">>>"), % tc.time-it tc.oTC-time-mode-check (tc.modes-check Ty) "mode check", !, tc.time-it _ (tc.compile.context Ctx CtxClause) "compile context", !, CtxClause => solve-under-context Ty Proof. solve-aux1 _ _ tc.mode_fail :- if-true (print-solution; print-solution-pp) (coq.say "Invalid mode call"). pred print-solution. % Print the solution in HOAS pred print-solution-pp. % Print the solution in coq pp pred print-goal. % Print the goal in HOAS pred print-goal-pp. % Print the goal with coq pp pred print-compiled-goal. }LPCIC-coq-elpi-eb449d7/apps/tc/elpi/tc_aux.elpi000066400000000000000000000205411523041753400211450ustar00rootroot00000000000000/* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ namespace tc { namespace lettify { func replace-args term, list term, list term, (func term -> term) -> term. replace-args Hd [] L K R :- std.rev L L1, K (app [Hd|L1]) R. replace-args Hd [X|Xs] L K (let `_` Ty X T') :- coq.typecheck X Ty ok, pi x\ replace-args Hd Xs [x|L] K (T' x). func replace-top-level list term, term, list term -> term. replace-top-level [] Hd L (app [Hd | L']) :- std.rev L L'. replace-top-level [app[X|Xs]|As] Hd L R :- replace-args X Xs [] (x\ replace-top-level As Hd [x|L]) R. replace-top-level [(fun _ _ _ as A)|As] Hd L (let `_` Ty A T') :- coq.typecheck A Ty ok, pi x\ replace-top-level As Hd [x|L] (T' x). func main term -> term. main (prod N Ty Bo) (prod N Ty Bo') :- !, pi x\ main (Bo x) (Bo' x). main (app [X|Xs]) T :- is-instance-term X, !, replace-top-level Xs X [] T. main T T. } % return if a gref is an existsing instance % TODO: this could be replaced with an API % coq.TC.get-class-of-inst i:gref, o:gref func existing-instance gref ->. existing-instance InstGR :- coq.env.typeof InstGR InstTy, get-TC-of-inst-type InstTy ClassGR, coq.TC.class? ClassGR, coq.TC.db-for ClassGR DB, std.mem! DB (tc-instance InstGR _). func under-p-global term -> gref. under-p-global (global GR) GR. under-p-global (pglobal GR _) GR. func class-gref term -> gref. class-gref T ClassGR :- under-p-global T ClassGR, coq.TC.class? ClassGR. % returns the TC from the type of an instance % TODO: This could be replaced with an api % coq.TC.get-class-of-inst i:gref, o:gref func get-TC-of-inst-type term -> gref. get-TC-of-inst-type (prod _ _ A) ClassGR:- !, pi x\ get-TC-of-inst-type (A x) ClassGR. get-TC-of-inst-type (let _ _ _ A) ClassGR:- !, pi x\ get-TC-of-inst-type (A x) ClassGR. get-TC-of-inst-type T ClassGR :- coq.safe-dest-app T HD _, not (var HD), class-gref HD ClassGR. func instances-of-current-section list gref ->. :name "MySectionEndHook" instances-of-current-section InstsFiltered :- coq.env.current-section-path SectionPath, std.findall (tc.instance SectionPath _ _ _) Insts, coq.env.section-variables SectionVars, std.map-filter Insts (x\r\ sigma X\ tc.instance _ r _ _ = x, const X = r, not(std.mem SectionVars X)) InstsFiltered. func is-instance-gr gref ->. is-instance-gr GR :- coq.env.typeof GR Ty, is-instance-term Ty. func is-instance-term term ->. is-instance-term T :- get-TC-of-inst-type T TC, coq.TC.class? TC. % adds a clause to the tc.db DB at the passed grafting func add-tc-db id, grafting, prop ->. add-tc-db _ _ Clause :- not (ground_term Clause), coq.error "[TC] anomaly: open rule:" Clause, !. add-tc-db ClauseName Graft Clause :- coq.elpi.accumulate _ "tc.db" (clause ClauseName Graft Clause), !. add-tc-db _ _ Clause :- coq.error "cannot add " PR " to tc.db". % takes a tc-instance and return the gref of the inst func inst->gref tc-instance -> gref. inst->gref (tc-instance Res _) Res. % returns all the instances of the passed ClassName func get-inst-by-tc-name gref -> list gref. get-inst-by-tc-name TC GRL:- coq.TC.db-for TC Inst, std.map Inst inst->gref GRL', std.rev GRL' GRL. func app-has-class term ->. app-has-class T :- get-TC-of-inst-type T Hd, coq.TC.class? Hd. % TC preds are on the form tc-[PATH_TO_TC].tc-[TC-Name] func gref->pred-name gref -> string. gref->pred-name Gr S :- if (tc.is-option-active tc.oTC-clauseNameShortName) (Path = "") (coq.gref->path Gr [Hd | Tl], if (Hd = "Coq") (Hd' = "Corelib") (Hd' = Hd), std.string.concat "." [Hd'|Tl] Path', Path is Path' ^ ".tc-"), % CAVEAT : Non-ascii caractars can't be part of a pred % name, we replace ö with o rex.replace "ö" "o" {coq.gref->id Gr} GrStr, S is "tc-" ^ Path ^ GrStr. func get-mode gref -> list string. get-mode ClassGR M :- tc.class ClassGR _ _ M, !. get-mode ClassGR _ :- coq.error "[TC]" ClassGR "is an unknown class". /* [make-tc.aux B Sol Head Body Rule] builds the rule with the given Head and body paying attention to the positivity of the clause Note: if the Rule being constructed is negative (B = ff), then Rules returns a solution Sol used inside the proof. If the solution is already given, we do not run the premise. This would ask Sol to be ground (ground_term S). Here, for performance issues, we simply check that the solution is not a flexible term */ :index (1 _ _ 1) func make-tc.aux bool, term, prop, list prop -> prop. make-tc.aux tt _ Head [] Head :- !. make-tc.aux ff Sol Head [] P :- !, P = if (var Sol) Head true. make-tc.aux tt _ Head Body (Head :- Body) :- !. make-tc.aux ff Sol Head Body P :- !, P = if (var Sol) (Body => Head) true. func make-tc term, term, list prop, bool -> prop. make-tc Goal Sol RuleBody IsPositive Rule :- coq.safe-dest-app Goal Class Args, get-TC-of-inst-type Class ClassGR, gref->pred-name ClassGR ClassStr, std.append Args [Sol] ArgsSol, coq.elpi.predicate ClassStr ArgsSol RuleHead, make-tc.aux IsPositive Sol RuleHead RuleBody Rule. % returns the priority of an instance from the gref of an instance func get-inst-prio gref -> int. get-inst-prio InstGR Prio :- coq.env.typeof InstGR InstTy, get-TC-of-inst-type InstTy ClassGR, coq.TC.get-inst-prio ClassGR InstGR Prio. func get-full-path gref -> string. get-full-path Gr Res' :- coq.gref->string Gr Path, coq.env.current-section-path SectionPath, std.fold SectionPath "" (e\acc\r\ r is acc ^ "." ^ e) Res, Res' is Res ^ Path. func constant->redflag prop -> coq.redflag. constant->redflag (tc.unfold-constant C) (coq.redflags.const C). func normalize-ty term -> term. :name "normalize-ty" normalize-ty G1 G2 :- std.findall (tc.unfold-constant _) UnfoldFindall, std.map UnfoldFindall constant->redflag UnfoldRF, coq.redflags.add coq.redflags.nored [coq.redflags.beta, coq.redflags.delta | UnfoldRF] RF, @redflags! RF => coq.reduction.lazy.norm G1 G2. func remove-clause string, prop, list prop ->. remove-clause ClauseName P Locality :- %Locality => add-tc-db _ (remove ClauseName) P. Locality => add-tc-db _ (replace ClauseName) (P :- fail, !). % [section-var->decl.aux L R] auxiliary function for `section-var->decl` func section-var->decl.aux list constant -> list prop. section-var->decl.aux [] []. section-var->decl.aux [X|XS] [(decl (global (const X)) _ Ty)|YS] :- coq.env.typeof (const X) Ty, section-var->decl.aux XS YS. % [section-var->decl L] decl representing seciton variables with their types func section-var->decl -> list prop. section-var->decl L :- section-var->decl.aux {coq.env.section-variables} L. func time-is-active (func (list string) ->) ->. :name "time-is-active" time-is-active _ :- coq.option.get ["Time", "TC", "Bench"] (coq.option.bool tt), !. time-is-active Opt :- tc.is-option-active Opt. func time-pp string, float ->. time-pp Msg Time :- !, coq.debug "[TC] - Time of" Msg "is" Time. pred give-res i:prop, o:prop. give-res P true :- P. give-res _ fail. pred time-res i:prop, o:float, o:prop. time-res P T Res :- std.time (give-res P Res) T. func build-msg prop, string -> string. build-msg true S S :- !. build-msg fail S S' :- S' is S ^ " fail". pred time-it i:(list string -> prop), i:prop, i:string. time-it Opt P Msg :- time-is-active Opt, !, time-res P Time Res, build-msg Res Msg Msg', time-pp Msg' Time, Res. time-it _ P _ :- P. kind range-arity type. type r-ar nat -> nat -> range-arity. type prod-range term -> % The current qunatified uvar range-arity -> % Its minimum and maximal application term. type maybe-eta-tm term -> % The current precompiled subterm list term -> % The list of FV in the precomp subterm term. type maybe-llam-tm term -> % The current precompiled subterm: shape is app[app[X,PF],NPF] list term -> % The eta-expanded version of X, from X^{len(PF)} to X^{len(PF)+len(NPF)} term. } LPCIC-coq-elpi-eb449d7/apps/tc/elpi/tc_same_order.elpi000066400000000000000000000017701523041753400224730ustar00rootroot00000000000000% [Typeclass, Coq Instances, Elpi Instances] % the instances of the given typeclass should be in the same order as Coq func correct_instance_order_aux gref, (list tc-instance), (list gref). :name "tc-correct-instance-order-aux" correct_instance_order_aux _ [] []. correct_instance_order_aux TC [tc-instance I1 _ | TL1] [I1 | TL2] :- correct_instance_order_aux TC TL1 TL2. % [Typeclasses of Coq, Elpi Instances] func correct_instance_order (list gref), (list prop). :name "tc-correct-instance-order" correct_instance_order [] _. correct_instance_order [TC | TL] ElpiInst :- coq.TC.db-for TC CoqInst, std.map-filter ElpiInst (x\r\ sigma I\ x = tc.instance _ I TC _, r = I) ElpiInstTC, if (correct_instance_order_aux TC CoqInst ElpiInstTC) (correct_instance_order TL ElpiInst) (coq.error "Error in import order\n" "Expected :" CoqInst "\nFound :" ElpiInstTC). :name "tc-same-order-main" main _ :- std.findall (tc.instance _ _ _ _) ElpiInst, correct_instance_order {coq.TC.db-tc} ElpiInst.LPCIC-coq-elpi-eb449d7/apps/tc/elpi/unif.elpi000066400000000000000000000217531523041753400206310ustar00rootroot00000000000000namespace tc{ namespace unif{ shorten std.{rev, append, ignore-failure!, mem, map2, split-at, map, assert!}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% Unification %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred unify-eq i:term, i:term. pred unify-list-eq i:list term, i:list term. pred unify-leq i:term, i:term. % invariant: hd-beta terms % we start with ff, tt to handle symmetric cases % NOTE: rec-calls with unify (ensured hd-beta + ff) , symmetric rules are typically ! % NOTE: asymmetric rules are not ! otherwise the flip rule is killed % NOTE: whd are ! % names: unif X C T D M kind cumul type. type eq cumul. type leq cumul. macro @tail-cut-if Option Hd Hyps :- ( (Hd :- get-option Option tt, Hyps, !), (Hd :- not(get-option Option tt), Hyps ) ). pred unif i:term, i:stack, i:term, i:stack, i:bool, i:cumul. :if "DBG:unif" unif X CX Y CY D M :- coq.say {counter "run"} "unif" X CX "==" Y CY "(flipped?" D "cumul:" M ")", fail. func swap bool, (func A, A -> ), A, A -> . swap tt F A B :- F B A. swap ff F A B :- F A B. % flexible cases unif (uvar V L) [] T D _ _ :- get-option "unif:greedy" tt, !, bind-list L {unwind T D} V, !. unif (uvar V L) [] T D _ _ :- !, bind-list L {unwind T D} V. unif X C (uvar V L) [] _ _ :- get-option "unif:greedy" tt, !, bind-list L {unwind X C} V, !. unif X C (uvar V L) [] _ _ :- !, bind-list L {unwind X C} V. unif (sort prop) [] (sort (uvar as Y)) [] _ _ :- !, Y = prop. unif X [] (sort (uvar as Y)) [] M U :- !, coq.univ.new Lvl, Y = typ Lvl, unif X [] (sort Y) [] M U. unif (sort (uvar as X)) [] Y [] M U :- !, coq.univ.new Lvl, X = typ Lvl, unif (sort X) [] Y [] M U. unif (sort S1) [] (sort S2) [] M eq :- !, swap M coq.sort.eq S1 S2. unif (sort S1) [] (sort S2) [] M leq :- !, swap M coq.sort.leq S1 S2. unif (primitive X) [] (primitive X) [] ff _ :- !. unif (global (indt GR1)) C (global (indt GR2)) D _ _ :- !, GR1 = GR2, unify-ctxs C D. unif (global (indc GR1)) C (global (indc GR2)) D _ _ :- !, GR1 = GR2, unify-ctxs C D. unif (pglobal (indt GR1) I1) C (pglobal (indt GR2) I2) D _ eq :- !, GR1 = GR2, coq.univ-instance.unify-eq (indt GR1) I1 I2 ok, unify-ctxs C D. unif (pglobal (indt GR1) I1) C (pglobal (indt GR2) I2) D _ leq :- !, GR1 = GR2, coq.univ-instance.unify-leq (indt GR1) I1 I2 ok, unify-ctxs C D. % fast path for stuck term on the right unif X C (global (indt _) as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (global (indc _) as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (pglobal (indt _) _ as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (pglobal (indc _) _ as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 % congruence rules TODO: is the of assumption really needed? unif (fun N T1 F1) [] (fun M T2 F2) [] _ _ :- !, ignore-failure! (N = M), unify T1 T2 eq, pi x\ (decl x N T1) => unify (F1 x) (F2 x) eq. unif (prod N T1 F1) [] (prod M T2 F2) [] _ U :- !, ignore-failure! (N = M), unify T1 T2 eq, pi x\ (decl x N T1) => unify (F1 x) (F2 x) U. unif (fix N Rno Ty1 F1) B1 (fix M Rno Ty2 F2) B2 _ _ :- !, ignore-failure! (N = M), unify Ty1 Ty2 eq, (pi f\ (decl f N Ty1) => unify (F1 f) (F2 f) eq), unify-ctxs B1 B2. unif (match A1 R1 L1) B1 (match A2 R2 L2) B2 _ _ :- !, unify A1 A2 eq, unify R1 R2 eq, unify-list L1 L2, unify-ctxs B1 B2. % congruence heuristic (same maybe-non-normal head) unif (let N T1 B1 F1) C1 (let M T2 B2 F2) C2 _ _ :- ignore-failure! (N = M), unify T1 T2 eq, unify B1 B2 eq, (@pi-def N T1 B1 x\ unify (F1 x) (F2 x) eq), unify-ctxs C1 C2, !. unif (global (const GR)) C (global (const GR)) D _ _ :- unify-ctxs C D, !. unif (pglobal (const GR) I1) C (pglobal (const GR) I2) D _ eq :- coq.univ-instance.unify-eq (const GR) I1 I2 ok, unify-ctxs C D, !. unif (pglobal (const GR) I1) C (pglobal (const GR) I2) D _ leq :- coq.univ-instance.unify-leq (const GR) I1 I2 ok, unify-ctxs C D, !. unif X C T D _ _ :- name X, name T, X = T, unify-ctxs C D. % 1 step reduction TODO:1 unif (global (const GR)) C T D M U :- unfold GR none C X1 C1, !, unif X1 C1 T D M U. unif (pglobal (const GR) I) C T D M U :- unfold GR (some I) C X1 C1, !, unif X1 C1 T D M U. unif (let N TB B F) C1 T C2 M U :- !, @pi-def N TB B x\ unif {hd-beta (F x) C1} T C2 M U. unif (match A _ L) C T D M U :- whd-indc A GR KA, !, unif {match-red GR KA L C} T D M U. unif (fix _ N _ F as X) C T D M U :- nth-stack N C LA A RA, whd-indc A GR KA, !, unif {fix-red F X LA GR KA RA} T D M U. unif X C T D M U :- name X, def X _ _ V, !, unif {hd-beta V C} T D M U. % TODO we could use _VN if nonflex % TODO:1 turn into (if reducible then reduce1 else fully-reduce2 tt) % symmetry unif X C T D ff U :- !, unif T D X C tt U. % error % unif X C1 Y C2 _tt :- !, % print "Error: " {coq.term->string {unwind X C1}} "vs" {coq.term->string {unwind Y C2}}. %, halt. % Contexts happens to be lists, so we just reuse the code pred unify-list i:list term, i:list term. unify-list L1 L2 :- unify-ctxs L1 L2. % the entry points of rec calls: unify unify-ctxs pred unify-ctxs i:list term, i:list term. unify-ctxs [] []. unify-ctxs [X|XS] [Y|YS] :- unify X Y eq, !, unify-ctxs XS YS. % Note lists are reversed + the 2nd length should be leq then the 1st pred unify-lists i:list term, i:list term. unify-lists [X] [Y] :- !, X = Y. unify-lists L [X] :- !, app {std.rev L} = X. unify-lists [X|Xs] [Y|Ys] :- X = Y, unify-lists Xs Ys. pred unify i:term, i:term, i:cumul. unify T1 (app [HD|TL]) _ :- not (var T1), var HD, !, T1 = app L1, unify-lists {std.rev L1} {std.rev [HD|TL]}. unify A B C :- unif {hd-beta A []} {hd-beta B []} ff C. %%%% Flexible case %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Binding a list of terms (delift in Matita, invert subst in Coq) % We use a keyd discipline, i.e. we only bind terms with a rigid head pred key i:term. key (global _) :- !. key (pglobal _ _) :- !. key C :- name C, !. key (primitive _) :- !. pred bind-list i:list term, i:term, o:any. bind-list [] T T' :- bind T T1, T1 = T'. bind-list [app [C| AS] |VS] T R :- key C, !, pi x\ (pi L X\ bind (app[C|L]) X :- get-option "unif:greedy" tt, unify-list-eq L AS, X = x, !) => (pi L X\ bind (app[C|L]) X :- not (get-option "unif:greedy" tt),unify-list-eq L AS, X = x) => bind-list VS T (R x). bind-list [C|VS] T R :- key C, def C _ _ V, key V, !, pi x\ @tail-cut-if "unif:greedy" (bind C x) true => @tail-cut-if "unif:greedy" (bind V x) true => bind-list VS T (R x). bind-list [C|VS] T R :- key C, !, pi x\ @tail-cut-if "unif:greedy" (bind C x) true => bind-list VS T (R x). bind-list [ _ |VS] T R :- !, pi x\ bind-list VS T (R x). % CAVEAT: (app FLEX), (match _ _ FLEX) are not terms! pred bind i:term, o:term. bind X Y :- name X, X = Y, !. bind X Y :- name X, def X _ _ T, !, bind T Y. bind (global _ as C) C :- !. bind (pglobal _ _ as C) C :- !. bind (sort _ as C) C :- !. bind (fix N Rno Ty F) (fix N Rno Ty1 F1) :- !, bind Ty Ty1, pi x\ decl x N Ty => bind (F x) (F1 x). bind (match T Rty B) X :- !, bind T T1, bind Rty Rty1, map B bind B1, X = (match T1 Rty1 B1). bind (app L) X :- !, map L bind L1, X = app L1. bind (fun N T F) (fun N T1 F1) :- !, bind T T1, pi x\ decl x N T => bind (F x) (F1 x). bind (let N T B F) (let N T1 B1 F1) :- !, bind T T1, bind B B1, @pi-def N T B x\ bind (F x) (F1 x). bind (prod N T F) X :- !, bind T T1, (@pi-decl N T x\ bind (F x) (F1 x)), X = (prod N T1 F1). bind (uvar M L) W :- map L bind L1, coq.mk-app-uvar M L1 W. unify-eq X Y :- unify X Y eq. unify-leq X Y :- unify X Y leq. } } pred tc.unif-aux i:(pred i:A, i:A), i:A, i:A. tc.unif-aux P A B :- (pi K A AS X C TA F\ hd-beta (uvar as K) [A|AS] X C :- !, % auto-intro std.assert-ok! (coq.typecheck A TA) "already typed", K = (fun `hd_beta_auto` TA F), hd-beta (F A) AS X C) => (pi K A AS X C TA F\ hd-beta-zeta (uvar as K) [A|AS] X C :- !, % auto-intro std.assert-ok! (coq.typecheck A TA) "already typed", K = (fun `hd_beta_zeta_auto` TA F), hd-beta-zeta (F A) AS X C) => P A B. pred tc.unify-eq i:term, i:term. pred tc.unify-leq i:term, i:term. pred tc.unify-list-eq i:list term, i:list term. tc.unify-eq X Y :- tc.unif-aux tc.unif.unify-eq X Y. tc.unify-leq X Y :- tc.unif-aux tc.unif.unify-leq X Y. tc.unify-list-eq X Y :- tc.unif-aux tc.unif.unify-list X Y. LPCIC-coq-elpi-eb449d7/apps/tc/examples/000077500000000000000000000000001523041753400176725ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/examples/dune000066400000000000000000000001551523041753400205510ustar00rootroot00000000000000(coq.theory (name elpi.apps.tc.examples) (theories elpi elpi.apps.tc Stdlib)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/tc/examples/tutorial.v000066400000000000000000000052211523041753400217240ustar00rootroot00000000000000From Stdlib Require Import Bool. From elpi.apps Require Import tc. Class Eqb (T: Type) := { eqb : T -> T -> bool; eqb_leibniz A B: eqb A B = true <-> A = B }. #[refine] Instance eqBool : Eqb bool := { eqb x y := if x then y else negb y }. Proof. intros [] []; intuition. Qed. #[refine] Instance eqProd (A B : Type) : Eqb A -> Eqb B -> Eqb (A * B) := { eqb x y := eqb (fst x) (fst y) && eqb (snd x) (snd y) }. Proof. intros [] []. split. intros; simpl in H. * case (eqb a a0) eqn:aB, (eqb b b0) eqn:bB; try easy. apply pair_equal_spec; destruct e, e0; split. apply eqb_leibniz0; auto. apply eqb_leibniz1; auto. * intros. apply pair_equal_spec in H; destruct H; subst. simpl. apply andb_true_intro; destruct e, e0; split. apply eqb_leibniz0; auto. apply eqb_leibniz1; auto. Qed. TC.Print_instances. TC.Get_class_info Eqb. (* Abstraction of elpi context variable *) Section Foo. Variable (A B: Type) (HA : Eqb A) (HB : Eqb B). #[refine] Global Instance eqProd' : Eqb (A * B) := { eqb x y := eqb (fst x) (fst y) && eqb (snd x) (snd y) }. Proof. intros [] []; simpl; split; intros. apply eqb_leibniz. destruct H. replace (eqb (a, b) (a0, b0)) with (eqb a a0 && eqb b b0); auto. admit. apply andb_true_intro; apply pair_equal_spec in H; split; apply eqb_leibniz; easy. Admitted. (* Here we see that HA and HB are compiled in elpi since their type is a class *) TC.Print_instances Eqb. (* The rules for eqProd' is as follows shorten tc-tutorial.{tc-Eqb}. tc-Eqb {{prod A B}} {{eqProd'}}. Remark: Here A and B are not elpi variables, but the coq variables from the context *) Elpi Print TC.Solver "elpi.apps.tc.examples/TC.Solver". End Foo. (* On section end the local instances are removed (i.e. HA and HB disappears) and eqProd' is recompiled *) TC.Print_instances Eqb. (* the rules for eqProd' is as follows shorten tc-tutorial.{tc-Eqb}. tc-Eqb {{prod lp:A lp:B}} {{eqProd' lp:A lp:B lp:PA lp:PB}} :- tc-Eqb A PA, tc-Eqb B PB. Remark: Here A and B are elpi variables and PA, PB are the proof that we can prove {{Eqb lp:A}} and {{Eqb lp:B}} *) TC.Get_class_info Eqb. Module Backtrack. Elpi TC Solver Override TC.Solver All. Class NoBacktrack (n: nat). TC.Set_deterministic NoBacktrack. Class A (n: nat). Instance a0 : A 0. Qed. Instance nb0 : NoBacktrack 0. Qed. Instance nb1 : NoBacktrack 1. Qed. Instance a3 n : NoBacktrack n -> A n -> A 3. Qed. Goal A 3. Fail apply _. Abort. Elpi Print TC.Solver "elpi.apps.tc.examples/TC.Solver". End Backtrack. TC.Print_instances. (* Require Stdlib *) (* TC.Get_class_info DecidableClass.Decidable. *) LPCIC-coq-elpi-eb449d7/apps/tc/src/000077500000000000000000000000001523041753400166435ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/src/dune000066400000000000000000000005061523041753400175220ustar00rootroot00000000000000(library (name elpi_tc_plugin) (public_name rocq-elpi.tc) (flags :standard -w -27) (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) (libraries rocq-runtime.plugins.ltac rocq-runtime.vernac rocq-elpi.elpi)) (coq.pp (modules rocq_elpi_tc_hook)) LPCIC-coq-elpi-eb449d7/apps/tc/src/elpi_tc_plugin.mlpack000066400000000000000000000001331523041753400230260ustar00rootroot00000000000000Rocq_elpi_tc_time Rocq_elpi_tc_register Rocq_elpi_class_tactics_takeover Rocq_elpi_tc_hook LPCIC-coq-elpi-eb449d7/apps/tc/src/rocq_elpi_class_tactics_takeover.ml000066400000000000000000000146101523041753400257530ustar00rootroot00000000000000(* rocq-elpi: Coq terms as the object language of elpi *) (* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) type aaction = ARm | AAdd | ASet | ANone | AAll module Rocq_elpi_lib_obj = struct let add_obj_no_discharge name cache = Libobject.(declare_object (global_object_nodischarge name ~cache ~subst:None)) let add_superobj_no_discharge name cache = Libobject.(declare_object (superglobal_object_nodischarge name ~cache ~subst:None)) end open Util open Typeclasses open Elpi open Elpi_plugin open Rocq_elpi_utils module GRSet = Names.GlobRef.Set module CSMap = CString.Map let qname2str observer = String.concat "." observer let str2gr = Rocq_elpi_utils.locate_simple_qualid let elpi_fails program_name = let open Pp in let kind = "TC_Solve" in let name = show_qualified_name program_name in CErrors.user_err (strbrk (String.concat " " [ "The elpi"; kind; name ; "failed without giving a specific error message."; "Please report this inconvenience to the authors of the program." ])) module type M = sig type elt type t val empty : t val diff : t -> t -> t val union : t -> t -> t val add : elt -> t -> t val gr2elt : Names.GlobRef.t -> elt val mem : elt -> t -> bool val of_qualid_list : Libnames.qualid list -> t end (* Set of overridden class *) module OSet : M = struct module M = GRSet type t = M.t type elt = M.elt let empty = M.empty let diff = M.diff let union = M.union let add = M.add let mem = M.mem let gr2elt (x: Names.GlobRef.t) : elt = x let of_qualid_list (x: Libnames.qualid list) : t = let add s x = add (Rocq_elpi_utils.locate_simple_qualid x) s in List.fold_left add empty x end module Modes = struct (** override_mode *) type omode = | AllButFor of OSet.t | Only of OSet.t type action = | Set of omode | Add of OSet.t | Rm of OSet.t let omodes = ref (CSMap.empty : omode CSMap.t) let create_solver_omode solver = omodes := CSMap.add solver (Only OSet.empty) !omodes let takeover (qname, new_mode,c) = let name = qname2str qname in if c then create_solver_omode name else let old_mode = CSMap.find name !omodes in let new_mode = match old_mode, new_mode with | _, Set(mode) -> mode | AllButFor s, Add grl -> AllButFor (OSet.diff s grl) | AllButFor s, Rm grl -> AllButFor (OSet.union s grl) | Only s, Add grl -> Only (OSet.union s grl) | Only s, Rm grl -> Only (OSet.diff s grl) in omodes := CSMap.set name new_mode !omodes let cache_solver_mode = Rocq_elpi_lib_obj.add_superobj_no_discharge "TC_Solver_omode" takeover end module Solver = struct let solve_TC_solver = fun program env sigma ~depth ~unique ~best_effort ~goals -> let atts = [] in let gls = goals in let query ~base state = let loc = Elpi.API.State.get Rocq_elpi_builtins_synterp.invocation_site_loc state in let depth = 0 in let state, q, gls = Rocq_elpi_HOAS.solvegoals2query sigma gls loc ~main:[] ~in_elpi_tac_arg:Rocq_elpi_arg_HOAS.(in_elpi_tac ~loc:(to_coq_loc loc)) ~depth ~base state in let state, qatts = Rocq_elpi_vernacular.atts2impl loc Summary.Stage.Interp ~depth state atts q in let state = API.State.set Rocq_elpi_builtins.tactic_mode state true in state, qatts, gls in let loc = Loc.initial Loc.ToplevelInput in match Rocq_elpi_vernacular.Interp.get_and_compile ~loc program with | None -> assert false | Some (base,_) -> match Rocq_elpi_vernacular.Interp.run ~loc base (Fun (query ~base)) with | API.Execute.Success solution -> let sigma, sub_goals, to_shelve = Rocq_elpi_HOAS.solution2evd ~eta_contract_solution:true sigma solution (Evar.Set.of_list goals) in let sigma = Evd.shelve sigma sub_goals in sub_goals = [], sigma | API.Execute.NoMoreSteps -> CErrors.user_err Pp.(str "elpi run out of steps") | API.Execute.Failure -> elpi_fails program | exception (Rocq_elpi_utils.LtacFail (level, msg)) -> raise Not_found [%%if coq = "9.0" || coq = "9.1"] let solve_TC program = let open Class_tactics in { solver = fun env sigma ~depth ~unique ~best_effort ~goals -> solve_TC_solver program env sigma ~depth ~unique ~best_effort ~goals } [%%else] let solve_TC program = let open Class_tactics in { solver = fun ?db env sigma ~depth ~unique ~best_effort ~goals -> solve_TC_solver program env sigma ~depth ~unique ~best_effort ~goals } [%%endif] type action = | Create | Activate | Deactivate let covered1 env sigma classes i default = let ei = Evd.find_undefined sigma i in let ty = Evd.evar_concl ei in match Typeclasses.class_of_constr env sigma ty with | Some (_,((cl,_),_)) -> OSet.mem (OSet.gr2elt cl.cl_impl) classes | None -> default let covered omode env sigma s = match omode () with | Modes.AllButFor blacklist -> Evar.Set.for_all (fun x -> not (covered1 env sigma blacklist x false)) s | Only whitelist -> Evar.Set.for_all (fun x -> covered1 env sigma whitelist x true) s let action_manager (qname, x) = let name = qname2str qname in match x with | Create -> Class_tactics.register_solver ~name (solve_TC qname, covered (fun () -> CSMap.get name !Modes.omodes)); | Activate -> Class_tactics.activate_solver ~name | Deactivate -> Class_tactics.deactivate_solver ~name let cache_solver = Rocq_elpi_lib_obj.add_superobj_no_discharge "TC_Solver" action_manager end let set_solver_mode kind qname (l: Libnames.qualid list) = let l = OSet.of_qualid_list l in let cache_solver_mode = Modes.cache_solver_mode in match kind with | AAdd -> Lib.add_leaf (cache_solver_mode (qname, Add l, false)) | ARm -> Lib.add_leaf (cache_solver_mode (qname, Rm l, false)) | AAll -> Lib.add_leaf (cache_solver_mode (qname, Set (AllButFor OSet.empty), false)) | ANone-> Lib.add_leaf (cache_solver_mode (qname, Set (Only OSet.empty), false)) | ASet -> Lib.add_leaf (cache_solver_mode (qname, Set (Only l), false)) let solver_register l = Lib.add_leaf (Solver.cache_solver (l, Create)); Lib.add_leaf (Modes.cache_solver_mode (l, Add OSet.empty, true)) let solver_activate l = Lib.add_leaf (Solver.cache_solver (l, Activate)) let solver_deactivate l = Lib.add_leaf (Solver.cache_solver (l, Deactivate)) LPCIC-coq-elpi-eb449d7/apps/tc/src/rocq_elpi_class_tactics_takeover.mli000066400000000000000000000011141523041753400261170ustar00rootroot00000000000000(* rocq-elpi: Coq terms as the object language of elpi *) (* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) type aaction = ARm | AAdd | ASet | ANone | AAll val set_solver_mode : aaction -> string list -> Libnames.qualid list -> unit val solver_register : Elpi_plugin.Rocq_elpi_utils.qualified_name -> unit val solver_activate : Elpi_plugin.Rocq_elpi_utils.qualified_name -> unit val solver_deactivate : Elpi_plugin.Rocq_elpi_utils.qualified_name -> unit LPCIC-coq-elpi-eb449d7/apps/tc/src/rocq_elpi_tc_hook.mlg000066400000000000000000000045041523041753400230320ustar00rootroot00000000000000(* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) DECLARE PLUGIN "rocq-elpi.tc" { open Stdarg open Elpi_plugin open Rocq_elpi_arg_syntax open Rocq_elpi_tc_register open Rocq_elpi_class_tactics_takeover } VERNAC COMMAND EXTEND ElpiTypeclasses CLASSIFIED AS SIDEFF | #[ atts = any_attribute ] [ "Elpi" "Register" "TC" "Compiler" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in register_observer (fst p, snd p, atts) } | #[ atts = any_attribute ] [ "Elpi" "TC" "Activate" "Observer" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in activate_observer (snd p) } | #[ atts = any_attribute ] [ "Elpi" "TC" "Deactivate" "Observer" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in deactivate_observer (snd p) } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Register" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in solver_register(snd p) } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Activate" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in solver_activate(snd p) } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Deactivate" qualified_name(p) ] -> { let () = ignore_unknown_attributes atts in solver_deactivate(snd p) } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Override" qualified_name(p) "All" ] -> { let () = ignore_unknown_attributes atts in set_solver_mode AAll (snd p) [] } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Override" qualified_name(p) "None" ] -> { let () = ignore_unknown_attributes atts in set_solver_mode ANone (snd p) [] } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Override" qualified_name(p) "Only" ne_reference_list(cs) ] -> { let () = ignore_unknown_attributes atts in set_solver_mode ASet (snd p) cs } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Override" qualified_name(p) "Add" reference_list(cs) ] -> { let () = ignore_unknown_attributes atts in set_solver_mode AAdd (snd p) cs } | #[ atts = any_attribute ] [ "Elpi" "TC" "Solver" "Override" qualified_name(p) "Rm" reference_list(cs) ] -> { let () = ignore_unknown_attributes atts in set_solver_mode ARm (snd p) cs } ENDLPCIC-coq-elpi-eb449d7/apps/tc/src/rocq_elpi_tc_register.ml000066400000000000000000000132671523041753400235550ustar00rootroot00000000000000(* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) open Elpi_plugin open Classes open Rocq_elpi_arg_HOAS open Names type qualified_name = Rocq_elpi_utils.qualified_name type loc_name_atts = (Loc.t * qualified_name * Attributes.vernac_flags) (* Hack to convert a Coq GlobRef into an elpi string *) let gref2elpi_term (gref: GlobRef.t) : Cmd.raw = let gref_2_string gref = Pp.string_of_ppcmds (Printer.pr_global gref) in Cmd.String (gref_2_string gref) let mode2str = function | None | Some [] -> "" | Some (x::xs) -> let pp_mode = Hints.string_of_mode in List.fold_left (fun acc e -> acc ^ " " ^ pp_mode e) (pp_mode x) xs (* Returns the elpi term representing the type class received in argument *) let observer_class m (x : Typeclasses.typeclass) : Rocq_elpi_arg_HOAS.Cmd.raw list = [Cmd.String "new_class"; gref2elpi_term x.cl_impl; Cmd.String (mode2str m)] let observer_default_instance (x : Typeclasses.typeclass) : Rocq_elpi_arg_HOAS.Cmd.raw list = [Cmd.String "default_instance";gref2elpi_term x.cl_impl] let observer_coercion add (x : Typeclasses.typeclass) : Rocq_elpi_arg_HOAS.Cmd.raw list = let name2str x = Cmd.String (Names.Name.print x |> Pp.string_of_ppcmds) in let proj = x.cl_projs |> List.map (fun (x: Typeclasses.class_method) -> x.meth_name) in let mode = if add then "add_coercions" else "remove_coercions" in Cmd.String mode :: List.map name2str proj (** Returns the list of Cmd.raw arguments to be passed to the elpi program in charge to compile instances. The arguments are [Inst, TC, Locality, Prio] where: - Inst : is the elpi Term for the current instance - TC : is the elpi Term for the type class implemented by Inst - Locality : is the elpi String [Local|Global|Export] for the locality of Inst - Prio : is the elpi Int N representing the priority of the instance. N is: | -1 if the instance has no user-defined priority | N if the instance has the user-defined priority N *) let observer_instance ({locality; instance; info; class_name} : instance) : Rocq_elpi_arg_HOAS.Cmd.raw list = let locality2elpi_string loc = let hint2string = function | Hints.Local -> "Local" | Export -> "Export" | SuperGlobal -> "Global" in Cmd.String (hint2string loc) in let prio2elpi_int (prio: Typeclasses.hint_info) = Cmd.Int (Option.default (-1) prio.hint_priority) in [ Cmd.String "new_instance"; gref2elpi_term instance; gref2elpi_term class_name; locality2elpi_string locality; prio2elpi_int info ] let class_runner f m cl = let actions = [ observer_coercion false; observer_class m; observer_coercion true; (* observer_default_instance *) ] in List.iter (fun obs -> f (obs cl)) actions let observer_class = Libobject.declare_object @@ Libobject.local_object "TC_HACK_OBSERVER_CLASSES" ~cache:(fun (run,m,cl) -> class_runner run m cl) ~discharge:(fun x -> Some x) let observer_instance = Libobject.declare_object @@ Libobject.local_object "TC_HACK_OBSERVER_INSTANCE" ~cache:(fun (run,inst) -> run @@ observer_instance inst) ~discharge:(fun (_,inst as x) -> if inst.locality = Local then None else Some x) [%%if coq = "9.0" || coq = "9.1" || coq = "9.2"] let observer_class_disp rp c = (observer_class (rp,None,c)) [%%else] let observer_class_disp rp (omode,c) = (observer_class (rp,omode,c)) [%%endif] let observer_evt ((loc, name, atts) : loc_name_atts) (x : Event.t) = let open Rocq_elpi_vernacular in let run_program e = Interp.run_program ~loc name ~syndata:None ~atts e in match x with | Event.NewClass cl -> Lib.add_leaf (observer_class_disp run_program cl) | Event.NewInstance inst -> Lib.add_leaf (observer_instance (run_program,inst)) module StringMap = Map.Make(String) type observers = observer StringMap.t let observers : observers ref = Summary.ref StringMap.empty ~name:"tc_observers" let build_observer_name (observer : qualified_name) = String.concat "." observer type action = | Create of string * loc_name_atts | Activate of qualified_name | Deactivate of qualified_name let action_manager x = match x with | Create (name, loc_name_atts) -> let t1 = Sys.time () in begin try let observer = Classes.register_observer ~name (observer_evt loc_name_atts) in observers := StringMap.add name observer !observers; Classes.activate_observer observer with e when Rocq_elpi_utils.is_sync_anomaly e -> Feedback.msg_warning Pp.(str (Printf.sprintf "%s already registered" name)) end; let t2 = Sys.time () in if Rocq_elpi_tc_time.get_time_tc_bench () then Feedback.msg_debug Pp.(str @@ Printf.sprintf "[TC] register.ml time is %.5f" (t1 -. t2)) | Activate observer -> Classes.activate_observer (StringMap.find (build_observer_name observer) !observers) | Deactivate observer -> Classes.deactivate_observer (StringMap.find (build_observer_name observer) !observers) (* Take an action and execute it with the action manager *) let inTakeover = let cache = action_manager in Libobject.(declare_object (superglobal_object_nodischarge "TC_HACK_OBSERVER" ~cache ~subst:None)) (* Adds a new observer in coq and activate it *) let register_observer ((_, name, _) as lna : loc_name_atts) = let obs_name = build_observer_name name in Lib.add_leaf (inTakeover (Create (obs_name, lna))) let activate_observer (observer : qualified_name) = Lib.add_leaf (inTakeover (Activate observer)) let deactivate_observer (observer : qualified_name) = Lib.add_leaf (inTakeover (Deactivate observer)) LPCIC-coq-elpi-eb449d7/apps/tc/src/rocq_elpi_tc_time.ml000066400000000000000000000006741523041753400226650ustar00rootroot00000000000000open Elpi_plugin let time_tc_bench = ref false let set_time_tc_bench = (:=) time_tc_bench let get_time_tc_bench () = !time_tc_bench let () = Goptions.declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Time";"TC";"Bench"]; optread = get_time_tc_bench; optwrite = set_time_tc_bench; } let time_all b = CDebug.set_flag Rocq_elpi_utils.elpitime_flag b; set_time_tc_bench b LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/000077500000000000000000000000001523041753400204755ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/bench/000077500000000000000000000000001523041753400215545ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/bench/bench_inj.py000066400000000000000000000074551523041753400240600ustar00rootroot00000000000000import subprocess import time import sys import os import re """ About this file: - it aims to test elpi vs coq performances of type class search. - it should be run from the ./apps/tc folder - parameters of command line: * N : the depth of the tree to build in tests/test.v * -nocoq : optional to test only elpi * -onlyOne : optional to run the test only for the tree of size N. By default, the tests are made for each i in [1..N] included """ INJ_BASE_FUN = "f" KEYS = "coqT, elpiT, tcSearch, refineT, compilT, runtimeT, buildQuery".split(", ") def buildDict(): res = dict() for key in KEYS: res[key] = [] return res def printDict(d): for key in KEYS: d[key] = sum(d[key])/len(d[key]) L = [d[k] for k in KEYS] L.append(d["elpiT"] - d["refineT"] - d["buildQuery"]) L.append(d["coqT"] / d["elpiT"]) L.append(d["elpiT"] / d["coqT"] if d["coqT"] > 0 else 100) print(", ".join(map(lambda x: str(round(x, 5)), L))) def findFloats(s): return [float(x) for x in re.findall("\d+\.\d*", s)] def filterLines(lines): #print(lines) validStarts = ["Finished", "Refine", "Elpi:", "Instance search", "Time build query"] for line in lines.split("\n"): for start in validStarts: if start in line: yield line def parseFile(s): lines = [findFloats(x) for x in filterLines(s)] #print(lines) base = 0 coqT = lines[base][0] buildQuery = lines[base + 1][0] tcSearch = lines[base + 2][0] refineT = lines[base + 3][0] elpiStats = lines[base + 4] compilT, runtimeT = elpiStats[0], elpiStats[-1] elpiT = lines[base + 5][0] res = buildDict() for key in KEYS: res[key].append(eval(key)) #print(res) return res def buildTree(len): if len == 0: return INJ_BASE_FUN + " " S = buildTree(len-1) STR = "(compose " + S + S + ")" return STR accumulate = """ Elpi Accumulate TC_solver lp:{{ :after "firstHook" tc {{:gref Inj}} {{Inj lp:R1 lp:R1 (@compose lp:A lp:A lp:A lp:L lp:R)}} Sol :- L = R, !, tc {{:gref Inj}} {{Inj lp:R1 lp:R1 lp:L}} InjL, Sol = {{@compose_inj lp:A lp:A lp:A lp:R1 lp:R1 lp:R1 lp:L lp:L lp:InjL lp:InjL }}. }}. """ def writeFile(fileName: str, composeLen: int, isCoq: bool): PREAMBLE = f"""\ From elpi_apps_tc_tests_stdlib Require Import {"stdppInjClassic" if isCoq else "stdppInj"}. {"" if isCoq else 'Elpi TC.Solver. Set TC Time Refine. Set TC Time Instance Search. Set TC Time Build Query. Set Debug "elpitime".'} """ GOAL = buildTree(composeLen) with open(fileName + ".v", "w") as fd: fd.write(PREAMBLE) fd.write(f"Goal Inj eq eq({GOAL}). Time apply _. Qed.\n") def runCoqMake(fileName): fileName = fileName + ".vo" if (os.path.exists(file_name)): subprocess.run(["rm", fileName]) return subprocess.check_output(["make", fileName]).decode() def run(file_name, height): def partialFun(isCoq: bool): writeFile(file_name, height, isCoq) return runCoqMake(file_name) return partialFun def loopTreeDepth(file_name: str, maxHeight: int, makeCoq=True, onlyOne=False): print("Height, Coq, Elpi, TC search, Refine, ElpiCompil, ElpiRuntime, BuildQuery, ElpiNoRefine, Ratio(Coq/Elpi), Ratio(Elpi/Coq)") for i in range(1 if not onlyOne else maxHeight, maxHeight+1): FUN = run(file_name, i) x = FUN(True) if makeCoq else "Finished 0.0" y = FUN(False) print(i, ", ", end="", sep="") # print("The xx result is " , x) dic = parseFile(x + y) printDict(dic) if __name__ == "__main__": print(os.curdir) file_name = "tests/bench/bench_inj" height = int(sys.argv[1]) loopTreeDepth(file_name, height, makeCoq=not ( "-nocoq" in sys.argv), onlyOne=("-onlyOne" in sys.argv)) #writeFile(file_name, 1, False) LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/bench/bench_inj.v000066400000000000000000000003021523041753400236550ustar00rootroot00000000000000From elpi_apps_tc_tests_stdlib Require Import stdppInj. Elpi TC.Solver. Set TC Time Refine. Set TC Time Instance Search. Set Debug "elpitime". Goal Inj eq eq((compose f f )). Time apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/bigTest.v000066400000000000000000002346241523041753400223000ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. (** This file collects type class interfaces, notations, and general theorems that are used throughout the whole development. Most importantly it contains abstract interfaces for ordered structures, sets, and various other data structures. *) (* We want to ensure that [le] and [lt] refer to operations on [nat]. These two functions being defined both in [Stdlib.Bool] and in [Stdlib.Peano], we must export [Stdlib.Peano] later than any export of [Stdlib.Bool]. *) (* We also want to ensure that notations from [Stdlib.Utf8] take precedence over the ones of [Stdlib.Peano] (see Coq PR#12950), so we import [Utf8] last. *) From Corelib Require Export Morphisms RelationClasses ListDef Setoid. From Stdlib Require Export Bool List Peano Utf8 Permutation. From Stdlib Require Export Program.Basics Program.Syntax. Export ListNotations. TC.AddAllClasses. TC.AddAllInstances. (** This notation is necessary to prevent [length] from being printed as [strings.length] if strings.v is imported and later base.v. See also strings.v and https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/144 and https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/129. *) Notation length := Datatypes.length. (** * Enable implicit generalization. *) (** This option enables implicit generalization in arguments of the form [`{...}] (i.e., anonymous arguments). Unfortunately, it also enables implicit generalization in [Instance]. We think that the fact that both behaviors are coupled together is a [bug in Coq](https://github.com/coq/coq/issues/6030). *) Global Generalizable All Variables. (** * Tweak program *) (** 1. Since we only use Program to solve logical side-conditions, they should always be made Opaque, otherwise we end up with performance problems due to Coq blindly unfolding them. Note that in most cases we use [Next Obligation. (* ... *) Qed.], for which this option does not matter. However, sometimes we write things like [Solve Obligations with naive_solver (* ... *)], and then the obligations should surely be opaque. *) Global Unset Transparent Obligations. (** 2. Do not let Program automatically simplify obligations. The default obligation tactic is [Tactics.program_simpl], which, among other things, introduces all variables and gives them fresh names. As such, it becomes impossible to refer to hypotheses in a robust way. *) Global Obligation Tactic := idtac. (** 3. Hide obligations and unsealing lemmas from the results of the [Search] commands. *) Add Search Blacklist "_obligation_". Add Search Blacklist "_unseal". (** * Sealing off definitions *) #[projections(primitive=yes)] Record seal {A} (f : A) := { unseal : A; seal_eq : unseal = f }. Global Arguments unseal {_ _} _ : assert. Global Arguments seal_eq {_ _} _ : assert. (** * Solving type class instances *) (** The tactic [tc_solve] is used to solve type class goals by invoking type class search. It is similar to [apply _], but it is more robust since it does not affect unrelated goals/evars due to https://github.com/coq/coq/issues/6583. The tactic [tc_solve] is particularly useful when building custom tactics that need tight control over when type class search is invoked. In Iris, many of the proof mode tactics make use of [notypeclasses refine] and use [tc_solve] to manually invoke type class search. Note that [typeclasses eauto] is multi-success. That means, whenever subsequent tactics fail, it will backtrack to [typeclasses eauto] to try the next type class instance. This is almost always undesired and can lead to poor performance and horrible error messages. Hence, we wrap it in a [once]. *) Ltac tc_solve := solve [once (typeclasses eauto)]. (** * Non-backtracking type classes *) (** The type class [TCNoBackTrack P] can be used to establish [P] without ever backtracking on the instance of [P] that has been found. Backtracking may normally happen when [P] contains evars that could be instanciated in different ways depending on which instance is picked, and type class search somewhere else depends on this evar. The proper way of handling this would be by setting Coq's option `Typeclasses Unique Instances`. However, this option seems to be broken, see Coq issue #6714. See https://gitlab.mpi-sws.org/FP/iris-coq/merge_requests/112 for a rationale of this type class. *) Class TCNoBackTrack (P : Prop) := TCNoBackTrack_intro { tc_no_backtrack : P }. Global Hint Extern 0 (TCNoBackTrack _) => notypeclasses refine (TCNoBackTrack_intro _ _); tc_solve : typeclass_instances. (* A conditional at the type class level. Note that [TCIf P Q R] is not the same as [TCOr (TCAnd P Q) R]: the latter will backtrack to [R] if it fails to establish [Q], i.e. does not have the behavior of a conditional. Furthermore, note that [TCOr (TCAnd P Q) (TCAnd (TCNot P) R)] would not work; we generally would not be able to prove the negation of [P]. *) Inductive TCIf (P Q R : Prop) : Prop := | TCIf_true : P → Q → TCIf P Q R | TCIf_false : R → TCIf P Q R. Existing Class TCIf. Global Hint Extern 0 (TCIf _ _ _) => first [notypeclasses refine (TCIf_true _ _ _ _ _); [tc_solve|] |notypeclasses refine (TCIf_false _ _ _ _)] : typeclass_instances. (** * Typeclass opaque definitions *) (** The constant [tc_opaque] is used to make definitions opaque for just type class search. Note that [simpl] is set up to always unfold [tc_opaque]. *) Definition tc_opaque {A} (x : A) : A := x. Global Typeclasses Opaque tc_opaque. Global Arguments tc_opaque {_} _ /. (** Below we define type class versions of the common logical operators. It is important to note that we duplicate the definitions, and do not declare the existing logical operators as type classes. That is, we do not say: Existing Class or. Existing Class and. If we could define the existing logical operators as classes, there is no way of disambiguating whether a premise of a lemma should be solved by type class resolution or not. These classes are useful for two purposes: writing complicated type class premises in a more concise way, and for efficiency. For example, using the [Or] class, instead of defining two instances [P → Q1 → R] and [P → Q2 → R] we could have one instance [P → Or Q1 Q2 → R]. When we declare the instance that way, we avoid the need to derive [P] twice. *) Inductive TCOr (P1 P2 : Prop) : Prop := | TCOr_l : P1 → TCOr P1 P2 | TCOr_r : P2 → TCOr P1 P2. Existing Class TCOr. Global Existing Instance TCOr_l | 9. Global Existing Instance TCOr_r | 10. Global Hint Mode TCOr ! ! : typeclass_instances. Inductive TCAnd (P1 P2 : Prop) : Prop := TCAnd_intro : P1 → P2 → TCAnd P1 P2. Existing Class TCAnd. Global Existing Instance TCAnd_intro. Global Hint Mode TCAnd ! ! : typeclass_instances. Inductive TCTrue : Prop := TCTrue_intro : TCTrue. Existing Class TCTrue. Global Existing Instance TCTrue_intro. (** The class [TCFalse] is not stricly necessary as one could also use [False]. However, users might expect that TCFalse exists and if it does not, it can cause hard to diagnose bugs due to automatic generalization. *) Inductive TCFalse : Prop :=. Existing Class TCFalse. (** The class [TCUnless] can be used to check that search for [P] fails. This is useful as a guard for certain instances together with classes like [TCFastDone] (see [tactics.v]) to prevent infinite loops (e.g. when saturating the context). *) Notation TCUnless P := (TCIf P TCFalse TCTrue). Inductive TCForall {A} (P : A → Prop) : list A → Prop := | TCForall_nil : TCForall P [] | TCForall_cons x xs : P x → TCForall P xs → TCForall P (x :: xs). Existing Class TCForall. Global Existing Instance TCForall_nil. Global Existing Instance TCForall_cons. Global Hint Mode TCForall ! ! ! : typeclass_instances. (** The class [TCForall2 P l k] is commonly used to transform an input list [l] into an output list [k], or the converse. Therefore there are two modes, either [l] input and [k] output, or [k] input and [l] input. *) Inductive TCForall2 {A B} (P : A → B → Prop) : list A → list B → Prop := | TCForall2_nil : TCForall2 P [] [] | TCForall2_cons x y xs ys : P x y → TCForall2 P xs ys → TCForall2 P (x :: xs) (y :: ys). Existing Class TCForall2. Global Existing Instance TCForall2_nil. Global Existing Instance TCForall2_cons. Global Hint Mode TCForall2 ! ! ! ! - : typeclass_instances. Global Hint Mode TCForall2 ! ! ! - ! : typeclass_instances. Inductive TCExists {A} (P : A → Prop) : list A → Prop := | TCExists_cons_hd x l : P x → TCExists P (x :: l) | TCExists_cons_tl x l: TCExists P l → TCExists P (x :: l). Existing Class TCExists. Global Existing Instance TCExists_cons_hd | 10. Global Existing Instance TCExists_cons_tl | 20. Global Hint Mode TCExists ! ! ! : typeclass_instances. Inductive TCElemOf {A} (x : A) : list A → Prop := | TCElemOf_here xs : TCElemOf x (x :: xs) | TCElemOf_further y xs : TCElemOf x xs → TCElemOf x (y :: xs). Existing Class TCElemOf. Global Existing Instance TCElemOf_here. Global Existing Instance TCElemOf_further. Global Hint Mode TCElemOf ! ! ! : typeclass_instances. (** The intended use of [TCEq x y] is to use [x] as input and [y] as output, but this is not enforced. We use output mode [-] (instead of [!]) for [x] to ensure that type class search succeed on goals like [TCEq (if ? then e1 else e2) ?y], see https://gitlab.mpi-sws.org/iris/iris/merge_requests/391 for a use case. Mode [-] is harmless, the only instance of [TCEq] is [TCEq_refl] below, so we cannot create loops. *) Inductive TCEq {A} (x : A) : A → Prop := TCEq_refl : TCEq x x. Existing Class TCEq. Global Existing Instance TCEq_refl. Global Hint Mode TCEq ! - - : typeclass_instances. Lemma TCEq_eq {A} (x1 x2 : A) : TCEq x1 x2 ↔ x1 = x2. Proof. split; destruct 1; reflexivity. Qed. (** The [TCSimpl x y] type class is similar to [TCEq] but performs [simpl] before proving the goal by reflexivity. Similar to [TCEq], the argument [x] is the input and [y] the output. When solving [TCEq x y], the argument [x] should be a concrete term and [y] an evar for the [simpl]ed result. *) Class TCSimpl {A} (x x' : A) := TCSimpl_TCEq : TCEq x x'. Global Hint Extern 0 (TCSimpl _ _) => (* Since the second argument should be an evar, we can call [simpl] on the whole goal. *) simpl; notypeclasses refine (TCEq_refl _) : typeclass_instances. Global Hint Mode TCSimpl ! - - : typeclass_instances. Lemma TCSimpl_eq {A} (x1 x2 : A) : TCSimpl x1 x2 ↔ x1 = x2. Proof. apply TCEq_eq. Qed. Inductive TCDiag {A} (C : A → Prop) : A → A → Prop := | TCDiag_diag x : C x → TCDiag C x x. Existing Class TCDiag. Global Existing Instance TCDiag_diag. Global Hint Mode TCDiag ! ! ! - : typeclass_instances. Global Hint Mode TCDiag ! ! - ! : typeclass_instances. (** Given a proposition [P] that is a type class, [tc_to_bool P] will return [true] iff there is an instance of [P]. It is often useful in Ltac programming, where one can do [lazymatch tc_to_bool P with true => .. | false => .. end]. *) Definition tc_to_bool (P : Prop) {p : bool} `{TCIf P (TCEq p true) (TCEq p false)} : bool := p. (** Throughout this development we use [stdpp_scope] for all general purpose notations that do not belong to a more specific scope. *) Declare Scope stdpp_scope. Delimit Scope stdpp_scope with stdpp. Global Open Scope stdpp_scope. (** Change [True] and [False] into notations in order to enable overloading. We will use this to give [True] and [False] a different interpretation for embedded logics. *) Notation "'True'" := True (format "True") : type_scope. Notation "'False'" := False (format "False") : type_scope. (** Change [forall] into a notation in order to enable overloading. *) Notation "'forall' x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, only parsing) : type_scope. (** * Equality *) (** Introduce some Haskell style like notations. *) Notation "(=)" := eq (only parsing) : stdpp_scope. Notation "( x =.)" := (eq x) (only parsing) : stdpp_scope. Notation "(.= x )" := (λ y, eq y x) (only parsing) : stdpp_scope. Notation "(≠)" := (λ x y, x ≠ y) (only parsing) : stdpp_scope. Notation "( x ≠.)" := (λ y, x ≠ y) (only parsing) : stdpp_scope. Notation "(.≠ x )" := (λ y, y ≠ x) (only parsing) : stdpp_scope. Infix "=@{ A }" := (@eq A) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(=@{ A } )" := (@eq A) (only parsing) : stdpp_scope. Notation "(≠@{ A } )" := (λ X Y, ¬X =@{A} Y) (only parsing) : stdpp_scope. Notation "X ≠@{ A } Y":= (¬X =@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope. Global Hint Extern 0 (_ = _) => reflexivity : core. Global Hint Extern 100 (_ ≠ _) => discriminate : core. Global Instance: ∀ A, PreOrder (=@{A}). Proof. split; repeat intro; congruence. Qed. (** ** Setoid equality *) (** We define an operational type class for setoid equality, i.e., the "canonical" equivalence for a type. The typeclass is tied to the \equiv symbol. This is based on (Spitters/van der Weegen, 2011). *) Class Equiv A := equiv: relation A. Global Hint Mode Equiv ! : typeclass_instances. (** We instruct setoid rewriting to infer [equiv] as a relation on type [A] when needed. This allows setoid_rewrite to solve constraints of shape [Proper (eq ==> ?R) f] using [Proper (eq ==> (equiv (A:=A))) f] when an equivalence relation is available on type [A]. We put this instance at level 150 so it does not take precedence over Coq's stdlib instances, favoring inference of [eq] (all Coq functions are automatically morphisms for [eq]). We have [eq] (at 100) < [≡] (at 150) < [⊑] (at 200). *) Global Instance equiv_rewrite_relation `{Equiv A} : RewriteRelation (@equiv A _) | 150 := {}. Infix "≡" := equiv (at level 70, no associativity) : stdpp_scope. Infix "≡@{ A }" := (@equiv A _) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(≡)" := equiv (only parsing) : stdpp_scope. Notation "( X ≡.)" := (equiv X) (only parsing) : stdpp_scope. Notation "(.≡ X )" := (λ Y, Y ≡ X) (only parsing) : stdpp_scope. Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : stdpp_scope. Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : stdpp_scope. Notation "( X ≢.)" := (λ Y, X ≢ Y) (only parsing) : stdpp_scope. Notation "(.≢ X )" := (λ Y, Y ≢ X) (only parsing) : stdpp_scope. Notation "(≡@{ A } )" := (@equiv A _) (only parsing) : stdpp_scope. Notation "(≢@{ A } )" := (λ X Y, ¬X ≡@{A} Y) (only parsing) : stdpp_scope. Notation "X ≢@{ A } Y":= (¬X ≡@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope. (** The type class [LeibnizEquiv] collects setoid equalities that coincide with Leibniz equality. We provide the tactic [fold_leibniz] to transform such setoid equalities into Leibniz equalities, and [unfold_leibniz] for the reverse. Various std++ tactics assume that this class is only instantiated if [≡] is an equivalence relation. *) Class LeibnizEquiv A `{Equiv A} := leibniz_equiv (x y : A) : x ≡ y → x = y. Global Hint Mode LeibnizEquiv ! ! : typeclass_instances. Lemma leibniz_equiv_iff `{LeibnizEquiv A, !Reflexive (≡@{A})} (x y : A) : x ≡ y ↔ x = y. Proof. split; [apply leibniz_equiv|]. intros ->; reflexivity. Qed. Ltac fold_leibniz := repeat match goal with | H : context [ _ ≡@{?A} _ ] |- _ => setoid_rewrite (leibniz_equiv_iff (A:=A)) in H | |- context [ _ ≡@{?A} _ ] => setoid_rewrite (leibniz_equiv_iff (A:=A)) end. Ltac unfold_leibniz := repeat match goal with | H : context [ _ =@{?A} _ ] |- _ => setoid_rewrite <-(leibniz_equiv_iff (A:=A)) in H | |- context [ _ =@{?A} _ ] => setoid_rewrite <-(leibniz_equiv_iff (A:=A)) end. Definition equivL {A} : Equiv A := (=). (** A [Params f n] instance forces the setoid rewriting mechanism not to rewrite in the first [n] arguments of the function [f]. We will declare such instances for all operational type classes in this development. *) Global Instance: Params (@equiv) 2 := {}. (** The following instance forces [setoid_replace] to use setoid equality (for types that have an [Equiv] instance) rather than the standard Leibniz equality. *) Global Instance equiv_default_relation `{Equiv A} : DefaultRelation (≡@{A}) | 3 := {}. Global Hint Extern 0 (_ ≡ _) => reflexivity : core. Global Hint Extern 0 (_ ≡ _) => symmetry; assumption : core. (** * Type classes *) (** ** Decidable propositions *) (** This type class by (Spitters/van der Weegen, 2011) collects decidable propositions. *) Class Decision (P : Prop) := decide : {P} + {¬P}. Global Hint Mode Decision ! : typeclass_instances. Global Arguments decide _ {_} : simpl never, assert. (** Although [RelDecision R] is just [∀ x y, Decision (R x y)], we make this an explicit class instead of a notation for two reasons: - It allows us to control [Hint Mode] more precisely. In particular, if it were defined as a notation, the above [Hint Mode] for [Decision] would not prevent diverging instance search when looking for [RelDecision (@eq ?A)], which would result in it looking for [Decision (@eq ?A x y)], i.e. an instance where the head position of [Decision] is not en evar. - We use it to avoid inefficient computation due to eager evaluation of propositions by [vm_compute]. This inefficiency arises for example if [(x = y) := (f x = f y)]. Since [decide (x = y)] evaluates to [decide (f x = f y)], this would then lead to evaluation of [f x] and [f y]. Using the [RelDecision], the [f] is hidden under a lambda, which prevents unnecessary evaluation. *) Class RelDecision {A B} (R : A → B → Prop) := decide_rel x y :: Decision (R x y). Global Hint Mode RelDecision ! ! ! : typeclass_instances. Global Arguments decide_rel {_ _} _ {_} _ _ : simpl never, assert. Notation EqDecision A := (RelDecision (=@{A})). (** ** Inhabited types *) (** This type class collects types that are inhabited. *) Class Inhabited (A : Type) : Type := populate { inhabitant : A }. Global Hint Mode Inhabited ! : typeclass_instances. Global Arguments populate {_} _ : assert. (** ** Proof irrelevant types *) (** This type class collects types that are proof irrelevant. That means, all elements of the type are equal. We use this notion only used for propositions, but by universe polymorphism we can generalize it. *) Class ProofIrrel (A : Type) : Prop := proof_irrel (x y : A) : x = y. Global Hint Mode ProofIrrel ! : typeclass_instances. (** ** Common properties *) (** These operational type classes allow us to refer to common mathematical properties in a generic way. For example, for injectivity of [(k ++.)] it allows us to write [inj (k ++.)] instead of [app_inv_head k]. *) Class Inj {A B} (R : relation A) (S : relation B) (f : A → B) : Prop := inj x y : S (f x) (f y) → R x y. Class Inj2 {A B C} (R1 : relation A) (R2 : relation B) (S : relation C) (f : A → B → C) : Prop := inj2 x1 x2 y1 y2 : S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2. Class Cancel {A B} (S : relation B) (f : A → B) (g : B → A) : Prop := cancel x : S (f (g x)) x. Class Surj {A B} (R : relation B) (f : A → B) := surj y : ∃ x, R (f x) y. Class IdemP {A} (R : relation A) (f : A → A → A) : Prop := idemp x : R (f x x) x. Class Comm {A B} (R : relation A) (f : B → B → A) : Prop := comm x y : R (f x y) (f y x). Class LeftId {A} (R : relation A) (i : A) (f : A → A → A) : Prop := left_id x : R (f i x) x. Class RightId {A} (R : relation A) (i : A) (f : A → A → A) : Prop := right_id x : R (f x i) x. Class Assoc {A} (R : relation A) (f : A → A → A) : Prop := assoc x y z : R (f x (f y z)) (f (f x y) z). Class LeftAbsorb {A} (R : relation A) (i : A) (f : A → A → A) : Prop := left_absorb x : R (f i x) i. Class RightAbsorb {A} (R : relation A) (i : A) (f : A → A → A) : Prop := right_absorb x : R (f x i) i. Class AntiSymm {A} (R S : relation A) : Prop := anti_symm x y : S x y → S y x → R x y. Class Total {A} (R : relation A) := total x y : R x y ∨ R y x. Class Trichotomy {A} (R : relation A) := trichotomy x y : R x y ∨ x = y ∨ R y x. Class TrichotomyT {A} (R : relation A) := trichotomyT x y : {R x y} + {x = y} + {R y x}. Notation Involutive R f := (Cancel R f f). Lemma involutive {A} {R : relation A} (f : A → A) `{Involutive R f} x : R (f (f x)) x. Proof. auto. Qed. Global Arguments irreflexivity {_} _ {_} _ _ : assert. Global Arguments inj {_ _ _ _} _ {_} _ _ _ : assert. Global Arguments inj2 {_ _ _ _ _ _} _ {_} _ _ _ _ _: assert. Global Arguments cancel {_ _ _} _ _ {_} _ : assert. Global Arguments surj {_ _ _} _ {_} _ : assert. Global Arguments idemp {_ _} _ {_} _ : assert. Global Arguments comm {_ _ _} _ {_} _ _ : assert. Global Arguments left_id {_ _} _ _ {_} _ : assert. Global Arguments right_id {_ _} _ _ {_} _ : assert. Global Arguments assoc {_ _} _ {_} _ _ _ : assert. Global Arguments left_absorb {_ _} _ _ {_} _ : assert. Global Arguments right_absorb {_ _} _ _ {_} _ : assert. Global Arguments anti_symm {_ _} _ {_} _ _ _ _ : assert. Global Arguments total {_} _ {_} _ _ : assert. Global Arguments trichotomy {_} _ {_} _ _ : assert. Global Arguments trichotomyT {_} _ {_} _ _ : assert. Lemma not_symmetry `{R : relation A, !Symmetric R} x y : ¬R x y → ¬R y x. Proof. intuition. Qed. Lemma symmetry_iff `(R : relation A) `{!Symmetric R} x y : R x y ↔ R y x. Proof. intuition. Qed. Lemma not_inj `{Inj A B R R' f} x y : ¬R x y → ¬R' (f x) (f y). Proof. intuition. Qed. Lemma not_inj2_1 `{Inj2 A B C R R' R'' f} x1 x2 y1 y2 : ¬R x1 x2 → ¬R'' (f x1 y1) (f x2 y2). Proof. intros HR HR''. destruct (inj2 f x1 y1 x2 y2); auto. Qed. Lemma not_inj2_2 `{Inj2 A B C R R' R'' f} x1 x2 y1 y2 : ¬R' y1 y2 → ¬R'' (f x1 y1) (f x2 y2). Proof. intros HR' HR''. destruct (inj2 f x1 y1 x2 y2); auto. Qed. Lemma inj_iff {A B} {R : relation A} {S : relation B} (f : A → B) `{!Inj R S f} `{!Proper (R ==> S) f} x y : S (f x) (f y) ↔ R x y. Proof. firstorder. Qed. Global Instance inj2_inj_1 `{Inj2 A B C R1 R2 R3 f} y : Inj R1 R3 (λ x, f x y). Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Global Instance inj2_inj_2 `{Inj2 A B C R1 R2 R3 f} x : Inj R2 R3 (f x). Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Elpi TC Solver Override TC.Solver Rm ProperProxy. Lemma cancel_inj `{Cancel A B R1 f g, !Equivalence R1, !Proper (R2 ==> R1) f} : Inj R1 R2 g. Proof. intros x y E. rewrite <-(cancel f g x), <-(cancel f g y), E. reflexivity. Qed. Lemma cancel_surj `{Cancel A B R1 f g} : Surj R1 f. Proof. intros y. exists (g y). auto. Qed. (** The following lemmas are specific versions of the projections of the above type classes for Leibniz equality. These lemmas allow us to enforce Coq not to use the setoid rewriting mechanism. *) Lemma idemp_L {A} f `{!@IdemP A (=) f} x : f x x = x. Proof. auto. Qed. Lemma comm_L {A B} f `{!@Comm A B (=) f} x y : f x y = f y x. Proof. auto. Qed. Lemma left_id_L {A} i f `{!@LeftId A (=) i f} x : f i x = x. Proof. auto. Qed. Lemma right_id_L {A} i f `{!@RightId A (=) i f} x : f x i = x. Proof. auto. Qed. Lemma assoc_L {A} f `{!@Assoc A (=) f} x y z : f x (f y z) = f (f x y) z. Proof. auto. Qed. Lemma left_absorb_L {A} i f `{!@LeftAbsorb A (=) i f} x : f i x = i. Proof. auto. Qed. Lemma right_absorb_L {A} i f `{!@RightAbsorb A (=) i f} x : f x i = i. Proof. auto. Qed. (** ** Generic orders *) (** The classes [PreOrder], [PartialOrder], and [TotalOrder] use an arbitrary relation [R] instead of [⊆] to support multiple orders on the same type. *) Definition strict {A} (R : relation A) : relation A := λ X Y, R X Y ∧ ¬R Y X. Global Instance: Params (@strict) 2 := {}. Set Warnings "-future-coercion-class-field". Class PartialOrder {A} (R : relation A) : Prop := { partial_order_pre ::> PreOrder R; partial_order_anti_symm :> AntiSymm (=) R }. Global Hint Mode PartialOrder ! ! : typeclass_instances. Class TotalOrder {A} (R : relation A) : Prop := { total_order_partial :> PartialOrder R; total_order_trichotomy :> Trichotomy (strict R) }. Global Hint Mode TotalOrder ! ! : typeclass_instances. (** * Logic *) Global Instance prop_inhabited : Inhabited Prop := populate True. Notation "(∧)" := and (only parsing) : stdpp_scope. Notation "( A ∧.)" := (and A) (only parsing) : stdpp_scope. Notation "(.∧ B )" := (λ A, A ∧ B) (only parsing) : stdpp_scope. Notation "(∨)" := or (only parsing) : stdpp_scope. Notation "( A ∨.)" := (or A) (only parsing) : stdpp_scope. Notation "(.∨ B )" := (λ A, A ∨ B) (only parsing) : stdpp_scope. Notation "(↔)" := iff (only parsing) : stdpp_scope. Notation "( A ↔.)" := (iff A) (only parsing) : stdpp_scope. Notation "(.↔ B )" := (λ A, A ↔ B) (only parsing) : stdpp_scope. Global Hint Extern 0 (_ ↔ _) => reflexivity : core. Global Hint Extern 0 (_ ↔ _) => symmetry; assumption : core. Lemma or_l P Q : ¬Q → P ∨ Q ↔ P. Proof. tauto. Qed. Lemma or_r P Q : ¬P → P ∨ Q ↔ Q. Proof. tauto. Qed. Lemma and_wlog_l (P Q : Prop) : (Q → P) → Q → (P ∧ Q). Proof. tauto. Qed. Lemma and_wlog_r (P Q : Prop) : P → (P → Q) → (P ∧ Q). Proof. tauto. Qed. Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R). Proof. tauto. Qed. Lemma forall_proper {A} (P Q : A → Prop) : (∀ x, P x ↔ Q x) → (∀ x, P x) ↔ (∀ x, Q x). Proof. firstorder. Qed. Lemma exist_proper {A} (P Q : A → Prop) : (∀ x, P x ↔ Q x) → (∃ x, P x) ↔ (∃ x, Q x). Proof. firstorder. Qed. Global Instance eq_comm {A} : Comm (↔) (=@{A}). Proof. red; intuition. Qed. Global Instance flip_eq_comm {A} : Comm (↔) (λ x y, y =@{A} x). Proof. red; intuition. Qed. Global Instance iff_comm : Comm (↔) (↔). Proof. red; intuition. Qed. Global Instance and_comm : Comm (↔) (∧). Proof. red; intuition. Qed. Global Instance and_assoc : Assoc (↔) (∧). Proof. red; intuition. Qed. Global Instance and_idemp : IdemP (↔) (∧). Proof. red; intuition. Qed. Global Instance or_comm : Comm (↔) (∨). Proof. red; intuition. Qed. Global Instance or_assoc : Assoc (↔) (∨). Proof. red; intuition. Qed. Global Instance or_idemp : IdemP (↔) (∨). Proof. red; intuition. Qed. Global Instance True_and : LeftId (↔) True (∧). Proof. red; intuition. Qed. Global Instance and_True : RightId (↔) True (∧). Proof. red; intuition. Qed. Global Instance False_and : LeftAbsorb (↔) False (∧). Proof. red; intuition. Qed. Global Instance and_False : RightAbsorb (↔) False (∧). Proof. red; intuition. Qed. Global Instance False_or : LeftId (↔) False (∨). Proof. red; intuition. Qed. Global Instance or_False : RightId (↔) False (∨). Proof. red; intuition. Qed. Global Instance True_or : LeftAbsorb (↔) True (∨). Proof. red; intuition. Qed. Global Instance or_True : RightAbsorb (↔) True (∨). Proof. red; intuition. Qed. Global Instance True_impl : LeftId (↔) True impl. Proof. unfold impl. red; intuition. Qed. Global Instance impl_True : RightAbsorb (↔) True impl. Proof. unfold impl. red; intuition. Qed. (** * Common data types *) (** ** Functions *) Notation "(→)" := (λ A B, A → B) (only parsing) : stdpp_scope. Notation "( A →.)" := (λ B, A → B) (only parsing) : stdpp_scope. Notation "(.→ B )" := (λ A, A → B) (only parsing) : stdpp_scope. Notation "t $ r" := (t r) (at level 65, right associativity, only parsing) : stdpp_scope. Notation "($)" := (λ f x, f x) (only parsing) : stdpp_scope. Notation "(.$ x )" := (λ f, f x) (only parsing) : stdpp_scope. Infix "∘" := compose : stdpp_scope. Notation "(∘)" := compose (only parsing) : stdpp_scope. Notation "( f ∘.)" := (compose f) (only parsing) : stdpp_scope. Notation "(.∘ f )" := (λ g, compose g f) (only parsing) : stdpp_scope. Global Instance impl_inhabited {A} `{Inhabited B} : Inhabited (A → B) := populate (λ _, inhabitant). (** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully applied. *) Global Arguments id _ _ / : assert. Global Arguments compose _ _ _ _ _ _ / : assert. Global Arguments flip _ _ _ _ _ _ / : assert. Global Arguments const _ _ _ _ / : assert. Global Typeclasses Transparent id compose flip const. Definition fun_map {A A' B B'} (f: A' → A) (g: B → B') (h : A → B) : A' → B' := g ∘ h ∘ f. Global Instance const_proper `{R1 : relation A, R2 : relation B} (x : B) : Reflexive R2 → Proper (R1 ==> R2) (λ _, x). Proof. intros ? y1 y2; reflexivity. Qed. Global Instance id_inj {A} : Inj (=) (=) (@id A). Proof. intros ??; auto. Qed. Global Instance compose_inj {A B C} R1 R2 R3 (f : A → B) (g : B → C) : Inj R1 R2 f → Inj R2 R3 g → Inj R1 R3 (g ∘ f). Proof. red; intuition. Qed. Global Instance id_surj {A} : Surj (=) (@id A). Proof. intros y; exists y; reflexivity. Qed. Global Instance compose_surj {A B C} R (f : A → B) (g : B → C) : Surj (=) f → Surj R g → Surj R (g ∘ f). Proof. intros ?? x. unfold compose. destruct (surj g x) as [y ?]. destruct (surj f y) as [z ?]. exists z. congruence. Qed. Global Instance const2_comm {A B} (x : B) : Comm (=) (λ _ _ : A, x). Proof. intros ?; reflexivity. Qed. Global Instance const2_assoc {A} (x : A) : Assoc (=) (λ _ _ : A, x). Proof. intros ???; reflexivity. Qed. Global Instance id1_assoc {A} : Assoc (=) (λ x _ : A, x). Proof. intros ???; reflexivity. Qed. Global Instance id2_assoc {A} : Assoc (=) (λ _ x : A, x). Proof. intros ???; reflexivity. Qed. Global Instance id1_idemp {A} : IdemP (=) (λ x _ : A, x). Proof. intros ?; reflexivity. Qed. Global Instance id2_idemp {A} : IdemP (=) (λ _ x : A, x). Proof. intros ?; reflexivity. Qed. (** ** Lists *) Global Instance list_inhabited {A} : Inhabited (list A) := populate []. Definition zip_with {A B C} (f : A → B → C) : list A → list B → list C := fix go l1 l2 := match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end. Notation zip := (zip_with pair). (** ** Booleans *) (** The following coercion allows us to use Booleans as propositions. *) Coercion Is_true : bool >-> Sortclass. Global Hint Unfold Is_true : core. Global Hint Immediate Is_true_eq_left : core. Global Hint Resolve orb_prop_intro andb_prop_intro : core. Notation "(&&)" := andb (only parsing). Notation "(||)" := orb (only parsing). Infix "&&*" := (zip_with (&&)) (at level 40). Infix "||*" := (zip_with (||)) (at level 50). Global Instance bool_inhabated : Inhabited bool := populate true. Definition bool_le (β1 β2 : bool) : Prop := negb β1 || β2. Infix "=.>" := bool_le (at level 70). Infix "=.>*" := (Forall2 bool_le) (at level 70). Global Instance: PartialOrder bool_le. Proof. repeat split; repeat intros [|]; compute; tauto. Qed. Lemma andb_True b1 b2 : b1 && b2 ↔ b1 ∧ b2. Proof. destruct b1, b2; simpl; tauto. Qed. Lemma orb_True b1 b2 : b1 || b2 ↔ b1 ∨ b2. Proof. destruct b1, b2; simpl; tauto. Qed. Lemma negb_True b : negb b ↔ ¬b. Proof. destruct b; simpl; tauto. Qed. Lemma Is_true_true (b : bool) : b ↔ b = true. Proof. now destruct b. Qed. Lemma Is_true_true_1 (b : bool) : b → b = true. Proof. apply Is_true_true. Qed. Lemma Is_true_true_2 (b : bool) : b = true → b. Proof. apply Is_true_true. Qed. Lemma Is_true_false (b : bool) : ¬ b ↔ b = false. Proof. now destruct b; simpl. Qed. Lemma Is_true_false_1 (b : bool) : ¬b → b = false. Proof. apply Is_true_false. Qed. Lemma Is_true_false_2 (b : bool) : b = false → ¬b. Proof. apply Is_true_false. Qed. (** ** Unit *) Global Instance unit_equiv : Equiv unit := λ _ _, True. Global Instance unit_equivalence : Equivalence (≡@{unit}). Proof. repeat split. Qed. Global Instance unit_leibniz : LeibnizEquiv unit. Proof. intros [] []; reflexivity. Qed. Global Instance unit_inhabited: Inhabited unit := populate (). (** ** Empty *) Global Instance Empty_set_equiv : Equiv Empty_set := λ _ _, True. Global Instance Empty_set_equivalence : Equivalence (≡@{Empty_set}). Proof. repeat split. Qed. Global Instance Empty_set_leibniz : LeibnizEquiv Empty_set. Proof. intros [] []; reflexivity. Qed. (** ** Products *) Notation "( x ,.)" := (pair x) (only parsing) : stdpp_scope. Notation "(., y )" := (λ x, (x,y)) (only parsing) : stdpp_scope. Notation "p .1" := (fst p) (at level 1, left associativity, format "p .1"). Notation "p .2" := (snd p) (at level 1, left associativity, format "p .2"). Global Instance: Params (@pair) 2 := {}. Global Instance: Params (@fst) 2 := {}. Global Instance: Params (@snd) 2 := {}. Global Instance: Params (@curry) 3 := {}. Global Instance: Params (@uncurry) 3 := {}. Definition uncurry3 {A B C D} (f : A → B → C → D) (p : A * B * C) : D := let '(a,b,c) := p in f a b c. Global Instance: Params (@uncurry3) 4 := {}. Definition uncurry4 {A B C D E} (f : A → B → C → D → E) (p : A * B * C * D) : E := let '(a,b,c,d) := p in f a b c d. Global Instance: Params (@uncurry4) 5 := {}. Definition curry3 {A B C D} (f : A * B * C → D) (a : A) (b : B) (c : C) : D := f (a, b, c). Global Instance: Params (@curry3) 4 := {}. Definition curry4 {A B C D E} (f : A * B * C * D → E) (a : A) (b : B) (c : C) (d : D) : E := f (a, b, c, d). Global Instance: Params (@curry4) 5 := {}. Definition prod_map {A A' B B'} (f: A → A') (g: B → B') (p : A * B) : A' * B' := (f (p.1), g (p.2)). Global Instance: Params (@prod_map) 4 := {}. Global Arguments prod_map {_ _ _ _} _ _ !_ / : assert. Definition prod_zip {A A' A'' B B' B''} (f : A → A' → A'') (g : B → B' → B'') (p : A * B) (q : A' * B') : A'' * B'' := (f (p.1) (q.1), g (p.2) (q.2)). Global Instance: Params (@prod_zip) 6 := {}. Global Arguments prod_zip {_ _ _ _ _ _} _ _ !_ !_ / : assert. Definition prod_swap {A B} (p : A * B) : B * A := (p.2, p.1). Global Arguments prod_swap {_ _} !_ /. Global Instance: Params (@prod_swap) 2 := {}. Global Instance prod_inhabited {A B} (iA : Inhabited A) (iB : Inhabited B) : Inhabited (A * B) := match iA, iB with populate x, populate y => populate (x,y) end. (** Note that we need eta for products for the [uncurry_curry] lemmas to hold in non-applied form ([uncurry (curry f) = f]). *) Lemma curry_uncurry {A B C} (f : A → B → C) : curry (uncurry f) = f. Proof. reflexivity. Qed. Lemma uncurry_curry {A B C} (f : A * B → C) p : uncurry (curry f) p = f p. Proof. destruct p; reflexivity. Qed. Lemma curry3_uncurry3 {A B C D} (f : A → B → C → D) : curry3 (uncurry3 f) = f. Proof. reflexivity. Qed. Lemma uncurry3_curry3 {A B C D} (f : A * B * C → D) p : uncurry3 (curry3 f) p = f p. Proof. destruct p as [[??] ?]; reflexivity. Qed. Lemma curry4_uncurry4 {A B C D E} (f : A → B → C → D → E) : curry4 (uncurry4 f) = f. Proof. reflexivity. Qed. Lemma uncurry4_curry4 {A B C D E} (f : A * B * C * D → E) p : uncurry4 (curry4 f) p = f p. Proof. destruct p as [[[??] ?] ?]; reflexivity. Qed. (** [pair_eq] as a name is more consistent with our usual naming. *) Lemma pair_eq {A B} (a1 a2 : A) (b1 b2 : B) : (a1, b1) = (a2, b2) ↔ a1 = a2 ∧ b1 = b2. Proof. apply pair_equal_spec. Qed. Global Instance pair_inj {A B} : Inj2 (=) (=) (=) (@pair A B). Proof. injection 1; auto. Qed. Global Instance prod_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (prod_map f g). Proof. intros ?? [??] [??] ?; simpl in *; f_equal; [apply (inj f)|apply (inj g)]; congruence. Qed. Elpi TC Solver Override TC.Solver Rm ProperProxy Proper. Global Instance prod_swap_cancel {A B} : Cancel (=) (@prod_swap A B) (@prod_swap B A). Proof. intros [??]; reflexivity. Qed. Global Instance prod_swap_inj {A B} : Inj (=) (=) (@prod_swap A B). Proof. apply cancel_inj. Qed. Global Instance prod_swap_surj {A B} : Surj (=) (@prod_swap A B). Proof. apply cancel_surj. Qed. Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A * B) := λ x y, R1 (x.1) (y.1) ∧ R2 (x.2) (y.2). Section prod_relation. Context `{RA : relation A, RB : relation B}. Global Instance prod_relation_refl : Reflexive RA → Reflexive RB → Reflexive (prod_relation RA RB). Proof. firstorder eauto. Qed. Global Instance prod_relation_sym : Symmetric RA → Symmetric RB → Symmetric (prod_relation RA RB). Proof. firstorder eauto. Qed. Global Instance prod_relation_trans : Transitive RA → Transitive RB → Transitive (prod_relation RA RB). Proof. firstorder eauto. Qed. Global Instance prod_relation_equiv : Equivalence RA → Equivalence RB → Equivalence (prod_relation RA RB). Proof. split; apply _. Qed. Global Instance pair_proper' : Proper (RA ==> RB ==> prod_relation RA RB) pair. Proof. firstorder eauto. Qed. Global Instance pair_inj' : Inj2 RA RB (prod_relation RA RB) pair. Proof. inversion_clear 1; eauto. Qed. Global Instance fst_proper' : Proper (prod_relation RA RB ==> RA) fst. Proof. firstorder eauto. Qed. Global Instance snd_proper' : Proper (prod_relation RA RB ==> RB) snd. Proof. firstorder eauto. Qed. Global Instance prod_swap_proper' : Proper (prod_relation RA RB ==> prod_relation RB RA) prod_swap. Proof. firstorder eauto. Qed. Global Instance curry_proper' `{RC : relation C} : Proper ((prod_relation RA RB ==> RC) ==> RA ==> RB ==> RC) curry. Proof. firstorder eauto. Qed. Global Instance uncurry_proper' `{RC : relation C} : Proper ((RA ==> RB ==> RC) ==> prod_relation RA RB ==> RC) uncurry. Proof. intros f1 f2 Hf [x1 y1] [x2 y2] []; apply Hf; assumption. Qed. Global Instance curry3_proper' `{RC : relation C, RD : relation D} : Proper ((prod_relation (prod_relation RA RB) RC ==> RD) ==> RA ==> RB ==> RC ==> RD) curry3. Proof. firstorder eauto. Qed. Global Instance uncurry3_proper' `{RC : relation C, RD : relation D} : Proper ((RA ==> RB ==> RC ==> RD) ==> prod_relation (prod_relation RA RB) RC ==> RD) uncurry3. Proof. intros f1 f2 Hf [[??] ?] [[??] ?] [[??] ?]; apply Hf; assumption. Qed. Global Instance curry4_proper' `{RC : relation C, RD : relation D, RE : relation E} : Proper ((prod_relation (prod_relation (prod_relation RA RB) RC) RD ==> RE) ==> RA ==> RB ==> RC ==> RD ==> RE) curry4. Proof. firstorder eauto. Qed. Global Instance uncurry4_proper' `{RC : relation C, RD : relation D, RE : relation E} : Proper ((RA ==> RB ==> RC ==> RD ==> RE) ==> prod_relation (prod_relation (prod_relation RA RB) RC) RD ==> RE) uncurry4. Proof. intros f1 f2 Hf [[[??] ?] ?] [[[??] ?] ?] [[[??] ?] ?]; apply Hf; assumption. Qed. End prod_relation. Global Instance prod_equiv `{Equiv A,Equiv B} : Equiv (A * B) := prod_relation (≡) (≡). (** Below we make [prod_equiv] type class opaque, so we first lift all instances *) Section prod_setoid. Context `{Equiv A, Equiv B}. Elpi Accumulate TC.Solver lp:{{ shorten tc-Corelib.Classes.RelationClasses.{tc-Equivalence}. :after "lastHook" tc-Equivalence A RA R :- RA = {{@equiv _ (@prod_equiv _ _ _ _)}}, RA' = {{@prod_relation _ _ _ _}}, coq.unify-eq RA RA' ok, % coq.say A RA, tc-Equivalence A RA' R. }}. (* *) Global Instance prod_equivalence@{i} (C D: Type@{i}) `{Equiv C, Equiv D}: @Equivalence C (≡@{C}) → @Equivalence D (≡@{D}) → @Equivalence (C * D) (≡@{C * D}) := _. Elpi Accumulate TC.Solver lp:{{ pred remove_equiv_prod_equiv i:term, o:term. remove_equiv_prod_equiv T1 T3 :- T1 = {{@equiv _ (@prod_equiv _ _ _ _)}}, !, T2 = {{@prod_relation lp:F lp:G lp:A lp:B}}, coq.unify-eq T1 T2 ok, remove_equiv_prod_equiv A X, remove_equiv_prod_equiv B Y, {{@prod_relation lp:F lp:G lp:X lp:Y}} = T3. remove_equiv_prod_equiv (app L1) (app L2) :- !, std.map L1 remove_equiv_prod_equiv L2. remove_equiv_prod_equiv A A. shorten tc-Corelib.Classes.Morphisms.{tc-Proper}. :after "lastHook" tc-Proper A B C R :- B = {{ @respectful _ _ _ _ }}, remove_equiv_prod_equiv B B1, tc-Proper A B1 C R. tc-Proper A {{@respectful lp:K1 lp:K2 lp:B1 (@respectful lp:K3 lp:K4 lp:B2 lp:B3)}} C S :- C1 = {{ @equiv _ _ }}, C2 = {{ @equiv _ _ }}, C3 = {{ @prod_relation _ _ _ _ }}, coq.unify-eq B1 C1 ok, coq.unify-eq B2 C2 ok, coq.unify-eq B3 C3 ok, tc-Proper A {{@respectful lp:K1 lp:K2 lp:C1 (@respectful lp:K3 lp:K4 lp:C2 lp:C3)}} C S. }}. Global Instance pair_proper : Proper ((≡) ==> (≡) ==> (≡@{A*B})) pair := _. Elpi Accumulate TC.Solver lp:{{ shorten tc-elpi_apps_tc_tests_stdlib.bigTest.{tc-Inj2}. % shorten tc-bigTest.{tc-Inj2}. :after "lastHook" tc-Inj2 A B C RA RB RC F S :- RC = app [global {coq.locate "equiv"} | _], remove_equiv_prod_equiv RC RC', tc-Inj2 A B C RA RB RC' F S. }}. Global Instance pair_equiv_inj : Inj2 (≡) (≡) (≡@{A*B}) pair := _. Global Instance fst_proper : Proper ((≡@{A*B}) ==> (≡)) fst := _. Global Instance snd_proper : Proper ((≡@{A*B}) ==> (≡)) snd := _. Global Instance prod_swap_proper : Proper ((≡@{A*B}) ==> (≡@{B*A})) prod_swap := _. Global Instance curry_proper `{Equiv C} : Proper (((≡@{A*B}) ==> (≡@{C})) ==> (≡) ==> (≡) ==> (≡)) curry := _. Global Instance uncurry_proper `{Equiv C} : Proper (((≡) ==> (≡) ==> (≡)) ==> (≡@{A*B}) ==> (≡@{C})) uncurry := _. Global Instance curry3_proper `{Equiv C, Equiv D} : Proper (((≡@{A*B*C}) ==> (≡@{D})) ==> (≡) ==> (≡) ==> (≡) ==> (≡)) curry3 := _. Global Instance uncurry3_proper `{Equiv C, Equiv D} : Proper (((≡) ==> (≡) ==> (≡) ==> (≡)) ==> (≡@{A*B*C}) ==> (≡@{D})) uncurry3 := _. Global Instance curry4_proper `{Equiv C, Equiv D, Equiv E} : Proper (((≡@{A*B*C*D}) ==> (≡@{E})) ==> (≡) ==> (≡) ==> (≡) ==> (≡) ==> (≡)) curry4 := _. Global Instance uncurry4_proper `{Equiv C, Equiv D, Equiv E} : Proper (((≡) ==> (≡) ==> (≡) ==> (≡) ==> (≡)) ==> (≡@{A*B*C*D}) ==> (≡@{E})) uncurry4 := _. Lemma pair_equiv (a1 a2 : A) (b1 b2 : B) : (a1, b1) ≡ (a2, b2) ↔ a1 ≡ a2 ∧ b1 ≡ b2. Proof. reflexivity. Qed. End prod_setoid. Global Typeclasses Opaque prod_equiv. Global Instance prod_leibniz `{LeibnizEquiv A, LeibnizEquiv B} : LeibnizEquiv (A * B). Proof. intros [??] [??] [??]; f_equal; apply leibniz_equiv; auto. Qed. (** ** Sums *) Definition sum_map {A A' B B'} (f: A → A') (g: B → B') (xy : A + B) : A' + B' := match xy with inl x => inl (f x) | inr y => inr (g y) end. Global Arguments sum_map {_ _ _ _} _ _ !_ / : assert. Global Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) := match iA with populate x => populate (inl x) end. Global Instance sum_inhabited_r {A B} (iB : Inhabited B) : Inhabited (A + B) := match iB with populate y => populate (inr y) end. Global Instance inl_inj {A B} : Inj (=) (=) (@inl A B). Proof. injection 1; auto. Qed. Global Instance inr_inj {A B} : Inj (=) (=) (@inr A B). Proof. injection 1; auto. Qed. Global Instance sum_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (sum_map f g). Proof. intros ?? [?|?] [?|?] [=]; f_equal; apply (inj _); auto. Qed. Inductive sum_relation {A B} (RA : relation A) (RB : relation B) : relation (A + B) := | inl_related x1 x2 : RA x1 x2 → sum_relation RA RB (inl x1) (inl x2) | inr_related y1 y2 : RB y1 y2 → sum_relation RA RB (inr y1) (inr y2). Section sum_relation. Context `{RA : relation A, RB : relation B}. Global Instance sum_relation_refl : Reflexive RA → Reflexive RB → Reflexive (sum_relation RA RB). Proof. intros ?? [?|?]; constructor; reflexivity. Qed. Global Instance sum_relation_sym : Symmetric RA → Symmetric RB → Symmetric (sum_relation RA RB). Proof. destruct 3; constructor; eauto. Qed. Global Instance sum_relation_trans : Transitive RA → Transitive RB → Transitive (sum_relation RA RB). Proof. destruct 3; inversion_clear 1; constructor; eauto. Qed. Global Instance sum_relation_equiv : Equivalence RA → Equivalence RB → Equivalence (sum_relation RA RB). Proof. split; apply _. Qed. Global Instance inl_proper' : Proper (RA ==> sum_relation RA RB) inl. Proof. constructor; auto. Qed. Global Instance inr_proper' : Proper (RB ==> sum_relation RA RB) inr. Proof. constructor; auto. Qed. Global Instance inl_inj' : Inj RA (sum_relation RA RB) inl. Proof. inversion_clear 1; auto. Qed. Global Instance inr_inj' : Inj RB (sum_relation RA RB) inr. Proof. inversion_clear 1; auto. Qed. End sum_relation. Global Instance sum_equiv `{Equiv A, Equiv B} : Equiv (A + B) := sum_relation (≡) (≡). Elpi Accumulate TC.Solver lp:{{ pred remove_equiv_sum_equiv i:term, o:term. remove_equiv_sum_equiv T1 T3 :- T1 = {{@equiv _ (@sum_equiv _ _ _ _)}}, !, T2 = {{@sum_relation lp:F lp:G lp:A lp:B}}, coq.unify-eq T1 T2 ok, remove_equiv_sum_equiv A X, remove_equiv_sum_equiv B Y, {{@sum_relation lp:F lp:G lp:X lp:Y}} = T3. remove_equiv_sum_equiv (app L1) (app L2) :- !, std.map L1 remove_equiv_sum_equiv L2. remove_equiv_sum_equiv A A. shorten tc-Corelib.Classes.Morphisms.{tc-Proper}. :after "lastHook" tc-Proper A B C R :- B = {{ @respectful _ _ _ _ }}, remove_equiv_sum_equiv B B1, tc-Proper A B1 C R. }}. Global Instance inl_proper `{Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@inl A B) := _. Global Instance inr_proper `{Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@inr A B) := _. Elpi Accumulate TC.Solver lp:{{ shorten tc-elpi_apps_tc_tests_stdlib.bigTest.{tc-Inj}. % shorten tc-bigTest.{tc-Inj}. :after "lastHook" tc-Inj A B R1 R2 S C :- R2 = {{@equiv (sum _ _) sum_equiv}}, R2' = {{sum_relation _ _}}, coq.unify-eq R2 R2' ok, tc-Inj A B R1 R2' S C. }}. Global Instance inl_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inl A B) := _. Global Instance inr_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inr A B) := _. Global Typeclasses Opaque sum_equiv. (** ** Option *) Global Instance option_inhabited {A} : Inhabited (option A) := populate None. (** ** Sigma types *) Global Arguments existT {_ _} _ _ : assert. Global Arguments projT1 {_ _} _ : assert. Global Arguments projT2 {_ _} _ : assert. Global Arguments exist {_} _ _ _ : assert. Global Arguments proj1_sig {_ _} _ : assert. Global Arguments proj2_sig {_ _} _ : assert. Notation "x ↾ p" := (exist _ x p) (at level 20) : stdpp_scope. Notation "` x" := (proj1_sig x) (at level 10, format "` x") : stdpp_scope. Lemma proj1_sig_inj {A} (P : A → Prop) x (Px : P x) y (Py : P y) : x↾Px = y↾Py → x = y. Proof. injection 1; trivial. Qed. Section sig_map. Context `{P : A → Prop} `{Q : B → Prop} (f : A → B) (Hf : ∀ x, P x → Q (f x)). Definition sig_map (x : sig P) : sig Q := f (`x) ↾ Hf _ (proj2_sig x). Global Instance sig_map_inj: (∀ x, ProofIrrel (P x)) → Inj (=) (=) f → Inj (=) (=) sig_map. Proof. intros ?? [x Hx] [y Hy]. injection 1. intros Hxy. apply (inj f) in Hxy; subst. rewrite (proof_irrel _ Hy). auto. Qed. End sig_map. Global Arguments sig_map _ _ _ _ _ _ !_ / : assert. Definition proj1_ex {P : Prop} {Q : P → Prop} (p : ∃ x, Q x) : P := let '(ex_intro _ x _) := p in x. Definition proj2_ex {P : Prop} {Q : P → Prop} (p : ∃ x, Q x) : Q (proj1_ex p) := let '(ex_intro _ x H) := p in H. (** * Operations on sets *) (** We define operational type classes for the traditional operations and relations on sets: the empty set [∅], the union [(∪)], intersection [(∩)], and difference [(∖)], the singleton [{[_]}], the subset [(⊆)] and element of [(∈)] relation, and disjointess [(##)]. *) Class Empty A := empty: A. Global Hint Mode Empty ! : typeclass_instances. Notation "∅" := empty (format "∅") : stdpp_scope. Global Instance empty_inhabited `(Empty A) : Inhabited A := populate ∅. Class Union A := union: A → A → A. Global Hint Mode Union ! : typeclass_instances. Global Instance: Params (@union) 2 := {}. Infix "∪" := union (at level 50, left associativity) : stdpp_scope. Notation "(∪)" := union (only parsing) : stdpp_scope. Notation "( x ∪.)" := (union x) (only parsing) : stdpp_scope. Notation "(.∪ x )" := (λ y, union y x) (only parsing) : stdpp_scope. Infix "∪*" := (zip_with (∪)) (at level 50, left associativity) : stdpp_scope. Notation "(∪*)" := (zip_with (∪)) (only parsing) : stdpp_scope. Definition union_list `{Empty A} `{Union A} : list A → A := fold_right (∪) ∅. Global Arguments union_list _ _ _ !_ / : assert. Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : stdpp_scope. Class Intersection A := intersection: A → A → A. Global Hint Mode Intersection ! : typeclass_instances. Global Instance: Params (@intersection) 2 := {}. Infix "∩" := intersection (at level 40) : stdpp_scope. Notation "(∩)" := intersection (only parsing) : stdpp_scope. Notation "( x ∩.)" := (intersection x) (only parsing) : stdpp_scope. Notation "(.∩ x )" := (λ y, intersection y x) (only parsing) : stdpp_scope. Class Difference A := difference: A → A → A. Global Hint Mode Difference ! : typeclass_instances. Global Instance: Params (@difference) 2 := {}. Infix "∖" := difference (at level 40, left associativity) : stdpp_scope. Notation "(∖)" := difference (only parsing) : stdpp_scope. Notation "( x ∖.)" := (difference x) (only parsing) : stdpp_scope. Notation "(.∖ x )" := (λ y, difference y x) (only parsing) : stdpp_scope. Infix "∖*" := (zip_with (∖)) (at level 40, left associativity) : stdpp_scope. Notation "(∖*)" := (zip_with (∖)) (only parsing) : stdpp_scope. Class Singleton A B := singleton: A → B. Global Hint Mode Singleton - ! : typeclass_instances. Global Instance: Params (@singleton) 3 := {}. Notation "{[ x ]}" := (singleton x) (at level 1) : stdpp_scope. Notation "{[ x ; y ; .. ; z ]}" := (union .. (union (singleton x) (singleton y)) .. (singleton z)) (at level 1) : stdpp_scope. Class SubsetEq A := subseteq: relation A. Global Hint Mode SubsetEq ! : typeclass_instances. Global Instance: Params (@subseteq) 2 := {}. Infix "⊆" := subseteq (at level 70) : stdpp_scope. Notation "(⊆)" := subseteq (only parsing) : stdpp_scope. Notation "( X ⊆.)" := (subseteq X) (only parsing) : stdpp_scope. Notation "(.⊆ X )" := (λ Y, Y ⊆ X) (only parsing) : stdpp_scope. Notation "X ⊈ Y" := (¬X ⊆ Y) (at level 70) : stdpp_scope. Notation "(⊈)" := (λ X Y, X ⊈ Y) (only parsing) : stdpp_scope. Notation "( X ⊈.)" := (λ Y, X ⊈ Y) (only parsing) : stdpp_scope. Notation "(.⊈ X )" := (λ Y, Y ⊈ X) (only parsing) : stdpp_scope. Infix "⊆@{ A }" := (@subseteq A _) (at level 70, only parsing) : stdpp_scope. Notation "(⊆@{ A } )" := (@subseteq A _) (only parsing) : stdpp_scope. Infix "⊆*" := (Forall2 (⊆)) (at level 70) : stdpp_scope. Notation "(⊆*)" := (Forall2 (⊆)) (only parsing) : stdpp_scope. Global Hint Extern 0 (_ ⊆ _) => reflexivity : core. Global Hint Extern 0 (_ ⊆* _) => reflexivity : core. Infix "⊂" := (strict (⊆)) (at level 70) : stdpp_scope. Notation "(⊂)" := (strict (⊆)) (only parsing) : stdpp_scope. Notation "( X ⊂.)" := (strict (⊆) X) (only parsing) : stdpp_scope. Notation "(.⊂ X )" := (λ Y, Y ⊂ X) (only parsing) : stdpp_scope. Notation "X ⊄ Y" := (¬X ⊂ Y) (at level 70) : stdpp_scope. Notation "(⊄)" := (λ X Y, X ⊄ Y) (only parsing) : stdpp_scope. Notation "( X ⊄.)" := (λ Y, X ⊄ Y) (only parsing) : stdpp_scope. Notation "(.⊄ X )" := (λ Y, Y ⊄ X) (only parsing) : stdpp_scope. Infix "⊂@{ A }" := (strict (⊆@{A})) (at level 70, only parsing) : stdpp_scope. Notation "(⊂@{ A } )" := (strict (⊆@{A})) (only parsing) : stdpp_scope. Notation "X ⊆ Y ⊆ Z" := (X ⊆ Y ∧ Y ⊆ Z) (at level 70, Y at next level) : stdpp_scope. Notation "X ⊆ Y ⊂ Z" := (X ⊆ Y ∧ Y ⊂ Z) (at level 70, Y at next level) : stdpp_scope. Notation "X ⊂ Y ⊆ Z" := (X ⊂ Y ∧ Y ⊆ Z) (at level 70, Y at next level) : stdpp_scope. Notation "X ⊂ Y ⊂ Z" := (X ⊂ Y ∧ Y ⊂ Z) (at level 70, Y at next level) : stdpp_scope. (** We define type classes for multisets: disjoint union [⊎] and the multiset singleton [{[+ _ +]}]. Multiset literals [{[+ x1; ..; xn +]}] are defined in terms of iterated disjoint union [{[+ x1 +]} ⊎ .. ⊎ {[+ xn +]}], and are thus different from set literals [{[ x1; ..; xn ]}], which use [∪]. Note that in principle we could reuse the set singleton [{[ _ ]}] for multisets, and define [{[+ x1; ..; xn +]}] as [{[ x1 ]} ⊎ .. ⊎ {[ xn ]}]. However, this would risk accidentally using [{[ x1; ..; xn ]}] for multisets (leading to unexpected results) and lead to ambigious pretty printing for [{[+ x +]}]. *) Class DisjUnion A := disj_union: A → A → A. Global Hint Mode DisjUnion ! : typeclass_instances. Global Instance: Params (@disj_union) 2 := {}. Infix "⊎" := disj_union (at level 50, left associativity) : stdpp_scope. Notation "(⊎)" := disj_union (only parsing) : stdpp_scope. Notation "( x ⊎.)" := (disj_union x) (only parsing) : stdpp_scope. Notation "(.⊎ x )" := (λ y, disj_union y x) (only parsing) : stdpp_scope. Class SingletonMS A B := singletonMS: A → B. Global Hint Mode SingletonMS - ! : typeclass_instances. Global Instance: Params (@singletonMS) 3 := {}. Notation "{[+ x +]}" := (singletonMS x) (at level 1, format "{[+ x +]}") : stdpp_scope. Notation "{[+ x ; y ; .. ; z +]}" := (disj_union .. (disj_union (singletonMS x) (singletonMS y)) .. (singletonMS z)) (at level 1, format "{[+ x ; y ; .. ; z +]}") : stdpp_scope. Definition option_to_set `{Singleton A C, Empty C} (mx : option A) : C := match mx with None => ∅ | Some x => {[ x ]} end. Fixpoint list_to_set `{Singleton A C, Empty C, Union C} (l : list A) : C := match l with [] => ∅ | x :: l => {[ x ]} ∪ list_to_set l end. Fixpoint list_to_set_disj `{SingletonMS A C, Empty C, DisjUnion C} (l : list A) : C := match l with [] => ∅ | x :: l => {[+ x +]} ⊎ list_to_set_disj l end. Class ScalarMul N A := scalar_mul : N → A → A. Global Hint Mode ScalarMul - ! : typeclass_instances. (** The [N] arguments is typically [nat] or [Z], so we do not want to rewrite in that. Hence, the value of [Params] is 3. *) Global Instance: Params (@scalar_mul) 3 := {}. (** The notation [*:] and level is taken from ssreflect, see https://github.com/math-comp/math-comp/blob/master/mathcomp/ssreflect/ssrnotations.v *) Infix "*:" := scalar_mul (at level 40) : stdpp_scope. Notation "(*:)" := scalar_mul (only parsing) : stdpp_scope. Notation "( x *:.)" := (scalar_mul x) (only parsing) : stdpp_scope. Notation "(.*: x )" := (λ y, scalar_mul y x) (only parsing) : stdpp_scope. (** The class [Lexico A] is used for the lexicographic order on [A]. This order is used to create finite maps, finite sets, etc, and is typically different from the order [(⊆)]. *) Class Lexico A := lexico: relation A. Global Hint Mode Lexico ! : typeclass_instances. Class ElemOf A B := elem_of: A → B → Prop. Global Hint Mode ElemOf - ! : typeclass_instances. Global Instance: Params (@elem_of) 3 := {}. Infix "∈" := elem_of (at level 70) : stdpp_scope. Notation "(∈)" := elem_of (only parsing) : stdpp_scope. Notation "( x ∈.)" := (elem_of x) (only parsing) : stdpp_scope. Notation "(.∈ X )" := (λ x, elem_of x X) (only parsing) : stdpp_scope. Notation "x ∉ X" := (¬x ∈ X) (at level 80) : stdpp_scope. Notation "(∉)" := (λ x X, x ∉ X) (only parsing) : stdpp_scope. Notation "( x ∉.)" := (λ X, x ∉ X) (only parsing) : stdpp_scope. Notation "(.∉ X )" := (λ x, x ∉ X) (only parsing) : stdpp_scope. Infix "∈@{ B }" := (@elem_of _ B _) (at level 70, only parsing) : stdpp_scope. Notation "(∈@{ B } )" := (@elem_of _ B _) (only parsing) : stdpp_scope. Notation "x ∉@{ B } X" := (¬x ∈@{B} X) (at level 80, only parsing) : stdpp_scope. Notation "(∉@{ B } )" := (λ x X, x ∉@{B} X) (only parsing) : stdpp_scope. Class Disjoint A := disjoint : A → A → Prop. Global Hint Mode Disjoint ! : typeclass_instances. Global Instance: Params (@disjoint) 2 := {}. Infix "##" := disjoint (at level 70) : stdpp_scope. Notation "(##)" := disjoint (only parsing) : stdpp_scope. Notation "( X ##.)" := (disjoint X) (only parsing) : stdpp_scope. Notation "(.## X )" := (λ Y, Y ## X) (only parsing) : stdpp_scope. Infix "##@{ A }" := (@disjoint A _) (at level 70, only parsing) : stdpp_scope. Notation "(##@{ A } )" := (@disjoint A _) (only parsing) : stdpp_scope. Infix "##*" := (Forall2 (##)) (at level 70) : stdpp_scope. Notation "(##*)" := (Forall2 (##)) (only parsing) : stdpp_scope. Global Hint Extern 0 (_ ## _) => symmetry; eassumption : core. Global Hint Extern 0 (_ ##* _) => symmetry; eassumption : core. Class Filter A B := filter: ∀ (P : A → Prop) `{∀ x, Decision (P x)}, B → B. Global Hint Mode Filter - ! : typeclass_instances. Class UpClose A B := up_close : A → B. Global Hint Mode UpClose - ! : typeclass_instances. Notation "↑ x" := (up_close x) (at level 20, format "↑ x"). (** * Monadic operations *) (** We define operational type classes for the monadic operations bind, join and fmap. We use these type classes merely for convenient overloading of notations and do not formalize any theory on monads (we do not even define a class with the monad laws). *) Class MRet (M : Type → Type) := mret: ∀ {A}, A → M A. Global Arguments mret {_ _ _} _ : assert. Global Instance: Params (@mret) 3 := {}. Global Hint Mode MRet ! : typeclass_instances. Class MBind (M : Type → Type) := mbind : ∀ {A B}, (A → M B) → M A → M B. Global Arguments mbind {_ _ _ _} _ !_ / : assert. Global Instance: Params (@mbind) 4 := {}. Global Hint Mode MBind ! : typeclass_instances. Class MJoin (M : Type → Type) := mjoin: ∀ {A}, M (M A) → M A. Global Arguments mjoin {_ _ _} !_ / : assert. Global Instance: Params (@mjoin) 3 := {}. Global Hint Mode MJoin ! : typeclass_instances. Class FMap (M : Type → Type) := fmap : ∀ {A B}, (A → B) → M A → M B. Global Arguments fmap {_ _ _ _} _ !_ / : assert. Global Instance: Params (@fmap) 4 := {}. Global Hint Mode FMap ! : typeclass_instances. Class OMap (M : Type → Type) := omap: ∀ {A B}, (A → option B) → M A → M B. Global Arguments omap {_ _ _ _} _ !_ / : assert. Global Instance: Params (@omap) 4 := {}. Global Hint Mode OMap ! : typeclass_instances. Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : stdpp_scope. Notation "( m ≫=.)" := (λ f, mbind f m) (only parsing) : stdpp_scope. Notation "(.≫= f )" := (mbind f) (only parsing) : stdpp_scope. Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : stdpp_scope. Notation "x ↠y ; z" := (y ≫= (λ x : _, z)) (at level 20, y at level 100, z at level 200, only parsing) : stdpp_scope. Notation "' x ↠y ; z" := (y ≫= (λ x : _, z)) (at level 20, x pattern, y at level 100, z at level 200, only parsing) : stdpp_scope. Infix "<$>" := fmap (at level 61, left associativity) : stdpp_scope. Notation "x ;; z" := (x ≫= λ _, z) (at level 100, z at level 200, only parsing, right associativity): stdpp_scope. Notation "ps .*1" := (fmap (M:=list) fst ps) (at level 2, left associativity, format "ps .*1"). Notation "ps .*2" := (fmap (M:=list) snd ps) (at level 2, left associativity, format "ps .*2"). (** For any monad that has a builtin way to throw an exception/error *) Class MThrow (E : Type) (M : Type → Type) := mthrow : ∀ {A}, E → M A. Global Arguments mthrow {_ _ _ _} _ : assert. Global Instance: Params (@mthrow) 4 := {}. Global Hint Mode MThrow ! ! : typeclass_instances. (** We use unit as the error content for monads that can only report an error without any payload like an option *) Global Notation MFail := (MThrow ()). Global Notation mfail := (mthrow ()). Definition guard_or {E} (e : E) `{MThrow E M, MRet M} P `{Decision P} : M P := match decide P with | left H => mret H | right _ => mthrow e end. Global Notation guard := (guard_or ()). (** * Operations on maps *) (** In this section we define operational type classes for the operations on maps. In the file [fin_maps] we will axiomatize finite maps. The function look up [m !! k] should yield the element at key [k] in [m]. *) Class Lookup (K A M : Type) := lookup: K → M → option A. Global Hint Mode Lookup - - ! : typeclass_instances. Global Instance: Params (@lookup) 5 := {}. Notation "m !! i" := (lookup i m) (at level 20) : stdpp_scope. Notation "(!!)" := lookup (only parsing) : stdpp_scope. Notation "( m !!.)" := (λ i, m !! i) (only parsing) : stdpp_scope. Notation "(.!! i )" := (lookup i) (only parsing) : stdpp_scope. Global Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [lookup_total] should be the total over-approximation of the partial [lookup] function. *) Class LookupTotal (K A M : Type) := lookup_total : K → M → A. Global Hint Mode LookupTotal - - ! : typeclass_instances. Global Instance: Params (@lookup_total) 5 := {}. Notation "m !!! i" := (lookup_total i m) (at level 20) : stdpp_scope. Notation "(!!!)" := lookup_total (only parsing) : stdpp_scope. Notation "( m !!!.)" := (λ i, m !!! i) (only parsing) : stdpp_scope. Notation "(.!!! i )" := (lookup_total i) (only parsing) : stdpp_scope. Global Arguments lookup_total _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The singleton map *) Class SingletonM K A M := singletonM: K → A → M. Global Hint Mode SingletonM - - ! : typeclass_instances. Global Instance: Params (@singletonM) 5 := {}. Notation "{[ k := a ]}" := (singletonM k a) (at level 1) : stdpp_scope. (** The function insert [<[k:=a]>m] should update the element at key [k] with value [a] in [m]. *) Class Insert (K A M : Type) := insert: K → A → M → M. Global Hint Mode Insert - - ! : typeclass_instances. Global Instance: Params (@insert) 5 := {}. Notation "<[ k := a ]>" := (insert k a) (at level 5, right associativity, format "<[ k := a ]>") : stdpp_scope. Global Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch, assert. (** Notation for more elements (up to 13) *) (* Defining a generic notation does not seem possible with Coq's recursive notation system, so we define individual notations for some cases relevant in practice. *) (* The "format" makes sure that linebreaks are placed after the separating semicola [;] when printing. *) (* _ : we are using parantheses in the "de-sugaring" of the notation instead of [$] because Coq 8.12 and earlier have trouble with using the notation for printing otherwise. Once support for Coq 8.12 is dropped, this can be replaced with [$]. *) Notation "{[ k1 := a1 ; k2 := a2 ]}" := (<[ k1 := a1 ]>{[ k2 := a2 ]}) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]>{[ k3 := a3 ]})) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]>{[ k4 := a4 ]}))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]>{[ k5 := a5 ]})))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]>{[ k6 := a6 ]}))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]>{[ k7 := a7 ]})))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]>{[ k8 := a8 ]}))))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ; ']' '/' '[' k8 := a8 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]>{[ k9 := a9 ]})))))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ; ']' '/' '[' k8 := a8 ; ']' '/' '[' k9 := a9 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> ( <[ k9 := a9 ]>{[ k10 := a10 ]}))))))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ; ']' '/' '[' k8 := a8 ; ']' '/' '[' k9 := a9 ; ']' '/' '[' k10 := a10 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ; k11 := a11 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> ( <[ k9 := a9 ]> ( <[ k10 := a10 ]>{[ k11 := a11 ]})))))))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ; ']' '/' '[' k8 := a8 ; ']' '/' '[' k9 := a9 ; ']' '/' '[' k10 := a10 ; ']' '/' '[' k11 := a11 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ; k11 := a11 ; k12 := a12 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> ( <[ k9 := a9 ]> ( <[ k10 := a10 ]> ( <[ k11 := a11 ]>{[ k12 := a12 ]}))))))))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ; ']' '/' '[' k8 := a8 ; ']' '/' '[' k9 := a9 ; ']' '/' '[' k10 := a10 ; ']' '/' '[' k11 := a11 ; ']' '/' '[' k12 := a12 ']' ']' ]}") : stdpp_scope. Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ; k11 := a11 ; k12 := a12 ; k13 := a13 ]}" := (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> ( <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> ( <[ k9 := a9 ]> ( <[ k10 := a10 ]> ( <[ k11 := a11 ]> ( <[ k12 := a12 ]>{[ k13 := a13 ]})))))))))))) (at level 1, format "{[ '[hv' '[' k1 := a1 ; ']' '/' '[' k2 := a2 ; ']' '/' '[' k3 := a3 ; ']' '/' '[' k4 := a4 ; ']' '/' '[' k5 := a5 ; ']' '/' '[' k6 := a6 ; ']' '/' '[' k7 := a7 ; ']' '/' '[' k8 := a8 ; ']' '/' '[' k9 := a9 ; ']' '/' '[' k10 := a10 ; ']' '/' '[' k11 := a11 ; ']' '/' '[' k12 := a12 ; ']' '/' '[' k13 := a13 ']' ']' ]}") : stdpp_scope. (** The function delete [delete k m] should delete the value at key [k] in [m]. If the key [k] is not a member of [m], the original map should be returned. *) Class Delete (K M : Type) := delete: K → M → M. Global Hint Mode Delete - ! : typeclass_instances. Global Instance: Params (@delete) 4 := {}. Global Arguments delete _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [alter f k m] should update the value at key [k] using the function [f], which is called with the original value. *) Class Alter (K A M : Type) := alter: (A → A) → K → M → M. Global Hint Mode Alter - - ! : typeclass_instances. Global Instance: Params (@alter) 4 := {}. Global Arguments alter {_ _ _ _} _ !_ !_ / : simpl nomatch, assert. (** The function [partial_alter f k m] should update the value at key [k] using the function [f], which is called with the original value at key [k] or [None] if [k] is not a member of [m]. The value at [k] should be deleted if [f] yields [None]. *) Class PartialAlter (K A M : Type) := partial_alter: (option A → option A) → K → M → M. Global Hint Mode PartialAlter - - ! : typeclass_instances. Global Instance: Params (@partial_alter) 4 := {}. Global Arguments partial_alter _ _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [dom m] should yield the domain of [m]. That is a finite set of type [D] that contains the keys that are a member of [m]. [D] is an output of the typeclass, i.e., there can be only one instance per map type [M]. *) Class Dom (M D : Type) := dom: M → D. Global Hint Mode Dom ! - : typeclass_instances. Global Instance: Params (@dom) 3 := {}. Global Arguments dom : clear implicits. Global Arguments dom {_ _ _} !_ / : simpl nomatch, assert. (** The function [merge f m1 m2] should merge the maps [m1] and [m2] by constructing a new map whose value at key [k] is [f (m1 !! k) (m2 !! k)].*) Class Merge (M : Type → Type) := merge: ∀ {A B C}, (option A → option B → option C) → M A → M B → M C. Global Hint Mode Merge ! : typeclass_instances. Global Instance: Params (@merge) 4 := {}. Global Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [union_with f m1 m2] is supposed to yield the union of [m1] and [m2] using the function [f] to combine values of members that are in both [m1] and [m2]. *) Class UnionWith (A M : Type) := union_with: (A → A → option A) → M → M → M. Global Hint Mode UnionWith - ! : typeclass_instances. Global Instance: Params (@union_with) 3 := {}. Global Arguments union_with {_ _ _} _ !_ !_ / : simpl nomatch, assert. (** Similarly for intersection and difference. *) Class IntersectionWith (A M : Type) := intersection_with: (A → A → option A) → M → M → M. Global Hint Mode IntersectionWith - ! : typeclass_instances. Global Instance: Params (@intersection_with) 3 := {}. Global Arguments intersection_with {_ _ _} _ !_ !_ / : simpl nomatch, assert. Class DifferenceWith (A M : Type) := difference_with: (A → A → option A) → M → M → M. Global Hint Mode DifferenceWith - ! : typeclass_instances. Global Instance: Params (@difference_with) 3 := {}. Global Arguments difference_with {_ _ _} _ !_ !_ / : simpl nomatch, assert. Definition intersection_with_list `{IntersectionWith A M} (f : A → A → option A) : M → list M → M := fold_right (intersection_with f). Global Arguments intersection_with_list _ _ _ _ _ !_ / : assert. (** * Notations for lattices. *) (** SqSubsetEq registers the "canonical" partial order for a type, and is used for the \sqsubseteq symbol. *) Class SqSubsetEq A := sqsubseteq: relation A. Global Hint Mode SqSubsetEq ! : typeclass_instances. Global Instance: Params (@sqsubseteq) 2 := {}. Infix "⊑" := sqsubseteq (at level 70) : stdpp_scope. Notation "(⊑)" := sqsubseteq (only parsing) : stdpp_scope. Notation "( x ⊑.)" := (sqsubseteq x) (only parsing) : stdpp_scope. Notation "(.⊑ y )" := (λ x, sqsubseteq x y) (only parsing) : stdpp_scope. Infix "⊑@{ A }" := (@sqsubseteq A _) (at level 70, only parsing) : stdpp_scope. Notation "(⊑@{ A } )" := (@sqsubseteq A _) (only parsing) : stdpp_scope. (** [sqsubseteq] does not take precedence over the stdlib's instances (like [eq], [impl], [iff]) or std++'s [equiv]. We have [eq] (at 100) < [≡] (at 150) < [⊑] (at 200). *) Global Instance sqsubseteq_rewrite `{SqSubsetEq A} : RewriteRelation (⊑@{A}) | 200 := {}. Global Hint Extern 0 (_ ⊑ _) => reflexivity : core. Class Meet A := meet: A → A → A. Global Hint Mode Meet ! : typeclass_instances. Global Instance: Params (@meet) 2 := {}. Infix "⊓" := meet (at level 40) : stdpp_scope. Notation "(⊓)" := meet (only parsing) : stdpp_scope. Notation "( x ⊓.)" := (meet x) (only parsing) : stdpp_scope. Notation "(.⊓ y )" := (λ x, meet x y) (only parsing) : stdpp_scope. Class Join A := join: A → A → A. Global Hint Mode Join ! : typeclass_instances. Global Instance: Params (@join) 2 := {}. Infix "⊔" := join (at level 50) : stdpp_scope. Notation "(⊔)" := join (only parsing) : stdpp_scope. Notation "( x ⊔.)" := (join x) (only parsing) : stdpp_scope. Notation "(.⊔ y )" := (λ x, join x y) (only parsing) : stdpp_scope. Class Top A := top : A. Global Hint Mode Top ! : typeclass_instances. Notation "⊤" := top (format "⊤") : stdpp_scope. Class Bottom A := bottom : A. Global Hint Mode Bottom ! : typeclass_instances. Notation "⊥" := bottom (format "⊥") : stdpp_scope. (** * Axiomatization of sets *) (** The classes [SemiSet A C], [Set_ A C], and [TopSet A C] axiomatize sets of type [C] with elements of type [A]. The first class, [SemiSet] does not include intersection and difference. It is useful for the case of lists, where decidable equality is needed to implement intersection and difference, but not union. Note that we cannot use the name [Set] since that is a reserved keyword. Hence we use [Set_]. *) Class SemiSet A C `{ElemOf A C, Empty C, Singleton A C, Union C} : Prop := { not_elem_of_empty (x : A) : x ∉@{C} ∅; (* We prove [elem_of_empty : x ∈@{C} ∅ ↔ False] in [sets.v], which is more convenient for rewriting. *) elem_of_singleton (x y : A) : x ∈@{C} {[ y ]} ↔ x = y; elem_of_union (X Y : C) (x : A) : x ∈ X ∪ Y ↔ x ∈ X ∨ x ∈ Y }. Global Hint Mode SemiSet - ! - - - - : typeclass_instances. Class Set_ A C `{ElemOf A C, Empty C, Singleton A C, Union C, Intersection C, Difference C} : Prop := { set_semi_set :> SemiSet A C; elem_of_intersection (X Y : C) (x : A) : x ∈ X ∩ Y ↔ x ∈ X ∧ x ∈ Y; elem_of_difference (X Y : C) (x : A) : x ∈ X ∖ Y ↔ x ∈ X ∧ x ∉ Y }. Global Hint Mode Set_ - ! - - - - - - : typeclass_instances. Class TopSet A C `{ElemOf A C, Empty C, Top C, Singleton A C, Union C, Intersection C, Difference C} : Prop := { top_set_set :> Set_ A C; elem_of_top' (x : A) : x ∈@{C} ⊤; (* We prove [elem_of_top : x ∈@{C} ⊤ ↔ True] in [sets.v], which is more convenient for rewriting. *) }. Global Hint Mode TopSet - ! - - - - - - - : typeclass_instances. (** We axiomative a finite set as a set whose elements can be enumerated as a list. These elements, given by the [elements] function, may be in any order and should not contain duplicates. *) Class Elements A C := elements: C → list A. Global Hint Mode Elements - ! : typeclass_instances. Global Instance: Params (@elements) 3 := {}. (** We redefine the standard library's [In] and [NoDup] using type classes. *) Inductive elem_of_list {A} : ElemOf A (list A) := | elem_of_list_here (x : A) l : x ∈ x :: l | elem_of_list_further (x y : A) l : x ∈ l → x ∈ y :: l. Global Existing Instance elem_of_list. Lemma elem_of_list_In {A} (l : list A) x : x ∈ l ↔ In x l. Proof. split. - induction 1; simpl; auto. - induction l; destruct 1; subst; constructor; auto. Qed. Inductive NoDup {A} : list A → Prop := | NoDup_nil_2 : NoDup [] | NoDup_cons_2 x l : x ∉ l → NoDup l → NoDup (x :: l). Lemma NoDup_ListNoDup {A} (l : list A) : NoDup l ↔ List.NoDup l. Proof. split. - induction 1; constructor; rewrite <-?elem_of_list_In; auto. - induction 1; constructor; rewrite ?elem_of_list_In; auto. Qed. (** Decidability of equality of the carrier set is admissible, but we add it anyway so as to avoid cycles in type class search. *) Class FinSet A C `{ElemOf A C, Empty C, Singleton A C, Union C, Intersection C, Difference C, Elements A C, EqDecision A} : Prop := { fin_set_set :> Set_ A C; elem_of_elements (X : C) x : x ∈ elements X ↔ x ∈ X; NoDup_elements (X : C) : NoDup (elements X) }. Global Hint Mode FinSet - ! - - - - - - - - : typeclass_instances. Class Size C := size: C → nat. Global Hint Mode Size ! : typeclass_instances. Global Arguments size {_ _} !_ / : simpl nomatch, assert. Global Instance: Params (@size) 2 := {}. (** The class [MonadSet M] axiomatizes a type constructor [M] that can be used to construct a set [M A] with elements of type [A]. The advantage of this class, compared to [Set_], is that it also axiomatizes the the monadic operations. The disadvantage is that not many inhabitants are possible: we will only provide as inhabitants [propset] and [listset], which are represented respectively using Boolean functions and lists with duplicates. More interesting implementations typically need decidable equality, or a total order on the elements, which do not fit in a type constructor of type [Type → Type]. *) Class MonadSet M `{∀ A, ElemOf A (M A), ∀ A, Empty (M A), ∀ A, Singleton A (M A), ∀ A, Union (M A), !MBind M, !MRet M, !FMap M, !MJoin M} : Prop := { monad_set_semi_set A :> SemiSet A (M A); elem_of_bind {A B} (f : A → M B) (X : M A) (x : B) : x ∈ X ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ X; elem_of_ret {A} (x y : A) : x ∈@{M A} mret y ↔ x = y; elem_of_fmap {A B} (f : A → B) (X : M A) (x : B) : x ∈ f <$> X ↔ ∃ y, x = f y ∧ y ∈ X; elem_of_join {A} (X : M (M A)) (x : A) : x ∈ mjoin X ↔ ∃ Y : M A, x ∈ Y ∧ Y ∈ X }. (** The [Infinite A] class axiomatizes types [A] with infinitely many elements. It contains a function [fresh : list A → A] that given a list [xs] gives an element [fresh xs ∉ xs]. We do not directly make [fresh] a field of the [Infinite] class, but use a separate operational type class [Fresh] for it. That way we can overload [fresh] to pick fresh elements from other data structure like sets. See the file [fin_sets], where we define [fresh : C → A] for any finite set implementation [FinSet C A]. Note: we require [fresh] to respect permutations, which is needed to define the aforementioned [fresh] function on finite sets that respects set equality. Instead of instantiating [Infinite] directly, consider using [max_infinite] or [inj_infinite] from the [infinite] module. *) Class Fresh A C := fresh: C → A. Global Hint Mode Fresh - ! : typeclass_instances. Global Instance: Params (@fresh) 3 := {}. Global Arguments fresh : simpl never. Class Infinite A := { infinite_fresh :> Fresh A (list A); infinite_is_fresh (xs : list A) : fresh xs ∉ xs; infinite_fresh_Permutation :> Proper (@Permutation A ==> (=)) fresh; }. Global Hint Mode Infinite ! : typeclass_instances. Global Arguments infinite_fresh : simpl never. (** * Miscellaneous *) Class Half A := half: A → A. Global Hint Mode Half ! : typeclass_instances. Notation "½" := half (format "½") : stdpp_scope. Notation "½*" := (fmap (M:=list) half) : stdpp_scope. LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/dune000066400000000000000000000003231523041753400213510ustar00rootroot00000000000000(coq.theory (package rocq-elpi-tests-stdlib) (name elpi_apps_tc_tests_stdlib) (flags :standard -async-proofs-cache force) (theories elpi elpi.apps.tc elpi.apps.tc.tests Stdlib)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/eqSimplDef.v000066400000000000000000000007001523041753400227120ustar00rootroot00000000000000From Stdlib Require Import Bool Arith List. Class Eqb A : Type := eqb : A -> A -> bool. Global Hint Mode Eqb + : typeclass_instances. Notation " x == y " := (eqb x y) (no associativity, at level 70). Global Instance eqU : Eqb unit := { eqb x y := true }. Global Instance eqB : Eqb bool := { eqb x y := if x then y else negb y }. Global Instance eqP {A B} `{Eqb A} `{Eqb B} : Eqb (A * B) := { eqb x y := (fst x == fst y) && (snd x == snd y) }. LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/stdppInj.v000066400000000000000000000236111523041753400224620ustar00rootroot00000000000000(* Test inspired from https://gitlab.mpi-sws.org/iris/stdpp/-/blob/8c98553ad0ca2029b30cf18b58e321ec3a79172b/stdpp/base.v *) From Corelib Require Export Morphisms RelationClasses ListDef Setoid. From Stdlib Require Export List Peano Utf8 Permutation. From Stdlib Require Export Program.Basics Program.Syntax. Export ListNotations. From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. Elpi TC.AddAllClasses. Elpi TC.AddAllInstances. Notation length := Datatypes.length. Global Generalizable All Variables. Global Unset Transparent Obligations. Definition tc_opaque {A} (x : A) : A := x. (* Typeclasses Opaque tc_opaque. *) Global Arguments tc_opaque {_} _ /. Declare Scope stdpp_scope. Delimit Scope stdpp_scope with stdpp. Global Open Scope stdpp_scope. Notation "(=)" := eq (only parsing) : stdpp_scope. Notation "( x =.)" := (eq x) (only parsing) : stdpp_scope. Notation "(.= x )" := (λ y, eq y x) (only parsing) : stdpp_scope. Notation "(≠)" := (λ x y, x ≠ y) (only parsing) : stdpp_scope. Notation "( x ≠.)" := (λ y, x ≠ y) (only parsing) : stdpp_scope. Notation "(.≠ x )" := (λ y, y ≠ x) (only parsing) : stdpp_scope. Infix "=@{ A }" := (@eq A) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(=@{ A } )" := (@eq A) (only parsing) : stdpp_scope. Notation "(≠@{ A } )" := (λ X Y, ¬X =@{A} Y) (only parsing) : stdpp_scope. Notation "X ≠@{ A } Y":= (¬X =@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope. Global Hint Extern 0 (_ = _) => reflexivity : core. Global Hint Extern 100 (_ ≠ _) => discriminate : core. Global Instance: ∀ A, PreOrder (=@{A}). Proof. split; repeat intro; congruence. Qed. Class Equiv A := equiv: relation A. Global Instance equiv_rewrite_relation `{Equiv A} : RewriteRelation (@equiv A _) | 150 := {}. Infix "≡" := equiv (at level 70, no associativity) : stdpp_scope. Infix "≡@{ A }" := (@equiv A _) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(≡)" := equiv (only parsing) : stdpp_scope. Notation "( X ≡.)" := (equiv X) (only parsing) : stdpp_scope. Notation "(.≡ X )" := (λ Y, Y ≡ X) (only parsing) : stdpp_scope. Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : stdpp_scope. Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : stdpp_scope. Notation "( X ≢.)" := (λ Y, X ≢ Y) (only parsing) : stdpp_scope. Notation "(.≢ X )" := (λ Y, Y ≢ X) (only parsing) : stdpp_scope. Notation "(≡@{ A } )" := (@equiv A _) (only parsing) : stdpp_scope. Notation "(≢@{ A } )" := (λ X Y, ¬X ≡@{A} Y) (only parsing) : stdpp_scope. Notation "X ≢@{ A } Y":= (¬X ≡@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope. Class LeibnizEquiv A `{Equiv A} := leibniz_equiv (x y : A) : x ≡ y → x = y. Global Hint Mode LeibnizEquiv ! - : typeclass_instances. Global Instance: Params (@equiv) 2 := {}. Global Instance equiv_default_relation `{Equiv A} : DefaultRelation (≡@{A}) | 3 := {}. Global Hint Extern 0 (_ ≡ _) => reflexivity : core. Global Hint Extern 0 (_ ≡ _) => symmetry; assumption : core. Class Inj {A B} (R : relation A) (S : relation B) (f : A → B) : Prop := inj x y : S (f x) (f y) → R x y. Class Inj2 {A B C} (R1 : relation A) (R2 : relation B) (S : relation C) (f : A → B → C) : Prop := inj2 x1 x2 y1 y2 : S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2. Global Arguments irreflexivity {_} _ {_} _ _ : assert. Global Arguments inj {_ _ _ _} _ {_} _ _ _ : assert. Global Arguments inj2 {_ _ _ _ _ _} _ {_} _ _ _ _ _: assert. Global Instance inj2_inj_1 `{Inj2 A B C R1 R2 R3 f} y : Inj R1 R3 (λ x, f x y) | 100. Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Global Instance inj2_inj_2 `{Inj2 A B C R1 R2 R3 f} x : Inj R2 R3 (f x) | 100. Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Notation "(∧)" := and (only parsing) : stdpp_scope. Notation "( A ∧.)" := (and A) (only parsing) : stdpp_scope. Notation "(.∧ B )" := (λ A, A ∧ B) (only parsing) : stdpp_scope. Notation "(∨)" := or (only parsing) : stdpp_scope. Notation "( A ∨.)" := (or A) (only parsing) : stdpp_scope. Notation "(.∨ B )" := (λ A, A ∨ B) (only parsing) : stdpp_scope. Notation "(↔)" := iff (only parsing) : stdpp_scope. Notation "( A ↔.)" := (iff A) (only parsing) : stdpp_scope. Notation "(.↔ B )" := (λ A, A ↔ B) (only parsing) : stdpp_scope. Global Hint Extern 0 (_ ↔ _) => reflexivity : core. Global Hint Extern 0 (_ ↔ _) => symmetry; assumption : core. Notation "(→)" := (λ A B, A → B) (only parsing) : stdpp_scope. Notation "( A →.)" := (λ B, A → B) (only parsing) : stdpp_scope. Notation "(.→ B )" := (λ A, A → B) (only parsing) : stdpp_scope. Notation "t $ r" := (t r) (at level 65, right associativity, only parsing) : stdpp_scope. Notation "($)" := (λ f x, f x) (only parsing) : stdpp_scope. Notation "(.$ x )" := (λ f, f x) (only parsing) : stdpp_scope. Infix "∘" := compose : stdpp_scope. Notation "(∘)" := compose (only parsing) : stdpp_scope. Notation "( f ∘.)" := (compose f) (only parsing) : stdpp_scope. Notation "(.∘ f )" := (λ g, compose g f) (only parsing) : stdpp_scope. (** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully applied. *) Global Arguments id _ _ / : assert. Global Arguments compose _ _ _ _ _ _ / : assert. Global Arguments flip _ _ _ _ _ _ / : assert. Global Arguments const _ _ _ _ / : assert. Definition fun_map {A A' B B'} (f: A' → A) (g: B → B') (h : A → B) : A' → B' := g ∘ h ∘ f. Global Instance id_inj {A} : Inj (=) (=) (@id A). Proof. intros ??; auto. Qed. Global Instance compose_inj {A B C} R1 R2 R3 (f : A → B) (g : B → C) : Inj R1 R2 f → Inj R2 R3 g → Inj R1 R3 (g ∘ f). Proof. red; intuition. Qed. (** ** Products *) Notation "( x ,.)" := (pair x) (only parsing) : stdpp_scope. Notation "(., y )" := (λ x, (x,y)) (only parsing) : stdpp_scope. Notation "p .1" := (fst p) (at level 1, left associativity, format "p .1"). Notation "p .2" := (snd p) (at level 1, left associativity, format "p .2"). Definition prod_map {A A' B B'} (f: A → A') (g: B → B') (p : A * B) : A' * B' := (f (p.1), g (p.2)). Global Arguments prod_map {_ _ _ _} _ _ !_ / : assert. Global Instance pair_inj {A B} : Inj2 (=) (=) (=) (@pair A B). Proof. injection 1; auto. Qed. Global Instance prod_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (prod_map f g). Proof. intros ?? [??] [??] ?; simpl in *; f_equal; [apply (inj f)|apply (inj g)]; congruence. Qed. Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A * B) := λ x y, R1 (x.1) (y.1) ∧ R2 (x.2) (y.2). Section prod_relation. Context `{RA : relation A, RB : relation B}. Global Instance pair_inj' : Inj2 RA RB (prod_relation RA RB) pair. Proof. inversion_clear 1; eauto. Qed. End prod_relation. Global Instance prod_equiv `{Equiv A,Equiv B} : Equiv (A * B) := prod_relation (≡) (≡). Section prod_setoid. Context `{Equiv A, Equiv B}. Elpi Accumulate TC.Solver lp:{{ shorten tc-elpi_apps_tc_tests_stdlib.stdppInj.{tc-Inj2}. % shorten tc-stdppInj.{tc-Inj2}. tc-Inj2 A B C RA RB RC F S :- RC = app [global {coq.locate "equiv"} | _], Res = {{prod_relation _ _}}, coq.unify-eq RC Res ok, tc-Inj2 A B C RA RB Res F S. }}. Global Instance pair_equiv_inj : Inj2 (≡) (≡) (≡@{A*B}) pair := _. End prod_setoid. (* Typeclasses Opaque prod_equiv. *) (** ** Sums *) Definition sum_map {A A' B B'} (f: A → A') (g: B → B') (xy : A + B) : A' + B' := match xy with inl x => inl (f x) | inr y => inr (g y) end. Global Arguments sum_map {_ _ _ _} _ _ !_ / : assert. Global Instance inl_inj {A B} : Inj (=) (=) (@inl A B). Proof. injection 1; auto. Qed. Global Instance inr_inj {A B} : Inj (=) (=) (@inr A B). Proof. injection 1; auto. Qed. Global Instance sum_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (sum_map f g). Proof. intros ?? [?|?] [?|?] [=]; f_equal; apply (inj _); auto. Qed. Inductive sum_relation {A B} (RA : relation A) (RB : relation B) : relation (A + B) := | inl_related x1 x2 : RA x1 x2 → sum_relation RA RB (inl x1) (inl x2) | inr_related y1 y2 : RB y1 y2 → sum_relation RA RB (inr y1) (inr y2). Section sum_relation. Context `{RA : relation A, RB : relation B}. Global Instance inl_inj' : Inj RA (sum_relation RA RB) inl. Proof. inversion_clear 1; auto. Qed. Global Instance inr_inj' : Inj RB (sum_relation RA RB) inr. Proof. inversion_clear 1; auto. Qed. End sum_relation. Global Instance sum_equiv `{Equiv A, Equiv B} : Equiv (A + B) := sum_relation (≡) (≡). Elpi Accumulate TC.Solver lp:{{ shorten tc-elpi_apps_tc_tests_stdlib.stdppInj.{tc-Inj}. % shorten tc-stdppInj.{tc-Inj}. tc-Inj A B RA {{@equiv (sum _ _) (@sum_equiv _ _ _ _)}} S C :- tc-Inj A B RA {{sum_relation _ _}} S C. }}. Global Instance inl_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inl A B) := _. Global Instance inr_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inr A B) := _. Notation "` x" := (proj1_sig x) (at level 10, format "` x") : stdpp_scope. Elpi Accumulate TC.Solver lp:{{ shorten tc-elpi_apps_tc_tests_stdlib.stdppInj.{tc-Inj}. tc-Inj A B RA RB F X :- F = fun _ _ _, G = {{@compose _ _ _ _ _}}, coq.unify-eq G F ok, tc-Inj A B RA RB G X. }}. Definition f := Nat.add 0. Global Instance h: Inj eq eq f. unfold f. simpl. easy. Qed. Elpi Accumulate TC.Solver lp:{{ shorten tc-elpi_apps_tc_tests_stdlib.stdppInj.{tc-Inj}. :after "lastHook" tc-Inj A B RA RB F S :- F = (fun _ _ _), !, G = {{ compose _ _ }}, coq.unify-eq G F ok, tc-Inj A B RA RB G S. }}. Set Warnings "+elpi". Goal Inj eq eq (compose (@id nat) id). apply _. Qed. Goal Inj eq eq (compose (compose (@id nat) id) id). apply _. Qed. Goal Inj eq eq (fun (x:nat) => id (id x)). apply _. Qed. Goal Inj eq eq (fun (x: nat) => (compose id id) (id x)). apply (compose_inj eq eq); apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/stdppInjClassic.v000066400000000000000000000213411523041753400237620ustar00rootroot00000000000000(* File inspired from https://gitlab.mpi-sws.org/iris/stdpp/-/blob/8c98553ad0ca2029b30cf18b58e321ec3a79172b/stdpp/base.v *) From Corelib Require Export Morphisms RelationClasses ListDef Setoid. From Stdlib Require Export List Peano Utf8 Permutation. From Stdlib Require Export Program.Basics Program.Syntax. Export ListNotations. Notation length := Datatypes.length. Global Generalizable All Variables. Global Unset Transparent Obligations. Definition tc_opaque {A} (x : A) : A := x. (* Typeclasses Opaque tc_opaque. *) Global Arguments tc_opaque {_} _ /. Declare Scope stdpp_scope. Delimit Scope stdpp_scope with stdpp. Global Open Scope stdpp_scope. Notation "(=)" := eq (only parsing) : stdpp_scope. Notation "( x =.)" := (eq x) (only parsing) : stdpp_scope. Notation "(.= x )" := (λ y, eq y x) (only parsing) : stdpp_scope. Notation "(≠)" := (λ x y, x ≠ y) (only parsing) : stdpp_scope. Notation "( x ≠.)" := (λ y, x ≠ y) (only parsing) : stdpp_scope. Notation "(.≠ x )" := (λ y, y ≠ x) (only parsing) : stdpp_scope. Infix "=@{ A }" := (@eq A) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(=@{ A } )" := (@eq A) (only parsing) : stdpp_scope. Notation "(≠@{ A } )" := (λ X Y, ¬X =@{A} Y) (only parsing) : stdpp_scope. Notation "X ≠@{ A } Y":= (¬X =@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope. Global Hint Extern 0 (_ = _) => reflexivity : core. Global Hint Extern 100 (_ ≠ _) => discriminate : core. Global Instance: ∀ A, PreOrder (=@{A}). Proof. split; repeat intro; congruence. Qed. Class Equiv A := equiv: relation A. Global Instance equiv_rewrite_relation `{Equiv A} : RewriteRelation (@equiv A _) | 150 := {}. Infix "≡" := equiv (at level 70, no associativity) : stdpp_scope. Infix "≡@{ A }" := (@equiv A _) (at level 70, only parsing, no associativity) : stdpp_scope. Notation "(≡)" := equiv (only parsing) : stdpp_scope. Notation "( X ≡.)" := (equiv X) (only parsing) : stdpp_scope. Notation "(.≡ X )" := (λ Y, Y ≡ X) (only parsing) : stdpp_scope. Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : stdpp_scope. Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : stdpp_scope. Notation "( X ≢.)" := (λ Y, X ≢ Y) (only parsing) : stdpp_scope. Notation "(.≢ X )" := (λ Y, Y ≢ X) (only parsing) : stdpp_scope. Notation "(≡@{ A } )" := (@equiv A _) (only parsing) : stdpp_scope. Notation "(≢@{ A } )" := (λ X Y, ¬X ≡@{A} Y) (only parsing) : stdpp_scope. Notation "X ≢@{ A } Y":= (¬X ≡@{ A } Y) (at level 70, only parsing, no associativity) : stdpp_scope. Class LeibnizEquiv A `{Equiv A} := leibniz_equiv (x y : A) : x ≡ y → x = y. Global Hint Mode LeibnizEquiv ! - : typeclass_instances. Global Instance: Params (@equiv) 2 := {}. Global Instance equiv_default_relation `{Equiv A} : DefaultRelation (≡@{A}) | 3 := {}. Global Hint Extern 0 (_ ≡ _) => reflexivity : core. Global Hint Extern 0 (_ ≡ _) => symmetry; assumption : core. Class Inj {A B} (R : relation A) (S : relation B) (f : A → B) : Prop := inj x y : S (f x) (f y) → R x y. Class Inj2 {A B C} (R1 : relation A) (R2 : relation B) (S : relation C) (f : A → B → C) : Prop := inj2 x1 x2 y1 y2 : S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2. Global Arguments irreflexivity {_} _ {_} _ _ : assert. Global Arguments inj {_ _ _ _} _ {_} _ _ _ : assert. Global Arguments inj2 {_ _ _ _ _ _} _ {_} _ _ _ _ _: assert. Global Instance inj2_inj_1 `{Inj2 A B C R1 R2 R3 f} y : Inj R1 R3 (λ x, f x y). Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Global Instance inj2_inj_2 `{Inj2 A B C R1 R2 R3 f} x : Inj R2 R3 (f x). Proof. repeat intro; edestruct (inj2 f); eauto. Qed. Notation "(∧)" := and (only parsing) : stdpp_scope. Notation "( A ∧.)" := (and A) (only parsing) : stdpp_scope. Notation "(.∧ B )" := (λ A, A ∧ B) (only parsing) : stdpp_scope. Notation "(∨)" := or (only parsing) : stdpp_scope. Notation "( A ∨.)" := (or A) (only parsing) : stdpp_scope. Notation "(.∨ B )" := (λ A, A ∨ B) (only parsing) : stdpp_scope. Notation "(↔)" := iff (only parsing) : stdpp_scope. Notation "( A ↔.)" := (iff A) (only parsing) : stdpp_scope. Notation "(.↔ B )" := (λ A, A ↔ B) (only parsing) : stdpp_scope. Global Hint Extern 0 (_ ↔ _) => reflexivity : core. Global Hint Extern 0 (_ ↔ _) => symmetry; assumption : core. Notation "(→)" := (λ A B, A → B) (only parsing) : stdpp_scope. Notation "( A →.)" := (λ B, A → B) (only parsing) : stdpp_scope. Notation "(.→ B )" := (λ A, A → B) (only parsing) : stdpp_scope. Notation "t $ r" := (t r) (at level 65, right associativity, only parsing) : stdpp_scope. Notation "($)" := (λ f x, f x) (only parsing) : stdpp_scope. Notation "(.$ x )" := (λ f, f x) (only parsing) : stdpp_scope. Infix "∘" := compose : stdpp_scope. Notation "(∘)" := compose (only parsing) : stdpp_scope. Notation "( f ∘.)" := (compose f) (only parsing) : stdpp_scope. Notation "(.∘ f )" := (λ g, compose g f) (only parsing) : stdpp_scope. (** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully applied. *) Global Arguments id _ _ / : assert. Global Arguments compose _ _ _ _ _ _ / : assert. Global Arguments flip _ _ _ _ _ _ / : assert. Global Arguments const _ _ _ _ / : assert. Definition fun_map {A A' B B'} (f: A' → A) (g: B → B') (h : A → B) : A' → B' := g ∘ h ∘ f. Global Instance id_inj {A} : Inj (=) (=) (@id A). Proof. intros ??; auto. Qed. Global Instance compose_inj {A B C} R1 R2 R3 (f : A → B) (g : B → C) : Inj R1 R2 f → Inj R2 R3 g → Inj R1 R3 (g ∘ f). Proof. red; intuition. Qed. (** ** Products *) Notation "( x ,.)" := (pair x) (only parsing) : stdpp_scope. Notation "(., y )" := (λ x, (x,y)) (only parsing) : stdpp_scope. Notation "p .1" := (fst p) (at level 1, left associativity, format "p .1"). Notation "p .2" := (snd p) (at level 1, left associativity, format "p .2"). Definition prod_map {A A' B B'} (f: A → A') (g: B → B') (p : A * B) : A' * B' := (f (p.1), g (p.2)). Global Arguments prod_map {_ _ _ _} _ _ !_ / : assert. Global Instance pair_inj {A B} : Inj2 (=) (=) (=) (@pair A B). Proof. injection 1; auto. Qed. Global Instance prod_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (prod_map f g). Proof. intros ?? [??] [??] ?; simpl in *; f_equal; [apply (inj f)|apply (inj g)]; congruence. Qed. Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A * B) := λ x y, R1 (x.1) (y.1) ∧ R2 (x.2) (y.2). Section prod_relation. Context `{RA : relation A, RB : relation B}. Global Instance pair_inj' : Inj2 RA RB (prod_relation RA RB) pair. Proof. inversion_clear 1; eauto. Qed. End prod_relation. Global Instance prod_equiv `{Equiv A,Equiv B} : Equiv (A * B) := prod_relation (≡) (≡). Section prod_setoid. Context `{Equiv A, Equiv B}. Global Instance pair_equiv_inj : Inj2 (≡) (≡) (≡@{A*B}) pair := _. End prod_setoid. (* Typeclasses Opaque prod_equiv. *) (** ** Sums *) Definition sum_map {A A' B B'} (f: A → A') (g: B → B') (xy : A + B) : A' + B' := match xy with inl x => inl (f x) | inr y => inr (g y) end. Global Arguments sum_map {_ _ _ _} _ _ !_ / : assert. Global Instance inl_inj {A B} : Inj (=) (=) (@inl A B). Proof. injection 1; auto. Qed. Global Instance inr_inj {A B} : Inj (=) (=) (@inr A B). Proof. injection 1; auto. Qed. Global Instance sum_map_inj {A A' B B'} (f : A → A') (g : B → B') : Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (sum_map f g). Proof. intros ?? [?|?] [?|?] [=]; f_equal; apply (inj _); auto. Qed. Inductive sum_relation {A B} (RA : relation A) (RB : relation B) : relation (A + B) := | inl_related x1 x2 : RA x1 x2 → sum_relation RA RB (inl x1) (inl x2) | inr_related y1 y2 : RB y1 y2 → sum_relation RA RB (inr y1) (inr y2). Section sum_relation. Context `{RA : relation A, RB : relation B}. Global Instance inl_inj' : Inj RA (sum_relation RA RB) inl. Proof. inversion_clear 1; auto. Qed. Global Instance inr_inj' : Inj RB (sum_relation RA RB) inr. Proof. inversion_clear 1; auto. Qed. End sum_relation. Global Instance sum_equiv `{Equiv A, Equiv B} : Equiv (A + B) := sum_relation (≡) (≡). Global Instance inl_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inl A B) := _. Global Instance inr_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inr A B) := _. Notation "` x" := (proj1_sig x) (at level 10, format "` x") : stdpp_scope. Definition f := Nat.add 0. Global Instance h: Inj eq eq f. unfold f. simpl. easy. Qed. Goal Inj eq eq (compose (@id nat) id). apply _. Qed. Goal Inj eq eq (compose (compose (@id nat) id) id). apply _. Qed. (* Goal Inj eq eq (fun (x:nat) => id (id x)). apply _. Qed. *) Goal Inj eq eq (fun (x: nat) => (compose id id) (id x)). apply (compose_inj eq eq); apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/test_commands_API.v000066400000000000000000000021071523041753400242150ustar00rootroot00000000000000From elpi.apps Require Import tc. From elpi_apps_tc_tests_stdlib Require Import eqSimplDef. Elpi Command len_test. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ pred counti i:gref, i:int. counti GR Len :- if (const _ = GR) (std.findall (tc.instance _ _ GR _) Cl, std.assert! ({std.length Cl} = Len) "Unexpected number of instances") true. main [str E, int Len] :- coq.locate E GR, counti GR Len. }}. TC.AddClasses Eqb. Module test1. TC.AddInstances Eqb ignoreInstances eqP. Elpi len_test Eqb 2. End test1. Reset test1. Module test2. Elpi len_test Eqb 0. End test2. Reset test2. Module test3. TC.AddInstances Eqb. Elpi len_test Eqb 3. End test3. Reset test3. (* About RewriteRelation. About RelationClasses.RewriteRelation. Elpi Query TC.Solver lp:{{ coq.gref->id {{:gref RelationClasses.RewriteRelation}} L. }}. *) Module test4. TC.AddAllClasses. TC.AddAllInstances eqU. Elpi Query TC.Solver lp:{{ EqP = {{:gref eqU}}, std.assert! (not (tc.instance _ EqP _ _)) "EqP should not be in the DB". }}. End test4.LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/test_import/000077500000000000000000000000001523041753400230465ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/test_import/f1.v000066400000000000000000000002031523041753400235360ustar00rootroot00000000000000From elpi.apps Require Export tc. From Corelib Require Export Morphisms. Elpi TC Solver Override TC.Solver Rm Proper ProperProxy. LPCIC-coq-elpi-eb449d7/apps/tc/tests-stdlib/test_import/f2.v000066400000000000000000000000761523041753400235470ustar00rootroot00000000000000From elpi_apps_tc_tests_stdlib.test_import Require Import f1. LPCIC-coq-elpi-eb449d7/apps/tc/tests/000077500000000000000000000000001523041753400172165ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/000077500000000000000000000000001523041753400176555ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/add_alias.v000066400000000000000000000011321523041753400217420ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. Elpi Debug "use-alias". Class foo (A : Type) := f : Type. Global Instance fooNat : foo nat := {f := nat}. Global Instance fooBool : foo bool := {f := bool}. Elpi AddClasses foo. Elpi AddInstances foo. Definition nat' := nat. Goal foo nat. apply _. Qed. Goal foo bool. apply _. Qed. Goal foo nat'. Fail apply _. Abort. Module A. Elpi Accumulate TC.Solver lp:{{ alias {{nat'}} {{nat}}. }}. Goal foo nat'. apply _. Qed. End A. Definition nat'' := nat'. Elpi AddAlias (nat'') (nat'). Goal foo nat''. apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/cyclicTC_jarl.v000066400000000000000000000035011523041753400225500ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi Debug "simple-compiler". Set TC NameShortPath. Elpi TC Solver Override TC.Solver All. Class A (T1 : Type). Class B (T1 : Type). Global Instance instA' (T1 : Type) (T2 : Type) : A bool. Qed. Global Instance instA (T1 : Type) `(B T1) : A T1. Qed. Global Instance instB (T1 : Type) `(A T1) : B T1. Qed. Global Instance instB' : B nat . Qed. Elpi Accumulate tc.db lp:{{ pred explored_gref o:gref. pred should_fail i:list gref, i:gref, i:gref. should_fail [] _ _. should_fail [Current | Tl] Current BlackElt :- !, if (std.mem Tl BlackElt) fail true. should_fail [_ | Tl] Current BlackElt :- !, should_fail Tl Current BlackElt. pred already_explored i:gref, i:gref. already_explored Current BlackElt :- std.findall (explored_gref _) As, std.map As (x\r\ x = explored_gref r) As', should_fail As' Current BlackElt. pred get_other i:gref, o:gref. pred under_extra i:gref, i:list prop, o:list prop. under_extra A B C :- std.map B (x\r\ (explored_gref A => x) = r) C1, C = [sigma x\ get_other A x, already_explored A x | C1]. :after "firstHook" tc.make-tc IsHead Ty Inst Hyp Clause :- !, app [global TC | TL] = Ty, tc.gref->pred-name TC TC_Str, std.append TL [Inst] Args, coq.elpi.predicate TC_Str Args Q, if (not IsHead) (Hyp = Hyp') (under_extra TC Hyp Hyp'), Clause = (Q :- Hyp'). }}. Elpi AddAllClasses. Elpi AddAllInstances. Elpi Command AddRecursivelyDependantTC. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ main [trm (global A), trm (global B)] :- coq.elpi.accumulate _ "tc.db" (clause _ _ (get_other A B)), coq.elpi.accumulate _ "tc.db" (clause _ _ (get_other B A)). main L :- coq.say L. }}. Elpi AddRecursivelyDependantTC (A) (B). Elpi Bound Steps 10000. Check (_ : B bool). Check (_ : A nat). LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/included_proof.v000066400000000000000000000013331523041753400230400ustar00rootroot00000000000000From elpi.apps Require Import tc. Class EqDec (A : Type) := { eqb : A -> A -> bool ; eqb_leibniz : forall x y, eqb x y = true -> x = y }. Generalizable Variables A. Class Ord `(E : EqDec A) := { le : A -> A -> bool }. Class C (A : Set). Elpi TC Solver Override TC.Solver All. Global Instance cInst `{e: EqDec nat} : Ord e -> C nat. Admitted. (* We want to be sure that cInst when compiled has only one hypothesis: (Ord e). We don't want the hypothesis {e : EqDec nat} since it will be verified by (Ord e) *) (* TODO: it should not fail *) Fail Elpi Query TC.Solver lp:{{ compile {{:gref cInst}} _ _ CL, CL = (pi a\ pi b\ (_ :- (Hyp a b))), coq.say Hyp, pi a b\ expected-found (do _) (Hyp a b). }}. LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/premisesSort/000077500000000000000000000000001523041753400223545ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/premisesSort/sort1.v000066400000000000000000000006141523041753400236140ustar00rootroot00000000000000From elpi.apps.tc.tests.premisesSort Require Import sortCode. Set Warnings "+elpi". Class A (S : Type). Class B (S : Type). Class C (S : Type). Global Instance A1 : A nat. Admitted. Global Instance A2 : A bool. Admitted. Global Instance B1 : B nat. Admitted. Global Instance C1 {T : Type} `{A T, B T} : C bool. Admitted. (* Simpl example where we do backtrack *) Goal C bool. apply _. Qed.LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/premisesSort/sort2.v000066400000000000000000000014511523041753400236150ustar00rootroot00000000000000From elpi.apps.tc.tests.premisesSort Require Import sortCode. Elpi Debug "simple-compiler". Set TC AddModes. Class A (S : Type). Class B (S : Type). Class C (S : Type). Global Hint Mode A + : typeclass_instances. Global Instance A1 : A nat. Admitted. Global Instance B1 : B nat. Admitted. (* Here since the output of T is input in A, we want to reorder the goals such that the proof of be is computed first. Question do we want to raise an error or try to rearrange subgoals in C1. We can try to make an analysis in the compiling phase to raise the error. *) Global Instance C1 {T : Type} `{e : A T, B T} : C bool. Admitted. Elpi AddAllClasses. Elpi AddAllInstances. Elpi TC Solver Override TC.Solver All. Elpi Print TC.Solver "elpi.apps.tc.tests/TC.Solver". Goal C bool. apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/premisesSort/sort3.v000066400000000000000000000014151523041753400236160ustar00rootroot00000000000000From elpi.apps.tc.tests.premisesSort Require Import sortCode. Elpi Debug "simple-compiler". Class A (S : Type) (T : Type). Class B (S : Type) (T : Type). Class C (S : Type). Global Hint Mode A + - : typeclass_instances. Global Hint Mode B + - : typeclass_instances. Elpi AddAllClasses. Global Instance A1 : A nat nat. Admitted. Global Instance B1 : B nat nat. Admitted. Global Instance C1 {S T : Type} `{B S T, A T S} : C T. Admitted. Elpi AddAllInstances. Elpi TC Solver Override TC.Solver All. Goal C nat. apply _. Qed. (* Following has a cyclic dependecy, therefore error *) (* Global Instance C2 {S T : Type} `{A T S, B S T} : C bool. Admitted. *) (* Elpi AddInstances C2. *) (* Global Instance C3 {S T : Type} `{B T S} : C S. Admitted. *) (* Elpi AddInstances C3. *)LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/premisesSort/sort4.v000066400000000000000000000040311523041753400236140ustar00rootroot00000000000000From elpi.apps.tc.tests.premisesSort Require Import sortCode. Elpi Debug "simple-compiler". Set TC AddModes. Class A (S : Type) (T : Type). Class C (S : Type) (T : Type). Class B (S : Type) (T : Type) `(A S T, C S T) := f : forall (x : S), x = x. Global Hint Mode A + + : typeclass_instances. Global Hint Mode C + + : typeclass_instances. Global Instance A1 : A nat nat. Admitted. Global Instance C1 : C nat nat. Admitted. Global Instance B1 (S : Type) (T : Type) (a : A S T) (c : C S T) : B S T a c. Admitted. Elpi AddAllClasses. Elpi AddAllInstances. Elpi TC Solver Override TC.Solver All. Elpi Accumulate tc.db lp:{{ pred get-inout-sealed-goal i:argument_mode, i:sealed-goal, o:list term. get-inout-sealed-goal AMode (seal (goal _ _ (app [global GR | L]) Sol _)) Res :- tc-mode GR Modes, std.append L [Sol] L', std.map2-filter L' Modes (t\m\r\ pr AMode _ = m, var t, r = t) Res. get-inout-sealed-goal out (seal (goal _ _ _ Sol _)) [Sol]. get-inout-sealed-goal _ _ []. pred sort-goals i:list sealed-goal, o:list int. sort-goals L NL :- std.map-i L (i\x\r\ r = pr x i) LookupList, std.map L (x\r\ sigma M\ get-inout-sealed-goal in x M, r = pr x M) InputModes, std.map L (x\r\ sigma Output Deps\ get-inout-sealed-goal out x Output, std.map-filter InputModes (x\r\ sigma Fst Snd\ pr Fst Snd = x, std.exists Output (v\ std.exists Snd (v1\ occurs_var v v1)), r = Fst) Deps, % O(N^2) sigma Output2Nb Deps2Nb\ std.lookup! LookupList x Output2Nb, std.map Deps (std.lookup! LookupList) Deps2Nb, r = pr Output2Nb Deps2Nb) Graph, coq.toposort Graph NL. pred sort-sealed-goals i:list sealed-goal, o:list sealed-goal. sort-sealed-goals SGL SortedSGL :- sort-goals SGL SGLIndexes, std.map SGLIndexes (x\r\ std.nth x SGL r) SortedSGL. :after "firstHook" msolve L N :- !, sort-sealed-goals L LSort, coq.say LSort, coq.ltac.all (coq.ltac.open solve) LSort N. :after "firstHook" msolve A _ :- coq.say A, sep, fail. }}. Goal 3 = 3. Fail apply f. Abort.LPCIC-coq-elpi-eb449d7/apps/tc/tests/WIP/premisesSort/sortCode.v000066400000000000000000000112141523041753400243240ustar00rootroot00000000000000 From elpi Require Import tc. Elpi Accumulate tc.db lp:{{ pred get-pattern-fragment i:term, o:list term. pred get-inout i:argument_mode, i:term, o:list term. % TODO: the second arg may not be an (app L) get-inout AMode (app [global GR | L]) Res :- std.drop-last 1 {tc-mode GR} Modes, std.map2-filter L Modes (t\m\r\ pr AMode _ = m, r = t) Res. get-inout _ _ []. pred input-must-have-predecessor i:term, i:term, i:list term, i:list term. input-must-have-predecessor _ _ [] _ :- !. input-must-have-predecessor Instance Premise [Mode | Modes] Premises :- std.exists Premises (p\ sigma MOut\ get-inout out p MOut, std.mem MOut Mode), input-must-have-predecessor Instance Premise Modes Premises. input-must-have-predecessor Instance Premise [Mode | _] _ :- coq.error "Input mode" Mode "of" Premise "cannot be inferred from the other premises of the instance" Instance. % CurrentType is the type of the current instance to get its input variables, % These variables should not create edges in the graph pred sort-hypothesis i:term, i:term, i:list term, o:list int. sort-hypothesis Instance (app [_ | InputCurrentType]) L NL :- std.map-i L (i\x\r\ r = pr x i) LookupList, std.map L (premise\r\ sigma M M'\ get-inout in premise M, std.filter M (x\ not (std.mem InputCurrentType x)) M', input-must-have-predecessor Instance premise M' L, r = pr premise M') InputModes, % foreach goal, we associate those goals having a dependency on it, % in particular a goal G2 depends on G1 if a variable V is in % output mode for G1 and in input mode for G2 (the dependency graph will % and edge going from G1 to G2 : G1 -> G2) std.map L (x\r\ sigma Output Deps\ % O(N^3 * check of occurs) % the list of variable in input of the current goal G get-inout out x Output, % for each output modes of all goals, we keep those having an output % which exists in the input variable of G std.map-filter InputModes (x\r\ sigma Fst Snd\ pr Fst Snd = x, std.exists Output (v\ std.exists Snd (v1\ occurs v v1)), r = Fst) Deps, % O(N^2) sigma Output2Nb Deps2Nb\ std.lookup! LookupList x Output2Nb, std.map Deps (std.lookup! LookupList) Deps2Nb, r = pr Output2Nb Deps2Nb) Graph, coq.toposort Graph NL. pred sort-and-compile-premises i:term, i:term, i:list term, i:list term, i:prop, o:list prop. sort-and-compile-premises Instance CurrentType Types Vars IsPositive Premises :- sort-hypothesis Instance CurrentType Types TypesSortedIndexes, % O (n^3) % std.map-i Types (i\e\r\ r = i) TypesSortedIndexes, std.map TypesSortedIndexes (x\r\ std.nth x Vars r) SortedVars, % O (n^2) std.map TypesSortedIndexes (x\r\ std.nth x Types r) SortedTypes, % O (n^2) std.map2-filter SortedTypes SortedVars (t\v\r\ compile-aux1 t v [] [] [] (not IsPositive) false r _) Premises. pred compile-aux1 i:term, i:term, i:list term, i:list univ, i:list term, i:prop, i:prop, o:prop, o:bool. :name "compiler-aux:start" compile-aux1 Ty I [] [X | XS] [] IsPositive IsHead (pi x\ C x) IsLeaf :- !, pi x\ copy (sort (typ X)) (sort (typ x)) => copy Ty (Ty1 x), compile-aux1 (Ty1 x) I [] XS [] IsPositive IsHead (C x) IsLeaf. compile-aux1 (prod N T F) I ListVar [] Types IsPositive IsHead Clause ff :- !, (if IsPositive (Clause = pi x\ C x) (Clause = (pi x\ decl x N T => C x))), pi p\ sigma Type\ if (app-has-class T, not (occurs p (F p))) (Type = T) (Type = app []), compile-aux1 (F p) I [p | ListVar] [] [Type | Types] IsPositive IsHead (C p) _. :if "simple-compiler" % TODO: here we don't do pattern fragment unification compile-aux1 Ty I ListVar [] Types IsPositive IsHead Clause tt :- !, sort-and-compile-premises I Ty Types ListVar IsPositive Premises, coq.mk-app I {std.rev ListVar} AppInst, tc.make-tc IsHead Ty AppInst Premises Clause. compile-aux1 Ty I ListVar [] Types IsPositive IsHead Clause tt :- !, sort-and-compile-premises I Ty Types ListVar IsPositive Premises, coq.mk-app I {std.rev ListVar} AppInst, std.append {get-pattern-fragment Ty} {get-pattern-fragment AppInst} Term-to-be-fixed, std.fold Term-to-be-fixed 0 (e\acc\r\ sigma L X\ e = app X, std.length X L, r is acc + L - 1) Len, if (IsPositive) (IsPositiveBool = tt) (IsPositiveBool = ff), remove-ho-unification IsHead IsPositiveBool Len Ty AppInst Premises Term-to-be-fixed [] [] [] [] [] Clause. :after "firstHook" compile-aux Ty Inst _Premises _VarAcc UnivL IsPositive IsHead Clause NoPremises :- !, compile-aux1 Ty Inst [] UnivL [] (IsPositive = tt, true; false) IsHead Clause NoPremises. }}. LPCIC-coq-elpi-eb449d7/apps/tc/tests/auto_compile.v000066400000000000000000000032271523041753400220710ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. (* TODO: How to add the #[deterministic] pragma in front of the class? *) (* #[deterministic] Class A (T : Type) := {succ : T -> T}. *) Class A (T : Type) := {succ : T -> T}. #[local] Instance B : A nat := {succ n := S n}. Instance C : A bool := {succ b := negb b}. Instance Prod (X Y: Type) `(A X, A Y) : A (X * Y) := {succ b := match b with (a, b) => (succ a, succ b) end}. Elpi Accumulate TC.Solver lp:{{ :after "firstHook" solve _ _ :- coq.say "Solving in ELPI!", fail. }}. Goal A (nat * (nat * bool)). apply _. Qed. Module M. Class B (T : nat). Section A. Instance X : B 1. Qed. Goal B 1. apply _. Qed. Global Instance Y : B 2. Qed. Goal B 2. apply _. Qed. End A. Goal B 1. Proof. Fail apply _. Abort. Goal B 2. Proof. apply _. Qed. Section B. Variable V : nat. Global Instance Z : `(B 0) -> B V. Qed. Global Instance W : B 0. Qed. End B. Goal B 0. apply _. Qed. Goal B 10. apply _. Qed. End M. Goal M.B 1. apply M.X. Qed. Goal M.B 0. apply _. Qed. Goal M.B 10. apply _. Qed. Elpi Query TC.Solver lp:{{ % Small test for instance order sigma I L\ std.findall (tc.instance _ _ _ _) I, std.map-filter I (x\y\ x = tc.instance _ y {{:gref M.B}} _) [{{:gref M.W}}, {{:gref M.Y}}, {{:gref M.Z}}]. }}. Module S. Class Cl (i: nat). #[local] Instance Cl1 : Cl 1. Qed. #[global] Instance Cl2 : Cl 2. Qed. #[export] Instance Cl3 : Cl 3. Qed. End S. Elpi TC Solver Override TC.Solver None. Goal S.Cl 1 /\ S.Cl 2 /\ S.Cl 3. Proof. split. all:cycle 1. split. apply _. Fail apply _. Import S. apply _. Fail apply _. Abort. LPCIC-coq-elpi-eb449d7/apps/tc/tests/compile_add_pred.v.skip000066400000000000000000000066431523041753400236350ustar00rootroot00000000000000From elpi Require Import elpi. Elpi Db tc.db lp:{{ pred classes i:gref. pred bool->mode-term i:bool, o:string. bool->mode-term tt "i:term". bool->mode-term ff "o:term". pred modes->string i:list bool, o:string. modes->string L S :- std.map L bool->mode-term L', std.string.concat "," L' S. pred list-init i:int, i:(int -> A -> prop), o:list A. list-init N _ _ :- N < 0, std.fatal-error "list-init negative length". list-init 0 _ [] :- !. list-init N F [A | TL] :- F N A, N1 is N - 1, list-init N1 F TL. pred fail->bool i:prop, o:bool. fail->bool P ff :- P, !. fail->bool _ tt. pred make-tc-modes i:int, o:string. make-tc-modes NB_args ModesStr :- list-init NB_args (x\r\ fail->bool (x = 1) r) ModesBool, modes->string ModesBool ModesStr. pred gref->pred-name i:gref, o:string. gref->pred-name Gr S :- coq.gref->id Gr S', S is "tc-" ^ S'. pred add-tc-pred i:gref, i:int. add-tc-pred Gr NbArgs :- not (classes Gr), make-tc-modes NbArgs Modes, gref->pred-name Gr GrStr, D is "pred " ^ GrStr ^ " " ^ Modes ^ ".", coq.elpi.add-predicate "tc.db" D, coq.elpi.accumulate _ "tc.db" (clause _ _ (classes Gr)). add-tc-pred _ _. pred make-tc i:term, i:term, i:list prop, o:prop. make-tc Ty Inst Hyp Clause :- app [global TC | TL] = Ty, gref->pred-name TC TC_Str, std.append TL [Inst] Args, std.length Args ArgsLen, add-tc-pred TC ArgsLen, coq.elpi.predicate TC_Str Args Q, Clause = (Q :- Hyp). pred app-has-class i:term, o:gref. app-has-class (prod _ _ T) C :- pi x\ app-has-class (T x) C. app-has-class (app [global T|_]) T :- coq.TC.class? T. pred compile i:term, i:term, i:list prop, i:list term, o:prop. compile (prod _ T F) I ListRHS ListVar (pi x\ C x) :- !, pi p cond\ sigma Clause L\ if (app-has-class T _) (compile T p [] [] Clause, L = [Clause | ListRHS]) (L = ListRHS), compile (F p) I L [p | ListVar] (C p). compile Ty I Premises ListVar Clause :- !, std.rev Premises PremisesRev, coq.mk-app I {std.rev ListVar} AppInst, make-tc Ty AppInst PremisesRev Clause. }}. Elpi Command addClass. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ main [str TC_Name] :- coq.locate TC_Name TC_Gr, coq.env.typeof TC_Gr TC_Ty, coq.count-prods TC_Ty N', N is N' + 1, % Plus one for the solution add-tc-pred TC_Gr N. }}. Elpi Command compile. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ main [str InstName] :- coq.locate InstName InstGr, coq.env.typeof InstGr InstTy, compile InstTy (global InstGr) [] [] Cl, coq.say Cl, coq.elpi.accumulate _ "tc.db" (clause _ _ Cl). }}. Elpi Tactic solver. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ msolve L N :- !, coq.ltac.all (coq.ltac.open solve) {std.rev L} N. solve (goal _ _ Ty Sol _ as G) GL :- var Sol, Ty = app [global TC | TL'], std.append TL' [X] TL, if (coq.elpi.predicate {gref->pred-name TC} TL Q, Q) ( refine X G GL; coq.say "illtyped solution:" {coq.term->string X} ) (GL = [seal G]). }}. Class EqSimpl (T : Type) := {eqb : T -> T -> bool}. Global Instance EqU : EqSimpl unit := { eqb A B := true }. Global Instance EqP {A B: Type} `(EqSimpl A, EqSimpl B) : EqSimpl (A * B) := { eqb A B := true }. Elpi addClass EqSimpl. Elpi compile EqU. Elpi compile EqP. Elpi Override TC solver All. Check (_ : EqSimpl unit). Check (_ : EqSimpl (unit * unit)). LPCIC-coq-elpi-eb449d7/apps/tc/tests/contextDeepHierarchy.v000066400000000000000000000006561523041753400235350ustar00rootroot00000000000000From elpi.apps Require Import tc. Unset Typeclass Resolution For Conversion. Set TC NameShortPath. Elpi TC Solver Override TC.Solver All. Class X (A: Type). Class Y (A: Type). Class Z (A: Type). Local Instance Inst1@{i} {A: Type@{i}} : X A -> Y A. Qed. Local Instance Inst2@{i} (A : Type@{i}): (forall A : Type@{i}, X A -> Y A) -> Z A. Qed. (* TODO: here Elpi Trace Fails... *) Goal forall A, Z A. intros. apply _. Qed.LPCIC-coq-elpi-eb449d7/apps/tc/tests/dune000066400000000000000000000003021523041753400200670ustar00rootroot00000000000000(coq.theory (name elpi.apps.tc.tests) (flags :standard -async-proofs-cache force) (package rocq-elpi-tests) (theories elpi elpi.apps.tc)) (include_subdirs qualified) (dirs :standard \ WIP) LPCIC-coq-elpi-eb449d7/apps/tc/tests/hook_test.v000066400000000000000000000006731523041753400214120ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. Elpi TC.AddHook after 1000 1513. Elpi TC.AddHook before 1513 1512. Class A (n : nat). Instance Inst1 : A 3 | 1513. Qed. Instance Inst2 : A 100 | 1512. Qed. Elpi Query TC.Solver lp:{{ sigma InstL GrefL\ std.findall (tc.instance _ _ {{:gref A}} _) InstL, std.map InstL (x\r\ x = tc.instance _ r _ _) GrefL, GrefL = [{{:gref Inst2}}, {{:gref Inst1}}]. }}. LPCIC-coq-elpi-eb449d7/apps/tc/tests/hyp_in_conl.v000066400000000000000000000036561523041753400217200ustar00rootroot00000000000000From elpi.apps Require Import tc. (* Here we want to test that if the solution of a premise is rigid then the premise is not run *) Module M1. Structure ofe := Ofe { ofe_car : Type; }. Class D (I : ofe). Class C (X : ofe) (I : D X). Definition ofe_nat : ofe := Ofe nat. Instance c : forall (H : D (Ofe nat)), C ofe_nat H := {}. Goal forall (H : D (Ofe nat)), True -> exists H, C (ofe_nat) H. intros. notypeclasses refine (ex_intro _ _ _ ). apply _. Qed. End M1. Module M2. Class A. Class B (I : A). Class C (A : A) (I : B A). Instance c : forall (A : A) (B : B A), C A B := {}. Goal forall (A : A) (B : B A), exists A B, C A B. intros. do 2 notypeclasses refine (ex_intro _ _ _ ). apply _. Qed. End M2. Module M3. Class A. Class B (I : A). Class C (A : A) (I : B A). Instance c : forall (A : A) (B : B A), C A B := {}. Set Warnings "+elpi". Section s. Elpi Accumulate TC.Solver lp:{{ :before "0" tc-elpi.apps.tc.tests.hyp_in_conl.M3.tc-A _ :- coq.say "In tc-A", fail. :before "0" tc-elpi.apps.tc.tests.hyp_in_conl.M3.tc-B _ _ :- coq.say "In tc-B", fail. }}. Local Instance AX : A := {}. Local Instance BX : A -> (B AX) := {}. Definition d : C AX (BX _) := _. Definition d' : C _ (BX _) := _. Definition d'' : C AX _ := _. Check (c _ _) : C AX _. (* Here we give the solver a partial solution with a hole in it. This hole correspond to the premise of the typeclass B (an instance of A). Due to the var condition on the resolution of rule's premises, the premise of `C`, that is, `B X` is not solved since we have the partial solution `BX _`. (see: [here](https://github.com/LPCIC/coq-elpi/blob/889bd3fc16c31f35c850edf5a0df2f70ea9c655a/apps/tc/elpi/tc_aux.elpi#L124)) *) Elpi Query TC.Solver lp:{{ S = {{c AX (BX _)}}, tc.solve-aux1 [] {{C _ _}} S. }}. End s. End M3.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/000077500000000000000000000000001523041753400215245ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f1.v000066400000000000000000000001751523041753400222240ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export sameOrderCommand. Class A (T : Set) := f : T -> T. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f2a.v000066400000000000000000000005041523041753400223620ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export f1. From elpi.apps.tc.tests.importOrder Require Export sameOrderCommand. Global Instance f2aa : A nat := {f x := x}. Global Instance f2ab : A nat := {f x := x}. Global Instance f2ac : A nat := {f x := x}. Global Instance f2ad : A nat := {f x := x}. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f2b.v000066400000000000000000000004061523041753400223640ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export f1. Global Instance f2ba : A nat := {f x := x}. Global Instance f2bb : A nat := {f x := x}. Global Instance f2bc : A nat := {f x := x}. Global Instance f2bd : A nat := {f x := x}. (* Elpi SameOrderImport. *) LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3a.v000066400000000000000000000002071523041753400223630ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Import f2a. From elpi.apps.tc.tests.importOrder Require Import f2b. Elpi SameOrderImport. LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3b.v000066400000000000000000000002061523041753400223630ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Import f2b. From elpi.apps.tc.tests.importOrder Require Import f2a. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3c.v000066400000000000000000000015641523041753400223740ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export f1. Global Instance f3a : A nat := {f x := x}. Global Instance f3b : A nat := {f x := x}. Global Instance f3c : A nat := {f x := x}. Elpi SameOrderImport. Section S1. Variable X : Type. Local Instance f3d : A nat := {f x := x}. Global Instance f3e : A nat := {f x := x}. Global Instance f3f : A nat := {f x := x}. Elpi SameOrderImport. End S1. Elpi SameOrderImport. Section S2. Context (T : Set). Global Instance f3g : A T := {f x := x}. Elpi SameOrderImport. End S2. Elpi SameOrderImport. Section S3. Context (T : Set). Global Instance f3g2 : A (T: Set) := {f x := x}. Global Instance f3h T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. Global Instance f3g3 : A (T: Set) := {f x := x}. Global Instance f3g4 : A (T: Set) | 10 := {f x := x}. Elpi SameOrderImport. End S3. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3d.v000066400000000000000000000013601523041753400223670ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export f1. From elpi.apps.tc.tests.importOrder Require Import f2b. Elpi SameOrderImport. Global Instance f3a' T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. Elpi SameOrderImport. Module M4'. (* From elpi.apps.tc.tests.importOrder Require Import f2a. *) Elpi SameOrderImport. Global Instance f3a : A nat := {f x := x}. Section S1. Variable X : Type. Global Instance f3b : A nat := {f x := x}. Section S1'. Variable Y : Type. Global Instance f3c : A nat := {f x := x}. End S1'. End S1. Elpi SameOrderImport. Section S2. Variable X : Type. Global Instance f3h T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. End S2. End M4'. Elpi SameOrderImport. LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3e.v000066400000000000000000000012261523041753400223710ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export f1. From elpi.apps.tc.tests.importOrder Require Import f2b. From elpi.apps.tc.tests.importOrder Require Import f2a. Global Instance f3a' T1 T2 `(A T1, A T2) : A (T1 * T2) := {f x := x}. Elpi SameOrderImport. Module M4'. Global Instance f3a : A nat := {f x := x}. Section S1. Variable X : Type. Global Instance f3b : A nat := {f x := x}. Section S1'. Variable Y : Type. Global Instance f3c : A nat := {f x := x}. End S1'. End S1. Section S2. Variable X : Type. Global Instance f3h T1 T2 `(A T1, A T2) : A (T1 * T2) | 100 := {f x := x}. End S2. End M4'. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3f.v000066400000000000000000000004731523041753400223750ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Import f1. Section S1. Context (T : Set). Global Instance f3a : A T := {f x := x}. Elpi SameOrderImport. Section S2. Context (T1 : Set). Global Instance f3b : A T1 := {f x := x}. End S2. Elpi SameOrderImport. End S1. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f3g.v000066400000000000000000000003221523041753400223670ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Export f1. Module M8. Class Classe (A: Type) (B: Type). Global Instance I (a b c d: Type): Classe a a -> Classe b c. Admitted. Elpi SameOrderImport. End M8. LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/f4.v000066400000000000000000000005461523041753400222310ustar00rootroot00000000000000From elpi.apps.tc.tests.importOrder Require Import f3f. From elpi.apps.tc.tests.importOrder Require Import f2a. From elpi.apps.tc.tests.importOrder Require Import f2b. From elpi.apps.tc.tests.importOrder Require Import f3c. From elpi.apps.tc.tests.importOrder Require Import f3d. From elpi.apps.tc.tests.importOrder Require Import f3g. Elpi SameOrderImport.LPCIC-coq-elpi-eb449d7/apps/tc/tests/importOrder/sameOrderCommand.v000066400000000000000000000007061523041753400251360ustar00rootroot00000000000000From elpi.apps Require Export tc. From elpi.apps.tc.elpi Extra Dependency "ho_link.elpi" as ho_link. From elpi.apps.tc.elpi Extra Dependency "tc_same_order.elpi" as tc_same_order. From elpi.apps.tc.elpi Extra Dependency "unif.elpi" as unif. Set Warnings "+elpi". Elpi Command SameOrderImport. Elpi Accumulate Db tc.db. Elpi Accumulate File unif. Elpi Accumulate File ho_link. Elpi Accumulate File tc_same_order. Elpi TC Solver Override TC.Solver All.LPCIC-coq-elpi-eb449d7/apps/tc/tests/indt_to_inst.v000066400000000000000000000016511523041753400221050ustar00rootroot00000000000000From Corelib Require Export ListDef. From elpi.apps Require Export tc. Global Generalizable All Variables. Elpi TC Solver Override TC.Solver All. Class ElemOf A B := elem_of: A -> B -> Prop. Class Elements A C := elements: C -> list A. Inductive elem_of_list {A} : ElemOf A (list A) := | elem_of_list_here (x : A) l : elem_of x (x :: l) | elem_of_list_further (x y : A) l : elem_of x l -> elem_of x (y :: l). Global Existing Instance elem_of_list. Inductive NoDup {A} : list A -> Prop := | NoDup_nil_2 : NoDup nil | NoDup_cons_2 x l : not (elem_of x l) -> NoDup l -> NoDup (x :: l). Module A. Class FinSet1 A C `{ElemOf A C,Elements A C} : Prop := { NoDup_elements (X : C) : NoDup (elements X) }. End A. Module B. Class FinSet2 A C `{ElemOf A C, Elements A C} : Prop := { elem_of_elements2 (X : C) x : iff (elem_of x (elements X)) (elem_of x X); NoDup_elements2 (X : C) : NoDup (elements X) }. End B. LPCIC-coq-elpi-eb449d7/apps/tc/tests/injTest.v000066400000000000000000000056171523041753400210360ustar00rootroot00000000000000From elpi.apps Require Import tc. From Corelib Require Import Morphisms RelationClasses ListDef Setoid. Generalizable All Variables. Elpi TC Solver Override TC.Solver All. Class Inj {A B} (R : relation A) (S : relation B) (f : A -> B) := inj x y : S (f x) (f y) -> R x y. Class Inj2 {A B C} (R1 : relation A) (R2 : relation B) (S : relation C) (f : A -> B -> C) : Prop := inj2 x1 x2 y1 y2 : S (f x1 x2) (f y1 y2) -> R1 x1 y1 /\ R2 x2 y2. (* Elpi TC Solver Override TC.Solver Only Inj Inj2. *) Definition gInj x := x + 1. Definition fInj x := x * 3. Axiom eq1 : relation nat. Axiom eq2 : relation nat. Axiom eq3 : relation nat. Local Instance isInjg : Inj eq3 eq1 gInj. Admitted. Local Instance isInjf : Inj eq1 eq3 fInj. Admitted. Local Instance isInjf_old : Inj eq1 eq2 fInj. Admitted. Local Instance isInjg_old : Inj eq2 eq3 gInj. Admitted. Local Instance isInjf_eq : Inj eq eq fInj. Admitted. Local Instance isInjg_eq : Inj eq eq gInj. Admitted. Local Instance id_inj {A} : Inj eq eq (@id A). Admitted. Local Instance inl_inj {A B} : Inj eq eq (@inl A B). Admitted. Local Instance inr_inj {A B} : Inj eq eq (@inr A B). Admitted. Definition compose {T1 T2 T3: Type} (g: T2 -> T3) (f : T1 -> T2) (x: T1) := g(f x). Local Instance compose_inj {A B C} R1 R2 R3 (f : A -> B) (g : B -> C) : Inj R1 R2 f -> Inj R2 R3 g -> Inj R1 R3 (compose g f). Admitted. Goal exists A B, Inj A B (compose gInj fInj). Admitted. Goal forall (T1 T2 : Type) (f: T1 -> T2), let r := Inj eq eq f in let x := true in (if x then r else r) -> Inj eq eq f. intros ? ? f r x H. unfold x, r in H. apply _. Qed. Goal forall (T1 T2 : Type) (f: T1 -> T2), let r := Inj eq eq f in let b := true in let cond := (match b with | true => r | false => f = f end) in cond -> Inj eq eq f. intros. unfold cond in H. simpl in H. unfold r in H. apply _. Qed. Elpi TC Solver Override TC.Solver All. Local Instance inj2_inj_1 `{Inj2 A B C R1 R2 R3 ff} y : Inj R1 R3 (fun x => ff x y). Admitted. Global Instance inj2_inj_2 `{Inj2 A B C R1 R2 R3 ff} x : Inj R2 R3 (ff x). Admitted. (* TODO: This does not work *) Goal Inj2 eq eq eq Nat.mul -> Inj eq eq (Nat.mul 0). intros. apply _. Qed. Goal Inj2 eq eq eq Nat.add -> Inj eq eq (fun x => Nat.add x 0). intros. apply _. Qed. Definition p (T : Type) := @pair T T. Goal Inj eq eq (compose fInj gInj). Proof. apply _. Qed. Set Warnings "+elpi". Elpi Accumulate tc.db lp:{{ shorten tc-elpi.apps.tc.tests.injTest.{tc-Inj}. % shorten tc-injTest.{tc-Inj}. tc-Inj T1 T2 R1 R3 F S :- F = (fun _ _ _), G = {{ compose _ _ }}, coq.unify-eq G F ok, tc-Inj T1 T2 R1 R3 G S. }}. Goal Inj eq eq (compose fInj gInj). apply _. Qed. Goal Inj eq eq (fun x => fInj (gInj x)). apply _. Qed. Goal forall (A: Type) (x: A -> A), let y := Inj eq eq x in let z := y in z -> Inj eq eq (compose x x). Proof. intros T x y z H. unfold z, y in H. apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests/lemma_with_max_impl.v000066400000000000000000000021351523041753400234220ustar00rootroot00000000000000From elpi.apps Require Import tc. Class A (n : nat). Instance a : A 0 := {}. Class B (n : nat). Class C (n : nat). Instance b x: C x := {}. Lemma foo: forall (x n: nat) `{A x} `{C n}, True -> B n. Admitted. Lemma bar: forall (n: nat) `{A n}, True -> B n. Admitted. Goal exists n, B n. Proof. eexists. (* Note: `{A x} and `{C n} are solved with x = 0, n remains a hole *) (* Moreover, True remains as active goal + a shelved goal remain for n *) refine (foo _ _ _). auto. Unshelve. constructor. Qed. Goal exists x, B x. Proof. eexists. (* Note: `{A x} is solved with x = 0 *) refine (bar _ _). auto. Qed. Goal exists x, C x. Proof. eexists. apply _. Unshelve. constructor. Qed. Class Decision (P : Type). Goal forall (A : Type) (P1: A -> Prop), exists (P : A -> A -> A -> Prop), forall z y , (forall x, Decision (P1 x)) -> forall x, Decision (P z y x). Proof. eexists; intros. apply _. Unshelve. auto. Qed. Elpi Tactic A. Elpi Accumulate lp:{{ msolve L _ :- coq.ltac.fail _ "[TC] fail to solve" L. }}. Goal exists n, B n. eexists. Fail apply _. Abort. LPCIC-coq-elpi-eb449d7/apps/tc/tests/multi_var.v000066400000000000000000000005351523041753400214120ustar00rootroot00000000000000From elpi Require Import elpi tc. Class C (T : Type) : Type := {}. Axiom t : forall n m : nat, Type. Instance tC (n : nat) : C (t n n). Qed. Set Printing All. Goal C (t 0 0). apply _. Qed. Instance tC1 (n : nat) : let n' := n in C (t n n'). Qed. Goal C (t 0 (id 0)). apply _. Qed. (* Elpi Print TC.Solver "elpi.apps.tc.examples/TC.Solver". *) LPCIC-coq-elpi-eb449d7/apps/tc/tests/nobacktrack.v000066400000000000000000000014721523041753400216730ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi Debug "simple-compiler". Set TC NameShortPath. Module A. Class C (n : nat) := {}. Elpi TC.Set_deterministic C. Elpi TC.Get_class_info C. Local Instance c_1 : C 1 | 10 := {}. Local Instance c_2 : C 2 | 1 := {}. Class D (n : nat) := {}. Local Instance d_1 : D 1 := {}. Class E (n : nat) := {}. Local Instance foo {n} : C n -> D n -> E n := {}. Elpi TC Solver Override TC.Solver All. Goal exists n, E n. eexists. Fail apply _. Abort. End A. Module B. Class A (T : Set) := f : T -> T. Elpi TC.Set_deterministic A. Global Instance A1 : A bool := {f x := x}. Global Instance A2 `(A bool) : A (bool * bool) := {f x := x}. Global Instance A3 `(A nat) : A (bool * bool) := {f x := x}. Goal A (bool * bool). apply _. Qed. End B.LPCIC-coq-elpi-eb449d7/apps/tc/tests/out/000077500000000000000000000000001523041753400200255ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/out/out.v000066400000000000000000000000001523041753400210110ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/patternFragment.v000066400000000000000000000101151523041753400225440ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. Set TC NameShortPath. Set TC CompilerWithPatternFragment. Class Y (A: Type). Class Z (A: Type). Class Ex (P : Type -> Type) (A: Type). Module M4. Local Instance Inst2 A F: (forall (a : Type) (b c : nat), Y (F a b) -> Y (F a c)) -> Z A. Qed. Goal Z bool. Elpi TC Solver Override TC.Solver None. Fail apply _. Elpi TC Solver Override TC.Solver All. apply _. Unshelve. assumption. (* we keep a, the first arg of F *) Qed. Local Instance Inst1: Y (bool * bool). Qed. Goal Z bool. Elpi TC Solver Override TC.Solver None. Succeed apply _. Elpi TC Solver Override TC.Solver All. apply _. Unshelve. assumption. Qed. End M4. (* Module M10. Class Y (I: nat). Goal exists F, forall a b c : Type, Y (F a b) -> Y (F c b). eexists. Elpi Trace Browser. apply _. *) Module M5. Local Instance Inst1: Y (bool * bool). Qed. Local Instance Inst2 A F (R: Type -> Type -> Type): forall x, (forall (a : Type), Y (F a)) -> Ex (R x) A. Qed. Goal forall (A:Type) x (R: Type -> Type -> Type ->Type), Ex (R x x) A. apply _. Qed. End M5. Module M1. Local Instance Inst1: Y (bool * bool). Qed. Local Instance Inst2 A F: (forall (a : Type), Y (F a)) -> Z A. Qed. Goal forall (A:Type), Z A. apply _. Qed. End M1. Module M2. Local Instance Inst1: Y (bool * bool). Qed. Local Instance Inst2 A F: (forall (a: Type), Y (F a)) -> Z A. Qed. Goal Z bool. apply _. Qed. End M2. Module M3. Local Instance Inst1: Y (bool * bool). Qed. Local Instance Inst2 A F: (forall (a b c d: Type), Y (F b c d)) -> Z A. Qed. Goal Z bool. apply _. Qed. End M3. (* Module withAnd. Elpi Accumulate TC.Solver lp:{{ :before "solve-aux-conclusion" solve-aux (goal _ _ TyRaw _ _ as G) GL :- not (var TyRaw), if (TyRaw = app [global C|_], coq.TC.class? C) fail (GL = [seal G]). }}. Module M6. Class and (a : Prop) (b : Prop). Instance andI {a b : Prop} : a -> b -> and a b. Qed. Local Instance Inst2 A F: and (F = fun _ _ => nat) (forall (a b c: Type), Y (F a b) -> Y (F b c)) -> Z A. Qed. Goal Z bool. Elpi Bound Steps 1000. Elpi Accumulate TC.Solver lp:{{ print-solution. }}. apply _. Unshelve. reflexivity. Qed. End M6. (* Module M10. Class and (a : Prop) (b : Prop). Instance andI {a b : Prop} : a -> b -> and a b. Qed. Elpi Accumulate TC.Solver lp:{{ :before "solve-aux-conclusion" solve-aux (goal _ _ TyRaw _ _ as G) GL :- not (var TyRaw), if (TyRaw = app [global C|_], coq.TC.class? C) fail (GL = [seal G]). }}. Local Instance Inst2 A F: (and (F = fun _ _ => nat) (forall (a b c: Type), Y (F a b) -> Y (F c b))) -> Z A. Qed. Goal Z bool. eapply Inst2. apply andI. (* reflexivity. *) 2: { Set Printing Existential Instances. apply _. intros. apply _. Qed. End M10. *) End withAnd. *) Module M7. Local Instance Inst2 A F: (forall (a b c: Type), Y (F a b) -> Y nat) -> Z A. Qed. Goal Z bool. apply _. Qed. End M7. Module M8. Local Instance Inst2 A F: (forall (a b c: Type), Y nat -> Y (F a b)) -> Z A. Qed. Goal Z bool. apply _. Qed. End M8. Module M9. Local Instance Inst2 A F: (forall (a b c: Type), Y (F a b) -> Y (F b c)) -> Z A. Qed. Goal Z bool. eapply _. Unshelve. apply nat. Qed. End M9. Module M1b. Local Instance Inst2 A F: (forall (a : Type), Y (F a)) -> Ex F A. Qed. Definition goal := forall (A:Type) (f : Type -> Type), (forall x, Y (f x)) -> exists g, Ex g A /\ g nat = g bool. Section coq. Elpi TC Solver Override TC.Solver None. Goal goal. Proof. intros ???. (* eexists (fun _ => nat). *) eexists; constructor. apply _. Show Proof. Abort. Elpi TC Solver Override TC.Solver All. End coq. Section elpi. Goal goal. Proof. intros ???. eexists; constructor. Show. apply _. Show. reflexivity. Unshelve. apply nat. Qed. End elpi. End M1b. LPCIC-coq-elpi-eb449d7/apps/tc/tests/prim_proj.v000066400000000000000000000002701523041753400214050ustar00rootroot00000000000000From elpi Require Import tc. Set Primitive Projections. Record S := { sort :> Type }. Unset Primitive Projections. Class C (s : Type) := {}. Instance SC (s : S) : C s := Build_C s. LPCIC-coq-elpi-eb449d7/apps/tc/tests/register/000077500000000000000000000000001523041753400210425ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/tests/register/f1.v000066400000000000000000000002161523041753400215360ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. Class A (n : nat). Instance I1 : A 1. Qed. Goal A 1. apply _. Qed.LPCIC-coq-elpi-eb449d7/apps/tc/tests/register/f2.v000066400000000000000000000002571523041753400215440ustar00rootroot00000000000000From elpi.apps.tc.tests.register Require Export f1. Goal A 1. apply _. Qed. Elpi TC Deactivate Observer TC.Compiler. Instance I2 : A 2. Qed. Goal A 2. Fail apply _. Abort.LPCIC-coq-elpi-eb449d7/apps/tc/tests/register/f3.v000066400000000000000000000012361523041753400215430ustar00rootroot00000000000000From elpi.apps.tc.tests.register Require Import f2. (* Note that in f2, TC.Compiler has been deactivated, therefore I3 should not be added *) Instance I3 : A 3. Qed. Goal A 3. Fail apply _. Abort. Elpi Command custom_observer. Elpi Accumulate lp:{{ main L :- coq.say "Received the following event" L. }}. Elpi TC Activate Observer TC.Compiler. Elpi Register TC Compiler custom_observer. Elpi TC Activate Observer custom_observer. (* Here we have two active event listener for the instance creation: custom observer which simply prints the received event and TC.Compiler that adds I4 to the db *) Instance I4 : A 4. Qed. Goal A 4. apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests/section_in_out.v000066400000000000000000000030021523041753400224210ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi Accumulate tc.db lp:{{ pred origial_tc o:int. }}. Elpi Command len_test. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ % contains the number of instances that are not % imported from other files main [int Len] :- std.findall (tc.instance _ _ _ _) Insts, std.map Insts (x\r\ tc.instance _ r _ _ = x) R, WantedLength is {origial_tc} + Len, std.assert! ({std.length R} = WantedLength) "Unexpected number of instances", std.forall R (x\ sigma L\ std.assert! (count R x L, L = 1) "Duplicates in instances"). }}. Elpi Query TC.Solver lp:{{ std.findall (tc.instance _ _ _ _) Rules, std.length Rules Len, coq.elpi.accumulate _ "tc.db" (clause _ _ (origial_tc Len)). }}. Class Eqb A:= eqb: A -> A -> bool. Global Instance eqA : Eqb unit := { eqb x y := true }. Elpi len_test 1. Section A. Context (A : Type). Global Instance eqB : Eqb bool := { eqb x y := if x then y else negb y }. Elpi len_test 2. Global Instance eqC : Eqb A := {eqb _ _ := true}. Elpi len_test 3. Section B. Context (B : Type). Global Instance eqD : Eqb B := {eqb _ _ := true}. Elpi len_test 4. End B. Elpi len_test 4. End A. Elpi len_test 4. Section ClassPersistence. Section S1. Context (X : Type) (A : X). Class class (A : X). Definition x : class A. apply Build_class. Qed. Hint Resolve x : typeclass_instances. Elpi TC.AddInstances x. Goal exists x, class x. eexists. apply _. Qed. End S1. End ClassPersistence.LPCIC-coq-elpi-eb449d7/apps/tc/tests/test.v000066400000000000000000000346501523041753400203740ustar00rootroot00000000000000From elpi Require Import tc. Section test_max_arity. Elpi Query TC.Solver lp:{{ T = (c1\ prod `c` _ c2 \ prod `_` (prod `a` _ c3 \ app [global _, app [c1, c3], c2]) c3 \ app [global _, c1, c2]), pi x\ tc.precomp.instance.get-range-arity x _ (T x) (tc.r-ar z (s z)). }}. End test_max_arity. Module test_link_eta_generation. Class c (T : Type -> Type -> Type -> Type). Class d (T : Type) (T : Type -> Type -> Type -> Type). Elpi Accumulate TC.Solver lp:{{ :after "0" tc.compile.instance.compile-conclusion _ (app [H|_]) _ _ _ Premises _ :- H = {{test_link_eta_generation.c}}, !, std.assert! (Premises = [do [tc.link.eta _ _] | _]) "[TC] Wrong number of eta links", coq.say "Good padding from here", fail. }}. Elpi Query TC.Solver lp:{{ ToCompile = {{forall (T : Type -> Type -> Type -> Type), (forall (a: Type), d a T) -> c T}}, not (tc.compile.instance ToCompile _ _). }}. End test_link_eta_generation. Module simpleHO. Class A (t : nat -> nat) (t' : Type). Class B (t : nat) (t' : Type). Instance I1: forall F c, (forall a, B (F a) c) -> A F c. Qed. Instance I2 : B 3 bool. Qed. Goal exists x, A x bool. Proof. eexists. apply _. Qed. End simpleHO. Module HO_1. Axiom (f : bool -> unit -> nat -> nat). Class A (t : bool -> unit -> nat -> nat). Class B (t : unit -> nat -> nat). Class C (t : nat). Instance I1: forall a b, (C (f true a b)). Qed. Instance I2: forall F, (forall x y, C (F x y)) -> B F. Qed. Instance I3: forall F, (forall x, B (F x)) -> A F. Qed. Goal B (fun x y => f true x y). apply _. Qed. Goal exists x, A x. eexists. Time apply _. Unshelve. (* Note: here we find a most general solution than Coq's one *) apply tt. apply 3. Qed. End HO_1. Module HO_2. Axiom f : Type -> Type -> Type. Class A (t : Type -> Type -> Type) (t : Type -> Type -> Type). Instance I: forall f, A f (fun x y => f y x). Qed. Goal A f (fun x y => f y x). apply _. Qed. End HO_2. Module HO_3. Axiom (f : nat -> nat -> nat). Class A (t : nat -> nat -> nat -> nat). Class B (t : nat -> nat -> nat). Class C (t : nat -> nat). Instance I1: (C (f 3)). Qed. Instance I2: forall F, (forall x, C (F x)) -> B F. Qed. Instance I3: forall F, (forall x, B (F x)) -> A F. Qed. Goal exists x,B x. eexists. apply _. Qed. End HO_3. Module HO_4. Axiom (f : nat -> nat -> nat -> nat). Class A (t : nat -> nat -> nat -> nat -> nat -> nat). Class B (t : nat -> nat -> nat -> nat -> nat). Class C (t : nat -> nat -> nat). Instance I1: C (fun x => f x 3). Qed. Instance I2: forall F, (forall x y, C (F x y)) -> B (fun a b => F b a). Qed. Instance I3: forall F, (forall x, B (F x)) -> A F. Qed. Goal exists x, A x. eexists. apply _. Qed. End HO_4. Module HO_swap. Axiom (f : Type -> Type -> Type). Elpi Query TC.Solver lp:{{ tc.link.eta.maybe-eta (fun `x` _ c0 \ fun `y` _ c1 \ A2 c1 c0), tc.link.eta.maybe-eta (fun `x` _ c0 \ fun `y` _ c1 \ A2 (A c1) c0), tc.link.eta.maybe-eta {{fun x y => f x y}}. }}. Class c1 (T : (Type -> Type -> Type)). Class c2 (T : (Type -> Type -> Type)). Elpi Query TC.Solver lp:{{ @pi-decl `x` {{Type -> Type}} f\ tc.precomp.instance.is-uvar f => sigma T\ tc.precomp.instance {{c1 (fun x y => lp:f y x)}} T N _ _, std.assert! (T = app[{{c1}}, tc.maybe-eta-tm _ _]) "[TC] invalid precomp". }}. Instance a1 : forall (F : Type -> Type -> Type), c2 (fun x y => F y x) -> c1 F. Qed. Instance b1 : c2 f. Qed. Goal c1 (fun x y => f y x). apply _. Qed. End HO_swap. Module HO_5. Axiom (f : Type -> Type -> Type). Class c1 (T : (Type -> Type -> Type)). Class c2 (T : (Type -> Type -> Type)). Class c3 (T : (Type -> Type -> Type)). Instance a1 : forall (F : Type -> Type -> Type), (c2 (fun x y => F y x) -> c3 (fun x y => F y x)) -> c1 F. Qed. Instance a2 : c2 f -> c3 f. Qed. Goal c1 (fun x y => f y x). apply _. Qed. End HO_5. Module HO_6. Axiom (f : Type -> Type -> Type). Class c1 (T : (Type -> Type -> Type)). Class c2 (T : (Type -> Type -> Type)). Class c3 (G : nat -> nat) (T : (Type -> Type -> Type)). Instance a1 : forall (F : Type -> Type -> Type), (c2 (fun x y => F y x) -> forall G, c3 G (fun x y => F y x)) -> c1 F. Qed. Instance a2 : forall F, c2 f -> c3 F f. Qed. Goal c1 (fun x y => f y x). apply _. Qed. End HO_6. Module HO_7. (* Here maybe-eta is in the goal, with a flexible head *) Axiom f : Type -> Type -> Type. Class c1 (T : Type -> Type -> Type) (T : Type -> Type -> Type). Instance i1: c1 f (fun x y => f y x). Qed. (* TODO: decl M _ {{Type -> Type -> Type}} => coq.typecheck M Ty ok. Ty is flex, I would like it to be (prod _ _ (x\ prod _ _ _))) to make the following test succeed Elpi Query TC.Solver lp:{{ decl M _ {{Type -> Type -> Type}} => tc.compile.goal {{c1 (fun x y => lp:M y x) lp:M}} G L, std.length L Len, std.assert! (Len = 5). }}. *) Goal exists M, c1 (fun x y => M y x) M. eexists. apply _. Qed. End HO_7. Module HO_81. Class c1 (T : Type). Instance i1 F : c1 F. Qed. Elpi Accumulate TC.Solver lp:{{ :before "compile-goal" tc.compile.goal Goal _ _ :- Goal = {{HO_81.c1 lp:_}}, !, tc.precomp.goal Goal _ Vars, !, tc.compile.goal.make-pairs Vars Pairs, std.assert! (Pairs = []) "", fail. }}. Goal exists X, c1 X. eexists. (* Failure is good, since here we simply check that the number of uvar-pair built by tc.precomp is zero. This is because the type of ?X is Type (i.e. it has `arity` zero) *) Fail apply _. Abort. End HO_81. Module HO_8. Class c1 (T : Type -> Type -> Type). Instance i1 F : c1 (fun x => F x). Qed. Goal exists X, c1 X. eexists. apply _. Unshelve. apply nat. Qed. End HO_8. Module HO_9. Axiom f : Type -> Type -> Type. Class c1 (T : Type -> Type). Instance i1 A: c1 (fun x => f (A x) (A x)). Qed. Elpi Query TC.Solver lp:{{ pi F\ sigma T\ decl F `x` {{Type -> Type}} ==> tc.precomp.instance.is-uvar F ==> tc.precomp.instance {{c1 (fun x => f (lp:F x) (lp:F x))}} T N _ _, std.assert! (T = app [{{c1}}, tc.maybe-eta-tm _ _]) "Invalid precompilation". }}. Goal exists X, c1 X. eexists. (* TODO: here good solution, but universe problem!!! *) eapply (i1 (fun x => _)). (* apply _. *) Unshelve. auto. Qed. End HO_9. Module HO_10. Axiom f : Type -> Type -> Type. Class c1 (T : Type -> Type -> Type). Instance i1 A: c1 (fun x y => f (A x y) (A x y)). Qed. (* Note: here interesting link-dedup *) Goal exists X, c1 X. eexists. (* TODO: here good solution, but universe problem!!! *) (* apply _. *) eapply (i1 (fun _ _ => _)). Unshelve. auto. Qed. End HO_10. Module HO_scope_check1. Axiom f : Type -> (Type -> Type) -> Type. Axiom g : Type -> Type -> Type. Axiom a : Type. Class c1 (T : Type -> Type). Instance i1 : forall X, c1 (fun x => f x (fun y => g x (X y))). Qed. Goal c1 (fun x => f x (g x)). apply _. Qed. Elpi Query TC.Solver lp:{{ sigma X Q\ % To avoid printing in console tc.build-query-from-goal {{c1 (fun x => f x lp:X)}} _ Q _, (pi A L T\ tc.link.eta.scope-check (uvar _ L) (fun _ _ (x\ app [{{g}}|_] as T)) :- !, std.assert! (not (prune A L, A = T)) "[TC] Should fail by Scope Check", fail) => not Q. }}. (* Here fail on scope check *) Goal exists X, c1 (fun x => f x X). eexists. Fail apply _. Abort. End HO_scope_check1. Module beta_reduce_preprocess. Axiom f : Type -> Type -> Type. Module in_instance. Class c1 (T:Type). Instance i1 : c1 ((fun x y => f y x) nat bool). Qed. Goal c1 (f bool nat). apply _. Qed. End in_instance. Module in_goal. Class c1 (T : Type). Instance i1 : c1 (f nat bool). Qed. Goal c1 ((fun x y => f y x) bool nat). apply _. Qed. End in_goal. End beta_reduce_preprocess. Module Llam_1. Class A (i: nat -> nat). Class B (i: nat -> nat). Elpi Query TC.Solver lp:{{ @pi-decl `x` {{Type -> Type}} f\ tc.precomp.instance.is-uvar f => @pi-decl `x` {{Type -> Type}} g\ tc.precomp.instance.is-uvar g => sigma T\ tc.precomp.instance {{A (fun x => lp:f (lp:g x))}} T N _ _, std.assert! (T = app[{{A}}, tc.maybe-eta-tm (fun _ _ (x\ tc.maybe-llam-tm _ _)) _]) "[TC] invalid precomp". }}. Instance I1: forall F G, B G -> A (fun x => F (G x)). Qed. Instance I2: B (fun x => x). Qed. (* HERE progress-llam-refine! *) (* While back-chaining `I1`, the eta-link for `F (G x)` is triggered, and the `llam-link` for `F (G x)` becomes `S =llam F (G x)` the premise `B G` assigns `G` to the identity (thanks to I2), this updates the `llam-link` to `S = llam F x`. `F x` is in PF, and can safely be unfied to `S`. The finaly substitution is therefore: I1 S (fun x => x) I2 *) Goal A S. apply _. Qed. End Llam_1. Module Llam_2. Axiom a : nat. Class c1 (i: nat). Class c2 (i: nat -> nat). Instance I1: forall F, c2 F -> c1 (F a). Qed. Instance I2: c2 (fun x => x). Qed. (* HERE progress-rhs! *) (* While back-chaining, the goal unify with I1. `c2 F` is unified with `c2 (fun x => x)` due to I2. F is now rigid can be beta-reduced to a *) Goal c1 a. (* Note : if, as coq, we force the llam link immediately, then apply _ fails *) Fail apply _. Abort. Goal exists X, c1 X. eexists. apply _. Qed. End Llam_2. Module Llam_3. Axiom f: bool -> unit -> nat -> nat -> nat -> nat. Class c1 (i : nat). Class c2 (i: nat). Class c3 (i: bool -> unit -> nat -> nat -> nat -> nat). Instance I1 : forall (F: bool -> unit -> nat -> nat -> nat) G, c3 G -> (forall a b c d, c2 (G a b c d (F a b c d))) -> c1 0. Qed. Instance I2 : c3 f. Qed. Instance I3 a b c d F: c2 (f a b c d F). Qed. Goal c1 0. apply _. Unshelve. auto. Qed. End Llam_3. Module Llam_4. Axiom f : Type -> (Type -> Type) -> Type. Axiom g : Type -> Type -> Type. Axiom a : Type. Class c1 (T : Type -> Type). Instance i1 : forall X, c1 (fun x => f x (X x (fun (_: nat) => a) x)). Qed. Fail Elpi Query TC.Solver lp:{{ sigma X Q\ % To avoid printing in console tc.build-query-from-goal {{c1 (fun x => f x lp:X)}} _ Q _, not Q. }}. End Llam_4. Module Llam_5. Definition NN := nat -> nat. Class c1 (T : nat). (* Instance has a uvar whose type is hidden behind a definition *) Instance i : forall (x : NN), c1 (x 3). Qed. Goal c1 (id 3). apply _. Qed. End Llam_5. Module Llam_6. Class B (i: nat -> nat -> nat). Elpi Query TC.Solver lp:{{ (pi x\ tc.unify-eq {{fun _ => 0}} (P x x)), coq.say (P {{1}} {{2}}), std.assert! (P {{1}} {{2}} = {{ fun _ => 0}}) "Heuristic error". }}. Axiom (f : nat -> nat). Instance instB: B (fun _ _ => f 3) := {}. Class A. Instance instA : forall X, B (fun x => X x x) -> A := {}. Goal A. apply _. Qed. End Llam_6. Module CoqUvar. Class c1 (i:Type -> Type -> Type). Elpi Query TC.Solver lp:{{ tc.precomp.instance {{c1 (fun x y => lp:F y x)}} T _ _ _, coq.say T, Expected = app[{{c1}}, tc.maybe-eta-tm (fun _ _ Inn) []], std.assert! (T = Expected) "[TC] invalid precompile1", pi x\ sigma ExpectedInn\ ExpectedInn = tc.maybe-eta-tm (A x) [x], std.assert! ((Inn x) = ExpectedInn) "[TC] invalid precompile2". }}. Goal exists F, c1 (fun x y => F y x) -> c1 F. (* exists (fun x y => nat); auto. *) eexists. apply _. Unshelve. apply nat. Qed. End CoqUvar. Module CoqUvar1. Class c1. Class c2 (i:Type -> Type -> Type). Axiom f : Type -> Type -> Type. Instance i1: c2 f -> c1. Qed. Goal exists F, c2 (fun x y => F y x) -> c1. (* exists (fun x y => f y x); apply i1. *) eexists. intros. apply _. Qed. End CoqUvar1. Module CoqUvar2. Axiom t : Type. Class c1 (T : Type). Instance i1 (F: Type -> Type): c1 (F t). Qed. Goal exists F, c1 (F t). eexists. (* Set Debug "unification". *) (* TODO: here we produce a eta-expanded proof, which produce a coq unification between `?F a` and `fun x => X x` if we eta-reduce then coq has to unify `?F a` against `X` which succeeds *) apply _. Fail Check (i1 (fun x => _)) : c1 ( (fun x => _) t). (* ??? *) Unshelve. auto. Qed. End CoqUvar2. Module CoqUvar3. Axiom f : Type -> Type -> Type. Class c1 (T : Type -> Type -> Type). Instance i1 A: c1 (fun x y => f (A x y) (A x y)). Qed. Elpi Query TC.Solver lp:{{ tc.precomp.goal {{c1 (fun x y => lp:X (lp:A x y) y)}} C _, Expected = app [{{c1}}, tc.maybe-eta-tm (fun _ _ Body1) _], Body1 = (x\ tc.maybe-eta-tm (fun _ _ (Body2 x)) [x]), Body2 = (x\y\ tc.maybe-llam-tm (app [app [X], (Y x y), y]) [x,y]), std.assert! (C = Expected) "[TC] invalid compilation". }}. (* Note: here interesting link-dedup *) Goal exists X (A: Type -> Type -> Type), c1 (fun x y => X (A x y) y). (* do 2 eexists. apply _. Show Proof. Unshelve. apply T. apply T. Show Proof. *) (* proof is OK, but for universes!!!! *) apply (ex_intro (fun X : Type -> Type -> Type => exists A : Type -> Type -> Type, c1 (fun x y : Type => X (A x y) y)) (fun _ H : Type => f H H) (ex_intro (fun A : Type -> Type -> Type => c1 (fun x y : Type => (fun _ H : Type => f H H) (A x y) y)) (fun H _ : Type => H) (i1 (fun _ H : Type => H)))). Qed. Axiom g : Type -> Type -> Type. (* Note: here interesting failing link-dedup *) Goal exists (A: Type -> Type -> Type), c1 (fun x y => g (A x y) y). do 1 eexists. Fail apply _. Abort. End CoqUvar3. Module CoqUvar4. Axiom f : Type -> Type -> Type. Class c1 (T : Type -> Type -> Type). Elpi Query TC.Solver lp:{{ tc.precomp.instance {{c1 (fun x y => lp:X (lp:A x y) y)}} C _ _ _, Expected = app [{{c1}}, tc.maybe-eta-tm (fun _ _ Body1) _], Body1 = (x\ tc.maybe-eta-tm (fun _ _ (Body2 x)) [x]), Body2 = (x\y\ tc.maybe-llam-tm (app [app [X], (Y x y), y]) [y,x]), std.assert! (C = Expected) "[TC] invalid compilation". }}. (* Note: here interesting failtc-c1ing link-dedup *) Goal forall f, exists X, c1 (X nat) -> c1 (f nat nat). do 1 eexists. apply _. Qed. End CoqUvar4. (* TODO: add test with negative premise having a variable with type (M A) where M and A are coq uvar, this is in order to clean-term with llam *)LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_HO.v000066400000000000000000000235141523041753400207570ustar00rootroot00000000000000From elpi Require Import tc. Set TC NameShortPath. Module FO_prod. Section XX. Context (A B : Type) (y : B) (Q : A -> Prop). Class Ccc (i : Prop). Global Instance i P : Ccc (forall (x: A), P x y). Qed. Goal forall (P : nat -> A -> B -> Prop), Ccc (forall x, P 0 x y). apply _. Qed. End XX. End FO_prod. Module FO_app. Class nice_predicate {T : Type} (P : T -> Prop). Instance partial_app: forall (T : Type) (P : T -> T -> Prop), forall x, nice_predicate (P x). Qed. (* Unification is done between `p 0 x` and `P X` (The latter is not in PF) The former's elpi representation is `app [p, {{0}}, x]` while the latter is `P t p x (X t p x)` - `t` stands for T : Type - `P` is the unif variable `P` in partial_app - `X` is the unif variable `x` in partial_app We are outside the pattern fragment. The heuristics splits the arguments of `P` into `[t, p, x]` and `[(X t p x)]`, where `[t,p,x]` is the longest prefix in PF and `(X t p x)` is the remaining tail. We call the former PF and the latter NPF Len N the length of NPF and M the length of `[p, {{0}}, x]`, then we split `[p, {{0}}, x]` at position `M - N`. We obtain the sublists: `[p, {{0}}]` and `[x]`. We then unify `[x]` with `[(X t p x)]`. Let `L` the concatenation of `PF` and `NPF`, then the head P of the elpi unification variable is obtained by adding 4 lambda abstraction (the length of `L`), and for each abstraction `x` at depth `i` we add the local clause `copy L.(i) x`. The final result is `P = (x\y\z\w\ app[y, {{0}}, w])` *) Lemma ex1 (T : Type) (p : nat -> T -> T -> Prop) (x : T) : nice_predicate (p 0 x). apply _. Show Proof. Unshelve. Defined. Check eq_refl : ex1 = fun T p x => @partial_app T (p 0) x. (* Check eq_refl : ex1 = fun T p x => @partial_app T (fun _ => p 0 x) x. *) Lemma ex2 (T : Type) (p : nat -> T -> T -> Prop) y : nice_predicate (fun x => p 0 y x). apply _. Unshelve. (* auto. *) Defined. Check eq_refl : ex2 = fun T p y => @partial_app T (p 0) y. (* Check eq_refl : ex2 = fun T p y => @partial_app T (fun _ => p 0 y) y. *) Elpi TC Solver Override TC.Solver None. Lemma ex3 (T : Type) (p : nat -> T -> T -> Prop) y : nice_predicate (fun x => p 0 x y). Fail apply _. (* Coq KO *) Fail apply partial_app. (* Coq KO *) apply (@partial_app T (fun a b => p 0 b a) y). Abort. Lemma ex4 (T : Type) (p : nat -> T -> T -> Prop) y : nice_predicate (fun x => p 0 y x). Fail apply _. (* Coq KO *) Succeed apply partial_app. (* Coq eta! *) apply (@partial_app T (p 0) y). Abort. End FO_app. Elpi TC Solver Override TC.Solver All. Module FO_app1. Class Singleton (B: Type). Class Singleton1 (B: Type). Instance s M: (forall A : Type, Singleton1 (M A)) -> forall A : Type, Singleton (M A). Qed. Goal forall M, (forall A : Type, Singleton1 (M A)) -> forall A : Type, Singleton (M A). apply _. (* Unshelve. *) (* apply nat. *) Qed. End FO_app1. Module FO_app2. Section XX. Context (A B : Type). Class Functional (B: Type). Instance s1 F: Functional (F B) -> Functional (F B) -> Functional (F A). Qed. Definition f (x : Type) := Type. Context (H : Functional (f B)). Goal Functional (f A). apply _. Abort. End XX. End FO_app2. Module FO_app3. Definition X := Type -> Type. Axiom f : X. Class C (I : Type -> Type). Instance I : C (fun _ => f nat). Qed. Goal exists (R : Type -> Type) , forall (T:Type), C (fun x => R T) /\ R bool = f nat. eexists. intros. split. (* Here we commit the only existing solution for R, that is, R := fun _ => f nat, note that R does not see T *) apply _. reflexivity. Qed. Goal exists (R : Type -> Type) , C (fun x => R nat) /\ R bool = f nat. eexists. split. (* Here there is no mgu: there are in fact two solutions for R 1. R := fun _ => f nat 2. R := fun x => f x == f, in our case we commit the second *) apply _. Show Proof. Fail reflexivity. Abort. (* ============= We restart and try the good sol ============= *) Goal exists (R : Type -> Type) , C (fun x => R nat) /\ R bool = f nat. exists (fun x => f nat). split. apply _. reflexivity. Qed. Goal exists (R : Type -> Type) , C (fun x => R unit) /\ R bool = f nat. eexists. (* Here we fail, even though there exists the solution R := fun _ => f nat *) Fail apply _. Unshelve. 2:{ refine (fun x => f nat). } split. apply _. reflexivity. Qed. Goal exists (R : Type -> Type) , C (fun x => R nat) /\ R bool = f bool. eexists. split. apply _. reflexivity. Qed. End FO_app3. Module HO_PF. Class Extensionality (T : Type). Instance fun_1 (A1 : Type) (A2 : A1 -> Type) : Extensionality (forall a : A1, A2 a). Qed. Lemma ex1 : Extensionality (nat -> nat). apply _. Defined. Check eq_refl : ex1 = @fun_1 nat (fun _ => nat). Lemma ex2 : Extensionality (forall x : nat, x = x + 1). apply _. Defined. Check eq_refl : ex2 = @fun_1 nat (fun a => a = a + 1). Axiom odd : nat -> Type. Lemma ex3 : Extensionality (forall x : nat, odd x). apply _. Defined. Goal ex3 = ex3. unfold ex3. match goal with |- @fun_1 nat odd = _ => idtac end. reflexivity. Abort. (* Instance for multiple lambdas *) Instance fun_2 (A1 : Type) (A2 : A1 -> A1 -> Type) : Extensionality (forall a b : A1, A2 b a). Qed. Lemma ex4 : Extensionality (nat -> nat -> nat). apply _. Qed. End HO_PF. Module HO_PF1. Parameter A : Type. Class Decision (P : Type). (* Global Hint Mode Decision ! : typeclass_instances. *) Section sol_in_hyp. Goal forall (P1: A -> Prop), exists (P : A -> A -> A -> Prop), forall z y , (forall x, Decision (P1 x)) -> forall x, Decision (P z y x). Proof. eexists; intros. Elpi Bound Steps 30000. Set Typeclasses Debug. apply _. Unshelve. auto. Qed. End sol_in_hyp. Class Exists (P : A -> Type) (l : A). Instance Exists_dec (P : A -> Type): (forall x, Decision (P x)) -> forall l, Decision (Exists P l). Qed. Section test. Goal forall P (l:A) , Decision (Exists P l). Proof. intros. Fail apply _. (* We fail without infinite loop thanks to ho-links *) Abort. End test. Goal forall (P1: A -> Prop) l, exists (P : A -> A -> A -> Prop), forall z y , (forall x, Decision (P1 x)) -> Decision (Exists (P z y) l) /\ P z y y = P1 z. Proof. eexists; intros. split. (* forall x : A, Decision (P1 x) = forall x : A, Decision ((?P z y) x) *) (* x |- Decision (P1 ?x) = Decision ((?P z y) x) *) (* We take the most general solution for P, it picks P = (fun a b c => P1 ?x) *) apply _. simpl. (* Reflexivity fix ?x = a hence (fun a b c => P1 a) z y y = P1 z is solvable *) reflexivity. Qed. Lemma ho_in_coq (P1: A -> Prop) l: exists (P : A -> A -> A -> Prop), forall z y , (forall x, Decision (P1 x)) -> Decision (Exists (P z y) l) /\ P z y y = P1 z. Proof. Elpi TC Solver Override TC.Solver None. eexists; intros. (* epose (H _). *) (* clearbody d. *) (* clear H. *) split. (* Print HintDb typeclass_instances. *) (* Set Elpi Typeclasses Debug. *) (* Coq doesn't give the most general solution for P, it picks P = (fun _ _ x => P1 x) *) apply _. Fail reflexivity. Abort. Elpi TC Solver Override TC.Solver All. Section test. Context (P1: Type -> Prop). Context (H : Decision (P1 nat)). Goal exists P, forall (x y:A) , Decision (P x y). Proof. eexists; intros. apply _. Abort. End test. End HO_PF1. Section HO_PF2. Class cl1 (i : Type). Class cl2 {i : Type} (y : cl1 i). Class cl3 {i : Type} (y : cl1 i). Instance i1 : forall (H : forall x, cl1 x), cl2 (H nat) -> cl3 (H bool). Qed. Goal forall (H : forall x, cl1 x), cl2 (H nat) -> cl3 (H bool). Proof. apply _. Qed. Goal forall (H : forall x, cl1 x), cl2 (H nat) -> exists x (i_cl1: cl1 x), cl3 i_cl1. Proof. intros. do 2 eexists. apply _. Qed. End HO_PF2. Module D. Class C1 (T : Type -> Type) (i: forall x, T x). Class D. Instance I : forall (T : Type -> Type) (H : forall x, T x), C1 T (fun x => H x) -> D . Qed. Instance J: forall (T : Type -> Type) (H : forall x, T x), C1 T H. Qed. Goal D. intros. apply _. Unshelve. all: try apply 3; try apply nat. Qed. End D. Module F. Class C1 (T : Type -> Type) (i: forall x, T x). Class D. Instance I : forall (T : Type -> Type) (H : forall x, T x), C1 T (fun x => H x) -> D . Qed. Goal forall (T : Type -> Type) (H : forall x, T x), C1 T H -> D. intros. Set Typeclasses Debug. Set Debug "tactic-unification". Elpi TC Solver Override TC.Solver None. Fail apply _. (* Here coq's unfication algorithm fails: it is not able to solce H =~ fun x => ?H x, even though it is sufficient to eta-expand the lhs *) Elpi TC Solver Override TC.Solver All. apply _. Qed. End F. Module F'. Class C2 (T : Type -> Type) (i: forall x, T x). Class D. Instance I : forall (T : Type -> Type) (H : forall x, T x), C2 T H -> D . Qed. Goal forall (T : Type -> Type) (H : forall x, T x), C2 T (fun x => H x) -> D. intros. Set Debug "tactic-unification". Elpi TC Solver Override TC.Solver None. apply _. (* Here coq succeds: it is able to solce ?H =~ fun x => H x *) Abort. Goal forall (T : Type -> Type) (H : forall x, T x), C2 T (fun x => H x) -> D. Elpi TC Solver Override TC.Solver None. apply _. Qed. End F'. Module E. Class C3 (i : nat -> nat -> nat). Instance I : C3 (plus). Qed. Class D3 (i : Prop). Instance I2 (F : nat -> nat -> nat) : C3 F -> D3 (forall x y, F x y = F y x) . Qed. Goal D3 (forall n m, n + m = m + n). apply _. Qed. End E. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_backtrack_several_goals.v000066400000000000000000000040141523041753400252760ustar00rootroot00000000000000Module M. Class C (i: nat). Instance i1: C 1 := {}. Instance i2: C 2 := {}. Class E (i: nat). Instance e1 : E 1 := {}. Lemma m {i} {H : C i} {H1 : E i}: C i. Admitted. Class D (i:nat) (o: C i). Instance d1 (H: C 1) : D 1 H := {}. Goal exists i, C i. eexists. Set Typeclasses Debug. (* Here backtracking is done *) apply m. Qed. End M. Module M1. Class C (i: nat). Instance i1: C 1 := {}. Instance i2: C 2 := {}. Class E (i: nat). Instance e1 : E 1 := {}. Lemma m {i} (H : C i) (H1 : E i): C i. Admitted. Class D (i:nat) (o: C i). Instance d1 (H: C 1) : D 1 H := {}. Goal exists i, C i. eexists. Set Typeclasses Debug. apply m. (* Note: in coq the following command fails since apply is a single entry command, i.e. it cannot receive multiple goal at the same time. Therefore `apply _` will be triggered on the `n` goals. *) Fail all: apply _. all: typeclasses eauto. Qed. End M1. (* Here similar problems using the rocq-elpi solver *) From elpi Require Import elpi tc. Module ElpiBt. Class C (i: nat). Instance i1: C 1 := {}. Instance i2: C 2 := {}. Class E (i: nat). Instance e1 : E 1 := {}. Elpi Tactic T. Elpi Accumulate lp:{{ msolve A B :- coq.say A, coq.ltac.all (coq.ltac.open solve-aux) A B. pred solve-aux i:goal, o:list sealed-goal. solve-aux (goal _ _ G _ _ as GG) L :- coq.say "Goal is" {coq.term->string G}, solvee G S, coq.say "Solution for" {coq.term->string G} "is" {coq.term->string S}, refine S GG L. pred solvee o:term, o:term. solvee {{C 2}} {{i2}}. solvee {{C 1}} {{i1}}. solvee {{E 1}} {{e1}}. }}. Goal exists i, C i /\ E i. eexists. split. all : elpi T. Qed. End ElpiBt. Module M_in_elpi. Class C (i: nat). Instance c0: C 0 := {}. Instance c1: C 1 := {}. Class E (i: nat). Instance e0 : E 0 := {}. Lemma m {i} {H : C i} {H1 : E i}: C i. Admitted. Goal exists i, C i. eexists. apply m. Qed. End M_in_elpi. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_coercion.v000066400000000000000000000040071523041753400222460ustar00rootroot00000000000000From elpi Require Import tc. Module Animals. Module Bird1. Inductive info := Fly | NotFly. Class Animal (i : info). Class Bird (i : info) := IsAnimal :: Animal i. Instance dove : Bird Fly. split. Qed. (* It exists a ground solution for tc-Animal *) Elpi Query TC.Solver lp:{{ tc-elpi.apps.tc.tests.test_coercion.Animals.Bird1.tc-Animal _ S, ground_term S. }}. (* It does not exist a solution for tc-Animal with a flexible solution *) Elpi Query TC.Solver lp:{{ not (tc-elpi.apps.tc.tests.test_coercion.Animals.Bird1.tc-Animal _ S, not (ground_term S)). }}. Goal Animal Fly. apply _. Qed. Goal Animal NotFly. Fail solve [apply _]. Abort. End Bird1. Module Bird2. Class Animal. Class Bird1 := IsAnimal : Animal. Instance dove : Bird1. split. Qed. (* It does not exists an instance for Animal1 *) Elpi Query TC.Solver lp:{{ not (tc-elpi.apps.tc.tests.test_coercion.Animals.Bird2.tc-Animal _). }}. Goal Animal. Fail solve [apply _]. apply IsAnimal. Abort. End Bird2. End Animals. Module Vehicle. Class Wheels (i: nat). Class NoWheels := { (* the first argument of no_wheels is implicit! *) wheels0 :: Wheels 0; }. Class Boat := { wheels :: NoWheels }. Goal Boat -> Wheels 0. intros. apply _. Qed. End Vehicle. Module foo. Class B (i : nat). Section s. (* Class with coercion depending on section parameters *) Context (A : Type). Class C (i : nat) : Set := { f (x : A) :: B i }. End s. End foo. Module foo1. Class B (i : nat). Section s. (* Class with coercion not depending on section parameters *) Class C (i : nat) : Set := { f :: B i }. End s. Goal C 3 -> B 3. apply _. Abort. End foo1. Module localCoercion. Class B (i : nat). Section s. Class C (i : nat) : Set := { #[local] f :: B i }. Goal C 3 -> B 3. apply _. Qed. End s. Goal C 3 -> B 3. Fail apply _. Abort. End localCoercion. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_coercion_import.v000066400000000000000000000001661523041753400236420ustar00rootroot00000000000000From elpi.apps.tc.tests Require Import test_coercion. Import Animals.Bird1. Elpi Query TC.Solver lp:{{ true. }}. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_eta.v000066400000000000000000000015671523041753400212260ustar00rootroot00000000000000From elpi Require Import tc. Module M1. Axiom T : Type. Axiom P : T -> T -> T. Class eta (P: T -> T -> T). Instance I1: eta P. Qed. Goal eta (fun x => P x). Proof. apply _. Qed. Goal eta (fun x y => P x y). Proof. apply _. Qed. End M1. Module M2. Axiom T : Type. Axiom P1 : T -> T. Axiom P2 : T -> T -> T. Class eta (P1 : T -> T) (P2: T -> T -> T). Instance I1: eta P1 P2. Qed. Goal eta (fun x => P1 x) P2. Proof. apply _. Qed. Goal eta P1 (fun x y => P2 x y). Proof. apply _. Qed. Goal eta (fun x => P1 x) (fun x y => P2 x y). Proof. apply _. Qed. End M2. Module M3. Axiom T : Type. Axiom P : T -> T. Class eta (P: T -> T). Class aux (P: T -> T). Instance auxInst : aux (fun x => x). Qed. Instance I1: forall (P : T -> T), aux (fun x => P x) -> eta P. Qed. Goal exists P, eta (fun x => P x). Proof. eexists. apply _. Qed. End M3. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_pending_mode.v000066400000000000000000000141041523041753400230740ustar00rootroot00000000000000From elpi Require Import tc. Elpi Accumulate TC.Compiler lp:{{ :before "0" tc.add-class-gr _ A SM :- coq.say "Adding predicate for" A, coq.say "with mode" SM, fail, !. func old-version string, int, int, int ->. old-version _ 9 0 _. old-version _ 9 1 _. old-version _ 9 2 _. pred get-old-mode o:string. :after "0" main [str "new_class", str Cl, str _] :- old-version {coq.version}, get-old-mode Modes, not (var Modes), !, tc.time-it tc.oTC-time-compile-class ( coq.locate Cl GR, tc.add-class-gr tc.classic GR {rex.split " " Modes} ) "Compiler for Class". }}. Module ES3. (* No explicit mode in the class, the type of the predicate for add is `pred -> term, term`. i.e. the nat is considered as an output *) Class Add (I: nat). Instance addNat: Add 0. Qed. (* No problem in apply _ since the evar can be unified with the pattern 0 *) Goal exists x, (Add x). Proof. eexists; now apply _. Qed. End ES3. Module ES3'. #[mode = "-"]Class Add (I: nat). Instance addNat: Add 0. Qed. (* No problem in apply _ since the evar can be unified with the pattern 0 *) Goal exists x, (Add x). Proof. eexists; now apply _. Qed. End ES3'. Module ES4. Section S. Elpi Accumulate TC.Compiler lp:{{ get-old-mode "+". }}. (* Plus is mapped to the elpi input mode, i.e. the type of the predicate for add is `pred term -> term`. *) #[mode = "+"] Class Add (I: nat). Instance addNat: Add 0. Qed. (* Failure in apply _ since the evar does not match the pattern 0 *) Goal exists x, (Add x). Proof. eexists. Fail apply _. Abort. End S. End ES4. Module m1. Elpi TC.Pending_mode +. Class C (i : nat). Instance C0 : C 0. Qed. Goal exists x, C x. eexists. Fail apply _. Abort. Class C' (i : nat). Instance C0' : C' 0. Qed. Goal exists x, C' x. eexists. apply _. Abort. Elpi TC.Pending_mode +. Fail Elpi TC.Pending_mode +. Class C'' (i : nat). Instance C0'' : C'' 0. Qed. Goal exists x, C'' x. eexists. Fail apply _. Abort. End m1. Module ground. Elpi TC.Pending_mode +. Class C (i : Type). Instance i : C (list nat). Qed. Goal exists (x : Type), C (list x). eexists. Fail apply _. Abort. End ground. Module ground1. Elpi TC.Pending_mode +. Class C (i : Type). Instance i x: C x. Qed. Goal exists (x : Type), C (list x). eexists. apply _. Abort. End ground1. Module ground2. Elpi TC.Pending_mode +. Class C (i : Type). Instance i (x: Type): C (list x). Qed. Goal exists (x : Type), C (list x). eexists. apply _. Abort. End ground2. Module ground3. Elpi TC.Pending_mode + +. Class C {i : Type} (f : i -> i -> Prop). Instance i {X : Type}: C (@eq X). Qed. Goal exists (X : Type), C (@eq X). eexists. apply _. Unshelve. apply nat. Qed. End ground3. Module ground4. Elpi TC.Pending_mode - +. Class C {i : Type} (f : i -> i -> Prop). Instance i {X : Type}: C (@eq X). Qed. Hint Mode C ! ! : typeclass_instances. Goal exists (X : Type), @C (list X) eq. eexists. apply _. Abort. End ground4. Module rigid_head1. Elpi TC.Pending_mode !. Class C (i : Type). Instance i: C (list nat). Qed. Hint Mode C ! : typeclass_instances. Goal exists (x : Type), C (list x). eexists. Fail apply _. Abort. Goal exists (x : Type), C x. eexists. Fail apply _. Abort. End rigid_head1. Module rigid_head2. Elpi TC.Pending_mode ! !. Class C {i : Type} (f : i -> i -> Prop). Instance i {X : Type}: C (@eq X). Qed. Hint Mode C ! ! : typeclass_instances. Goal exists (X : Type), C (@eq X). eexists. apply _. Unshelve. apply nat. Qed. End rigid_head2. Module simplEq. TC.Pending_mode "!". Class MyEqb A : Type := eqb : A -> A -> bool. (* Global Hint Mode MyEqb ! : typeclass_instances. *) Notation " x == y " := (eqb x y) (no associativity, at level 70). Global Instance eqU : MyEqb unit := { eqb x y := true }. Global Instance eqB : MyEqb bool := { eqb x y := if x then y else negb y }. Global Instance eqP {A B} `{MyEqb A} `{MyEqb B} : MyEqb (A * B) := { eqb x y := andb (fst x == fst y) (snd x == snd y) }. Fail Goal exists T: Type, forall n m : T, eqb n m = false. Goal forall n m : bool, eqb n m = false. Abort. End simplEq. Module force_input_link. TC.Pending_mode "+". Class A (i: nat -> nat -> nat). Global Hint Mode A + : typeclass_instances. Axiom (f : nat -> nat -> nat). Instance instA: A f := {}. Class B (i: nat). Instance instB : forall R, A R -> forall x y, B (R x y) := {}. Goal B (f 0 0). apply _. Qed. End force_input_link. Module force_input_link_HO_var1. TC.Pending_mode !. Class A (i: Type). Global Hint Mode A ! : typeclass_instances. (*Mode also added in elpi*) Axiom f : Type -> Type. Axiom g : Type -> Type. Class B (i :Type). (* Elpi Trace Browser. *) Instance i: forall X (Y: Type), (forall Y, A (X Y)) -> B (X Y) := {}. Instance a : forall x, A (g x) := {}. Instance b x : A (f x) -> A (f x) := {}. Goal B (g nat). apply _. Qed. End force_input_link_HO_var1. Module force_input_link_HO_var2. TC.Pending_mode !. Class A (i: Type). Global Hint Mode A ! : typeclass_instances. (*Mode also added in elpi*) Axiom f : Type -> Type. Axiom g : Type -> Type. Class B (i :Type). Instance i: forall X (Y: Type), A (X Y) -> B (X Y) := {}. Instance a : A (g nat) := {}. Instance b x : A (f x) -> A (f x) | 0 := {}. Goal B (g nat). apply _. Abort. End force_input_link_HO_var2. Module force_input_link_HO_var3. TC.Pending_mode !. Class A (i: Type). Global Hint Mode A ! : typeclass_instances. (*Mode also added in elpi*) Axiom g : Type -> Type. Class B (i :Type). (* TODO: This instance should not be compilable ? The premise has always a flex term while its mode is rigid head *) Instance i: forall X (Y: Type), (A X) -> B nat := {}. Instance b x : A x -> A x := {}. Goal B nat. (* TODO: this should not loop, note that we have no way to stop it in elpi since the current modes on arguments do not filter out instance b *) Fail Timeout 1 apply _. Abort. End force_input_link_HO_var3. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_scope.v000066400000000000000000000004701523041753400215560ustar00rootroot00000000000000From elpi Require Import tc. Section M. Class C (i : Type -> Type). Context (Q : Type -> Type). Goal C Q -> exists (T : Type -> Type), forall R, C R -> C (T). eexists. intros. Set Printing Existential Instances. assert (C Q) by auto. (* Elpi Trace Browser. *) apply _. Show Proof. Abort. End M.LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_shelve.v000066400000000000000000000005051523041753400217320ustar00rootroot00000000000000From elpi.apps Require Import tc. Class C. Instance T (n:nat) : C := {}. Elpi TC Solver Deactivate TC.Solver. (* THIS IS COQ *) Goal C. Fail apply _. eapply _. Show. Unshelve. Show. apply (T 2). Qed. (* THIS IS ELPI *) Goal C. Fail apply _. eapply _. Show. Unshelve. Show. apply (T 2). Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_tc.v000066400000000000000000000003131523041753400210470ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. Class a (N: nat). Instance b : a 3. Qed. Instance c : a 4. Qed. TC.AddAllClasses. TC.AddAllInstances. Goal a 4. apply _. Qed. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_tc_declare.v000066400000000000000000000033671523041753400225420ustar00rootroot00000000000000From elpi.apps Require Import tc. Elpi TC Solver Override TC.Solver All. (* Base test *) Section S1. TC.Declare Class class1 (n : nat). (* TODO: here coq can solve the goal without applying Build_class1 *) Instance inst1 : class1 3. Proof. apply Build_class1. Qed. Goal exists x, class1 x. Proof. eexists. apply _. Qed. End S1. (* Deterministic class test *) Section S2. #[deterministic] TC.Declare Class class2 (n : nat). Instance inst2 : class2 1 | 0. Proof. apply Build_class2. Qed. Instance inst2' : class2 2 | 1. Proof. apply Build_class2. Qed. Class aux (i: nat). Instance inst_aux : forall n, class2 n -> aux n -> aux 3. Qed. Section S2'. Local Instance inst_aux' : aux 1. Qed. Goal aux 3. apply _. Qed. End S2'. Section S2'. Local Instance inst_aux'' : aux 2. Qed. Goal aux 3. Proof. Succeed apply (inst_aux 2 inst2' inst_aux''). (* Note: since class2 is deterministic we cannot backtrack. The first hypothesis of inst_aux is unified to inst2, this causes `aux 2` to fail. The instance inst2' is not tried due to the deterministic class *) Fail apply _. Abort. End S2'. End S2. (* Mode test *) Section S3. #[mode(i)] TC.Declare Class class3 (n : nat). Instance inst3 : class3 0. Proof. apply Build_class3. Qed. (* Elpi Print TC.Solver "elpi.apps.tc.examples/TC.Solver". *) Goal exists x, class3 x. Proof. eexists. Succeed apply inst3. Fail apply _. Abort. End S3. Section S31. #[mode(o=ff)] TC.Declare Class class31 (n : nat). Instance inst31 : class31 0. Proof. apply Build_class31. Qed. Goal exists x, class31 x. Proof. eexists. Succeed apply inst31. Fail apply _. Abort. End S31. LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_tele_app.v000066400000000000000000000012371523041753400222400ustar00rootroot00000000000000From elpi.apps Require Import tc. (* From stdpp/telescopes.v *) (* A test where polymorphic universes are used *) Polymorphic Inductive tele : Type := | TeleO : tele | TeleS {X} (binder : X -> tele) : tele. Polymorphic Fixpoint tele_fun (TT : tele) (T : Type) : Type := match TT with | TeleO => T | TeleS b => forall x, tele_fun (b x) T end. Class FMap (X : Type -> Type). (* Since the instance is polymorphic, then the proof of the compiled elpi rule should be wrapped inside the pglobal constructor *) Polymorphic Instance tele_fmap {TT : tele} : FMap (tele_fun TT) := {}. Goal forall x, FMap (tele_fun x). intros. apply _. Show Proof. Qed.LPCIC-coq-elpi-eb449d7/apps/tc/tests/test_unfold.v000066400000000000000000000013611523041753400217340ustar00rootroot00000000000000From elpi Require Import tc. Module NAT. (* Unfold on S vs Nat.succ *) TC.Unfold Nat.succ. Class nat2 (T : nat -> nat). Elpi Accumulate TC.Solver lp:{{ % Just to print what is beeing normalized :after "firstHook" tc.normalize-ty T _ :- coq.say "Normalizing" T, fail, !. }}. (* The unfold is done in the goal *) Module NAT1. Instance i1 : nat2 S. Qed. Goal nat2 Nat.succ. apply _. Qed. End NAT1. (* The unfold is done at instance compilation *) Module NAT2. Instance i1 : nat2 Nat.succ. Qed. Goal nat2 S. apply _. Qed. End NAT2. (* The unfold is done on the instance and on the goal *) Module NAT3. Instance i1 : nat2 Nat.succ. Qed. Goal nat2 Nat.succ. apply _. Qed. End NAT3. End NAT.LPCIC-coq-elpi-eb449d7/apps/tc/tests/tlc.v000066400000000000000000000027001523041753400201660ustar00rootroot00000000000000(* Test inspired from tlc library *) From elpi Require Import tc. Module extensionability. Notation binary A := (A -> A -> Prop). Class Extensionality (T : Type). Global Instance Extensionality_pred_2 (A1 : Type) (A2 : forall (x1 : A1), Type): Extensionality (forall (x1:A1) (x2:A2 x1), Prop). Qed. Goal forall A, Extensionality (binary A). intros. apply _. Qed. End extensionability. Module SlowExecution. Set Implicit Arguments. Elpi Accumulate TC.Solver lp:{{ % :after "normalize-ty" tc.link.scope-check _ _ :- !, true. }}. Class Extensionality (A:Type) := Extensionality_make { extensionality_hyp : A -> A -> Prop; extensionality : forall (x y : A), extensionality_hyp x y -> x = y }. Section FuncExtDep. Variables (A1 : Type). Variables (A2 : forall (x1 : A1), Type). Variables (A3 : forall (x1 : A1) (x2 : A2 x1), Type). Variables (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). Variables (A5 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3), Type). Variables (A6 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3) (x5 : A5 x4), Type). Global Instance Extensionality_fun_1 : Extensionality (forall (x1:A1), A2 x1). Admitted. End FuncExtDep. Lemma eq_existT_same_eq (A : Type) (P : A -> Type) (p : A) (x y : P p): (existT P p x = existT P p y) = (x = y). Proof. Timeout 30 Fail refine (@extensionality _ _). Abort. End SlowExecution. LPCIC-coq-elpi-eb449d7/apps/tc/theories/000077500000000000000000000000001523041753400176765ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/tc/theories/add_commands.v000066400000000000000000000117551523041753400225070ustar00rootroot00000000000000(* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) From elpi.apps.tc Require Import db. From elpi.apps.tc.elpi Extra Dependency "tc_aux.elpi" as tc_aux. From elpi.apps.tc.elpi Extra Dependency "ho_precompile.elpi" as ho_precompile. From elpi.apps.tc.elpi Extra Dependency "ho_compile.elpi" as ho_compile. From elpi.apps.tc.elpi Extra Dependency "compiler1.elpi" as compiler1. From elpi.apps.tc.elpi Extra Dependency "unif.elpi" as unif. From elpi.apps.tc.elpi Extra Dependency "modes.elpi" as modes. From elpi.apps.tc.elpi Extra Dependency "ho_link.elpi" as ho_link. From elpi.apps.tc.elpi Extra Dependency "parser_addInstances.elpi" as parser_addInstances. From elpi.apps.tc.elpi Extra Dependency "solver.elpi" as solver. From elpi.apps.tc.elpi Extra Dependency "create_tc_predicate.elpi" as create_tc_predicate. (* Set Warnings "+elpi". *) Elpi Command TC.AddAllInstances. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File ho_precompile. Elpi Accumulate File unif. Elpi Accumulate File ho_link. Elpi Accumulate File ho_compile. Elpi Accumulate File compiler1. Elpi Accumulate File modes. Elpi Accumulate lp:{{ main L :- args->str-list L L1, tc.time-it _ (std.forall {coq.TC.db-tc} (x\ tc.add-tc-or-inst-gr [] L1 [x])) "TC.AddAllInstances". }}. Elpi Command TC.AddInstances. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File ho_precompile. Elpi Accumulate File ho_compile. Elpi Accumulate File unif. Elpi Accumulate File ho_link. Elpi Accumulate File compiler1. Elpi Accumulate File modes. Elpi Accumulate File parser_addInstances. Elpi Accumulate lp:{{ main Arguments :- tc.parse Arguments Res, tc.run-command Res. }}. Elpi Command TC.AddAllClasses. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File modes. Elpi Accumulate File create_tc_predicate. Elpi Accumulate lp:{{ % Ignore is the list of classes we do not want to add main IgnoreStr :- std.map IgnoreStr (x\r\ sigma S\ str S = x, coq.locate S r) IgnoreGR, tc.time-it _ (std.forall {coq.TC.db-tc} (x\ if (std.mem IgnoreGR x) true (tc.add-class-gr tc.classic x []))) "TC.AddAllClasses". }}. Elpi Command TC.AddClasses. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File modes. Elpi Accumulate File create_tc_predicate. Elpi Accumulate lp:{{ pred tc.add-all-classes i:list argument , i:tc.search-mode. tc.add-all-classes L S :- tc.time-it _ (std.forall {args->str-list L} (tc.add-class-str S)) "TC.AddClasses". main L :- std.mem {attributes} (attribute "deterministic" _), tc.add-all-classes L tc.deterministic. main L :- tc.add-all-classes L tc.classic. main _ :- coq.error "This commands accepts: [classic|deterministic]? TC-names*". }}. Elpi Command TC.AddHook. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate lp:{{ pred tc.addHook i:grafting, i:string. tc.addHook Grafting NewName :- @global! => tc.add-tc-db NewName Grafting (tc.hook NewName). main [str "before", str OldHook, str NewHook] :- tc.addHook (before OldHook) NewHook. main [str "after", str OldHook, str NewHook] :- tc.addHook (after OldHook) NewHook. main [Graft, int OldHook, NewHook] :- main [Graft, str {calc (int_to_string OldHook)}, NewHook]. main [Graft, OldHook, int NewHook] :- main [Graft, OldHook, str {calc (int_to_string NewHook)}]. main _ :- coq.error "Invalid call to command AddHook. A valid call looks like" "[ElpiAddHook Pos OldName NewName] where:" " - Pos is either after or before" " - OldName is the name of an existing hook" " - NewName is the name of the new hook". }}. Elpi Command TC.Declare. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File modes. Elpi Accumulate File create_tc_predicate. Elpi Accumulate lp:{{ main _ :- coq.warning "TC.Declare" {tc.warning-name} "This command does not fully mirror the watned behavior if the class has methods with implicit arguments (those implicits will be neglected)", fail. main [indt-decl D] :- !, tc.declare-class D. main _ :- coq.error "Argument should be an inductive type". }}. Elpi Command TC.Pending_mode. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File modes. Elpi Accumulate File create_tc_predicate. Elpi Accumulate lp:{{ main M :- % the "o" added at the end of M stands for the solution of the goal std.append M [str "o"] M1, tc.add-pending-mode {args->str-list M1}. }}. Elpi Export TC.AddAllClasses. Elpi Export TC.AddAllInstances. Elpi Export TC.AddClasses. Elpi Export TC.AddInstances. Elpi Export TC.AddHook. Elpi Export TC.Declare. Elpi Export TC.Pending_mode.LPCIC-coq-elpi-eb449d7/apps/tc/theories/db.v000066400000000000000000000072561523041753400204640ustar00rootroot00000000000000(* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) From elpi Require Import elpi. (* tc_option.db contains the set of options used by the solver of tc. all the options are set to false by default *) Elpi Db tc_options.db lp:{{ namespace tc { func oTC-eta-reduce-proof -> list string. oTC-eta-reduce-proof ["TC", "Eta", "Reduce", "Proof"]. % Time taken by only instance search (we time tc-recursive-search) func oTC-time-instance-search -> list string. oTC-time-instance-search ["TC", "Time", "Instance", "Search"]. func oTC-time-compile-goal -> list string. oTC-time-compile-goal ["TC", "Time", "Compile", "Query"]. func oTC-time-mode-check -> list string. oTC-time-mode-check ["TC", "Time", "Mode", "Check"]. % Time taken by the whole search in tc func oTC-time-msolve -> list string. oTC-time-msolve ["TC", "Time"]. % Time taken to refine the solution func oTC-time-refine -> list string. oTC-time-refine ["TC", "Time", "Refine"]. func oTC-time-compile-instance -> list string. oTC-time-compile-instance ["TC", "Time", "Compile", "Instance"]. func oTC-time-compile-class -> list string. oTC-time-compile-class ["TC", "Time", "Compile", "Class"]. func oTC-clauseNameShortName -> list string. oTC-clauseNameShortName ["TC", "NameShortPath"]. func oTC-debug -> list string. oTC-debug ["TC", "Debug"]. func oTC-use-pattern-fragment-compiler -> list string. oTC-use-pattern-fragment-compiler ["TC", "CompilerWithPatternFragment"]. func all-options -> list (func -> (list string)). all-options [ oTC-eta-reduce-proof, oTC-time-refine, oTC-time-msolve, oTC-clauseNameShortName, oTC-time-instance-search, oTC-debug, oTC-use-pattern-fragment-compiler, oTC-time-compile-goal, oTC-time-mode-check, oTC-time-compile-instance, oTC-time-compile-class ]. func is-option-active (func (list string) ->) ->. is-option-active uvar :- !, fail. is-option-active Opt :- Opt X, coq.option.get X (coq.option.bool tt). func warning-name -> string. warning-name "[TC] Warning". } }}. Elpi Db tc.db lp:{{ namespace tc { % the type of search for a typeclass % deterministic :- no backtrack after having found a solution/fail % classic :- the classic search, if a path is failing, we backtrack kind search-mode type. type deterministic search-mode. type classic search-mode. % [instance Path InstGR ClassGR Locality], ClassGR is the class implemented by InstGR % Locality is either the empty list, or [@local!], or [@global!] pred instance o:list string, o:gref, o:gref, o:list prop. % [class ClassGR PredName SearchMode Modes], for each class GR, it contains % the name of its predicate and its SearchMode :index (5) pred class o:gref, o:string, o:search-mode, o:list string. % pred on which we graft instances in the database pred hook o:string. :name "firstHook" hook "firstHook". :name "lastHook" hook "lastHook". % [unfold-constant C] constants to be unfolded before goal resolution pred unfold-constant o:constant. % the set of instances that we are not yet able to compile, % in majority they use universe polimorphism pred banned o:gref. pred pending-mode o:list string. pred ho-link o:term, i:term, o:A. func link.eta term, term ->. func link.llam term, term ->. func link.unif-eq term, term ->. } }}. From elpi.apps.tc.elpi Extra Dependency "base.elpi" as base. #[superglobal] Elpi Accumulate tc.db File base. LPCIC-coq-elpi-eb449d7/apps/tc/theories/dune000066400000000000000000000002511523041753400205520ustar00rootroot00000000000000(coq.theory (name elpi.apps.tc) (package rocq-elpi) (theories elpi elpi.apps.tc.elpi) (flags -w -all -w -elpi) (plugins rocq-elpi.tc)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/tc/theories/tc.v000066400000000000000000000156001523041753400204750ustar00rootroot00000000000000(* license: GNU Lesser General Public License Version 2.1 or later *) (* ------------------------------------------------------------------------- *) Declare ML Module "rocq-elpi.tc". From elpi.apps.tc.elpi Extra Dependency "tc_aux.elpi" as tc_aux. (* From elpi.apps.tc.elpi Extra Dependency "compiler.elpi" as compiler. *) From elpi.apps.tc.elpi Extra Dependency "ho_precompile.elpi" as ho_precompile. From elpi.apps.tc.elpi Extra Dependency "ho_compile.elpi" as ho_compile. From elpi.apps.tc.elpi Extra Dependency "compiler1.elpi" as compiler1. From elpi.apps.tc.elpi Extra Dependency "modes.elpi" as modes. From elpi.apps.tc.elpi Extra Dependency "unif.elpi" as unif. From elpi.apps.tc.elpi Extra Dependency "ho_link.elpi" as ho_link. From elpi.apps.tc.elpi Extra Dependency "solver.elpi" as solver. From elpi.apps.tc.elpi Extra Dependency "create_tc_predicate.elpi" as create_tc_predicate. From elpi.apps Require Import db. From elpi.apps Require Export add_commands. (* Set Warnings "+elpi". *) Elpi Command TC.Print_instances. Elpi Accumulate Db tc.db. Elpi Accumulate lp:{{ func tc.list-printer-aux prop ->. tc.list-printer-aux (tc.instance _ InstGR _ Locality) :- coq.say InstGR "with locality" Locality. func tc.list-printer gref, list prop ->. tc.list-printer _ [] :- !. tc.list-printer ClassGR Instances :- coq.say "Instances list for" ClassGR "is:", std.forall Instances tc.list-printer-aux. main [str Class] :- std.assert! (coq.locate Class ClassGR) "The entered TC not exists", std.findall (tc.instance _ _ ClassGR _) Rules, tc.list-printer ClassGR Rules. main [] :- std.forall {coq.TC.db-tc} (ClassGR\ sigma Rules\ std.findall (tc.instance _ _ ClassGR _) Rules, tc.list-printer ClassGR Rules ). }}. Elpi Tactic TC.Solver. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File unif. Elpi Accumulate File ho_link. (* Elpi Accumulate File compiler. *) Elpi Accumulate File ho_precompile. Elpi Accumulate File ho_compile. Elpi Accumulate File compiler1. Elpi Accumulate File modes. Elpi Accumulate File create_tc_predicate. Elpi Accumulate File solver. Elpi Query lp:{{ sigma Options\ tc.all-options Options, std.forall Options (x\ sigma L\ x L, if (coq.option.available? L _) true (coq.option.add L (coq.option.bool ff) ff)). }}. Elpi Query lp:{{ sigma Nums\ std.iota 1001 Nums, std.forall Nums (x\ sigma NumStr\ NumStr is int_to_string x, @global! => tc.add-tc-db NumStr (before "lastHook") (tc.hook NumStr) ) }}. Elpi Command TC.Compiler. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate File modes. Elpi Accumulate File create_tc_predicate. Elpi Accumulate File ho_precompile. Elpi Accumulate File ho_compile. Elpi Accumulate File unif. Elpi Accumulate File ho_link. Elpi Accumulate File compiler1. Elpi Accumulate lp:{{ /* Projections of a class that are coercions, are wrongly compiled: In the following code: ```coq Class Animal. Class Bird := IsAnimal :> Animal. ``` The instance IsAnimal of type Bird -> Animal, is compiled before the predicate for Bird; hence, Bird is not recognize as a premise of IsAnimal. This problem is due to the order in which the registers for Instance and Class creation are run. The solution is to do the following two jobs when a class C is created: 1: for every projection P of C, if P is a coercion, the wrongly compiled instance is replaced with a `dummy` clause. 2: the predicate for the class is created 3: for every projection P of C, if P is a coercion, the correct instance is created and added to the db */ shorten tc.class-coercion.{add, remove, loop-proj}. main [str "remove_coercions" | Proj] :- !, loop-proj remove Proj. main [str "add_coercions" | Proj] :- !, loop-proj add Proj. main [str "new_instance", str Inst, str Cl, str Locality, int Prio] :- !, tc.time-it _ (coq.locate Cl GRCl, coq.locate Inst GRInst, tc.add-inst GRInst GRCl Locality Prio) "Compiler for Instance". main [str "new_class", str Cl, str Modes] :- !, tc.time-it tc.oTC-time-compile-class ( coq.locate Cl GR, tc.add-class-gr tc.classic GR {rex.split " " Modes} ) "Compiler for Class". % used to build ad-hoc instance for eta-reduction on the argument of % Cl that have function type main [str "default_instance", str Cl] :- !, tc.eta-reduction-aux.main Cl. main A :- coq.error "Fail in TC.Compiler: not a valid input entry" A. }}. (* Command allowing to set if a TC is deterministic. *) Elpi Command TC.Set_deterministic. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate lp:{{ main [str ClassStr] :- coq.locate ClassStr ClassGR, std.assert! (coq.TC.class? ClassGR) "Should pass the name of a type class", std.assert! (tc.class ClassGR PredName _ Modes) "Cannot find `class ClassGR _ _` in the db", std.assert! (not (tc.instance _ _ ClassGR _)) "Cannot set deterministic a class with an already existing instance", tc.add-tc-db _ (after "0") (tc.class ClassGR PredName tc.deterministic Modes :- !). }}. Elpi Command TC.Get_class_info. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File tc_aux. Elpi Accumulate lp:{{ main [str ClassStr] :- coq.locate ClassStr ClassGR, tc.class ClassGR PredName SearchMode Modes, coq.say "[TC] For " ClassGR ":", coq.say " elpi predicate :" PredName, coq.say " search mode is :" SearchMode, coq.say " modes are :" Modes. main [str C] :- coq.error "[TC]" C "is not found in elpi db". main [A] :- std.assert! (str _ = A) "first argument should be a str". main [_|_] :- coq.error "[TC] Get_class_info accepts only one argument of type str". main [] :- coq.error "[TC] Get_class_info accepts only one argument of type str". main L :- coq.error "[TC] Uncaught error on input" L. }}. Elpi Command TC.Unfold. Elpi Accumulate Db tc_options.db. Elpi Accumulate Db tc.db. Elpi Accumulate File tc_aux. Elpi Accumulate lp:{{ func tc.add-unfold gref ->. tc.add-unfold (const C) :- !, if (tc.unfold-constant C) true (tc.add-tc-db _ _ (tc.unfold-constant C)). tc.add-unfold GR :- coq.error "[TC]" GR "is not a constant". main L :- ErrMsg = "[TC] TC.Unfold accepts a list of string is accepted", std.map L (x\r\ sigma R\ std.assert! (str R = x) ErrMsg, coq.locate R r) L', std.forall L' tc.add-unfold. }}. Elpi TC Solver Register TC.Solver. Elpi TC Solver Activate TC.Solver. Elpi TC Solver Override TC.Solver All. Elpi Register TC Compiler TC.Compiler. Elpi Export TC.Print_instances. Elpi Export TC.Solver. Elpi Export TC.Compiler. Elpi Export TC.Get_class_info. Elpi Export TC.Set_deterministic. Elpi Export TC.Unfold. Set Warnings "elpi". Elpi TC.AddAllClasses. Elpi TC.AddAllInstances. LPCIC-coq-elpi-eb449d7/apps/tc/theories/wip.v000066400000000000000000000040441523041753400206660ustar00rootroot00000000000000(* license: GNU Lesser General Public License Version 2.1 or later *) (* --------------------------------------------------------------------------*) Declare ML Module "rocq-elpi.tc". From elpi Require Import elpi. From elpi.apps.tc.elpi Extra Dependency "modes.elpi" as modes. From elpi.apps.tc.elpi Extra Dependency "ho_precompile.elpi" as ho_precompile. From elpi.apps.tc.elpi Extra Dependency "ho_compile.elpi" as ho_compile. From elpi.apps.tc.elpi Extra Dependency "compiler1.elpi" as compiler1. From elpi.apps.tc.elpi Extra Dependency "ho_link.elpi" as ho_link. From elpi.apps.tc.elpi Extra Dependency "parser_addInstances.elpi" as parser_addInstances. From elpi.apps.tc.elpi Extra Dependency "alias.elpi" as alias. From elpi.apps.tc.elpi Extra Dependency "solver.elpi" as solver. From elpi.apps.tc.elpi Extra Dependency "rewrite_forward.elpi" as rforward. From elpi.apps.tc.elpi Extra Dependency "tc_aux.elpi" as tc_aux. From elpi.apps.tc.elpi Extra Dependency "create_tc_predicate.elpi" as create_tc_predicate. (* From elpi.apps Require Import tc. Set Warnings "+elpi". Elpi Command AddForwardRewriting. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File base. Elpi Accumulate File tc_aux. Elpi Accumulate File ho_link. Elpi Accumulate File modes. Elpi Accumulate File ho_precompile. Elpi Accumulate File compiler1. Elpi Accumulate File ho_compile. Elpi Accumulate File create_tc_predicate. Elpi Accumulate File solver. Elpi Accumulate File rforward. Elpi Accumulate lp:{{ :before "tc-compile-context" tc.compile.context Ctx Clauses :- !, std.append Ctx {section-var->decl} CtxAndSection, tc.compile.instance.context {rewrite-dep CtxAndSection} Clauses. main L :- std.forall {args->str-list L} add-lemma->forward. }}. Elpi Command AddAlias. Elpi Accumulate Db tc.db. Elpi Accumulate Db tc_options.db. Elpi Accumulate File base. Elpi Accumulate File tc_aux. Elpi Accumulate File ho_link. Elpi Accumulate File alias. Elpi Accumulate lp:{{ main [trm New, trm Old] :- add-tc-db _ _ (alias New Old). }}. *) LPCIC-coq-elpi-eb449d7/apps/xml/000077500000000000000000000000001523041753400162465ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/xml/README.md000066400000000000000000000016671523041753400175370ustar00rootroot00000000000000Binding to xml-light ==================== This Rocq-Elpi plugin gives access to xml files. ```bash opam install rocq-elpi-xml # pulls in xml-light ``` Then you can access the APIs in [doc/xml.elpi](doc/xml.elpi) this way: ```coq From elpi Require Import elpi xml. From elpi.xml.tests Extra Dependency "test.xml" as xml_test_file. Elpi Command hello_xml. Elpi Accumulate Plugin "xml.elpi". Elpi Accumulate lp:{{ main [str D] :- std.assert-ok! (coq.extra-dep->xml D X) "bad file", coq.say "xml AST:" X, coq.xml->string X S, coq.say "pretty:" S, coq.string->xml S X', coq.say "xml AST:" X', std.assert! (X = X') "this would be bad". }}. Elpi Export hello_xml. hello_xml "xml_test_file". ``` Note: At the time of writing `rocq_makefile` fully supports this directive and considers `` as a dependency of the `.v` file. Dune does not yet support this. For a workaround see the [tests/](tests-plugin/) directory. LPCIC-coq-elpi-eb449d7/apps/xml/doc/000077500000000000000000000000001523041753400170135ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/xml/doc/dune000066400000000000000000000003411523041753400176670ustar00rootroot00000000000000(executable (name gen_doc) (libraries elpi_xml_plugin)) (rule (targets xml.elpi) (deps gen_doc.exe) (mode promote) (action (run ./gen_doc.exe))) (install (files xml.elpi) (section doc) (package rocq-elpi-xml)) LPCIC-coq-elpi-eb449d7/apps/xml/doc/gen_doc.ml000066400000000000000000000001561523041753400207450ustar00rootroot00000000000000 let _ = Elpi.API.BuiltIn.document_file ~header:"% Generated" Elpi_xml_plugin.Rocq_elpi_xml_plugin.builtins LPCIC-coq-elpi-eb449d7/apps/xml/doc/xml.elpi000066400000000000000000000034101523041753400204640ustar00rootroot00000000000000 % Xml-light bindings for Elpi % license: GNU Lesser General Public License Version 2.1 or later % ------------------------------------------------------------------------ % This code is not Rocq specific, i.e. could go to an Elpi specific % package. % Xml.xml kind xml type. external symbol xml.element : string -> list (pair string string) -> list xml -> xml = "1". % Attributes are sorted by key external symbol xml.pcdata : string -> xml = "1". % [xml.parse_file File XML D] like Xml.parse_file reads XML from File. % If D is error then XML is not assigned. external func xml.parse_file string -> xml, diagnostic. % [xml.parse_string String XML D] like Xml.parse_string reads XML from % String. % If D is error then XML is not assigned. external func xml.parse_string string -> xml, diagnostic. % [xml.to_string XML S D] like Xml.to_string write XML to a compact string % S. external func xml.to_string xml -> string, diagnostic. % [xml.to_string_fmt XML S D] like Xml.to_string_fmt write XML to a nice % string S. external func xml.to_string_fmt xml -> string, diagnostic. % ------------------------------------------------------------------------ % Rocq-Elpi APIs % ------------------------------------------------------------------------ func coq.xml->string xml -> string. coq.xml->string XML S :- xml.to_string_fmt XML S ok. func coq.string->xml string -> xml. coq.string->xml S XML :- xml.parse_string S XML ok. % [coq.extra-dep->xml Dep XML D] reads a xml file declared as an extra % dependency, see the coq.extra-dep API. func coq.extra-dep->xml string -> xml, diagnostic. coq.extra-dep->xml S XML D :- coq.extra-dep S (some P), !, xml.parse_file P XML D. coq.extra-dep->xml S _ (error Msg) :- Msg is "unknown Extra Dependency " ^ S. LPCIC-coq-elpi-eb449d7/apps/xml/examples/000077500000000000000000000000001523041753400200645ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/xml/examples/dune000066400000000000000000000001551523041753400207430ustar00rootroot00000000000000(coq.theory (name elpi.xml.examples) (theories elpi elpi.xml elpi.xml.tests)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/xml/examples/usage_xml.v000066400000000000000000000007501523041753400222410ustar00rootroot00000000000000From elpi Require Import elpi xml. From elpi.xml.tests Extra Dependency "test.xml" as xml_test_file. Elpi Command hello_xml. Elpi Accumulate Plugin "xml.elpi". Elpi Accumulate lp:{{ main [str D] :- std.assert-ok! (coq.extra-dep->xml D J) "bad file", coq.say "xml AST:" J, coq.xml->string J S, coq.say "pretty:" S, coq.string->xml S J', coq.say "xml AST:" J', std.assert! (J = J') "this would be bad". }}. Elpi Export hello_xml. hello_xml "xml_test_file". LPCIC-coq-elpi-eb449d7/apps/xml/src/000077500000000000000000000000001523041753400170355ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/xml/src/dune000066400000000000000000000005001523041753400177060ustar00rootroot00000000000000(library (name elpi_xml_plugin) (public_name rocq-elpi-xml.elpi_xml_plugin) (flags :standard -w -27) (preprocess (pps ppx_optcomp -- -cookie "ppx_optcomp.env=env ~coq:(Defined \"%{coq:version.major}.%{coq:version.minor}\")")) (libraries rocq-runtime.plugins.ltac rocq-runtime.vernac rocq-elpi.elpi elpi xml-light)) LPCIC-coq-elpi-eb449d7/apps/xml/src/elpi_xml_plugin.mlpack000066400000000000000000000000251523041753400234120ustar00rootroot00000000000000Rocq_elpi_xml_plugin LPCIC-coq-elpi-eb449d7/apps/xml/src/rocq_elpi_xml_plugin.ml000066400000000000000000000076141523041753400236120ustar00rootroot00000000000000open Elpi.API (* todo, move this in Elpi, there are already two copies of this code in rocq-elpi *) let listC (d : ('a,'h,'cst) ContextualConversion.t) = let embed ~depth h cst s l = let s, l, eg = Utils.map_acc (d.ContextualConversion.embed ~depth h cst ) s l in s, Utils.list_to_lp_list l, eg in let readback ~depth h cst s t = Utils.map_acc (d.ContextualConversion.readback ~depth h cst) s (Utils.lp_list_to_list ~depth t) in let pp fmt l = Format.fprintf fmt "[%a]" (RawPp.list d.ContextualConversion.pp ~boxed:true "; ") l in { ContextualConversion.embed; readback; ty = TyApp ("list",d.ContextualConversion.ty,[]); pp; pp_doc = (fun fmt () -> ()) } open BuiltInData open Elpi.Builtin let xml : Xml.xml Conversion.t = AlgebraicData.(declare { ty = Conversion.TyName "xml"; doc = "Xml.xml"; pp = (fun fmt x -> Format.fprintf fmt "%s" (Xml.to_string_fmt x)); constructors = [ K("xml.element","Attributes are sorted by key",A(string,A(list (pair string string),C(listC,N))), B (fun tag attrs bo -> Element(tag,attrs,bo)), M (fun ~ok ~ko -> function Element(t,a,b) -> let a = List.stable_sort (fun (x,_) (y,_) -> String.compare x y) a in ok t a b | _ -> ko ())); K("xml.pcdata","",A(string,N),B (fun x -> PCData x),M (fun ~ok ~ko -> function Xml.PCData s -> ok s | _ -> ko ())); ]; } ) |> ContextualConversion.(!<) open BuiltIn open BuiltInPredicate open BuiltInPredicate.Notation let xml_parse_file = MLCode(Pred("xml.parse_file", In(string,"File", Out(xml,"XML", Out(diagnostic,"D", Easy {|like Xml.parse_file reads XML from File. If D is error then XML is not assigned.|}))), (fun f _ _ ~depth -> try !: (Xml.parse_file f) +! mkOK with | Xml.Error e -> ?: None +! (mkERROR (Xml.error e)) | Xml.File_not_found s | Xml_light_errors.File_not_found s -> ?: None +! (mkERROR s) )),DocAbove) let xml_parse_string = MLCode(Pred("xml.parse_string", In(string,"String", Out(xml,"XML", Out(diagnostic,"D", Easy {|like Xml.parse_string reads XML from String. If D is error then XML is not assigned.|}))), (fun f _ _ ~depth -> try !: (Xml.parse_string f) +! mkOK with Xml.Error e | Xml_light_errors.Xml_error e -> ?: None +! (mkERROR (Xml.error e)) )),DocAbove) let xml_to_string = MLCode(Pred("xml.to_string", In(xml,"XML", Out(string,"S", Out(diagnostic,"D", Easy {|like Xml.to_string write XML to a compact string S.|}))), (fun j _ _ ~depth -> !: (Xml.to_string j) +! mkOK )),DocAbove) let xml_to_string_fmt = MLCode(Pred("xml.to_string_fmt", In(xml,"XML", Out(string,"S", Out(diagnostic,"D", Easy {|like Xml.to_string_fmt write XML to a nice string S.|}))), (fun j _ _ ~depth -> !: (Xml.to_string_fmt j) +! mkOK )),DocAbove) let builtins = declare ~file_name:"xml.elpi" [ LPDoc {|Xml-light bindings for Elpi|}; LPDoc {|license: GNU Lesser General Public License Version 2.1 or later|}; LPDoc {|------------------------------------------------------------------------|}; LPDoc {|This code is not Rocq specific, i.e. could go to an Elpi specific package.|}; MLData xml; xml_parse_file; xml_parse_string; xml_to_string; xml_to_string_fmt; LPDoc {|------------------------------------------------------------------------|}; LPDoc {|Rocq-Elpi APIs|}; LPDoc {|------------------------------------------------------------------------|}; LPCode {| func coq.xml->string xml -> string. coq.xml->string XML S :- xml.to_string_fmt XML S ok. func coq.string->xml string -> xml. coq.string->xml S XML :- xml.parse_string S XML ok. % [coq.extra-dep->xml Dep XML D] reads a xml file declared as an extra % dependency, see the coq.extra-dep API. func coq.extra-dep->xml string -> xml, diagnostic. coq.extra-dep->xml S XML D :- coq.extra-dep S (some P), !, xml.parse_file P XML D. coq.extra-dep->xml S _ (error Msg) :- Msg is "unknown Extra Dependency " ^ S. |} ] LPCIC-coq-elpi-eb449d7/apps/xml/tests-plugin/000077500000000000000000000000001523041753400207045ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/xml/tests-plugin/dune000066400000000000000000000005521523041753400215640ustar00rootroot00000000000000(coq.theory (name elpi.xml.tests) (package rocq-elpi-xml-tests) (theories elpi elpi.xml)) ; work around missing dune support for Extra Dependency ; https://github.com/ocaml/dune/pull/9591 (rule (target dummy.v) (deps (glob_files *.xml)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (include_subdirs qualified)LPCIC-coq-elpi-eb449d7/apps/xml/tests-plugin/test.v000066400000000000000000000011511523041753400220500ustar00rootroot00000000000000 From elpi Require Import elpi xml. From elpi Require xml.tests.dummy. (* work around missing dune support for Extra Dependency *) Elpi Command test. Elpi Accumulate Plugin "xml.elpi". Fail Elpi Query lp:{{ std.assert-ok! (xml.parse_file "foo.xml" X) "xml" }}. From elpi.xml.tests Extra Dependency "test.xml" as xml_test_file. Elpi Query lp:{{ coq.extra-dep "xml_test_file" (some Path), std.assert-ok! (xml.parse_file Path X) "xml", coq.say X, std.assert! ( X = xml.element "message" [] [A]) "xml", std.assert! ( A = xml.element "warning" [pr "level" "2", pr "zlevel" "2"] [xml.pcdata _]) "xml" }}. LPCIC-coq-elpi-eb449d7/apps/xml/tests-plugin/test.xml000066400000000000000000000002021523041753400223770ustar00rootroot00000000000000 Hello World LPCIC-coq-elpi-eb449d7/apps/xml/theories/000077500000000000000000000000001523041753400200705ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/apps/xml/theories/dune000066400000000000000000000002301523041753400207410ustar00rootroot00000000000000(coq.theory (name elpi.xml) (theories elpi_elpi elpi) (plugins rocq-elpi-xml.elpi_xml_plugin) (package rocq-elpi-xml)) (include_subdirs qualified) LPCIC-coq-elpi-eb449d7/apps/xml/theories/xml.v000066400000000000000000000001231523041753400210530ustar00rootroot00000000000000Declare ML Module "rocq-elpi-xml.elpi_xml_plugin". From elpi Require Import elpi. LPCIC-coq-elpi-eb449d7/builtin-doc/000077500000000000000000000000001523041753400167145ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/builtin-doc/coq-builtin-synterp.elpi000066400000000000000000000427001523041753400235220ustar00rootroot00000000000000 kind implicit_kind type. kind field-attribute type. kind upoly-decl type. kind upoly-decl-cumul type. % -- Misc --------------------------------------------------------- % [coq.info ...] Prints an info message external type coq.info variadic any (func). % [coq.notice ...] Prints a notice message external type coq.notice variadic any (func). % [coq.say ...] Prints a notice message external type coq.say variadic any (func). % [coq.debug ...] Prints a debug message external type coq.debug variadic any (func). % [coq.warn ...] Prints a generic warning message external type coq.warn variadic any (func). % [coq.warning Category Name ...] % Prints a warning message with a Name and Category which can be used % to silence this warning or turn it into an error. See coqc -w command % line option external type coq.warning string -> string -> variadic any (func). % [coq.error ...] Prints and *aborts* the program. It is a fatal error for % Elpi and Ltac external type coq.error variadic any (func). % [coq.version VersionString Major Minor Patch] Fetches the version of Coq, % as a string and as 3 numbers external func coq.version -> string, int, int, int. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-arg-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular the entry points for commands % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry points % % Command and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry point for commands. Eg. "#[att=true] Elpi mycommand foo 3 (f x)." becomes % main [str "foo", int 3, trm (app[f,x])] % in a context where % attributes [attribute "att" (leaf "true")] % holds. The encoding of terms is described below. % See also the coq.parse-attributes utility. external pred main i:list argument. % Commands with a non-trivial parsing phase can thread data between % from the parsing phase to the interp one in an untyped way using the % following two entrypoints external pred main-interp i:list argument, i:any. external pred main-synterp i:list argument, o:any. % Commands starting/closing proofs have to use the following entrypoints. % The minimal working snippet is: % % main-interp-proof [trm P] _ P GL _ :- % coq.typecheck P _ ok, coq.ltac.collect-goals P GL _. % main-interp-qed _ _ P _GL _ :- % coq.env.add-const "it" P _ _ _. % % Where GL are the goals to prove, and _GL (unused here) are the same goals % with their current proof. The term P can be used as the root proof term, % where GL are missing pieces. One is not obliged to use P as is, i.e. he % can inspect _GL and declare each proof independenlty, or combine these proofs % as he likes and ignore P completely. When a main-interp-qed is used to end % a proof stated by a standard Rocq Lemma/Definition statement, the data from % the proof opening command is the lemma name, _GL is the empty list and P the % proof term. external pred main-interp-proof i:list argument, % arguments passed to the command i:any, % data from the parsing phase (defaults to _) o:term, % proof data for the corresponding proof-closing command o:list sealed-goal, % the sequents to prove o:any. % any data for the corresponding proof-closing command external pred main-interp-qed i:list argument, % arguments passed to the command i:any, % data from the parsing phase (defaults to _) i:term, % proof data from the corresponding proof-opening command i:list sealed-goal, % the sequents from the corresponding proof-opening command, but with proofs i:any. % any data from the corresponding proof-opening command pred usage. external func attributes -> list attribute. % see coq-lib.elpi for coq.parse-attributes generating the options below external pred get-option o:string, o:A. % The data type of arguments (for commands or tactics) kind argument type. external symbol int : int -> argument. % Eg. 1 -2. external symbol str : string -> argument. % Eg. x "y" z.w. or any Coq keyword/symbol external symbol trm : term -> argument. % Eg. (t). external symbol open-trm : int -> term -> argument. % Extra arguments for commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record or Inductive external symbol indt-decl : indt-decl -> argument. % Eg. #[universes(polymorphic,...)] Record or Inductive external symbol upoly-indt-decl : indt-decl -> upoly-decl -> argument. % Eg. Definition or Axiom (when the body is none) external symbol const-decl : id -> option term -> arity -> argument. % Eg. #[universes(polymorphic,...)] Definition or Axiom external symbol upoly-const-decl : id -> option term -> arity -> upoly-decl -> argument. % Eg. Context A (b : A). external symbol ctx-decl : context-decl -> argument. % Declaration of inductive types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% kind indt-decl type. kind indc-decl type. kind record-decl type. % An arity is written, in Coq syntax, as: % (x : T1) .. (xn : Tn) : S1 -> ... -> Sn -> U % This syntax is used, for example, in the type of an inductive type or % in the type of constructors. We call the abstractions on the left of ":" % "parameters" while we call the type following the ":" (proper) arity. % Note: in some contexts, like the type of an inductive type constructor, % Coq makes no distinction between these two writings % (xn : Tn) : forall y1 : S1, ... and (xn : Tn) (y1 : S1) : ... % while Elpi is a bit more restrictive, since it understands user directives % such as the implicit status of an arguments (eg, using {} instead of () around % the binder), only on parameters. % Moreover parameters carry the name given by the user as an "id", while binders % in terms only carry it as a "name", an irrelevant pretty pringintg hint (see % also the HOAS of terms). A user command can hence only use the names of % parameters, and not the names of "forall" quantified variables in the arity. % % See also the arity->term predicate in coq-lib.elpi kind arity type. external symbol parameter : id -> implicit_kind -> term -> (term -> arity) -> arity = "1". external symbol arity : term -> arity. external symbol parameter : id -> implicit_kind -> term -> (term -> indt-decl) -> indt-decl = "2". external symbol inductive : id -> bool -> arity -> (term -> list indc-decl) -> indt-decl. % tt means inductive, ff coinductive external symbol minductive : id -> bool -> arity -> (term -> indt-decl) -> indt-decl. % one type of a mutual block external symbol mblock : list (list indc-decl) -> indt-decl. % constructor blocks for minductive declarations external symbol record : id -> term -> id -> record-decl -> indt-decl. external symbol constructor : id -> arity -> indc-decl. external symbol field : field-attributes -> id -> term -> (term -> record-decl) -> record-decl. external symbol end-record : record-decl. % Example. % Remark that A is a regular parameter; y is a non-uniform parameter and t % also features an index of type bool. % % Inductive t (A : Type) | (y : nat) : bool -> Type := % | K1 (x : A) {n : nat} : S n = y -> t A n true -> t A y true % | K2 : t A y false % % is written % % (parameter "A" explicit {{ Type }} a\ % inductive "t" tt (parameter "y" explicit {{ nat }} _\ % arity {{ bool -> Type }}) % t\ % [ constructor "K1" % (parameter "y" explicit {{ nat }} y\ % (parameter "x" explicit a x\ % (parameter "n" maximal {{ nat }} n\ % arity {{ S lp:n = lp:y -> lp:t lp:n true -> lp:t lp:y true }}))) % , constructor "K2" % (parameter "y" explicit {{ nat }} y\ % arity {{ lp:t lp:y false }}) ]) % % Remark that the uniform parameters are not passed to occurrences of t, since % they never change, while non-uniform parameters are both abstracted % in each constructor type and passed as arguments to t. % % The coq.typecheck-indt-decl API can be used to fill in implicit arguments % an infer universe constraints in the declaration above (e.g. the hidden % argument of "=" in the arity of K1). % % Note: when and inductive type declaration is passed as an argument to an % Elpi command non uniform parameters must be separated from the uniform ones % with a | (a syntax introduced in Coq 8.12 and accepted by rocq-elpi since % version 1.4, in Coq this separator is optional, but not in Elpi). % Context declaration (used as an argument to Elpi commands) kind context-decl type. % Eg. (x : T) or (x := B), body is optional, type may be a variable external symbol context-item : id -> implicit_kind -> term -> option term -> (term -> context-decl) -> context-decl. external symbol context-end : context-decl. typeabbrev field-attributes (list field-attribute). macro @global! :- get-option "coq:locality" "global". macro @local! :- get-option "coq:locality" "local". % Coq terms are not visible at synterp time, they are always holes kind term type. kind sealed-goal type. kind gref type. kind abbreviation type. % -- Parsing time APIs % ---------------------------------------------------- % [id] is a name that matters, we piggy back on Elpi's strings. % Note: [name] is a name that does not matter. typeabbrev id string. % Name of a module /*E*/ kind modpath type. % Name of a module type /*E*/ kind modtypath type. % [coq.locate-module ModName ModPath] locates a module. It's a fatal error % if ModName cannot be located. *E* external func coq.locate-module id -> modpath. % [coq.locate-module-type ModName ModPath] locates a module. It's a fatal % error if ModName cannot be located. *E* external func coq.locate-module-type id -> modtypath. % Result of coq.locate-all kind located type. external symbol loc-gref : gref -> located = "1". external symbol loc-modpath : modpath -> located = "1". external symbol loc-modtypath : modtypath -> located = "1". external symbol loc-abbreviation : abbreviation -> located = "1". % [coq.locate-all Name Located] finds all possible meanings of a string. % Does not fail. external func coq.locate-all id -> list located. % Coq Module inline directive kind coq.inline type. external symbol coq.inline.no : coq.inline = "1". % Coq's [no inline] (aka !) external symbol coq.inline.default : coq.inline = "1". % The default, can be omitted external symbol coq.inline.at : int -> coq.inline = "1". % Coq's [inline at ] external func coq.env.begin-module-functor % Starts a functor *E* id, % The name of the functor option modtypath, % Its module type list (pair id modtypath). % Parameters of the functor func coq.env.begin-module id, option modtypath -> . coq.env.begin-module Name MP :- coq.env.begin-module-functor Name MP []. % [coq.env.end-module ModPath] end the current module that becomes known as % ModPath *E* external func coq.env.end-module -> modpath. external func coq.env.begin-module-type-functor % Starts a module type functor *E* id, % The name of the functor list (pair id modtypath). % The parameters of the functor func coq.env.begin-module-type id ->. coq.env.begin-module-type Name :- coq.env.begin-module-type-functor Name []. % [coq.env.end-module-type ModTyPath] end the current module type that % becomes known as ModPath *E* external func coq.env.end-module-type -> modtypath. external func coq.env.apply-module-functor % Applies a functor *E* id, % The name of the new module option modtypath, % Its module type modpath, % The functor being applied list modpath, % Its arguments coq.inline % Arguments inlining -> modpath. % The modpath of the new module external func coq.env.apply-module-type-functor % Applies a type functor *E* id, % The name of the new module type modtypath, % The functor list modpath, % Its arguments coq.inline % Arguments inlining -> modtypath. % The modtypath of the new module type % [coq.env.include-module ModPath Inline] is like the vernacular Include, % Inline can be omitted *E* external func coq.env.include-module modpath, coq.inline. % [coq.env.include-module-type ModTyPath Inline] is like the vernacular % Include Type, Inline can be omitted *E* external func coq.env.include-module-type modtypath, coq.inline. % [coq.env.import-module ModPath] is like the vernacular Import *E* external func coq.env.import-module modpath. % [coq.env.export-module ModPath] is like the vernacular Export *E* external func coq.env.export-module modpath. % [coq.env.begin-section Name] starts a section named Name *E* external func coq.env.begin-section id. % [coq.env.end-section] end the current section *E* external func coq.env.end-section. % [coq.modpath->path MP FullPath] extract the full kernel name, each % component is a separate list item external func coq.modpath->path modpath -> list string. % [coq.modtypath->path MTP FullPath] extract the full kernel name, each % component is a separate list item external func coq.modtypath->path modtypath -> list string. % [coq.modpath->library MP LibraryPath] extract the enclosing module which % can be Required external func coq.modpath->library modpath -> modpath. % [coq.modtypath->library MTP LibraryPath] extract the enclosing module % which can be Required external func coq.modtypath->library modtypath -> modpath. % [coq.env.current-path Path] lists the current module path external func coq.env.current-path -> list string. % [coq.env.current-section-path Path] lists the current section path external func coq.env.current-section-path -> list string. % clauses % % A clause like % :name "foo" :before "bar" foo X Y :- bar X Z, baz Z Y % is represented as % clause "foo" (before "bar") (pi x y z\ foo x y :- bar x z, baz z y) % that is exactly what one would load in the context using =>. % % The name and the grafting specification can be left unspecified. kind clause type. external symbol clause : id -> grafting -> prop -> clause = "1". % Specify if the clause has to be grafted before, grafted after or replace % a named clause kind grafting type. external symbol before : id -> grafting = "1". external symbol after : id -> grafting = "1". external symbol remove : id -> grafting = "1". external symbol replace : id -> grafting = "1". % Specify to which module the clause should be attached to kind scope type. external symbol execution-site : scope = "1". % The module inside which the Elpi program is run external symbol current : scope = "1". % The module being defined (see begin/end-module) external symbol library : scope = "1". % The outermost module (carrying the file name) % see coq.elpi.accumulate-clauses func coq.elpi.accumulate scope, id, clause ->. coq.elpi.accumulate S N C :- coq.elpi.accumulate-clauses S N [C]. % [coq.elpi.accumulate-clauses Scope DbName Clauses] % Declare that, once the program is over, the given clauses has to be % added to the given db (see Elpi Db). % Clauses usually belong to Coq modules: the Scope argument lets one % select which module: % - execution site (default) is the module in which the pogram is % invoked % - current is the module currently being constructed (see % begin/end-module) % - library is the current file (the module that is named after the file) % The clauses are visible as soon as the enclosing module is % Imported. % Clauses cannot be accumulated inside functors. % Supported attributes: % - @local! (default: false, discard at the end of section or module) % - @global! (default: false, always active, only if Scope is % execution-site, discouraged) external func coq.elpi.accumulate-clauses scope, id, list clause. % Action executed during the parsing phase (aka synterp) kind synterp-action type. external symbol begin-module : id -> synterp-action = "1". external symbol begin-module-type : id -> synterp-action = "1". external symbol begin-section : id -> synterp-action = "1". external symbol end-module : modpath -> synterp-action = "1". external symbol end-module-type : modtypath -> synterp-action = "1". external symbol end-section : synterp-action = "1". external symbol apply-module-functor : id -> synterp-action = "1". external symbol apply-module-type-functor : id -> synterp-action = "1". external symbol include-module : modpath -> synterp-action = "1". external symbol include-module-type : modtypath -> synterp-action = "1". external symbol import-module : modpath -> synterp-action = "1". external symbol export-module : modpath -> synterp-action = "1". % Synterp action group kind group type. % [coq.synterp-actions A] Get the list of actions performed during the % parsing phase (aka synterp) up to now. external func coq.synterp-actions -> list synterp-action. % [coq.begin-synterp-group ID Group] Create and open a new synterp action % group with the given name. external func coq.begin-synterp-group id -> group. % [coq.end-synterp-group Group] End the synterp action group Group. Group % must refer to the most recently openned group. external func coq.end-synterp-group group. % Generic attribute value kind attribute-value type. external symbol leaf-str : string -> attribute-value = "1". external symbol leaf-loc : loc -> attribute-value = "1". external symbol node : list attribute -> attribute-value = "1". % Generic attribute kind attribute type. external symbol attribute : string -> attribute-value -> attribute = "1". LPCIC-coq-elpi-eb449d7/builtin-doc/coq-builtin.elpi000066400000000000000000003104461523041753400220250ustar00rootroot00000000000000 % Coq terms as the object language of elpi and basic API to access Coq % license: GNU Lesser General Public License Version 2.1 or later % ------------------------------------------------------------------------- % This file is automatically generated from % - coq-HOAS.elpi % - rocq_elpi_builtin.ml % and contains the description of the data type of Coq terms and the % API to access Coq. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-arg-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular the entry points for commands % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry points % % Command and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry point for commands. Eg. "#[att=true] Elpi mycommand foo 3 (f x)." becomes % main [str "foo", int 3, trm (app[f,x])] % in a context where % attributes [attribute "att" (leaf "true")] % holds. The encoding of terms is described below. % See also the coq.parse-attributes utility. external pred main i:list argument. % Commands with a non-trivial parsing phase can thread data between % from the parsing phase to the interp one in an untyped way using the % following two entrypoints external pred main-interp i:list argument, i:any. external pred main-synterp i:list argument, o:any. % Commands starting/closing proofs have to use the following entrypoints. % The minimal working snippet is: % % main-interp-proof [trm P] _ P GL _ :- % coq.typecheck P _ ok, coq.ltac.collect-goals P GL _. % main-interp-qed _ _ P _GL _ :- % coq.env.add-const "it" P _ _ _. % % Where GL are the goals to prove, and _GL (unused here) are the same goals % with their current proof. The term P can be used as the root proof term, % where GL are missing pieces. One is not obliged to use P as is, i.e. he % can inspect _GL and declare each proof independenlty, or combine these proofs % as he likes and ignore P completely. When a main-interp-qed is used to end % a proof stated by a standard Rocq Lemma/Definition statement, the data from % the proof opening command is the lemma name, _GL is the empty list and P the % proof term. external pred main-interp-proof i:list argument, % arguments passed to the command i:any, % data from the parsing phase (defaults to _) o:term, % proof data for the corresponding proof-closing command o:list sealed-goal, % the sequents to prove o:any. % any data for the corresponding proof-closing command external pred main-interp-qed i:list argument, % arguments passed to the command i:any, % data from the parsing phase (defaults to _) i:term, % proof data from the corresponding proof-opening command i:list sealed-goal, % the sequents from the corresponding proof-opening command, but with proofs i:any. % any data from the corresponding proof-opening command pred usage. external func attributes -> list attribute. % see coq-lib.elpi for coq.parse-attributes generating the options below external pred get-option o:string, o:A. % The data type of arguments (for commands or tactics) kind argument type. external symbol int : int -> argument. % Eg. 1 -2. external symbol str : string -> argument. % Eg. x "y" z.w. or any Coq keyword/symbol external symbol trm : term -> argument. % Eg. (t). external symbol open-trm : int -> term -> argument. % Extra arguments for commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record or Inductive external symbol indt-decl : indt-decl -> argument. % Eg. #[universes(polymorphic,...)] Record or Inductive external symbol upoly-indt-decl : indt-decl -> upoly-decl -> argument. % Eg. Definition or Axiom (when the body is none) external symbol const-decl : id -> option term -> arity -> argument. % Eg. #[universes(polymorphic,...)] Definition or Axiom external symbol upoly-const-decl : id -> option term -> arity -> upoly-decl -> argument. % Eg. Context A (b : A). external symbol ctx-decl : context-decl -> argument. % Declaration of inductive types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% kind indt-decl type. kind indc-decl type. kind record-decl type. % An arity is written, in Coq syntax, as: % (x : T1) .. (xn : Tn) : S1 -> ... -> Sn -> U % This syntax is used, for example, in the type of an inductive type or % in the type of constructors. We call the abstractions on the left of ":" % "parameters" while we call the type following the ":" (proper) arity. % Note: in some contexts, like the type of an inductive type constructor, % Coq makes no distinction between these two writings % (xn : Tn) : forall y1 : S1, ... and (xn : Tn) (y1 : S1) : ... % while Elpi is a bit more restrictive, since it understands user directives % such as the implicit status of an arguments (eg, using {} instead of () around % the binder), only on parameters. % Moreover parameters carry the name given by the user as an "id", while binders % in terms only carry it as a "name", an irrelevant pretty pringintg hint (see % also the HOAS of terms). A user command can hence only use the names of % parameters, and not the names of "forall" quantified variables in the arity. % % See also the arity->term predicate in coq-lib.elpi kind arity type. external symbol parameter : id -> implicit_kind -> term -> (term -> arity) -> arity = "1". external symbol arity : term -> arity. external symbol parameter : id -> implicit_kind -> term -> (term -> indt-decl) -> indt-decl = "2". external symbol inductive : id -> bool -> arity -> (term -> list indc-decl) -> indt-decl. % tt means inductive, ff coinductive external symbol minductive : id -> bool -> arity -> (term -> indt-decl) -> indt-decl. % one type of a mutual block external symbol mblock : list (list indc-decl) -> indt-decl. % constructor blocks for minductive declarations external symbol record : id -> term -> id -> record-decl -> indt-decl. external symbol constructor : id -> arity -> indc-decl. external symbol field : field-attributes -> id -> term -> (term -> record-decl) -> record-decl. external symbol end-record : record-decl. % Example. % Remark that A is a regular parameter; y is a non-uniform parameter and t % also features an index of type bool. % % Inductive t (A : Type) | (y : nat) : bool -> Type := % | K1 (x : A) {n : nat} : S n = y -> t A n true -> t A y true % | K2 : t A y false % % is written % % (parameter "A" explicit {{ Type }} a\ % inductive "t" tt (parameter "y" explicit {{ nat }} _\ % arity {{ bool -> Type }}) % t\ % [ constructor "K1" % (parameter "y" explicit {{ nat }} y\ % (parameter "x" explicit a x\ % (parameter "n" maximal {{ nat }} n\ % arity {{ S lp:n = lp:y -> lp:t lp:n true -> lp:t lp:y true }}))) % , constructor "K2" % (parameter "y" explicit {{ nat }} y\ % arity {{ lp:t lp:y false }}) ]) % % Remark that the uniform parameters are not passed to occurrences of t, since % they never change, while non-uniform parameters are both abstracted % in each constructor type and passed as arguments to t. % % The coq.typecheck-indt-decl API can be used to fill in implicit arguments % an infer universe constraints in the declaration above (e.g. the hidden % argument of "=" in the arity of K1). % % Note: when and inductive type declaration is passed as an argument to an % Elpi command non uniform parameters must be separated from the uniform ones % with a | (a syntax introduced in Coq 8.12 and accepted by rocq-elpi since % version 1.4, in Coq this separator is optional, but not in Elpi). % Context declaration (used as an argument to Elpi commands) kind context-decl type. % Eg. (x : T) or (x := B), body is optional, type may be a variable external symbol context-item : id -> implicit_kind -> term -> option term -> (term -> context-decl) -> context-decl. external symbol context-end : context-decl. typeabbrev field-attributes (list field-attribute). macro @global! :- get-option "coq:locality" "global". macro @local! :- get-option "coq:locality" "local". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular the data type for terms and the evar_map entries (a sequent) % and the entry points for tactics % Entry point for tactics. Eg. "elpi mytactic foo 3 (f x)." becomes % solve % Where [str "foo", int 3, trm (app[f,x])] is part of . % The encoding of goals is described below. % msolve is for tactics that operate on multiple goals (called via all: ). external pred solve i:goal, o:list sealed-goal. external pred msolve i:list sealed-goal, o:list sealed-goal. % Extra arguments for tactics external symbol tac : ltac1-tactic -> argument. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's terms % % Types of term formers % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- terms -------------------------------------------------------------------- kind term type. external symbol sort : sort -> term. % Prop, Type@{i} % constants: inductive types, inductive constructors, definitions external symbol global : gref -> term. external symbol pglobal : gref -> univ-instance -> term. % binders: to form functions, arities and local definitions external symbol fun : name -> term -> (term -> term) -> term. % fun x : t => external symbol prod : name -> term -> (term -> term) -> term. % forall x : t, external symbol let : name -> term -> term -> (term -> term) -> term. % let x : T := v in % other term formers: function application, pattern matching and recursion external symbol app : list term -> term. % app [hd|args] external symbol match : term -> term -> list term -> term. % match t p [branch]) external symbol fix : name -> int -> term -> (term -> term) -> term. % fix name rno ty bo external symbol mfix : int -> int -> mfix-block -> term. % mfix block-idx rno external symbol primitive : primitive-value -> term. kind mfix-block type. external symbol mfix-ty : name -> int -> term -> (term -> mfix-block) -> mfix-block. % mfix-ty name rno ty rest external symbol mfix-bo : list term -> mfix-block. % NYI %type cofix name -> term -> (term -> term) -> term. % cofix name ty bo % Notes about (match Scrutinee TypingFunction Branches) when % Inductive i A : A -> nat -> Type := K : forall a : A, i A a 0 % and % Scrutinee be a term of type (i bool true 7) % % - TypingFunction has a very rigid shape that depends on i. Namely % as many lambdas as indexes plus one lambda for the inductive itself % where the value of the parameters are taken from the type of the scrutinee: % fun `a` (indt "bool") a\ % fun `n` (indt "nat) n\ % fun `i` (app[indt "i", indt "bool", a n) i\ .. % Such spine of fun cannot be omitted; else elpi cannot read the term back. % See also coq.bind-ind-arity-no-let in coq-lib.elpi, that builds such spine for you, % or the higher level api coq.build-match (same file) that also takes % care of branches. % - Branches is a list of terms, the order is the canonical one (the order % of the constructors as they were declared). If the constructor has arguments % (excluding the parameters) then the corresponding term shall be a Coq % function. In this case % fun `x` (indt "bool") x\ .. % -- helpers ------------------------------------------------------------------ macro @cast T TY :- (let `cast` TY T x\x). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's evar_map % % Context and evar declaration % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % An evar_info (displayed as a Coq goal) is essentially a sequent: % % x : t % y := v : x % ---------- % p x y % % is coded as an Elpi query % % pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) % % where, by default, declare-evar creates a syntactic constraint as % % {x1 x2} : % decl x1 `x` , def x2 `y` x1 ?- % evar (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) /* suspended on RawEvar, Ev */ % % When the program is over, a remaining syntactic constraint like the one above % is read back and transformed into the corresponding evar_info. external func decl term -> name, term. % Var Name Ty external func def term -> name, term, term. % Var Name Ty Bo external func cache term -> term. external func declare-evar list prop, term, term, term. % Ctx RawEvar Ty Evar :name "default-declare-evar" declare-evar Ctx RawEv Ty Ev :- declare_constraint (declare-evar Ctx RawEv Ty Ev) [RawEv]. % When a goal (evar _ _ _) is turned into a constraint the context is filtered % to only contain decl, def, pp. For now no handling rules for this set of % constraints other than one to remove a constraint external func rm-evar term, term. rm-evar (uvar as X) (uvar as Y):- !, declare_constraint (rm-evar X Y) [X,Y]. rm-evar _ _. constraint declare-evar evar def decl cache rm-evar { % Override the actual context rule \ (declare-evar Ctx RawEv Ty Ev) <=> (Ctx =!=> evar RawEv Ty Ev). rule \ (rm-evar (uvar X _) (uvar Y _)) (evar (uvar X _) _ (uvar Y _)). rule \ (rm-evar (uvar X _) (uvar Y _)). } % The (evar R Ty E) predicate suspends when R and E are flexible, % and is solved otherwise. % The client may want to provide an alternative implementation of % the clause "default-assign-evar", for example to typechecks that the % term assigned to E has type Ty, or that the term assigned to R % elaborates to a term of type Ty that gets assigned to E. % In tactic mode, elpi/coq-elaborator.elpi wires things up that way. external func evar term, term -> term. % Evar Ty RefinedSolution evar (uvar as X) T S :- var S _ VL, !, prune T VL, prune X VL, declare_constraint (evar X T S) [X, S]. :name "default-assign-evar" evar _ _ _. % volatile, only unresolved evars are considered as evars % To ease the creation of a context with decl and def % Eg. @pi-decl `x` x1\ @pi-def `y` y\ ... macro @pi-decl N T F :- pi x\ decl x N T => F x. macro @pi-def N T B F :- pi x\ def x N T B => cache x B_ => F x. % Converts an arity to a term func coq.arity->term arity -> term. coq.arity->term (parameter ID _ Ty Rest) (prod Name Ty R) :- coq.id->name ID Name, @pi-decl Name Ty x\ coq.arity->term (Rest x) (R x). coq.arity->term (arity A) A. macro @pi-parameter ID T F :- sigma N\ (coq.id->name ID N, pi x\ decl x N T => F x). macro @pi-inductive ID A F :- sigma N\ (coq.id->name ID N, coq.arity->term A T, pi x\ decl x N T => F x). % Sometimes it can be useful to pass to Coq a term with unification variables % representing "untyped holes" like an implicit argument _. In particular % a unification variable may exit the so called pattern fragment (applied % to distinct variables) and hence cannot be reliably mapped to Coq as an evar, % but can still be considered as an implicit argument. % By loading in the context get-option "HOAS:holes" tt one forces that % behavior. Here a convenience macro to be put on the LHS of => macro @holes! :- get-option "HOAS:holes" tt. % Similarly, some APIs take a term skeleton in input. In that case unification % variables are totally disregarded (not even mapped to Coq evars). They are % interpreted as the {{ lib:elpi.hole }} constant, which represents an implicit % argument. As a consequence these APIs don't modify the input term at all, but % rather return a copy. Note that if {{ lib:elpi.hole }} is used directly, then % it has to be applied to all variables in scope, since Coq erases variables % that are not used. For example using {{ forall x : nat, lib:elpi.hole }} as % a term skeleton is equivalent to {{ nat -> lib:elpi.hole }}, while % {{ forall x : nat, lib:elpi.hole x lib:elpi.hole more args }} puts x in % the scope of the hole (and passes to is more args). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's goals and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A Coq goal is essentially a sequent, like the evar_info above, but since it % has to be manipulated as first class Elpi data, it is represented in a slightly % different way. For example % % x : t % y := v : x % ---------- % g x y % % is represented by the following term of type sealed-goal % % nabla x1\ % nabla x2\ % seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % (Arguments x1 x2)) kind goal type. kind sealed-goal type. external symbol nabla : (term -> sealed-goal) -> sealed-goal. external symbol seal : goal -> sealed-goal. typeabbrev goal-ctx (list prop). external symbol goal : goal-ctx -> term -> term -> term -> list argument -> goal. % A sealed-goal closes with nabla the bound names of a % % (goal Ctx RawSolution Ty Solution Arguments) % % where Ctx is a list of decl or def and Solution is a unification variable % to be assigned to a term of type Ty in order to make progress. % RawSolution is used as a trigger: when a term is assigned to it, it is % elaborated against Ty and the resulting term is assigned to Solution. % % Arguments contains data attached to the goal, which lives in its context % and can be used by tactics to solve the goals. % A tactic (an elpi predicate which makes progress on a Coq goal) is % a predicate of type % sealed-goal -> list sealed-goal -> prop % % while the main entry point for a tactic written in Elpi is solve % which has type % goal -> list sealed-goal -> prop % % The utility (coq.ltac.open T G GL) postulates all the variables bounds % by nabla and loads the goal context before calling T on the unsealed % goal. The invocation of a tactic with arguments % 3 x "y" (h x) % on the previous goal results in the following Elpi query: % % (pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2)), % (coq.ltac.open solve % (nabla x1\ nabla x2\ seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % [int 3, str `x`, str`y`, trm (app[const `h`,x1])])) % NewGoals) % % If the goal sequent contains other evars, then a tactic invocation is % an Elpi query made of the conjunction of all the declare-evar queries % corresponding to these evars and the query corresponding to the goal % sequent. NewGoals can be assigned to a list of goals that should be % declared as open. Omitted goals are shelved. If NewGoals is not % assigned, then all unresolved evars become new goals, but the order % of such goals is not specified. % The file elpi-ltac.elpi provides a few combinators (other than coq.ltac.open) % in the tradition of LCF tacticals. The main difference is that the arguments % of custom written tactics must not be passed as predicate arguments but rather % put in the goal they receive. Indeed these arguments can contain terms, and % their bound variables cannot escape the seal. coq.ltac.set-goal-arguments % can be used to put an argument from the current goal context into another % goal. The coq.ltac.call utility can call Ltac1 code (written in Coq) and % pass arguments via this mechanism. % Last, since Elpi is already a logic programming language with primitive % support for unification variables, most of the work of a tactic can be % performed without using tacticals (which work on sealed goals) but rather % in the context of the original goal. The last step is typically to call % the refine utility with a term synthesized by the tactic or invoke some % Ltac1 code on that term (e.g. to call vm_compute, see also the example % on the reflexive tactic). % ----- Multi goals tactics. ---- % Coq provides goal selectors, such as all:, to pass to a tactic more than one % goal. In order to write such a tactic, Coq-Elpi provides another entry point % called msolve. To be precise, if there are two goals under focus, say and % , then all: elpi tac runs the following query % % msolve [,] NewGoals ; % note the disjunction % coq.ltac.all (coq.ltac.open solve) [,] NewGoals % % So, if msolve has no clause, Coq-Elpi will use solve on all the goals % independently. If msolve has a clause, then it can manipulate the entire list % of sealed goals. Note that the argument is in both and but % it is interpreted in both contexts independently. If both goals have a proof % variable named "x" then passing (@eq_refl _ x) as equips both goals with % a (raw) proof that "x = x", no matter what their type is. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Declarations for Coq's API (environment read/write access, etc). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % tt = Yes, ff = No, unspecified = No (unspecified means "_" or a variable). typeabbrev opaque? bool. macro @opaque! :- tt. macro @transparent! :- ff. %%%%%%% Attributes to be passed to APIs as in @local! => coq.something %%%%%%%% macro @keep-alg-univs! :- get-option "coq:keepalgunivs" tt. macro @primitive! :- get-option "coq:primitive" tt. % primitive records macro @reversible! :- get-option "coq:reversible" tt. % coercions macro @no-tc! :- get-option "coq:no_tc" tt. % skip typeclass inference macro @uinstance! I :- get-option "coq:uinstance" I. % universe instance % declaration of universe polymorphic constants % The first list is the one of the universe variables being bound % The first boolean is tt if this list can be extended by Coq (or it has to % mention all universes actually used) % The second list is the one with the constraints amond where universes % The second boolean is tt if this list can be extended by Coq or it has to % mention all universe constraints actually required to type check the % declaration) macro @udecl! Vs LV Cs LC :- get-option "coq:udecl" (upoly-decl Vs LV Cs LC). macro @udecl-cumul! Vs LV Cs LC :- get-option "coq:udecl-cumul" (upoly-decl-cumul Vs LV Cs LC). macro @univpoly! :- @udecl! [] tt [] tt. macro @univpoly-cumul! :- @udecl-cumul! [] tt [] tt. macro @ppwidth! N :- get-option "coq:ppwidth" N. % printing width macro @ppall! :- get-option "coq:pp" "all". % printing all macro @ppmost! :- get-option "coq:pp" "most". % printing most of contents macro @pplevel! N :- get-option "coq:pplevel" N. % printing precedence (for parentheses) macro @keepunivs! :- get-option "coq:keepunivs" tt. % skeletons elaboration macro @dropunivs! :- get-option "coq:keepunivs" ff. % add-indt/add-const macro @using! S :- get-option "coq:using" S. % like the #[using=S] attribute macro @inline-at! N :- get-option "coq:inline" (coq.inline.at N). % like Inline(N) macro @inline! N :- get-option "coq:inline" coq.inline.default. % like macro @redflags! F :- get-option "coq:redflags" (F : coq.redflags). % for whd & co % both arguments are strings eg "8.12.0" "use foo instead" macro @deprecated! Since Msg :- get-option "coq:deprecated" (pr Since Msg). macro @ltacfail! N :- get-option "ltac:fail" N. % retrocompatibility macro for Coq v8.10 macro @coercion! :- [coercion reversible]. % Attributes for a record field. Can be left unspecified, see defaults % below. kind field-attribute type. external symbol coercion : coercion-status -> field-attribute = "1". % default off external symbol canonical : bool -> field-attribute = "1". % default true, if field is named % Status of a record field w.r.t. coercions kind coercion-status type. external symbol regular : coercion-status = "1". external symbol reversible : coercion-status = "1". external symbol off : coercion-status = "1". %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% builtins %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the API to access Coq % The marker *E* means *experimental*, i.e. use at your own risk, it may change % substantially or even disappear in future versions. % -- Misc --------------------------------------------------------- % [coq.info ...] Prints an info message external type coq.info variadic any (func). % [coq.notice ...] Prints a notice message external type coq.notice variadic any (func). % [coq.say ...] Prints a notice message external type coq.say variadic any (func). % [coq.debug ...] Prints a debug message external type coq.debug variadic any (func). % [coq.warn ...] Prints a generic warning message external type coq.warn variadic any (func). % [coq.warning Category Name ...] % Prints a warning message with a Name and Category which can be used % to silence this warning or turn it into an error. See coqc -w command % line option external type coq.warning string -> string -> variadic any (func). % [coq.error ...] Prints and *aborts* the program. It is a fatal error for % Elpi and Ltac external type coq.error variadic any (func). % [coq.version VersionString Major Minor Patch] Fetches the version of Coq, % as a string and as 3 numbers external func coq.version -> string, int, int, int. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % API for objects belonging to the logic % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- Environment: names ----------------------------------------------- % To make the API more precise we use different data types for the names % of global objects. % Note: [ctype "bla"] is an opaque data type and by convention it is written % [@bla]. % Global constant name kind constant type. % Inductive type name kind inductive type. % Inductive constructor name kind constructor type. % Global objects: inductive types, inductive constructors, definitions kind gref type. external symbol const : constant -> gref. % Nat.add, List.append, ... external symbol indt : inductive -> gref. % nat, list, ... external symbol indc : constructor -> gref. % O, S, nil, cons, ... % [id] is a name that matters, we piggy back on Elpi's strings. % Note: [name] is a name that does not matter. typeabbrev id string. % Name of a module /*E*/ kind modpath type. % Name of a module type /*E*/ kind modtypath type. % Result of coq.locate-all kind located type. external symbol loc-gref : gref -> located = "1". external symbol loc-modpath : modpath -> located = "1". external symbol loc-modtypath : modtypath -> located = "1". external symbol loc-abbreviation : abbreviation -> located = "1". % [coq.locate-all Name Located] finds all possible meanings of a string. % Does not fail. external func coq.locate-all id -> list located. % [coq.locate Name GlobalReference] locates a global definition, inductive % type or constructor via its name. % It unfolds syntactic notations, e.g. "Notation old_name := new_name." % It understands qualified names, e.g. "Nat.t". % It understands Rocqlib Registered names using the "lib:" prefix, % eg "lib:core.bool.true". % It's a fatal error if Name cannot be located. external func coq.locate id -> gref. % -- Environment: read ------------------------------------------------ % Note: The type [term] is defined in coq-HOAS.elpi % [coq.env.typeof GR Ty] reads the type Ty of a global reference. % Supported attributes: % - @uinstance! I (default: fresh instance I) external func coq.env.typeof gref -> term. % [coq.env.global GR T] turns a global reference GR into a term, or % viceversa. % T = (global GR) or, if GR points to a universe polymorphic term, % T = (pglobal GR I). % Supported attributes: % - @uinstance! I (default: fresh instance I) external func coq.env.global -> gref, term. external func coq.env.indt % reads the inductive type declaration for the environment. % Supported attributes: % - @uinstance! I (default: fresh instance I) inductive % reference to the inductive type -> bool, % tt if the type is inductive (ff for co-inductive) int, % number of parameters int, % number of parameters that are uniform (<= parameters) term, % type of the inductive type constructor including parameters list constructor, % list of constructor names list term. % list of the types of the constructors (type of KNames) including parameters external func coq.env.indt-block % reads the inductive type declaration for the environment. inductive % Ind -> bool, % tt if the type is inductive (ff for co-inductive) int, % number of parameters int, % number of parameters that are uniform (<= parameters) list inductive, % all inductives in the block list term, % types of the inductive types constructors including parameters list (list constructor), % lists of constructor names list (list term). % lists of the types of the constructors (type of KNames) including parameters external func coq.env.indt-decl % reads the inductive type declaration for the environment. % Supported attributes: % - @uinstance! I (default: fresh instance I) inductive % reference to the inductive type -> indt-decl. % HOAS description of the inductive type % [coq.env.indc->indt K I N] finds the inductive I to which constructor K % belongs and its position N among the other constructors external func coq.env.indc->indt constructor -> inductive, int. % [coq.env.indc GR ParamNo UnifParamNo Kno Ty] reads the type Ty of an % inductive constructor GR, as well as % the number of parameters ParamNo and uniform parameters % UnifParamNo and the number of the constructor Kno (0 based). % Supported attributes: % - @uinstance! I (default: fresh instance I) external func coq.env.indc constructor -> int, int, int, term. % [coq.env.informative? Ind] Checks if Ind is informative, that is, if % it can be eliminated to build a Type. Inductive types in Type % are % informative, as well a singleton types in Prop (which are % regarded as not non-informative). external func coq.env.informative? inductive. % [coq.env.record? Ind PrimProjs] checks if Ind is a record (PrimProjs = tt % if Ind has primitive projections) external func coq.env.record? inductive -> bool. % [coq.env.recursive? Ind] checks if Ind is recursive external func coq.env.recursive? inductive. % [coq.env.opaque? GR] checks if GR is an opaque constant external func coq.env.opaque? constant. % [coq.env.univpoly? GR PolyArity] checks if GR is universe polymorphic and % if so returns the number of universe variables external func coq.env.univpoly? gref -> int. % [coq.env.const GR Bo Ty] reads the type Ty and the body Bo of constant % GR. % Opaque constants have Bo = none. % Supported attributes: % - @uinstance! I (default: fresh instance I) external func coq.env.const constant -> option term, term. % [coq.env.const-body GR Bo] reads the body of a constant, even if it is % opaque. % If such body is none, then the constant is a true axiom. % Supported attributes: % - @uinstance! I (default: fresh instance I) external func coq.env.const-body constant -> option term. % [coq.env.primitive? GR] tests if GR is a primitive constant (like uin63 % addition) or a primitive type (like uint63) external func coq.env.primitive? constant. % [coq.locate-module ModName ModPath] locates a module. It's a fatal error % if ModName cannot be located. *E* external func coq.locate-module id -> modpath. % [coq.locate-module-type ModName ModPath] locates a module. It's a fatal % error if ModName cannot be located. *E* external func coq.locate-module-type id -> modtypath. % Contents of a module kind module-item type. external symbol submodule : modpath -> list module-item -> module-item = "1". external symbol module-type : modtypath -> module-item = "1". external symbol gref : gref -> module-item = "1". external symbol module-functor : modpath -> list modtypath -> module-item = "1". external symbol module-type-functor : modtypath -> list modtypath -> module-item = "1". % [coq.env.module MP Contents] lists the contents of a module (recurses on % submodules) *E* external func coq.env.module modpath -> list module-item. % [coq.env.module-type MTP Entries] lists the items made visible by module % type (does not recurse on submodules) *E* external func coq.env.module-type modtypath -> list id. % [coq.env.section-variables ConstantsRepresentingVariables] lists all the % section variables, i.e. the global objects that are marked as to be % abstracted at the end of the enclosing sections external func coq.env.section-variables -> list constant. % [coq.env.section-contents GlobalObjects] lists the global objects that are % defined withing the open sections. Inner section first. external func coq.env.section-contents -> list (list gref). % Deprecated, use coq.env.section-variables func coq.env.section -> list constant. coq.env.section L :- coq.warning "elpi.deprecated" "elpi.env.section" "use coq.env.section-variables in place of coq.env.section", coq.env.section-variables L. % [coq.env.dependencies GR MP Deps] Computes the direct dependencies of GR. % If MP is given, Deps only contains grefs from that module external func coq.env.dependencies gref, modpath -> coq.gref.set. % [coq.env.transitive-dependencies GR MP Deps] Computes the transitive % dependencies of GR. If MP is given, Deps only contains grefs from that % module external func coq.env.transitive-dependencies gref, modpath -> coq.gref.set. % [coq.env.term-dependencies T S] Computes all the grefs S occurring in the % term T external func coq.env.term-dependencies term -> coq.gref.set. % [coq.env.current-path Path] lists the current module path external func coq.env.current-path -> list string. % [coq.env.current-section-path Path] lists the current section path external func coq.env.current-section-path -> list string. % Deprecated, use coq.env.opaque? pred coq.env.const-opaque? i:constant. coq.env.const-opaque? C :- coq.warning "elpi.deprecated" "elpi.const-opaque" "use coq.env.opaque? in place of coq.env.const-opaque?", coq.env.opaque? C. % Deprecated, use coq.env.primitive? pred coq.env.const-primitive? i:constant. coq.env.const-primitive? C :- coq.warning "elpi.deprecated" "elpi.const-primitive" "use coq.env.primitive? in place of coq.env.const-primitive?", coq.env.primitive? C. % -- Environment: write ----------------------------------------------- % Note: (monomorphic) universe constraints are taken from ELPI's % constraints store. Use coq.univ-* in order to add constraints (or any % higher level facility as coq.typecheck). Load in the context attributes % such as @univpoly!, @univpoly-cumul!, @udecl! or @udecl-cumul! in order to % declare universe polymorphic constants or inductives. % [coq.env.add-const Name Bo Ty Opaque C] Declare a new constant: C gets a % constant derived from Name % and the current module; Ty can be left unspecified and in that case % the % inferred one is taken (as in writing Definition x := t); Bo can be % left % unspecified and in that case an axiom is added (or a section variable, % if a section is open and @local! is used). Omitting the body and the type % is % an error. Note: using this API for declaring an axiom or a section % variable is % deprecated, use coq.env.add-axiom or coq.env.add-section-variable % instead. % Supported attributes: % - @local! (default: false) % - @using! (default: section variables actually used) % - @univpoly! (default unset) % - @udecl! (default unset) % - @dropunivs! (default: false, drops all universe constraints from the % store after the definition) % external func coq.env.add-const id, term, term, opaque? -> constant. % [coq.env.add-axiom Name Ty C] Declare a new axiom: C gets a constant % derived from Name % and the current module. % Supported attributes: % - @local! (default: false) % - @univpoly! (default unset) % - @using! (default: section variables actually used) % - @inline! (default: no inlining) % - @inline-at! N (default: no inlining) external func coq.env.add-axiom id, term -> constant. % [coq.env.add-section-variable Name I Ty C] Declare a new section variable: % C gets a constant derived from Name % and the current module. % external func coq.env.add-section-variable id, implicit_kind, term -> constant. pred coq.env.add-context i:context-decl. coq.env.add-context context-end. coq.env.add-context (context-item Name I Ty none Rest) :- coq.env.add-section-variable Name I Ty C, coq.env.add-context (Rest {coq.env.global (const C)}). coq.env.add-context (context-item Name _I Ty (some Bo) Rest) :- coq.env.add-const Name Bo Ty ff C, coq.env.add-context (Rest {coq.env.global (const C)}). % [coq.env.add-indt Decl I] Declares an inductive type. % Supported attributes: % - @dropunivs! (default: false, drops all universe constraints from the % store after the definition) % - @primitive! (default: false, makes records primitive) external func coq.env.add-indt indt-decl -> inductive. % Interactive module construction % Coq Module inline directive kind coq.inline type. external symbol coq.inline.no : coq.inline = "1". % Coq's [no inline] (aka !) external symbol coq.inline.default : coq.inline = "1". % The default, can be omitted external symbol coq.inline.at : int -> coq.inline = "1". % Coq's [inline at ] % [coq.env.fresh-global-id ID FID] Generates an id FID which is fresh in % the current module and looks similar to ID, i.e. it is ID concatenated % with a number, starting from 1. % [coq.env.fresh-global-id X X] can be used to check if X is taken external func coq.env.fresh-global-id id -> id. external func coq.env.begin-module-functor % Starts a functor. bla bla id, % The name of the functor option modtypath, % Its module type (optional) list (pair id modtypath). % Parameters of the functor (optional) func coq.env.begin-module id, option modtypath -> . coq.env.begin-module Name MP :- coq.env.begin-module-functor Name MP []. % [coq.env.end-module ModPath] end the current module that becomes known as % ModPath *E*. bla bla external func coq.env.end-module -> modpath. external func coq.env.begin-module-type-functor % Starts a module type functor *E*. bla bla id, % The name of the functor list (pair id modtypath). % The parameters of the functor (optional) func coq.env.begin-module-type id ->. coq.env.begin-module-type Name :- coq.env.begin-module-type-functor Name []. % [coq.env.end-module-type ModTyPath] end the current module type that % becomes known as ModPath *E*. bla bla external func coq.env.end-module-type -> modtypath. external func coq.env.apply-module-functor % Applies a functor *E*. bla bla id, % The name of the new module option modtypath, % Its module type (optional) modpath, % The functor being applied (optional) list modpath, % Its arguments (optional) coq.inline % Arguments inlining (optional) -> modpath. % The modpath of the new module external func coq.env.apply-module-type-functor % Applies a type functor *E*. bla bla id, % The name of the new module type modtypath, % The functor (optional) list modpath, % Its arguments (optional) coq.inline % Arguments inlining (optional) -> modtypath. % The modtypath of the new module type % [coq.env.include-module ModPath Inline (optional)] is like the vernacular % Include, Inline can be omitted *E*. bla bla external func coq.env.include-module modpath, coq.inline. % [coq.env.include-module-type ModTyPath Inline (optional)] is like the % vernacular Include Type, Inline can be omitted *E*. bla bla external func coq.env.include-module-type modtypath, coq.inline. % [coq.env.import-module ModPath] is like the vernacular Import *E* external func coq.env.import-module modpath. % [coq.env.export-module ModPath] is like the vernacular Export *E* external func coq.env.export-module modpath. % Support for sections is limited, in particular sections and % Coq quotations may interact in surprising ways. For example % Section Test. % Variable x : nat. % Elpi Query lp:{{ coq.say {{ x }} }}. % works since x is a global Coq term while % Elpi Query lp:{{ % coq.env.begin-section "Test", % coq.env.add-const "x" _ {{ nat }} _ @local! GRX, % coq.say {{ x }} % }}. % may work in a surprising way or may not work at all since % x is resolved before the section is started hence it cannot % denote the same x as before. % [coq.env.begin-section Name] starts a section named Name *E* external func coq.env.begin-section id. % [coq.env.end-section] end the current section *E* external func coq.env.end-section. % [coq.env.projections StructureName Projections] given a record % StructureName lists all projections external func coq.env.projections inductive -> list (option constant). % [coq.env.projection? Constant Number of parameters] if the constant is a % projection, returns the number of parameters of its record. external func coq.env.projection? constant -> int. % [coq.env.primitive-projections StructureName Projections] given a record % StructureName lists all primitive projections external func coq.env.primitive-projections inductive -> list (option (pair projection int)). % [coq.env.primitive-projection? Projection Compatibility constant Index] % Relates a primitive projection to its compatibility constant. Index is set % to the constructor argument extracted by the projection (starting from 0). external func coq.env.primitive-projection? -> projection, constant, int. % -- Sorts (and their universe level, if applicable) ---------------- % Warning: universe polymorphism has to be considered experimental *E* as % a feature, not just as a set of APIs. Unfortunately some of the % current complexity is exposed to the programmer, bare with us. % % The big bang is that in Coq one has terms, types and sorts (which are % the types of types). Some sorts (as of today only Type) some with % a universe level, on paper Type_i for some i. At the sort level % Coq features some form of subtyping: a function expecting a function % to Type, e.g. nat -> Type, can receive a function to Prop, since % Prop <= Type. So far, so good. But what are these levels i % exactly? % % Universe levels are said to be "algebraic", they are made of % variables (see the next section) and the two operators +1 and max. % This is a sort of internal optimization that leaks to the % user/programmer. Indeed these universe levels cannot be (directly) used % in all APIs morally expecting a universe level "i", in particular % the current constraint engine cannot handle constraint with an % algebraic level on the right, e.g. i <= j+1. Since some APIs only % accept universe variables, we provide the coq.univ.variable API % which is able to craft a universe variable which is roughly % equivalent to an algebraic universe, e.g. k such that j+1 = k. % % Rocq-Elpi systematically purges algebraic universes from terms (and % types and sorts) when one reads them from the environment. This % makes the embedding of terms less precise than what it could be. % The different data types stay, since Coq will eventually become % able to handle algebraic universes consistently, making this purging % phase unnecessary. % universe level (algebraic: max, +1, univ.variable) kind univ type. % Sorts (kinds of types) kind sort type. external symbol prop : sort. % impredicative sort of propositions external symbol sprop : sort. % impredicative sort of propositions with definitional proof irrelevance external symbol typ : univ -> sort. % predicative sort of data (carries a universe level) % [coq.sort.leq S1 S2] constrains S1 <= S2 external func coq.sort.leq sort, sort. % [coq.sort.eq S1 S2] constrains S1 = S2 external func coq.sort.eq sort, sort. % [coq.sort.sup S1 S2] constrains S2 = S1 + 1 external func coq.sort.sup sort, sort. % [coq.sort.pts-triple S1 S2 S3] constrains S3 = sort of product with domain % in S1 and codomain in S2 external func coq.sort.pts-triple sort, sort -> sort. % [coq.univ.print] prints the set of universe constraints external func coq.univ.print. % [coq.univ.new U] A fresh universe. external func coq.univ.new -> univ. % [coq.univ.alg-super U V] relates a univ U to its algebraic successor V, % that is U+1 and not any V s.t. U < V external func coq.univ.alg-super univ -> univ. % [coq.univ.alg-max U1 U2 UMax] relates univs U1 and U2 to their algebraic % maximum UMax, that is max(U1, U2) external func coq.univ.alg-max univ, univ -> univ. % [coq.univ Name U] Finds a named unvierse. Can fail. external func coq.univ -> id, univ. % [coq.univ.global? U] succeeds if U is a global universe external func coq.univ.global? univ. % [coq.univ.constraints CL] gives the list of constraints, see also % coq.univ.variable.constraints external func coq.univ.constraints -> list univ-constraint. % -- Universe variables ------ % universe level variable kind univ.variable type. % [coq.univ.variable U L] relates a univ.variable L to a univ U external func coq.univ.variable -> univ, univ.variable. % [coq.univ.variable.constraints L CL] gives the list of constraints on L. % Can be used to craft a strict upoly-decl external func coq.univ.variable.constraints univ.variable -> list univ-constraint. % [coq.univ.variable.of-term T S] collects all univ.variables occurring in T external func coq.univ.variable.of-term term -> coq.univ.variable.set. % -- Universe instance (for universe polymorphic global terms) ------ % As of today a universe polymorphic constant can only be instantiated % with universe level variables. That is f@{Prop} is not valid, nor % is f@{u+1}. One can only write f@{u} for any u. % % A univ-instance is morally a list of universe level variables, % but its list syntax is hidden in the terms. If you really need to % craft or inspect one of these, the following APIs can help you. % % Most of the time the user is expected to use coq.env.global which % crafts a fresh, appropriate, universe instance and possibly unify that % term (of the instance it contains) with another one. % Universes level instance for a universe-polymorphic constant kind univ-instance type. % [coq.univ-instance UI UL] relates a univ-instance UI and a list of % universe level variables UL external func coq.univ-instance -> univ-instance, list univ.variable. % [coq.univ-instance.unify-eq GR UI1 UI2 Diagnostic] unifies the two % universe instances for the same gref external func coq.univ-instance.unify-eq gref, univ-instance, univ-instance -> diagnostic. % [coq.univ-instance.unify-leq GR UI1 UI2 Diagnostic] unifies the two % universe instances for the same gref. Note: if the GR is not *cumulative* % (see Cumulative or #[universes(cumulative)]) then this API imposes an % equality constraint. external func coq.univ-instance.unify-leq gref, univ-instance, univ-instance -> diagnostic. % -- Declaration of universe polymorphic global terms ----------- % These are the data types used to declare how constants % and inductive types should be declared (see also the @udecl! % and % @udecl-cumul! macros). Note that only inductive types can be % declared as cumulative. % Constraint between two universes level variables kind univ-constraint type. external symbol lt : univ.variable -> univ.variable -> univ-constraint = "2". external symbol le : univ.variable -> univ.variable -> univ-constraint = "1". external symbol eq : univ.variable -> univ.variable -> univ-constraint = "2". % Variance of a universe level variable kind univ-variance type. external symbol auto : univ.variable -> univ-variance = "1". external symbol covariant : univ.variable -> univ-variance = "1". external symbol invariant : univ.variable -> univ-variance = "1". external symbol irrelevant : univ.variable -> univ-variance = "1". % Constraints for a non-cumulative declaration. Boolean tt means loose % (e.g. the '+' in f@{u v + | u < v +}) kind upoly-decl type. external symbol upoly-decl : list univ.variable -> bool -> list univ-constraint -> bool -> upoly-decl = "1". external symbol upoly-decl-cumul : list univ-variance -> bool -> list univ-constraint -> bool -> upoly-decl = "1". % -- Primitive -------------------------------------------------------- kind uint63 type. kind float64 type. kind pstring type. kind projection type. % Primitive values kind primitive-value type. external symbol uint63 : uint63 -> primitive-value = "1". % unsigned integers over 63 bits external symbol float64 : float64 -> primitive-value = "1". % double precision foalting points external symbol pstring : pstring -> primitive-value = "1". % primitive string external symbol proj : projection -> int -> primitive-value = "1". % primitive projection % [coq.uint63->int U I] Transforms a primitive unsigned integer U into an % elpi integer I. Fails if it does not fit. external func coq.uint63->int uint63 -> int. % [coq.int->uint63 I U] Transforms an elpi integer I into a primitive % unsigned integer U. Fails if I is negative. external func coq.int->uint63 int -> uint63. % [coq.float64->float F64 F] Transforms a primitive float on 64 bits to an % elpi one. Currently, it should not fail. external func coq.float64->float float64 -> float. % [coq.float->float64 F F64] Transforms an elpi float F to a primitive float % on 64 bits. Currently, it should not fail. external func coq.float->float64 float -> float64. % [coq.primitive.projection-unfolded P PU] Relates a primitive projection P % to its unfolded version PU. PU is still a primitive projection, but it is % displayed as a match and some Ltac code can see that. external func coq.primitive.projection-unfolded -> projection, projection. % [coq.pstring->string PS S] Transforms a Coq primitive string to an elpi % string. It does not fail. external func coq.pstring->string pstring -> string. % [coq.string->pstring S PS] Transforms an elpi string into a Coq primitive % string. It fails if the lenght of S is greater than the maximal primitive % string length. external func coq.string->pstring string -> pstring. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % API for extra logical objects % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- Databases (TC, CS, Coercions) ------------------------------------ % Pattern for canonical values kind cs-pattern type. external symbol cs-gref : gref -> cs-pattern = "1". external symbol cs-prod : cs-pattern = "1". external symbol cs-default : cs-pattern = "1". external symbol cs-sort : sort -> cs-pattern = "1". % Canonical Structure instances: (cs-instance Proj ValPat Inst) kind cs-instance type. external symbol cs-instance : gref -> cs-pattern -> gref -> cs-instance = "1". % [coq.CS.declare-instance GR] Declares GR as a canonical structure % instance. % Supported attributes: % - @local! (default: false) external func coq.CS.declare-instance gref. % [coq.CS.db Db] reads all instances external func coq.CS.db -> list cs-instance. % [coq.CS.db-for Proj Value Db] reads all instances for a given Projection % or canonical Value, or both external func coq.CS.db-for gref, cs-pattern -> list cs-instance. % [coq.CS.canonical-projection? Projection] Tells if the projection can be % used for CS inference. external func coq.CS.canonical-projection? constant. % [coq.TC.declare-class GR] Declare GR as a type class external func coq.TC.declare-class gref. % [coq.elpi.toposort Graph Nodes in toposort order] takes a graph and % returns the nodes in topological order external func coq.elpi.toposort list (pair A (list A)) -> list A. % Type class instance with priority kind tc-instance type. external symbol tc-instance : gref -> int -> tc-instance = "1". % [coq.TC.declare-instance GR Priority] Declare GR as a Global type class % instance with Priority. % Supported attributes: % - @global! (default: true) external func coq.TC.declare-instance gref, int. % [coq.TC.db Instances] reads all type class instances external func coq.TC.db -> list tc-instance. % [coq.TC.db-tc TypeClasses] reads all type classes external func coq.TC.db-tc -> list gref. % [coq.TC.db-for GR InstanceList] reads all instances of the given class GR. % Instances are in their precedence order. external func coq.TC.db-for gref -> list tc-instance. % [coq.TC.get-inst-prio ClassGR InstGR InstPrio] reads the priority of an % instance external func coq.TC.get-inst-prio gref, gref -> int. % [coq.TC.class? GR] checks if GR is a class external func coq.TC.class? gref. % Node of the coercion graph kind class type. external symbol funclass : class = "1". external symbol sortclass : class = "1". external symbol grefclass : gref -> class = "1". % Edge of the coercion graph kind coercion type. external symbol coercion : gref -> int -> gref -> class -> coercion = "2". % ref, nparams, src, tgt % [coq.coercion.declare C] Declares C = (coercion GR NParams From To) as a % coercion From >-> To. % NParams can always be omitted, since it is inferred. % If From or To is unspecified, then the endpoints are inferred. % Supported attributes: % - @global! (default: false) % - @nonuniform! (default: false) % - @reversible! (default: false) external func coq.coercion.declare coercion. % [coq.coercion.db L] reads all declared coercions external func coq.coercion.db -> list coercion. % [coq.coercion.db-for From To L] L is a path From -> To external func coq.coercion.db-for class, class -> list (pair gref int). % Deprecated, use coq.env.projections pred coq.CS.canonical-projections i:inductive, o:list (option constant). coq.CS.canonical-projections I L :- coq.warning "elpi.deprecated" "elpi.canonical-projections" "use coq.env.projections in place of coq.CS.canonical-projections", coq.env.projections I L. % -- Coq's Hint DB ------------------------------------- % Locality of hints is a delicate matter since the Coq default % is, in some cases, to make an hint active even if the module it belongs % to is not imported (just merely required, which can happen % transitively). % Coq is aiming at changing the default to #[export], that makes an % hint active only when its enclosing module is imported. % See: % https://coq.discourse.group/t/change-of-default-locality-for-hint-commands-in-coq-8-13/1140 % % This old behavior is available via the @global! flag, but is discouraged. % % Hint Mode kind hint-mode type. external symbol mode-ground : hint-mode = "1". % No Evar external symbol mode-input : hint-mode = "1". % No Head Evar external symbol mode-output : hint-mode = "1". % Anything % [coq.hints.add-mode GR DB Mode] Adds a mode declaration to DB about % GR. % Supported attributes: % - @local! (default is export) % - @global! (discouraged, may become deprecated) external func coq.hints.add-mode gref, string, list hint-mode. % [coq.hints.modes GR DB Modes] Gets all the mode declarations in DB about % GR external func coq.hints.modes gref, string -> list (list hint-mode). % [coq.hints.set-opaque C DB Opaque] Like Hint Opaque C : DB (or Hint % Transparent, if the boolean is ff). % Supported attributes: % - @local! (default is export) % - @global! (discouraged, may become deprecated) external func coq.hints.set-opaque constant, string, bool. % [coq.hints.opaque C DB Opaque] Reads if constant C is opaque (tt) or % transparent (ff) in DB external func coq.hints.opaque constant, string -> bool. % [coq.hints.add-resolve GR DB Priority Pattern] Like Hint Resolve GR | % Priority Pattern : DB. % Supported attributes: % - @local! (default is export) % - @global! (discouraged, may become deprecated) external func coq.hints.add-resolve gref, string, int, term. % -- Coq's notational mechanisms ------------------------------------- % Implicit status of an argument kind implicit_kind type. external symbol implicit : implicit_kind = "1". % regular implicit argument, eg Arguments foo [x] external symbol maximal : implicit_kind = "1". % maximally inserted implicit argument, eg Arguments foo {x} external symbol explicit : implicit_kind = "1". % explicit argument, eg Arguments foo x % [coq.arguments.implicit GR Imps] reads the implicit arguments declarations % associated to a global reference. See also the [] and {} flags for the % Arguments command. external func coq.arguments.implicit gref -> list (list implicit_kind). % [coq.arguments.set-implicit GR Imps] sets the implicit arguments % declarations associated to a global reference. % Unspecified means explicit. % See also the [] and {} flags for the Arguments command. % Supported attributes: % - @global! (default: false) external func coq.arguments.set-implicit gref, list (list implicit_kind). % [coq.arguments.set-default-implicit GR] sets the default implicit % arguments declarations associated to a global reference. % See also the "default implicits" flag to the Arguments command. % Supported attributes: % - @global! (default: false) external func coq.arguments.set-default-implicit gref. % [coq.arguments.name GR Names] reads the Names of the arguments of a global % reference. See also the (f (A := v)) syntax. external func coq.arguments.name gref -> list (option id). % [coq.arguments.set-name GR Names] sets the Names of the arguments of a % global reference. % See also the :rename flag to the Arguments command. % Supported attributes: % - @global! (default: false) external func coq.arguments.set-name gref, list (option id). % [coq.arguments.scope GR Scopes] reads the notation scope of the arguments % of a global reference. See also the %scope modifier for the Arguments % command external func coq.arguments.scope gref -> list (list id). % [coq.arguments.set-scope GR Scopes] sets the notation scope of the % arguments of a global reference. % Scope can be a scope name or its delimiter. % See also the %scope modifier for the Arguments command. % Supported attributes: % - @global! (default: false) external func coq.arguments.set-scope gref, list (list id). % Strategy for simplification tactics kind simplification_strategy type. external symbol never : simplification_strategy = "1". % Arguments foo : simpl never external symbol when : list int -> option int -> simplification_strategy = "1". % Arguments foo .. / .. ! .. external symbol when-nomatch : list int -> option int -> simplification_strategy = "1". % Arguments foo .. / .. ! .. : simpl nomatch % [coq.arguments.simplification GR Strategy] reads the behavior of the % simplification tactics. Positions are 0 based. See also the ! and / % modifiers for the Arguments command external func coq.arguments.simplification gref -> option simplification_strategy. % [coq.arguments.set-simplification GR Strategy] sets the behavior of the % simplification tactics. % Positions are 0 based. % See also the ! and / modifiers for the Arguments command. % Supported attributes: % - @global! (default: false) external func coq.arguments.set-simplification gref, simplification_strategy. % [coq.arguments.reset-simplification GR] resets the behavior of the % simplification tactics. % Also resets the ! and / modifiers for the Arguments command. % Supported attributes: % - @global! (default: false) external func coq.arguments.reset-simplification gref. % [coq.locate-abbreviation Name Abbreviation] locates an abbreviation. It's % a fatal error if Name cannot be located. external func coq.locate-abbreviation id -> abbreviation. % Name of an abbreviation kind abbreviation type. % [coq.notation.add-abbreviation Name Nargs Body OnlyParsing Abbreviation] % Declares an abbreviation Name with Nargs arguments. % The term must begin with at least Nargs "fun" nodes whose domain is % ignored, eg (fun _ _ x\ fun _ _ y\ app[global "add",x,y]). % Supported attributes: % - @deprecated! (default: not deprecated) % - @warn! (default: no warning) % - @global! (default: false) external func coq.notation.add-abbreviation id, int, term, bool -> abbreviation. % [coq.notation.abbreviation Abbreviation Args Body] Unfolds an abbreviation external func coq.notation.abbreviation abbreviation, list term -> term. % [coq.notation.abbreviation-body Abbreviation Nargs Body] Retrieves the % body of an abbreviation external func coq.notation.abbreviation-body abbreviation -> int, term. % [coq.notation.add-abbreviation-for-tactic Name TacticName FixedArgs] % Declares a parsing rule similar to % Notation Name X1..Xn := ltac:(elpi TacticName FixedArgs (X1)..(Xn)) % so that Name can be used in the middle of a term to invoke an % elpi tactic. While FixedArgs can contain str, int, and trm all % other arguments will necessarily be terms, and their number is % not fixed (the user can pass as many as he likes). % The tactic receives as the elpi.loc attribute the precise location % at which the term is written (unlike if a regular abbreviation was % declared by hand). % A call to coq.notation.add-abbreviation-for-tactic TacName TacName [] % is equivalent to Elpi Export TacName. external func coq.notation.add-abbreviation-for-tactic string, string, list argument. % Generic attribute value kind attribute-value type. external symbol leaf-str : string -> attribute-value = "1". external symbol leaf-loc : loc -> attribute-value = "1". external symbol node : list attribute -> attribute-value = "1". % Generic attribute kind attribute type. external symbol attribute : string -> attribute-value -> attribute = "1". % -- Coq's pretyper --------------------------------------------------- % [coq.sigma.print] Prints Coq's Evarmap and the mapping to/from Elpi's % unification variables external func coq.sigma.print. % [coq.typecheck T Ty Diagnostic] typchecks a term T returning its type Ty. % If Ty is provided, then % the inferred type is unified (see unify-leq) with it. % Universe constraints are put in the constraint store. external func coq.typecheck term -> term, diagnostic. % [coq.typecheck-ty Ty U Diagnostic] typchecks a type Ty returning its % universe U. If U is provided, then % the inferred universe is unified (see unify-leq) with it. % Universe constraints are put in the constraint store. external func coq.typecheck-ty term -> sort, diagnostic. % [coq.unify-eq A B Diagnostic] unifies the two terms external func coq.unify-eq term, term -> diagnostic. % [coq.unify-leq A B Diagnostic] unifies the two terms (with cumulativity, % if they are types) external func coq.unify-leq term, term -> diagnostic. % [coq.elaborate-skeleton T ETy E Diagnostic] elaborates T against the % expected type ETy. % T is allowed to contain holes (unification variables) but these are % not assigned even if the elaborated term has a term in place of the % hole. Similarly universe levels present in T are disregarded. % Supported attributes: % - @keepunivs! (default false, do not disregard universe levels) % - @no-tc! (default false, do not infer typeclasses) external func coq.elaborate-skeleton term -> term, term, diagnostic. % [coq.elaborate-ty-skeleton T U E Diagnostic] elaborates T expecting it to % be a type of sort U. % T is allowed to contain holes (unification variables) but these are % not assigned even if the elaborated term has a term in place of the % hole. Similarly universe levels present in T are disregarded. % Supported attributes: % - @keepunivs! (default false, do not disregard universe levels) % - @no-tc! (default false, do not infer typeclasses) external func coq.elaborate-ty-skeleton term -> sort, term, diagnostic. % -- Coq's reduction flags ------------------------------------ % Flags for lazy, cbv, ... reductions kind coq.redflag type. external symbol coq.redflags.beta : coq.redflag = "2". external symbol coq.redflags.delta : coq.redflag = "2". % if set then coq.redflags.const disables unfolding external symbol coq.redflags.match : coq.redflag = "1". external symbol coq.redflags.fix : coq.redflag = "1". external symbol coq.redflags.cofix : coq.redflag = "1". external symbol coq.redflags.zeta : coq.redflag = "2". external symbol coq.redflags.const : constant -> coq.redflag = "1". % enable/disable unfolding external symbol coq.redflags.proj : projection -> coq.redflag = "1". % enable/disable unfolding % Set of flags for lazy, cbv, ... reductions kind coq.redflags type. external symbol coq.redflags.nored : coq.redflags = "1". external symbol coq.redflags.zeta : coq.redflags = "1". external symbol coq.redflags.delta : coq.redflags = "1". external symbol coq.redflags.betazeta : coq.redflags = "1". external symbol coq.redflags.betaiotazeta : coq.redflags = "1". external symbol coq.redflags.betaiota : coq.redflags = "1". external symbol coq.redflags.betadeltazeta : coq.redflags = "1". external symbol coq.redflags.beta : coq.redflags = "1". external symbol coq.redflags.allnolet : coq.redflags = "1". external symbol coq.redflags.all : coq.redflags = "1". % [coq.redflags.add Flags Options NewFlags] Updates reduction Flags by % adding Options external func coq.redflags.add coq.redflags, list coq.redflag -> coq.redflags. % [coq.redflags.sub Flags Options NewFlags] Updates reduction Flags by % removing Options external func coq.redflags.sub coq.redflags, list coq.redflag -> coq.redflags. % -- Coq's reduction machines ------------------------------------ % [coq.reduction.lazy.whd T Tred] Puts T in weak head normal form. % Supported attributes: % - @redflags! (default coq.redflags.all) external func coq.reduction.lazy.whd term -> term. % [coq.reduction.lazy.norm T Tred] Puts T in normal form. % Supported attributes: % - @redflags! (default coq.redflags.all) external func coq.reduction.lazy.norm term -> term. % [coq.reduction.lazy.bi-norm T Tred] Puts T in normal form only reducing % beta and iota redexes external func coq.reduction.lazy.bi-norm term -> term. % [coq.reduction.cbv.norm T Tred] Puts T in normal form using the call by % value strategy. % Supported attributes: % - @redflags! (default coq.redflags.all) external func coq.reduction.cbv.norm term -> term. % [coq.reduction.vm.norm T Ty Tred] Puts T in normal form using % [vm_compute]'s machinery. Its type Ty can be omitted (but is recomputed) external func coq.reduction.vm.norm term, term -> term. % [coq.reduction.native.norm T Ty Tred] Puts T in normal form using % [native_compute]'s machinery. Its type Ty can be omitted (but is % recomputed). Falls back to vm.norm if native compilation is not available. external func coq.reduction.native.norm term, term -> term. % [coq.reduction.native.available?] Is native compilation available on this % system/configuration? external func coq.reduction.native.available?. % Deprecated, use coq.reduction.cbv.norm pred coq.reduction.cbv.whd_all i:term, o:term. coq.reduction.cbv.whd_all T R :- coq.warning "elpi.deprecated" "elpi.cbv-whd-all" "use coq.reduction.cbv.norm in place of coq.reduction.cbv.whd_all", coq.reduction.cbv.norm T R. % Deprecated, use coq.reduction.vm.norm pred coq.reduction.vm.whd_all i:term, i:term, o:term. coq.reduction.vm.whd_all T TY R :- coq.warning "elpi.deprecated" "elpi.vm-whd-all" "use coq.reduction.vm.norm in place of coq.reduction.vm.whd_all", coq.reduction.vm.norm T TY R. func coq.reduction.lazy.whd_all term -> term. coq.reduction.lazy.whd_all X Y :- @redflags! coq.redflags.all => coq.reduction.lazy.whd X Y. % [coq.reduction.eta-contract T Tred] Removes all eta expansions from T external func coq.reduction.eta-contract term -> term. % -- Coq's conversion strategy tweaks -------------------------- % Strategy for conversion test % expand < ... < level -1 < level 0 < level 1 < ... < opaque kind conversion_strategy type. external symbol opaque : conversion_strategy = "1". external symbol expand : conversion_strategy = "1". external symbol level : int -> conversion_strategy = "1". % default is 0, aka transparent % [coq.strategy.set CL Level] Sets the unfolding priority for all the % constants in the list CL. See the command Strategy. external func coq.strategy.set list constant, conversion_strategy. % [coq.strategy.get C Level] Gets the unfolding priority for C external func coq.strategy.get constant -> conversion_strategy. % -- Coq's tactics -------------------------------------------- % LTac1 tactic expression kind ltac1-tactic type. % [coq.ltac.fail Level ...] Interrupts the Elpi program and calls Ltac's % fail Level Msg, where Msg is the printing of the remaining arguments. % Level can be left unspecified and defaults to 0 external type coq.ltac.fail int -> variadic any (func). % [coq.ltac.collect-sealed-goals T Goals ShelvedGoals] % Turns the holes in T into Goals. % Goals are closed with nablas. % ShelvedGoals are goals which can be solved by side effect (they occur % in the type of the other goals). % The order of Goals is given by the traversal order of EConstr.fold % (a % fold_left over the terms, letin body comes before the type). % external func coq.ltac.collect-sealed-goals term -> list sealed-goal, list sealed-goal. func coq.ltac.collect-goals term -> list sealed-goal, list sealed-goal. coq.ltac.collect-goals T GA GB :- coq.ltac.collect-sealed-goals T GA GB. % [coq.ltac.collect-simple-goals T Goals ShelvedGoals] Like % coq.ltac.collect-sealed-goals turns the holes in T into % Goals but fails if the goals do not live in the current proof context. % external func coq.ltac.collect-simple-goals term -> list goal, list sealed-goal. % [coq.ltac.call-mltac PluginName BlockName BlockIndex G GL Diagnostic] % Calls OCaml code bound via TACTIC EXTEND. For example the % OCaml code for lia looks like: % % DECLARE PLUGIN "rocq-runtime.plugins.micromega" % ... % TACTIC EXTEND Lia % | [ "xlia" tactic(t) ] -> { Coq_micromega.xlia % (Tacinterp.tactic_of_value ist t) } % END % % In order to call the code between curly braces one has to run % % coq.ltac.call-mltac "rocq-runtime.plugins.micromega" "Lia" 0 G GL % % Note that each TACTIC EXTEND block can have many entries and their % numbering % starts from 0. Also, each block has a name, "Lia" in this case. % % When the diagnostic is (error Msg), then GL is not set. % % Supported attributes: % - @no-tc! (default false, do not infer typeclasses) external func coq.ltac.call-mltac string, string, int, goal -> list sealed-goal, diagnostic. % [coq.ltac.call-simple-mltac PluginName BlockName BlockIndex G GL % Diagnostic] Like coq.ltac.call-mltac but Tac is not allowed to % generate new goals GL in different contexts. For example "intro" does % not % obey this restriction. % % Supported attributes: % - @no-tc! (default false, do not infer typeclasses) external func coq.ltac.call-simple-mltac string, string, int, goal -> list goal, diagnostic. % [coq.ltac.call-ltac1 Tac G GL ...] Calls Ltac1 tactic Tac on goal G % (passing the arguments of G, see coq.ltac.call for a handy wrapper). % It accepts one diagnostic argument, defaults to ok if omitted. % Tac can either be a string (the tactic name), or a value % of type ltac1-tactic, see the tac argument constructor % and the ltac_tactic:(...) syntax to pass arguments to % an elpi tactic. % Caveat: % if Tac is a tactic name, then the tactic must be defined using % "Ltac name := body", it cannot be a builtin one. For example % "Ltac myapply x := apply x." lets one call apply by running % coq.ltac.call-ltac1 "myapply" G GL. % % When the diagnostic is (error Msg), then GL is not set. % % Supported attributes: % - @no-tc! (default false, do not infer typeclasses) external func coq.ltac.call-ltac1 any, goal -> list sealed-goal, diagnostic.. . % [coq.ltac.call-simple-ltac1 Tac G GL Diagnostic] Like coq.ltac.call-ltac1 % but Tac is not allowed to % generate new goals GL in different contexts. For example "intro" does % not % obey this restriction. % % Supported attributes: % - @no-tc! (default false, do not infer typeclasses) external func coq.ltac.call-simple-ltac1 any, goal -> list goal, diagnostic. % [coq.ltac.id-free? ID G] % Fails if ID is already used in G. Note that ids which are taken are % renamed % on the fly (since in the HOAS of terms, names are just pretty printing % hints), but for the ergonomy of a tactic it may help to know if an % hypothesis name is already taken. % external func coq.ltac.id-free? id, goal. % [coq.ltac.fresh-id Default Ty FreshID] TODO external func coq.ltac.fresh-id id, term -> id. % -- Coq's options system -------------------------------------------- % Coq option value kind coq.option type. external symbol coq.option.int : option int -> coq.option = "1". % none means unset external symbol coq.option.string : option string -> coq.option = "1". % none means unset external symbol coq.option.bool : bool -> coq.option = "1". % [coq.option.get Option Value] reads Option. Reading a non existing option % is a fatal error. external func coq.option.get list string -> coq.option. % [coq.option.set Option Value] writes Option. Writing a non existing option % is a fatal error. external func coq.option.set list string, coq.option. % [coq.option.available? Option Deprecated] checks if Option exists and % tells if is deprecated (tt) or not (ff) external func coq.option.available? list string -> bool. % [coq.option.add Option Value Deprecated] % adds a new option to Coq setting its current value (and type). % Deprecated can be left unspecified and defaults to ff. % This call cannot be undone in a Coq interactive session, use it once % and for all in a .v file which your clients will load. Eg. % % Elpi Query lp:{{ coq.option.add ... }}. % % external func coq.option.add list string, coq.option, bool. % -- Datatypes conversions -------------------------------------------- % Name.Name.t: Name hints (in binders), can be input writing a name % between backticks, e.g. `x` or `_` for anonymous. Important: these are % just printing hints with no meaning, hence in elpi two name are always % related: `x` = `y` kind name type. % [coq.name-suffix Name Suffix NameSuffix] suffixes a Name with a string or % an int or another name external func coq.name-suffix name, any -> name. % [coq.string->name Hint Name] creates a name hint using a relevance % variable external func coq.string->name string -> name. % [coq.string->name-relevant Hint Name] creates a name hint with the % relevant mark (see SProp) external func coq.string->name-relevant string -> name. func coq.id->name id -> name. coq.id->name S N :- coq.string->name-relevant S N. % [coq.name->id Name Id] tuns a pretty printing hint into a string. This API % is for internal use, no guarantee on its behavior. external func coq.name->id name -> id. % [coq.name.relevant? Name Relevance] Reads the relevance mark. none means % unset, some tt means relevant. external func coq.name.relevant? name -> option bool. % [coq.gref->id GR Id] extracts the label (last component of a full kernel % name) external func coq.gref->id gref -> id. % [coq.gref->string GR FullPath] extract the full kernel name external func coq.gref->string gref -> string. % [coq.gref->path GR FullPath] extract the full path (kernel name without % final id), each component is a separate list item external func coq.gref->path gref -> list string. % [coq.modpath->path MP FullPath] extract the full kernel name, each % component is a separate list item external func coq.modpath->path modpath -> list string. % [coq.modtypath->path MTP FullPath] extract the full kernel name, each % component is a separate list item external func coq.modtypath->path modtypath -> list string. % [coq.modpath->library MP LibraryPath] extract the enclosing module which % can be Required external func coq.modpath->library modpath -> modpath. % [coq.modtypath->library MTP LibraryPath] extract the enclosing module % which can be Required external func coq.modtypath->library modtypath -> modpath. % [coq.term->string T S] prints a term T to a string S using Coq's pretty % printer % Supported attributes: % - @ppwidth! N (default 80, max line length) % - @ppall! (default: false, prints all details) % - @ppmost! (default: false, prints most details) % - @pplevel! (default: _, prints parentheses to reach that level, 200 = % off) % - @holes! (default: false, prints evars as _) external func coq.term->string term -> string. % [coq.term->pp T B] prints a term T to a pp.t B using Coq's pretty % printer" % Supported attributes: % - @ppall! (default: false, prints all details) % - @ppmost! (default: false, prints most details) % - @pplevel! (default: _, prints parentheses to reach that level, 200 = % off) % - @holes! (default: false, prints evars as _) external func coq.term->pp term -> coq.pp. % [coq.goal->pp G B] prints a goal G to a pp.t B using Coq's pretty % printer" % Supported attributes: % - @ppall! (default: false, prints all details) % - @ppmost! (default: false, prints most details) % - @pplevel! (default: _, prints parentheses to reach that level, 200 = % off) % - @holes! (default: false, prints evars as _) external func coq.goal->pp goal -> coq.pp. % -- Register ----------------------------------------------- % Coq scheme kind (currently undocumented in Rocq) kind coq.register.scheme-kind type. external symbol coq.register.scheme.rect_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rec_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.ind_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.sind_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rect_nodep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rec_nodep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.ind_nodep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.sind_nodep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.case_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.case_nodep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.casep_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.casep_nodep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.sym_internal : coq.register.scheme-kind = "1". external symbol coq.register.scheme.sym_involutive : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rew_r_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rew_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rew_fwd_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rew_fwd_r_dep : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rew_r : coq.register.scheme-kind = "1". external symbol coq.register.scheme.rew : coq.register.scheme-kind = "1". external symbol coq.register.scheme.congr : coq.register.scheme-kind = "1". external symbol coq.register.scheme.beq : coq.register.scheme-kind = "1". external symbol coq.register.scheme.dec_bl : coq.register.scheme-kind = "1". external symbol coq.register.scheme.dec_lb : coq.register.scheme-kind = "1". external symbol coq.register.scheme.eq_dec : coq.register.scheme-kind = "1". external symbol coq.register.scheme.other : string -> coq.register.scheme-kind = "1". % Coq register value kind coq.register type. external symbol coq.register.inline : coq.register = "1". external symbol coq.register.lib : string -> coq.register = "1". external symbol coq.register.scheme : gref -> coq.register.scheme-kind -> coq.register = "1". % [coq.register GR R] Registers GR as R (See Register Inline, Register % Scheme) external func coq.register gref, coq.register. % [coq.scheme Kind GR Scheme] looks up the scheme of the given kind for GR. % Returns none if GR is not an inductive or no such scheme is registered. external func coq.scheme coq.register.scheme-kind, gref -> option gref. % -- Extra Dependencies ----------------------------------------------- % [coq.extra-dep Identifier FileName] Resolve the file name of an extra % dependency. See also Coq's From xxx Extra Dependency yyy as zzz. external func coq.extra-dep id -> option id. % -- Access to Elpi's data -------------------------------------------- % clauses % % A clause like % :name "foo" :before "bar" foo X Y :- bar X Z, baz Z Y % is represented as % clause "foo" (before "bar") (pi x y z\ foo x y :- bar x z, baz z y) % that is exactly what one would load in the context using =>. % % The name and the grafting specification can be left unspecified. kind clause type. external symbol clause : id -> grafting -> prop -> clause = "1". % Specify if the clause has to be grafted before, grafted after or replace % a named clause kind grafting type. external symbol before : id -> grafting = "1". external symbol after : id -> grafting = "1". external symbol remove : id -> grafting = "1". external symbol replace : id -> grafting = "1". % Specify to which module the clause should be attached to kind scope type. external symbol execution-site : scope = "1". % The module inside which the Elpi program is run external symbol current : scope = "1". % The module being defined (see begin/end-module) external symbol library : scope = "1". % The outermost module (carrying the file name) % see coq.elpi.accumulate-clauses :index (1) func coq.elpi.accumulate scope, id, clause. coq.elpi.accumulate S N C :- coq.elpi.accumulate-clauses S N [C]. % [coq.elpi.accumulate-clauses Scope DbName Clauses] % Declare that the given clauses have to be added to the given db (see Elpi % Db). % Clauses usually belong to Coq modules: the Scope argument lets one % select which module: % - execution site (default) is the module in which the program is % invoked, the clauses will be accumulated when the execution of the % program ends % - current is the module currently being constructed (see % begin/end-module), the clauses will be accumulated when the execution of % the program ends % or the start of another program (whichever comes first) % - library is the current file (the module that is named after the file), % the clauses will be accumulated when the execution of the program % ends % The clauses are visible as soon as the enclosing module is Imported. % A clause that mentions a section variable is automatically discarded % at the end of the section. % Clauses cannot be accumulated inside functors. % Supported attributes: % - @local! (default: false, discard at the end of section or module) % - @global! (default: false, always active, only if Scope is % execution-site, discouraged) external func coq.elpi.accumulate-clauses scope, id, list clause. % Specify if a predicate argument is in input or output mode kind argument_mode type. external symbol in : argument_mode = "1". external symbol out : argument_mode = "1". % [coq.elpi.add-predicate Db Indexing PredName Spec] Declares a new % predicate PredName in the data base Db. % Indexing can be left unspecified. Spec gathers a mode and a % type for each argument. CAVEAT: types and indexing are strings % instead of proper data types; beware parsing errors are fatal. % Supported attributes: % - @local! (default: false, discard at the end of section or module) % - @global! (default: false, always active external func coq.elpi.add-predicate string, string, string, list (pair argument_mode string). % [coq.elpi.predicate? PredName] Tells if a predicate called PredName exists external func coq.elpi.predicate? string. % [coq.elpi.predicate PredName Args Pred] Pred is the application of % PredName to Args external func coq.elpi.predicate string, list any -> prop. % -- Synterp ---------------------------------------------------------- % Action executed during the parsing phase (aka synterp) kind synterp-action type. external symbol begin-module : id -> synterp-action = "1". external symbol begin-module-type : id -> synterp-action = "1". external symbol begin-section : id -> synterp-action = "1". external symbol end-module : modpath -> synterp-action = "1". external symbol end-module-type : modtypath -> synterp-action = "1". external symbol end-section : synterp-action = "1". external symbol apply-module-functor : id -> synterp-action = "1". external symbol apply-module-type-functor : id -> synterp-action = "1". external symbol include-module : modpath -> synterp-action = "1". external symbol include-module-type : modtypath -> synterp-action = "1". external symbol import-module : modpath -> synterp-action = "1". external symbol export-module : modpath -> synterp-action = "1". % Synterp action group kind group type. % [coq.next-synterp-action A] Get the next action performed during parsing % (aka synterp), that is also the next action to be performed during % execution (aka interp). See also coq.replay-synterp-action external func coq.next-synterp-action -> synterp-action. % [coq.replay-synterp-action-group ID] Execute all actions of synterp action % group ID. ID must be the name of the next group, it must not be opened % already, and there must not be any actions before it. external func coq.replay-synterp-action-group id. % [coq.begin-synterp-group ID Group] Match a begin-synterp-group synterp % operation. ID must be the name of the next synterp action group and there % must not be any actions before it. external func coq.begin-synterp-group id -> group. % [coq.end-synterp-group Group] Match a end-synterp-group synterp operation. % Group must be the currently opened synterp action group and the group must % not have any more synterp actions or groups left to replay. external func coq.end-synterp-group group. % -- Utils ------------------------------------------------------------ kind coq.gref.set type. % [coq.gref.set.empty A] The empty set external func coq.gref.set.empty -> coq.gref.set. % [coq.gref.set.mem Elem A] Checks if Elem is in a external func coq.gref.set.mem gref, coq.gref.set. % [coq.gref.set.add Elem A B] B is A union {Elem} external func coq.gref.set.add gref, coq.gref.set -> coq.gref.set. % [coq.gref.set.remove Elem A B] B is A \ {Elem} external func coq.gref.set.remove gref, coq.gref.set -> coq.gref.set. % [coq.gref.set.union A B X] X is A union B external func coq.gref.set.union coq.gref.set, coq.gref.set -> coq.gref.set. % [coq.gref.set.inter A B X] X is A intersection B external func coq.gref.set.inter coq.gref.set, coq.gref.set -> coq.gref.set. % [coq.gref.set.diff A B X] X is A \ B external func coq.gref.set.diff coq.gref.set, coq.gref.set -> coq.gref.set. % [coq.gref.set.equal A B] tests A and B for equality external func coq.gref.set.equal coq.gref.set, coq.gref.set. % [coq.gref.set.subset A B] tests if A is a subset of B external func coq.gref.set.subset coq.gref.set, coq.gref.set. % [coq.gref.set.elements M L] L is M transformed into list external func coq.gref.set.elements coq.gref.set -> list gref. % [coq.gref.set.choose M X] X is an element of M external func coq.gref.set.choose coq.gref.set -> gref. % [coq.gref.set.min M X] X is the smallest element of M external func coq.gref.set.min coq.gref.set -> gref. % [coq.gref.set.max M X] X is the bigger of M external func coq.gref.set.max coq.gref.set -> gref. % [coq.gref.set.cardinal M N] N is the number of elements of M external func coq.gref.set.cardinal coq.gref.set -> int. % [coq.gref.set.filter M F M1] Filter M w.r.t. the predicate F external func coq.gref.set.filter coq.gref.set, (gref -> (func)) -> coq.gref.set. % [coq.gref.set.map M F M1] Map M w.r.t. the predicate F external func coq.gref.set.map coq.gref.set, (gref -> gref -> prop) -> coq.gref.set. % [coq.gref.set.fold M Acc F Acc1] fold M w.r.t. the predicate F external func coq.gref.set.fold coq.gref.set, A, (gref -> A -> A -> prop) -> A. % [coq.gref.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1 % is where F holds external func coq.gref.set.partition coq.gref.set, (gref -> (func)) -> coq.gref.set, coq.gref.set. % CAVEAT: the type parameter of coq.gref.map must be a closed term kind coq.gref.map type -> type. % [coq.gref.map.empty M] The empty map external func coq.gref.map.empty -> coq.gref.map A. % [coq.gref.map.mem S M] Checks if S is bound in M external func coq.gref.map.mem gref, coq.gref.map A. % [coq.gref.map.add S V M M1] M1 is M where V is bound to S external func coq.gref.map.add gref, A, coq.gref.map A -> coq.gref.map A. % [coq.gref.map.remove S M M1] M1 is M where S is unbound external func coq.gref.map.remove gref, coq.gref.map A -> coq.gref.map A. % [coq.gref.map.find S M V] V is the binding of S in M external func coq.gref.map.find gref, coq.gref.map A -> A. % [coq.gref.map.bindings M L] L is M transformed into an associative list external func coq.gref.map.bindings coq.gref.map A -> list (pair gref A). % [coq.gref.map.filter M F M1] Filter M w.r.t. the predicate F external func coq.gref.map.filter coq.gref.map A, (gref -> A -> prop) -> coq.gref.map A. % [coq.gref.map.map M F M1] Map M w.r.t. the predicate F external func coq.gref.map.map coq.gref.map A, (gref -> A -> B -> prop) -> coq.gref.map B. % [coq.gref.map.fold M Acc F Acc1] fold M w.r.t. the predicate F external func coq.gref.map.fold coq.gref.map A, C, (gref -> A -> C -> C -> prop) -> C. kind coq.univ.set type. % [coq.univ.set.empty A] The empty set external func coq.univ.set.empty -> coq.univ.set. % [coq.univ.set.mem Elem A] Checks if Elem is in a external func coq.univ.set.mem univ, coq.univ.set. % [coq.univ.set.add Elem A B] B is A union {Elem} external func coq.univ.set.add univ, coq.univ.set -> coq.univ.set. % [coq.univ.set.remove Elem A B] B is A \ {Elem} external func coq.univ.set.remove univ, coq.univ.set -> coq.univ.set. % [coq.univ.set.union A B X] X is A union B external func coq.univ.set.union coq.univ.set, coq.univ.set -> coq.univ.set. % [coq.univ.set.inter A B X] X is A intersection B external func coq.univ.set.inter coq.univ.set, coq.univ.set -> coq.univ.set. % [coq.univ.set.diff A B X] X is A \ B external func coq.univ.set.diff coq.univ.set, coq.univ.set -> coq.univ.set. % [coq.univ.set.equal A B] tests A and B for equality external func coq.univ.set.equal coq.univ.set, coq.univ.set. % [coq.univ.set.subset A B] tests if A is a subset of B external func coq.univ.set.subset coq.univ.set, coq.univ.set. % [coq.univ.set.elements M L] L is M transformed into list external func coq.univ.set.elements coq.univ.set -> list univ. % [coq.univ.set.choose M X] X is an element of M external func coq.univ.set.choose coq.univ.set -> univ. % [coq.univ.set.min M X] X is the smallest element of M external func coq.univ.set.min coq.univ.set -> univ. % [coq.univ.set.max M X] X is the bigger of M external func coq.univ.set.max coq.univ.set -> univ. % [coq.univ.set.cardinal M N] N is the number of elements of M external func coq.univ.set.cardinal coq.univ.set -> int. % [coq.univ.set.filter M F M1] Filter M w.r.t. the predicate F external func coq.univ.set.filter coq.univ.set, (univ -> (func)) -> coq.univ.set. % [coq.univ.set.map M F M1] Map M w.r.t. the predicate F external func coq.univ.set.map coq.univ.set, (univ -> univ -> prop) -> coq.univ.set. % [coq.univ.set.fold M Acc F Acc1] fold M w.r.t. the predicate F external func coq.univ.set.fold coq.univ.set, A, (univ -> A -> A -> prop) -> A. % [coq.univ.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1 % is where F holds external func coq.univ.set.partition coq.univ.set, (univ -> (func)) -> coq.univ.set, coq.univ.set. % CAVEAT: the type parameter of coq.univ.map must be a closed term kind coq.univ.map type -> type. % [coq.univ.map.empty M] The empty map external func coq.univ.map.empty -> coq.univ.map A. % [coq.univ.map.mem S M] Checks if S is bound in M external func coq.univ.map.mem univ, coq.univ.map A. % [coq.univ.map.add S V M M1] M1 is M where V is bound to S external func coq.univ.map.add univ, A, coq.univ.map A -> coq.univ.map A. % [coq.univ.map.remove S M M1] M1 is M where S is unbound external func coq.univ.map.remove univ, coq.univ.map A -> coq.univ.map A. % [coq.univ.map.find S M V] V is the binding of S in M external func coq.univ.map.find univ, coq.univ.map A -> A. % [coq.univ.map.bindings M L] L is M transformed into an associative list external func coq.univ.map.bindings coq.univ.map A -> list (pair univ A). % [coq.univ.map.filter M F M1] Filter M w.r.t. the predicate F external func coq.univ.map.filter coq.univ.map A, (univ -> A -> prop) -> coq.univ.map A. % [coq.univ.map.map M F M1] Map M w.r.t. the predicate F external func coq.univ.map.map coq.univ.map A, (univ -> A -> B -> prop) -> coq.univ.map B. % [coq.univ.map.fold M Acc F Acc1] fold M w.r.t. the predicate F external func coq.univ.map.fold coq.univ.map A, C, (univ -> A -> C -> C -> prop) -> C. kind coq.univ.variable.set type. % [coq.univ.variable.set.empty A] The empty set external func coq.univ.variable.set.empty -> coq.univ.variable.set. % [coq.univ.variable.set.mem Elem A] Checks if Elem is in a external func coq.univ.variable.set.mem univ.variable, coq.univ.variable.set. % [coq.univ.variable.set.add Elem A B] B is A union {Elem} external func coq.univ.variable.set.add univ.variable, coq.univ.variable.set -> coq.univ.variable.set. % [coq.univ.variable.set.remove Elem A B] B is A \ {Elem} external func coq.univ.variable.set.remove univ.variable, coq.univ.variable.set -> coq.univ.variable.set. % [coq.univ.variable.set.union A B X] X is A union B external func coq.univ.variable.set.union coq.univ.variable.set, coq.univ.variable.set -> coq.univ.variable.set. % [coq.univ.variable.set.inter A B X] X is A intersection B external func coq.univ.variable.set.inter coq.univ.variable.set, coq.univ.variable.set -> coq.univ.variable.set. % [coq.univ.variable.set.diff A B X] X is A \ B external func coq.univ.variable.set.diff coq.univ.variable.set, coq.univ.variable.set -> coq.univ.variable.set. % [coq.univ.variable.set.equal A B] tests A and B for equality external func coq.univ.variable.set.equal coq.univ.variable.set, coq.univ.variable.set. % [coq.univ.variable.set.subset A B] tests if A is a subset of B external func coq.univ.variable.set.subset coq.univ.variable.set, coq.univ.variable.set. % [coq.univ.variable.set.elements M L] L is M transformed into list external func coq.univ.variable.set.elements coq.univ.variable.set -> list univ.variable. % [coq.univ.variable.set.choose M X] X is an element of M external func coq.univ.variable.set.choose coq.univ.variable.set -> univ.variable. % [coq.univ.variable.set.min M X] X is the smallest element of M external func coq.univ.variable.set.min coq.univ.variable.set -> univ.variable. % [coq.univ.variable.set.max M X] X is the bigger of M external func coq.univ.variable.set.max coq.univ.variable.set -> univ.variable. % [coq.univ.variable.set.cardinal M N] N is the number of elements of M external func coq.univ.variable.set.cardinal coq.univ.variable.set -> int. % [coq.univ.variable.set.filter M F M1] Filter M w.r.t. the predicate F external func coq.univ.variable.set.filter coq.univ.variable.set, (univ.variable -> (func)) -> coq.univ.variable.set. % [coq.univ.variable.set.map M F M1] Map M w.r.t. the predicate F external func coq.univ.variable.set.map coq.univ.variable.set, (univ.variable -> univ.variable -> prop) -> coq.univ.variable.set. % [coq.univ.variable.set.fold M Acc F Acc1] fold M w.r.t. the predicate F external func coq.univ.variable.set.fold coq.univ.variable.set, A, (univ.variable -> A -> A -> prop) -> A. % [coq.univ.variable.set.partition M F M1 M2] Partitions M w.r.t. the % predicate F, M1 is where F holds external func coq.univ.variable.set.partition coq.univ.variable.set, (univ.variable -> (func)) -> coq.univ.variable.set, coq.univ.variable.set. % CAVEAT: the type parameter of coq.univ.variable.map must be a closed % term kind coq.univ.variable.map type -> type. % [coq.univ.variable.map.empty M] The empty map external func coq.univ.variable.map.empty -> coq.univ.variable.map A. % [coq.univ.variable.map.mem S M] Checks if S is bound in M external func coq.univ.variable.map.mem univ.variable, coq.univ.variable.map A. % [coq.univ.variable.map.add S V M M1] M1 is M where V is bound to S external func coq.univ.variable.map.add univ.variable, A, coq.univ.variable.map A -> coq.univ.variable.map A. % [coq.univ.variable.map.remove S M M1] M1 is M where S is unbound external func coq.univ.variable.map.remove univ.variable, coq.univ.variable.map A -> coq.univ.variable.map A. % [coq.univ.variable.map.find S M V] V is the binding of S in M external func coq.univ.variable.map.find univ.variable, coq.univ.variable.map A -> A. % [coq.univ.variable.map.bindings M L] L is M transformed into an % associative list external func coq.univ.variable.map.bindings coq.univ.variable.map A -> list (pair univ.variable A). % [coq.univ.variable.map.filter M F M1] Filter M w.r.t. the predicate F external func coq.univ.variable.map.filter coq.univ.variable.map A, (univ.variable -> A -> prop) -> coq.univ.variable.map A. % [coq.univ.variable.map.map M F M1] Map M w.r.t. the predicate F external func coq.univ.variable.map.map coq.univ.variable.map A, (univ.variable -> A -> B -> prop) -> coq.univ.variable.map B. % [coq.univ.variable.map.fold M Acc F Acc1] fold M w.r.t. the predicate F external func coq.univ.variable.map.fold coq.univ.variable.map A, C, (univ.variable -> A -> C -> C -> prop) -> C. % Coq box types for pretty printing: % - Vertical block: each break leads to a new line % - Horizontal block: no line breaking % - Horizontal-vertical block: same as Vertical block, except if this block % is small enough to fit on a single line in which case it is the same % as a Horizontal block % - Horizontal or Vertical block: breaks lead to new line only when % necessary to print the content of the block (the contents flow % inside the box) kind coq.pp.box type. external symbol coq.pp.v : int -> coq.pp.box = "1". external symbol coq.pp.h : coq.pp.box = "1". external symbol coq.pp.hv : int -> coq.pp.box = "1". external symbol coq.pp.hov : int -> coq.pp.box = "1". % Coq box model for pretty printing. Items: % - empty % - spc: a spacem, also a breaking hint % - str: a non breakable string % - brk L I: a breaking hint of a given length L contributing I spaces to % indentation when taken % - glue: puts things together % - box B: a box with automatic line breaking according to B % - comment: embedded \\n are turned into nl (see below) % - tag: ignored % - nl: break the line (should not be used) kind coq.pp type. external symbol coq.pp.empty : coq.pp = "1". external symbol coq.pp.spc : coq.pp = "1". external symbol coq.pp.str : string -> coq.pp = "1". external symbol coq.pp.brk : int -> int -> coq.pp = "1". external symbol coq.pp.glue : list coq.pp -> coq.pp = "1". external symbol coq.pp.box : coq.pp.box -> list coq.pp -> coq.pp = "1". external symbol coq.pp.comment : list string -> coq.pp = "1". external symbol coq.pp.tag : string -> coq.pp -> coq.pp = "1". external symbol coq.pp.nl : coq.pp = "1". % [coq.pp->string B S] Prints a pp.t box expression B to a string S % Supported attributes: % - @ppwidth! N (default 80, max line length) external func coq.pp->string coq.pp -> string. LPCIC-coq-elpi-eb449d7/builtin-doc/dune000066400000000000000000000005071523041753400175740ustar00rootroot00000000000000(executable (name gen_doc) (libraries elpi_plugin)) (rule (targets coq-builtin.elpi coq-builtin-synterp.elpi elpi-builtin.elpi) (deps gen_doc.exe) (mode promote) (action (run ./gen_doc.exe))) (install (files coq-builtin.elpi coq-builtin-synterp.elpi elpi-builtin.elpi) (section doc) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/builtin-doc/elpi-builtin.elpi000066400000000000000000001525201523041753400221710ustar00rootroot00000000000000 % File generated by elpi -document-builtins, do not edit % == Core builtins ===================================== % -- Logic -- func true. true. func fail. func false. % [X = T] unifies X with Y, possibly assigning unification % variables in X and Y. external func (=) -> A, A. % [pattern_matching T P] matches T against pattern P, only % variables in P are assigned. external func pattern_match A -> A. external func (pi) (func A). external func (sigma) (func A). kind int type. kind string type. kind float type. external symbol (;) (pred) -> (pred) -> (pred). (A ; _) :- A. (_ ; B) :- B. external symbol (:-) : (func) -> (func) -> (func) = "core". external symbol (:-) : (func) -> list (pred) -> (func) = "core". external symbol (,) : variadic (func) (func). external symbol uvar : A = "core". external symbol (as) : A -> A -> A = "core". external symbol (=>) : (pred) -> (func) -> (func) = "core". external symbol (=>) : list (pred) -> (func) -> (func) = "core". external symbol (==>) : (pred) -> (func) -> (func). external symbol (==>) : list (pred) -> (func) -> (func). % -- Control -- external func !. % The cut operator func not prop. not X :- X, !, fail. not _. % [declare_constraint C Key1 Key2...] declares C blocked % on Key1 Key2 ... (variables, or lists thereof). external func declare_constraint (func) -> any .. . % [print_constraints] prints all constraints external func print_constraints. % [halt ...] halts the program and print the terms external type halt variadic any (func). func stop. stop :- halt. % -- Evaluation -- :functional pred (is) o:A, i:A. X is Y :- calc Y X. % [calc Expr Out] unifies Out with the value of Expr. It can be used in % tandem with spilling, eg [f {calc (N + 1)}] external func calc A -> A. % --- Operators --- external symbol (-) : A -> A -> A = "1". external symbol (i-) : int -> int -> int = "1". external symbol (r-) : float -> float -> float = "1". external symbol (+) : float -> float -> float = "2". external symbol (+) : int -> int -> int = "1". external symbol (i+) : int -> int -> int = "1". external symbol (r+) : float -> float -> float = "1". external symbol (*) : float -> float -> float = "2". external symbol (*) : int -> int -> int = "1". external symbol (/) : float -> float -> float = "1". external symbol (mod) : int -> int -> int = "1". external symbol (div) : int -> int -> int = "1". external symbol (^) : string -> string -> string = "1". external symbol (~) : float -> float = "2". external symbol (~) : int -> int = "1". external symbol (i~) : int -> int = "1". external symbol (r~) : float -> float = "1". external symbol abs : float -> float = "2". external symbol abs : int -> int = "1". external symbol iabs : int -> int = "1". external symbol rabs : float -> float = "1". external symbol max : float -> float -> float = "2". external symbol max : int -> int -> int = "1". external symbol min : float -> float -> float = "2". external symbol min : int -> int -> int = "1". external symbol sqrt : float -> float = "1". external symbol sin : float -> float = "1". external symbol cos : float -> float = "1". external symbol arctan : float -> float = "1". external symbol ln : float -> float = "1". external symbol int_to_real : int -> float = "1". external symbol floor : float -> int = "1". external symbol ceil : float -> int = "1". external symbol truncate : float -> int = "1". external symbol size : string -> int = "1". external symbol chr : int -> string = "1". external symbol rhc : string -> int = "1". external symbol string_to_int : string -> int = "1". external symbol int_to_string : int -> string = "1". external symbol substring : string -> int -> int -> string = "1". external symbol real_to_string : float -> string = "1". % -- Arithmetic tests -- % [lt_ X Y] checks if X < Y. Works for string, int and float external func lt_ A, A. % [gt_ X Y] checks if X > Y. Works for string, int and float external func gt_ A, A. % [le_ X Y] checks if X =< Y. Works for string, int and float external func le_ A, A. % [ge_ X Y] checks if X >= Y. Works for string, int and float external func ge_ A, A. func (>) A, A. X > Y :- gt_ X Y. func (<) A, A. X < Y :- lt_ X Y. func (=<) A, A. X =< Y :- le_ X Y. func (>=) A, A. X >= Y :- ge_ X Y. func (i>) int, int. X i> Y :- gt_ X Y. func (i<) int, int. X i< Y :- lt_ X Y. func (i=<) int, int. X i=< Y :- le_ X Y. func (i>=) int, int. X i>= Y :- ge_ X Y. func (r>) float, float. X r> Y :- gt_ X Y. func (r<) float, float. X r< Y :- lt_ X Y. func (r=<) float, float. X r=< Y :- le_ X Y. func (r>=) float, float. X r>= Y :- ge_ X Y. func (s>) string, string. X s> Y :- gt_ X Y. func (s<) string, string. X s< Y :- lt_ X Y. func (s=<) string, string. X s=< Y :- le_ X Y. func (s>=) string, string. X s>= Y :- ge_ X Y. % -- Standard data types (supported in the FFI) -- kind list type -> type. external symbol (::) : X -> list X -> list X = "core". external symbol ([]) : list X = "core". % Boolean values: tt and ff since true and false are predicates kind bool type. external symbol tt : bool = "1". external symbol ff : bool = "1". % Pair: the constructor is pr, since ',' is for conjunction kind pair type -> type -> type. external symbol pr : A -> B -> pair A B = "1". func fst pair A B -> A. fst (pr A _) A. func snd pair A B -> B. snd (pr _ B) B. kind triple type -> type -> type -> type. type triple A -> B -> C -> triple A B C. func triple_1 triple A B C -> A. triple_1 (triple A _ _) A. func triple_2 triple A B C -> B. triple_2 (triple _ B _) B. func triple_3 triple A B C -> C. triple_3 (triple _ _ C) C. % The option type (aka Maybe) kind option type -> type. external symbol none : option A = "1". external symbol some : A -> option A = "1". % Result of a comparison kind cmp type. external symbol eq : cmp = "1". external symbol lt : cmp = "1". external symbol gt : cmp = "1". % Used in builtin variants that return Coq's error rather than failing kind diagnostic type. external symbol ok : diagnostic = "1". % Success external symbol error : string -> diagnostic = "1". % Failure % == Elpi builtins ===================================== % [dprint ...] prints raw terms (debugging) external type dprint variadic any (func). % [print ...] prints terms external type print variadic any (func). % Deprecated, use trace.counter func counter string -> int. counter C N :- trace.counter C N. kind loc type. % [loc.fields Loc File StartChar StopChar Line LineStartsAtChar] Decomposes % a loc into its fields external func loc.fields loc -> string, int, int, int, int. % == Regular Expressions ===================================== % [rex.match Rex Subject] checks if Subject matches Rex. Matching is based % on OCaml's Str library external func rex.match string, string. % [rex.replace Rex Replacement Subject Out] Out is obtained by replacing all % occurrences of Rex with Replacement in Subject. See also OCaml's % Str.global_replace external func rex.replace string, string, string -> string. % [rex.split Rex Subject Out] Out is obtained by splitting Subject at all % occurrences of Rex. See also OCaml's Str.split external func rex.split string, string -> list string. % Deprecated, use rex.match func rex_match string, string. rex_match Rx S :- rex.match Rx S. % Deprecated, use rex.replace func rex_replace string, string, string -> string. rex_replace Rx R S O :- rex.replace Rx R S O. % Deprecated, use rex.split func rex_split string, string -> list string. rex_split Rx S L :- rex.split Rx S L. % == Elpi nonlogical builtins ===================================== % [var V ...] checks if the term V is a variable. When used with tree % arguments it relates an applied variable with its head and argument list. external func var -> any, any.. . % [prune V L] V is pruned to L (V is unified with a variable that only sees % the list of names L) :functional :external pred prune o:any, i:list any. % [distinct_names L] checks if L is a list of distinct names. If L is the % scope of a unification variable (its arguments, as per var predicate) then % distinct_names L checks that such variable is in the Miller pattern % fragment (L_\lambda) external func distinct_names list any. % [same_var V1 V2] checks if the two terms V1 and V2 are the same variable, % ignoring the arguments of the variables external func same_var A, A. % [same_term T1 T2] checks if the two terms T1 and T2 are syntactically % equal (no unification). It behaves differently than same_var since it % recursively compares the arguments of the variables external func same_term A, A. % Infix notation for same_term func (==) A, A. X == Y :- same_term X Y. % Unification without occur check. It can create infinite terms. :nooc func unsound_unif -> A, A. unsound_unif X X. % [cmp_term A B Cmp] Compares A and B. Only works if A and B are ground. external func cmp_term any, any -> cmp. % [name T ...] checks if T is a eigenvariable. When used with tree arguments % it relates an applied name with its head and argument list. external func name -> any, any.. . % [constant T ...] checks if T is a (global) constant. When used with tree % arguments it relates an applied constant with its head and argument list. external func constant -> any, any.. . external func names % generates the list of eigenvariable -> list any. % list of eigenvariables in order of age (young first) external func occurs % checks if the atom occurs in the term any, % an atom, that is a global constant or a bound name (aka eigenvariable) any. % a term % [closed_term T] unify T with a variable that has no eigenvariables in % scope external func closed_term -> any. % [ground_term T] Checks if T contains unification variables external func ground_term any. % [is_cdata T Ctype] checks if T is primitive of type Ctype, eg "int" external func is_cdata any -> string. func primitive? any, string. primitive? X S :- is_cdata X S. % [new_int N] unifies N with a different int every time it is called. Values % of N are guaranteed to be incresing. external func new_int -> int. % [findall_solution P L] finds all the solved instances of P and puts them % in L in the order in which they are found. Instances can contain % eigenvariables and unification variables. P may or may not be % instantiated. Instances should be found in L. external func findall_solutions prop -> list prop. % Holds data across bracktracking; can only contain closed terms kind safe type. % [new_safe Safe] creates a safe: a store that persists across backtracking external func new_safe -> safe. % [stash_in_safe Safe Data] stores Data in the Safe external func stash_in_safe safe, A. % [open_safe Safe Data] retrieves the Data stored in Safe external func open_safe safe -> list A. % [if C T E] picks the first success of C then runs T (never E). % if C has no success it runs E. func if (pred), (func), (func). if B T _ :- B, !, T. if _ _ E :- E. % [if2 C1 B1 C2 B2 E] like if but with 2 then branches (and one else branch). func if2 (pred), (func), (pred), (func), (func). if2 G1 P1 _ _ _ :- G1, !, P1. if2 _ _ G2 P2 _ :- G2, !, P2. if2 _ _ _ _ E :- !, E. % [random.init Seed] Initialize OCaml's PRNG with the given Seed external func random.init int. % [random.self_init] Initialize OCaml's PRNG with some seed external func random.self_init. % [random.int Bound N] unifies N with a random int between 0 and Bound % (excluded) external func random.int int -> int. #line 1 "builtin_stdlib.elpi" % == stdlib ======================================================= % Conventions: % - all predicates declare a mode with some input arguments, unless... % - predicates whose name ends with R are relations (work in any direction, % that is all arguments are in output mode) % - predicates whose name ends with ! do contain a cut and generate only the % first result % - all errors given by this library end up calling fatal-error[-w-data], % override it in order to handle them differently % - all debug prints by this library end up calling debug-print, override it % in order to handle them differently namespace std { func fatal-error string. :name "default-fatal-error" fatal-error Msg :- halt Msg. func fatal-error-w-data string, any. :name "default-fatal-error-w-data" fatal-error-w-data Msg Data :- halt Msg ":" Data. func debug-print string, any. :name "default-debug-print" debug-print Msg Data :- print Msg Data. % -- Errors, Debugging, Hacks -- func ignore-failure! prop ->. ignore-failure! P :- P, !. ignore-failure! _. func once prop ->. once P :- P, !. % [assert! C M] takes the first success of C or fails with message M func assert! prop, string. assert! Cond Msg :- (Cond ; fatal-error-w-data Msg Cond), !. % [assert-ok! C M] like assert! but the last argument of the predicate must % be a diagnostic that is printed after M in case it is not ok func assert-ok! (pred o:diagnostic), string. assert-ok! Cond Msg :- Cond Diagnostic, !, (Diagnostic = ok ; Diagnostic = error S, fatal-error-w-data Msg S), !. assert-ok! _ Msg :- fatal-error-w-data Msg "no diagnostic returned". % [spy P] traces the call to P, printing all success and the final failure pred spy (pred). spy P :- trace.counter "run" NR, if (not(NR = 0)) (debug-print "run=" NR) true, debug-print "----<<---- enter: " P, P, debug-print "---->>---- exit: " P. spy P :- debug-print "---->>---- fail: " P, fail. % [spy! P] traces the first call to P without leaving a choice point func spy! prop. spy! P :- trace.counter "run" NR, if (not(NR = 0)) (debug-print "run=" NR) true, debug-print "----<<---- enter: " P, P, debug-print "---->>---- exit: " P, !. spy! P :- debug-print "---->>---- fail: " P, fail. % to silence the type checker func unsafe-cast A -> B. :untyped unsafe-cast X X. % -- List processing -- func length list A -> int. length [_|L] N :- length L N1, N is N1 + 1. length [] 0. func rev list A -> list A. rev L RL :- rev-append L [] RL. func rev-append list A, list A -> list A. rev-append [X|XS] ACC R :- rev-append XS [X|ACC] R. rev-append [] L L. func rev.aux list A, list A -> list A. rev.aux L1 L2 L3 :- rev-append L1 L2 L3. func last list A -> A. last [] _ :- fatal-error "last on empty list". last [X] X :- !. last [_|XS] R :- last XS R. func append list A, list A -> list A. append [X|XS] L [X|L1] :- append XS L L1 . append [] L L . pred appendR -> list A, list A, list A. appendR [] L L. appendR [X|XS] L [X|L1] :- appendR XS L L1. func take int, list A -> list A. take 0 _ [] :- !. take N [X|XS] [X|L] :- !, N1 is N - 1, take N1 XS L. take _ _ _ :- fatal-error "take run out of list items". func take-last int, list A -> list A. take-last N L R :- length L M, D is M - N, drop D L R. func drop int, list A -> list A. drop 0 L L :- !. drop N [_|XS] L :- !, N1 is N - 1, drop N1 XS L. drop _ _ _ :- fatal-error "drop run out of list items". func drop-last int, list A -> list A. drop-last N L R :- length L M, I is M - N, take I L R. func split-at int, list A -> list A, list A. split-at 0 L [] L :- !. split-at N [X|XS] [X|LN] LM :- !, N1 is N - 1, split-at N1 XS LN LM. split-at _ _ _ _ :- fatal-error "split-at run out of list items". func fold list B, A, (func B, A -> A) -> A. fold [] A _ A. fold [X|XS] A F R :- F X A A1, fold XS A1 F R. func fold-right list B, A, (func B, A -> A) -> A. fold-right [] A _ A. fold-right [X|XS] A F R :- fold-right XS A F A', F X A' R. :index (1 1) func fold2 list C, list B, A, (func C, B, A -> A) -> A. fold2 [] [_|_] _ _ _ :- fatal-error "fold2 on lists of different length". fold2 [_|_] [] _ _ _ :- fatal-error "fold2 on lists of different length". fold2 [] [] A _ A. fold2 [X|XS] [Y|YS] A F R :- F X Y A A1, fold2 XS YS A1 F R. func map list A, (func A -> B) -> list B. map [] _ []. map [X|XS] F [Y|YS] :- F X Y, map XS F YS. func map-i list A, (func int, A -> B) -> list B. map-i L F R :- map-i.aux L 0 F R. func map-i.aux list A, int, (func int, A -> B) -> list B. map-i.aux [] _ _ []. map-i.aux [X|XS] N F [Y|YS] :- F N X Y, M is N + 1, map-i.aux XS M F YS. func map-filter list A, (func A -> B) -> list B. map-filter [] _ []. map-filter [X|XS] F [Y|YS] :- F X Y, !, map-filter XS F YS. map-filter [_|XS] F YS :- map-filter XS F YS. :index(1 1) func map2 list A, list B, (func A, B -> C) -> list C. map2 [] [_|_] _ _ :- fatal-error "map2 on lists of different length". map2 [_|_] [] _ _ :- fatal-error "map2 on lists of different length". map2 [] [] _ []. map2 [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, map2 XS YS F ZS. func map2-filter list A, list B, (func A, B -> C) -> list C. map2-filter [] [_|_] _ _ :- fatal-error "map2-filter on lists of different length". map2-filter [_|_] [] _ _ :- fatal-error "map2-filter on lists of different length". map2-filter [] [] _ []. map2-filter [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, !, map2-filter XS YS F ZS. map2-filter [_|XS] [_|YS] F ZS :- map2-filter XS YS F ZS. func map-ok list A, (func A -> B, diagnostic) -> list B, diagnostic. map-ok [X|L] P [Y|YS] S :- P X Y S0, if (S0 = ok) (map-ok L P YS S) (S = S0). map-ok [] _ [] ok. func fold-map list A, B, (func A, B -> C, B) -> list C, B. fold-map [] A _ [] A. fold-map [X|XS] A F [Y|YS] A2 :- F X A Y A1, fold-map XS A1 F YS A2. func omap option A, (func A -> B) -> option B. omap none _ none. omap (some X) F (some Y) :- F X Y. % [nth N L X] picks in X the N-th element of L (L must be of length > N) func nth int, list A -> A. nth 0 [X|_ ] R :- !, X = R. nth N [_|XS] R :- N > 0, !, N1 is N - 1, nth N1 XS R. nth N _ _ :- N < 0, !, fatal-error "nth got a negative index". nth _ _ _ :- fatal-error "nth run out of list items". % [lookup L K V] sees L as a map from K to V pred lookup list (pair A B), A -> B. lookup [pr X Y|_] X Y. lookup [_|LS] X Y :- lookup LS X Y. % [lookup! L K V] sees L as a map from K to V, stops at the first binding func lookup! list (pair A B), A -> B. lookup! [pr X Y|_] X Y :- !. lookup! [_|LS] X Y :- lookup! LS X Y. % [mem! L X] succeeds once if X occurs inside L func mem! list A, A ->. mem! [X|_] X :- !. mem! [_|L] X :- mem! L X. % [mem L X] succeeds every time if X occurs inside L pred mem list A -> A. mem [X|_] X. mem [_|L] X :- mem L X. func exists! list A, (pred A). exists! [X| _] P :- P X, !. exists! [_|XS] P :- exists! XS P. pred exists list A, (pred A). exists [X|_] P :- P X. exists [_|L] P :- exists L P. pred exists2 list A, list B, (pred A, B). exists2 [] [_|_] _ :- fatal-error "exists2 on lists of different length". exists2 [_|_] [] _ :- fatal-error "exists2 on lists of different length". exists2 [X|_] [Y|_] P :- P X Y. exists2 [_|L] [_|M] P :- exists2 L M P. func forall list A, (func A). forall [] _. forall [X|L] P :- P X, forall L P. func forall-ok list A, (func A -> diagnostic) -> diagnostic. forall-ok [X|L] P S :- P X S0, if (S0 = ok) (forall-ok L P S) (S = S0). forall-ok [] _ ok. func forall2 list A, list B, (func A, B). forall2 [] [_|_] _ :- fatal-error "forall2 on lists of different length". forall2 [_|_] [] _ :- fatal-error "forall2 on lists of different length". forall2 [X|XS] [Y|YS] P :- P X Y, forall2 XS YS P. forall2 [] [] _. func filter list A, (func A) -> list A. filter [] _ []. filter [X|L] P R :- if (P X) (R = X :: L1) (R = L1), filter L P L1. :index (1) func partition list A, (pred A) -> list A, list A. partition [] _ [] []. partition [X|XS] P [X|R] L :- P X, !, partition XS P R L. partition [X|XS] P R [X|L] :- partition XS P R L. func zip list A, list B -> list (pair A B). zip [_|_] [] _ :- fatal-error "zip on lists of different length". zip [] [_|_] _ :- fatal-error "zip on lists of different length". zip [X|LX] [Y|LY] [pr X Y|LR] :- zip LX LY LR. zip [] [] []. func unzip list (pair A B) -> list A, list B. unzip [] [] []. unzip [pr X Y|L] [X|LX] [Y|LY] :- unzip L LX LY. func flatten list (list A) -> list A. flatten [X|LS] R :- flatten LS LS', append X LS' R. flatten [] []. func null list A. null []. % [make N E L] L is [E, ..., E] and L has length N func list.make int, A -> list A. list.make 0 _ [] :- !. list.make N E [E|L] :- N' is N - 1, list.make N' E L. % [init N F L] L is [F 0, ..., F (N-1)] func list.init int, (func int -> A) -> list A. list.init N F L :- assert! (N >= 0) ("list.init: negative length"), list.init.aux 0 N F L. func list.init.aux int, int, (func int -> A) -> list A. list.init.aux N N _ [] :- !. list.init.aux N M F [E|L] :- F N E, N' is N + 1, list.init.aux N' M F L. func iota int -> list int. iota N L :- list.init N (x\y\ x = y) L. % [intersperse X L R] R is [L0, X, ..., X, LN] :index(_ 1) func intersperse A, list A -> list A. intersperse _ [] []. intersperse _ [X] [X] :- !. intersperse Sep [X|XS] [X,Sep|YS] :- intersperse Sep XS YS. % -- Misc -- func flip (func A, B), B, A. flip P X Y :- P Y X. func time (func) -> float. time P T :- gettimeofday Before, P, gettimeofday After, T is After - Before. func do! list prop. do! []. do! [P|PS] :- P, !, do! PS. :index(_ 1) :functional pred do-ok! o:diagnostic, i:list (pred o:diagnostic). do-ok! ok []. do-ok! S [P|PS] :- P S0, !, if (S0 = ok) (do-ok! S PS) (S = S0). pred lift-ok (pred), string -> diagnostic. lift-ok P Msg R :- (P, R = ok; R = error Msg). func spy-do! list prop. spy-do! L :- map L (x\y\y = spy x) L1, do! L1. func while-ok-do! diagnostic, list (pred -> diagnostic) -> diagnostic. while-ok-do! (error _ as E) _ E. while-ok-do! ok [] ok. while-ok-do! ok [P|PS] R :- P C, !, while-ok-do! C PS R. func any->string A -> string. any->string X Y :- term_to_string X Y. func max A, A -> A. max N M N :- N >= M, !. max _ M M. % [findall P L] L is the list [P1,P2,P3..] where each Pi is a solution to P. func findall prop -> list prop. findall P L :- findall_solutions P L. } % [std.string.concat Separator Items Result] concatenates Items % interspersing Separator external func std.string.concat string, list string -> string. % CAVEAT: the type parameter of std.string.map must be a closed term kind std.string.map type -> type. % [std.string.map.empty M] The empty map external func std.string.map.empty -> std.string.map A. % [std.string.map.mem S M] Checks if S is bound in M external func std.string.map.mem string, std.string.map A. % [std.string.map.add S V M M1] M1 is M where V is bound to S external func std.string.map.add string, A, std.string.map A -> std.string.map A. % [std.string.map.remove S M M1] M1 is M where S is unbound external func std.string.map.remove string, std.string.map A -> std.string.map A. % [std.string.map.find S M V] V is the binding of S in M external func std.string.map.find string, std.string.map A -> A. % [std.string.map.bindings M L] L is M transformed into an associative list external func std.string.map.bindings std.string.map A -> list (pair string A). % [std.string.map.filter M F M1] Filter M w.r.t. the predicate F external func std.string.map.filter std.string.map A, (string -> A -> prop) -> std.string.map A. % [std.string.map.map M F M1] Map M w.r.t. the predicate F external func std.string.map.map std.string.map A, (string -> A -> B -> prop) -> std.string.map B. % [std.string.map.fold M Acc F Acc1] fold M w.r.t. the predicate F external func std.string.map.fold std.string.map A, C, (string -> A -> C -> C -> prop) -> C. % CAVEAT: the type parameter of std.int.map must be a closed term kind std.int.map type -> type. % [std.int.map.empty M] The empty map external func std.int.map.empty -> std.int.map A. % [std.int.map.mem S M] Checks if S is bound in M external func std.int.map.mem int, std.int.map A. % [std.int.map.add S V M M1] M1 is M where V is bound to S external func std.int.map.add int, A, std.int.map A -> std.int.map A. % [std.int.map.remove S M M1] M1 is M where S is unbound external func std.int.map.remove int, std.int.map A -> std.int.map A. % [std.int.map.find S M V] V is the binding of S in M external func std.int.map.find int, std.int.map A -> A. % [std.int.map.bindings M L] L is M transformed into an associative list external func std.int.map.bindings std.int.map A -> list (pair int A). % [std.int.map.filter M F M1] Filter M w.r.t. the predicate F external func std.int.map.filter std.int.map A, (int -> A -> prop) -> std.int.map A. % [std.int.map.map M F M1] Map M w.r.t. the predicate F external func std.int.map.map std.int.map A, (int -> A -> B -> prop) -> std.int.map B. % [std.int.map.fold M Acc F Acc1] fold M w.r.t. the predicate F external func std.int.map.fold std.int.map A, C, (int -> A -> C -> C -> prop) -> C. % CAVEAT: the type parameter of std.loc.map must be a closed term kind std.loc.map type -> type. % [std.loc.map.empty M] The empty map external func std.loc.map.empty -> std.loc.map A. % [std.loc.map.mem S M] Checks if S is bound in M external func std.loc.map.mem loc, std.loc.map A. % [std.loc.map.add S V M M1] M1 is M where V is bound to S external func std.loc.map.add loc, A, std.loc.map A -> std.loc.map A. % [std.loc.map.remove S M M1] M1 is M where S is unbound external func std.loc.map.remove loc, std.loc.map A -> std.loc.map A. % [std.loc.map.find S M V] V is the binding of S in M external func std.loc.map.find loc, std.loc.map A -> A. % [std.loc.map.bindings M L] L is M transformed into an associative list external func std.loc.map.bindings std.loc.map A -> list (pair loc A). % [std.loc.map.filter M F M1] Filter M w.r.t. the predicate F external func std.loc.map.filter std.loc.map A, (loc -> A -> prop) -> std.loc.map A. % [std.loc.map.map M F M1] Map M w.r.t. the predicate F external func std.loc.map.map std.loc.map A, (loc -> A -> B -> prop) -> std.loc.map B. % [std.loc.map.fold M Acc F Acc1] fold M w.r.t. the predicate F external func std.loc.map.fold std.loc.map A, C, (loc -> A -> C -> C -> prop) -> C. kind std.string.set type. % [std.string.set.empty A] The empty set external func std.string.set.empty -> std.string.set. % [std.string.set.mem Elem A] Checks if Elem is in a external func std.string.set.mem string, std.string.set. % [std.string.set.add Elem A B] B is A union {Elem} external func std.string.set.add string, std.string.set -> std.string.set. % [std.string.set.remove Elem A B] B is A \ {Elem} external func std.string.set.remove string, std.string.set -> std.string.set. % [std.string.set.union A B X] X is A union B external func std.string.set.union std.string.set, std.string.set -> std.string.set. % [std.string.set.inter A B X] X is A intersection B external func std.string.set.inter std.string.set, std.string.set -> std.string.set. % [std.string.set.diff A B X] X is A \ B external func std.string.set.diff std.string.set, std.string.set -> std.string.set. % [std.string.set.equal A B] tests A and B for equality external func std.string.set.equal std.string.set, std.string.set. % [std.string.set.subset A B] tests if A is a subset of B external func std.string.set.subset std.string.set, std.string.set. % [std.string.set.elements M L] L is M transformed into list external func std.string.set.elements std.string.set -> list string. % [std.string.set.choose M X] X is an element of M external func std.string.set.choose std.string.set -> string. % [std.string.set.min M X] X is the smallest element of M external func std.string.set.min std.string.set -> string. % [std.string.set.max M X] X is the bigger of M external func std.string.set.max std.string.set -> string. % [std.string.set.cardinal M N] N is the number of elements of M external func std.string.set.cardinal std.string.set -> int. % [std.string.set.filter M F M1] Filter M w.r.t. the predicate F external func std.string.set.filter std.string.set, (string -> (func)) -> std.string.set. % [std.string.set.map M F M1] Map M w.r.t. the predicate F external func std.string.set.map std.string.set, (string -> string -> prop) -> std.string.set. % [std.string.set.fold M Acc F Acc1] fold M w.r.t. the predicate F external func std.string.set.fold std.string.set, A, (string -> A -> A -> prop) -> A. % [std.string.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, % M1 is where F holds external func std.string.set.partition std.string.set, (string -> (func)) -> std.string.set, std.string.set. kind std.int.set type. % [std.int.set.empty A] The empty set external func std.int.set.empty -> std.int.set. % [std.int.set.mem Elem A] Checks if Elem is in a external func std.int.set.mem int, std.int.set. % [std.int.set.add Elem A B] B is A union {Elem} external func std.int.set.add int, std.int.set -> std.int.set. % [std.int.set.remove Elem A B] B is A \ {Elem} external func std.int.set.remove int, std.int.set -> std.int.set. % [std.int.set.union A B X] X is A union B external func std.int.set.union std.int.set, std.int.set -> std.int.set. % [std.int.set.inter A B X] X is A intersection B external func std.int.set.inter std.int.set, std.int.set -> std.int.set. % [std.int.set.diff A B X] X is A \ B external func std.int.set.diff std.int.set, std.int.set -> std.int.set. % [std.int.set.equal A B] tests A and B for equality external func std.int.set.equal std.int.set, std.int.set. % [std.int.set.subset A B] tests if A is a subset of B external func std.int.set.subset std.int.set, std.int.set. % [std.int.set.elements M L] L is M transformed into list external func std.int.set.elements std.int.set -> list int. % [std.int.set.choose M X] X is an element of M external func std.int.set.choose std.int.set -> int. % [std.int.set.min M X] X is the smallest element of M external func std.int.set.min std.int.set -> int. % [std.int.set.max M X] X is the bigger of M external func std.int.set.max std.int.set -> int. % [std.int.set.cardinal M N] N is the number of elements of M external func std.int.set.cardinal std.int.set -> int. % [std.int.set.filter M F M1] Filter M w.r.t. the predicate F external func std.int.set.filter std.int.set, (int -> (func)) -> std.int.set. % [std.int.set.map M F M1] Map M w.r.t. the predicate F external func std.int.set.map std.int.set, (int -> int -> prop) -> std.int.set. % [std.int.set.fold M Acc F Acc1] fold M w.r.t. the predicate F external func std.int.set.fold std.int.set, A, (int -> A -> A -> prop) -> A. % [std.int.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1 % is where F holds external func std.int.set.partition std.int.set, (int -> (func)) -> std.int.set, std.int.set. kind std.loc.set type. % [std.loc.set.empty A] The empty set external func std.loc.set.empty -> std.loc.set. % [std.loc.set.mem Elem A] Checks if Elem is in a external func std.loc.set.mem loc, std.loc.set. % [std.loc.set.add Elem A B] B is A union {Elem} external func std.loc.set.add loc, std.loc.set -> std.loc.set. % [std.loc.set.remove Elem A B] B is A \ {Elem} external func std.loc.set.remove loc, std.loc.set -> std.loc.set. % [std.loc.set.union A B X] X is A union B external func std.loc.set.union std.loc.set, std.loc.set -> std.loc.set. % [std.loc.set.inter A B X] X is A intersection B external func std.loc.set.inter std.loc.set, std.loc.set -> std.loc.set. % [std.loc.set.diff A B X] X is A \ B external func std.loc.set.diff std.loc.set, std.loc.set -> std.loc.set. % [std.loc.set.equal A B] tests A and B for equality external func std.loc.set.equal std.loc.set, std.loc.set. % [std.loc.set.subset A B] tests if A is a subset of B external func std.loc.set.subset std.loc.set, std.loc.set. % [std.loc.set.elements M L] L is M transformed into list external func std.loc.set.elements std.loc.set -> list loc. % [std.loc.set.choose M X] X is an element of M external func std.loc.set.choose std.loc.set -> loc. % [std.loc.set.min M X] X is the smallest element of M external func std.loc.set.min std.loc.set -> loc. % [std.loc.set.max M X] X is the bigger of M external func std.loc.set.max std.loc.set -> loc. % [std.loc.set.cardinal M N] N is the number of elements of M external func std.loc.set.cardinal std.loc.set -> int. % [std.loc.set.filter M F M1] Filter M w.r.t. the predicate F external func std.loc.set.filter std.loc.set, (loc -> (func)) -> std.loc.set. % [std.loc.set.map M F M1] Map M w.r.t. the predicate F external func std.loc.set.map std.loc.set, (loc -> loc -> prop) -> std.loc.set. % [std.loc.set.fold M Acc F Acc1] fold M w.r.t. the predicate F external func std.loc.set.fold std.loc.set, A, (loc -> A -> A -> prop) -> A. % [std.loc.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1 % is where F holds external func std.loc.set.partition std.loc.set, (loc -> (func)) -> std.loc.set, std.loc.set. #line 1 "builtin_map.elpi" kind std.map type -> type -> type. type std.map std.map.private.map K V -> (func K, K -> cmp) -> std.map K V. namespace std.map { % [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn func make (func K, K -> cmp) -> std.map K V. make Cmp (std.map private.empty Cmp). % [find K M V] looks in M for the value V associated to K func find K, std.map K V -> V. find K (std.map M Cmp) V :- private.find M Cmp K V. % [add K V M M1] M1 is M where K is bound to V func add K, V, std.map K V -> std.map K V. add K V (std.map M Cmp) (std.map M1 Cmp) :- private.add M Cmp K V M1. % [remove K M M1] M1 is M where K is unbound func remove K, std.map K V -> std.map K V. remove K (std.map M Cmp) (std.map M1 Cmp) :- private.remove M Cmp K M1. % [bindings M L] L is the key-value pairs in increasing order func bindings std.map K V -> list (pair K V). bindings (std.map M _) L :- private.bindings M [] L. namespace private { % Taken from OCaml's map.ml kind map type -> type -> type. type empty map K V. type node map K V -> K -> V -> map K V -> int -> map K V. func height map K V -> int. height empty 0. height (node _ _ _ _ H) H. func create map K V, K, V, map K V -> map K V. create L K V R (node L K V R H) :- H is {std.max {height L} {height R}} + 1. func bal map K V, K, V, map K V -> map K V. bal L K V R T :- height L HL, height R HR, HL2 is HL + 2, HR2 is HR + 2, bal.aux HL HR HL2 HR2 L K V R T. func bal.aux int, int, int, int, map K V, K, V, map K V -> map K V. bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :- HL > HR2, {height LL} >= {height LR}, !, create LL LV LD {create LR X D R} T. bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :- HL > HR2, !, create {create LL LV LD LRL} LRV LRD {create LRR X D R} T. bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :- HR > HL2, {height RR} >= {height RL}, !, create {create L X D RL} RV RD RR T. bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :- HR > HL2, !, create {create L X D RLL} RLV RLD {create RLR RV RD RR} T. bal.aux _ _ _ _ L K V R T :- create L K V R T. func add map K V, (func K, K -> cmp), K, V -> map K V. add empty _ K V T :- create empty K V empty T. add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1. func add.aux cmp, map K V, (func K, K -> cmp), K, V -> map K V. add.aux eq (node L _ _ R H) _ X XD T :- T = node L X XD R H. add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T. add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T. func find map K V, (func K, K -> cmp), K -> V. find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V. func find.aux cmp, (func K, K -> cmp), map K V, map K V, V, K -> V. find.aux eq _ _ _ V _ V. find.aux lt Cmp L _ _ K V :- find L Cmp K V. find.aux gt Cmp _ R _ K V :- find R Cmp K V. func remove-min-binding map K V -> map K V. remove-min-binding (node empty _ _ R _) R :- !. remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X. func min-binding map K V -> K, V. min-binding (node empty V D _ _) V D :- !. min-binding (node L _ _ _ _) V D :- min-binding L V D. func merge map K V, map K V -> map K V. merge empty X X :- !. merge X empty X :- !. merge M1 M2 R :- min-binding M2 X D, bal M1 X D {remove-min-binding M2} R. func remove map K V, (func K, K -> cmp), K -> map K V. remove empty _ _ empty :- !. remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M. func remove.aux cmp, (func K, K -> cmp), map K V, map K V, K, V, K -> map K V. remove.aux eq _ L R _ _ _ M :- merge L R M. remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M. remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M. func bindings map K V, list (pair K V) -> list (pair K V). bindings empty X X. bindings (node L V D R _) X X1 :- bindings L [pr V D|{bindings R X}] X1. } % std.map.private } % std.map %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Fast maps only work ground terms but do not perform occur check kind std.fmap type -> type -> type. type std.fmap std.fmap.private.map K V -> (func K, K -> cmp) -> std.fmap K V. namespace std.fmap { % [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn func make (func K, K -> cmp) -> std.fmap K V. make Cmp (std.fmap private.empty Cmp). % [find K M V] looks in M for the value V associated to K func find K, std.fmap K V -> V. find K (std.fmap M Cmp) V :- private.assert-ground K, private.find M Cmp K V. % [add K V M M1] M1 is M where K is bound to V func add K, V, std.fmap K V -> std.fmap K V. add K V (std.fmap M Cmp) R :- private.assert-ground K, private.assert-ground V, private.add M Cmp K V M1, unsound_unif R (std.fmap M1 Cmp). % [remove K M M1] M1 is M where K is unbound func remove K, std.fmap K V -> std.fmap K V. remove K (std.fmap M Cmp) R :- private.assert-ground K, private.remove M Cmp K M1, unsound_unif R (std.fmap M1 Cmp). % [bindings M L] L is the key-value pairs in increasing order func bindings std.fmap K V -> list (pair K V). bindings (std.fmap M _) L :- private.bindings M [] L. namespace private { func assert-ground A. assert-ground A :- std.assert! (ground_term A) "std.fmap: not ground". % Taken from OCaml's map.ml kind map type -> type -> type. type empty map K V. type node map K V -> K -> V -> map K V -> int -> map K V. func height map K V -> int. height empty 0. height (node _ _ _ _ H) H. func create map K V, K, V, map K V -> map K V. create L K V R X :- H is {std.max {height L} {height R}} + 1, unsound_unif X (node L K V R H). func bal map K V, K, V, map K V -> map K V. bal L K V R T :- height L HL, height R HR, HL2 is HL + 2, HR2 is HR + 2, bal.aux HL HR HL2 HR2 L K V R T. func bal.aux int, int, int, int, map K V, K, V, map K V -> map K V. bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :- HL > HR2, {height LL} >= {height LR}, !, create LL LV LD {create LR X D R} T. bal.aux HL _ _ HR2 (node LL LV LD (node LRL LRV LRD LRR _) _) X D R T :- HL > HR2, !, create {create LL LV LD LRL} LRV LRD {create LRR X D R} T. bal.aux _ HR HL2 _ L X D (node RL RV RD RR _) T :- HR > HL2, {height RR} >= {height RL}, !, create {create L X D RL} RV RD RR T. bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :- HR > HL2, !, create {create L X D RLL} RLV RLD {create RLR RV RD RR} T. bal.aux _ _ _ _ L K V R T :- create L K V R T. func add map K V, (func K, K -> cmp), K, V -> map K V. add empty _ K V T :- create empty K V empty T. add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1. func add.aux cmp, map K V, (func K, K -> cmp), K, V -> map K V. add.aux eq (node L _ _ R H) _ X XD T :- unsound_unif T (node L X XD R H). add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T. add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T. func find map K V, (func K, K -> cmp), K -> V. find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V. func find.aux cmp, (func K, K -> cmp), map K V, map K V, V, K -> V. find.aux eq _ _ _ V _ V. find.aux lt Cmp L _ _ K V :- find L Cmp K V. find.aux gt Cmp _ R _ K V :- find R Cmp K V. func remove-min-binding map K V -> map K V. remove-min-binding (node empty _ _ R _) R :- !. remove-min-binding (node L V D R _) X :- bal {remove-min-binding L} V D R X. func min-binding map K V -> K, V. min-binding (node empty V D _ _) V D :- !. min-binding (node L _ _ _ _) V D :- min-binding L V D. func merge map K V, map K V -> map K V. merge empty X X :- !. merge X empty X :- !. merge M1 M2 R :- min-binding M2 X D, bal M1 X D {remove-min-binding M2} R. func remove map K V, (func K, K -> cmp), K -> map K V. remove empty _ _ empty :- !. remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M. func remove.aux cmp, (func K, K -> cmp), map K V, map K V, K, V, K -> map K V. remove.aux eq _ L R _ _ _ M :- merge L R M. remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M. remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M. func bindings map K V, list (pair K V) -> list (pair K V). bindings empty X X. bindings (node L V D R _) X X1 :- bindings L [pr V D|{bindings R X}] X1. } % std.fmap.private } % std.fmap #line 1 "builtin_set.elpi" kind std.set type -> type. type std.set std.set.private.set E -> (func E, E -> cmp) -> std.set E. namespace std.set { % [make Eq Ltn M] builds an empty set M where keys are compared using Eq and Ltn func make (func E, E -> cmp) -> std.set E. make Cmp (std.set private.empty Cmp). % [mem E M] looks if E is in M func mem E, std.set E. mem E (std.set M Cmp):- private.mem M Cmp E. % [add E M M1] M1 is M + {E} func add E, std.set E -> std.set E. add E (std.set M Cmp) (std.set M1 Cmp) :- private.add M Cmp E M1. % [remove E M M1] M1 is M - {E} func remove E, std.set E -> std.set E. remove E (std.set M Cmp) (std.set M1 Cmp) :- private.remove M Cmp E M1. % [cardinal S N] N is the number of elements of S func cardinal std.set E -> int. cardinal (std.set M _) N :- private.cardinal M N. func elements std.set E -> list E. elements (std.set M _) L :- private.elements M [] L. namespace private { % Taken from OCaml's set.ml kind set type -> type. type empty set E. type node set E -> E -> set E -> int -> set E. func height set E -> int. height empty 0. height (node _ _ _ H) H. func create set E, E, set E -> set E. create L E R (node L E R H) :- H is {std.max {height L} {height R}} + 1. func bal set E, E, set E -> set E. bal L E R T :- height L HL, height R HR, HL2 is HL + 2, HR2 is HR + 2, bal.aux HL HR HL2 HR2 L E R T. func bal.aux int, int, int, int, set E, E, set E -> set E. bal.aux HL _ _ HR2 (node LL LV LR _) X R T :- HL > HR2, {height LL} >= {height LR}, !, create LL LV {create LR X R} T. bal.aux HL _ _ HR2 (node LL LV (node LRL LRV LRR _) _) X R T :- HL > HR2, !, create {create LL LV LRL} LRV {create LRR X R} T. bal.aux _ HR HL2 _ L X (node RL RV RR _) T :- HR > HL2, {height RR} >= {height RL}, !, create {create L X RL} RV RR T. bal.aux _ HR HL2 _ L X (node (node RLL RLV RLR _) RV RR _) T :- HR > HL2, !, create {create L X RLL} RLV {create RLR RV RR} T. bal.aux _ _ _ _ L E R T :- create L E R T. func add set E, (func E, E -> cmp), E -> set E. add empty _ E T :- create empty E empty T. add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S. func add.aux cmp, (func E, E -> cmp), set E, set E, E, E, int -> set E. add.aux eq _ L R X _ H (node L X R H). add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T. add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T. func mem set E, (func E, E -> cmp), E. mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E. func mem.aux cmp, (func E, E -> cmp), set E, set E, E. mem.aux eq _ _ _ _. mem.aux lt Cmp L _ E :- mem L Cmp E. mem.aux gt Cmp _ R E :- mem R Cmp E. func remove-min-binding set E -> set E. remove-min-binding (node empty _ R _) R :- !. remove-min-binding (node L E R _) X :- bal {remove-min-binding L} E R X. func min-binding set E -> E. min-binding (node empty E _ _) E :- !. min-binding (node L _ _ _) E :- min-binding L E. func merge set E, set E -> set E. merge empty X X :- !. merge X empty X :- !. merge M1 M2 R :- min-binding M2 X, bal M1 X {remove-min-binding M2} R. func remove set E, (func E, E -> cmp), E -> set E. remove empty _ _ empty. remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M. func remove.aux cmp, (func E, E -> cmp), set E, set E, E, E -> set E. remove.aux eq _ L R _ _ M :- merge L R M. remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M. remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M. func cardinal set E -> int. cardinal empty 0. cardinal (node L _ R _) N :- N is {cardinal L} + 1 + {cardinal R}. func elements set E, list E -> list E. elements empty X X. elements (node L E R _) Acc X :- elements L [E|{elements R Acc}] X. } % std.set.private } % std.set %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Fast sets only work ground terms but do not perform occur check kind std.fset type -> type. type std.fset std.fset.private.set E -> (func E, E -> cmp) -> std.fset E. namespace std.fset { % [make Eq Ltn M] builds an empty set M where keys are compared using Eq and Ltn func make (func E, E -> cmp) -> std.fset E. make Cmp (std.fset private.empty Cmp). % [mem E M] looks if E is in M func mem E, std.fset E. mem E (std.fset M Cmp):- private.mem M Cmp E. % [add E M M1] M1 is M + {E} func add E, std.fset E -> std.fset E. add E (std.fset M Cmp) R :- private.assert-ground E, private.add M Cmp E M1, unsound_unif R (std.fset M1 Cmp). % [remove E M M1] M1 is M - {E} func remove E, std.fset E -> std.fset E. remove E (std.fset M Cmp) R :- private.assert-ground E, private.remove M Cmp E M1, unsound_unif R (std.fset M1 Cmp). % [cardinal S N] N is the number of elements of S func cardinal std.fset E -> int. cardinal (std.fset M _) N :- private.cardinal M N. func elements std.fset E -> list E. elements (std.fset M _) L :- private.elements M [] L. namespace private { func assert-ground A. assert-ground A :- std.assert! (ground_term A) "std.fset: not ground". % Taken from OCaml's set.ml kind set type -> type. type empty set E. type node set E -> E -> set E -> int -> set E. func height set E -> int. height empty 0. height (node _ _ _ H) H. func create set E, E, set E -> set E. create L E R S :- H is {std.max {height L} {height R}} + 1, unsound_unif S (node L E R H). func bal set E, E, set E -> set E. bal L E R T :- height L HL, height R HR, HL2 is HL + 2, HR2 is HR + 2, bal.aux HL HR HL2 HR2 L E R T. func bal.aux int, int, int, int, set E, E, set E -> set E. bal.aux HL _ _ HR2 (node LL LV LR _) X R T :- HL > HR2, {height LL} >= {height LR}, !, create LL LV {create LR X R} T. bal.aux HL _ _ HR2 (node LL LV (node LRL LRV LRR _) _) X R T :- HL > HR2, !, create {create LL LV LRL} LRV {create LRR X R} T. bal.aux _ HR HL2 _ L X (node RL RV RR _) T :- HR > HL2, {height RR} >= {height RL}, !, create {create L X RL} RV RR T. bal.aux _ HR HL2 _ L X (node (node RLL RLV RLR _) RV RR _) T :- HR > HL2, !, create {create L X RLL} RLV {create RLR RV RR} T. bal.aux _ _ _ _ L E R T :- create L E R T. func add set E, (func E, E -> cmp), E -> set E. add empty _ E T :- create empty E empty T. add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S. func add.aux cmp, (func E, E -> cmp), set E, set E, E, E, int -> set E. add.aux eq _ L R X _ H S :- unsound_unif S (node L X R H). add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T. add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T. func mem set E, (func E, E -> cmp), E. mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E. func mem.aux cmp, (func E, E -> cmp), set E, set E, E. mem.aux eq _ _ _ _. mem.aux lt Cmp L _ E :- mem L Cmp E. mem.aux gt Cmp _ R E :- mem R Cmp E. func remove-min-binding set E -> set E. remove-min-binding (node empty _ R _) R :- !. remove-min-binding (node L E R _) X :- bal {remove-min-binding L} E R X. func min-binding set E -> E. min-binding (node empty E _ _) E :- !. min-binding (node L _ _ _) E :- min-binding L E. func merge set E, set E -> set E. merge empty X X :- !. merge X empty X :- !. merge M1 M2 R :- min-binding M2 X, bal M1 X {remove-min-binding M2} R. func remove set E, (func E, E -> cmp), E -> set E. remove empty _ _ empty. remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M. func remove.aux cmp, (func E, E -> cmp), set E, set E, E, E -> set E. remove.aux eq _ L R _ _ M :- merge L R M. remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M. remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M. func cardinal set E -> int. cardinal empty 0. cardinal (node L _ R _) N :- N is {cardinal L} + 1 + {cardinal R}. func elements set E, list E -> list E. elements empty X X. elements (node L E R _) Acc X :- elements L [E|{elements R Acc}] X. } % std.fset.private } % std.fset % == I/O builtins ===================================== % -- I/O -- kind in_stream type. external symbol std_in : in_stream = "1". kind out_stream type. external symbol std_err : out_stream = "1". external symbol std_out : out_stream = "1". % [open_in FileName InStream] opens FileName for input external func open_in string -> in_stream. % [open_out FileName OutStream] opens FileName for output external func open_out string -> out_stream. % [open_append FileName OutStream] opens FileName for output in append mode external func open_append string -> out_stream. % [close_in InStream] closes input stream InStream external func close_in in_stream. % [close_out OutStream] closes output stream OutStream external func close_out out_stream. % [output OutStream Data] writes Data to OutStream external func output out_stream, string. % [flush OutStream] flush all output not yet finalized to OutStream external func flush out_stream. % [input InStream Bytes Data] reads Bytes from InStream external func input in_stream, int -> string. % [input_line InStream Line] reads a full line from InStream external func input_line in_stream -> string. % [eof InStream] checks if no more data can be read from InStream external func eof in_stream. % -- System -- % [gettimeofday T] sets T to the number of seconds elapsed since 1/1/1970 external func gettimeofday -> float. % [getenv VarName Value] Like Sys.getenv external func getenv string -> option string. % [system Command RetVal] executes Command and sets RetVal to the exit code external func system string -> int. % -- Unix -- % gathers the standard file descriptors or a process kind unix.process type. external symbol unix.process : out_stream -> in_stream -> in_stream -> unix.process = "1". % [unix.process.open Executable Arguments Environment P Diagnostic] OCaml's % Unix.open_process_args_full. % Note that the first argument is the executable name (as in argv[0]). % If Executable is omitted it defaults to the first element of % Arguments. % Environment can be left unspecified, defaults to the current process % environment. % This API only works reliably since OCaml 4.12. external func unix.process.open string, list string, list string -> unix.process, diagnostic. % [unix.process.close P Diagnostic] OCaml's Unix.close_process_full external func unix.process.close unix.process -> diagnostic. % -- Debugging -- % [term_to_string T S] prints T to S external func term_to_string -> any, string. % == Elpi runtime builtins ===================================== % [trace.counter Name Value] reads the Value of a trace point Name external func trace.counter string -> int. external func gc.get % Reads the current settings of the garbage collector. See also OCaml's Gc.control type documentation. -> int, % MinorHeapSize int, % MajorHeapIncrement int, % SpaceOverhead int, % Verbose int, % MaxOverhead int, % StackLimit int, % AllocationPolicy int. % WindowSize % [gc.set MinorHeapSize MajorHeapIncrement SpaceOverhead Verbose MaxOverhead % StackLimit AllocationPolicy WindowSize] Writes the current settings of the % garbage collector. Any parameter left unspecificed (eg _) is not changed. % See also OCaml's Gc.control type documentation. external func gc.set int, int, int, int, int, int, int, int. % [gc.minor] See OCaml's Gc.minor documentation. external func gc.minor. % [gc.major] See OCaml's Gc.major documentation. external func gc.major. % [gc.full] See OCaml's Gc.full_major documentation. external func gc.full. % [gc.compact] See OCaml's Gc.compact documentation. external func gc.compact. % [gc.stat MinorWords PromotedWords MajorWords MinorCollections % MajorCollections HeapWords HeapChunks LiveWords LiveBlocks FreeWords % FreeBlocks LargestFree Fragments Compactions TopHeapWords StackSize] See % OCaml's Gc.stat documentation. external func gc.stat -> float, float, float, int, int, int, int, int, int, int, int, int, int, int, int, int. % [gc.quick-stat MinorWords PromotedWords MajorWords MinorCollections % MajorCollections HeapWords HeapChunks Compactions TopHeapWords StackSize] % See OCaml's Gc.quick_stat documentation. external func gc.quick-stat -> float, float, float, int, int, int, int, int, int, int. % == Lambda Prolog builtins ===================================== % -- Extra I/O -- % [open_string DataIn InStream] opens DataIn as an input stream external func open_string string -> in_stream. % [lookahead InStream NextChar] peeks one byte from InStream external func lookahead in_stream -> string. pred printterm out_stream, A. printterm S T :- term_to_string T T1, output S T1. LPCIC-coq-elpi-eb449d7/builtin-doc/gen_doc.ml000066400000000000000000000000761523041753400206470ustar00rootroot00000000000000let _ = Elpi_plugin.Rocq_elpi_programs.document_builtins () LPCIC-coq-elpi-eb449d7/coq-elpi.opam000066400000000000000000000012011523041753400170640ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Compatibility metapackage for Elpi extension language after the Rocq renaming" maintainer: ["Enrico Tassi "] authors: ["Enrico Tassi "] license: "LGPL-2.1-or-later" tags: [ "category:Miscellaneous/Coq Extensions" "keyword:λProlog" "keyword:higher order abstract syntax" "logpath:elpi" ] homepage: "https://github.com/LPCIC/coq-elpi" bug-reports: "https://github.com/LPCIC/coq-elpi/issues" depends: [ "coq-core" "rocq-elpi" {= version} ] dev-repo: "git+https://github.com/LPCIC/coq-elpi.git" LPCIC-coq-elpi-eb449d7/default.nix000066400000000000000000000006621523041753400166530ustar00rootroot00000000000000{ config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, update-nixpkgs ? false, ci-matrix ? false, override ? {}, ocaml-override ? {}, global-override ? {}, bundle ? null, job ? null, inNixShell ? null, src ? ./., }@args: let auto = fetchGit { url = "https://github.com/rocq-community/coq-nix-toolbox.git"; ref = "master"; rev = import .nix/coq-nix-toolbox.nix; }; in import auto ({inherit src;} // args) LPCIC-coq-elpi-eb449d7/dune000066400000000000000000000002601523041753400153570ustar00rootroot00000000000000(env (dev (flags (:standard -w -9 -w -32 -w -27 -w -6 -w -37 -warn-error -A)) (coq (flags -w +elpi.deprecated -w +elpi.implication-precedence -w -elpi.flex-clause -bt)))) LPCIC-coq-elpi-eb449d7/dune-project000066400000000000000000000050161523041753400170270ustar00rootroot00000000000000(lang dune 3.13) (using coq 0.8) (name rocq-elpi) ;(generate_opam_files) (source (github LPCIC/coq-elpi)) (license LGPL-2.1-or-later) (authors "Enrico Tassi ") (maintainers "Enrico Tassi ") (package (name rocq-elpi) (synopsis "Elpi extension language for Coq") (description "Coq-elpi provides a Coq plugin that embeds ELPI. It also provides \ a way to embed Coq's terms into λProlog using the Higher-Order \ Abstract Syntax approach and a way to read terms back. In addition \ to that it exports to ELPI a set of Coq's primitives, e.g. printing \ a message, accessing the environment of theorems and data types, \ defining a new constant and so on. For convenience it also provides \ a quotation and anti-quotation for Coq's syntax in λProlog. E.g., \ `{{nat}}` is expanded to the type name of natural numbers, or \ `{{A -> B}}` to the representation of a product by unfolding the \ `->` notation. Finally it provides a way to define new vernacular \ commands and new tactics.") (tags ("category:Miscellaneous/Coq Extensions" "keyword:λProlog" "keyword:higher order abstract syntax" "logpath:elpi")) (depends (ocaml (>= 4.10.0)) (elpi (and (>= 3.0) (< 3.2.0~))) ; (rocq-core (and (>= 9.0+rc1) (< 9.2~))) ppx_optcomp (ocaml-lsp-server :with-dev-setup))) (package (name rocq-elpi-json) (synopsis "Yojson bindings for rocq-elpi") (description "This package provides basic support for reading and writing json files from Elpi programs running in Rocq") (depends rocq-elpi yojson)) (package (name rocq-elpi-xml) (synopsis "Xml-light bindings for rocq-elpi") (description "DThis package provides basic support for reading xml files from Elpi programs running in Rocq") (depends rocq-elpi yojson)) (package (name rocq-elpi-tests) (synopsis "Technical package to run tests") (description "Do not install") (depends rocq-elpi)) (package (name rocq-elpi-json-tests) (synopsis "Technical package to run tests") (description "Do not install") (depends rocq-elpi)) (package (name rocq-elpi-xml-tests) (synopsis "Technical package to run tests") (description "Do not install") (depends rocq-elpi)) (package (name rocq-elpi-tests-stdlib) (synopsis "Technical package to run tests depending on Stdlib") (description "Do not install") (depends rocq-elpi rocq-stdlib)) (package (name coq-elpi) (allow_empty) (depends coq-core (rocq-elpi (= :version))) (synopsis "Compatibility metapackage for Elpi extension language after the Rocq renaming")) LPCIC-coq-elpi-eb449d7/elpi/000077500000000000000000000000001523041753400154345ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/elpi/README.md000066400000000000000000000015371523041753400167210ustar00rootroot00000000000000### coq-HOAS Documents how Coq terms are represented in Elpi. ### coq-lib Standard library of Coq specific utilities (in the coq. namespace). ### elpi-command-template Selects which files are accumulated in an `Elpi Command`. ### elpi-tactic-template Selects which files are accumulated in an `Elpi Tactic`. ### coq-elpi-checker Extends the standard type checker for Elpi programs so that it reports errors using Coq's I/O primitives. ### elpi-ltac Implementation of Ltac's like combinators in Elpi. ### elpi-reduction Implementation of reduction in Elpi. Main entry points are `whd` and `hd-beta`. ### coq-elaborator Uses the Coq type inference and unification algorithms in order to implement `of`, `unify-*` and `evar`. ### elpi-elaborator An elaborator completely written in Elpi (work in progress). It implements `of`, `unify-*` and `evar`. LPCIC-coq-elpi-eb449d7/elpi/coq-HOAS.elpi000066400000000000000000000363241523041753400176310ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular the data type for terms and the evar_map entries (a sequent) % and the entry points for tactics % Entry point for tactics. Eg. "elpi mytactic foo 3 (f x)." becomes % solve % Where [str "foo", int 3, trm (app[f,x])] is part of . % The encoding of goals is described below. % msolve is for tactics that operate on multiple goals (called via all: ). external pred solve i:goal, o:list sealed-goal. external pred msolve i:list sealed-goal, o:list sealed-goal. % Extra arguments for tactics external symbol tac : ltac1-tactic -> argument. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's terms % % Types of term formers % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % -- terms -------------------------------------------------------------------- kind term type. external symbol sort : sort -> term. % Prop, Type@{i} % constants: inductive types, inductive constructors, definitions external symbol global : gref -> term. external symbol pglobal : gref -> univ-instance -> term. % binders: to form functions, arities and local definitions external symbol fun : name -> term -> (term -> term) -> term. % fun x : t => external symbol prod : name -> term -> (term -> term) -> term. % forall x : t, external symbol let : name -> term -> term -> (term -> term) -> term. % let x : T := v in % other term formers: function application, pattern matching and recursion external symbol app : list term -> term. % app [hd|args] external symbol match : term -> term -> list term -> term. % match t p [branch]) external symbol fix : name -> int -> term -> (term -> term) -> term. % fix name rno ty bo external symbol mfix : int -> int -> mfix-block -> term. % mfix block-idx rno external symbol primitive : primitive-value -> term. kind mfix-block type. external symbol mfix-ty : name -> int -> term -> (term -> mfix-block) -> mfix-block. % mfix-ty name rno ty rest external symbol mfix-bo : list term -> mfix-block. % NYI %type cofix name -> term -> (term -> term) -> term. % cofix name ty bo % Notes about (match Scrutinee TypingFunction Branches) when % Inductive i A : A -> nat -> Type := K : forall a : A, i A a 0 % and % Scrutinee be a term of type (i bool true 7) % % - TypingFunction has a very rigid shape that depends on i. Namely % as many lambdas as indexes plus one lambda for the inductive itself % where the value of the parameters are taken from the type of the scrutinee: % fun `a` (indt "bool") a\ % fun `n` (indt "nat) n\ % fun `i` (app[indt "i", indt "bool", a n) i\ .. % Such spine of fun cannot be omitted; else elpi cannot read the term back. % See also coq.bind-ind-arity-no-let in coq-lib.elpi, that builds such spine for you, % or the higher level api coq.build-match (same file) that also takes % care of branches. % - Branches is a list of terms, the order is the canonical one (the order % of the constructors as they were declared). If the constructor has arguments % (excluding the parameters) then the corresponding term shall be a Coq % function. In this case % fun `x` (indt "bool") x\ .. % -- helpers ------------------------------------------------------------------ macro @cast T TY :- (let `cast` TY T x\x). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's evar_map % % Context and evar declaration % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % An evar_info (displayed as a Coq goal) is essentially a sequent: % % x : t % y := v : x % ---------- % p x y % % is coded as an Elpi query % % pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) % % where, by default, declare-evar creates a syntactic constraint as % % {x1 x2} : % decl x1 `x` , def x2 `y` x1 ?- % evar (RawEvar x1 x2) (

x1 x2) (Ev x1 x2) /* suspended on RawEvar, Ev */ % % When the program is over, a remaining syntactic constraint like the one above % is read back and transformed into the corresponding evar_info. external func decl term -> name, term. % Var Name Ty external func def term -> name, term, term. % Var Name Ty Bo external func cache term -> term. external func declare-evar list prop, term, term, term. % Ctx RawEvar Ty Evar :name "default-declare-evar" declare-evar Ctx RawEv Ty Ev :- declare_constraint (declare-evar Ctx RawEv Ty Ev) [RawEv]. % When a goal (evar _ _ _) is turned into a constraint the context is filtered % to only contain decl, def, pp. For now no handling rules for this set of % constraints other than one to remove a constraint external func rm-evar term, term. rm-evar (uvar as X) (uvar as Y):- !, declare_constraint (rm-evar X Y) [X,Y]. rm-evar _ _. constraint declare-evar evar def decl cache rm-evar { % Override the actual context rule \ (declare-evar Ctx RawEv Ty Ev) <=> (Ctx =!=> evar RawEv Ty Ev). rule \ (rm-evar (uvar X _) (uvar Y _)) (evar (uvar X _) _ (uvar Y _)). rule \ (rm-evar (uvar X _) (uvar Y _)). } % The (evar R Ty E) predicate suspends when R and E are flexible, % and is solved otherwise. % The client may want to provide an alternative implementation of % the clause "default-assign-evar", for example to typechecks that the % term assigned to E has type Ty, or that the term assigned to R % elaborates to a term of type Ty that gets assigned to E. % In tactic mode, elpi/coq-elaborator.elpi wires things up that way. external func evar term, term -> term. % Evar Ty RefinedSolution evar (uvar as X) T S :- var S _ VL, !, prune T VL, prune X VL, declare_constraint (evar X T S) [X, S]. :name "default-assign-evar" evar _ _ _. % volatile, only unresolved evars are considered as evars % To ease the creation of a context with decl and def % Eg. @pi-decl `x` x1\ @pi-def `y` y\ ... macro @pi-decl N T F :- pi x\ decl x N T => F x. macro @pi-def N T B F :- pi x\ def x N T B => cache x B_ => F x. % Converts an arity to a term func coq.arity->term arity -> term. coq.arity->term (parameter ID _ Ty Rest) (prod Name Ty R) :- coq.id->name ID Name, @pi-decl Name Ty x\ coq.arity->term (Rest x) (R x). coq.arity->term (arity A) A. macro @pi-parameter ID T F :- sigma N\ (coq.id->name ID N, pi x\ decl x N T => F x). macro @pi-inductive ID A F :- sigma N\ (coq.id->name ID N, coq.arity->term A T, pi x\ decl x N T => F x). % Sometimes it can be useful to pass to Coq a term with unification variables % representing "untyped holes" like an implicit argument _. In particular % a unification variable may exit the so called pattern fragment (applied % to distinct variables) and hence cannot be reliably mapped to Coq as an evar, % but can still be considered as an implicit argument. % By loading in the context get-option "HOAS:holes" tt one forces that % behavior. Here a convenience macro to be put on the LHS of => macro @holes! :- get-option "HOAS:holes" tt. % Similarly, some APIs take a term skeleton in input. In that case unification % variables are totally disregarded (not even mapped to Coq evars). They are % interpreted as the {{ lib:elpi.hole }} constant, which represents an implicit % argument. As a consequence these APIs don't modify the input term at all, but % rather return a copy. Note that if {{ lib:elpi.hole }} is used directly, then % it has to be applied to all variables in scope, since Coq erases variables % that are not used. For example using {{ forall x : nat, lib:elpi.hole }} as % a term skeleton is equivalent to {{ nat -> lib:elpi.hole }}, while % {{ forall x : nat, lib:elpi.hole x lib:elpi.hole more args }} puts x in % the scope of the hole (and passes to is more args). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Coq's goals and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A Coq goal is essentially a sequent, like the evar_info above, but since it % has to be manipulated as first class Elpi data, it is represented in a slightly % different way. For example % % x : t % y := v : x % ---------- % g x y % % is represented by the following term of type sealed-goal % % nabla x1\ % nabla x2\ % seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % (Arguments x1 x2)) kind goal type. kind sealed-goal type. external symbol nabla : (term -> sealed-goal) -> sealed-goal. external symbol seal : goal -> sealed-goal. typeabbrev goal-ctx (list prop). external symbol goal : goal-ctx -> term -> term -> term -> list argument -> goal. % A sealed-goal closes with nabla the bound names of a % % (goal Ctx RawSolution Ty Solution Arguments) % % where Ctx is a list of decl or def and Solution is a unification variable % to be assigned to a term of type Ty in order to make progress. % RawSolution is used as a trigger: when a term is assigned to it, it is % elaborated against Ty and the resulting term is assigned to Solution. % % Arguments contains data attached to the goal, which lives in its context % and can be used by tactics to solve the goals. % A tactic (an elpi predicate which makes progress on a Coq goal) is % a predicate of type % sealed-goal -> list sealed-goal -> prop % % while the main entry point for a tactic written in Elpi is solve % which has type % goal -> list sealed-goal -> prop % % The utility (coq.ltac.open T G GL) postulates all the variables bounds % by nabla and loads the goal context before calling T on the unsealed % goal. The invocation of a tactic with arguments % 3 x "y" (h x) % on the previous goal results in the following Elpi query: % % (pi x1\ decl x1 `x` => % pi x2\ def x2 `y` x1 => % declare-evar % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2)), % (coq.ltac.open solve % (nabla x1\ nabla x2\ seal % (goal % [def x2 `y` x1 , decl x1 `x` ] % (RawEvar x1 x2) ( x1 x2) (Evar x1 x2) % [int 3, str `x`, str`y`, trm (app[const `h`,x1])])) % NewGoals) % % If the goal sequent contains other evars, then a tactic invocation is % an Elpi query made of the conjunction of all the declare-evar queries % corresponding to these evars and the query corresponding to the goal % sequent. NewGoals can be assigned to a list of goals that should be % declared as open. Omitted goals are shelved. If NewGoals is not % assigned, then all unresolved evars become new goals, but the order % of such goals is not specified. % The file elpi-ltac.elpi provides a few combinators (other than coq.ltac.open) % in the tradition of LCF tacticals. The main difference is that the arguments % of custom written tactics must not be passed as predicate arguments but rather % put in the goal they receive. Indeed these arguments can contain terms, and % their bound variables cannot escape the seal. coq.ltac.set-goal-arguments % can be used to put an argument from the current goal context into another % goal. The coq.ltac.call utility can call Ltac1 code (written in Coq) and % pass arguments via this mechanism. % Last, since Elpi is already a logic programming language with primitive % support for unification variables, most of the work of a tactic can be % performed without using tacticals (which work on sealed goals) but rather % in the context of the original goal. The last step is typically to call % the refine utility with a term synthesized by the tactic or invoke some % Ltac1 code on that term (e.g. to call vm_compute, see also the example % on the reflexive tactic). % ----- Multi goals tactics. ---- % Coq provides goal selectors, such as all:, to pass to a tactic more than one % goal. In order to write such a tactic, Coq-Elpi provides another entry point % called msolve. To be precise, if there are two goals under focus, say and % , then all: elpi tac runs the following query % % msolve [,] NewGoals ; % note the disjunction % coq.ltac.all (coq.ltac.open solve) [,] NewGoals % % So, if msolve has no clause, Coq-Elpi will use solve on all the goals % independently. If msolve has a clause, then it can manipulate the entire list % of sealed goals. Note that the argument is in both and but % it is interpreted in both contexts independently. If both goals have a proof % variable named "x" then passing (@eq_refl _ x) as equips both goals with % a (raw) proof that "x = x", no matter what their type is. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Declarations for Coq's API (environment read/write access, etc). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % tt = Yes, ff = No, unspecified = No (unspecified means "_" or a variable). typeabbrev opaque? bool. macro @opaque! :- tt. macro @transparent! :- ff. %%%%%%% Attributes to be passed to APIs as in @local! => coq.something %%%%%%%% macro @keep-alg-univs! :- get-option "coq:keepalgunivs" tt. macro @primitive! :- get-option "coq:primitive" tt. % primitive records macro @reversible! :- get-option "coq:reversible" tt. % coercions macro @no-tc! :- get-option "coq:no_tc" tt. % skip typeclass inference macro @uinstance! I :- get-option "coq:uinstance" I. % universe instance % declaration of universe polymorphic constants % The first list is the one of the universe variables being bound % The first boolean is tt if this list can be extended by Coq (or it has to % mention all universes actually used) % The second list is the one with the constraints amond where universes % The second boolean is tt if this list can be extended by Coq or it has to % mention all universe constraints actually required to type check the % declaration) macro @udecl! Vs LV Cs LC :- get-option "coq:udecl" (upoly-decl Vs LV Cs LC). macro @udecl-cumul! Vs LV Cs LC :- get-option "coq:udecl-cumul" (upoly-decl-cumul Vs LV Cs LC). macro @univpoly! :- @udecl! [] tt [] tt. macro @univpoly-cumul! :- @udecl-cumul! [] tt [] tt. macro @ppwidth! N :- get-option "coq:ppwidth" N. % printing width macro @ppall! :- get-option "coq:pp" "all". % printing all macro @ppmost! :- get-option "coq:pp" "most". % printing most of contents macro @pplevel! N :- get-option "coq:pplevel" N. % printing precedence (for parentheses) macro @keepunivs! :- get-option "coq:keepunivs" tt. % skeletons elaboration macro @dropunivs! :- get-option "coq:keepunivs" ff. % add-indt/add-const macro @using! S :- get-option "coq:using" S. % like the #[using=S] attribute macro @inline-at! N :- get-option "coq:inline" (coq.inline.at N). % like Inline(N) macro @inline! N :- get-option "coq:inline" coq.inline.default. % like macro @redflags! F :- get-option "coq:redflags" (F : coq.redflags). % for whd & co % both arguments are strings eg "8.12.0" "use foo instead" macro @deprecated! Since Msg :- get-option "coq:deprecated" (pr Since Msg). macro @ltacfail! N :- get-option "ltac:fail" N. % retrocompatibility macro for Coq v8.10 macro @coercion! :- [coercion reversible]. LPCIC-coq-elpi-eb449d7/elpi/coq-arg-HOAS.elpi000066400000000000000000000176221523041753400204000ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%% coq-arg-HOAS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This section contains the low level data types linking Coq and elpi. % In particular the entry points for commands % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry points % % Command and tactic invocation % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry point for commands. Eg. "#[att=true] Elpi mycommand foo 3 (f x)." becomes % main [str "foo", int 3, trm (app[f,x])] % in a context where % attributes [attribute "att" (leaf "true")] % holds. The encoding of terms is described below. % See also the coq.parse-attributes utility. external pred main i:list argument. % Commands with a non-trivial parsing phase can thread data between % from the parsing phase to the interp one in an untyped way using the % following two entrypoints external pred main-interp i:list argument, i:any. external pred main-synterp i:list argument, o:any. % Commands starting/closing proofs have to use the following entrypoints. % The minimal working snippet is: % % main-interp-proof [trm P] _ P GL _ :- % coq.typecheck P _ ok, coq.ltac.collect-goals P GL _. % main-interp-qed _ _ P _GL _ :- % coq.env.add-const "it" P _ _ _. % % Where GL are the goals to prove, and _GL (unused here) are the same goals % with their current proof. The term P can be used as the root proof term, % where GL are missing pieces. One is not obliged to use P as is, i.e. he % can inspect _GL and declare each proof independenlty, or combine these proofs % as he likes and ignore P completely. When a main-interp-qed is used to end % a proof stated by a standard Rocq Lemma/Definition statement, the data from % the proof opening command is the lemma name, _GL is the empty list and P the % proof term. external pred main-interp-proof i:list argument, % arguments passed to the command i:any, % data from the parsing phase (defaults to _) o:term, % proof data for the corresponding proof-closing command o:list sealed-goal, % the sequents to prove o:any. % any data for the corresponding proof-closing command external pred main-interp-qed i:list argument, % arguments passed to the command i:any, % data from the parsing phase (defaults to _) i:term, % proof data from the corresponding proof-opening command i:list sealed-goal, % the sequents from the corresponding proof-opening command, but with proofs i:any. % any data from the corresponding proof-opening command pred usage. external func attributes -> list attribute. % see coq-lib.elpi for coq.parse-attributes generating the options below external pred get-option o:string, o:A. % The data type of arguments (for commands or tactics) kind argument type. external symbol int : int -> argument. % Eg. 1 -2. external symbol str : string -> argument. % Eg. x "y" z.w. or any Coq keyword/symbol external symbol trm : term -> argument. % Eg. (t). external symbol open-trm : int -> term -> argument. % Extra arguments for commands. [Definition], [Axiom], [Record] and [Context] % take precedence over the [str] argument above (when not "quoted"). % % Eg. Record or Inductive external symbol indt-decl : indt-decl -> argument. % Eg. #[universes(polymorphic,...)] Record or Inductive external symbol upoly-indt-decl : indt-decl -> upoly-decl -> argument. % Eg. Definition or Axiom (when the body is none) external symbol const-decl : id -> option term -> arity -> argument. % Eg. #[universes(polymorphic,...)] Definition or Axiom external symbol upoly-const-decl : id -> option term -> arity -> upoly-decl -> argument. % Eg. Context A (b : A). external symbol ctx-decl : context-decl -> argument. % Declaration of inductive types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% kind indt-decl type. kind indc-decl type. kind record-decl type. % An arity is written, in Coq syntax, as: % (x : T1) .. (xn : Tn) : S1 -> ... -> Sn -> U % This syntax is used, for example, in the type of an inductive type or % in the type of constructors. We call the abstractions on the left of ":" % "parameters" while we call the type following the ":" (proper) arity. % Note: in some contexts, like the type of an inductive type constructor, % Coq makes no distinction between these two writings % (xn : Tn) : forall y1 : S1, ... and (xn : Tn) (y1 : S1) : ... % while Elpi is a bit more restrictive, since it understands user directives % such as the implicit status of an arguments (eg, using {} instead of () around % the binder), only on parameters. % Moreover parameters carry the name given by the user as an "id", while binders % in terms only carry it as a "name", an irrelevant pretty pringintg hint (see % also the HOAS of terms). A user command can hence only use the names of % parameters, and not the names of "forall" quantified variables in the arity. % % See also the arity->term predicate in coq-lib.elpi kind arity type. external symbol parameter : id -> implicit_kind -> term -> (term -> arity) -> arity = "1". external symbol arity : term -> arity. external symbol parameter : id -> implicit_kind -> term -> (term -> indt-decl) -> indt-decl = "2". external symbol inductive : id -> bool -> arity -> (term -> list indc-decl) -> indt-decl. % tt means inductive, ff coinductive external symbol minductive : id -> bool -> arity -> (term -> indt-decl) -> indt-decl. % one type of a mutual block external symbol mblock : list (list indc-decl) -> indt-decl. % constructor blocks for minductive declarations external symbol record : id -> term -> id -> record-decl -> indt-decl. external symbol constructor : id -> arity -> indc-decl. external symbol field : field-attributes -> id -> term -> (term -> record-decl) -> record-decl. external symbol end-record : record-decl. % Example. % Remark that A is a regular parameter; y is a non-uniform parameter and t % also features an index of type bool. % % Inductive t (A : Type) | (y : nat) : bool -> Type := % | K1 (x : A) {n : nat} : S n = y -> t A n true -> t A y true % | K2 : t A y false % % is written % % (parameter "A" explicit {{ Type }} a\ % inductive "t" tt (parameter "y" explicit {{ nat }} _\ % arity {{ bool -> Type }}) % t\ % [ constructor "K1" % (parameter "y" explicit {{ nat }} y\ % (parameter "x" explicit a x\ % (parameter "n" maximal {{ nat }} n\ % arity {{ S lp:n = lp:y -> lp:t lp:n true -> lp:t lp:y true }}))) % , constructor "K2" % (parameter "y" explicit {{ nat }} y\ % arity {{ lp:t lp:y false }}) ]) % % Remark that the uniform parameters are not passed to occurrences of t, since % they never change, while non-uniform parameters are both abstracted % in each constructor type and passed as arguments to t. % % The coq.typecheck-indt-decl API can be used to fill in implicit arguments % an infer universe constraints in the declaration above (e.g. the hidden % argument of "=" in the arity of K1). % % Note: when and inductive type declaration is passed as an argument to an % Elpi command non uniform parameters must be separated from the uniform ones % with a | (a syntax introduced in Coq 8.12 and accepted by rocq-elpi since % version 1.4, in Coq this separator is optional, but not in Elpi). % Context declaration (used as an argument to Elpi commands) kind context-decl type. % Eg. (x : T) or (x := B), body is optional, type may be a variable external symbol context-item : id -> implicit_kind -> term -> option term -> (term -> context-decl) -> context-decl. external symbol context-end : context-decl. typeabbrev field-attributes (list field-attribute). macro @global! :- get-option "coq:locality" "global". macro @local! :- get-option "coq:locality" "local". LPCIC-coq-elpi-eb449d7/elpi/coq-elaborator.elpi000066400000000000000000000013351523041753400212230ustar00rootroot00000000000000/* Type inference and unification */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % This file does the plumbing to use Coq's elaborator :name "coq-assign-evar-raw" :before "default-assign-evar" evar X Ty R :- var R, !, of X Ty R. :name "coq-assign-evar-refined" :before "default-assign-evar" evar X Ty R :- not(var R), !, coq.typecheck R Ty ok, X = R. pred unify-eq i:term, i:term. unify-eq A B :- coq.unify-eq A B ok. pred unify-leq i:term, i:term. unify-leq A B :- coq.unify-leq A B ok. func of term -> term, term. of T Ty TR :- !, coq.elaborate-skeleton T Ty TR ok. LPCIC-coq-elpi-eb449d7/elpi/coq-elpi-checker.elpi000066400000000000000000000025541523041753400214300ustar00rootroot00000000000000/* rocq-elpi: Coq terms as the object language of elpi */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % redirect to Coq type checking messages :before "default-typechecking-error" error [] _ :- !. :before "default-typechecking-error" error [pr L M] tt :- !, coq.error L M. :before "default-typechecking-error" error [pr L M|MS] tt :- Msgs = [pr L M|MS], all-same-loc L Msgs, !, coq.error L "At least one of the following errors holds:" {error-concat-noloc Msgs}. :before "default-typechecking-error" error Msgs tt :- !, coq.error "At least one of the following errors holds:" {error-concat Msgs}. func error-concat list string -> string. error-concat L R :- std.string.concat "\n" {std.map L error-pp-wloc} R. func error-concat-noloc list string -> string. error-concat-noloc L R :- std.string.concat "\n" {std.map L error-pp-noloc} R. func error-pp-wloc pair loc string -> string. error-pp-wloc (pr L S) R :- R is {std.any->string L} ^ " " ^ S. func error-pp-noloc pair loc string -> string. error-pp-noloc (pr _ S) R :- R is "- " ^ S. func all-same-loc loc, list (pair loc string) ->. all-same-loc L XS :- std.forall XS (x\sigma s\x = pr L s). :before "default-typechecking-warning" warning L M :- !, coq.warning "elpi" "elpi.typecheck" L M. LPCIC-coq-elpi-eb449d7/elpi/coq-lib-common.elpi000066400000000000000000000155461523041753400211360ustar00rootroot00000000000000/* rocq-elpi: Helpers common to synterp and interp */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{fatal-error, fatal-error-w-data, debug-print}. :before "default-fatal-error" fatal-error M :- !, stop M. :before "default-fatal-error-w-data" fatal-error-w-data Msg Data :- !, term_to_string Data DataS, M is Msg ^ ": " ^ DataS, stop M. :before "default-debug-print" debug-print M Data :- !, coq.debug M Data. % HACK: elpi's stop has no argument func stop string. :name "stop:begin" stop S :- coq.error S. % halt S %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func coq.parse-attributes list attribute, list attribute-signature -> list prop. % Coq attribute parser, eg [#[attribute=value] Command] % % Usage: % main _ :- % attributes A, % fetch % coq.parse-attributes A Spec Opts, % parse/validate % Opts => (mycode, get-option "foo" V, mycode). % use % % where [Opts] is a list of clauses [get-option StringName Value], where value % can have any type and [Spec] is a list of [attribute-sigmature]. % Example of an attribute signature: % [ % att "this" bool, % att "that.thing" int, % att "algebraic" (oneof ["foo" `-> foo-thing, "bar" `-> barbar]), % ] % % Env variable COQ_ELPI_ATTRIBUTES can be used to pass attributes to all % commands. These attributes names are prefixed by 'elpi.' and are of type % string. % % Eg. % COQ_ELPI_ATTRIBUTES=test=yes,str="some-string" coqc foo.v % results in commands in foo.v to receive % [ attribute "elpi.test" (leaf "yes") , % attribute "elpi.str" (leaf "some-string") | ...] % which are automatically accepted and give rise to % get-option "elpi.test" "yes" % get-option "elpi.str" "some-string" kind attribute-signature type. type att string -> attribute-type -> attribute-signature. type att-ignore-unknown attribute-signature. type supported-attribute attribute-signature -> prop. supported-attribute (att "elpi.loc" loc). supported-attribute (att Name string) :- rex_match "^elpi\\." Name. kind attribute-type type. type int attribute-type. type string attribute-type. type bool attribute-type. type oneof list attribute-mapping -> attribute-type. type attmap attribute-type. % #[map(k1="v1",k2="v2")] type attlist attribute-type. % #[set(b1,b2,b3)] type attlabel attribute-type. % #[label( a(..), b, .. )] if #[label(a, b), a(..), ..] type loc attribute-type. kind attribute-mapping type. type (`->) string -> any -> attribute-mapping. func coq.valid-str-attribute string, string -> option any, diagnostic. coq.valid-str-attribute Name Value V Diag :- if (supported-attribute (att Name Type)) (coq.typecheck-attribute Name Type Value LPV Diag, V = some LPV) (if (supported-attribute att-ignore-unknown) (V = none, Diag = ok) (Diag = error {calc ( "Attribute " ^ Name ^ " is not supported")})). func coq.valid-loc-attribute string, loc -> diagnostic. coq.valid-loc-attribute Name Loc Diag :- if (supported-attribute (att Name loc)) (if (primitive? Loc "loc") (Diag = ok) (Diag = error {calc ( "Attribute " ^ Name ^ " takes a loc, got " ^ {std.any->string Loc} ) } )) (if (supported-attribute att-ignore-unknown) (Diag = ok) (Diag = error {calc ( "Attribute " ^ Name ^ " is not supported")})). :index (_ 1 1) func coq.typecheck-attribute string, attribute-type, string -> any, diagnostic. coq.typecheck-attribute _ int Value V ok :- V is string_to_int Value, !. coq.typecheck-attribute N int Value _ (error Msg) :- Msg is "Attribute " ^ N ^ " takes an integer, got: " ^ Value. coq.typecheck-attribute _ string V V ok. coq.typecheck-attribute _ bool "true" tt ok :- !. coq.typecheck-attribute _ bool "tt" tt ok :- !. coq.typecheck-attribute _ bool "True" tt ok :- !. coq.typecheck-attribute _ bool "on" tt ok :- !. coq.typecheck-attribute _ bool "yes" tt ok :- !. coq.typecheck-attribute _ bool "" tt ok :- !. coq.typecheck-attribute _ bool "false" ff ok :- !. coq.typecheck-attribute _ bool "False" ff ok :- !. coq.typecheck-attribute _ bool "off" ff ok :- !. coq.typecheck-attribute _ bool "ff" ff ok :- !. coq.typecheck-attribute _ bool "no" ff ok :- !. coq.typecheck-attribute N bool Value _ (error Msg) :- Msg is "Attribute " ^ N ^ " takes an boolean, got: " ^ Value. :functional pred coq.is-one-of i:string, o:any, i:attribute-mapping. coq.is-one-of K V (K `-> V). coq.typecheck-attribute _ (oneof L) K V ok :- std.exists L (coq.is-one-of K V), !. coq.typecheck-attribute N (oneof L) K _ (error Msg) :- std.map L (x\r\ sigma tmp\ x = r `-> tmp) S, std.fold S "" (s\ a\ calc (a ^ " " ^ s)) OneOf, Msg is "Attribute " ^ N ^ " takes one of " ^ OneOf ^ ", got: " ^ K. func append-string string, string -> string. append-string "" A A :- !. append-string A B R :- R is A ^ "." ^ B. func keep-only-label attribute -> attribute. keep-only-label (attribute L _) (attribute L (leaf-str "")). coq.parse-attributes L S O :- std.map S (x\r\ r = supported-attribute x) CS, CS => parse-attributes.aux L "" O, !. :index (1) func parse-attributes.aux list attribute, string -> list prop. parse-attributes.aux [] _ []. parse-attributes.aux [attribute S (node L)|AS] Prefix R :- append-string Prefix S PS, supported-attribute (att PS attlist), !, parse-attributes.aux AS Prefix R1, ((pi x\ supported-attribute (att x bool) :- !) ==> parse-attributes.aux L "" Map), std.append R1 [get-option PS Map] R. parse-attributes.aux [attribute S (node L)|AS] Prefix R :- append-string Prefix S PS, supported-attribute (att PS attmap), !, parse-attributes.aux AS Prefix R1, ((pi x\ supported-attribute (att x string) :- !) ==> parse-attributes.aux L "" Map), std.append R1 [get-option PS Map] R. parse-attributes.aux [attribute S (node L)|AS] Prefix R :- append-string Prefix S PS, supported-attribute (att PS attlabel), !, parse-attributes.aux AS Prefix R1, std.map L keep-only-label Ll, ((pi x\ supported-attribute (att x bool) :- !) ==> parse-attributes.aux Ll "" Map), parse-attributes.aux L Prefix R2, std.append R1 [get-option PS Map|R2] R. parse-attributes.aux [attribute S (node L)|AS] Prefix R :- !, parse-attributes.aux AS Prefix R1, append-string Prefix S PS, parse-attributes.aux L PS R2, std.append R1 R2 R. parse-attributes.aux [attribute S (leaf-str V)|AS] Prefix CLS :- !, append-string Prefix S PS, coq.valid-str-attribute PS V V1 Diag, if (Diag = error Msg) (coq.error Msg) true, if (V1 = some Val) (CLS = [get-option PS Val|R]) (CLS = R), % ignored parse-attributes.aux AS Prefix R. parse-attributes.aux [attribute S (leaf-loc V)|AS] Prefix CLS :- !, append-string Prefix S PS, coq.valid-loc-attribute PS V Diag, if (Diag = error Msg) (coq.error Msg) true, CLS = [get-option PS V|R], parse-attributes.aux AS Prefix R. LPCIC-coq-elpi-eb449d7/elpi/coq-lib.elpi000066400000000000000000001154651523041753400176510ustar00rootroot00000000000000/* rocq-elpi: Coq terms as the object language of elpi */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ accumulate elpi_elpi/coq-lib-common. shorten std.{fatal-error, fatal-error-w-data, debug-print, unsafe-cast}. shorten std.{rev, map, append, appendR, map2, forall-ok, take, do-ok!, lift-ok}. shorten std.{ omap, take-last, intersperse, map-ok, string.concat }. :before "stop:begin" stop S :- get-option "ltac:fail" N, !, coq.ltac.fail N S. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Helpers % % Pure LP code that works with the data types and API above. % Named clauses are natural extension points, eg one can extend % subst-prod to perform reduction in order to expose a "prod" node. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Term surgery %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func coq.subst-prod list term, term -> term. coq.subst-prod [] P P :- !. coq.subst-prod [X|XS] (prod _ _ F) P :- !, coq.subst-prod XS (F X) P. coq.subst-prod XS (let _ _ X F) P :- !, coq.subst-prod XS (F X) P. :name "subst-prod:fail" coq.subst-prod [_|_] T _ :- !, fatal-error-w-data "subst-prod: not a product" T. func coq.subst-fun list term, term -> term. coq.subst-fun [] T T :- !. coq.subst-fun [X|XS] (fun _ _ F) T :- !, coq.subst-fun XS (F X) T. coq.subst-fun XS (let _ _ X F) T :- !, coq.subst-fun XS (F X) T. :name "subst-fun:fail" coq.subst-fun [_|_] T _ :- !, fatal-error-w-data "subst-fun: not a lambda" T. func coq.prod-R-fun -> term, term. coq.prod-R-fun (prod N T F) (fun N T R) :- !, pi x\ coq.prod-R-fun (F x) (R x). coq.prod-R-fun (let N T B F) (let N T B R) :- !, pi x\ coq.prod-R-fun (F x) (R x). coq.prod-R-fun X X. func coq.prod->fun term -> term. coq.prod->fun (prod N T F) (fun N T R) :- !, pi x\ coq.prod->fun (F x) (R x). coq.prod->fun (let N T B F) (let N T B R) :- !, pi x\ coq.prod->fun (F x) (R x). coq.prod->fun X X. func coq.count-prods term -> int. coq.count-prods (prod N T B) C :- !, (@pi-decl N T x\ coq.count-prods (B x) C'), C is C' + 1. coq.count-prods (let N T V B) C :- !, (@pi-def N T V x\ coq.count-prods (B x) C). coq.count-prods T C :- !, coq.reduction.lazy.whd T Tr, if (T == Tr) (C = 0) (coq.count-prods Tr C). func coq.mk-n-holes int -> list A. coq.mk-n-holes 0 [] :- !. coq.mk-n-holes N [HOLE_|R] :- !, M is N - 1, coq.mk-n-holes M R. func coq.safe-dest-app term -> term, list term. coq.safe-dest-app (app [X|XS]) HD AllArgs :- !, coq.safe-dest-app X HD ARGS, append ARGS XS AllArgs. coq.safe-dest-app X X []. % coq.mk-eta n Ty T: performs up to n (when >= 0) eta expasion of T % according to its type Ty. If n < 0 it makes as many step as % products in Ty. There be dragons if T has not type Ty. func coq.mk-eta int, term, term -> term. coq.mk-eta 0 _ B B :- !. coq.mk-eta N (prod Name Ty P) (fun _ _ F) (fun Name Ty F1) :- !, N1 is N - 1, pi x \ coq.mk-eta N1 (P x) (F x) (F1 x). coq.mk-eta N (prod Name Ty P) B (fun Name Ty B1) :- !, N1 is N - 1, pi x \ coq.mk-eta N1 (P x) {coq.mk-app B [x]} (B1 x). :name "mk-eta:end" coq.mk-eta _ _ B B :- !. func coq.saturate term, term -> term. coq.saturate Ty T O :- whd Ty [] (prod N Src Tgt) [], !, coq.mk-app T [Hole_] R, @pi-decl N Src x\ coq.saturate (Tgt x) R O. coq.saturate _ X X. % [copy A B] can be used to perform a replacement, eg % (copy (const "foo") (const "bar") :- !) => copy A B % traverses A replacing foo with bar. func copy term -> term. :name "copy:start" copy X Y :- name X, !, X = Y, !. % avoid loading "copy x x" at binders copy (global _ as C) C :- !. copy (pglobal _ _ as C) C :- !. copy (sort _ as C) C :- !. copy (fun N T F) (fun N T1 F1) :- !, copy T T1, pi x\ copy (F x) (F1 x). copy (let N T B F) (let N T1 B1 F1) :- !, copy T T1, copy B B1, pi x\ copy (F x) (F1 x). copy (prod N T F) (prod N T1 F1) :- !, copy T T1, (pi x\ copy (F x) (F1 x)). copy (app L) (app L1) :- !, map L copy L1. copy (fix N Rno Ty F) (fix N Rno Ty1 F1) :- !, copy Ty Ty1, pi x\ copy (F x) (F1 x). copy (mfix F Rno MF) (mfix F Rno MF1) :- !, copy-mfix-block MF MF1. copy (match T Rty B) (match T1 Rty1 B1) :- !, copy T T1, copy Rty Rty1, map B copy B1. copy (primitive _ as C) C :- !. copy (uvar M L as X) W :- var X, !, map L copy L1, coq.mk-app-uvar M L1 W. % when used in CHR rules copy (uvar X L) (uvar X L1) :- !, map L copy L1. func copy-mfix-block mfix-block -> mfix-block. copy-mfix-block (mfix-ty N Rno Ty F) (mfix-ty N Rno Ty1 F1) :- !, copy Ty Ty1, pi x\ copy-mfix-block (F x) (F1 x). copy-mfix-block (mfix-bo Bs) (mfix-bo Bs1) :- !, map Bs copy Bs1. func copy-ctx-item prop -> prop. copy-ctx-item (decl X N T) (decl X1 N T1) :- copy X X1, copy T T1. copy-ctx-item (def X N T B) (def X1 N T1 B1) :- copy X X1, copy T T1, copy B B1. func copy-arity arity -> arity. copy-arity (parameter ID IMP T R) (parameter ID IMP T1 R1) :- copy T T1, pi x\ copy-arity (R x) (R1 x). copy-arity (arity T) (arity T1) :- copy T T1. func copy-indt-decl indt-decl -> indt-decl. copy-indt-decl (parameter ID I Ty D) (parameter ID I Ty1 D1) :- copy Ty Ty1, @pi-parameter ID Ty1 x\ copy-indt-decl (D x) (D1 x). copy-indt-decl (inductive ID CO A D) (inductive ID CO A1 D1) :- copy-arity A A1, @pi-inductive ID A1 i\ std.map (D i) copy-constructor (D1 i). copy-indt-decl (minductive ID CO A D) (minductive ID CO A1 D1) :- copy-arity A A1, @pi-inductive ID A1 i\ copy-indt-decl (D i) (D1 i). copy-indt-decl (mblock Bs) (mblock Bs1) :- map Bs copy-constructor-block Bs1. copy-indt-decl (record ID T IDK F) (record ID T1 IDK F1) :- copy T T1, copy-fields F F1. func copy-constructor-block list indc-decl -> list indc-decl. copy-constructor-block Ks Ks1 :- map Ks copy-constructor Ks1. func copy-fields record-decl -> record-decl. copy-fields end-record end-record. copy-fields (field Att ID T F) (field Att ID T1 F1) :- copy T T1, @pi-parameter ID T1 x\ copy-fields (F x) (F1 x). func copy-constructor indc-decl -> indc-decl. copy-constructor (constructor ID A) (constructor ID A1) :- copy-arity A A1. func fold-map term, A -> term, A. :name "fold-map:start" fold-map X A Y A :- name X, !, X = Y, !. % avoid loading "fold-map x A x A" at binders fold-map (global _ as C) A C A :- !. fold-map (pglobal _ _ as C) A C A :- !. fold-map (sort _ as C) A C A :- !. fold-map (fun N T F) A (fun N T1 F1) A2 :- !, fold-map T A T1 A1, pi x\ fold-map (F x) A1 (F1 x) A2. fold-map (let N T B F) A (let N T1 B1 F1) A3 :- !, fold-map T A T1 A1, fold-map B A1 B1 A2, pi x\ fold-map (F x) A2 (F1 x) A3. fold-map (prod N T F) A (prod N T1 F1) A2 :- !, fold-map T A T1 A1, (pi x\ fold-map (F x) A1 (F1 x) A2). fold-map (app L) A (app L1) A1 :- !, std.fold-map L A fold-map L1 A1. fold-map (fix N Rno Ty F) A (fix N Rno Ty1 F1) A2 :- !, fold-map Ty A Ty1 A1, pi x\ fold-map (F x) A1 (F1 x) A2. fold-map (mfix F Rno MF) A (mfix F Rno MF1) A1 :- !, fold-map-mfix-block MF A MF1 A1. fold-map (match T Rty B) A (match T1 Rty1 B1) A3 :- !, fold-map T A T1 A1, fold-map Rty A1 Rty1 A2, std.fold-map B A2 fold-map B1 A3. fold-map (primitive _ as C) A C A :- !. fold-map (uvar M L as X) A W A1 :- var X, !, std.fold-map L A fold-map L1 A1, coq.mk-app-uvar M L1 W. % when used in CHR rules fold-map (uvar X L) A (uvar X L1) A1 :- std.fold-map L A fold-map L1 A1. func fold-map-mfix-block mfix-block, A -> mfix-block, A. fold-map-mfix-block (mfix-ty N Rno Ty F) A (mfix-ty N Rno Ty1 F1) A2 :- !, fold-map Ty A Ty1 A1, pi x\ fold-map-mfix-block (F x) A1 (F1 x) A2. fold-map-mfix-block (mfix-bo Bs) A (mfix-bo Bs1) A1 :- !, std.fold-map Bs A fold-map Bs1 A1. func fold-map-ctx-item prop, A -> prop, A. fold-map-ctx-item (decl X N T) A (decl X1 N T1) A2 :- fold-map X A X1 A1, fold-map T A1 T1 A2. fold-map-ctx-item (def X N T B) A (def X1 N T1 B1) A3 :- fold-map X A X1 A1, fold-map T A1 T1 A2, fold-map B A2 B1 A3. func fold-map-arity arity, A -> arity, A. fold-map-arity (parameter ID IMP T R) A (parameter ID IMP T1 R1) A2 :- fold-map T A T1 A1, pi x\ fold-map-arity (R x) A1 (R1 x) A2. fold-map-arity (arity T) A (arity T1) A1 :- fold-map T A T1 A1. % Bridges the gap between the data types used to read/write inductives. % The arguments are the same of coq.env.indt plus an an extra one being % the output (of type indt-decl). func coq.upoly-decl->attribute any -> prop. coq.upoly-decl->attribute (upoly-decl A B C D) (@udecl! A B C D). coq.upoly-decl->attribute (upoly-decl-cumul A B C D) (@udecl-cumul! A B C D). func coq.upoly-decl.complete-constraints upoly-decl -> upoly-decl. coq.upoly-decl.complete-constraints (upoly-decl VS LV CS LC) (upoly-decl VS LV CS1 LC) :- std.do! [ std.map VS coq.univ.variable.constraints ExtraL, std.flatten ExtraL Extra, std.filter Extra (c\not(std.mem CS c)) New, std.append CS New CS1, ]. coq.upoly-decl.complete-constraints (upoly-decl-cumul VS LV CS LC) (upoly-decl-cumul VS LV CS1 LC) :- std.do! [ std.map VS coq.upoly-decl-cumul.complete-constraints.aux ExtraL, std.flatten ExtraL Extra, std.filter Extra (c\not(std.mem CS c)) New, std.append CS New CS1, ]. func coq.upoly-decl-cumul.complete-constraints.aux univ-variance -> list univ-constraint. coq.upoly-decl-cumul.complete-constraints.aux (auto V) CS :- coq.univ.variable.constraints V CS. coq.upoly-decl-cumul.complete-constraints.aux (covariant V) CS :- coq.univ.variable.constraints V CS. coq.upoly-decl-cumul.complete-constraints.aux (invariant V) CS :- coq.univ.variable.constraints V CS. coq.upoly-decl-cumul.complete-constraints.aux (irrelevant V) CS :- coq.univ.variable.constraints V CS. kind coq.indt-spec type. type coq.indt-spec inductive -> id -> bool -> term -> list (pair constructor id) -> list term -> coq.indt-spec. func coq.build-indt-decl coq.indt-spec, int, int -> indt-decl. coq.build-indt-decl (coq.indt-spec I ID IsInd Arity Kns Ktys) Pno UPno Decl :- coq.build-indt-decl-aux (pr I ID) IsInd Pno UPno Arity Kns Ktys [] Decl. func coq.build-indt-decl-aux pair inductive id, bool, int, int, term, list (pair constructor id), list term, list term -> indt-decl. coq.build-indt-decl-aux (pr GR I) IsInd NUPno 0 Ty Kns KtysNu Params (inductive I IsInd Arity Ks) :- !, coq.term->arity Ty NUPno Arity, std.map KtysNu (k\coq.term->arity k NUPno) Ktys, rev Params ParamsR, (pi i\ Sub i = [ % we factor uniform parameters (pi x l\ copy (app[global (indt GR)|l]) (app[i|x]):- !, appendR ParamsR x l, !), (pi x l ui\ copy (app[pglobal (indt GR) ui|l]) (app[i|x]):- !, appendR ParamsR x l, !), (copy (global (indt GR)) i :- !), (pi ui\ copy (pglobal (indt GR) ui) i :- !) ]), pi i\ map2 Kns Ktys (gr_name\ ty\ res\ sigma tmp name\ (Sub i ==> copy-arity ty tmp), gr_name = pr _ name, res = constructor name tmp) (Ks i). coq.build-indt-decl-aux GR IsInd Pno UPno (prod N S T) Kns Ktys Params (parameter NS explicit S Res) :- Pno > 0, UPno > 0, !, coq.name->id N NS, Pno1 is Pno - 1, UPno1 is UPno - 1, pi p\ map Ktys (coq.subst-prod [p]) (Ktys1 p), coq.build-indt-decl-aux GR IsInd Pno1 UPno1 (T p) Kns (Ktys1 p) [p|Params] (Res p). :name "coq.build-indt-decl-aux:fail" coq.build-indt-decl-aux _ _ _ _ _ _ _ _ _ :- !, fatal-error "coq.build-indt-decl-aux: invalid declaration". func coq.build-mindt-decl list coq.indt-spec, int, int -> indt-decl. coq.build-mindt-decl Specs Pno UPno Decl :- coq.build-mindt-decl-aux Specs Pno UPno [] Decl. func coq.build-mindt-decl-aux list coq.indt-spec, int, int, list term -> indt-decl. coq.build-mindt-decl-aux Specs 0 0 Params Decl :- !, rev Params ParamsR, coq.build-mindt-decl-binders Specs Specs ParamsR [] Decl. coq.build-mindt-decl-aux ([coq.indt-spec _ _ _ (prod N S _) _ _|_] as Specs) Pno UPno Params (parameter NS explicit S Res) :- Pno > 0, UPno > 0, !, coq.name->id N NS, Pno1 is Pno - 1, UPno1 is UPno - 1, pi p\ std.map Specs (coq.build-mindt-decl-subst-param p) Specs1, coq.build-mindt-decl-aux Specs1 Pno1 UPno1 [p|Params] (Res p). :name "coq.build-mindt-decl-aux:fail" coq.build-mindt-decl-aux _ _ _ _ _ :- !, fatal-error "coq.build-mindt-decl-aux: invalid mutual declaration". func coq.build-mindt-decl-subst-param term, coq.indt-spec -> coq.indt-spec. coq.build-mindt-decl-subst-param P (coq.indt-spec GR ID IsInd (prod _ _ T) Kns Ktys) (coq.indt-spec GR ID IsInd (T P) Kns Ktys1) :- !, std.map Ktys (coq.subst-prod [P]) Ktys1. coq.build-mindt-decl-subst-param _ _ _ :- !, fatal-error "coq.build-mindt-decl-subst-param: parameter mismatch". func coq.build-mindt-decl-binders list coq.indt-spec, list coq.indt-spec, list term, list (pair inductive term) -> indt-decl. coq.build-mindt-decl-binders All [] ParamsR Acc (mblock Blocks) :- !, rev Acc Pairs, std.map All (coq.build-mindt-decl-block Pairs ParamsR) Blocks. coq.build-mindt-decl-binders All [coq.indt-spec GR ID IsInd Ty _ _|Rest] ParamsR Acc (minductive ID IsInd Arity More) :- !, coq.term->arity Ty 0 Arity, @pi-inductive ID Arity i\ coq.build-mindt-decl-binders All Rest ParamsR [pr GR i|Acc] (More i). func coq.build-mindt-decl-block list (pair inductive term), list term, coq.indt-spec -> list indc-decl. coq.build-mindt-decl-block Pairs ParamsR (coq.indt-spec _ _ _ _ Kns Ktys) Block :- coq.build-mindt-decl-copy-clauses Pairs ParamsR Sub, std.map2 Kns Ktys (gr_name\ ty\ res\ sigma tmp name ar\ (Sub ==> copy ty tmp), coq.term->arity tmp 0 ar, gr_name = pr _ name, res = constructor name ar) Block. func coq.build-mindt-decl-copy-clauses list (pair inductive term), list term -> list prop. coq.build-mindt-decl-copy-clauses [] _ []. coq.build-mindt-decl-copy-clauses [pr GR I|Rest] ParamsR [ (pi l rest r\ copy (app[global (indt GR)|l]) r :- !, std.append ParamsR rest l, coq.mk-app I rest r, !), (pi l rest r ui\ copy (app[pglobal (indt GR) ui|l]) r :- !, std.append ParamsR rest l, coq.mk-app I rest r, !), (copy (global (indt GR)) I :- !), (pi ui\ copy (pglobal (indt GR) ui) I :- !) | More] :- coq.build-mindt-decl-copy-clauses Rest ParamsR More. % [coq.indt-unif->indt-nonunif I O] takes an inductive declaration I which may % contain uniform parameters (i.e. be headed by the `parameter` constructor), % and returns in O the inductive declaration obtained by pushing the uniform % parameters into the arities of the inductive and the constructors. % % In rocq-elpi's encoding this makes them non-uniform parameters, but beware % that when passed to coq.env.add-indt, Rocq reassigns the uniformity of % parameters as it sees fit, so reading back the declaration of an inductive % added with coq.env.add-indt might give you an inductive with uniform % parameters anyway. % % When the inductive passed is a record, it is interpreted as an inductive % with one constructor. func coq.indt-unif->indt-nonunif indt-decl -> indt-decl. coq.indt-unif->indt-nonunif (parameter N Expl Ty RestI) (inductive IN IsInd IA Cs) :- % Reparameterize the inductive and constructors' arities by a fresh variable % standing for this parameter (pi p\ coq.indt-unif->indt-nonunif (RestI p) (inductive IN IsInd (InnerIA p) (InnerCs p))), % This way the continuation of the new arity is already abstracted over the parameter IA = parameter N Expl Ty InnerIA, % InnerCs is parameterized by two terms: first standing for the current % parameter, second standing for the inductive already applied to this % parameter. This makes it have the type (term -> term -> list constructor). % Since we want to bind the current parameter in each constructor % individually, we need to push those two arguments inside the list. The shape % of the list doesn't depend on these arguments, so we can map over it under % binders, and then only allow the elements of the list to refer to the fresh % variables, but not the list itself. % We end up with the more useful (InnerCsList : list (term -> term -> constructor)). (pi sI sP\ map (InnerCs sP sI) (i\ o\ o sP sI = i) InnerCsList), % Abstract over the inductive we're producing. In the constructor arities, % this variable is supposed to be applied to the inner parameters. (pi i\ map InnerCsList (ic\ oc\ sigma cname carr\ % Decompose the inner constructor; the name doesn't depend on the terms (pi sP sI\ ic sP sI = constructor cname (carr sP sI)), % Add the parameter to the constructor, instantiating the arguments as expected oc = constructor cname (parameter N Expl Ty a\ carr a (app [i, a]))) (Cs i)). coq.indt-unif->indt-nonunif (inductive _ _ _ _ as I) I. coq.indt-unif->indt-nonunif (record N Ty CN Decl) (inductive N tt (arity Ty) C) :- coq.record-decl->arity Decl Ar, pi c\ C c = [constructor CN (arity (Ar c))]. % [coq.record-decl->arity R T] takes a record declaration R and returns in T % the type of the the record's constructor, parameterized by a term standing % for the record type. func coq.record-decl->arity record-decl -> (term -> term). coq.record-decl->arity (field _ Id Ty RestF) (r\ prod N Ty (RestT r)) :- !, coq.id->name Id N, pi x\ coq.record-decl->arity (RestF x) (r\ RestT r x). coq.record-decl->arity end-record (r\ r) :- !. :index (_ 1) func coq.rename-arity (func id -> id), arity -> arity. coq.rename-arity RP (parameter ID I TY In) (parameter ID1 I TY Out) :- RP ID ID1, @pi-parameter ID TY p\ coq.rename-arity RP (In p) (Out p). coq.rename-arity _ (arity T) (arity T). % [coq.rename-indt-decl RenameParam RenameIndType RenameIndConstr D D1] % can be used to rename all [id] part of an inductive type declaration :index (_ _ _ 1) func coq.rename-indt-decl (func id -> id), (func id -> id), (func id -> id), indt-decl -> indt-decl. coq.rename-indt-decl RP RI RK (parameter ID I TY In) (parameter ID1 I TY Out) :- RP ID ID1, @pi-parameter ID TY p\ coq.rename-indt-decl RP RI RK (In p) (Out p). coq.rename-indt-decl RP RI RK (inductive ID Ind A In) (inductive ID1 Ind A1 Out) :- RI ID ID1, coq.rename-arity RP A A1, coq.id->name ID Name, coq.arity->term A TY, @pi-decl Name TY i\ std.map (In i) (coq.rename-indt-decl.aux RP RI RK) (Out i). coq.rename-indt-decl RP RI RK (minductive ID Ind A In) (minductive ID1 Ind A1 Out) :- RI ID ID1, coq.rename-arity RP A A1, coq.id->name ID Name, coq.arity->term A TY, @pi-decl Name TY i\ coq.rename-indt-decl RP RI RK (In i) (Out i). coq.rename-indt-decl RP RI RK (mblock Blocks) (mblock Blocks1) :- map Blocks (coq.rename-indt-decl.block RP RI RK) Blocks1. coq.rename-indt-decl _ RI RK (record ID A KID F) (record ID1 A KID1 F) :- RI ID ID1, RK KID KID1. func coq.rename-indt-decl.block (func id -> id), (func id -> id), (func id -> id), list indc-decl -> list indc-decl. coq.rename-indt-decl.block RP RI RK Ks Ks1 :- map Ks (coq.rename-indt-decl.aux RP RI RK) Ks1. func coq.rename-indt-decl.aux (func id -> id), (func id -> id), (func id -> id), indc-decl -> indc-decl. coq.rename-indt-decl.aux RP _ RK (constructor ID A) (constructor ID1 A1) :- RK ID ID1, coq.rename-arity RP A A1. func coq.ensure-fresh-global-id string -> string. coq.ensure-fresh-global-id Exp S :- Name is Exp, coq.env.fresh-global-id Name S, if (Name = S) true (coq.warning "elpi" "elpi.renamed" "Global name" Name "is taken, using" S "instead"). % Lifts coq.typecheck to inductive declarations func coq.typecheck-indt-decl.heuristic-var-type term -> diagnostic. coq.typecheck-indt-decl.heuristic-var-type (uvar _ _ as X) D :- !, coq.univ.new U, coq.unify-eq X (sort (typ U)) D. coq.typecheck-indt-decl.heuristic-var-type _ ok. func coq.typecheck-indt-arity arity -> term, int, diagnostic. coq.typecheck-indt-arity (parameter ID _ T D) (prod N T F) NU1 Diag :- do-ok! Diag [ coq.typecheck-ty T _, (d\ @pi-parameter ID T x\ coq.typecheck-indt-arity (D x) (F x) NU d), lift-ok (NU1 is NU + 1) "", lift-ok (coq.id->name ID N) "", ]. coq.typecheck-indt-arity (arity T) T 0 Diag :- do-ok! Diag [ coq.typecheck-ty T _, coq.typecheck-indt-decl.heuristic-var-type T, ]. func coq.typecheck-indt-decl indt-decl -> diagnostic. coq.typecheck-indt-decl (parameter ID _ T Decl) Diag :- do-ok! Diag [ coq.typecheck-ty T _, (d\ @pi-parameter ID T x\ coq.typecheck-indt-decl (Decl x) d), ]. coq.typecheck-indt-decl (inductive ID _ Arity KDecl) Diag :- do-ok! Diag [ coq.typecheck-indt-arity Arity A NUPNO, d\ @pi-parameter ID A i\ forall-ok (KDecl i) (coq.typecheck-indt-decl-c i A NUPNO) d ]. coq.typecheck-indt-decl (minductive ID _ Arity Rest) Diag :- do-ok! Diag [ coq.typecheck-indt-arity Arity A NUPNO, d\ @pi-parameter ID A i\ coq.typecheck-indt-decl-mutual [pr i (pr A NUPNO)] (Rest i) d ]. coq.typecheck-indt-decl (record ID A _IDK FDecl) Diag :- do-ok! Diag [ coq.typecheck-ty A _, d\ @pi-parameter ID A i\ do-ok! d [ lift-ok (coq.typecheck-indt-decl-field i FDecl (K i)) "", coq.typecheck-indt-decl-c i A 0 (constructor "fields" (arity (K i))) ] ]. func coq.typecheck-indt-decl-mutual list (pair term (pair term int)), indt-decl -> diagnostic. coq.typecheck-indt-decl-mutual Acc (minductive ID _ Arity Rest) Diag :- !, do-ok! Diag [ coq.typecheck-indt-arity Arity A NUPNO, d\ @pi-parameter ID A i\ coq.typecheck-indt-decl-mutual [pr i (pr A NUPNO)|Acc] (Rest i) d ]. coq.typecheck-indt-decl-mutual Acc (mblock Blocks) Diag :- !, rev Acc Infos, coq.typecheck-indt-decl-blocks Infos Blocks Diag. coq.typecheck-indt-decl-mutual _ _ (error "minductive/mblock expected") :- !. func coq.typecheck-indt-decl-blocks list (pair term (pair term int)), list (list indc-decl) -> diagnostic. coq.typecheck-indt-decl-blocks [] [] ok :- !. coq.typecheck-indt-decl-blocks [pr I (pr A NUPNO)|Infos] [Ks|Blocks] Diag :- !, do-ok! Diag [ forall-ok Ks (coq.typecheck-indt-decl-c I A NUPNO), d\ coq.typecheck-indt-decl-blocks Infos Blocks d ]. coq.typecheck-indt-decl-blocks _ _ (error "mblock constructor block count mismatch") :- !. func coq.typecheck-indc-arity arity, int -> term, sort, diagnostic. coq.typecheck-indc-arity A 0 T S Diag :- !, coq.arity->term A T, coq.typecheck-ty T S Diag. coq.typecheck-indc-arity (parameter ID _ T D) NUPNO (prod N T F) S Diag :- do-ok! Diag [ coq.typecheck-ty T _, lift-ok (NUPNO1 is NUPNO - 1) "", (d\ @pi-parameter ID T x\ coq.typecheck-indc-arity (D x) NUPNO1 (F x) S d), lift-ok (coq.id->name ID N) "", ]. func coq.typecheck-indt-decl-c term, term, int, indc-decl -> diagnostic. coq.typecheck-indt-decl-c I S NUPNO (constructor _ID Arity) Diag :- do-ok! Diag [ coq.typecheck-indc-arity Arity NUPNO T KS, coq.typecheck-indt-decl-c.unify-arrow-tgt I 0 S T, lift-ok (coq.arity->sort S IS) "", lift-ok (coq.sort.leq KS IS) "constructor universe too large" ]. :index (_ _ _ 1) func coq.typecheck-indt-decl-c.unify-arrow-tgt term, int, term, term -> diagnostic. coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (prod N S T) D :- !, @pi-decl N S x\ coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (T x) D. coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (let N S B T) D :- !, @pi-def N S B x\ coq.typecheck-indt-decl-c.unify-arrow-tgt I P A (T x) D. coq.typecheck-indt-decl-c.unify-arrow-tgt I P A Concl D :- coq.count-prods A N, coq.mk-n-holes {calc (N + P)} Args, coq.mk-app I Args IArgs, coq.unify-eq Concl IArgs D. :index (_ 2) func coq.typecheck-indt-decl-field term, record-decl -> term. coq.typecheck-indt-decl-field I end-record I. coq.typecheck-indt-decl-field I (field _ ID T F) (prod N T F1) :- coq.id->name ID N, @pi-decl N T a\ coq.typecheck-indt-decl-field I (F a) (F1 a). % Lifts coq.elaborate-skeleton to inductive declarations :index (1) func coq.elaborate-indt-decl-skeleton indt-decl -> indt-decl, diagnostic. coq.elaborate-indt-decl-skeleton (parameter ID Imp T Decl) (parameter ID Imp T1 Decl1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T _ T1, (d\ @pi-parameter ID T1 x\ coq.elaborate-indt-decl-skeleton (Decl x) (Decl1 x) d), ]. coq.elaborate-indt-decl-skeleton (inductive ID I Arity KDecl) (inductive ID I Arity1 KDecl1) Diag :- do-ok! Diag [ coq.elaborate-arity-skeleton Arity _ Arity1, lift-ok (coq.arity->nparams Arity1 NUPNO) "", d\ coq.arity->term Arity1 A1, do-ok! d [ coq.typecheck-indt-decl.heuristic-var-type A1, d\ @pi-parameter ID A1 i\ map-ok (KDecl i) (coq.elaborate-indt-decl-skeleton-c i Arity1 NUPNO) (KDecl1 i) d ] ]. coq.elaborate-indt-decl-skeleton (minductive ID I Arity Rest) (minductive ID I Arity1 Rest1) Diag :- do-ok! Diag [ coq.elaborate-arity-skeleton Arity _ Arity1, lift-ok (coq.arity->nparams Arity1 NUPNO) "", d\ coq.arity->term Arity1 A1, do-ok! d [ coq.typecheck-indt-decl.heuristic-var-type A1, d\ @pi-parameter ID A1 i\ coq.elaborate-indt-decl-skeleton-mutual [pr i (pr Arity1 NUPNO)] (Rest i) (Rest1 i) d ] ]. coq.elaborate-indt-decl-skeleton (record ID A IDK FDecl) (record ID A1 IDK FDecl1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton A _ A1, lift-ok (A1 = sort U) "record type is not a sort", d\ @pi-parameter ID A1 i\ coq.elaborate-indt-decl-skeleton-fields U FDecl FDecl1 d ]. :index (_ 1) func coq.elaborate-indt-decl-skeleton-mutual list (pair term (pair arity int)), indt-decl -> indt-decl, diagnostic. coq.elaborate-indt-decl-skeleton-mutual Acc (minductive ID I Arity Rest) (minductive ID I Arity1 Rest1) Diag :- !, do-ok! Diag [ coq.elaborate-arity-skeleton Arity _ Arity1, lift-ok (coq.arity->nparams Arity1 NUPNO) "", d\ coq.arity->term Arity1 A1, do-ok! d [ coq.typecheck-indt-decl.heuristic-var-type A1, d\ @pi-parameter ID A1 i\ coq.elaborate-indt-decl-skeleton-mutual [pr i (pr Arity1 NUPNO)|Acc] (Rest i) (Rest1 i) d ] ]. coq.elaborate-indt-decl-skeleton-mutual Acc (mblock Blocks) (mblock Blocks1) Diag :- !, rev Acc Infos, coq.elaborate-indt-decl-skeleton-blocks Infos Blocks Blocks1 Diag. coq.elaborate-indt-decl-skeleton-mutual _ _ _ (error "minductive/mblock expected") :- !. func coq.elaborate-indt-decl-skeleton-blocks list (pair term (pair arity int)), list (list indc-decl) -> list (list indc-decl), diagnostic. coq.elaborate-indt-decl-skeleton-blocks [] [] [] ok :- !. coq.elaborate-indt-decl-skeleton-blocks [pr I (pr Arity NUPNO)|Infos] [Ks|Blocks] [Ks1|Blocks1] Diag :- !, do-ok! Diag [ map-ok Ks (coq.elaborate-indt-decl-skeleton-c I Arity NUPNO) Ks1, d\ coq.elaborate-indt-decl-skeleton-blocks Infos Blocks Blocks1 d ]. coq.elaborate-indt-decl-skeleton-blocks _ _ _ (error "mblock constructor block count mismatch") :- !. :index (_ 1) func coq.elaborate-indt-decl-skeleton-fields sort, record-decl -> record-decl, diagnostic. coq.elaborate-indt-decl-skeleton-fields _ end-record end-record ok. coq.elaborate-indt-decl-skeleton-fields U (field Att ID A Fields) (field Att ID A1 Fields1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton A UA A1, lift-ok (coq.sort.leq UA U) "constructor universe too large", d\ @pi-parameter ID A1 p\ coq.elaborate-indt-decl-skeleton-fields U (Fields p) (Fields1 p) d ]. func coq.elaborate-indt-decl-skeleton-c term, arity, int, indc-decl -> indc-decl, diagnostic. coq.elaborate-indt-decl-skeleton-c I SA NUPNO (constructor ID Arity) (constructor ID Arity1) Diag :- do-ok! Diag [ coq.elaborate-arity-skeleton-nuparams Arity NUPNO KS Arity1, coq.typecheck-indt-decl-c.unify-arity I 0 SA Arity1, lift-ok (coq.arity->sort {coq.arity->term SA} IS) "", lift-ok (coq.sort.leq KS IS) "constructor universe too large" ]. :index (_ _ 1 1) func coq.typecheck-indt-decl-c.unify-arity term, int, arity, arity -> diagnostic. coq.typecheck-indt-decl-c.unify-arity I PNO (parameter _ _ T1 A) (parameter ID _ T C) D :- do-ok! D [ coq.unify-eq T1 T, lift-ok (PNO1 is PNO + 1) "", d\ @pi-parameter ID T p\ coq.typecheck-indt-decl-c.unify-arity I PNO1 (A p) (C p) d ]. coq.typecheck-indt-decl-c.unify-arity I PNO (arity A) (parameter ID _ T C) D :- @pi-parameter ID T p\ coq.typecheck-indt-decl-c.unify-arity I PNO (arity A) (C p) D. coq.typecheck-indt-decl-c.unify-arity I PNO (arity A) (arity C) D :- coq.typecheck-indt-decl-c.unify-arrow-tgt I PNO A C D. % Lifts coq.elaborate-skeleton to arity func coq.elaborate-arity-skeleton arity -> sort, arity, diagnostic. coq.elaborate-arity-skeleton (parameter ID Imp T A) U3 (parameter ID Imp T1 A1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T U1 T1, (d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton (A i) U2 (A1 i) d), lift-ok (coq.sort.pts-triple U1 U2 U3) "coq.elaborate-arity-skeleton: should not happen", ]. coq.elaborate-arity-skeleton (arity A) U (arity A1) Diag :- coq.elaborate-ty-skeleton A U A1 Diag. :index (1) func coq.elaborate-arity-skeleton-nuparams arity, int -> sort, arity, diagnostic. coq.elaborate-arity-skeleton-nuparams (parameter ID Imp T A) 0 U3 (parameter ID Imp T1 A1) Diag :- !, do-ok! Diag [ coq.elaborate-ty-skeleton T U1 T1, (d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton-nuparams (A i) 0 U2 (A1 i) d), lift-ok (coq.sort.pts-triple U1 U2 U3) "coq.elaborate-arity-skeleton-nuparams: should not happen", ]. coq.elaborate-arity-skeleton-nuparams (parameter ID Imp T A) N U (parameter ID Imp T1 A1) Diag :- do-ok! Diag [ coq.elaborate-ty-skeleton T _ T1, lift-ok (M is N - 1) "", (d\ @pi-parameter ID T1 i\ coq.elaborate-arity-skeleton-nuparams (A i) M U (A1 i) d), ]. coq.elaborate-arity-skeleton-nuparams (arity A) _ U (arity A1) Diag :- coq.elaborate-ty-skeleton A U A1 Diag. func coq.term->arity term, int -> arity. coq.term->arity T 0 (arity T) :- !. coq.term->arity (prod Name S T) N (parameter ID explicit S R) :- N > 0, M is N - 1, coq.name->id Name ID, @pi-decl Name S x\ coq.term->arity (T x) M (R x). % extracts the sort at the end of an arity func coq.arity->sort term -> sort. coq.arity->sort (prod N S X) Y :- !, @pi-decl N S x\ coq.arity->sort (X x) Y. coq.arity->sort (let N T V X) Y :- !, @pi-def N T V x\ coq.arity->sort (X x) Y. coq.arity->sort (sort X) X :- !. coq.arity->sort X Y :- coq.reduction.lazy.whd X Xr, not (X == Xr), !, coq.arity->sort Xr Y. coq.arity->sort T _ :- fatal-error-w-data "arity->sort: not a sort or prod" T. % Counts how many parameters are there func coq.arity->nparams arity -> int. coq.arity->nparams (parameter _ _ _ In) O :- pi x\ coq.arity->nparams (In x) O1, O is O1 + 1. coq.arity->nparams (arity _) 0. % Prints an arity func coq.arity->pp arity -> coq.pp. coq.arity->pp (parameter ID Imp T Arity) (coq.pp.glue Res) :- Res = [coq.pp.box (coq.pp.hv 2) [coq.pp.str A, coq.pp.str ID, coq.pp.str " :", coq.pp.spc,TPP,coq.pp.str B], coq.pp.spc, Rest], if2 (Imp = explicit) (A = "(", B = ")") (Imp = maximal) (A = "{", B = "}") (A = "[", B = "]"), coq.term->pp T TPP, @pi-parameter ID T x\ coq.arity->pp (Arity x) Rest. coq.arity->pp (arity T) (coq.pp.glue [coq.pp.str" : ",TPP]) :- coq.term->pp T TPP. % Get impargs setting from an arity func coq.arity->implicits arity -> list implicit_kind. coq.arity->implicits (parameter Id I Ty F) [I|Is] :- @pi-parameter Id Ty x\ coq.arity->implicits (F x) Is. coq.arity->implicits (arity _) []. func coq.constructor-block->implicits list indc-decl -> list (list implicit_kind). coq.constructor-block->implicits Ks R :- std.map Ks (c\i\sigma a\ c = constructor _ a, coq.arity->implicits a i) R. % Get impargs settings from all inductives in an indt-decl, and from their % constructor blocks, in declaration order. func coq.indt-decl->implicits-all indt-decl -> list (list implicit_kind), list (list (list implicit_kind)). coq.indt-decl->implicits-all (parameter Id I Ty F) Inds1 Ks1 :- @pi-parameter Id Ty x\ coq.indt-decl->implicits-all (F x) Inds Ks, std.map Inds (l\r\ r = [I|l]) Inds1, std.map Ks (b\r\ std.map b (l\r\ r = [I|l]) r) Ks1. coq.indt-decl->implicits-all (record _ _ _ _) [[]] [[[]]]. coq.indt-decl->implicits-all (inductive Id _ A Ks) [Is] [R] :- coq.arity->implicits A Is, @pi-inductive Id A x\ coq.constructor-block->implicits (Ks x) R. coq.indt-decl->implicits-all (minductive Id _ A Rest) [Is|Inds] Ks :- coq.arity->implicits A Is, @pi-inductive Id A x\ coq.indt-decl->implicits-all (Rest x) Inds Ks. coq.indt-decl->implicits-all (mblock Ks) [] R :- std.map Ks coq.constructor-block->implicits R. % Get impargs setting from the first inductive in an indt-decl. func coq.indt-decl->implicits indt-decl -> list implicit_kind, list (list implicit_kind). coq.indt-decl->implicits D Is Ks :- coq.indt-decl->implicits-all D [Is|_] [Ks|_]. % Check if some implicits are set func coq.any-implicit? list implicit_kind ->. coq.any-implicit? L :- std.exists! L (x\not(x = explicit)). % extract gref from terms that happen to have one func coq.term->gref term -> gref. coq.term->gref (global GR) GR :- !. coq.term->gref (pglobal GR _) GR :- !. coq.term->gref (app [Hd|_]) GR :- !, coq.term->gref Hd GR. coq.term->gref (let _ _ T x\x) GR :- !, coq.term->gref T GR. coq.term->gref (primitive (proj Proj _)) (const C) :- coq.env.primitive-projection? Proj C _, !. :name "term->gref:fail" coq.term->gref Term _ :- fatal-error-w-data "term->gref: input has no global reference" Term. func coq.fresh-type -> term. coq.fresh-type (sort (typ U)) :- coq.univ.new U. func coq.sort? term -> . coq.sort? (sort _) :- !. coq.sort? T :- whd1 T T1, coq.sort? T1. % Map the term under a spine of fun nodes func coq.map-under-fun term, % InputTermUnderLams LamBoundVars TheirTypes Result (func term, list term, list term -> term) -> term. coq.map-under-fun T F R :- map-under-fun.aux T [] [] F R. :index (1) func map-under-fun.aux term, list term, list term, (func term, list term, list term -> term) -> term. map-under-fun.aux (fun N T B) AccT AccTy F (fun N T R) :- !, @pi-decl N T x\ map-under-fun.aux (B x) [x|AccT] [T|AccTy] F (R x). map-under-fun.aux (let N T X B) AccT AccTy F (let N T X R) :- !, @pi-def N T X x\ map-under-fun.aux (B x) AccT AccTy F (R x). map-under-fun.aux End AccT AccTy F R :- F End {rev AccT} {rev AccTy} R. func coq.iter-under-fun term, % InputTermUnderLams LamBoundVars TheirTypes (func term, list term, list term ->). coq.iter-under-fun T F :- iter-under-fun.aux T [] [] F. func iter-under-fun.aux term, list term, list term, (func term, list term, list term ->) ->. iter-under-fun.aux (fun N T B) AccT AccTy F :- !, @pi-decl N T x\ iter-under-fun.aux (B x) [x|AccT] [T|AccTy] F. iter-under-fun.aux (let _ _ X B) AccT AccTy F :- !, iter-under-fun.aux (B X) AccT AccTy F. iter-under-fun.aux End AccT AccTy F :- F End {rev AccT} {rev AccTy}. % Build a match given the term and function to build the return type and the % branches func coq.build-match term, % T, the term being matched term, % the type of T, expected to be an inductive, eventually applied % MkRty: IndSort LamBoundVars TheirTypes Result (func term, list term, list term -> term), % MkBranch: Constructor ConstructorTyUnderLams LamBoundVars TheirTypes Result (func term, term, list term, list term -> term) -> term. % match T (.. MkRty) [ .. MkBranch K1, .. MkBranch K2, ..] coq.build-match T Tty RtyF BranchF (match T Rty Bs) :- whd Tty [] HD Args, if2 (HD = global (indt GR)) true (HD = pglobal (indt GR) I) true fail, (@uinstance! I ==> coq.env.indt GR _ Lno _ Arity Kn Kt), take Lno Args LArgs, (@uinstance! I ==> coq.mk-app {coq.env.global (indt GR)} LArgs IndtLArgs), % Rty coq.subst-prod LArgs Arity ArityArgs, coq.bind-ind-arity-no-let IndtLArgs ArityArgs RtyF Rty, % Bs map Kt (coq.subst-prod LArgs) KtArgs, map KtArgs hd-beta-zeta-reduce KtArgsNorm, map KtArgsNorm coq.prod->fun KtArgsLam, map Kn (k\r\ sigma K\ coq.env.global (indc k) K, coq.mk-app K LArgs r) KnArgs, map2 KnArgs KtArgsLam (k\t\coq.map-under-fun t (BranchF k)) Bs. % XXX the list of arguments are often needed in reverse order :functional pred coq.bind-ind-arity % calls K under (fun Arity (x : Ity Arity) =>..) i:term, % the inductive type i:term, % the arity i:(func term, list term, list term -> term), % Sort Vars Tys Out o:term. % :functional pred coq.bind-ind-arity.aux i:term, o:term, i:list term, i:list term, i:term, i:(func term, list term, list term -> term). coq.bind-ind-arity.aux (prod N T B) (fun N T F) AccT AccTy IT K :- !, @pi-decl N T x\ coq.bind-ind-arity.aux (B x) (F x) [x|AccT] [T|AccTy] IT K. coq.bind-ind-arity.aux (let N T X B) (let N T X F) AccT AccTy IT K :- !, @pi-def N T X x\ coq.bind-ind-arity.aux (B x) (F x) AccT AccTy IT K. coq.bind-ind-arity.aux (sort _ as Sort) (fun `i` ITy F) AccT AccTy IT K :- rev AccT Vars, coq.mk-app IT Vars ITy, @pi-decl `i` ITy x\ K Sort {append Vars [x]} {rev [ITy|AccTy]} (F x). coq.bind-ind-arity IT Arity F R :- coq.bind-ind-arity.aux Arity R [] [] IT F. % As above but let-ins are reduced func coq.bind-ind-arity-no-let term, term, (func term, list term, list term -> term) -> term. coq.bind-ind-arity-no-let IT Arity F R :- (pi N T X B F AccT AccTy IT K\ coq.bind-ind-arity.aux (let N T X B) F AccT AccTy IT K :- !, coq.bind-ind-arity.aux (B X) F AccT AccTy IT K) => coq.bind-ind-arity.aux Arity R [] [] IT F. func coq.bind-ind-parameters inductive, (func term, list term, list term -> term) -> term. coq.bind-ind-parameters I K O :- coq.env.indt I _ _ N A _ _, coq.bind-ind-parameters.aux N A [] [] K O. func coq.bind-ind-parameters.aux int, term, list term, list term, (func term, list term, list term -> term) -> term. coq.bind-ind-parameters.aux 0 Ty Vars Tys K O :- !, K Ty {std.rev Vars} {std.rev Tys} O. coq.bind-ind-parameters.aux I (prod N T F) Vs Ts K (fun N T G) :- I > 0, !, J is I - 1, @pi-decl N T x\ coq.bind-ind-parameters.aux J (F x) [x|Vs] [T|Ts] K (G x). coq.bind-ind-parameters.aux I (let N T B F) Vs Ts K (fun N T G) :- I > 0, !, J is I - 1, @pi-def N T B x\ coq.bind-ind-parameters.aux J (F x) [x|Vs] [T|Ts] K (G x). coq.bind-ind-parameters.aux I T Vs Ts K O :- I > 0, whd1 T T', !, coq.bind-ind-parameters.aux I T' Vs Ts K O. % coq.with-TC Class Instance->Clause Code: runs Code under a context augmented with % all instances for Class transformed by Instance->Clause. func coq.with-TC term, (func tc-instance -> prop), (func) ->. coq.with-TC Class Instance->Clause Code :- coq.TC.db-for {coq.term->gref Class} Instances, map Instances Instance->Clause Hyps, !, Hyps => Code. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func coq.replay-synterp-action synterp-action. coq.replay-synterp-action (begin-module ID) :- coq.env.begin-module ID _. coq.replay-synterp-action (end-module MP) :- coq.env.end-module MP. coq.replay-synterp-action (begin-module-type ID) :- coq.env.begin-module-type ID. coq.replay-synterp-action (end-module-type MTP) :- coq.env.end-module-type MTP. coq.replay-synterp-action (apply-module-functor ID) :- coq.env.apply-module-functor ID _ _ _ _ _. coq.replay-synterp-action (apply-module-type-functor ID) :- coq.env.apply-module-type-functor ID _ _ _ _. coq.replay-synterp-action (include-module MP) :- coq.env.include-module MP _. coq.replay-synterp-action (include-module-type MP) :- coq.env.include-module-type MP _. coq.replay-synterp-action (import-module MP) :- coq.env.import-module MP. coq.replay-synterp-action (export-module MP) :- coq.env.export-module MP. coq.replay-synterp-action (begin-section ID) :- coq.env.begin-section ID. coq.replay-synterp-action (end-section) :- coq.env.end-section. func coq.replay-next-synterp-actions. coq.replay-next-synterp-actions :- coq.next-synterp-action Action, !, coq.replay-synterp-action Action, !, coq.replay-next-synterp-actions. coq.replay-next-synterp-actions. LPCIC-coq-elpi-eb449d7/elpi/dune000066400000000000000000000005101523041753400163060ustar00rootroot00000000000000(coq.theory (name elpi_elpi) ; FIXME (package rocq-elpi)) (rule (target dummy.v) (deps (glob_files *.elpi)) (action (with-stdout-to %{target} (progn (run rocq_elpi_shafile %{deps}))))) (install (files (glob_files (*.elpi with_prefix coq/user-contrib/elpi_elpi/))) (section lib_root) (package rocq-elpi)) LPCIC-coq-elpi-eb449d7/elpi/elpi-command-template-synterp.elpi000066400000000000000000000004261523041753400241710ustar00rootroot00000000000000/* Loaded when Elpi Command has a code accumulated at #[synterp] time */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ accumulate elpi_elpi/coq-lib-common. LPCIC-coq-elpi-eb449d7/elpi/elpi-command-template.elpi000066400000000000000000000006611523041753400224700ustar00rootroot00000000000000/* Loaded when Elpi Command is used */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ accumulate elpi_elpi/elpi-reduction. % whd, hd-beta, ... accumulate elpi_elpi/coq-lib. % basic term manipulation routines accumulate elpi_elpi/elpi-ltac. % refine, or, thenl, ... LPCIC-coq-elpi-eb449d7/elpi/elpi-ltac.elpi000066400000000000000000000166021523041753400201660ustar00rootroot00000000000000/* elpi-ltac: building blocks for tactics */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % tactics work on entire sequents, i.e. goals sealed in their proof context typeabbrev tactic (pred sealed-goal -> list sealed-goal). typeabbrev func-tactic (func sealed-goal -> list sealed-goal). % no backtracking % open tactics see the goal context and can generate goals in different context typeabbrev open-tactic (pred goal -> list sealed-goal). typeabbrev func-open-tactic (func goal -> list sealed-goal). % no backtracking % simple tactics see the goal contex and generate subgoals in the same context typeabbrev simple-tactic (pred goal -> list goal). typeabbrev func-simple-tactic (func goal -> list goal). % no backtracking % The one tactic ------------------------------------------------------------ func refine term, goal -> list sealed-goal. refine T G GS :- coq.ltac.refine.elaborate T G GS. % backward compatibility func refine.elaborate term, goal -> list sealed-goal. refine.elaborate T G GL :- coq.ltac.refine.elaborate T G GL. func refine.typecheck term, goal -> list sealed-goal. refine.typecheck T G GL :- coq.ltac.refine.typecheck T G GL. func refine.no_check term, goal -> list sealed-goal. refine.no_check T G GL :- coq.ltac.refine.no_check T G GL. % calling other tactics, with arguments --------------------------------------- func coq.ltac string, sealed-goal -> list sealed-goal. coq.ltac Tac G GS :- coq.ltac.open (x\y\coq.ltac.call-ltac1 Tac x y ok) G GS. namespace coq.ltac { % simple tactics do not change the goal context %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% namespace simple { func call string, list argument, goal -> list goal, diagnostic. call Tac Args G GS D :- set-goal-arguments Args G (seal G) (seal G1), coq.ltac.call-simple-ltac1 Tac G1 GS D. func refine.elaborate term, goal -> list goal. refine.elaborate T (goal _ RawEv Ty Ev _) GS :- rm-evar RawEv Ev, (@keepunivs! => coq.elaborate-skeleton T Ty TR ok), coq.ltac.collect-simple-goals TR GS _, RawEv = T, Ev = TR. func refine.typecheck term, goal -> list goal. refine.typecheck T (goal _ RawEv Ty Ev _) GS :- rm-evar RawEv Ev, coq.typecheck T Ty ok, coq.ltac.collect-simple-goals T GS _, RawEv = T, Ev = T. func refine.no_check term, goal -> list goal. refine.no_check T (goal _ RawEv _ Ev _) GS :- rm-evar RawEv Ev, coq.ltac.collect-simple-goals T GS _, RawEv = T, Ev = T. func all func-simple-tactic, list goal -> list goal. all T [G|Gs] O :- T G O1, all T Gs O2, std.append O1 O2 O. all _ [] []. pred thenl list simple-tactic, goal -> list goal. thenl [] G [G]. thenl [T|Ts] G GS :- T G NG, all (thenl Ts) NG GS. pred repeat simple-tactic, goal -> list goal. repeat T G GS :- T G GS1, all (repeat T) GS1 GS. repeat _ G [G]. func repeat! simple-tactic, goal -> list goal. repeat! T G GS :- T G GS1, !, all (repeat! T) GS1 GS. repeat! _ G [G]. pred or list simple-tactic, goal -> list goal. or TL G GS :- std.exists TL (t\ t G GS). } % end simple. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% func refine.elaborate term, goal -> list sealed-goal. refine.elaborate T (goal _ RawEv Ty Ev _) GS :- rm-evar RawEv Ev, (@keepunivs! => coq.elaborate-skeleton T Ty TR ok), coq.ltac.collect-goals TR GS _, RawEv = T, Ev = TR. func refine.typecheck term, goal -> list sealed-goal. refine.typecheck T (goal _ RawEv Ty Ev _) GS :- rm-evar RawEv Ev, coq.typecheck T Ty ok, coq.ltac.collect-goals T GS _, RawEv = T, Ev = T. func refine.no_check term, goal -> list sealed-goal. refine.no_check T (goal _ RawEv _ Ev _) GS :- rm-evar RawEv Ev, coq.ltac.collect-goals T GS _, RawEv = T, Ev = T. func call string, list argument, goal -> list sealed-goal, diagnostic. call Tac Args G GS D :- set-goal-arguments Args G (seal G) (seal G1), coq.ltac.call-ltac1 Tac G1 GS D. % backward compatibility (no diagnostic) func call string, list argument, goal -> list sealed-goal. call Tac Args G GS :- set-goal-arguments Args G (seal G) (seal G1), coq.ltac.call-ltac1 Tac G1 GS ok. :index(_ _ 1) func set-goal-arguments list argument, goal, sealed-goal -> sealed-goal. set-goal-arguments A G (nabla SG) (nabla R) :- pi x\ set-goal-arguments A G (SG x) (R x). set-goal-arguments A (goal Ctx1 _ _ _ _) (seal (goal Ctx2 REv2 Ty2 Ev2 _)) (seal (goal Ctx2 REv2 Ty2 Ev2 I)) :- same_term Ctx1 Ctx2, !, A = I. set-goal-arguments A (goal Ctx1 _ _ _ _) (seal (goal Ctx2 REv2 Ty2 Ev2 _)) (seal (goal Ctx2 REv2 Ty2 Ev2 I)) :- std.map A (private.move-goal-argument Ctx1 Ctx2) I. % Tacticals ---------------------------------------------------------------- pred try i:tactic, i:sealed-goal, o:list sealed-goal. try T G GS :- T G GS. try _ G [G]. :external pred all tactic, list sealed-goal -> list sealed-goal. all T [G|Gs] O :- T G O1, all T Gs O2, std.append O1 O2 O. all _ [] []. pred thenl list tactic, sealed-goal -> list sealed-goal. thenl [] G [G]. thenl [T|Ts] G GS :- T G NG, all (thenl Ts) NG GS. pred repeat tactic, sealed-goal -> list sealed-goal. repeat T G GS :- T G GS1, all (repeat T) GS1 GS. repeat _ G [G]. pred repeat! tactic, sealed-goal -> list sealed-goal. repeat! T G GS :- T G GS1, !, all (repeat! T) GS1 GS. repeat! _ G [G]. pred or list tactic, sealed-goal -> list sealed-goal. or TL G GS :- std.exists TL (t\ t G GS). % :index (_ 1) TODO :external :index(_ 1) func open func-open-tactic, sealed-goal -> list sealed-goal. open T (nabla G) O :- (pi x\ open T (G x) (NG x)), private.distribute-nabla NG O. open _ (seal (goal _ _ _ Solution _)) [] :- not (var Solution), !. % solved by side effect open T (seal (goal Ctx _ _ _ _ as G)) O :- std.filter Ctx private.not-already-assumed Ctx1, Ctx1 => (T G O, if (var O) (G = goal _ _ _ P _, coq.ltac.collect-goals P O1 O2, std.append O1 O2 O) true). % helper code --------------------------------------------------------------- namespace private { :index(_ _ 1) func move-goal-argument list prop, list prop, argument -> argument. move-goal-argument _ _ (int _ as A) A. move-goal-argument _ _ (str _ as A) A. move-goal-argument _ _ (tac _) _ :- coq.error "NIY: move tactic goal argument to another context". move-goal-argument C D (trm T) (trm T1) :- std.rev C Cr, std.rev D Dr, std.assert! (move-term Cr Dr T T1) "cannot move goal argument to the right context", !. :index(2) func move-term list prop, list prop, term -> term. move-term [] _ T T1 :- copy T T1, !. move-term [decl X _ TX|C1] [decl Y _ TY|C2] T T1 :- std.do! [ copy TX TX1, same_term TX1 TY ], !, (copy X Y :- !) => move-term C1 C2 T T1. move-term [def X _ TX BX|C1] [def Y _ TY BY|C2] T T1 :- std.do! [ copy TX TX1, same_term TX1 TY, copy BX BX1, same_term BX1 BY ], !, (copy X Y :- !) => move-term C1 C2 T T1. move-term [decl X _ _|C1] C2 T T1 :- not(occurs X T), !, move-term C1 C2 T T1. move-term [def X _ _ _|C1] C2 T T1 :- not(occurs X T), !, move-term C1 C2 T T1. move-term C1 [_|C2] T T1 :- move-term C1 C2 T T1. func distribute-nabla (term -> list sealed-goal) -> list sealed-goal. distribute-nabla (_\ []) [] :- !. distribute-nabla (x\ [X x| XS x]) [nabla X|R] :- (pi x\ occurs x (X x)), !, distribute-nabla XS R. distribute-nabla (x\ [X| XS x]) [X|R] :- distribute-nabla XS R. func not-already-assumed prop. not-already-assumed (decl X _ _Ty) :- not(decl X _ _ ; def X _ _ _). not-already-assumed (def X _ _Ty _Bo) :- not(decl X _ _ ; def X _ _ _). }} LPCIC-coq-elpi-eb449d7/elpi/elpi-reduction.elpi000066400000000000000000000122011523041753400212260ustar00rootroot00000000000000/* Reduction (whd, hd-beta, ...) */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Entry points typeabbrev stack (list term). func hd-beta term, stack -> term, stack. func hd-beta-zeta term, stack -> term, stack. func hd-beta-zeta-reduce term -> term. func whd term, stack -> term, stack. func whd-indc term -> constructor, stack. func unwind term, stack -> term. func whd1 term -> term. :index (_ 1) func coq.mk-app term, list term -> term. func coq.mk-app-uvar any, list term -> term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% shorten std.{append, nth, drop}. coq.mk-app HD [] HD :- !. coq.mk-app (app L) Args R :- !, append L Args LArgs, R = app LArgs. coq.mk-app (fun _ _ F) [A|Args] R :- !, coq.mk-app (F A) Args R. coq.mk-app (let _ _ A F) Args R :- !, coq.mk-app (F A) Args R. coq.mk-app HD Args (app [HD|Args]). coq.mk-app-uvar HD [] HD :- !. coq.mk-app-uvar ((uvar as K) : term) [A|Args] R :- !, std.unsafe-cast K K', coq.mk-app-uvar (K' A) Args R. % indirection, to be used if we add to the stack "match" frames unwind T A R :- if (var T) (coq.mk-app-uvar T A R) (coq.mk-app T A R). func nth-stack int, stack -> stack, term, stack. nth-stack 0 [X|XS] [] X XS :- !. nth-stack N [X|XS] [X|Before] At After :- M is N - 1, nth-stack M XS Before At After. % whd beta-iota-delta-zeta, main code whd (app [Hd|Args]) C X XC :- !, whd Hd {append Args C} X XC. whd (fun _ _ _ as X) [] X [] :- !. whd (fun N T F) [B|C] X XC :- !, (pi x\ def x N T B => cache x BN_ => whd (F x) C (F1 x) (C1 x)), X = F1 B, XC = C1 B. whd (let N T B F) C X XC :- !, (pi x\ def x N T B => cache x BN_ => whd (F x) C (F1 x) (C1 x)), X = F1 B, XC = C1 B. whd (global (const GR)) C X XC :- unfold GR none C D DC, !, whd D DC X XC. whd (pglobal (const GR) I) C X XC :- unfold GR (some I) C D DC, !, whd D DC X XC. whd (primitive (proj _ N)) [A|C] X XC :- whd-indc A _ KA, !, whd {proj-red KA N C} X XC. whd (global (const GR) as HD) C X XC :- coq.env.primitive? GR, !, unwind HD C Orig, coq.reduction.lazy.whd_all Orig R, if (same_term Orig R) (X = HD, XC = C) (whd R [] X XC). whd (match A _ L) C X XC :- whd-indc A GR KA, !, whd {match-red GR KA L C} X XC. whd (fix _ N _ F as Fix) C X XC :- nth-stack N C LA A RA, whd-indc A GR KA, !, whd {fix-red F Fix LA GR KA RA} X XC. whd (mfix Fno N MF) C X XC :- nth-stack N C LA A RA, whd-indc A GR KA, !, whd-mfix MF MF 0 Fno LA GR KA RA X XC. whd N C X XC :- name N, def N _ _ V, !, cache-whd N VN V, whd VN C X XC. whd X C X C. func whd-mfix mfix-block, mfix-block, int, int, stack, constructor, stack, stack -> term, stack. whd-mfix (mfix-ty _ Rno _ F) MF Cur Fixno LA K KA RA X XC :- whd-mfix (F (mfix Cur Rno MF)) MF {calc (Cur + 1)} Fixno LA K KA RA X XC. whd-mfix (mfix-bo Bs) _ _ Fixno LA K KA RA X XC :- append LA [{coq.mk-app (global (indc K)) KA}|RA] ArgsWRedRecNo, std.nth Fixno Bs B, whd B ArgsWRedRecNo X XC. % assert A reduces to a constructor whd-indc A GR KA :- whd A [] VA C, !, not(var VA), (VA = global (indc GR); VA = pglobal (indc GR) _), !, KA = C. % [whd1 T R] asserts progress was made in reducing T to R. whd1 T R :- whd T [] HD ARGS, unwind HD ARGS R, not(same_term T R). % iota step :index (1) func match-red constructor, list term, list term, stack -> term, stack. match-red GR KArgs BL C X XC :- coq.env.indc GR Lno _ Ki _, drop Lno KArgs Args, nth Ki BL Bi, hd-beta {coq.mk-app Bi Args} C X XC. :index (1) func proj-red list term, int, stack -> term, stack. proj-red Args FieldNo C V C :- nth FieldNo Args V. % iota step :index (1) func fix-red (term -> term), term, list term, constructor, list term, list term -> term, stack. fix-red F Fix LA GR KA RA X XC :- append LA [{coq.mk-app (global (indc GR)) KA}|RA] ArgsWRedRecNo, hd-beta {coq.mk-app (F Fix) ArgsWRedRecNo} [] X XC. :index (_ 2) func unfold % delta (global constants) + hd-beta constant, % name option univ-instance, % universe instance if the constant is universe polymorphic stack % args -> term, % body stack. % args after hd-beta unfold GR none A BO BOC :- coq.env.const GR (some B) _, hd-beta B A BO BOC. unfold GR (some I) A BO BOC :- (@uinstance! I ==> coq.env.const GR (some B) _), hd-beta B A BO BOC. % ensures its first argument is the whd of the second :index (1) func cache-whd term, term, term ->. cache-whd N K V :- cache N VN, var VN, !, whd V [] X XC, unwind X XC VN, K = VN. cache-whd N K _ :- cache N K, !. cache-whd N _ _ :- coq.error "anomaly: def with no cache:" {coq.term->string N}. hd-beta (app [Hd|Args]) S X C :- !, hd-beta Hd {append Args S} X C. hd-beta (fun _ _ F) [A|AS] X C :- !, hd-beta (F A) AS X C. :name "hd-beta:end" hd-beta X C X C. hd-beta-zeta (app [Hd|Args]) S X C :- !, hd-beta-zeta Hd {append Args S} X C. hd-beta-zeta (fun _ _ F) [A|AS] X C :- !, hd-beta-zeta (F A) AS X C. hd-beta-zeta (let _ _ B F) AS X C :- !, hd-beta-zeta (F B) AS X C. :name "hd-beta-zeta:end" hd-beta-zeta X C X C. hd-beta-zeta-reduce T R :- hd-beta-zeta T [] H S, unwind H S R. LPCIC-coq-elpi-eb449d7/elpi/elpi-tactic-template.elpi000066400000000000000000000006231523041753400223170ustar00rootroot00000000000000/* Loaded when Elpi Command is used */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ % Since the elaborator written in Elpi is not ready, we fallback to the Coq one % accumulate engine/elaborator. % of, unify accumulate elpi_elpi/coq-elaborator.LPCIC-coq-elpi-eb449d7/elpi/elpi_elaborator.elpi000066400000000000000000000357101523041753400214600ustar00rootroot00000000000000/* Type inference and unification */ /* license: GNU Lesser General Public License Version 2.1 or later */ /* ------------------------------------------------------------------------- */ shorten std.{rev, append, ignore-failure!, mem, map2, split-at, map, assert!}. % Entry points pred unify-eq i:term, i:term. pred unify-list-eq i:list term, i:list term. pred unify-leq i:term, i:term. pred of i:term, o:term, o:term. % of Term Type(i/o) RefinedTerm %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% Reduction %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :before "hd-beta:end" hd-beta (uvar as K) [A|AS] X C :- !, % auto-intro assert! (of A TA _) "already typed", unify-eq K (fun `hd_beta_auto` TA F), !, hd-beta (F A) AS X C. :before "hd-beta-zeta:end" hd-beta-zeta (uvar as K) [A|AS] X C :- !, % auto-intro assert! (of A TA _) "already typed", unify-eq K (fun `hd_beta_zeta_auto` TA F), !, hd-beta-zeta (F A) AS X C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% Unification %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % invariant: hd-beta terms % we start with ff, tt to handle symmetric cases % NOTE: rec-calls with unify (ensured hd-beta + ff) , symmetric rules are typically ! % NOTE: asymmetric rules are not ! otherwise the flip rule is killed % NOTE: whd are ! % names: unif X C T D M kind cumul type. type eq cumul. type leq cumul. macro @tail-cut-if Option Hd Hyps :- ( (Hd :- get-option Option tt, Hyps, !), (Hd :- not(get-option Option tt), Hyps ) ). pred unif i:term, i:stack, i:term, i:stack, i:bool, i:cumul. :if "DBG:unif" unif X CX Y CY D M :- coq.say {counter "run"} "unif" X CX "==" Y CY "(flipped?" D "cumul:" M ")", fail. func swap bool, (func A, A -> ), A, A -> . swap tt F A B :- F B A. swap ff F A B :- F A B. % flexible cases unif (uvar V L) [] T D _ _ :- get-option "unif:greedy" tt, !, bind-list L {unwind T D} V, !. unif (uvar V L) [] T D _ _ :- !, bind-list L {unwind T D} V. unif X C (uvar V L) [] _ _ :- get-option "unif:greedy" tt, !, bind-list L {unwind X C} V, !. unif X C (uvar V L) [] _ _ :- !, bind-list L {unwind X C} V. unif (sort prop) [] (sort (uvar as Y)) [] _ _ :- !, Y = prop. unif X [] (sort (uvar as Y)) [] M U :- !, coq.univ.new Lvl, Y = typ Lvl, unif X [] (sort Y) [] M U. unif (sort (uvar as X)) [] Y [] M U :- !, coq.univ.new Lvl, X = typ Lvl, unif (sort X) [] Y [] M U. unif (sort S1) [] (sort S2) [] M eq :- !, swap M coq.sort.eq S1 S2. unif (sort S1) [] (sort S2) [] M leq :- !, swap M coq.sort.leq S1 S2. unif (primitive X) [] (primitive X) [] ff _ :- !. unif (global (indt GR1)) C (global (indt GR2)) D _ _ :- !, GR1 = GR2, unify-ctxs C D. unif (global (indc GR1)) C (global (indc GR2)) D _ _ :- !, GR1 = GR2, unify-ctxs C D. unif (pglobal (indt GR1) I1) C (pglobal (indt GR2) I2) D _ eq :- !, GR1 = GR2, coq.univ-instance.unify-eq (indt GR1) I1 I2 ok, unify-ctxs C D. unif (pglobal (indt GR1) I1) C (pglobal (indt GR2) I2) D _ leq :- !, GR1 = GR2, coq.univ-instance.unify-leq (indt GR1) I1 I2 ok, unify-ctxs C D. % fast path for stuck term on the right unif X C (global (indt _) as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (global (indc _) as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (pglobal (indt _) _ as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 unif X C (pglobal (indc _) _ as T) D ff U :- !, unif T D {whd X C} tt U. % TODO:1 % congruence rules TODO: is the of assumption really needed? unif (fun N T1 F1) [] (fun M T2 F2) [] _ _ :- !, ignore-failure! (N = M), unify T1 T2 eq, pi x\ (decl x N T1) => unify (F1 x) (F2 x) eq. unif (prod N T1 F1) [] (prod M T2 F2) [] _ U :- !, ignore-failure! (N = M), unify T1 T2 eq, pi x\ (decl x N T1) => unify (F1 x) (F2 x) U. unif (fix N Rno Ty1 F1) B1 (fix M Rno Ty2 F2) B2 _ _ :- !, ignore-failure! (N = M), unify Ty1 Ty2 eq, (pi f\ (decl f N Ty1) => unify (F1 f) (F2 f) eq), unify-ctxs B1 B2. unif (match A1 R1 L1) B1 (match A2 R2 L2) B2 _ _ :- !, unify A1 A2 eq, unify R1 R2 eq, unify-list L1 L2, unify-ctxs B1 B2. % congruence heuristic (same maybe-non-normal head) unif (let N T1 B1 F1) C1 (let M T2 B2 F2) C2 _ _ :- ignore-failure! (N = M), unify T1 T2 eq, unify B1 B2 eq, (@pi-def N T1 B1 x\ unify (F1 x) (F2 x) eq), unify-ctxs C1 C2, !. unif (global (const GR)) C (global (const GR)) D _ _ :- unify-ctxs C D, !. unif (pglobal (const GR) I1) C (pglobal (const GR) I2) D _ eq :- coq.univ-instance.unify-eq (const GR) I1 I2 ok, unify-ctxs C D, !. unif (pglobal (const GR) I1) C (pglobal (const GR) I2) D _ leq :- coq.univ-instance.unify-leq (const GR) I1 I2 ok, unify-ctxs C D, !. unif X C T D _ _ :- name X, name T, X = T, unify-ctxs C D. % 1 step reduction TODO:1 unif (global (const GR)) C T D M U :- unfold GR none C X1 C1, !, unif X1 C1 T D M U. unif (pglobal (const GR) I) C T D M U :- unfold GR (some I) C X1 C1, !, unif X1 C1 T D M U. unif (let N TB B F) C1 T C2 M U :- !, @pi-def N TB B x\ unif {hd-beta (F x) C1} T C2 M U. unif (match A _ L) C T D M U :- whd-indc A GR KA, !, unif {match-red GR KA L C} T D M U. unif (fix _ N _ F as X) C T D M U :- nth-stack N C LA A RA, whd-indc A GR KA, !, unif {fix-red F X LA GR KA RA} T D M U. unif X C T D M U :- name X, def X _ _ V, !, unif {hd-beta V C} T D M U. % TODO we could use _VN if nonflex % TODO:1 turn into (if reducible then reduce1 else fully-reduce2 tt) % symmetry unif X C T D ff U :- !, unif T D X C tt U. % error % unif X C1 Y C2 _tt :- !, % print "Error: " {coq.term->string {unwind X C1}} "vs" {coq.term->string {unwind Y C2}}. %, halt. % Contexts happens to be lists, so we just reuse the code pred unify-list i:list term, i:list term. unify-list L1 L2 :- unify-ctxs L1 L2. % the entry points of rec calls: unify unify-ctxs pred unify-ctxs i:list term, i:list term. unify-ctxs [] []. unify-ctxs [X|XS] [Y|YS] :- unify X Y eq, !, unify-ctxs XS YS. pred unify i:term, i:term, i:cumul. unify A B C :- unif {hd-beta A []} {hd-beta B []} ff C. %%%%%% entry points for clients %%%%%%% unify-eq X Y :- unify X Y eq. unify-leq X Y :- unify X Y leq. unify-list-eq L1 L2 :- unify-list L1 L2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Flexible case %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Binding a list of terms (delift in Matita, invert subst in Coq) % We use a keyd discipline, i.e. we only bind terms with a rigid head pred key i:term. key (global _) :- !. key (pglobal _ _) :- !. key C :- name C, !. key (primitive _) :- !. pred bind-list i:list term, i:term, o:any. bind-list [] T T' :- bind T T1, T1 = T'. bind-list [app [C| AS] |VS] T R :- key C, !, pi x\ (pi L X\ bind (app[C|L]) X :- get-option "unif:greedy" tt, unify-list-eq L AS, X = x, !) => (pi L X\ bind (app[C|L]) X :- not (get-option "unif:greedy" tt),unify-list-eq L AS, X = x) => bind-list VS T (R x). bind-list [C|VS] T R :- key C, def C _ _ V, key V, !, pi x\ @tail-cut-if "unif:greedy" (bind C x) true => @tail-cut-if "unif:greedy" (bind V x) true => bind-list VS T (R x). bind-list [C|VS] T R :- key C, !, pi x\ @tail-cut-if "unif:greedy" (bind C x) true => bind-list VS T (R x). bind-list [ _ |VS] T R :- !, pi x\ bind-list VS T (R x). % CAVEAT: (app FLEX), (match _ _ FLEX) are not terms! pred bind i:term, o:term. bind X Y :- name X, X = Y, !. bind X Y :- name X, def X _ _ T, !, bind T Y. bind (global _ as C) C :- !. bind (pglobal _ _ as C) C :- !. bind (sort _ as C) C :- !. bind (fix N Rno Ty F) (fix N Rno Ty1 F1) :- !, bind Ty Ty1, pi x\ decl x N Ty => bind (F x) (F1 x). bind (match T Rty B) X :- !, bind T T1, bind Rty Rty1, map B bind B1, X = (match T1 Rty1 B1). bind (app L) X :- !, map L bind L1, X = app L1. bind (fun N T F) (fun N T1 F1) :- !, bind T T1, pi x\ decl x N T => bind (F x) (F1 x). bind (let N T B F) (let N T1 B1 F1) :- !, bind T T1, bind B B1, @pi-def N T B x\ bind (F x) (F1 x). bind (prod N T F) X :- !, bind T T1, (@pi-decl N T x\ bind (F x) (F1 x)), X = (prod N T1 F1). bind (uvar M L) W :- map L bind L1, coq.mk-app-uvar M L1 W. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Type checking %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%% eat-prod head head-ty args-done todo-args refined-app refined-ty %%%%%%%% pred bidir-app i:term, i:term, i:list term, o:term. :name "of:bidirectional-app" bidir-app _ _ _ _. pred saturate-dummy i:term, o:term. saturate-dummy (prod _ _ F) R :- pi x\ saturate-dummy (F x) R. saturate-dummy X X. pred ensure-prod.aux i:list A, i:term, o:term, o:bool. ensure-prod.aux [] X X _. ensure-prod.aux [_|Args] (prod N S T) (prod N S T1) NU :- !, pi x\ ensure-prod.aux Args (T x) (T1 x) NU. ensure-prod.aux [_|Args] uvar (prod Name_ Src_ R) tt :- !, pi x\ ensure-prod.aux Args (R x) (R x) tt. ensure-prod.aux Args X R NU :- whd1 X Y, ensure-prod.aux Args Y R NU. % TODO: do not fail if whd1 fails and the term is not flexible since it % may just need to be passed a concrete argument pred ensure-prod i:list A, i:term. ensure-prod Args Ty :- ensure-prod.aux Args Ty R NeedsUnif, if (var NeedsUnif) true (of R _ R1, unify-eq Ty R1). pred eat-prod i:list term, i:term, i:term, o:list term, o:term, o:term. :if "DBG:of" eat-prod [] Hd Prod Adone Res ResTy :- coq.say "eat-prod" Hd {rev Adone} "==" Res ";" Prod "=<=" ResTy, fail. eat-prod [] Hd Prod Adone Res ResTy :- !, rev Adone Args, unify-eq Res {coq.mk-app Hd Args}, unify-leq Prod ResTy. % XXX why not unif? eat-prod [A|AS] Hd (prod _ Src Tgt as Prod) Adone Res ResTy :- bidir-app Hd Prod Adone ResTy, of A Src ResA, eat-prod AS Hd (Tgt ResA) [ResA|Adone] Res ResTy. % TODO: add a whd1 eg in case of a n-ary function :if "DBG:of" of X Tx Rx :- coq.say {counter "run"} "of" X Tx Rx, fail. of X Tx R :- name X, (decl X _ T ; def X _ T _), unify-leq T Tx, R = X. of (fun N S F) LamTy (fun M S2 F2) :- of (prod N S _) (sort _U) (prod M S2 T), unify-leq (prod M S2 T) LamTy, pi x\ decl x M S2 => of (F x) (T x) (F2 x). of (app [X]) Ty R :- !, of X Ty R. of (app [Hd|Args]) TyApp App :- of Hd Prod Hd1, ensure-prod Args Prod, eat-prod Args Hd1 Prod [] App TyApp. of (prod N S F) ProdTy (prod N ResS ResF) :- closed_term U1, closed_term U2, closed_term U, of S (sort U1) ResS, (pi x\ decl x N ResS => of (F x) (sort U2) (ResF x)), pts U1 U2 U, unify-leq (sort U) ProdTy. of (match T Rty Bs) ResRtyInst (match ResT ResRty ResBs) :- of T TyT ResT, % T : TyT = (indt GR) LArgs RArgs, and (indt GR) : Ty coq.safe-dest-app TyT (global (indt GR)) Args, coq.env.indt GR _IsInd Lno _Luno Ty Kn Ks, % TODO LUno split-at Lno Args LArgs RArgs, % TODO: not a failure, just type err % fix LArgs on ind ty and constructors ty coq.subst-prod LArgs Ty TyLArgs, map Ks (coq.subst-prod LArgs) KsLArgs, % Rty skeleton (uknown ending) = fun rargs, fun e : indt largs rargs, ? mk-rty [] {coq.mk-app (global (indt GR)) LArgs} TyLArgs ResRtyRaw, of ResRtyRaw _ ResRty, unify-eq Rty ResRty, % Rty must type each branch map2 KsLArgs Kn (mk-bty Rty Lno) BsTy, map2R Bs BsTy of ResBs, % Outside type unify-leq {coq.mk-app ResRty {append RArgs [ResT]}} ResRtyInst. pred map2R i:list A, o:list B, i:(pred i:A, o:B, o:C), o:list C. map2R [] [] _ []. map2R [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, map2R XS YS F ZS. of (let N Ty Bo F) TyFx (let N ResTy ResBo ResF) :- of Ty (sort _) ResTy, of Bo ResTy ResBo, pi x\ def x N ResTy ResBo => cache x T_ => of (F x) TyFx (ResF x). of (fix N Rno Ty BoF) ResTy (fix N Rno RTy ResBoF) :- of Ty (sort _) RTy, unify-leq RTy ResTy, pi f\ decl f N RTy => of (BoF f) ResTy (ResBoF f). of (sort S) (sort S1) (sort S) :- coq.sort.sup S S1. of (global GR as X) T X :- coq.env.typeof GR T1, unify-leq T1 T. of (pglobal GR I as X) T X :- (@uinstance! I => coq.env.typeof GR T1), unify-leq T1 T. of (primitive (uint63 _) as X) T X :- unify-leq {{ lib:num.int63.type }} T. of (primitive (float64 _) as X) T X :- unify-leq {{ lib:num.float.type }} T. of (primitive (pstring _) as X) T X :- unify-leq {{ lib:elpi.pstring }} T. of (uvar as X) T Y :- !, evar X T Y. :if "OVERRIDE_COQ_ELABORATOR" :name "refiner-assign-evar" :before "default-assign-evar" evar X Ty S :- !, of X Ty S, !. pred coerce o:term, o:term, o:term, o:term. pred coerced i:term, i:term, i:term, o:term. pred coerceible i:term, o:term, i:term, o:term. of X T R :- get-option "of:coerce" tt, not (var T), of X XT Y, coerced XT T Y R. :if "DBG:of" of X Tx Rx :- coq.say {counter "run"} "of [FAIL]" X Tx Rx, fail. func utc % Uniqueness of typing list term, % names (canonical) term, % type living in names list term, % values (explicit subst on names) term % type living in values -> (func). % goal checking compatibility of the two types utc [] T1 [] T2 (std.once(unify-eq T1V T2)) :- !, copy T1 T1V. utc [N|NS] T1 [V|VS] T2 C :- !, (copy N V :- !) => utc NS T1 VS T2 C. utc [] T1 VS T2 C :- !, utc [] {coq.subst-prod VS T1} [] T2 C. % FIXME: reduction utc [_|NS] (prod _ _ F) [] T2 C :- !, % FIXME: reduction assert! (pi x\ F x = F1) "restriction bug", utc NS F1 [] T2 C. % This could be done in ML func canonical? list term. canonical? []. canonical? [N|NS] :- name N, not(mem NS N), canonical? NS. constraint declare-evar evar decl def cache rm-evar { rule (E1 :> G1 ?- evar _ T1 (uvar K L1)) % canonical \ (E2 :> G2 ?- evar _ T2 (uvar K L2)) % actual | (canonical? L1, utc L1 T1 L2 T2 Condition, coq.say "CHR: Uniqueness of typing of" K "+" L1 "<->" L2, coq.say E1 "|>" G1 "|-" K L1 ":" T1, coq.say E2 "|>" G2 "|-" K L2 ":" T2, coq.say E2 "|>" G2 "|-" Condition "\n" ) <=> (E2 :> G2 ?- Condition). } % typing match %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% type mk-rty list term -> term -> term -> term -> prop. mk-rty ARGS HD (prod N S T) (fun N S F) :- !, pi x\ mk-rty [x|ARGS] HD (T x) (F x). mk-rty ARGS HD _ (fun _ IndApp _FRESH) :- coq.mk-app HD {rev ARGS} IndApp. pred mk-bty i:term, i:int, i:term, i:constructor, o:term. mk-bty Rty Lno (prod N S T) Ki (prod N S B) :- !, pi x\ mk-bty Rty Lno (T x) Ki (B x). mk-bty Rty Lno T Ki AppRtyNorm :- coq.safe-dest-app T (global (indt _)) Args, split-at Lno Args LArgs RArgs, coq.mk-app Rty {append RArgs [{coq.mk-app (global (indc Ki)) {append LArgs RArgs}}]} AppRty, hd-beta-zeta-reduce AppRty AppRtyNorm. mk-bty Rty Lno T Ki AppRtyNorm :- coq.safe-dest-app T (pglobal (indt _) I) Args, split-at Lno Args LArgs RArgs, coq.mk-app Rty {append RArgs [{coq.mk-app (pglobal (indc Ki) I) {append LArgs RArgs}}]} AppRty, hd-beta-zeta-reduce AppRty AppRtyNorm. % PTS sorts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pred pts i:sort, i:sort, o:sort. pts X Y U :- coq.sort.pts-triple X Y U. LPCIC-coq-elpi-eb449d7/etc/000077500000000000000000000000001523041753400152565ustar00rootroot00000000000000LPCIC-coq-elpi-eb449d7/etc/alectryon_elpi.py000077500000000000000000000347451523041753400206610ustar00rootroot00000000000000#!/usr/bin/env python3 import sys from os.path import join, dirname # This is a custom driver: it exposes the same interface as # Alectryon's usual CLI, but: # - it sets the internal parameter pp_margin of SerAPI to a different value # - it installs a new ghref RST role # - it install a new pygments lexer for Elpi # - it patches Coq's pygments lexer to handle quotations to Elpi root = join(dirname(__file__), "..") sys.path.insert(0, root) # SERAPI ###################################################################### from alectryon.cli import main from alectryon.serapi import SerAPI SerAPI.DEFAULT_PP_ARGS['pp_margin'] = 55 # PYGMENTS ELPI ############################################################### from pygments.lexer import RegexLexer, default, words, bygroups, include, inherit from pygments.regexopt import regex_opt, regex_opt_inner from pygments.token import \ Text, Comment, Operator, Keyword, Name, String, Number, Punctuation class ElpiLexer(RegexLexer): """ Lexer for the Elpi programming language. """ name = 'Elpi' url = 'http://github.com/LPCIC/elpi' aliases = ['elpi'] filenames = ['*.elpi'] mimetypes = ['text/x-elpi'] version_added = '2.11' lcase_re = r"[a-z]" ucase_re = r"[A-Z]" digit_re = r"[0-9]" schar2_re = r"([+*^?/<>`'@#~=&!])" schar_re = rf"({schar2_re}|-|\$|_)" idchar_re = rf"({lcase_re}|{ucase_re}|{digit_re}|{schar_re})" idcharstarns_re = rf"({idchar_re}*(\.({lcase_re}|{ucase_re}){idchar_re}*)*)" symbchar_re = rf"({lcase_re}|{ucase_re}|{digit_re}|{schar_re}|:)" constant_re = rf"({ucase_re}{idchar_re}*|{lcase_re}{idcharstarns_re}|{schar2_re}{symbchar_re}*|_{idchar_re}+)" symbol_re = r"(,|<=>|-->|:-|:>|;|\?-|->|&|=>|\bas\b|\buvar\b|<|=<|=|==|>=|>|\bi<|\bi=<|\bi>=|\bi>|\bis\b|\br<|\br=<|\br>=|\br>|\bs<|\bs=<|\bs>=|\bs>|@|::|\[\]|`->|`:|`:=|\^|-|\+|\bi-|\bi\+|r-|r\+|/|\*|\bdiv\b|\bi\*|\bmod\b|\br\*|~|\bi~|\br~)" const_sym_re = rf"({constant_re}|{symbol_re}|\({symbol_re}\))" tokens = { 'root': [ include('elpi') ], 'elpi': [ include('_elpi-comment'), (r"(:before|:after|:if|:name)(\s*)(\")", bygroups(Keyword.ElpiMode, Text.Whitespace, String.Double), 'elpi-string'), (r"(:functional)", bygroups(Keyword.ElpiMode)), (r"(:index)(\s*)(\()", bygroups(Keyword.ElpiMode, Text.Whitespace, Punctuation), 'elpi-indexing-expr'), (rf"\b(external pred|pred)(\s+)({const_sym_re})", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-pred-item'), (rf"\b(func)(\s+)({const_sym_re})", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-func-item'), (rf"\b(external type|type)(\s+)(({const_sym_re}(,\s*)?)+)", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-type'), (rf"\b(kind)(\s+)(({const_sym_re}|,)+)", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-type'), (rf"\b(typeabbrev)(\s+)({const_sym_re})", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-type'), (r"\b(typeabbrev)(\s+)(\([^)]+\))", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-type'), (r"\b(accumulate)(\s+)(\")", bygroups(Keyword.ElpiKeyword, Text.Whitespace, String.Double), 'elpi-string'), (rf"\b(accumulate|namespace|local)(\s+)({constant_re})", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Text)), (rf"\b(shorten)(\s+)({constant_re}\.)", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Text)), (r"\b(pi|sigma)(\s+)([a-zA-Z][A-Za-z0-9_ ]*)(\\)", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiVariable, Text)), (rf"\b(constraint)(\s+)(({const_sym_re}(\s+)?)+)", bygroups(Keyword.ElpiKeyword, Text.Whitespace, Name.ElpiFunction), 'elpi-chr-rule-start'), (rf"(?=[A-Z_]){constant_re}", Name.ElpiVariable), (rf"(?=[a-z_])({constant_re}|_)(:[A-Za-z0-9_ ]*)?(\\)", Name.ElpiVariable), (r"_", Name.ElpiVariable), (rf"({symbol_re}|!|=>|;)", Keyword.ElpiKeyword), (constant_re, Text), (r"\[|\]|\||=>", Keyword.ElpiKeyword), (r":", Keyword.ElpiKeyword), (r'"', String.Double, 'elpi-string'), (r'`', String.Double, 'elpi-btick'), (r'\'', String.Double, 'elpi-tick'), #(r'\{\{', Punctuation, 'elpi-quote'), (r'\{[^\{]', Text, 'elpi-spill'), (r"\(", Punctuation, 'elpi-in-parens'), (r'\d[\d_]*', Number.Integer), (r'-?\d[\d_]*(.[\d_]*)?([eE][+\-]?\d[\d_]*)', Number.Float), (r"[\+\*\-/\^\.]", Operator), ], '_elpi-comment': [ (r'%[^\n]*\n', Comment), (r'/(?:\\\n)?[*](?:[^*]|[*](?!(?:\\\n)?/))*[*](?:\\\n)?/', Comment), (r"\s+", Text.Whitespace), ], 'elpi-indexing-expr':[ (r'[0-9 _]+', Number.Integer), (r'\)', Punctuation, '#pop'), ], 'elpi-type': [ (r"(ctype\s+)(\")", bygroups(Keyword.Type, String.Double), 'elpi-string'), (r'->', Keyword.Type), (r'prop', Keyword.ElpiMode), (constant_re, Keyword.Type), (r"\(|\)", Keyword.Type), (r"\.", Text, '#pop'), include('_elpi-comment'), ], 'elpi-chr-rule-start': [ (r"\{", Punctuation, 'elpi-chr-rule'), include('_elpi-comment'), ], 'elpi-chr-rule': [ (r"\brule\b", Keyword.ElpiKeyword), (r"\\", Keyword.ElpiKeyword), (r"\}", Punctuation, '#pop:2'), include('elpi'), ], 'elpi-pred-item': [ (r"[io]:", Keyword.ElpiMode), (r"\.", Text, '#pop'), (r",", Keyword.ElpiMode), include('_elpi-inner-pred-fun'), (r"\)", Keyword.ElpiMode, '#pop'), (r"\(", Keyword.Type, '_elpi-type-item'), include('_elpi-comment'), include('_elpi-type-item'), ], 'elpi-func-item': [ (constant_re, Keyword.Type), (r"\.", Text, '#pop'), (r",", Keyword.ElpiMode), (r'->', Keyword.ElpiMode), include('_elpi-inner-pred-fun'), (r"\)", Keyword.ElpiMode, '#pop'), (r"\(", Keyword.Type, '_elpi-type-item'), include('_elpi-comment'), include('_elpi-type-item'), ], '_elpi-inner-pred-fun': [ (r"(\()(\s*)(pred)", bygroups(Keyword.ElpiMode,Text.Whitespace,Keyword.ElpiKeyword), 'elpi-pred-item'), (r"(\()(\s*)(func)", bygroups(Keyword.ElpiMode,Text.Whitespace,Keyword.ElpiKeyword), 'elpi-func-item'), ], '_elpi-type-item': [ (r'->', Keyword.Type), (constant_re, Keyword.Type), include('_elpi-inner-pred-fun'), (r"\(", Keyword.Type, '#push'), (r"\)", Keyword.Type, '#pop'), include('_elpi-comment'), ], '' 'elpi-btick': [ (r'[^` ]+', String.Double), (r'`', String.Double, '#pop'), ], 'elpi-tick': [ (r'[^\' ]+', String.Double), (r'\'', String.Double, '#pop'), ], 'elpi-string': [ (r'[^\"]+', String.Double), (r'"', String.Double, '#pop'), ], # 'elpi-quote': [ # (r'\}\}', Punctuation, '#pop'), # (r"\s+", Text.Whitespace), # (r"(lp:)(\{\{)", bygroups(Number, Punctuation), 'elpi-quote-exit'), # (rf"(lp:)((?=[A-Za-z_]){constant_re})", bygroups(Number, Name.ElpiVariable)), # (r"(lp:\()([A-Za-z]+)( )([^)]*)(\))", bygroups(Number, Name.ElpiVariable, Text.Whitespace, Text, Number)), # (r"((?!lp:|\}\})(.|\n))+", using(CoqLexer)), # ], # 'elpi-quote-exit': [ # include('elpi'), # (r'\}\}', Punctuation, '#pop'), # ], 'elpi-spill': [ (r'\{[^\{]', Text, '#push'), (r'\}[^\}]', Text, '#pop'), include('elpi'), ], 'elpi-in-parens': [ (r"\(", Punctuation, '#push'), include('elpi'), (rf"(\))(:[A-Za-z0-9_ ]*)?", bygroups(Punctuation,Name.ElpiVariable), '#pop'), ], } from pygments.lexers._mapping import LEXERS LEXERS['ElpiLexer'] = ('alectryon_elpi','Elpi',('elpi',),('*.elpi',),('text/x-elpi',)) # PYGMENTS COQ-ELPI ########################################################### from alectryon.pygments_lexer import CoqLexer class CoqElpiLexer(CoqLexer, ElpiLexer): tokens = { 'root': [ # No clue what inherit would do here, so we copy Coq's ones include('_basic'), include('_vernac'), include('_keywords'), include('_other'), ], '_quotations': [ (r"lp:\{\{",String.Interpol, 'elpi'), (r"(lp:)([A-Za-z_0-9']+)",bygroups(String.Interpol, Name.ElpiVariable)), (r"(lp:)(\()([A-Z][A-Za-z_0-9']*)([a-z0-9 ]+)(\))",bygroups(String.Interpol,String.Interpol,Name.ElpiVariable,Text,String.Interpol)), ], 'antiquotation': [ (r"\}\}",String.Interpol,'#pop'), include('root') ], 'elpi': [ (r"\}\}",String.Interpol,'#pop'), (r"\b(global|sort|app|fun|let|prod|match|fix)\b", Keyword.ElpiKeyword), (r"\{\{(:[a-z]+)?",String.Interpol,'antiquotation'), # back to Coq inherit ], '_other': [ include('_quotations'), inherit ], } import alectryon.pygments_lexer alectryon.pygments_lexer.CoqLexer = CoqElpiLexer # DOCUTILS #################################################################### import docutils from docutils.parsers.rst import directives, roles # type: ignore from docutils import nodes def set_line(node, lineno, sm): node.source, node.line = sm.get_source_and_line(lineno) import re import time import pickle import atexit ghref_cache = {} def dump_ghref_cache(): when = int(time.time() / 1000) file = '/tmp/ghref_cache_{}'.format(str(when)) pickle.dump(ghref_cache,open(file,'wb')) atexit.register(dump_ghref_cache) try: when = int(time.time() / 1000) file = '/tmp/ghref_cache_{}'.format(str(when)) ghref_cache = pickle.load(open(file,'rb')) #print('loaded cache', when, file) except: #print('failed to loaded cache', file) ghref_cache = {} ghref_scrape_re = re.compile("\"sha\"[: ]*\"([a-zA-Z0-9]+)\"",re.IGNORECASE) def ghref_role(role, rawtext, text, lineno, inliner, options={}, content=[]): src = options.get('src',None) if src is None: msg = inliner.reporter.error("{}: no src option".format(role), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] components = str.split(src,sep=" ") if len(components) != 4: msg = inliner.reporter.error("{}: src should be 4 space separated strings".format(role), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] org, repo, branch, path = components uri = "https://github.com/{}/{}/blob/{}/{}".format(org,repo,branch,path) roles.set_classes(options) options.setdefault("classes", []).append("ghref") if uri in ghref_cache: code, rawuri, uri = ghref_cache[uri] else: from urllib import request apiuri = "https://api.github.com/repos/{}/{}/commits/{}/branches-where-head".format(org,repo,branch) try: with request.urlopen(apiuri) as f: json = f.read().decode('utf-8') except: msg = inliner.reporter.error("{}: could not download: {}".format(role,apiuri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] try: # A json parser would be nicer sha = ghref_scrape_re.search(json).group(1) except: msg = inliner.reporter.error("{}: could not scrape for permalink: {}".format(role,uri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] puri = "https://github.com/{}/{}/blob/{}/{}".format(org,repo,sha,path) rawuri = "https://raw.githubusercontent.com/{}/{}/{}/{}".format(org,repo,sha,path) try: with request.urlopen(rawuri) as f: code = f.read().decode('utf-8') except: msg = inliner.reporter.error("{}: could not download: {}".format(role,rawuri), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] ghref_cache[uri]=(code,rawuri,puri) uri=puri mangler = options.get('replace',None) mangler_with = options.get('replace_with','') if mangler is None: name = text else: name = re.sub(mangler,mangler_with,text) pattern = options.get('pattern','') from string import Template pattern = Template(pattern).safe_substitute(name = re.escape(name)) pattern = re.compile(pattern) for num, line in enumerate(code.splitlines(), 1): if pattern.search(line): uri = uri + '#L' + str(num) break else: msg = inliner.reporter.error("{}: {} not found in {} using pattern {}".format(role,text,rawuri,pattern), line=lineno) return [inliner.problematic(rawtext, rawtext, msg)], [msg] node = nodes.reference(rawtext, text, refuri=uri, **options) set_line(node, lineno, inliner.reporter) return [node], [] ghref_role.name = "ghref" ghref_role.options = { # the GH source, 4 fields separated by space: org repo branch path. Eg # :src: cpitclaudel alectryon master alectryon/docutils.py "src": directives.unchanged, # the regex to find the location in the raw file at path. I must use $name # this is replaced by the text in :ghref:`text`. Eg # :pattern: ^def $name "pattern": directives.unchanged, # optionally mangle the name before substituting it in the regexp using # re.sub. Eg # :replace: this # :replace_with: that "replace": directives.unchanged, "replace_with": directives.unchanged } roles.register_canonical_role("ghref", ghref_role) ############################################################################### __all__ = [ "ElpiLexer", "CoqElpiLexer"] if __name__ == "__main__": main() LPCIC-coq-elpi-eb449d7/etc/coq-elpi.lang000066400000000000000000000273501523041753400176410ustar00rootroot00000000000000 *.v \(\* \*\)