diff --git a/.github/workflows/nix-action-rocq-9.1.yml b/.github/workflows/nix-action-rocq-9.1.yml index 2a8c222ec5..20615c4f9d 100644 --- a/.github/workflows/nix-action-rocq-9.1.yml +++ b/.github/workflows/nix-action-rocq-9.1.yml @@ -1770,70 +1770,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "dpdgraph-test" - equations: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (equations) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"equations\" \\\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: 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 "equations" fcsl-pcm: needs: - coq @@ -2441,6 +2377,7 @@ jobs: - mathcomp-order - mathcomp-fingroup - hierarchy-builder + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -2506,87 +2443,13 @@ jobs: 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-algebra" - mathcomp-algebra-tactics: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - 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' + 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 "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" + "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-tactics" + "rocq-9.1" --argstr job "mathcomp-algebra" mathcomp-analysis: needs: - coq @@ -3660,249 +3523,9 @@ jobs: 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" - metarocq-common: - needs: - - coq - - equations - - ExtLib - - stdlib - - metarocq-utils - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (metarocq-common) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"metarocq-common\" \\\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: equations' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "equations" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: ExtLib' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "ExtLib" - - 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 previous CI target: metarocq-utils' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "metarocq-utils" - - 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 "metarocq-common" - metarocq-template-rocq: + micromega-plugin: needs: - - coq - - equations - - ExtLib - - stdlib - - metarocq-common - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (metarocq-template-rocq) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"metarocq-template-rocq\" \\\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: equations' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "equations" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: ExtLib' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "ExtLib" - - 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 previous CI target: metarocq-common' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "metarocq-common" - - 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 "metarocq-template-rocq" - metarocq-translations: - needs: - - coq - - equations - - ExtLib - - stdlib - - metarocq-template-rocq - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (metarocq-translations) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"metarocq-translations\" \\\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: equations' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "equations" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: ExtLib' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "ExtLib" - - 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 previous CI target: metarocq-template-rocq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "metarocq-template-rocq" - - 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 "metarocq-translations" - metarocq-utils: - needs: - - coq - - equations - - ExtLib - - stdlib + - rocq-core runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -3939,9 +3562,9 @@ jobs: extraPullNames: coq-community, math-comp name: coq - id: stepGetDerivation - name: Getting derivation for current job (metarocq-utils) + name: Getting derivation for current job (micromega-plugin) run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"metarocq-utils\" \\\n --dry-run 2> err > out + \"rocq-9.1\" --argstr job \"micromega-plugin\" \\\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 @@ -3952,25 +3575,13 @@ jobs: \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: equations' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "equations" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: ExtLib' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-9.1" --argstr job "ExtLib" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: stdlib' + 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 "stdlib" + "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 "metarocq-utils" + "rocq-9.1" --argstr job "micromega-plugin" mtac2: needs: - coq @@ -4744,70 +4355,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "simple-io" - smtcoq: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (smtcoq) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"smtcoq\" \\\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: 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 "smtcoq" stalmarck: needs: - coq @@ -4939,6 +4486,7 @@ jobs: stdlib: needs: - rocq-core + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -4991,6 +4539,10 @@ jobs: 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: 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 @@ -4999,6 +4551,7 @@ jobs: needs: - rocq-core - stdlib + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -5055,6 +4608,10 @@ jobs: 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 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 @@ -5246,70 +4803,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.1" --argstr job "unicoq" - waterproof: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (waterproof) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.1\" --argstr job \"waterproof\" \\\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: 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 "waterproof" name: Nix CI for bundle rocq-9.1 on: pull_request: diff --git a/.github/workflows/nix-action-rocq-9.2.yml b/.github/workflows/nix-action-rocq-9.2.yml index eb407baf75..a6a3bfdb74 100644 --- a/.github/workflows/nix-action-rocq-9.2.yml +++ b/.github/workflows/nix-action-rocq-9.2.yml @@ -1770,70 +1770,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "dpdgraph-test" - equations: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (equations) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.2\" --argstr job \"equations\" \\\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: 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 "equations" fcsl-pcm: needs: - coq @@ -2441,6 +2377,7 @@ jobs: - mathcomp-order - mathcomp-fingroup - hierarchy-builder + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -2506,87 +2443,13 @@ jobs: 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 + 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 "mathcomp-algebra" - mathcomp-algebra-tactics: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - 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.2\" --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.2" --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.2" --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.2" --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.2" --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.2" --argstr job "mathcomp-zify" + "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-tactics" + "rocq-9.2" --argstr job "mathcomp-algebra" mathcomp-analysis: needs: - coq @@ -3660,6 +3523,65 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "mathcomp-zify" + micromega-plugin: + 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 + uses: cachix/cachix-action@v16 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq-community, math-comp + name: coq + - id: stepGetDerivation + name: Getting derivation for current job (micromega-plugin) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"rocq-9.2\" --argstr job \"micromega-plugin\" \\\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 "micromega-plugin" mtac2: needs: - coq @@ -4433,70 +4355,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "simple-io" - smtcoq: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (smtcoq) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.2\" --argstr job \"smtcoq\" \\\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: 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 "smtcoq" stalmarck: needs: - coq @@ -4628,6 +4486,7 @@ jobs: stdlib: needs: - rocq-core + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -4680,6 +4539,10 @@ jobs: 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: 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 @@ -4688,6 +4551,7 @@ jobs: needs: - rocq-core - stdlib + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -4744,6 +4608,10 @@ jobs: 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 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 @@ -4989,70 +4857,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-9.2" --argstr job "unicoq" - waterproof: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - id: stepGetDerivation - name: Getting derivation for current job (waterproof) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"rocq-9.2\" --argstr job \"waterproof\" \\\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: 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 "waterproof" name: Nix CI for bundle rocq-9.2 on: pull_request: diff --git a/.github/workflows/nix-action-rocq-master.yml b/.github/workflows/nix-action-rocq-master.yml index 493e8b1119..d98ad5a635 100644 --- a/.github/workflows/nix-action-rocq-master.yml +++ b/.github/workflows/nix-action-rocq-master.yml @@ -3568,6 +3568,7 @@ jobs: - mathcomp-order - mathcomp-fingroup - hierarchy-builder + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -3633,87 +3634,13 @@ jobs: 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 + name: 'Building/fetching previous CI target: micromega-plugin' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle - "rocq-master" --argstr job "mathcomp-algebra" - mathcomp-algebra-tactics: - needs: - - coq - - 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 - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq-community, math-comp - name: coq - - 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" + "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-tactics" + "rocq-master" --argstr job "mathcomp-algebra" mathcomp-analysis: needs: - coq @@ -5839,6 +5766,65 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "rocq-master" --argstr job "metarocq-utils" + micromega-plugin: + 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 + uses: cachix/cachix-action@v16 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq-community, math-comp + name: coq + - id: stepGetDerivation + name: Getting derivation for current job (micromega-plugin) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"rocq-master\" --argstr job \"micromega-plugin\" \\\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 "micromega-plugin" mtac2: needs: - coq @@ -7004,6 +6990,7 @@ jobs: stdlib: needs: - rocq-core + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -7056,6 +7043,10 @@ jobs: 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: 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 @@ -7064,6 +7055,7 @@ jobs: needs: - rocq-core - stdlib + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -7120,6 +7112,10 @@ jobs: 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 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 @@ -7128,6 +7124,7 @@ jobs: needs: - rocq-core - stdlib + - micromega-plugin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -7184,6 +7181,10 @@ jobs: 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 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 diff --git a/.gitignore b/.gitignore index 84f86a2ac4..1580471939 100644 --- a/.gitignore +++ b/.gitignore @@ -84,7 +84,6 @@ test-suite/coq-makefile/merlin1/.merlin test-suite/coqdoc/Coqdoc.* test-suite/coqdoc/index.html test-suite/coqdoc/coqdoc.css -test-suite/output/MExtraction.out test-suite/output/*.out.real test-suite/oUnit-anon.cache test-suite/redirect_test.out diff --git a/.nix/config.nix b/.nix/config.nix index 272c34bd26..142a42d3c1 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -156,7 +156,6 @@ with builtins; with (import {}).lib; "itree-io" "json" "kami" - "mathcomp-algebra-tactics" "mathcomp-analysis" "mathcomp-classical" "mathcomp-reals" @@ -227,6 +226,7 @@ with builtins; with (import {}).lib; "metacoq-translations" "metacoq-utils" "metarocq" + "metarocq-common" "metarocq-erasure" "metarocq-erasure-plugin" "metarocq-pcuic" @@ -234,7 +234,10 @@ with builtins; with (import {}).lib; "metarocq-safechecker" "metarocq-safechecker-plugin" "metarocq-template-pcuic" + "metarocq-template-rocq" "metarocq-test" + "metarocq-translations" + "metarocq-utils" "rewriter" "riscvcoq" "rupicola" @@ -249,7 +252,7 @@ with builtins; with (import {}).lib; // listToAttrs (forEach main (p: { name = p; value.override.version = "main"; })) // { - coq-elpi.override.version = "master"; + # coq-elpi.override.version = "master"; coq-elpi.override.elpi-version = "3.6.2"; tlc.override.version = "master-for-coq-ci"; smtcoq-trakt.override.version = "with-trakt-coq-master"; @@ -258,6 +261,7 @@ with builtins; with (import {}).lib; iris-examples.job = false; # Currently broken jasmin.job = false; # Currently broken, c.f., https://github.com/rocq-prover/rocq/pull/20589 CakeMLExtraction.job = false; # not in Rocq CI + verified-extraction.job = false; # not in Rocq CI ceres-bs.job = false; # not in Rocq CI CertiRocq.job = false; # not in Rocq CI ConCert.job = false; # not in Rocq CI @@ -280,12 +284,28 @@ with builtins; with (import {}).lib; # for a complete list of Coq packages available in Nix # * : is such that this will use the branch # from https://github.com// + micromega-plugin.override.version = "tify"; + bedrock2.override.version = "proux01:stdlib251"; + coq-elpi.override.version = "proux01:stdlib251"; + coqutil.override.version = "proux01:stdlib251"; + itauto.override.version = "proux01:stdlib251"; + equations.override.version = "proux01:stdlib251"; + equations-test.override.version = "proux01:stdlib251"; + smtcoq.override.version = "proux01:stdlib251"; + metarocq.override.version = "proux01:stdlib251"; + metarocq-test.override.version = "proux01:stdlib251"; + waterproof.override.version = "proux01:stdlib251"; sf.job = false; # temporarily disactivated in Rocq CI trakt.job = false; # temporarily disactivated in Rocq CI smtcoq-trakt.job = false; # temporarily disactivated in Rocq CI }; common-bundles = listToAttrs (forEach rocq-master (p: - { name = p; value.override.version = "master"; })); + { name = p; value.override.version = "master"; })) + // { + micromega-plugin.override.version = "tify"; + rocq-elpi.override.version = "proux01:stdlib251"; + rocq-elpi-test.override.version = "proux01:stdlib251"; + }; in { "rocq-master" = { rocqPackages = common-bundles // { rocq-core.override.version = "master"; @@ -311,7 +331,7 @@ with builtins; with (import {}).lib; dpdgraph-test.override.version = "7a0fba21287dd8889c55e6611f8ba219d012b81b"; coq-hammer.override.version = "1d581299c2a85af175b53bd35370ea074af922ec"; coq-hammer-tactics.override.version = "1d581299c2a85af175b53bd35370ea074af922ec"; - equations.override.version = "757662b9c875d7169a07b861d48e82157520ab1a"; + equations.job = false; equations-test.job = false; fiat-parsers.job = false; # broken metarocq.override.version = "e8f8078e756cc378b830eb5a8e4637df43d481af"; @@ -321,11 +341,13 @@ with builtins; with (import {}).lib; relation-algebra.override.version = "ba3db5783060d9e25d1db5e377fc9d71338a5160"; rewriter.override.version = "dd37fb28ed7f01a3b7edc0675a86b95dd3eb1545"; rocq-lean-import.override.version = "b8291b9dae4f5ed780112e95eea484e435199b46"; - smtcoq.override.version = "cff0a8cdb7c73b6c59965a749a4304f3c4ac01bf"; + # smtcoq.override.version = "cff0a8cdb7c73b6c59965a749a4304f3c4ac01bf"; + smtcoq.job = false; # smtcoq-trakt.override.version = "9392f7446a174b770110445c155a07b183cdca3d"; stalmarck-tactic.override.version = "d32acd3c477c57b48dd92bdd96d53fb8fa628512"; unicoq.override.version = "d52374ca86e3885197f114555e742420fa9bbe94"; - waterproof.override.version = "99ad6ff78fa700c84ba0cb1d1bda27d8e0f11e1a"; + # waterproof.override.version = "99ad6ff78fa700c84ba0cb1d1bda27d8e0f11e1a"; + waterproof.job = false; compcert.job = false; # broken VST.job = false; # depends on compcert } // listToAttrs (forEach lighten-released (p: @@ -346,21 +368,21 @@ with builtins; with (import {}).lib; dpdgraph-test.override.version = "7817def06d4e3abc2e54a2600cf6e29d63d58b8a"; coq-hammer.override.version = "8649603dcbac5d92eaf1319a6b7cdfc65cdd804b"; coq-hammer-tactics.override.version = "8649603dcbac5d92eaf1319a6b7cdfc65cdd804b"; - equations.override.version = "2137c8e7081f2d47ab903de0cc09fd6a05bfab01"; + equations.job = false; equations-test.job = false; fiat-parsers.job = false; # broken - metarocq.override.version = "2995003b88f3812e5649cfdd0f9a4c44ceaf0700"; - metarocq-test.override.version = "2995003b88f3812e5649cfdd0f9a4c44ceaf0700"; mtac2.override.version = "bcbefa79406fc113f878eb5f89758de241d81433"; paramcoq-test.override.version = "937537d416bc5f7b81937d4223d7783d0e687239"; relation-algebra.override.version = "4db15229396abfd8913685be5ffda4f0fdb593d9"; rewriter.override.version = "9496defb8b236f442d11372f6e0b5e48aa38acfc"; rocq-lean-import.override.version = "c3546102f242aaa1e9af921c78bdb1132522e444"; - smtcoq.override.version = "5c6033c906249fcf98a48b4112f6996053124514"; + # smtcoq.override.version = "5c6033c906249fcf98a48b4112f6996053124514"; + smtcoq.job = false; # smtcoq-trakt.override.version = "9392f7446a174b770110445c155a07b183cdca3d"; stalmarck-tactic.override.version = "d32acd3c477c57b48dd92bdd96d53fb8fa628512"; unicoq.override.version = "28ec18aef35877829535316fc09825a25be8edf1"; - waterproof.override.version = "dd712eb0b7f5c205870dbd156736a684d40eeb9a"; + # waterproof.override.version = "dd712eb0b7f5c205870dbd156736a684d40eeb9a"; + waterproof.job = false; compcert.job = false; # broken VST.job = false; # depends on compcert } // listToAttrs (forEach lighten-released (p: diff --git a/.nix/coq-nix-toolbox.nix b/.nix/coq-nix-toolbox.nix index b6d32e70df..4f9fec949b 100644 --- a/.nix/coq-nix-toolbox.nix +++ b/.nix/coq-nix-toolbox.nix @@ -1 +1 @@ -"3b7baf61aa95441d62332d7fdad562a61a125f80" +"e0b17bf483bcde5079722f9bc494063373ee098e" diff --git a/.nix/coq-overlays/itauto/default.nix b/.nix/coq-overlays/itauto/default.nix new file mode 100644 index 0000000000..bb50706f3b --- /dev/null +++ b/.nix/coq-overlays/itauto/default.nix @@ -0,0 +1,67 @@ +{ + lib, + callPackage, + mkCoqDerivation, + coq, + stdlib, + dune, + version ? null, +}: + +(mkCoqDerivation { + pname = "itauto"; + owner = "fbesson"; + # domain = "gitlab.inria.fr"; + + release."8.20.0".sha256 = "sha256-LYKGbI3O6yw6CiTJNUGL11PT4q4o+gJK1kQgKQL0/Hk="; + release."8.19.0".sha256 = "sha256-xKWCF4dYvvlJUVGCZcR2RLCG55vlGzu2GN30MeRvVD4="; + release."8.18.0".sha256 = "sha256-4mDDnKTeYrf27uRMkydQxO7j2tfgTFXOREW474d40eo="; + release."8.17.0".sha256 = "sha256-fgdnKchNT1Hyrq14gU8KWYnlSfg3qlsSw5A4+RoA26w="; + release."8.16.0".sha256 = "sha256-4zAUYGlw/pBcLPv2GroIduIlvbfi1+Vy+TdY8KLCqO4="; + release."8.15.0".sha256 = "sha256:10qpv4nx1p0wm9sas47yzsg9z22dhvizszfa21yff08a8fr0igya"; + release."8.14.0".sha256 = "sha256:1k6pqhv4dwpkwg81f2rlfg40wh070ks1gy9r0ravm2zhsbxqcfc9"; + release."8.13+no".sha256 = "sha256-gXoxtLcHPoyjJkt7WqvzfCMCQlh6kL2KtCGe3N6RC/A="; + inherit version; + defaultVersion = + let + case = case: out: { inherit case out; }; + in + with lib.versions; + lib.switch coq.coq-version [ + (case (isEq "8.20") "8.20.0") + (case (isEq "8.19") "8.19.0") + (case (isEq "8.18") "8.18.0") + (case (isEq "8.17") "8.17.0") + (case (isEq "8.16") "8.16.0") + (case (isEq "8.15") "8.15.0") + (case (isEq "8.14") "8.14.0") + (case (isEq "8.13") "8.13+no") + ] null; + + mlPlugin = true; + nativeBuildInputs = (with coq.ocamlPackages; [ ocamlbuild ]); + enableParallelBuilding = false; + + passthru.tests.suite = callPackage ./test.nix { }; + + propagatedBuildInputs = [ stdlib ]; + + meta = { + description = "Reflexive SAT solver parameterised by a leaf tactic and Nelson-Oppen support"; + maintainers = with lib.maintainers; [ siraben ]; + license = lib.licenses.gpl3Plus; + }; +}).overrideAttrs + ( + o: + lib.optionalAttrs (o.version == "dev" || lib.versionAtLeast o.version "8.16") { + propagatedBuildInputs = o.propagatedBuildInputs ++ [ coq.ocamlPackages.findlib ]; + } + // lib.optionalAttrs (o.version == "dev" || lib.versionAtLeast o.version "8.18") { + nativeBuildInputs = with coq.ocamlPackages; [ + ocaml + findlib + dune + ]; + } + ) diff --git a/.nix/coq-overlays/itauto/test.nix b/.nix/coq-overlays/itauto/test.nix new file mode 100644 index 0000000000..f442783904 --- /dev/null +++ b/.nix/coq-overlays/itauto/test.nix @@ -0,0 +1,38 @@ +{ + stdenv, + lib, + coq, + itauto, +}: + +let + excluded = lib.optionals (lib.versions.isEq "8.16" itauto.version) [ + "arith.v" + "refl_bool.v" + ]; +in + +stdenv.mkDerivation { + pname = "coq${coq.coq-version}-itauto-test"; + inherit (itauto) src version; + + nativeCheckInputs = [ + coq + itauto + ]; + + dontConfigure = true; + dontBuild = true; + doCheck = true; + + checkPhase = '' + cd test-suite + for m in *.v + do + echo -n ${lib.concatStringsSep " " excluded} | grep --silent $m && continue + echo $m && coqc $m + done + ''; + + installPhase = "touch $out"; +} diff --git a/.nix/rocq-overlays/stdlib-refman-html/default.nix b/.nix/rocq-overlays/stdlib-refman-html/default.nix index bdf9ed39ac..c35cf8e20c 100644 --- a/.nix/rocq-overlays/stdlib-refman-html/default.nix +++ b/.nix/rocq-overlays/stdlib-refman-html/default.nix @@ -15,8 +15,12 @@ rocqPackages.lib.overrideRocqDerivation { useDune = true; - buildPhase = '' + configurePhase = '' + export COQPATH=''${ROCQPATH} patchShebangs dev/with-rocq-wrap.sh + ''; + + buildPhase = '' dev/with-rocq-wrap.sh dune build --root . --no-buffer @refman-html ''${enableParallelBuilding:+-j $NIX_BUILD_CORES} ''; diff --git a/default.nix b/default.nix index ec2742873f..4bb04e5b4c 100644 --- a/default.nix +++ b/default.nix @@ -4,8 +4,8 @@ bundle ? null, job ? null, inNixShell ? null, src ? ./., }@args: let auto = fetchGit { - url = "https://github.com/rocq-community/coq-nix-toolbox.git"; - ref = "master"; + url = "https://github.com/proux01/coq-nix-toolbox.git"; + ref = "micromega"; rev = import .nix/coq-nix-toolbox.nix; }; in diff --git a/rocq-stdlib.opam b/rocq-stdlib.opam index 9ae8c9805d..78db1fac90 100644 --- a/rocq-stdlib.opam +++ b/rocq-stdlib.opam @@ -26,6 +26,7 @@ dev-repo: "git+https://github.com/coq/stdlib.git" depends: [ "rocq-runtime" "rocq-core" {>= "9.1"} + "micromega-plugin" {= "dev"} ] build: [ [make "-j" jobs] diff --git a/subcomponents/corelib_wrapper.v b/subcomponents/corelib_wrapper.v index 7ce6279b14..ae07b6f823 100644 --- a/subcomponents/corelib_wrapper.v +++ b/subcomponents/corelib_wrapper.v @@ -3,6 +3,7 @@ From Stdlib Require Array.PrimArray. From Stdlib Require BinNums.IntDef. From Stdlib Require BinNums.NatDef. From Stdlib Require BinNums.PosDef. +From Stdlib Require BinNums.RatDef. From Stdlib Require Classes.CMorphisms. From Stdlib Require Classes.CRelationClasses. From Stdlib Require Classes.Equivalence. diff --git a/subcomponents/field.v b/subcomponents/field.v index b95bcc6f26..6967748aca 100644 --- a/subcomponents/field.v +++ b/subcomponents/field.v @@ -1,2 +1,3 @@ From subcomponents Require ring. From Stdlib Require setoid_ring.Field. +From Stdlib Require setoid_ring.field_eval. diff --git a/subcomponents/lia.v b/subcomponents/lia.v index 9edcd1b3ab..b1a1a6e7bb 100644 --- a/subcomponents/lia.v +++ b/subcomponents/lia.v @@ -1,11 +1,3 @@ From subcomponents Require ring. +From subcomponents Require tify. From Stdlib Require micromega.Lia. -From Stdlib Require micromega.SatDivMod. -From Stdlib Require micromega.Zify. -From Stdlib Require micromega.ZifyBool. -From Stdlib Require micromega.ZifyClasses. -From Stdlib Require micromega.ZifyComparison. -From Stdlib Require micromega.ZifyInst. -From Stdlib Require micromega.ZifyN. -From Stdlib Require micromega.ZifyNat. -From Stdlib Require micromega.ZifyPow. diff --git a/subcomponents/ring.v b/subcomponents/ring.v index 1ba18583c5..1fe6b42300 100644 --- a/subcomponents/ring.v +++ b/subcomponents/ring.v @@ -18,6 +18,7 @@ From Stdlib Require setoid_ring.Ring_tac. From Stdlib Require setoid_ring.ArithRing. From Stdlib Require setoid_ring.NArithRing. From Stdlib Require setoid_ring.Ring_theory. +From Stdlib Require setoid_ring.ring_eval. From Stdlib Require nsatz.NsatzTactic. From Stdlib Require nsatz.ENsatzTactic. From Stdlib Require micromega.VarMap. diff --git a/subcomponents/tify.v b/subcomponents/tify.v new file mode 100644 index 0000000000..35e44cc167 --- /dev/null +++ b/subcomponents/tify.v @@ -0,0 +1,12 @@ +From subcomponents Require integers. +From subcomponents Require ring. +From Stdlib Require micromega.Tify. +From Stdlib Require micromega.Zify. +From Stdlib Require micromega.SatDivMod. +From Stdlib Require micromega.ZifyBool. +From Stdlib Require micromega.ZifyClasses. +From Stdlib Require micromega.ZifyComparison. +From Stdlib Require micromega.ZifyInst. +From Stdlib Require micromega.ZifyN. +From Stdlib Require micromega.ZifyNat. +From Stdlib Require micromega.ZifyPow. diff --git a/test-suite/Makefile b/test-suite/Makefile index 3f841e31c7..3cf28cf991 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -136,7 +136,8 @@ PREREQUISITELOG = $(addsuffix .log,$(wildcard prerequisite/*.v)) .csdp.cache ifeq ($(COQLIB_NOT_FOUND),true) all: @echo "" - @echo "Coq's standard library has not been installed; please run: " + @echo "The Stdli library has not been installed; please run:" + @echo " - cd .." @echo " - make" @echo " - make install" @echo "" diff --git a/test-suite/bugs/bug_5359.v b/test-suite/bugs/bug_5359.v index eb8205940f..50b6acc8a6 100644 --- a/test-suite/bugs/bug_5359.v +++ b/test-suite/bugs/bug_5359.v @@ -7,215 +7,215 @@ Goal False. let sugar := constr:( 0%Z ) in let nparams := constr:( (-1)%Z ) in let reified_goal := constr:( - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) ) in + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) ) in let power := constr:( N.one ) in let reified_givens := constr:( - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 9)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) (Ring_polynom.PEX Z 8))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3)))) :: nil)%list ) in + (PEmul + (PEadd (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) + :: PEsub + (PEmul + (PEadd (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEX Z 2)) (PEX Z 5)) + (PEX Z 3)) (PEX Z 6))) + (PEX Z 10)) (PEc 1%Z) + :: PEsub + (PEmul + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEX Z 2)) (PEX Z 5)) + (PEX Z 3)) (PEX Z 6))) + (PEX Z 9)) (PEc 1%Z) + :: PEsub + (PEadd + (PEmul (PEX Z 1) + (PEmul (PEX Z 7) + (PEX Z 7))) + (PEmul (PEX Z 8) (PEX Z 8))) + (PEadd (PEc 1%Z) + (PEmul + (PEmul (PEX Z 4) + (PEmul (PEX Z 7) + (PEX Z 7))) + (PEmul (PEX Z 8) + (PEX Z 8)))) + :: PEsub + (PEadd + (PEmul (PEX Z 1) + (PEmul (PEX Z 5) + (PEX Z 5))) + (PEmul (PEX Z 6) + (PEX Z 6))) + (PEadd (PEc 1%Z) + (PEmul + (PEmul (PEX Z 4) + (PEmul (PEX Z 5) + (PEX Z 5))) + (PEmul (PEX Z 6) + (PEX Z 6)))) + :: PEsub + (PEadd + (PEmul (PEX Z 1) + (PEmul (PEX Z 2) + (PEX Z 2))) + (PEmul (PEX Z 3) + (PEX Z 3))) + (PEadd (PEc 1%Z) + (PEmul + (PEmul (PEX Z 4) + (PEmul (PEX Z 2) + (PEX Z 2))) + (PEmul (PEX Z 3) + (PEX Z 3)))) :: nil)%list ) in NsatzTactic.nsatz_compute - (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). + (@cons _ (@PEc _ sugar) (@cons _ (@PEc _ nparams) (@cons _ (@PEpow _ reified_goal power) reified_givens))). let sugar := constr:( 0%Z ) in let nparams := constr:( (-1)%Z ) in let reified_goal := constr:( - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) ) in + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) ) in let power := constr:( N.one ) in let reified_givens := constr:( - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - :: Ring_polynom.PEadd - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 6)) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 5)))) (Ring_polynom.PEX Z 7)) - (Ring_polynom.PEsub - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 6)) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)))) - (Ring_polynom.PEX Z 8)) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) (Ring_polynom.PEX Z 9)) - (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3)))) :: nil)%list ) in + (PEmul + (PEadd (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) + :: PEadd + (PEmul + (PEadd (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEX Z 2)) (PEX Z 5)) + (PEX Z 3)) (PEX Z 6))) + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEX Z 2)) (PEX Z 5)) + (PEX Z 3)) (PEX Z 6)))) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEadd + (PEmul (PEX Z 2) + (PEX Z 6)) + (PEmul (PEX Z 3) + (PEX Z 5)))) (PEX Z 7)) + (PEsub + (PEmul (PEX Z 3) (PEX Z 6)) + (PEmul + (PEmul (PEX Z 1) + (PEX Z 2)) (PEX Z 5)))) + (PEX Z 8)) + :: PEsub + (PEmul + (PEadd (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEX Z 2)) (PEX Z 5)) + (PEX Z 3)) (PEX Z 6))) + (PEX Z 10)) (PEc 1%Z) + :: PEsub + (PEmul + (PEsub (PEc 1%Z) + (PEmul + (PEmul + (PEmul + (PEmul (PEX Z 4) + (PEX Z 2)) + (PEX Z 5)) (PEX Z 3)) + (PEX Z 6))) (PEX Z 9)) + (PEc 1%Z) + :: PEsub + (PEadd + (PEmul (PEX Z 1) + (PEmul (PEX Z 7) + (PEX Z 7))) + (PEmul (PEX Z 8) + (PEX Z 8))) + (PEadd (PEc 1%Z) + (PEmul + (PEmul (PEX Z 4) + (PEmul (PEX Z 7) + (PEX Z 7))) + (PEmul (PEX Z 8) + (PEX Z 8)))) + :: PEsub + (PEadd + (PEmul (PEX Z 1) + (PEmul (PEX Z 5) + (PEX Z 5))) + (PEmul (PEX Z 6) + (PEX Z 6))) + (PEadd (PEc 1%Z) + (PEmul + (PEmul (PEX Z 4) + (PEmul (PEX Z 5) + (PEX Z 5))) + (PEmul (PEX Z 6) + (PEX Z 6)))) + :: PEsub + (PEadd + (PEmul (PEX Z 1) + (PEmul (PEX Z 2) + (PEX Z 2))) + (PEmul (PEX Z 3) + (PEX Z 3))) + (PEadd (PEc 1%Z) + (PEmul + (PEmul (PEX Z 4) + (PEmul (PEX Z 2) + (PEX Z 2))) + (PEmul (PEX Z 3) + (PEX Z 3)))) :: nil)%list ) in NsatzTactic.nsatz_compute - (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). + (@cons _ (@PEc _ sugar) (@cons _ (@PEc _ nparams) (@cons _ (@PEpow _ reified_goal power) reified_givens))). Abort. diff --git a/test-suite/micromega/bug_18158.v b/test-suite/micromega/bug_18158.v index 002e0f373f..f6be97463c 100644 --- a/test-suite/micromega/bug_18158.v +++ b/test-suite/micromega/bug_18158.v @@ -85,7 +85,7 @@ Goal forall x y , -> Z.le (Z.shiftr y 8) 255 -> Z.le (Z.shiftr x 24) 255. intros. - Zify.zify_saturate. - (* [xlia zchecker] used to raise a [Stack overflow] error. It is supposed to fail normally. *) - assert_fails (xlia zchecker). + Tify.tify_saturate. + (* [mp_lia zchecker] used to raise a [Stack overflow] error. It is supposed to fail normally. *) + assert_fails (mp_lia zchecker). Abort. diff --git a/test-suite/micromega/witness_tactics.v b/test-suite/micromega/witness_tactics.v deleted file mode 100644 index c4c12066e5..0000000000 --- a/test-suite/micromega/witness_tactics.v +++ /dev/null @@ -1,54 +0,0 @@ -From Stdlib Require Import ZArith QArith. -From Stdlib.micromega Require Import RingMicromega EnvRing Tauto. -From Stdlib.micromega Require Import ZMicromega QMicromega. - -Declare ML Module "rocq-runtime.plugins.micromega". - -Goal True. -Proof. -pose (ff := - IMPL - (EQ - (A isBool - {| - Flhs := PEadd (PEX 1) (PEmul (PEc 2%Q) (PEX 2)); - Fop := OpLe; - Frhs := PEc 3%Q - |} tt) (TT isBool)) None - (IMPL - (EQ - (A isBool - {| - Flhs := PEadd (PEmul (PEc 2%Q) (PEX 1)) (PEX 2); - Fop := OpLe; - Frhs := PEc 3%Q - |} tt) (TT isBool)) None - (EQ - (A isBool - {| Flhs := PEadd (PEX 1) (PEX 2); Fop := OpLe; Frhs := PEc 2%Q |} tt) - (TT isBool))) : BFormula (Formula Q) isProp). -let ff' := eval unfold ff in ff in wlra_Q wit0 ff'. -Check eq_refl : wit0 = (PsatzAdd (PsatzIn Q 2) - (PsatzAdd (PsatzIn Q 1) (PsatzMulE (PsatzC 3%Q) (PsatzIn Q 0))) :: nil)%list. -let ff' := eval unfold ff in ff in wlia wit1 ff'. -Check eq_refl : wit1 = (RatProof (PsatzAdd (PsatzIn Z 2) (PsatzAdd (PsatzIn Z 1) - (PsatzIn Z 0))) DoneProof :: nil)%list. -let ff' := eval unfold ff in ff in wnia wit4 ff'. -Check eq_refl : wit4 = (RatProof (PsatzAdd (PsatzIn Z 2) (PsatzAdd (PsatzIn Z 1) - (PsatzIn Z 0))) DoneProof :: nil)%list. -let ff' := eval unfold ff in ff in wnra_Q wit5 ff'. -Check eq_refl : wit5 = (PsatzAdd (PsatzIn Q 2) - (PsatzAdd (PsatzIn Q 1) (PsatzMulE (PsatzC 3%Q) (PsatzIn Q 0))) :: nil)%list. -Fail let ff' := eval unfold ff in ff in wsos_Q wit6 ff'. -Fail let ff' := eval unfold ff in ff in wsos_Z wit6 ff'. -(* Requires Csdp, not in CI -let ff' := eval unfold ff in ff in wpsatz_Z 3 wit2 ff'. -Check eq_refl : wit2 = (RatProof (PsatzAdd (PsatzC 1) - (PsatzAdd (PsatzIn Z 2) (PsatzAdd (PsatzIn Z 1) (PsatzIn Z 0)))) DoneProof - :: nil)%list. -let ff' := eval unfold ff in ff in wpsatz_Q 3 wit3 ff'. -Check eq_refl : wit3 = (PsatzAdd (PsatzIn Q 0) - (PsatzAdd (PsatzMulE (PsatzIn Q 2) (PsatzC (1 # 2))) - (PsatzAdd (PsatzMulE (PsatzIn Q 1) (PsatzC (1 # 2))) - (PsatzMulE (PsatzIn Q 0) (PsatzC (1 # 2))))) :: nil)%list. *) -Abort. diff --git a/test-suite/output/InfoMicromega.v b/test-suite/output/InfoMicromega.v index 094245f16d..795b5ac4db 100644 --- a/test-suite/output/InfoMicromega.v +++ b/test-suite/output/InfoMicromega.v @@ -1,7 +1,7 @@ From Stdlib Require Import Reals Lra. Open Scope R_scope. -Set Info Micromega. +Set Micromega Info. Goal forall (x y z:R), x + y > 0 -> x - y > 0 -> x + z = 0 -> x < 0 -> False. Proof. diff --git a/test-suite/output/MExtraction.out b/test-suite/output/MExtraction.out deleted file mode 100644 index a1ab5d3224..0000000000 --- a/test-suite/output/MExtraction.out +++ /dev/null @@ -1,2603 +0,0 @@ - -type __ = Obj.t - -type unit0 = -| Tt - -(** val negb : bool -> bool **) - -let negb = function -| true -> false -| false -> true - -type nat = -| O -| S of nat - -type ('a, 'b) sum = -| Inl of 'a -| Inr of 'b - -(** val fst : ('a1 * 'a2) -> 'a1 **) - -let fst = function -| x,_ -> x - -(** val snd : ('a1 * 'a2) -> 'a2 **) - -let snd = function -| _,y -> y - -(** val app : 'a1 list -> 'a1 list -> 'a1 list **) - -let rec app l m = - match l with - | [] -> m - | a::l1 -> a::(app l1 m) - -type comparison = -| Eq -| Lt -| Gt - -(** val compOpp : comparison -> comparison **) - -let compOpp = function -| Eq -> Eq -| Lt -> Gt -| Gt -> Lt - -module Coq__1 = struct - (** val add : nat -> nat -> nat **) - - let rec add n0 m = - match n0 with - | O -> m - | S p -> S (add p m) -end -include Coq__1 - -(** val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list **) - -let rec map f = function -| [] -> [] -| a::l0 -> (f a)::(map f l0) - -(** val nth : nat -> 'a1 list -> 'a1 -> 'a1 **) - -let rec nth n0 l default = - match n0 with - | O -> (match l with - | [] -> default - | x::_ -> x) - | S m -> (match l with - | [] -> default - | _::l' -> nth m l' default) - -(** val rev_append : 'a1 list -> 'a1 list -> 'a1 list **) - -let rec rev_append l l' = - match l with - | [] -> l' - | a::l0 -> rev_append l0 (a::l') - -(** val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a2 list -> 'a1 -> 'a1 **) - -let rec fold_left f l a0 = - match l with - | [] -> a0 - | b::l0 -> fold_left f l0 (f a0 b) - -(** val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1 **) - -let rec fold_right f a0 = function -| [] -> a0 -| b::l0 -> f b (fold_right f a0 l0) - -type positive = -| XI of positive -| XO of positive -| XH - -type n = -| N0 -| Npos of positive - -type z = -| Z0 -| Zpos of positive -| Zneg of positive - -module Pos = - struct - (** val succ : positive -> positive **) - - let rec succ = function - | XI p -> XO (succ p) - | XO p -> XI p - | XH -> XO XH - - (** val add : positive -> positive -> positive **) - - let rec add x y = - match x with - | XI p -> - (match y with - | XI q0 -> XO (add_carry p q0) - | XO q0 -> XI (add p q0) - | XH -> XO (succ p)) - | XO p -> - (match y with - | XI q0 -> XI (add p q0) - | XO q0 -> XO (add p q0) - | XH -> XI p) - | XH -> (match y with - | XI q0 -> XO (succ q0) - | XO q0 -> XI q0 - | XH -> XO XH) - - (** val add_carry : positive -> positive -> positive **) - - and add_carry x y = - match x with - | XI p -> - (match y with - | XI q0 -> XI (add_carry p q0) - | XO q0 -> XO (add_carry p q0) - | XH -> XI (succ p)) - | XO p -> - (match y with - | XI q0 -> XO (add_carry p q0) - | XO q0 -> XI (add p q0) - | XH -> XO (succ p)) - | XH -> - (match y with - | XI q0 -> XI (succ q0) - | XO q0 -> XO (succ q0) - | XH -> XI XH) - - (** val pred_double : positive -> positive **) - - let rec pred_double = function - | XI p -> XI (XO p) - | XO p -> XI (pred_double p) - | XH -> XH - - type mask = - | IsNul - | IsPos of positive - | IsNeg - - (** val mul : positive -> positive -> positive **) - - let rec mul x y = - match x with - | XI p -> add y (XO (mul p y)) - | XO p -> XO (mul p y) - | XH -> y - - (** val iter : ('a1 -> 'a1) -> 'a1 -> positive -> 'a1 **) - - let rec iter f x = function - | XI n' -> f (iter f (iter f x n') n') - | XO n' -> iter f (iter f x n') n' - | XH -> f x - - (** val compare_cont : comparison -> positive -> positive -> comparison **) - - let rec compare_cont r x y = - match x with - | XI p -> - (match y with - | XI q0 -> compare_cont r p q0 - | XO q0 -> compare_cont Gt p q0 - | XH -> Gt) - | XO p -> - (match y with - | XI q0 -> compare_cont Lt p q0 - | XO q0 -> compare_cont r p q0 - | XH -> Gt) - | XH -> (match y with - | XH -> r - | _ -> Lt) - - (** val compare : positive -> positive -> comparison **) - - let compare = - compare_cont Eq - - (** val eqb : positive -> positive -> bool **) - - let rec eqb p q0 = - match p with - | XI p2 -> (match q0 with - | XI q1 -> eqb p2 q1 - | _ -> false) - | XO p2 -> (match q0 with - | XO q1 -> eqb p2 q1 - | _ -> false) - | XH -> (match q0 with - | XH -> true - | _ -> false) - - (** val of_succ_nat : nat -> positive **) - - let rec of_succ_nat = function - | O -> XH - | S x -> succ (of_succ_nat x) - end - -module Coq_Pos = - struct - (** val succ : positive -> positive **) - - let rec succ = function - | XI p -> XO (succ p) - | XO p -> XI p - | XH -> XO XH - - (** val add : positive -> positive -> positive **) - - let rec add x y = - match x with - | XI p -> - (match y with - | XI q0 -> XO (add_carry p q0) - | XO q0 -> XI (add p q0) - | XH -> XO (succ p)) - | XO p -> - (match y with - | XI q0 -> XI (add p q0) - | XO q0 -> XO (add p q0) - | XH -> XI p) - | XH -> (match y with - | XI q0 -> XO (succ q0) - | XO q0 -> XI q0 - | XH -> XO XH) - - (** val add_carry : positive -> positive -> positive **) - - and add_carry x y = - match x with - | XI p -> - (match y with - | XI q0 -> XI (add_carry p q0) - | XO q0 -> XO (add_carry p q0) - | XH -> XI (succ p)) - | XO p -> - (match y with - | XI q0 -> XO (add_carry p q0) - | XO q0 -> XI (add p q0) - | XH -> XO (succ p)) - | XH -> - (match y with - | XI q0 -> XI (succ q0) - | XO q0 -> XO (succ q0) - | XH -> XI XH) - - (** val pred_double : positive -> positive **) - - let rec pred_double = function - | XI p -> XI (XO p) - | XO p -> XI (pred_double p) - | XH -> XH - - type mask = Pos.mask = - | IsNul - | IsPos of positive - | IsNeg - - (** val succ_double_mask : mask -> mask **) - - let succ_double_mask = function - | IsNul -> IsPos XH - | IsPos p -> IsPos (XI p) - | IsNeg -> IsNeg - - (** val double_mask : mask -> mask **) - - let double_mask = function - | IsPos p -> IsPos (XO p) - | x0 -> x0 - - (** val double_pred_mask : positive -> mask **) - - let double_pred_mask = function - | XI p -> IsPos (XO (XO p)) - | XO p -> IsPos (XO (pred_double p)) - | XH -> IsNul - - (** val sub_mask : positive -> positive -> mask **) - - let rec sub_mask x y = - match x with - | XI p -> - (match y with - | XI q0 -> double_mask (sub_mask p q0) - | XO q0 -> succ_double_mask (sub_mask p q0) - | XH -> IsPos (XO p)) - | XO p -> - (match y with - | XI q0 -> succ_double_mask (sub_mask_carry p q0) - | XO q0 -> double_mask (sub_mask p q0) - | XH -> IsPos (pred_double p)) - | XH -> (match y with - | XH -> IsNul - | _ -> IsNeg) - - (** val sub_mask_carry : positive -> positive -> mask **) - - and sub_mask_carry x y = - match x with - | XI p -> - (match y with - | XI q0 -> succ_double_mask (sub_mask_carry p q0) - | XO q0 -> double_mask (sub_mask p q0) - | XH -> IsPos (pred_double p)) - | XO p -> - (match y with - | XI q0 -> double_mask (sub_mask_carry p q0) - | XO q0 -> succ_double_mask (sub_mask_carry p q0) - | XH -> double_pred_mask p) - | XH -> IsNeg - - (** val sub : positive -> positive -> positive **) - - let sub x y = - match sub_mask x y with - | IsPos z0 -> z0 - | _ -> XH - - (** val mul : positive -> positive -> positive **) - - let rec mul x y = - match x with - | XI p -> add y (XO (mul p y)) - | XO p -> XO (mul p y) - | XH -> y - - (** val compare_cont : comparison -> positive -> positive -> comparison **) - - let rec compare_cont r x y = - match x with - | XI p -> - (match y with - | XI q0 -> compare_cont r p q0 - | XO q0 -> compare_cont Gt p q0 - | XH -> Gt) - | XO p -> - (match y with - | XI q0 -> compare_cont Lt p q0 - | XO q0 -> compare_cont r p q0 - | XH -> Gt) - | XH -> (match y with - | XH -> r - | _ -> Lt) - - (** val compare : positive -> positive -> comparison **) - - let compare = - compare_cont Eq - - (** val leb : positive -> positive -> bool **) - - let leb x y = - match compare x y with - | Gt -> false - | _ -> true - - (** val size_nat : positive -> nat **) - - let rec size_nat = function - | XI p2 -> S (size_nat p2) - | XO p2 -> S (size_nat p2) - | XH -> S O - - (** val max : positive -> positive -> positive **) - - let max p p' = - match compare p p' with - | Gt -> p - | _ -> p' - - (** val gcdn : nat -> positive -> positive -> positive **) - - let rec gcdn n0 a b = - match n0 with - | O -> XH - | S n1 -> - (match a with - | XI a' -> - (match b with - | XI b' -> - (match compare a' b' with - | Eq -> a - | Lt -> gcdn n1 (sub b' a') a - | Gt -> gcdn n1 (sub a' b') b) - | XO b0 -> gcdn n1 a b0 - | XH -> XH) - | XO a0 -> - (match b with - | XI _ -> gcdn n1 a0 b - | XO b0 -> XO (gcdn n1 a0 b0) - | XH -> XH) - | XH -> XH) - - (** val gcd : positive -> positive -> positive **) - - let gcd a b = - gcdn (Coq__1.add (size_nat a) (size_nat b)) a b - end - -module N = - struct - (** val of_nat : nat -> n **) - - let of_nat = function - | O -> N0 - | S n' -> Npos (Pos.of_succ_nat n') - end - -module Z = - struct - (** val double : z -> z **) - - let double = function - | Z0 -> Z0 - | Zpos p -> Zpos (XO p) - | Zneg p -> Zneg (XO p) - - (** val succ_double : z -> z **) - - let succ_double = function - | Z0 -> Zpos XH - | Zpos p -> Zpos (XI p) - | Zneg p -> Zneg (Pos.pred_double p) - - (** val pred_double : z -> z **) - - let pred_double = function - | Z0 -> Zneg XH - | Zpos p -> Zpos (Pos.pred_double p) - | Zneg p -> Zneg (XI p) - - (** val pos_sub : positive -> positive -> z **) - - let rec pos_sub x y = - match x with - | XI p -> - (match y with - | XI q0 -> double (pos_sub p q0) - | XO q0 -> succ_double (pos_sub p q0) - | XH -> Zpos (XO p)) - | XO p -> - (match y with - | XI q0 -> pred_double (pos_sub p q0) - | XO q0 -> double (pos_sub p q0) - | XH -> Zpos (Pos.pred_double p)) - | XH -> - (match y with - | XI q0 -> Zneg (XO q0) - | XO q0 -> Zneg (Pos.pred_double q0) - | XH -> Z0) - - (** val add : z -> z -> z **) - - let add x y = - match x with - | Z0 -> y - | Zpos x' -> - (match y with - | Z0 -> x - | Zpos y' -> Zpos (Pos.add x' y') - | Zneg y' -> pos_sub x' y') - | Zneg x' -> - (match y with - | Z0 -> x - | Zpos y' -> pos_sub y' x' - | Zneg y' -> Zneg (Pos.add x' y')) - - (** val opp : z -> z **) - - let opp = function - | Z0 -> Z0 - | Zpos x0 -> Zneg x0 - | Zneg x0 -> Zpos x0 - - (** val sub : z -> z -> z **) - - let sub m n0 = - add m (opp n0) - - (** val mul : z -> z -> z **) - - let mul x y = - match x with - | Z0 -> Z0 - | Zpos x' -> - (match y with - | Z0 -> Z0 - | Zpos y' -> Zpos (Pos.mul x' y') - | Zneg y' -> Zneg (Pos.mul x' y')) - | Zneg x' -> - (match y with - | Z0 -> Z0 - | Zpos y' -> Zneg (Pos.mul x' y') - | Zneg y' -> Zpos (Pos.mul x' y')) - - (** val pow_pos : z -> positive -> z **) - - let pow_pos z0 = - Pos.iter (mul z0) (Zpos XH) - - (** val pow : z -> z -> z **) - - let pow x = function - | Z0 -> Zpos XH - | Zpos p -> pow_pos x p - | Zneg _ -> Z0 - - (** val compare : z -> z -> comparison **) - - let compare x y = - match x with - | Z0 -> (match y with - | Z0 -> Eq - | Zpos _ -> Lt - | Zneg _ -> Gt) - | Zpos x' -> (match y with - | Zpos y' -> Pos.compare x' y' - | _ -> Gt) - | Zneg x' -> - (match y with - | Zneg y' -> compOpp (Pos.compare x' y') - | _ -> Lt) - - (** val leb : z -> z -> bool **) - - let leb x y = - match compare x y with - | Gt -> false - | _ -> true - - (** val ltb : z -> z -> bool **) - - let ltb x y = - match compare x y with - | Lt -> true - | _ -> false - - (** val eqb : z -> z -> bool **) - - let eqb x y = - match x with - | Z0 -> (match y with - | Z0 -> true - | _ -> false) - | Zpos p -> (match y with - | Zpos q0 -> Pos.eqb p q0 - | _ -> false) - | Zneg p -> (match y with - | Zneg q0 -> Pos.eqb p q0 - | _ -> false) - - (** val max : z -> z -> z **) - - let max n0 m = - match compare n0 m with - | Lt -> m - | _ -> n0 - - (** val of_nat : nat -> z **) - - let of_nat = function - | O -> Z0 - | S n1 -> Zpos (Pos.of_succ_nat n1) - - (** val of_N : n -> z **) - - let of_N = function - | N0 -> Z0 - | Npos p -> Zpos p - - (** val pos_div_eucl : positive -> z -> z * z **) - - let rec pos_div_eucl a b = - match a with - | XI a' -> - let q0,r = pos_div_eucl a' b in - let r' = add (mul (Zpos (XO XH)) r) (Zpos XH) in - if ltb r' b - then (mul (Zpos (XO XH)) q0),r' - else (add (mul (Zpos (XO XH)) q0) (Zpos XH)),(sub r' b) - | XO a' -> - let q0,r = pos_div_eucl a' b in - let r' = mul (Zpos (XO XH)) r in - if ltb r' b - then (mul (Zpos (XO XH)) q0),r' - else (add (mul (Zpos (XO XH)) q0) (Zpos XH)),(sub r' b) - | XH -> if leb (Zpos (XO XH)) b then Z0,(Zpos XH) else (Zpos XH),Z0 - - (** val div_eucl : z -> z -> z * z **) - - let div_eucl a b = - match a with - | Z0 -> Z0,Z0 - | Zpos a' -> - (match b with - | Z0 -> Z0,a - | Zpos _ -> pos_div_eucl a' b - | Zneg b' -> - let q0,r = pos_div_eucl a' (Zpos b') in - (match r with - | Z0 -> (opp q0),Z0 - | _ -> (opp (add q0 (Zpos XH))),(add b r))) - | Zneg a' -> - (match b with - | Z0 -> Z0,a - | Zpos _ -> - let q0,r = pos_div_eucl a' b in - (match r with - | Z0 -> (opp q0),Z0 - | _ -> (opp (add q0 (Zpos XH))),(sub b r)) - | Zneg b' -> let q0,r = pos_div_eucl a' (Zpos b') in q0,(opp r)) - - (** val div : z -> z -> z **) - - let div a b = - let q0,_ = div_eucl a b in q0 - - (** val gtb : z -> z -> bool **) - - let gtb x y = - match compare x y with - | Gt -> true - | _ -> false - - (** val abs : z -> z **) - - let abs = function - | Zneg p -> Zpos p - | x -> x - - (** val to_N : z -> n **) - - let to_N = function - | Zpos p -> Npos p - | _ -> N0 - - (** val gcd : z -> z -> z **) - - let gcd a b = - match a with - | Z0 -> abs b - | Zpos a0 -> - (match b with - | Z0 -> abs a - | Zpos b0 -> Zpos (Coq_Pos.gcd a0 b0) - | Zneg b0 -> Zpos (Coq_Pos.gcd a0 b0)) - | Zneg a0 -> - (match b with - | Z0 -> abs a - | Zpos b0 -> Zpos (Coq_Pos.gcd a0 b0) - | Zneg b0 -> Zpos (Coq_Pos.gcd a0 b0)) - end - -(** val pow_pos0 : ('a1 -> 'a1 -> 'a1) -> 'a1 -> positive -> 'a1 **) - -let rec pow_pos0 rmul x = function -| XI i0 -> let p = pow_pos0 rmul x i0 in rmul x (rmul p p) -| XO i0 -> let p = pow_pos0 rmul x i0 in rmul p p -| XH -> x - -type kind = -| IsProp -| IsBool - -type 'a trace = -| Null -| Push of 'a * 'a trace -| Merge of 'a trace * 'a trace - -type ('tA, 'tX, 'aA, 'aF) gFormula = -| TT of kind -| FF of kind -| X of kind * 'tX -| A of kind * 'tA * 'aA -| AND of kind * ('tA, 'tX, 'aA, 'aF) gFormula * ('tA, 'tX, 'aA, 'aF) gFormula -| OR of kind * ('tA, 'tX, 'aA, 'aF) gFormula * ('tA, 'tX, 'aA, 'aF) gFormula -| NOT of kind * ('tA, 'tX, 'aA, 'aF) gFormula -| IMPL of kind * ('tA, 'tX, 'aA, 'aF) gFormula * 'aF option - * ('tA, 'tX, 'aA, 'aF) gFormula -| IFF of kind * ('tA, 'tX, 'aA, 'aF) gFormula * ('tA, 'tX, 'aA, 'aF) gFormula -| EQ of ('tA, 'tX, 'aA, 'aF) gFormula * ('tA, 'tX, 'aA, 'aF) gFormula - -(** val mapX : - (kind -> 'a2 -> 'a2) -> kind -> ('a1, 'a2, 'a3, 'a4) gFormula -> ('a1, - 'a2, 'a3, 'a4) gFormula **) - -let rec mapX f _ = function -| X (k0, x) -> X (k0, (f k0 x)) -| AND (k0, f1, f2) -> AND (k0, (mapX f k0 f1), (mapX f k0 f2)) -| OR (k0, f1, f2) -> OR (k0, (mapX f k0 f1), (mapX f k0 f2)) -| NOT (k0, f1) -> NOT (k0, (mapX f k0 f1)) -| IMPL (k0, f1, o, f2) -> IMPL (k0, (mapX f k0 f1), o, (mapX f k0 f2)) -| IFF (k0, f1, f2) -> IFF (k0, (mapX f k0 f1), (mapX f k0 f2)) -| EQ (f1, f2) -> EQ ((mapX f IsBool f1), (mapX f IsBool f2)) -| x -> x - -(** val foldA : - ('a5 -> 'a3 -> 'a5) -> kind -> ('a1, 'a2, 'a3, 'a4) gFormula -> 'a5 -> 'a5 **) - -let rec foldA f _ f0 acc = - match f0 with - | A (_, _, an) -> f acc an - | AND (k0, f1, f2) -> foldA f k0 f1 (foldA f k0 f2 acc) - | OR (k0, f1, f2) -> foldA f k0 f1 (foldA f k0 f2 acc) - | NOT (k0, f1) -> foldA f k0 f1 acc - | IMPL (k0, f1, _, f2) -> foldA f k0 f1 (foldA f k0 f2 acc) - | IFF (k0, f1, f2) -> foldA f k0 f1 (foldA f k0 f2 acc) - | EQ (f1, f2) -> foldA f IsBool f1 (foldA f IsBool f2 acc) - | _ -> acc - -(** val cons_id : 'a1 option -> 'a1 list -> 'a1 list **) - -let cons_id id l = - match id with - | Some id0 -> id0::l - | None -> l - -(** val ids_of_formula : kind -> ('a1, 'a2, 'a3, 'a4) gFormula -> 'a4 list **) - -let rec ids_of_formula _ = function -| IMPL (k0, _, id, f') -> cons_id id (ids_of_formula k0 f') -| _ -> [] - -(** val collect_annot : kind -> ('a1, 'a2, 'a3, 'a4) gFormula -> 'a3 list **) - -let rec collect_annot _ = function -| A (_, _, a) -> a::[] -| AND (k0, f1, f2) -> app (collect_annot k0 f1) (collect_annot k0 f2) -| OR (k0, f1, f2) -> app (collect_annot k0 f1) (collect_annot k0 f2) -| NOT (k0, f0) -> collect_annot k0 f0 -| IMPL (k0, f1, _, f2) -> app (collect_annot k0 f1) (collect_annot k0 f2) -| IFF (k0, f1, f2) -> app (collect_annot k0 f1) (collect_annot k0 f2) -| EQ (f1, f2) -> app (collect_annot IsBool f1) (collect_annot IsBool f2) -| _ -> [] - -type rtyp = __ - -type eKind = __ - -type 'a bFormula = ('a, eKind, unit0, unit0) gFormula - -(** val map_bformula : - kind -> ('a1 -> 'a2) -> ('a1, 'a3, 'a4, 'a5) gFormula -> ('a2, 'a3, 'a4, - 'a5) gFormula **) - -let rec map_bformula _ fct = function -| TT k -> TT k -| FF k -> FF k -| X (k, p) -> X (k, p) -| A (k, a, t0) -> A (k, (fct a), t0) -| AND (k0, f1, f2) -> - AND (k0, (map_bformula k0 fct f1), (map_bformula k0 fct f2)) -| OR (k0, f1, f2) -> - OR (k0, (map_bformula k0 fct f1), (map_bformula k0 fct f2)) -| NOT (k0, f0) -> NOT (k0, (map_bformula k0 fct f0)) -| IMPL (k0, f1, a, f2) -> - IMPL (k0, (map_bformula k0 fct f1), a, (map_bformula k0 fct f2)) -| IFF (k0, f1, f2) -> - IFF (k0, (map_bformula k0 fct f1), (map_bformula k0 fct f2)) -| EQ (f1, f2) -> - EQ ((map_bformula IsBool fct f1), (map_bformula IsBool fct f2)) - -type ('x, 'annot) clause = ('x * 'annot) list - -type ('x, 'annot) cnf = ('x, 'annot) clause list - -(** val cnf_tt : ('a1, 'a2) cnf **) - -let cnf_tt = - [] - -(** val cnf_ff : ('a1, 'a2) cnf **) - -let cnf_ff = - []::[] - -(** val add_term : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1 * 'a2) -> ('a1, 'a2) - clause -> ('a1, 'a2) clause option **) - -let rec add_term unsat deduce t0 = function -| [] -> - (match deduce (fst t0) (fst t0) with - | Some u -> if unsat u then None else Some (t0::[]) - | None -> Some (t0::[])) -| t'::cl0 -> - (match deduce (fst t0) (fst t') with - | Some u -> - if unsat u - then None - else (match add_term unsat deduce t0 cl0 with - | Some cl' -> Some (t'::cl') - | None -> None) - | None -> - (match add_term unsat deduce t0 cl0 with - | Some cl' -> Some (t'::cl') - | None -> None)) - -(** val or_clause : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) clause -> ('a1, - 'a2) clause -> ('a1, 'a2) clause option **) - -let rec or_clause unsat deduce cl1 cl2 = - match cl1 with - | [] -> Some cl2 - | t0::cl -> - (match add_term unsat deduce t0 cl2 with - | Some cl' -> or_clause unsat deduce cl cl' - | None -> None) - -(** val xor_clause_cnf : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) clause -> ('a1, - 'a2) cnf -> ('a1, 'a2) cnf **) - -let xor_clause_cnf unsat deduce t0 f = - fold_left (fun acc e -> - match or_clause unsat deduce t0 e with - | Some cl -> cl::acc - | None -> acc) f [] - -(** val or_clause_cnf : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) clause -> ('a1, - 'a2) cnf -> ('a1, 'a2) cnf **) - -let or_clause_cnf unsat deduce t0 f = - match t0 with - | [] -> f - | _::_ -> xor_clause_cnf unsat deduce t0 f - -(** val or_cnf : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) cnf -> ('a1, - 'a2) cnf -> ('a1, 'a2) cnf **) - -let rec or_cnf unsat deduce f f' = - match f with - | [] -> cnf_tt - | e::rst -> - rev_append (or_cnf unsat deduce rst f') (or_clause_cnf unsat deduce e f') - -(** val and_cnf : ('a1, 'a2) cnf -> ('a1, 'a2) cnf -> ('a1, 'a2) cnf **) - -let and_cnf = - rev_append - -type ('term, 'annot, 'tX, 'aF) tFormula = ('term, 'tX, 'annot, 'aF) gFormula - -(** val is_cnf_tt : ('a1, 'a2) cnf -> bool **) - -let is_cnf_tt = function -| [] -> true -| _::_ -> false - -(** val is_cnf_ff : ('a1, 'a2) cnf -> bool **) - -let is_cnf_ff = function -| [] -> false -| c0::l -> - (match c0 with - | [] -> (match l with - | [] -> true - | _::_ -> false) - | _::_ -> false) - -(** val and_cnf_opt : ('a1, 'a2) cnf -> ('a1, 'a2) cnf -> ('a1, 'a2) cnf **) - -let and_cnf_opt f1 f2 = - if if is_cnf_ff f1 then true else is_cnf_ff f2 - then cnf_ff - else if is_cnf_tt f2 then f1 else and_cnf f1 f2 - -(** val or_cnf_opt : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) cnf -> ('a1, - 'a2) cnf -> ('a1, 'a2) cnf **) - -let or_cnf_opt unsat deduce f1 f2 = - if if is_cnf_tt f1 then true else is_cnf_tt f2 - then cnf_tt - else if is_cnf_ff f2 then f1 else or_cnf unsat deduce f1 f2 - -(** val mk_and : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf) -> kind -> bool -> ('a1, 'a3, - 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf **) - -let mk_and unsat deduce rEC k pol0 f1 f2 = - if pol0 - then and_cnf_opt (rEC pol0 k f1) (rEC pol0 k f2) - else or_cnf_opt unsat deduce (rEC pol0 k f1) (rEC pol0 k f2) - -(** val mk_or : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf) -> kind -> bool -> ('a1, 'a3, - 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf **) - -let mk_or unsat deduce rEC k pol0 f1 f2 = - if pol0 - then or_cnf_opt unsat deduce (rEC pol0 k f1) (rEC pol0 k f2) - else and_cnf_opt (rEC pol0 k f1) (rEC pol0 k f2) - -(** val mk_impl : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf) -> kind -> bool -> ('a1, 'a3, - 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf **) - -let mk_impl unsat deduce rEC k pol0 f1 f2 = - if pol0 - then or_cnf_opt unsat deduce (rEC (negb pol0) k f1) (rEC pol0 k f2) - else and_cnf_opt (rEC (negb pol0) k f1) (rEC pol0 k f2) - -(** val mk_iff : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf) -> kind -> bool -> ('a1, 'a3, - 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf **) - -let mk_iff unsat deduce rEC k pol0 f1 f2 = - or_cnf_opt unsat deduce - (and_cnf_opt (rEC (negb pol0) k f1) (rEC false k f2)) - (and_cnf_opt (rEC pol0 k f1) (rEC true k f2)) - -(** val is_bool : kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> bool option **) - -let is_bool _ = function -| TT _ -> Some true -| FF _ -> Some false -| _ -> None - -(** val xcnf : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a3 -> ('a2, 'a3) - cnf) -> ('a1 -> 'a3 -> ('a2, 'a3) cnf) -> bool -> kind -> ('a1, 'a3, 'a4, - 'a5) tFormula -> ('a2, 'a3) cnf **) - -let rec xcnf unsat deduce normalise1 negate0 pol0 _ = function -| TT _ -> if pol0 then cnf_tt else cnf_ff -| FF _ -> if pol0 then cnf_ff else cnf_tt -| X (_, _) -> cnf_ff -| A (_, x, t0) -> if pol0 then normalise1 x t0 else negate0 x t0 -| AND (k0, e1, e2) -> - mk_and unsat deduce (fun x x0 x1 -> - xcnf unsat deduce normalise1 negate0 x x0 x1) k0 pol0 e1 e2 -| OR (k0, e1, e2) -> - mk_or unsat deduce (fun x x0 x1 -> - xcnf unsat deduce normalise1 negate0 x x0 x1) k0 pol0 e1 e2 -| NOT (k0, e) -> xcnf unsat deduce normalise1 negate0 (negb pol0) k0 e -| IMPL (k0, e1, _, e2) -> - mk_impl unsat deduce (fun x x0 x1 -> - xcnf unsat deduce normalise1 negate0 x x0 x1) k0 pol0 e1 e2 -| IFF (k0, e1, e2) -> - (match is_bool k0 e2 with - | Some isb -> - xcnf unsat deduce normalise1 negate0 (if isb then pol0 else negb pol0) - k0 e1 - | None -> - mk_iff unsat deduce (fun x x0 x1 -> - xcnf unsat deduce normalise1 negate0 x x0 x1) k0 pol0 e1 e2) -| EQ (e1, e2) -> - (match is_bool IsBool e2 with - | Some isb -> - xcnf unsat deduce normalise1 negate0 (if isb then pol0 else negb pol0) - IsBool e1 - | None -> - mk_iff unsat deduce (fun x x0 x1 -> - xcnf unsat deduce normalise1 negate0 x x0 x1) IsBool pol0 e1 e2) - -(** val radd_term : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1 * 'a2) -> ('a1, 'a2) - clause -> (('a1, 'a2) clause, 'a2 trace) sum **) - -let rec radd_term unsat deduce t0 = function -| [] -> - (match deduce (fst t0) (fst t0) with - | Some u -> if unsat u then Inr (Push ((snd t0), Null)) else Inl (t0::[]) - | None -> Inl (t0::[])) -| t'::cl0 -> - (match deduce (fst t0) (fst t') with - | Some u -> - if unsat u - then Inr (Push ((snd t0), (Push ((snd t'), Null)))) - else (match radd_term unsat deduce t0 cl0 with - | Inl cl' -> Inl (t'::cl') - | Inr l -> Inr l) - | None -> - (match radd_term unsat deduce t0 cl0 with - | Inl cl' -> Inl (t'::cl') - | Inr l -> Inr l)) - -(** val ror_clause : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1 * 'a2) list -> ('a1, - 'a2) clause -> (('a1, 'a2) clause, 'a2 trace) sum **) - -let rec ror_clause unsat deduce cl1 cl2 = - match cl1 with - | [] -> Inl cl2 - | t0::cl -> - (match radd_term unsat deduce t0 cl2 with - | Inl cl' -> ror_clause unsat deduce cl cl' - | Inr l -> Inr l) - -(** val xror_clause_cnf : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1 * 'a2) list -> ('a1, - 'a2) clause list -> ('a1, 'a2) clause list * 'a2 trace **) - -let xror_clause_cnf unsat deduce t0 f = - fold_left (fun pat e -> - let acc,tg = pat in - (match ror_clause unsat deduce t0 e with - | Inl cl -> (cl::acc),tg - | Inr l -> acc,(Merge (tg, l)))) - f ([],Null) - -(** val ror_clause_cnf : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1 * 'a2) list -> ('a1, - 'a2) clause list -> ('a1, 'a2) clause list * 'a2 trace **) - -let ror_clause_cnf unsat deduce t0 f = - match t0 with - | [] -> f,Null - | _::_ -> xror_clause_cnf unsat deduce t0 f - -(** val ror_cnf : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) clause list -> - ('a1, 'a2) clause list -> ('a1, 'a2) cnf * 'a2 trace **) - -let rec ror_cnf unsat deduce f f' = - match f with - | [] -> cnf_tt,Null - | e::rst -> - let rst_f',t0 = ror_cnf unsat deduce rst f' in - let e_f',t' = ror_clause_cnf unsat deduce e f' in - (rev_append rst_f' e_f'),(Merge (t0, t')) - -(** val ror_cnf_opt : - ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> ('a1, 'a2) cnf -> ('a1, - 'a2) cnf -> ('a1, 'a2) cnf * 'a2 trace **) - -let ror_cnf_opt unsat deduce f1 f2 = - if is_cnf_tt f1 - then cnf_tt,Null - else if is_cnf_tt f2 - then cnf_tt,Null - else if is_cnf_ff f2 then f1,Null else ror_cnf unsat deduce f1 f2 - -(** val ratom : ('a1, 'a2) cnf -> 'a2 -> ('a1, 'a2) cnf * 'a2 trace **) - -let ratom c a = - if if is_cnf_ff c then true else is_cnf_tt c - then c,(Push (a, Null)) - else c,Null - -(** val rxcnf_and : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf * 'a3 trace) -> bool -> kind -> - ('a1, 'a3, 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, - 'a3) cnf * 'a3 trace **) - -let rxcnf_and unsat deduce rXCNF polarity k e1 e2 = - let e3,t1 = rXCNF polarity k e1 in - let e4,t2 = rXCNF polarity k e2 in - if polarity - then (and_cnf_opt e3 e4),(Merge (t1, t2)) - else let f',t' = ror_cnf_opt unsat deduce e3 e4 in - f',(Merge (t1, (Merge (t2, t')))) - -(** val rxcnf_or : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf * 'a3 trace) -> bool -> kind -> - ('a1, 'a3, 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, - 'a3) cnf * 'a3 trace **) - -let rxcnf_or unsat deduce rXCNF polarity k e1 e2 = - let e3,t1 = rXCNF polarity k e1 in - let e4,t2 = rXCNF polarity k e2 in - if polarity - then let f',t' = ror_cnf_opt unsat deduce e3 e4 in - f',(Merge (t1, (Merge (t2, t')))) - else (and_cnf_opt e3 e4),(Merge (t1, t2)) - -(** val rxcnf_impl : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf * 'a3 trace) -> bool -> kind -> - ('a1, 'a3, 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, - 'a3) cnf * 'a3 trace **) - -let rxcnf_impl unsat deduce rXCNF polarity k e1 e2 = - let e3,t1 = rXCNF (negb polarity) k e1 in - if polarity - then if is_cnf_tt e3 - then e3,t1 - else if is_cnf_ff e3 - then rXCNF polarity k e2 - else let e4,t2 = rXCNF polarity k e2 in - let f',t' = ror_cnf_opt unsat deduce e3 e4 in - f',(Merge (t1, (Merge (t2, t')))) - else let e4,t2 = rXCNF polarity k e2 in (and_cnf_opt e3 e4),(Merge (t1, t2)) - -(** val rxcnf_iff : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> (bool -> kind -> ('a1, - 'a3, 'a4, 'a5) tFormula -> ('a2, 'a3) cnf * 'a3 trace) -> bool -> kind -> - ('a1, 'a3, 'a4, 'a5) tFormula -> ('a1, 'a3, 'a4, 'a5) tFormula -> ('a2, - 'a3) cnf * 'a3 trace **) - -let rxcnf_iff unsat deduce rXCNF polarity k e1 e2 = - let c1,t1 = rXCNF (negb polarity) k e1 in - let c2,t2 = rXCNF false k e2 in - let c3,t3 = rXCNF polarity k e1 in - let c4,t4 = rXCNF true k e2 in - let f',t' = ror_cnf_opt unsat deduce (and_cnf_opt c1 c2) (and_cnf_opt c3 c4) - in - f',(Merge (t1, (Merge (t2, (Merge (t3, (Merge (t4, t')))))))) - -(** val rxcnf : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a3 -> ('a2, 'a3) - cnf) -> ('a1 -> 'a3 -> ('a2, 'a3) cnf) -> bool -> kind -> ('a1, 'a3, 'a4, - 'a5) tFormula -> ('a2, 'a3) cnf * 'a3 trace **) - -let rec rxcnf unsat deduce normalise1 negate0 polarity _ = function -| TT _ -> if polarity then cnf_tt,Null else cnf_ff,Null -| FF _ -> if polarity then cnf_ff,Null else cnf_tt,Null -| X (_, _) -> cnf_ff,Null -| A (_, x, t0) -> - ratom (if polarity then normalise1 x t0 else negate0 x t0) t0 -| AND (k0, e1, e2) -> - rxcnf_and unsat deduce (fun x x0 x1 -> - rxcnf unsat deduce normalise1 negate0 x x0 x1) polarity k0 e1 e2 -| OR (k0, e1, e2) -> - rxcnf_or unsat deduce (fun x x0 x1 -> - rxcnf unsat deduce normalise1 negate0 x x0 x1) polarity k0 e1 e2 -| NOT (k0, e) -> rxcnf unsat deduce normalise1 negate0 (negb polarity) k0 e -| IMPL (k0, e1, _, e2) -> - rxcnf_impl unsat deduce (fun x x0 x1 -> - rxcnf unsat deduce normalise1 negate0 x x0 x1) polarity k0 e1 e2 -| IFF (k0, e1, e2) -> - rxcnf_iff unsat deduce (fun x x0 x1 -> - rxcnf unsat deduce normalise1 negate0 x x0 x1) polarity k0 e1 e2 -| EQ (e1, e2) -> - rxcnf_iff unsat deduce (fun x x0 x1 -> - rxcnf unsat deduce normalise1 negate0 x x0 x1) polarity IsBool e1 e2 - -type ('term, 'annot, 'tX) to_constrT = { mkTT : (kind -> 'tX); - mkFF : (kind -> 'tX); - mkA : (kind -> 'term -> 'annot -> - 'tX); - mkAND : (kind -> 'tX -> 'tX -> 'tX); - mkOR : (kind -> 'tX -> 'tX -> 'tX); - mkIMPL : (kind -> 'tX -> 'tX -> 'tX); - mkIFF : (kind -> 'tX -> 'tX -> 'tX); - mkNOT : (kind -> 'tX -> 'tX); - mkEQ : ('tX -> 'tX -> 'tX) } - -(** val aformula : - ('a1, 'a2, 'a3) to_constrT -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> 'a3 **) - -let rec aformula to_constr _ = function -| TT b -> to_constr.mkTT b -| FF b -> to_constr.mkFF b -| X (_, p) -> p -| A (b, x, t0) -> to_constr.mkA b x t0 -| AND (k0, f1, f2) -> - to_constr.mkAND k0 (aformula to_constr k0 f1) (aformula to_constr k0 f2) -| OR (k0, f1, f2) -> - to_constr.mkOR k0 (aformula to_constr k0 f1) (aformula to_constr k0 f2) -| NOT (k0, f0) -> to_constr.mkNOT k0 (aformula to_constr k0 f0) -| IMPL (k0, f1, _, f2) -> - to_constr.mkIMPL k0 (aformula to_constr k0 f1) (aformula to_constr k0 f2) -| IFF (k0, f1, f2) -> - to_constr.mkIFF k0 (aformula to_constr k0 f1) (aformula to_constr k0 f2) -| EQ (f1, f2) -> - to_constr.mkEQ (aformula to_constr IsBool f1) (aformula to_constr IsBool f2) - -(** val is_X : kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> 'a3 option **) - -let is_X _ = function -| X (_, p) -> Some p -| _ -> None - -(** val abs_and : - ('a1, 'a2, 'a3) to_constrT -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> - ('a1, 'a2, 'a3, 'a4) tFormula -> (kind -> ('a1, 'a2, 'a3, 'a4) tFormula - -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> - ('a1, 'a3, 'a2, 'a4) gFormula **) - -let abs_and to_constr k f1 f2 c = - match is_X k f1 with - | Some _ -> X (k, (aformula to_constr k (c k f1 f2))) - | None -> - (match is_X k f2 with - | Some _ -> X (k, (aformula to_constr k (c k f1 f2))) - | None -> c k f1 f2) - -(** val abs_or : - ('a1, 'a2, 'a3) to_constrT -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> - ('a1, 'a2, 'a3, 'a4) tFormula -> (kind -> ('a1, 'a2, 'a3, 'a4) tFormula - -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> - ('a1, 'a3, 'a2, 'a4) gFormula **) - -let abs_or to_constr k f1 f2 c = - match is_X k f1 with - | Some _ -> - (match is_X k f2 with - | Some _ -> X (k, (aformula to_constr k (c k f1 f2))) - | None -> c k f1 f2) - | None -> c k f1 f2 - -(** val abs_not : - ('a1, 'a2, 'a3) to_constrT -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> - (kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) - -> ('a1, 'a3, 'a2, 'a4) gFormula **) - -let abs_not to_constr k f1 c = - match is_X k f1 with - | Some _ -> X (k, (aformula to_constr k (c k f1))) - | None -> c k f1 - -(** val mk_arrow : - 'a4 option -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, - 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula **) - -let mk_arrow o k f1 f2 = - match o with - | Some _ -> - (match is_X k f1 with - | Some _ -> f2 - | None -> IMPL (k, f1, o, f2)) - | None -> IMPL (k, f1, None, f2) - -(** val abst_simpl : - ('a1, 'a2, 'a3) to_constrT -> ('a2 -> bool) -> kind -> ('a1, 'a2, 'a3, - 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula **) - -let rec abst_simpl to_constr needA _ = function -| A (k, x, t0) -> - if needA t0 then A (k, x, t0) else X (k, (to_constr.mkA k x t0)) -| AND (k0, f1, f2) -> - AND (k0, (abst_simpl to_constr needA k0 f1), - (abst_simpl to_constr needA k0 f2)) -| OR (k0, f1, f2) -> - OR (k0, (abst_simpl to_constr needA k0 f1), - (abst_simpl to_constr needA k0 f2)) -| NOT (k0, f0) -> NOT (k0, (abst_simpl to_constr needA k0 f0)) -| IMPL (k0, f1, o, f2) -> - IMPL (k0, (abst_simpl to_constr needA k0 f1), o, - (abst_simpl to_constr needA k0 f2)) -| IFF (k0, f1, f2) -> - IFF (k0, (abst_simpl to_constr needA k0 f1), - (abst_simpl to_constr needA k0 f2)) -| EQ (f1, f2) -> - EQ ((abst_simpl to_constr needA IsBool f1), - (abst_simpl to_constr needA IsBool f2)) -| x -> x - -(** val abst_and : - ('a1, 'a2, 'a3) to_constrT -> (bool -> kind -> ('a1, 'a2, 'a3, 'a4) - tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> bool -> kind -> ('a1, 'a2, - 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, - 'a4) tFormula **) - -let abst_and to_constr rEC pol0 k f1 f2 = - if pol0 - then abs_and to_constr k (rEC pol0 k f1) (rEC pol0 k f2) (fun x x0 x1 -> - AND (x, x0, x1)) - else abs_or to_constr k (rEC pol0 k f1) (rEC pol0 k f2) (fun x x0 x1 -> AND - (x, x0, x1)) - -(** val abst_or : - ('a1, 'a2, 'a3) to_constrT -> (bool -> kind -> ('a1, 'a2, 'a3, 'a4) - tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> bool -> kind -> ('a1, 'a2, - 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, - 'a4) tFormula **) - -let abst_or to_constr rEC pol0 k f1 f2 = - if pol0 - then abs_or to_constr k (rEC pol0 k f1) (rEC pol0 k f2) (fun x x0 x1 -> OR - (x, x0, x1)) - else abs_and to_constr k (rEC pol0 k f1) (rEC pol0 k f2) (fun x x0 x1 -> OR - (x, x0, x1)) - -(** val abst_impl : - ('a1, 'a2, 'a3) to_constrT -> (bool -> kind -> ('a1, 'a2, 'a3, 'a4) - tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> bool -> 'a4 option -> kind - -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> - ('a1, 'a2, 'a3, 'a4) tFormula **) - -let abst_impl to_constr rEC pol0 o k f1 f2 = - if pol0 - then abs_or to_constr k (rEC (negb pol0) k f1) (rEC pol0 k f2) (mk_arrow o) - else abs_and to_constr k (rEC (negb pol0) k f1) (rEC pol0 k f2) (mk_arrow o) - -(** val or_is_X : - kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> - bool **) - -let or_is_X k f1 f2 = - match is_X k f1 with - | Some _ -> true - | None -> (match is_X k f2 with - | Some _ -> true - | None -> false) - -(** val abs_iff : - ('a1, 'a2, 'a3) to_constrT -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> - ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, - 'a2, 'a3, 'a4) tFormula -> kind -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, - 'a2, 'a3, 'a4) tFormula **) - -let abs_iff to_constr k nf1 ff2 f1 tf2 r def = - if (&&) (or_is_X k nf1 ff2) (or_is_X k f1 tf2) - then X (r, (aformula to_constr r def)) - else def - -(** val abst_iff : - ('a1, 'a2, 'a3) to_constrT -> ('a2 -> bool) -> (bool -> kind -> ('a1, - 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> bool -> kind - -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> - ('a1, 'a2, 'a3, 'a4) tFormula **) - -let abst_iff to_constr needA rEC pol0 k f1 f2 = - abs_iff to_constr k (rEC (negb pol0) k f1) (rEC false k f2) (rEC pol0 k f1) - (rEC true k f2) k (IFF (k, (abst_simpl to_constr needA k f1), - (abst_simpl to_constr needA k f2))) - -(** val abst_eq : - ('a1, 'a2, 'a3) to_constrT -> ('a2 -> bool) -> (bool -> kind -> ('a1, - 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula) -> bool -> - ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula -> ('a1, - 'a2, 'a3, 'a4) tFormula **) - -let abst_eq to_constr needA rEC pol0 f1 f2 = - abs_iff to_constr IsBool (rEC (negb pol0) IsBool f1) (rEC false IsBool f2) - (rEC pol0 IsBool f1) (rEC true IsBool f2) IsProp (EQ - ((abst_simpl to_constr needA IsBool f1), - (abst_simpl to_constr needA IsBool f2))) - -(** val abst_form : - ('a1, 'a2, 'a3) to_constrT -> ('a2 -> bool) -> bool -> kind -> ('a1, 'a2, - 'a3, 'a4) tFormula -> ('a1, 'a2, 'a3, 'a4) tFormula **) - -let rec abst_form to_constr needA pol0 _ = function -| TT k -> if pol0 then TT k else X (k, (to_constr.mkTT k)) -| FF k -> if pol0 then X (k, (to_constr.mkFF k)) else FF k -| X (k, p) -> X (k, p) -| A (k, x, t0) -> - if needA t0 then A (k, x, t0) else X (k, (to_constr.mkA k x t0)) -| AND (k0, f1, f2) -> - abst_and to_constr (abst_form to_constr needA) pol0 k0 f1 f2 -| OR (k0, f1, f2) -> - abst_or to_constr (abst_form to_constr needA) pol0 k0 f1 f2 -| NOT (k0, f0) -> - abs_not to_constr k0 (abst_form to_constr needA (negb pol0) k0 f0) - (fun x x0 -> NOT (x, x0)) -| IMPL (k0, f1, o, f2) -> - abst_impl to_constr (abst_form to_constr needA) pol0 o k0 f1 f2 -| IFF (k0, f1, f2) -> - abst_iff to_constr needA (abst_form to_constr needA) pol0 k0 f1 f2 -| EQ (f1, f2) -> - abst_eq to_constr needA (abst_form to_constr needA) pol0 f1 f2 - -(** val cnf_checker : - (('a1 * 'a2) list -> 'a3 -> bool) -> ('a1, 'a2) cnf -> 'a3 list -> bool **) - -let rec cnf_checker checker f l = - match f with - | [] -> true - | e::f0 -> - (match l with - | [] -> false - | c::l0 -> if checker e c then cnf_checker checker f0 l0 else false) - -(** val tauto_checker : - ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a3 -> ('a2, 'a3) - cnf) -> ('a1 -> 'a3 -> ('a2, 'a3) cnf) -> (('a2 * 'a3) list -> 'a4 -> - bool) -> ('a1, rtyp, 'a3, unit0) gFormula -> 'a4 list -> bool **) - -let tauto_checker unsat deduce normalise1 negate0 checker f w = - cnf_checker checker (xcnf unsat deduce normalise1 negate0 true IsProp f) w - -type 'c pExpr = -| PEc of 'c -| PEX of positive -| PEadd of 'c pExpr * 'c pExpr -| PEsub of 'c pExpr * 'c pExpr -| PEmul of 'c pExpr * 'c pExpr -| PEopp of 'c pExpr -| PEpow of 'c pExpr * n - -type 'c pol = -| Pc of 'c -| Pinj of positive * 'c pol -| PX of 'c pol * positive * 'c pol - -(** val p0 : 'a1 -> 'a1 pol **) - -let p0 cO = - Pc cO - -(** val p1 : 'a1 -> 'a1 pol **) - -let p1 cI = - Pc cI - -(** val peq : ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> bool **) - -let rec peq ceqb p p' = - match p with - | Pc c -> (match p' with - | Pc c' -> ceqb c c' - | _ -> false) - | Pinj (j, q0) -> - (match p' with - | Pinj (j', q') -> - (match Coq_Pos.compare j j' with - | Eq -> peq ceqb q0 q' - | _ -> false) - | _ -> false) - | PX (p2, i, q0) -> - (match p' with - | PX (p'0, i', q') -> - (match Coq_Pos.compare i i' with - | Eq -> if peq ceqb p2 p'0 then peq ceqb q0 q' else false - | _ -> false) - | _ -> false) - -(** val mkPinj : positive -> 'a1 pol -> 'a1 pol **) - -let mkPinj j p = match p with -| Pc _ -> p -| Pinj (j', q0) -> Pinj ((Coq_Pos.add j j'), q0) -| PX (_, _, _) -> Pinj (j, p) - -(** val mkPinj_pred : positive -> 'a1 pol -> 'a1 pol **) - -let mkPinj_pred j p = - match j with - | XI j0 -> Pinj ((XO j0), p) - | XO j0 -> Pinj ((Coq_Pos.pred_double j0), p) - | XH -> p - -(** val mkPX : - 'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **) - -let mkPX cO ceqb p i q0 = - match p with - | Pc c -> if ceqb c cO then mkPinj XH q0 else PX (p, i, q0) - | Pinj (_, _) -> PX (p, i, q0) - | PX (p', i', q') -> - if peq ceqb q' (p0 cO) - then PX (p', (Coq_Pos.add i' i), q0) - else PX (p, i, q0) - -(** val mkXi : 'a1 -> 'a1 -> positive -> 'a1 pol **) - -let mkXi cO cI i = - PX ((p1 cI), i, (p0 cO)) - -(** val mkX : 'a1 -> 'a1 -> 'a1 pol **) - -let mkX cO cI = - mkXi cO cI XH - -(** val popp : ('a1 -> 'a1) -> 'a1 pol -> 'a1 pol **) - -let rec popp copp = function -| Pc c -> Pc (copp c) -| Pinj (j, q0) -> Pinj (j, (popp copp q0)) -| PX (p2, i, q0) -> PX ((popp copp p2), i, (popp copp q0)) - -(** val paddC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol **) - -let rec paddC cadd p c = - match p with - | Pc c1 -> Pc (cadd c1 c) - | Pinj (j, q0) -> Pinj (j, (paddC cadd q0 c)) - | PX (p2, i, q0) -> PX (p2, i, (paddC cadd q0 c)) - -(** val psubC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol **) - -let rec psubC csub p c = - match p with - | Pc c1 -> Pc (csub c1 c) - | Pinj (j, q0) -> Pinj (j, (psubC csub q0 c)) - | PX (p2, i, q0) -> PX (p2, i, (psubC csub q0 c)) - -(** val paddI : - ('a1 -> 'a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol -> - positive -> 'a1 pol -> 'a1 pol **) - -let rec paddI cadd pop q0 j = function -| Pc c -> mkPinj j (paddC cadd q0 c) -| Pinj (j', q') -> - (match Z.pos_sub j' j with - | Z0 -> mkPinj j (pop q' q0) - | Zpos k -> mkPinj j (pop (Pinj (k, q')) q0) - | Zneg k -> mkPinj j' (paddI cadd pop q0 k q')) -| PX (p2, i, q') -> - (match j with - | XI j0 -> PX (p2, i, (paddI cadd pop q0 (XO j0) q')) - | XO j0 -> PX (p2, i, (paddI cadd pop q0 (Coq_Pos.pred_double j0) q')) - | XH -> PX (p2, i, (pop q' q0))) - -(** val psubI : - ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> - 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **) - -let rec psubI cadd copp pop q0 j = function -| Pc c -> mkPinj j (paddC cadd (popp copp q0) c) -| Pinj (j', q') -> - (match Z.pos_sub j' j with - | Z0 -> mkPinj j (pop q' q0) - | Zpos k -> mkPinj j (pop (Pinj (k, q')) q0) - | Zneg k -> mkPinj j' (psubI cadd copp pop q0 k q')) -| PX (p2, i, q') -> - (match j with - | XI j0 -> PX (p2, i, (psubI cadd copp pop q0 (XO j0) q')) - | XO j0 -> PX (p2, i, (psubI cadd copp pop q0 (Coq_Pos.pred_double j0) q')) - | XH -> PX (p2, i, (pop q' q0))) - -(** val paddX : - 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol - -> positive -> 'a1 pol -> 'a1 pol **) - -let rec paddX cO ceqb pop p' i' p = match p with -| Pc _ -> PX (p', i', p) -| Pinj (j, q') -> - (match j with - | XI j0 -> PX (p', i', (Pinj ((XO j0), q'))) - | XO j0 -> PX (p', i', (Pinj ((Coq_Pos.pred_double j0), q'))) - | XH -> PX (p', i', q')) -| PX (p2, i, q') -> - (match Z.pos_sub i i' with - | Z0 -> mkPX cO ceqb (pop p2 p') i q' - | Zpos k -> mkPX cO ceqb (pop (PX (p2, k, (p0 cO))) p') i' q' - | Zneg k -> mkPX cO ceqb (paddX cO ceqb pop p' k p2) i q') - -(** val psubX : - 'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 - pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **) - -let rec psubX cO copp ceqb pop p' i' p = match p with -| Pc _ -> PX ((popp copp p'), i', p) -| Pinj (j, q') -> - (match j with - | XI j0 -> PX ((popp copp p'), i', (Pinj ((XO j0), q'))) - | XO j0 -> PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q'))) - | XH -> PX ((popp copp p'), i', q')) -| PX (p2, i, q') -> - (match Z.pos_sub i i' with - | Z0 -> mkPX cO ceqb (pop p2 p') i q' - | Zpos k -> mkPX cO ceqb (pop (PX (p2, k, (p0 cO))) p') i' q' - | Zneg k -> mkPX cO ceqb (psubX cO copp ceqb pop p' k p2) i q') - -(** val padd : - 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol - -> 'a1 pol **) - -let rec padd cO cadd ceqb p = function -| Pc c' -> paddC cadd p c' -| Pinj (j', q') -> paddI cadd (padd cO cadd ceqb) q' j' p -| PX (p'0, i', q') -> - (match p with - | Pc c -> PX (p'0, i', (paddC cadd q' c)) - | Pinj (j, q0) -> - (match j with - | XI j0 -> PX (p'0, i', (padd cO cadd ceqb (Pinj ((XO j0), q0)) q')) - | XO j0 -> - PX (p'0, i', - (padd cO cadd ceqb (Pinj ((Coq_Pos.pred_double j0), q0)) q')) - | XH -> PX (p'0, i', (padd cO cadd ceqb q0 q'))) - | PX (p2, i, q0) -> - (match Z.pos_sub i i' with - | Z0 -> - mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i (padd cO cadd ceqb q0 q') - | Zpos k -> - mkPX cO ceqb (padd cO cadd ceqb (PX (p2, k, (p0 cO))) p'0) i' - (padd cO cadd ceqb q0 q') - | Zneg k -> - mkPX cO ceqb (paddX cO ceqb (padd cO cadd ceqb) p'0 k p2) i - (padd cO cadd ceqb q0 q'))) - -(** val psub : - 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 - -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **) - -let rec psub cO cadd csub copp ceqb p = function -| Pc c' -> psubC csub p c' -| Pinj (j', q') -> psubI cadd copp (psub cO cadd csub copp ceqb) q' j' p -| PX (p'0, i', q') -> - (match p with - | Pc c -> PX ((popp copp p'0), i', (paddC cadd (popp copp q') c)) - | Pinj (j, q0) -> - (match j with - | XI j0 -> - PX ((popp copp p'0), i', - (psub cO cadd csub copp ceqb (Pinj ((XO j0), q0)) q')) - | XO j0 -> - PX ((popp copp p'0), i', - (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0), q0)) - q')) - | XH -> PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q'))) - | PX (p2, i, q0) -> - (match Z.pos_sub i i' with - | Z0 -> - mkPX cO ceqb (psub cO cadd csub copp ceqb p2 p'0) i - (psub cO cadd csub copp ceqb q0 q') - | Zpos k -> - mkPX cO ceqb (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0) - i' (psub cO cadd csub copp ceqb q0 q') - | Zneg k -> - mkPX cO ceqb - (psubX cO copp ceqb (psub cO cadd csub copp ceqb) p'0 k p2) i - (psub cO cadd csub copp ceqb q0 q'))) - -(** val pmulC_aux : - 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 -> - 'a1 pol **) - -let rec pmulC_aux cO cmul ceqb p c = - match p with - | Pc c' -> Pc (cmul c' c) - | Pinj (j, q0) -> mkPinj j (pmulC_aux cO cmul ceqb q0 c) - | PX (p2, i, q0) -> - mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i (pmulC_aux cO cmul ceqb q0 c) - -(** val pmulC : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> - 'a1 -> 'a1 pol **) - -let pmulC cO cI cmul ceqb p c = - if ceqb c cO - then p0 cO - else if ceqb c cI then p else pmulC_aux cO cmul ceqb p c - -(** val pmulI : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> - 'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **) - -let rec pmulI cO cI cmul ceqb pmul0 q0 j = function -| Pc c -> mkPinj j (pmulC cO cI cmul ceqb q0 c) -| Pinj (j', q') -> - (match Z.pos_sub j' j with - | Z0 -> mkPinj j (pmul0 q' q0) - | Zpos k -> mkPinj j (pmul0 (Pinj (k, q')) q0) - | Zneg k -> mkPinj j' (pmulI cO cI cmul ceqb pmul0 q0 k q')) -| PX (p', i', q') -> - (match j with - | XI j' -> - mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 j p') i' - (pmulI cO cI cmul ceqb pmul0 q0 (XO j') q') - | XO j' -> - mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 j p') i' - (pmulI cO cI cmul ceqb pmul0 q0 (Coq_Pos.pred_double j') q') - | XH -> - mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 XH p') i' (pmul0 q' q0)) - -(** val pmul : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **) - -let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with -| Pc c -> pmulC cO cI cmul ceqb p c -| Pinj (j', q') -> pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p -| PX (p', i', q') -> - (match p with - | Pc c -> pmulC cO cI cmul ceqb p'' c - | Pinj (j, q0) -> - let qQ' = - match j with - | XI j0 -> pmul cO cI cadd cmul ceqb (Pinj ((XO j0), q0)) q' - | XO j0 -> - pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0)) q' - | XH -> pmul cO cI cadd cmul ceqb q0 q' - in - mkPX cO ceqb (pmul cO cI cadd cmul ceqb p p') i' qQ' - | PX (p2, i, q0) -> - let qQ' = pmul cO cI cadd cmul ceqb q0 q' in - let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2 in - let qP' = pmul cO cI cadd cmul ceqb (mkPinj XH q0) p' in - let pP' = pmul cO cI cadd cmul ceqb p2 p' in - padd cO cadd ceqb - (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP') i' - (p0 cO)) - (mkPX cO ceqb pQ' i qQ')) - -(** val psquare : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> 'a1 pol -> 'a1 pol **) - -let rec psquare cO cI cadd cmul ceqb = function -| Pc c -> Pc (cmul c c) -| Pinj (j, q0) -> Pinj (j, (psquare cO cI cadd cmul ceqb q0)) -| PX (p2, i, q0) -> - let twoPQ = - pmul cO cI cadd cmul ceqb p2 - (mkPinj XH (pmulC cO cI cmul ceqb q0 (cadd cI cI))) - in - let q2 = psquare cO cI cadd cmul ceqb q0 in - let p3 = psquare cO cI cadd cmul ceqb p2 in - mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb p3 i (p0 cO)) twoPQ) i q2 - -(** val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol **) - -let mk_X cO cI j = - mkPinj_pred j (mkX cO cI) - -(** val ppow_pos : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1 - pol **) - -let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function -| XI p3 -> - subst_l - (pmul cO cI cadd cmul ceqb - (ppow_pos cO cI cadd cmul ceqb subst_l - (ppow_pos cO cI cadd cmul ceqb subst_l res p p3) p p3) - p) -| XO p3 -> - ppow_pos cO cI cadd cmul ceqb subst_l - (ppow_pos cO cI cadd cmul ceqb subst_l res p p3) p p3 -| XH -> subst_l (pmul cO cI cadd cmul ceqb res p) - -(** val ppow_N : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **) - -let ppow_N cO cI cadd cmul ceqb subst_l p = function -| N0 -> p1 cI -| Npos p2 -> ppow_pos cO cI cadd cmul ceqb subst_l (p1 cI) p p2 - -(** val norm_aux : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **) - -let rec norm_aux cO cI cadd cmul csub copp ceqb = function -| PEc c -> Pc c -| PEX j -> mk_X cO cI j -| PEadd (pe1, pe2) -> - (match pe1 with - | PEopp pe3 -> - psub cO cadd csub copp ceqb - (norm_aux cO cI cadd cmul csub copp ceqb pe2) - (norm_aux cO cI cadd cmul csub copp ceqb pe3) - | _ -> - (match pe2 with - | PEopp pe3 -> - psub cO cadd csub copp ceqb - (norm_aux cO cI cadd cmul csub copp ceqb pe1) - (norm_aux cO cI cadd cmul csub copp ceqb pe3) - | _ -> - padd cO cadd ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1) - (norm_aux cO cI cadd cmul csub copp ceqb pe2))) -| PEsub (pe1, pe2) -> - psub cO cadd csub copp ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1) - (norm_aux cO cI cadd cmul csub copp ceqb pe2) -| PEmul (pe1, pe2) -> - pmul cO cI cadd cmul ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1) - (norm_aux cO cI cadd cmul csub copp ceqb pe2) -| PEopp pe1 -> popp copp (norm_aux cO cI cadd cmul csub copp ceqb pe1) -| PEpow (pe1, n0) -> - ppow_N cO cI cadd cmul ceqb (fun p -> p) - (norm_aux cO cI cadd cmul csub copp ceqb pe1) n0 - -(** val cneqb : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool **) - -let cneqb ceqb x y = - negb (ceqb x y) - -(** val cltb : - ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool **) - -let cltb ceqb cleb x y = - (&&) (cleb x y) (cneqb ceqb x y) - -type 'c polC = 'c pol - -type op1 = -| Equal -| NonEqual -| Strict -| NonStrict - -type 'c nFormula = 'c polC * op1 - -(** val opMult : op1 -> op1 -> op1 option **) - -let opMult o o' = - match o with - | Equal -> Some Equal - | NonEqual -> - (match o' with - | Equal -> Some Equal - | NonEqual -> Some NonEqual - | _ -> None) - | Strict -> (match o' with - | NonEqual -> None - | _ -> Some o') - | NonStrict -> - (match o' with - | Equal -> Some Equal - | NonEqual -> None - | _ -> Some NonStrict) - -(** val opAdd : op1 -> op1 -> op1 option **) - -let opAdd o o' = - match o with - | Equal -> Some o' - | NonEqual -> (match o' with - | Equal -> Some NonEqual - | _ -> None) - | Strict -> (match o' with - | NonEqual -> None - | _ -> Some Strict) - | NonStrict -> - (match o' with - | Equal -> Some NonStrict - | NonEqual -> None - | x -> Some x) - -type 'c psatz = -| PsatzLet of 'c psatz * 'c psatz -| PsatzIn of nat -| PsatzSquare of 'c polC -| PsatzMulC of 'c polC * 'c psatz -| PsatzMulE of 'c psatz * 'c psatz -| PsatzAdd of 'c psatz * 'c psatz -| PsatzC of 'c -| PsatzZ - -(** val map_option : ('a1 -> 'a2 option) -> 'a1 option -> 'a2 option **) - -let map_option f = function -| Some x -> f x -| None -> None - -(** val map_option2 : - ('a1 -> 'a2 -> 'a3 option) -> 'a1 option -> 'a2 option -> 'a3 option **) - -let map_option2 f o o' = - match o with - | Some x -> (match o' with - | Some x' -> f x x' - | None -> None) - | None -> None - -(** val pexpr_times_nformula : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **) - -let pexpr_times_nformula cO cI cplus ctimes ceqb e = function -| ef,o -> - (match o with - | Equal -> Some ((pmul cO cI cplus ctimes ceqb e ef),Equal) - | _ -> None) - -(** val nformula_times_nformula : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **) - -let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 = - let e1,o1 = f1 in - let e2,o2 = f2 in - map_option (fun x -> Some ((pmul cO cI cplus ctimes ceqb e1 e2),x)) - (opMult o1 o2) - -(** val nformula_plus_nformula : - 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1 - nFormula -> 'a1 nFormula option **) - -let nformula_plus_nformula cO cplus ceqb f1 f2 = - let e1,o1 = f1 in - let e2,o2 = f2 in - map_option (fun x -> Some ((padd cO cplus ceqb e1 e2),x)) (opAdd o1 o2) - -(** val eval_Psatz : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1 - nFormula option **) - -let rec eval_Psatz cO cI cplus ctimes ceqb cleb l = function -| PsatzLet (p2, p3) -> - (match eval_Psatz cO cI cplus ctimes ceqb cleb l p2 with - | Some f -> eval_Psatz cO cI cplus ctimes ceqb cleb (f::l) p3 - | None -> None) -| PsatzIn n0 -> Some (nth n0 l ((Pc cO),Equal)) -| PsatzSquare e0 -> Some ((psquare cO cI cplus ctimes ceqb e0),NonStrict) -| PsatzMulC (re, e0) -> - map_option (pexpr_times_nformula cO cI cplus ctimes ceqb re) - (eval_Psatz cO cI cplus ctimes ceqb cleb l e0) -| PsatzMulE (f1, f2) -> - map_option2 (nformula_times_nformula cO cI cplus ctimes ceqb) - (eval_Psatz cO cI cplus ctimes ceqb cleb l f1) - (eval_Psatz cO cI cplus ctimes ceqb cleb l f2) -| PsatzAdd (f1, f2) -> - map_option2 (nformula_plus_nformula cO cplus ceqb) - (eval_Psatz cO cI cplus ctimes ceqb cleb l f1) - (eval_Psatz cO cI cplus ctimes ceqb cleb l f2) -| PsatzC c -> if cltb ceqb cleb cO c then Some ((Pc c),Strict) else None -| PsatzZ -> Some ((Pc cO),Equal) - -(** val check_inconsistent : - 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> - bool **) - -let check_inconsistent cO ceqb cleb = function -| e,op -> - (match e with - | Pc c -> - (match op with - | Equal -> cneqb ceqb c cO - | NonEqual -> ceqb c cO - | Strict -> cleb c cO - | NonStrict -> cltb ceqb cleb c cO) - | _ -> false) - -(** val check_normalised_formulas : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> bool **) - -let check_normalised_formulas cO cI cplus ctimes ceqb cleb l cm = - match eval_Psatz cO cI cplus ctimes ceqb cleb l cm with - | Some f -> check_inconsistent cO ceqb cleb f - | None -> false - -type op2 = -| OpEq -| OpNEq -| OpLe -| OpGe -| OpLt -| OpGt - -type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr } - -(** val norm : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **) - -let norm = - norm_aux - -(** val psub0 : - 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 - -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **) - -let psub0 = - psub - -(** val padd0 : - 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol - -> 'a1 pol **) - -let padd0 = - padd - -(** val popp0 : ('a1 -> 'a1) -> 'a1 pol -> 'a1 pol **) - -let popp0 = - popp - -(** val normalise : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 - nFormula **) - -let normalise cO cI cplus ctimes cminus copp ceqb f = - let { flhs = lhs; fop = op; frhs = rhs } = f in - let lhs0 = norm cO cI cplus ctimes cminus copp ceqb lhs in - let rhs0 = norm cO cI cplus ctimes cminus copp ceqb rhs in - (match op with - | OpEq -> (psub0 cO cplus cminus copp ceqb lhs0 rhs0),Equal - | OpNEq -> (psub0 cO cplus cminus copp ceqb lhs0 rhs0),NonEqual - | OpLe -> (psub0 cO cplus cminus copp ceqb rhs0 lhs0),NonStrict - | OpGe -> (psub0 cO cplus cminus copp ceqb lhs0 rhs0),NonStrict - | OpLt -> (psub0 cO cplus cminus copp ceqb rhs0 lhs0),Strict - | OpGt -> (psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict) - -(** val xnormalise : ('a1 -> 'a1) -> 'a1 nFormula -> 'a1 nFormula list **) - -let xnormalise copp = function -| e,o -> - (match o with - | Equal -> (e,Strict)::(((popp0 copp e),Strict)::[]) - | NonEqual -> (e,Equal)::[] - | Strict -> ((popp0 copp e),NonStrict)::[] - | NonStrict -> ((popp0 copp e),Strict)::[]) - -(** val xnegate : ('a1 -> 'a1) -> 'a1 nFormula -> 'a1 nFormula list **) - -let xnegate copp = function -| e,o -> - (match o with - | NonEqual -> (e,Strict)::(((popp0 copp e),Strict)::[]) - | x -> (e,x)::[]) - -(** val cnf_of_list : - 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list - -> 'a2 -> ('a1 nFormula, 'a2) cnf **) - -let cnf_of_list cO ceqb cleb l tg = - fold_right (fun x acc -> - if check_inconsistent cO ceqb cleb x then acc else ((x,tg)::[])::acc) - cnf_tt l - -(** val cnf_normalise : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) - -> 'a1 formula -> 'a2 -> ('a1 nFormula, 'a2) cnf **) - -let cnf_normalise cO cI cplus ctimes cminus copp ceqb cleb t0 tg = - let f = normalise cO cI cplus ctimes cminus copp ceqb t0 in - if check_inconsistent cO ceqb cleb f - then cnf_ff - else cnf_of_list cO ceqb cleb (xnormalise copp f) tg - -(** val cnf_negate : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 - -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) - -> 'a1 formula -> 'a2 -> ('a1 nFormula, 'a2) cnf **) - -let cnf_negate cO cI cplus ctimes cminus copp ceqb cleb t0 tg = - let f = normalise cO cI cplus ctimes cminus copp ceqb t0 in - if check_inconsistent cO ceqb cleb f - then cnf_tt - else cnf_of_list cO ceqb cleb (xnegate copp f) tg - -(** val xdenorm : positive -> 'a1 pol -> 'a1 pExpr **) - -let rec xdenorm jmp = function -| Pc c -> PEc c -| Pinj (j, p2) -> xdenorm (Coq_Pos.add j jmp) p2 -| PX (p2, j, q0) -> - PEadd ((PEmul ((xdenorm jmp p2), (PEpow ((PEX jmp), (Npos j))))), - (xdenorm (Coq_Pos.succ jmp) q0)) - -(** val denorm : 'a1 pol -> 'a1 pExpr **) - -let denorm p = - xdenorm XH p - -(** val map_PExpr : ('a2 -> 'a1) -> 'a2 pExpr -> 'a1 pExpr **) - -let rec map_PExpr c_of_S = function -| PEc c -> PEc (c_of_S c) -| PEX p -> PEX p -| PEadd (e1, e2) -> PEadd ((map_PExpr c_of_S e1), (map_PExpr c_of_S e2)) -| PEsub (e1, e2) -> PEsub ((map_PExpr c_of_S e1), (map_PExpr c_of_S e2)) -| PEmul (e1, e2) -> PEmul ((map_PExpr c_of_S e1), (map_PExpr c_of_S e2)) -| PEopp e0 -> PEopp (map_PExpr c_of_S e0) -| PEpow (e0, n0) -> PEpow ((map_PExpr c_of_S e0), n0) - -(** val map_Formula : ('a2 -> 'a1) -> 'a2 formula -> 'a1 formula **) - -let map_Formula c_of_S f = - let { flhs = l; fop = o; frhs = r } = f in - { flhs = (map_PExpr c_of_S l); fop = o; frhs = (map_PExpr c_of_S r) } - -(** val simpl_cone : - 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz -> - 'a1 psatz **) - -let simpl_cone cO cI ctimes ceqb e = match e with -| PsatzSquare t0 -> - (match t0 with - | Pc c -> if ceqb cO c then PsatzZ else PsatzC (ctimes c c) - | _ -> PsatzSquare t0) -| PsatzMulE (t1, t2) -> - (match t1 with - | PsatzMulE (x, x0) -> - (match x with - | PsatzC p2 -> - (match t2 with - | PsatzC c -> PsatzMulE ((PsatzC (ctimes c p2)), x0) - | PsatzZ -> PsatzZ - | _ -> e) - | _ -> - (match x0 with - | PsatzC p2 -> - (match t2 with - | PsatzC c -> PsatzMulE ((PsatzC (ctimes c p2)), x) - | PsatzZ -> PsatzZ - | _ -> e) - | _ -> - (match t2 with - | PsatzC c -> if ceqb cI c then t1 else PsatzMulE (t1, t2) - | PsatzZ -> PsatzZ - | _ -> e))) - | PsatzC c -> - (match t2 with - | PsatzMulE (x, x0) -> - (match x with - | PsatzC p2 -> PsatzMulE ((PsatzC (ctimes c p2)), x0) - | _ -> - (match x0 with - | PsatzC p2 -> PsatzMulE ((PsatzC (ctimes c p2)), x) - | _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2))) - | PsatzAdd (y, z0) -> - PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c), z0))) - | PsatzC c0 -> PsatzC (ctimes c c0) - | PsatzZ -> PsatzZ - | _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2)) - | PsatzZ -> PsatzZ - | _ -> - (match t2 with - | PsatzC c -> if ceqb cI c then t1 else PsatzMulE (t1, t2) - | PsatzZ -> PsatzZ - | _ -> e)) -| PsatzAdd (t1, t2) -> - (match t1 with - | PsatzZ -> t2 - | _ -> (match t2 with - | PsatzZ -> t1 - | _ -> PsatzAdd (t1, t2))) -| _ -> e - -type 'a t = -| Empty -| Elt of 'a -| Branch of 'a t * 'a * 'a t - -(** val find : 'a1 -> 'a1 t -> positive -> 'a1 **) - -let rec find default vm p = - match vm with - | Empty -> default - | Elt i -> i - | Branch (l, e, r) -> - (match p with - | XI p2 -> find default r p2 - | XO p2 -> find default l p2 - | XH -> e) - -(** val singleton : 'a1 -> positive -> 'a1 -> 'a1 t **) - -let rec singleton default x v = - match x with - | XI p -> Branch (Empty, default, (singleton default p v)) - | XO p -> Branch ((singleton default p v), default, Empty) - | XH -> Elt v - -(** val vm_add : 'a1 -> positive -> 'a1 -> 'a1 t -> 'a1 t **) - -let rec vm_add default x v = function -| Empty -> singleton default x v -| Elt vl -> - (match x with - | XI p -> Branch (Empty, vl, (singleton default p v)) - | XO p -> Branch ((singleton default p v), vl, Empty) - | XH -> Elt v) -| Branch (l, o, r) -> - (match x with - | XI p -> Branch (l, o, (vm_add default p v r)) - | XO p -> Branch ((vm_add default p v l), o, r) - | XH -> Branch (l, v, r)) - -(** val zeval_const : z pExpr -> z option **) - -let rec zeval_const = function -| PEc c -> Some c -| PEX _ -> None -| PEadd (e1, e2) -> - map_option2 (fun x y -> Some (Z.add x y)) (zeval_const e1) (zeval_const e2) -| PEsub (e1, e2) -> - map_option2 (fun x y -> Some (Z.sub x y)) (zeval_const e1) (zeval_const e2) -| PEmul (e1, e2) -> - map_option2 (fun x y -> Some (Z.mul x y)) (zeval_const e1) (zeval_const e2) -| PEopp e0 -> map_option (fun x -> Some (Z.opp x)) (zeval_const e0) -| PEpow (e1, n0) -> - map_option (fun x -> Some (Z.pow x (Z.of_N n0))) (zeval_const e1) - -type zWitness = z psatz - -(** val zWeakChecker : z nFormula list -> z psatz -> bool **) - -let zWeakChecker = - check_normalised_formulas Z0 (Zpos XH) Z.add Z.mul Z.eqb Z.leb - -(** val psub1 : z pol -> z pol -> z pol **) - -let psub1 = - psub0 Z0 Z.add Z.sub Z.opp Z.eqb - -(** val popp1 : z pol -> z pol **) - -let popp1 = - popp0 Z.opp - -(** val padd1 : z pol -> z pol -> z pol **) - -let padd1 = - padd0 Z0 Z.add Z.eqb - -(** val normZ : z pExpr -> z pol **) - -let normZ = - norm Z0 (Zpos XH) Z.add Z.mul Z.sub Z.opp Z.eqb - -(** val zunsat : z nFormula -> bool **) - -let zunsat = - check_inconsistent Z0 Z.eqb Z.leb - -(** val zdeduce : z nFormula -> z nFormula -> z nFormula option **) - -let zdeduce = - nformula_plus_nformula Z0 Z.add Z.eqb - -(** val xnnormalise : z formula -> z nFormula **) - -let xnnormalise t0 = - let { flhs = lhs; fop = o; frhs = rhs } = t0 in - let lhs0 = normZ lhs in - let rhs0 = normZ rhs in - (match o with - | OpEq -> (psub1 rhs0 lhs0),Equal - | OpNEq -> (psub1 rhs0 lhs0),NonEqual - | OpLe -> (psub1 rhs0 lhs0),NonStrict - | OpGe -> (psub1 lhs0 rhs0),NonStrict - | OpLt -> (psub1 rhs0 lhs0),Strict - | OpGt -> (psub1 lhs0 rhs0),Strict) - -(** val xnormalise0 : z nFormula -> z nFormula list **) - -let xnormalise0 = function -| e,o -> - (match o with - | Equal -> - ((psub1 e (Pc (Zpos XH))),NonStrict)::(((psub1 (Pc (Zneg XH)) e),NonStrict)::[]) - | NonEqual -> (e,Equal)::[] - | Strict -> ((psub1 (Pc Z0) e),NonStrict)::[] - | NonStrict -> ((psub1 (Pc (Zneg XH)) e),NonStrict)::[]) - -(** val cnf_of_list0 : - 'a1 -> z nFormula list -> (z nFormula * 'a1) list list **) - -let cnf_of_list0 tg l = - fold_right (fun x acc -> if zunsat x then acc else ((x,tg)::[])::acc) - cnf_tt l - -(** val normalise0 : z formula -> 'a1 -> (z nFormula, 'a1) cnf **) - -let normalise0 t0 tg = - let f = xnnormalise t0 in - if zunsat f then cnf_ff else cnf_of_list0 tg (xnormalise0 f) - -(** val xnegate0 : z nFormula -> z nFormula list **) - -let xnegate0 = function -| e,o -> - (match o with - | NonEqual -> - ((psub1 e (Pc (Zpos XH))),NonStrict)::(((psub1 (Pc (Zneg XH)) e),NonStrict)::[]) - | Strict -> ((psub1 e (Pc (Zpos XH))),NonStrict)::[] - | x -> (e,x)::[]) - -(** val negate : z formula -> 'a1 -> (z nFormula, 'a1) cnf **) - -let negate t0 tg = - let f = xnnormalise t0 in - if zunsat f then cnf_tt else cnf_of_list0 tg (xnegate0 f) - -(** val cnfZ : - kind -> (z formula, 'a1, 'a2, 'a3) tFormula -> (z nFormula, 'a1) - cnf * 'a1 trace **) - -let cnfZ k f = - rxcnf zunsat zdeduce normalise0 negate true k f - -(** val ceiling : z -> z -> z **) - -let ceiling a b = - let q0,r = Z.div_eucl a b in - (match r with - | Z0 -> q0 - | _ -> Z.add q0 (Zpos XH)) - -type zArithProof = -| DoneProof -| RatProof of zWitness * zArithProof -| CutProof of zWitness * zArithProof -| SplitProof of z polC * zArithProof * zArithProof -| Deprecated_EnumProof of zWitness * zWitness * zArithProof list -| ExProof of positive * zArithProof - -(** val zgcdM : z -> z -> z **) - -let zgcdM x y = - Z.max (Z.gcd x y) (Zpos XH) - -(** val zgcd_pol : z polC -> z * z **) - -let rec zgcd_pol = function -| Pc c -> Z0,c -| Pinj (_, p2) -> zgcd_pol p2 -| PX (p2, _, q0) -> - let g1,c1 = zgcd_pol p2 in - let g2,c2 = zgcd_pol q0 in (zgcdM (zgcdM g1 c1) g2),c2 - -(** val zdiv_pol : z polC -> z -> z polC **) - -let rec zdiv_pol p x = - match p with - | Pc c -> Pc (Z.div c x) - | Pinj (j, p2) -> Pinj (j, (zdiv_pol p2 x)) - | PX (p2, j, q0) -> PX ((zdiv_pol p2 x), j, (zdiv_pol q0 x)) - -(** val makeCuttingPlane : z polC -> z polC * z **) - -let makeCuttingPlane p = - let g,c = zgcd_pol p in - if Z.gtb g Z0 - then (zdiv_pol (psubC Z.sub p c) g),(Z.opp (ceiling (Z.opp c) g)) - else p,Z0 - -(** val genCuttingPlane : z nFormula -> ((z polC * z) * op1) option **) - -let genCuttingPlane = function -| e,op -> - (match op with - | Equal -> - let g,c = zgcd_pol e in - if (&&) (Z.gtb g Z0) - ((&&) (negb (Z.eqb c Z0)) (negb (Z.eqb (Z.gcd g c) g))) - then None - else Some ((makeCuttingPlane e),Equal) - | NonEqual -> Some ((e,Z0),op) - | Strict -> Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict) - | NonStrict -> Some ((makeCuttingPlane e),NonStrict)) - -(** val nformula_of_cutting_plane : ((z polC * z) * op1) -> z nFormula **) - -let nformula_of_cutting_plane = function -| e_z,o -> let e,z0 = e_z in (padd1 e (Pc z0)),o - -(** val eval_Psatz0 : z nFormula list -> zWitness -> z nFormula option **) - -let eval_Psatz0 = - eval_Psatz Z0 (Zpos XH) Z.add Z.mul Z.eqb Z.leb - -(** val bound_var : positive -> z formula **) - -let bound_var v = - { flhs = (PEX v); fop = OpGe; frhs = (PEc Z0) } - -(** val mk_eq_pos : positive -> positive -> positive -> z formula **) - -let mk_eq_pos x y t0 = - { flhs = (PEX x); fop = OpEq; frhs = (PEsub ((PEX y), (PEX t0))) } - -(** val max_var : positive -> z pol -> positive **) - -let rec max_var jmp = function -| Pc _ -> jmp -| Pinj (j, p2) -> max_var (Coq_Pos.add j jmp) p2 -| PX (p2, _, q0) -> - Coq_Pos.max (max_var jmp p2) (max_var (Coq_Pos.succ jmp) q0) - -(** val max_var_nformulae : z nFormula list -> positive **) - -let max_var_nformulae l = - fold_left (fun acc f -> Coq_Pos.max acc (max_var XH (fst f))) l XH - -(** val zChecker : z nFormula list -> zArithProof -> bool **) - -let rec zChecker l = function -| RatProof (w, pf0) -> - (match eval_Psatz0 l w with - | Some f -> if zunsat f then true else zChecker (f::l) pf0 - | None -> false) -| CutProof (w, pf0) -> - (match eval_Psatz0 l w with - | Some f -> - (match genCuttingPlane f with - | Some cp -> zChecker ((nformula_of_cutting_plane cp)::l) pf0 - | None -> true) - | None -> false) -| SplitProof (p, pf1, pf2) -> - (match genCuttingPlane (p,NonStrict) with - | Some cp1 -> - (match genCuttingPlane ((popp1 p),NonStrict) with - | Some cp2 -> - (&&) (zChecker ((nformula_of_cutting_plane cp1)::l) pf1) - (zChecker ((nformula_of_cutting_plane cp2)::l) pf2) - | None -> false) - | None -> false) -| ExProof (x, prf) -> - let fr = max_var_nformulae l in - if Coq_Pos.leb x fr - then let z0 = Coq_Pos.succ fr in - let t0 = Coq_Pos.succ z0 in - let nfx = xnnormalise (mk_eq_pos x z0 t0) in - let posz = xnnormalise (bound_var z0) in - let post = xnnormalise (bound_var t0) in - zChecker (nfx::(posz::(post::l))) prf - else false -| _ -> false - -(** val zTautoChecker : z formula bFormula -> zArithProof list -> bool **) - -let zTautoChecker f w = - tauto_checker zunsat zdeduce normalise0 negate (fun cl -> - zChecker (map fst cl)) f w - -type q = { qnum : z; qden : positive } - -(** val qeq_bool : q -> q -> bool **) - -let qeq_bool x y = - Z.eqb (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)) - -(** val qle_bool : q -> q -> bool **) - -let qle_bool x y = - Z.leb (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)) - -(** val qplus : q -> q -> q **) - -let qplus x y = - { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden))); - qden = (Coq_Pos.mul x.qden y.qden) } - -(** val qmult : q -> q -> q **) - -let qmult x y = - { qnum = (Z.mul x.qnum y.qnum); qden = (Coq_Pos.mul x.qden y.qden) } - -(** val qopp : q -> q **) - -let qopp x = - { qnum = (Z.opp x.qnum); qden = x.qden } - -(** val qminus : q -> q -> q **) - -let qminus x y = - qplus x (qopp y) - -(** val qinv : q -> q **) - -let qinv x = - match x.qnum with - | Z0 -> { qnum = Z0; qden = XH } - | Zpos p -> { qnum = (Zpos x.qden); qden = p } - | Zneg p -> { qnum = (Zneg x.qden); qden = p } - -(** val qpower_positive : q -> positive -> q **) - -let qpower_positive = - pow_pos0 qmult - -(** val qpower : q -> z -> q **) - -let qpower q0 = function -| Z0 -> { qnum = (Zpos XH); qden = XH } -| Zpos p -> qpower_positive q0 p -| Zneg p -> qinv (qpower_positive q0 p) - -type qWitness = q psatz - -(** val qWeakChecker : q nFormula list -> q psatz -> bool **) - -let qWeakChecker = - check_normalised_formulas { qnum = Z0; qden = XH } { qnum = (Zpos XH); - qden = XH } qplus qmult qeq_bool qle_bool - -(** val qnormalise : q formula -> 'a1 -> (q nFormula, 'a1) cnf **) - -let qnormalise t0 tg = - cnf_normalise { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } - qplus qmult qminus qopp qeq_bool qle_bool t0 tg - -(** val qnegate : q formula -> 'a1 -> (q nFormula, 'a1) cnf **) - -let qnegate t0 tg = - cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus - qmult qminus qopp qeq_bool qle_bool t0 tg - -(** val qunsat : q nFormula -> bool **) - -let qunsat = - check_inconsistent { qnum = Z0; qden = XH } qeq_bool qle_bool - -(** val qdeduce : q nFormula -> q nFormula -> q nFormula option **) - -let qdeduce = - nformula_plus_nformula { qnum = Z0; qden = XH } qplus qeq_bool - -(** val normQ : q pExpr -> q pol **) - -let normQ = - norm { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus qmult - qminus qopp qeq_bool - -(** val cnfQ : - kind -> (q formula, 'a1, 'a2, 'a3) tFormula -> (q nFormula, 'a1) - cnf * 'a1 trace **) - -let cnfQ k f = - rxcnf qunsat qdeduce qnormalise qnegate true k f - -(** val qTautoChecker : q formula bFormula -> qWitness list -> bool **) - -let qTautoChecker f w = - tauto_checker qunsat qdeduce qnormalise qnegate (fun cl -> - qWeakChecker (map fst cl)) f w - -type rcst = -| C0 -| C1 -| CQ of q -| CZ of z -| CPlus of rcst * rcst -| CMinus of rcst * rcst -| CMult of rcst * rcst -| CPow of rcst * (z, nat) sum -| CInv of rcst -| COpp of rcst - -(** val z_of_exp : (z, nat) sum -> z **) - -let z_of_exp = function -| Inl z1 -> z1 -| Inr n0 -> Z.of_nat n0 - -(** val q_of_Rcst : rcst -> q **) - -let rec q_of_Rcst = function -| C0 -> { qnum = Z0; qden = XH } -| C1 -> { qnum = (Zpos XH); qden = XH } -| CQ q0 -> q0 -| CZ z0 -> { qnum = z0; qden = XH } -| CPlus (r1, r2) -> qplus (q_of_Rcst r1) (q_of_Rcst r2) -| CMinus (r1, r2) -> qminus (q_of_Rcst r1) (q_of_Rcst r2) -| CMult (r1, r2) -> qmult (q_of_Rcst r1) (q_of_Rcst r2) -| CPow (r1, z0) -> qpower (q_of_Rcst r1) (z_of_exp z0) -| CInv r0 -> qinv (q_of_Rcst r0) -| COpp r0 -> qopp (q_of_Rcst r0) - -type rWitness = q psatz - -(** val rWeakChecker : q nFormula list -> q psatz -> bool **) - -let rWeakChecker = - check_normalised_formulas { qnum = Z0; qden = XH } { qnum = (Zpos XH); - qden = XH } qplus qmult qeq_bool qle_bool - -(** val rnormalise : q formula -> 'a1 -> (q nFormula, 'a1) cnf **) - -let rnormalise t0 tg = - cnf_normalise { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } - qplus qmult qminus qopp qeq_bool qle_bool t0 tg - -(** val rnegate : q formula -> 'a1 -> (q nFormula, 'a1) cnf **) - -let rnegate t0 tg = - cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus - qmult qminus qopp qeq_bool qle_bool t0 tg - -(** val runsat : q nFormula -> bool **) - -let runsat = - check_inconsistent { qnum = Z0; qden = XH } qeq_bool qle_bool - -(** val rdeduce : q nFormula -> q nFormula -> q nFormula option **) - -let rdeduce = - nformula_plus_nformula { qnum = Z0; qden = XH } qplus qeq_bool - -(** val rTautoChecker : rcst formula bFormula -> rWitness list -> bool **) - -let rTautoChecker f w = - tauto_checker runsat rdeduce rnormalise rnegate (fun cl -> - rWeakChecker (map fst cl)) - (map_bformula IsProp (map_Formula q_of_Rcst) f) w - diff --git a/test-suite/output/MExtraction.v b/test-suite/output/MExtraction.v deleted file mode 100644 index a31c993666..0000000000 --- a/test-suite/output/MExtraction.v +++ /dev/null @@ -1,68 +0,0 @@ -(************************************************************************) -(* * The Rocq Prover / The Rocq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* "( * )" [ "(,)" ]. -Extract Inductive list => list [ "[]" "(::)" ]. -Extract Inductive bool => bool [ true false ]. -Extract Inductive sumbool => bool [ true false ]. -Extract Inductive option => option [ Some None ]. -Extract Inductive sumor => option [ Some None ]. -(** Then, in a ternary alternative { }+{ }+{ }, - - leftmost choice (Inleft Left) is (Some true), - - middle choice (Inleft Right) is (Some false), - - rightmost choice (Inright) is (None) *) - - -(** To preserve its laziness, andb is normally expanded. - Let's rather use the ocaml && *) -Extract Inlined Constant andb => "(&&)". - -Import Reals.Rdefinitions. - -Extract Constant R => "int". -Extract Constant R0 => "0". -Extract Constant R1 => "1". -Extract Constant Rplus => "( + )". -Extract Constant Rmult => "( * )". -Extract Constant Ropp => "fun x -> - x". -Extract Constant Rinv => "fun x -> 1 / x". - -(** In order to avoid annoying build dependencies the actual - extraction is only performed as a test in the test suite. *) -Recursive Extraction - Tauto.mapX Tauto.foldA Tauto.collect_annot Tauto.ids_of_formula Tauto.map_bformula - Tauto.abst_form - ZMicromega.cnfZ ZMicromega.Zeval_const QMicromega.cnfQ - List.map simpl_cone (*map_cone indexes*) - denorm QArith_base.Qpower vm_add - normZ normQ normQ Z.to_N N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find. - -(* Local Variables: *) -(* coding: utf-8 *) -(* End: *) diff --git a/test-suite/success/TifyZR.v b/test-suite/success/TifyZR.v new file mode 100644 index 0000000000..799a5f3ee2 --- /dev/null +++ b/test-suite/success/TifyZR.v @@ -0,0 +1,86 @@ +From Stdlib Require Import Tify. +From Stdlib Require Import ZifyClasses. +From Stdlib Require Import Reals. +From Stdlib Require Import Lra. +(* [zify] instances are already loaded *) + +Goal forall (y:nat), + (Z.of_nat y + 1)%Z = Z.of_nat (y + 1). +Proof. + tify Z. + change ((Z.of_nat y + 1)%Z = (Z.of_nat y + 1)%Z). + reflexivity. +Qed. + +Goal forall (y:nat), + (Z.of_nat y + 1)%Z = Z.of_nat (y + 1). +Proof. + tify R. (* This is no known way to map to R, default to Z *) + change ((Z.of_nat y + 1)%Z = (Z.of_nat y + 1)%Z). + reflexivity. +Qed. + +(* Define instances for R *) +Lemma inj_IZR_iff : forall n m, n = m <-> (IZR n = IZR m)%R. +Proof. + split. + apply f_equal. + apply eq_IZR. +Qed. + +(* For the test, we lose the information that Z is discrete *) +#[global] +Instance Inj_Z_R : InjTyp Z R := + mkinj _ _ IZR (fun x => True) (fun _ => I). +Add Tify InjTyp Inj_Z_R. + +#[global] +Instance Inj_nat_R : InjTyp nat R := + mkinj _ _ INR (fun x => 0 <= x)%R pos_INR. +Add Tify InjTyp Inj_nat_R. + +#[global] +Instance Inj_R_R : InjTyp R R := + mkinj _ _ (fun x=> x) (fun x => True) (fun _ => I). +Add Tify InjTyp Inj_R_R. + +#[global] +Instance Op_eq_Z_R : BinRel (T:=R) (@eq Z) := + { TR := @eq R ; TRInj := inj_IZR_iff }. +Add Tify BinRel Op_eq_Z_R. + +#[global] +Instance Op_plus_R : BinOp Z.add := + { TBOp := Rplus; TBOpInj := plus_IZR }. +Add Tify BinOp Op_plus_R. + +#[global] +Instance Op_plus_nat_R : BinOp Nat.add := + { TBOp := Rplus; TBOpInj := plus_INR }. +Add Tify BinOp Op_plus_nat_R. + +#[global] +Instance Op_Z_of_nat_R : UnOp (T1:= R) (T2:=R) Z.of_nat:= + { TUOp x := x ; TUOpInj x := eq_sym (INR_IZR_INZ x) }. +Add Tify UnOp Op_Z_of_nat_R. + +#[global] +Instance Op_S_R : UnOp (T1:= R) (T2:=R) S := + { TUOp := (fun x => Rplus x 1) ; TUOpInj := S_INR }. +Add Tify UnOp Op_S_R. + +#[global] +Instance Op_O : CstOp (T:= R) O:= + { TCst := 0%R ; TCstInj := INR_0 }. +Add Tify CstOp Op_O. + +Goal forall (y:nat), + (Z.of_nat y + 1)%Z = Z.of_nat (y + 1). +Proof. + intros. + Fail lra. (* Does not reason over Z *) + Fail (tify Z; change ((INR y + 1)%R = (INR y + R1)%R)). + tify R. + change ((INR y + 1)%R = (INR y + R1)%R). + lra. +Qed. diff --git a/theories/BinNums/NatDef.v b/theories/BinNums/NatDef.v index 41a5777d30..07f9334433 100644 --- a/theories/BinNums/NatDef.v +++ b/theories/BinNums/NatDef.v @@ -1 +1,2 @@ -From Corelib Require Export NatDef. +From Stdlib Require Import PosDef. +From micromega_plugin Require Export NatDef. diff --git a/theories/BinNums/PosDef.v b/theories/BinNums/PosDef.v index ad44d4bb38..39a9b7f980 100644 --- a/theories/BinNums/PosDef.v +++ b/theories/BinNums/PosDef.v @@ -1 +1 @@ -From Corelib Require Export PosDef. +From micromega_plugin Require Export PosDef. diff --git a/theories/BinNums/RatDef.v b/theories/BinNums/RatDef.v new file mode 100644 index 0000000000..887381578e --- /dev/null +++ b/theories/BinNums/RatDef.v @@ -0,0 +1 @@ +From micromega_plugin Require Export RatDef. diff --git a/theories/Lists/List.v b/theories/Lists/List.v index e2d092dddf..c214ed0aa3 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -1072,12 +1072,6 @@ Section ListOps. (** An alternative tail-recursive definition for reverse *) - Fixpoint rev_append (l l': list A) : list A := - match l with - | [] => l' - | a :: l => rev_append l (a::l') - end. - Definition rev' l : list A := rev_append l []. Lemma rev_append_rev : forall l l', rev_append l l' = rev l ++ l'. @@ -1154,6 +1148,7 @@ Section ListOps. Qed. End ListOps. +Notation rev_append := rev_append. (***************************************************) (** * Applying functions to the elements of a list *) @@ -1407,19 +1402,14 @@ Section Fold_Left_Recursor. Variables (A : Type) (B : Type). Variable f : A -> B -> A. - Fixpoint fold_left (l:list B) (a0:A) : A := - match l with - | [] => a0 - | b :: l => fold_left l (f a0 b) - end. - Lemma fold_left_app : forall (l l':list B)(i:A), - fold_left (l++l') i = fold_left l' (fold_left l i). + fold_left f (l++l') i = fold_left f l' (fold_left f l i). Proof. now intro l; induction l; cbn. Qed. End Fold_Left_Recursor. +Notation fold_left := fold_left. Lemma fold_left_S_0 : forall (A:Type)(l:list A), fold_left (fun x _ => S x) l 0 = length l. @@ -1432,18 +1422,7 @@ Qed. (** Right-to-left iterator on lists *) (************************************) -Section Fold_Right_Recursor. - Variables (A : Type) (B : Type). - Variable f : B -> A -> A. - Variable a0 : A. - - Fixpoint fold_right (l:list B) : A := - match l with - | [] => a0 - | b :: l => f b (fold_right l) - end. - -End Fold_Right_Recursor. + Notation fold_right := fold_right. Lemma fold_right_app : forall (A B:Type)(f:A->B->B) l l' i, fold_right f i (l++l') = fold_right f (fold_right f i l') l. @@ -3883,7 +3862,7 @@ Lemma length_concat A l: length (concat l) = list_sum (map (@length A) l). Proof. induction l; [reflexivity|]. - simpl. rewrite length_app. + simpl; rewrite length_app. f_equal. assumption. Qed. diff --git a/theories/Lists/ListDef.v b/theories/Lists/ListDef.v index aa3414c0fc..e98a7adf7b 100644 --- a/theories/Lists/ListDef.v +++ b/theories/Lists/ListDef.v @@ -1 +1 @@ -From Corelib Require Export ListDef. +From micromega_plugin Require Export ListDef. diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v index 3fdb67e900..e839c2e955 100644 --- a/theories/NArith/BinNatDef.v +++ b/theories/NArith/BinNatDef.v @@ -10,7 +10,7 @@ From Stdlib Require Export BinNums. From Stdlib Require Import BinPos. -From Stdlib Require Export BinNums.NatDef. +From micromega_plugin Require Export NatDef. #[local] Open Scope N_scope. @@ -24,7 +24,7 @@ From Stdlib Require Export BinNums.NatDef. Module N. -Include BinNums.NatDef.N. +Include NatDef.N. Definition t := N. @@ -38,14 +38,6 @@ Definition zero := 0. Definition one := 1. Definition two := 2. -(** ** Successor *) - -Definition succ n := - match n with - | 0 => 1 - | pos p => pos (Pos.succ p) - end. - (** ** Predecessor *) Definition pred n := @@ -56,39 +48,18 @@ Definition pred n := (** ** Addition *) -Definition add n m := - match n, m with - | 0, _ => m - | _, 0 => n - | pos p, pos q => pos (p + q) - end. - Infix "+" := add : N_scope. Infix "-" := sub : N_scope. (** Multiplication *) -Definition mul n m := - match n, m with - | 0, _ => 0 - | _, 0 => 0 - | pos p, pos q => pos (p * q) - end. - Infix "*" := mul : N_scope. Infix "?=" := compare (at level 70, no associativity) : N_scope. (** Boolean equality and comparison *) -Definition eqb n m := - match n, m with - | 0, 0 => true - | pos p, pos q => Pos.eqb p q - | _, _ => false - end. - Definition ltb x y := match x ?= y with Lt => true | _ => false end. @@ -263,12 +234,6 @@ Definition testbit a n := (** Translation from [N] to [nat] and back. *) -Definition to_nat (a:N) := - match a with - | 0 => O - | pos p => Pos.to_nat p - end. - Definition of_nat (n:nat) := match n with | O => 0 @@ -290,16 +255,6 @@ Definition iter_op {A} (op : A -> A -> A) (z x : A) (n : N) := (** Conversion with a decimal representation for printing/parsing *) -Definition of_uint (d:Decimal.uint) := Pos.of_uint d. - -Definition of_hex_uint (d:Hexadecimal.uint) := Pos.of_hex_uint d. - -Definition of_num_uint (d:Number.uint) := - match d with - | Number.UIntDecimal d => of_uint d - | Number.UIntHexadecimal d => of_hex_uint d - end. - Definition of_int (d:Decimal.int) := match Decimal.norm d with | Decimal.Pos d => Some (Pos.of_uint d) diff --git a/theories/Numbers/DecimalR.v b/theories/Numbers/DecimalR.v index 970cfb397c..ec1d70facf 100644 --- a/theories/Numbers/DecimalR.v +++ b/theories/Numbers/DecimalR.v @@ -13,15 +13,15 @@ Proofs that conversions between decimal numbers and [R] are bijections. *) +From Stdlib Require Import RatDef PeanoNat. From Stdlib Require Import Decimal DecimalFacts DecimalPos DecimalZ DecimalQ Rdefinitions. -From Stdlib Require Import PeanoNat. Lemma of_IQmake_to_decimal num den : match IQmake_to_decimal num den with | None => True | Some (DecimalExp _ _ _) => False | Some (Decimal i f) => - of_decimal (Decimal i f) = IRQ (QArith_base.Qmake num den) + of_decimal (Decimal i f) = IRQ (Qmake num den) end. Proof. unfold IQmake_to_decimal. diff --git a/theories/Numbers/HexadecimalR.v b/theories/Numbers/HexadecimalR.v index eb8f0ea1de..512803a152 100644 --- a/theories/Numbers/HexadecimalR.v +++ b/theories/Numbers/HexadecimalR.v @@ -13,7 +13,7 @@ Proofs that conversions between hexadecimal numbers and [R] are bijections. *) -From Stdlib Require Import PeanoNat. +From Stdlib Require Import RatDef PeanoNat. From Stdlib Require Import Decimal DecimalFacts. From Stdlib Require Import Hexadecimal HexadecimalFacts HexadecimalPos HexadecimalZ. From Stdlib Require Import HexadecimalQ Rdefinitions. @@ -23,7 +23,7 @@ Lemma of_IQmake_to_hexadecimal num den : | None => True | Some (HexadecimalExp _ _ _) => False | Some (Hexadecimal i f) => - of_hexadecimal (Hexadecimal i f) = IRQ (QArith_base.Qmake num den) + of_hexadecimal (Hexadecimal i f) = IRQ (Qmake num den) end. Proof. unfold IQmake_to_hexadecimal. diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v index 9a4ad9a4c2..d35d3dbedb 100644 --- a/theories/PArith/BinPosDef.v +++ b/theories/PArith/BinPosDef.v @@ -24,7 +24,7 @@ From Stdlib Require Export BinNums BinNums.PosDef. Module Pos. -Include BinNums.PosDef.Pos. +Include PosDef.Pos. Definition t := positive. @@ -32,15 +32,6 @@ Definition t := positive. Infix "+" := add : positive_scope. -(** ** Predecessor *) - -Definition pred x := - match x with - | p~1 => p~0 - | p~0 => pred_double p - | 1 => 1 - end. - (** ** Predecessor with mask *) Definition pred_mask (p : mask) : mask := @@ -237,82 +228,6 @@ Fixpoint of_nat (n:nat) : positive := (** ** Conversion with a decimal representation for printing/parsing *) -#[local] Notation ten := 1~0~1~0. - -Fixpoint of_uint_acc (d:Decimal.uint)(acc:positive) := - match d with - | Decimal.Nil => acc - | Decimal.D0 l => of_uint_acc l (mul ten acc) - | Decimal.D1 l => of_uint_acc l (add 1 (mul ten acc)) - | Decimal.D2 l => of_uint_acc l (add 1~0 (mul ten acc)) - | Decimal.D3 l => of_uint_acc l (add 1~1 (mul ten acc)) - | Decimal.D4 l => of_uint_acc l (add 1~0~0 (mul ten acc)) - | Decimal.D5 l => of_uint_acc l (add 1~0~1 (mul ten acc)) - | Decimal.D6 l => of_uint_acc l (add 1~1~0 (mul ten acc)) - | Decimal.D7 l => of_uint_acc l (add 1~1~1 (mul ten acc)) - | Decimal.D8 l => of_uint_acc l (add 1~0~0~0 (mul ten acc)) - | Decimal.D9 l => of_uint_acc l (add 1~0~0~1 (mul ten acc)) - end. - -Fixpoint of_uint (d:Decimal.uint) : N := - match d with - | Decimal.Nil => N0 - | Decimal.D0 l => of_uint l - | Decimal.D1 l => Npos (of_uint_acc l 1) - | Decimal.D2 l => Npos (of_uint_acc l 1~0) - | Decimal.D3 l => Npos (of_uint_acc l 1~1) - | Decimal.D4 l => Npos (of_uint_acc l 1~0~0) - | Decimal.D5 l => Npos (of_uint_acc l 1~0~1) - | Decimal.D6 l => Npos (of_uint_acc l 1~1~0) - | Decimal.D7 l => Npos (of_uint_acc l 1~1~1) - | Decimal.D8 l => Npos (of_uint_acc l 1~0~0~0) - | Decimal.D9 l => Npos (of_uint_acc l 1~0~0~1) - end. - -#[local] Notation sixteen := 1~0~0~0~0. - -Fixpoint of_hex_uint_acc (d:Hexadecimal.uint)(acc:positive) := - match d with - | Hexadecimal.Nil => acc - | Hexadecimal.D0 l => of_hex_uint_acc l (mul sixteen acc) - | Hexadecimal.D1 l => of_hex_uint_acc l (add 1 (mul sixteen acc)) - | Hexadecimal.D2 l => of_hex_uint_acc l (add 1~0 (mul sixteen acc)) - | Hexadecimal.D3 l => of_hex_uint_acc l (add 1~1 (mul sixteen acc)) - | Hexadecimal.D4 l => of_hex_uint_acc l (add 1~0~0 (mul sixteen acc)) - | Hexadecimal.D5 l => of_hex_uint_acc l (add 1~0~1 (mul sixteen acc)) - | Hexadecimal.D6 l => of_hex_uint_acc l (add 1~1~0 (mul sixteen acc)) - | Hexadecimal.D7 l => of_hex_uint_acc l (add 1~1~1 (mul sixteen acc)) - | Hexadecimal.D8 l => of_hex_uint_acc l (add 1~0~0~0 (mul sixteen acc)) - | Hexadecimal.D9 l => of_hex_uint_acc l (add 1~0~0~1 (mul sixteen acc)) - | Hexadecimal.Da l => of_hex_uint_acc l (add 1~0~1~0 (mul sixteen acc)) - | Hexadecimal.Db l => of_hex_uint_acc l (add 1~0~1~1 (mul sixteen acc)) - | Hexadecimal.Dc l => of_hex_uint_acc l (add 1~1~0~0 (mul sixteen acc)) - | Hexadecimal.Dd l => of_hex_uint_acc l (add 1~1~0~1 (mul sixteen acc)) - | Hexadecimal.De l => of_hex_uint_acc l (add 1~1~1~0 (mul sixteen acc)) - | Hexadecimal.Df l => of_hex_uint_acc l (add 1~1~1~1 (mul sixteen acc)) - end. - -Fixpoint of_hex_uint (d:Hexadecimal.uint) : N := - match d with - | Hexadecimal.Nil => N0 - | Hexadecimal.D0 l => of_hex_uint l - | Hexadecimal.D1 l => Npos (of_hex_uint_acc l 1) - | Hexadecimal.D2 l => Npos (of_hex_uint_acc l 1~0) - | Hexadecimal.D3 l => Npos (of_hex_uint_acc l 1~1) - | Hexadecimal.D4 l => Npos (of_hex_uint_acc l 1~0~0) - | Hexadecimal.D5 l => Npos (of_hex_uint_acc l 1~0~1) - | Hexadecimal.D6 l => Npos (of_hex_uint_acc l 1~1~0) - | Hexadecimal.D7 l => Npos (of_hex_uint_acc l 1~1~1) - | Hexadecimal.D8 l => Npos (of_hex_uint_acc l 1~0~0~0) - | Hexadecimal.D9 l => Npos (of_hex_uint_acc l 1~0~0~1) - | Hexadecimal.Da l => Npos (of_hex_uint_acc l 1~0~1~0) - | Hexadecimal.Db l => Npos (of_hex_uint_acc l 1~0~1~1) - | Hexadecimal.Dc l => Npos (of_hex_uint_acc l 1~1~0~0) - | Hexadecimal.Dd l => Npos (of_hex_uint_acc l 1~1~0~1) - | Hexadecimal.De l => Npos (of_hex_uint_acc l 1~1~1~0) - | Hexadecimal.Df l => Npos (of_hex_uint_acc l 1~1~1~1) - end. - Definition of_num_uint (d:Number.uint) : N := match d with | Number.UIntDecimal d => of_uint d diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 3d40a3d502..389879f595 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -8,6 +8,7 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) +From Stdlib Require Export RatDef. From Stdlib Require Export BinInt. From Stdlib Require Export ZArithRing. From Stdlib Require Export ZArith.BinInt. @@ -20,7 +21,10 @@ From Stdlib Require ZArith_dec. (** Rationals are pairs of [Z] and [positive] numbers. *) -Record Q : Set := Qmake {Qnum : Z; Qden : positive}. +Notation Q := Q. +Notation Qmake := Qmake. +Notation Qnum := Qnum. +Notation Qden := Qden. Declare Scope hex_Q_scope. Delimit Scope hex_Q_scope with xQ. @@ -30,9 +34,6 @@ Delimit Scope Q_scope with Q. Bind Scope Q_scope with Q. Arguments Qmake _%_Z _%_positive. -Register Q as rat.Q.type. -Register Qmake as rat.Q.Qmake. - Open Scope Q_scope. Ltac simpl_mult := rewrite ?Pos2Z.inj_mul. @@ -177,11 +178,8 @@ Proof. apply Z.eq_dec. Defined. -Definition Qeq_bool x y := - (Z.eqb (Qnum x * QDen y) (Qnum y * QDen x))%Z. - -Definition Qle_bool x y := - (Z.leb (Qnum x * QDen y) (Qnum y * QDen x))%Z. +Notation Qeq_bool := Qeq_bool. +Notation Qle_bool := Qle_bool. Lemma Qeq_bool_iff x y : Qeq_bool x y = true <-> x == y. Proof. apply Z.eqb_eq. Qed. @@ -242,21 +240,11 @@ Hint Resolve Qnot_eq_sym : qarith. (** The addition, multiplication and opposite are defined in the straightforward way: *) -Definition Qplus (x y : Q) := - (Qnum x * QDen y + Qnum y * QDen x) # (Qden x * Qden y). - -Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y). - -Definition Qopp (x : Q) := (- Qnum x) # (Qden x). - -Definition Qminus (x y : Q) := Qplus x (Qopp y). - -Definition Qinv (x : Q) := - match Qnum x with - | Z0 => 0#1 - | Zpos p => (QDen x)#p - | Zneg p => (Zneg (Qden x))#p - end. +Notation Qplus := Qplus. +Notation Qmult := Qmult. +Notation Qopp := Qopp. +Notation Qminus := Qminus. +Notation Qinv := Qinv. Definition Qdiv (x y : Q) := Qmult x (Qinv y). @@ -1288,7 +1276,8 @@ Qed. Lemma Qmult_lt_0_compat : forall a b : Q, 0 < a -> 0 < b -> 0 < a * b. Proof. intros a b Ha Hb. - destruct a,b. unfold Qlt, Qmult, QArith_base.Qnum, QArith_base.Qden in *. + destruct a as [na da]; destruct b as [nb db]. + unfold Qlt, Qmult, Qnum, Qden in *. rewrite Pos2Z.inj_mul. rewrite Z.mul_0_l, Z.mul_1_r in *. apply Z.mul_pos_pos; assumption. @@ -1297,7 +1286,8 @@ Qed. Lemma Qmult_le_1_compat: forall a b : Q, 1 <= a -> 1 <= b -> 1 <= a * b. Proof. intros a b Ha Hb. - destruct a,b. unfold Qle, Qmult, QArith_base.Qnum, QArith_base.Qden in *. + destruct a as [na da]; destruct b as [nb db]. + unfold Qle, Qmult, Qnum, Qden in *. rewrite Pos2Z.inj_mul. rewrite Z.mul_1_l, Z.mul_1_r in *. apply Z.mul_le_mono_nonneg. @@ -1308,7 +1298,8 @@ Qed. Lemma Qmult_lt_1_compat: forall a b : Q, 1 < a -> 1 < b -> 1 < a * b. Proof. intros a b Ha Hb. - destruct a,b. unfold Qlt, Qmult, QArith_base.Qnum, QArith_base.Qden in *. + destruct a as [na da]; destruct b as [nb db]. + unfold Qlt, Qmult, Qnum, Qden in *. rewrite Pos2Z.inj_mul. rewrite Z.mul_1_l, Z.mul_1_r in *. apply Z.mul_lt_mono_nonneg. diff --git a/theories/Strings/PString.v b/theories/Strings/PString.v index 73f8e3d5b3..34bbb1de48 100644 --- a/theories/Strings/PString.v +++ b/theories/Strings/PString.v @@ -14,7 +14,7 @@ From Stdlib Require Import ZArith. #[local] Instance Op_max_length : ZifyClasses.CstOp max_length := { TCst := 16777211%Z ; TCstInj := eq_refl }. -Add Zify CstOp Op_max_length. +Add Tify CstOp Op_max_length. #[local] Ltac case_if := lazymatch goal with diff --git a/theories/dune b/theories/dune index c15615087c..3f3e31397d 100644 --- a/theories/dune +++ b/theories/dune @@ -1,7 +1,8 @@ (include_subdirs qualified) (coq.theory (name Stdlib) - (package rocq-stdlib)) + (package rocq-stdlib) + (theories micromega_plugin)) (env (dev diff --git a/theories/micromega/EnvRing.v b/theories/micromega/EnvRing.v index fb9f1ea13b..62750e61b4 100644 --- a/theories/micromega/EnvRing.v +++ b/theories/micromega/EnvRing.v @@ -11,67 +11,15 @@ For big polynomials, this is inefficient -- linear access. I have modified the code to use binary trees -- logarithmic access. *) - -Set Implicit Arguments. +From micromega_plugin Require Export formula witness eval checker. From Stdlib Require Import Setoid Morphisms Env BinPos BinNat BinInt. From Stdlib Require Export Ring_theory. +Set Implicit Arguments. + #[local] Open Scope positive_scope. Import RingSyntax. -(** Definition of polynomial expressions *) -#[universes(template)] -Inductive PExpr {C} : Type := -| PEc : C -> PExpr -| PEX : positive -> PExpr -| PEadd : PExpr -> PExpr -> PExpr -| PEsub : PExpr -> PExpr -> PExpr -| PEmul : PExpr -> PExpr -> PExpr -| PEopp : PExpr -> PExpr -| PEpow : PExpr -> N -> PExpr. -Arguments PExpr : clear implicits. - -Register PEc as micromega.PExpr.PEc. -Register PEX as micromega.PExpr.PEX. -Register PEadd as micromega.PExpr.PEadd. -Register PEsub as micromega.PExpr.PEsub. -Register PEmul as micromega.PExpr.PEmul. -Register PEopp as micromega.PExpr.PEopp. -Register PEpow as micromega.PExpr.PEpow. - - (* Definition of multivariable polynomials with coefficients in C : - Type [Pol] represents [X1 ... Xn]. - The representation is Horner's where a [n] variable polynomial - (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients - are polynomials with [n-1] variables (C[X2..Xn]). - There are several optimisations to make the repr compacter: - - [Pc c] is the constant polynomial of value c - == c*X1^0*..*Xn^0 - - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables. - variable indices are shifted of j in Q. - == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn} - - [PX P i Q] is an optimised Horner form of P*X^i + Q - with P not the null polynomial - == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn} - - In addition: - - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden - since they can be represented by the simpler form (PX P (i+j) Q) - - (Pinj i (Pinj j P)) is (Pinj (i+j) P) - - (Pinj i (Pc c)) is (Pc c) - *) - -#[universes(template)] -Inductive Pol {C} : Type := -| Pc : C -> Pol -| Pinj : positive -> Pol -> Pol -| PX : Pol -> positive -> Pol -> Pol. -Arguments Pol : clear implicits. - -Register Pc as micromega.Pol.Pc. -Register Pinj as micromega.Pol.Pinj. -Register PX as micromega.Pol.PX. - Section MakeRingPol. (* Ring elements *) @@ -155,275 +103,34 @@ Section MakeRingPol. Implicit Types pe : PExpr. Implicit Types P : Pol. - Definition P0 := Pc cO. - Definition P1 := Pc cI. - - Fixpoint Peq (P P' : Pol) {struct P'} : bool := - match P, P' with - | Pc c, Pc c' => c ?=! c' - | Pinj j Q, Pinj j' Q' => - match j ?= j' with - | Eq => Peq Q Q' - | _ => false - end - | PX P i Q, PX P' i' Q' => - match i ?= i' with - | Eq => if Peq P P' then Peq Q Q' else false - | _ => false - end - | _, _ => false - end. + #[local] Notation P0 := (P0 cO). + #[local] Notation P1 := (P1 cI). + #[local] Notation Peq := (Peq ceqb). + #[local] Notation mkPX := (mkPX cO ceqb). + #[local] Notation mk_X := (mkX cO cI). + #[local] Notation Popp := (Popp copp). + #[local] Notation PaddC := (PaddC cadd). + #[local] Notation PsubC := (PsubC csub). + #[local] Notation PaddI := (PaddI cadd). + #[local] Notation PaddX := (PaddX cO ceqb). + #[local] Notation Padd := (Padd cO cadd ceqb). + #[local] Notation PsubI := (PsubI cadd copp). + #[local] Notation PsubX := (PsubX cO copp ceqb). + #[local] Notation Psub := (Psub cO cadd csub copp ceqb). + #[local] Notation PmulC_aux := (PmulC_aux cO cmul ceqb). + #[local] Notation PmulC := (PmulC cO cI cmul ceqb). + #[local] Notation PmulI := (PmulI cO cI cmul ceqb). + #[local] Notation Pmul := (Pmul cO cI cadd cmul ceqb). + #[local] Notation Psquare := (Psquare cO cI cadd cmul ceqb). + #[local] Notation Ppow_pos := (Ppow_pos cO cI cadd cmul ceqb). + #[local] Notation norm_aux := (Pol_of_PExpr cO cI cadd cmul csub copp ceqb). Infix "?==" := Peq. - - Definition mkPinj j P := - match P with - | Pc _ => P - | Pinj j' Q => Pinj (j + j') Q - | _ => Pinj j P - end. - - Definition mkPinj_pred j P := - match j with - | xH => P - | xO j => Pinj (Pos.pred_double j) P - | xI j => Pinj (xO j) P - end. - - Definition mkPX P i Q := - match P with - | Pc c => if c ?=! cO then mkPinj xH Q else PX P i Q - | Pinj _ _ => PX P i Q - | PX P' i' Q' => if Q' ?== P0 then PX P' (i' + i) Q else PX P i Q - end. - - Definition mkXi i := PX P1 i P0. - - Definition mkX := mkXi 1. - - (** Opposite of addition *) - - Fixpoint Popp (P:Pol) : Pol := - match P with - | Pc c => Pc (-! c) - | Pinj j Q => Pinj j (Popp Q) - | PX P i Q => PX (Popp P) i (Popp Q) - end. - Notation "-- P" := (Popp P). - - (** Addition et subtraction *) - - Fixpoint PaddC (P:Pol) (c:C) : Pol := - match P with - | Pc c1 => Pc (c1 +! c) - | Pinj j Q => Pinj j (PaddC Q c) - | PX P i Q => PX P i (PaddC Q c) - end. - - Fixpoint PsubC (P:Pol) (c:C) : Pol := - match P with - | Pc c1 => Pc (c1 -! c) - | Pinj j Q => Pinj j (PsubC Q c) - | PX P i Q => PX P i (PsubC Q c) - end. - - Section PopI. - - Variable Pop : Pol -> Pol -> Pol. - Variable Q : Pol. - - Fixpoint PaddI (j:positive) (P:Pol) : Pol := - match P with - | Pc c => mkPinj j (PaddC Q c) - | Pinj j' Q' => - match Z.pos_sub j' j with - | Zpos k => mkPinj j (Pop (Pinj k Q') Q) - | Z0 => mkPinj j (Pop Q' Q) - | Zneg k => mkPinj j' (PaddI k Q') - end - | PX P i Q' => - match j with - | xH => PX P i (Pop Q' Q) - | xO j => PX P i (PaddI (Pos.pred_double j) Q') - | xI j => PX P i (PaddI (xO j) Q') - end - end. - - Fixpoint PsubI (j:positive) (P:Pol) : Pol := - match P with - | Pc c => mkPinj j (PaddC (--Q) c) - | Pinj j' Q' => - match Z.pos_sub j' j with - | Zpos k => mkPinj j (Pop (Pinj k Q') Q) - | Z0 => mkPinj j (Pop Q' Q) - | Zneg k => mkPinj j' (PsubI k Q') - end - | PX P i Q' => - match j with - | xH => PX P i (Pop Q' Q) - | xO j => PX P i (PsubI (Pos.pred_double j) Q') - | xI j => PX P i (PsubI (xO j) Q') - end - end. - - Variable P' : Pol. - - Fixpoint PaddX (i':positive) (P:Pol) : Pol := - match P with - | Pc c => PX P' i' P - | Pinj j Q' => - match j with - | xH => PX P' i' Q' - | xO j => PX P' i' (Pinj (Pos.pred_double j) Q') - | xI j => PX P' i' (Pinj (xO j) Q') - end - | PX P i Q' => - match Z.pos_sub i i' with - | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' - | Z0 => mkPX (Pop P P') i Q' - | Zneg k => mkPX (PaddX k P) i Q' - end - end. - - Fixpoint PsubX (i':positive) (P:Pol) : Pol := - match P with - | Pc c => PX (--P') i' P - | Pinj j Q' => - match j with - | xH => PX (--P') i' Q' - | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q') - | xI j => PX (--P') i' (Pinj (xO j) Q') - end - | PX P i Q' => - match Z.pos_sub i i' with - | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' - | Z0 => mkPX (Pop P P') i Q' - | Zneg k => mkPX (PsubX k P) i Q' - end - end. - - - End PopI. - - Fixpoint Padd (P P': Pol) {struct P'} : Pol := - match P' with - | Pc c' => PaddC P c' - | Pinj j' Q' => PaddI Padd Q' j' P - | PX P' i' Q' => - match P with - | Pc c => PX P' i' (PaddC Q' c) - | Pinj j Q => - match j with - | xH => PX P' i' (Padd Q Q') - | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q') - | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q') - end - | PX P i Q => - match Z.pos_sub i i' with - | Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q') - | Z0 => mkPX (Padd P P') i (Padd Q Q') - | Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q') - end - end - end. Infix "++" := Padd. - - Fixpoint Psub (P P': Pol) {struct P'} : Pol := - match P' with - | Pc c' => PsubC P c' - | Pinj j' Q' => PsubI Psub Q' j' P - | PX P' i' Q' => - match P with - | Pc c => PX (--P') i' (*(--(PsubC Q' c))*) (PaddC (--Q') c) - | Pinj j Q => - match j with - | xH => PX (--P') i' (Psub Q Q') - | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q') - | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q') - end - | PX P i Q => - match Z.pos_sub i i' with - | Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q') - | Z0 => mkPX (Psub P P') i (Psub Q Q') - | Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q') - end - end - end. Infix "--" := Psub. - - (** Multiplication *) - - Fixpoint PmulC_aux (P:Pol) (c:C) : Pol := - match P with - | Pc c' => Pc (c' *! c) - | Pinj j Q => mkPinj j (PmulC_aux Q c) - | PX P i Q => mkPX (PmulC_aux P c) i (PmulC_aux Q c) - end. - - Definition PmulC P c := - if c ?=! cO then P0 else - if c ?=! cI then P else PmulC_aux P c. - - Section PmulI. - Variable Pmul : Pol -> Pol -> Pol. - Variable Q : Pol. - Fixpoint PmulI (j:positive) (P:Pol) : Pol := - match P with - | Pc c => mkPinj j (PmulC Q c) - | Pinj j' Q' => - match Z.pos_sub j' j with - | Zpos k => mkPinj j (Pmul (Pinj k Q') Q) - | Z0 => mkPinj j (Pmul Q' Q) - | Zneg k => mkPinj j' (PmulI k Q') - end - | PX P' i' Q' => - match j with - | xH => mkPX (PmulI xH P') i' (Pmul Q' Q) - | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q') - | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q') - end - end. - - End PmulI. - - Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol := - match P'' with - | Pc c => PmulC P c - | Pinj j' Q' => PmulI Pmul Q' j' P - | PX P' i' Q' => - match P with - | Pc c => PmulC P'' c - | Pinj j Q => - let QQ' := - match j with - | xH => Pmul Q Q' - | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q' - | xI j => Pmul (Pinj (xO j) Q) Q' - end in - mkPX (Pmul P P') i' QQ' - | PX P i Q=> - let QQ' := Pmul Q Q' in - let PQ' := PmulI Pmul Q' xH P in - let QP' := Pmul (mkPinj xH Q) P' in - let PP' := Pmul P P' in - (mkPX (mkPX PP' i P0 ++ QP') i' P0) ++ mkPX PQ' i QQ' - end - end. - Infix "**" := Pmul. - Fixpoint Psquare (P:Pol) : Pol := - match P with - | Pc c => Pc (c *! c) - | Pinj j Q => Pinj j (Psquare Q) - | PX P i Q => - let twoPQ := Pmul P (mkPinj xH (PmulC Q (cI +! cI))) in - let Q2 := Psquare Q in - let P2 := Psquare P in - mkPX (mkPX P2 i P0 ++ twoPQ) i Q2 - end. - (** Monomial **) (** A monomial is X1^k1...Xi^ki. Its representation @@ -971,21 +678,10 @@ Qed. rewrite <- IHm; auto. Qed. - (** evaluation of polynomial expressions towards R *) - Definition mk_X j := mkPinj_pred j mkX. - (** evaluation of polynomial expressions towards R *) - Fixpoint PEeval (l:Env R) (pe:PExpr) : R := - match pe with - | PEc c => phi c - | PEX j => nth j l - | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2) - | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2) - | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2) - | PEopp pe1 => - (PEeval l pe1) - | PEpow pe1 n => rpow (PEeval l pe1) (Cp_phi n) - end. + #[local] Notation PEeval := (PEeval + rO rI radd rmul rsub ropp Cp_phi rpow phi (@nth R)). (** Correctness proofs *) @@ -1001,18 +697,6 @@ Qed. Section POWER. Variable subst_l : Pol -> Pol. - Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol := - match p with - | xH => subst_l (res ** P) - | xO p => Ppow_pos (Ppow_pos res P p) P p - | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P) - end. - - Definition Ppow_N P n := - match n with - | N0 => P1 - | Npos p => Ppow_pos P1 P p - end. Lemma Ppow_pos_ok l : (forall P, subst_l P@l == P@l) -> @@ -1023,6 +707,8 @@ Section POWER. mul_permut. Qed. + #[local] Notation Ppow_N := (Ppow_N cO cI cadd cmul ceqb). + Lemma Ppow_N_ok l : (forall P, subst_l P@l == P@l) -> forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l. @@ -1043,20 +729,6 @@ Section POWER. Let Pmul_subst P1 P2 := subst_l (Pmul P1 P2). Let Ppow_subst := Ppow_N subst_l. - Fixpoint norm_aux (pe:PExpr) : Pol := - match pe with - | PEc c => Pc c - | PEX j => mk_X j - | PEadd (PEopp pe1) pe2 => Psub (norm_aux pe2) (norm_aux pe1) - | PEadd pe1 (PEopp pe2) => - Psub (norm_aux pe1) (norm_aux pe2) - | PEadd pe1 pe2 => Padd (norm_aux pe1) (norm_aux pe2) - | PEsub pe1 pe2 => Psub (norm_aux pe1) (norm_aux pe2) - | PEmul pe1 pe2 => Pmul (norm_aux pe1) (norm_aux pe2) - | PEopp pe1 => Popp (norm_aux pe1) - | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n - end. - Definition norm_subst pe := subst_l (norm_aux pe). (** Internally, [norm_aux] is expanded in a large number of cases. @@ -1077,7 +749,7 @@ Section POWER. end. Proof. simpl (norm_aux (PEadd _ _)). - destruct pe1; [ | | | | | reflexivity | ]; + destruct pe1; [ | | | | | | | reflexivity | ]; destruct pe2; simpl get_PEopp; reflexivity. Qed. @@ -1094,7 +766,9 @@ Section POWER. PEeval l pe == (norm_aux pe)@l. Proof. intros. - induction pe as [| |pe1 IHpe1 pe2 IHpe2|? IHpe1 ? IHpe2|? IHpe1 ? IHpe2|? IHpe|? IHpe n0]. + induction pe as [| | | |pe1 IHpe1 pe2 IHpe2|? IHpe1 ? IHpe2|? IHpe1 ? IHpe2|? IHpe|? IHpe n0]. + - now rewrite (morph0 CRmorph). + - now rewrite (morph1 CRmorph). - reflexivity. - apply mkX_ok. - simpl PEeval. rewrite IHpe1, IHpe2. @@ -1105,7 +779,7 @@ Section POWER. - simpl. rewrite IHpe1, IHpe2. Esimpl. - simpl. rewrite IHpe1, IHpe2. now rewrite Pmul_ok. - simpl. rewrite IHpe. Esimpl. - - simpl. rewrite Ppow_N_ok by reflexivity. + - simpl. rewrite (Ppow_N_ok id) by reflexivity. rewrite (rpow_pow_N pow_th). destruct n0 as [|p]; simpl; Esimpl. induction p as [p IHp|p IHp|];simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. Qed. @@ -1113,3 +787,6 @@ Section POWER. End NORM_SUBST_REC. End MakeRingPol. + +Notation PEeval := (fun rO rI add mul sub opp phi pow_phi pow => PEeval + rO rI add mul sub opp pow_phi pow phi (@Env.nth _)). diff --git a/theories/micromega/Lia.v b/theories/micromega/Lia.v index 7ea3ecac5b..f17ee3a0fc 100644 --- a/theories/micromega/Lia.v +++ b/theories/micromega/Lia.v @@ -16,8 +16,7 @@ From Stdlib Require Import BinInt. From Stdlib.micromega Require Import Tauto VarMap ZMicromega Zify. -Declare ML Module "rocq-runtime.plugins.micromega_core". -Declare ML Module "rocq-runtime.plugins.micromega". +From micromega_plugin Require Export tactics. Ltac zchecker := let __wit := fresh "__wit" in @@ -28,6 +27,6 @@ Ltac zchecker := (@eq_refl bool true <: @eq bool (ZTautoChecker __ff __wit) true) (@find Z Z0 __varmap)). -Ltac lia := Zify.zify; xlia zchecker. +Ltac lia := Zify.zify; mp_lia zchecker. -Ltac nia := Zify.zify; xnia zchecker. +Ltac nia := Zify.zify; mp_nia zchecker. diff --git a/theories/micromega/Lqa.v b/theories/micromega/Lqa.v index f2a71f288d..dc007660a4 100644 --- a/theories/micromega/Lqa.v +++ b/theories/micromega/Lqa.v @@ -20,8 +20,7 @@ From Stdlib Require Import RingMicromega. From Stdlib Require Import VarMap. From Stdlib Require Import DeclConstant. From Stdlib.micromega Require Tauto. -Declare ML Module "rocq-runtime.plugins.micromega_core". -Declare ML Module "rocq-runtime.plugins.micromega". +From micromega_plugin Require Export tactics. Ltac rchange := let __wit := fresh "__wit" in @@ -37,15 +36,15 @@ Ltac rchecker_abstract := rchange ; vm_cast_no_check (eq_refl true). Ltac rchecker := rchecker_no_abstract. (** Here, lra stands for linear rational arithmetic *) -Ltac lra := xlra_Q rchecker. +Ltac lra := mp_lra_Q rchecker. (** Here, nra stands for non-linear rational arithmetic *) -Ltac nra := xnra_Q rchecker. +Ltac nra := mp_nra_Q rchecker. Ltac xpsatz dom d := let tac := lazymatch dom with | Q => - ((xsos_Q rchecker) || (xpsatz_Q d rchecker)) + ((mp_sos_Q rchecker) || (mp_psatz_Q d rchecker)) | _ => fail "Unsupported domain" end in tac. diff --git a/theories/micromega/Lra.v b/theories/micromega/Lra.v index 46f80c5d5a..610ff65f4e 100644 --- a/theories/micromega/Lra.v +++ b/theories/micromega/Lra.v @@ -21,8 +21,7 @@ From Stdlib Require Import RingMicromega. From Stdlib Require Import VarMap. From Stdlib.micromega Require Tauto. From Stdlib Require Import Rregisternames. - -Declare ML Module "rocq-runtime.plugins.micromega". +From micromega_plugin Require Export tactics. Ltac rchange := let __wit := fresh "__wit" in @@ -38,15 +37,15 @@ Ltac rchecker_abstract := rchange ; vm_cast_no_check (eq_refl true). Ltac rchecker := rchecker_no_abstract. (** Here, lra stands for linear real arithmetic *) -Ltac lra := unfold Rdiv in * ; xlra_R rchecker. +Ltac lra := unfold Rdiv in * ; mp_lra_R rchecker. (** Here, nra stands for non-linear real arithmetic *) -Ltac nra := unfold Rdiv in * ; xnra_R rchecker. +Ltac nra := unfold Rdiv in * ; mp_nra_R rchecker. Ltac xpsatz dom d := let tac := lazymatch dom with | R => - (xsos_R rchecker) || (xpsatz_R d rchecker) + (mp_sos_R rchecker) || (mp_psatz_R d rchecker) | _ => fail "Unsupported domain" end in tac. diff --git a/theories/micromega/Psatz.v b/theories/micromega/Psatz.v index 48d7d444fd..72b2f7175b 100644 --- a/theories/micromega/Psatz.v +++ b/theories/micromega/Psatz.v @@ -26,8 +26,7 @@ From Stdlib.micromega Require Tauto. From Stdlib Require Lia. From Stdlib Require Lra. From Stdlib Require Lqa. - -Declare ML Module "rocq-runtime.plugins.micromega". +From micromega_plugin Require Export tactics. Ltac lia := Lia.lia. @@ -35,9 +34,9 @@ Ltac nia := Lia.nia. Ltac xpsatz dom d := let tac := lazymatch dom with - | Z => (xsos_Z Lia.zchecker) || (xpsatz_Z d Lia.zchecker) - | R => (xsos_R Lra.rchecker) || (xpsatz_R d Lra.rchecker) - | Q => (xsos_Q Lqa.rchecker) || (xpsatz_Q d Lqa.rchecker) + | Z => (mp_sos_Z Lia.zchecker) || (mp_psatz_Z d Lia.zchecker) + | R => (mp_sos_R Lra.rchecker) || (mp_psatz_R d Lra.rchecker) + | Q => (mp_sos_Q Lqa.rchecker) || (mp_psatz_Q d Lqa.rchecker) | _ => fail "Unsupported domain" end in tac. diff --git a/theories/micromega/QMicromega.v b/theories/micromega/QMicromega.v index c823961e09..a82d4873c4 100644 --- a/theories/micromega/QMicromega.v +++ b/theories/micromega/QMicromega.v @@ -64,33 +64,10 @@ Qed. (*Definition Zeval_expr := eval_pexpr 0 Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => Z.of_N x) (Z.pow).*) From Stdlib Require Import EnvRing. -Fixpoint Qeval_expr (env: PolEnv Q) (e: PExpr Q) : Q := - match e with - | PEc c => c - | PEX j => env j - | PEadd pe1 pe2 => (Qeval_expr env pe1) + (Qeval_expr env pe2) - | PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2) - | PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2) - | PEopp pe1 => - (Qeval_expr env pe1) - | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z.of_N n) - end. +#[local] Notation Qeval_expr := (PEeval + Q0 Q1 Qplus Qmult Qminus Qopp id Z.of_N Qpower). -Lemma Qeval_expr_simpl : forall env e, - Qeval_expr env e = - match e with - | PEc c => c - | PEX j => env j - | PEadd pe1 pe2 => (Qeval_expr env pe1) + (Qeval_expr env pe2) - | PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2) - | PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2) - | PEopp pe1 => - (Qeval_expr env pe1) - | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z.of_N n) - end. -Proof. - destruct e ; reflexivity. -Qed. - -Definition Qeval_expr' := eval_pexpr Qplus Qmult Qminus Qopp (fun x => x) (fun x => x) (pow_N 1 Qmult). +Definition Qeval_expr' := eval_pexpr Q0 Q1 Qplus Qmult Qminus Qopp (fun x => x) (fun x => x) (pow_N 1 Qmult). Lemma QNpower : forall r n, r ^ Z.of_N n = pow_N 1 Qmult r n. Proof. @@ -100,10 +77,9 @@ Qed. Lemma Qeval_expr_compat : forall env e, Qeval_expr env e = Qeval_expr' env e. Proof. - induction e ; simpl ; subst ; try congruence. - - reflexivity. - - rewrite IHe. - apply QNpower. + induction e ; simpl ; subst ; try congruence; try reflexivity. + rewrite IHe. + apply QNpower. Qed. Definition Qeval_pop2 (o : Op2) : Q -> Q -> Prop := @@ -153,8 +129,8 @@ Proof. - apply Qlt_bool_iff. Qed. -Definition Qeval_op2 (k:Tauto.kind) : Op2 -> Q -> Q -> Tauto.rtyp k:= - if k as k0 return (Op2 -> Q -> Q -> Tauto.rtyp k0) +Definition Qeval_op2 (k:kind) : Op2 -> Q -> Q -> eKind k:= + if k as k0 return (Op2 -> Q -> Q -> eKind k0) then Qeval_pop2 else Qeval_bop2. @@ -166,11 +142,11 @@ Proof. - simpl. apply pop2_bop2. Qed. -Definition Qeval_formula (e:PolEnv Q) (k: Tauto.kind) (ff : Formula Q) := +Definition Qeval_formula (e:PolEnv Q) (k: kind) (ff : Formula Q) := let (lhs,o,rhs) := ff in Qeval_op2 k o (Qeval_expr e lhs) (Qeval_expr e rhs). Definition Qeval_formula' := - eval_formula Qplus Qmult Qminus Qopp Qeq Qle Qlt (fun x => x) (fun x => x) (pow_N 1 Qmult). + eval_formula Q0 Q1 Qplus Qmult Qminus Qopp Qeq Qle Qlt (fun x => x) (fun x => x) (pow_N 1 Qmult). Lemma Qeval_formula_compat : forall env b f, Tauto.hold b (Qeval_formula env b f) <-> Qeval_formula' env f. Proof. @@ -203,12 +179,8 @@ Proof. exact (fun env d =>eval_nformula_dec Qsor (fun x => x) env d). Qed. -Definition QWitness := Psatz Q. - -Register QWitness as micromega.QWitness.type. - - -Definition QWeakChecker := check_normalised_formulas 0 1 Qplus Qmult Qeq_bool Qle_bool. +#[local] Notation QWeakChecker := (CWeakChecker + Q0 Q1 Qplus Qmult Qeq_bool Qle_bool). From Stdlib Require Import List. @@ -226,27 +198,18 @@ Qed. From Stdlib.micromega Require Import Tauto. -Definition Qnormalise := @cnf_normalise Q 0 1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. - -Definition Qnegate := @cnf_negate Q 0 1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. - -Definition qunsat := check_inconsistent 0 Qeq_bool Qle_bool. - -Definition qdeduce := nformula_plus_nformula 0 Qplus Qeq_bool. +#[local] Notation Qnormalise := (Cnormalise + Q0 Q1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool). +#[local] Notation Qnegate := (Cnegate + Q0 Q1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool). +#[local] Notation qunsat := (check_inconsistent Q0 Qeq_bool Qle_bool). +#[local] Notation qdeduce := (nformula_plus_nformula Q0 Qplus Qeq_bool). Definition normQ := norm 0 1 Qplus Qmult Qminus Qopp Qeq_bool. Declare Equivalent Keys normQ RingMicromega.norm. -Definition cnfQ (Annot:Type) (TX: Tauto.kind -> Type) (AF: Type) (k: Tauto.kind) (f: TFormula (Formula Q) Annot TX AF k) := - rxcnf qunsat qdeduce (Qnormalise Annot) (Qnegate Annot) true f. - -Definition QTautoChecker (f : BFormula (Formula Q) Tauto.isProp) (w: list QWitness) : bool := - @tauto_checker (Formula Q) (NFormula Q) unit - qunsat qdeduce - (Qnormalise unit) - (Qnegate unit) QWitness (fun cl => QWeakChecker (List.map fst cl)) f w. - - +Definition cnfQ (Annot:Type) (TX: kind -> Type) (AF: Type) (k: kind) (f: @GFormula (Formula Q) TX Annot AF k) := + rxcnf qunsat qdeduce (@Qnormalise Annot) (@Qnegate Annot) true f. Lemma QTautoChecker_sound : forall f w, QTautoChecker f w = true -> forall env, eval_bf (Qeval_formula env) f. Proof. diff --git a/theories/micromega/RMicromega.v b/theories/micromega/RMicromega.v index 20be99ead1..65ca8b01d1 100644 --- a/theories/micromega/RMicromega.v +++ b/theories/micromega/RMicromega.v @@ -378,7 +378,7 @@ Definition INZ (n:N) : R := | Npos p => IZR (Zpos p) end. -Definition Reval_expr := eval_pexpr Rplus Rmult Rminus Ropp R_of_Rcst N.to_nat pow. +Definition Reval_expr := eval_pexpr R0 R1 Rplus Rmult Rminus Ropp R_of_Rcst N.to_nat pow. Definition Reval_pop2 (o:Op2) : R -> R -> Prop := @@ -419,8 +419,8 @@ Proof. - apply Rlt_not_le in H. tauto. Qed. -Definition Reval_op2 (k: Tauto.kind) : Op2 -> R -> R -> Tauto.rtyp k:= - if k as k0 return (Op2 -> R -> R -> Tauto.rtyp k0) +Definition Reval_op2 (k: kind) : Op2 -> R -> R -> eKind k:= + if k as k0 return (Op2 -> R -> R -> eKind k0) then Reval_pop2 else Reval_bop2. Lemma Reval_op2_hold : forall b op q1 q2, @@ -431,16 +431,16 @@ Proof. - simpl. apply pop2_bop2. Qed. -Definition Reval_formula (e: PolEnv R) (k: Tauto.kind) (ff : Formula Rcst) := +Definition Reval_formula (e: PolEnv R) (k: kind) (ff : Formula Rcst) := let (lhs,o,rhs) := ff in Reval_op2 k o (Reval_expr e lhs) (Reval_expr e rhs). Definition Reval_formula' := - eval_sformula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt N.to_nat pow R_of_Rcst. + eval_sformula R0 R1 Rplus Rmult Rminus Ropp (@eq R) Rle Rlt N.to_nat pow R_of_Rcst. Lemma Reval_pop2_eval_op2 : forall o e1 e2, Reval_pop2 o e1 e2 <-> - eval_op2 eq Rle Rlt o e1 e2. + eval_op2 isProp eq (fun x y => x <> y) Rle Rlt o e1 e2. Proof. destruct o ; simpl ; try tauto. split. @@ -459,14 +459,14 @@ Proof. apply Reval_pop2_eval_op2. Qed. -Definition QReval_expr := eval_pexpr Rplus Rmult Rminus Ropp Q2R N.to_nat pow. +Definition QReval_expr := eval_pexpr R0 R1 Rplus Rmult Rminus Ropp Q2R N.to_nat pow. -Definition QReval_formula (e: PolEnv R) (k: Tauto.kind) (ff : Formula Q) := +Definition QReval_formula (e: PolEnv R) (k: kind) (ff : Formula Q) := let (lhs,o,rhs) := ff in Reval_op2 k o (QReval_expr e lhs) (QReval_expr e rhs). Definition QReval_formula' := - eval_formula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt Q2R N.to_nat pow. + eval_formula R0 R1 Rplus Rmult Rminus Ropp (@eq R) Rle Rlt Q2R N.to_nat pow. Lemma QReval_formula_compat : forall env b f, Tauto.hold b (QReval_formula env b f) <-> QReval_formula' env f. Proof. @@ -489,7 +489,8 @@ Qed. Definition RWitness := Psatz Q. -Definition RWeakChecker := check_normalised_formulas 0%Q 1%Q Qplus Qmult Qeq_bool Qle_bool. +#[local] Notation RWeakChecker := (CWeakChecker + Q0 Q1 Qplus Qmult Qeq_bool Qle_bool). From Stdlib Require Import List. @@ -507,18 +508,11 @@ Qed. From Stdlib.micromega Require Import Tauto. -Definition Rnormalise := @cnf_normalise Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. -Definition Rnegate := @cnf_negate Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. +#[local] Notation Qcnf_of_GFormula := (Ccnf_of_GFormula + Q0 Q1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool). -Definition runsat := check_inconsistent 0%Q Qeq_bool Qle_bool. - -Definition rdeduce := nformula_plus_nformula 0%Q Qplus Qeq_bool. - -Definition RTautoChecker (f : BFormula (Formula Rcst) Tauto.isProp) (w: list RWitness) : bool := - @tauto_checker (Formula Q) (NFormula Q) - unit runsat rdeduce - (Rnormalise unit) (Rnegate unit) - RWitness (fun cl => RWeakChecker (List.map fst cl)) (map_bformula (map_Formula Q_of_Rcst) f) w. +Definition RTautoChecker (f : BFormula (Formula Rcst) isProp) (w: list RWitness) : bool := + checker.tauto_checker (fun cl => RWeakChecker (List.map fst cl)) (Qcnf_of_GFormula (GFmap (Fmap Q_of_Rcst) f)) w. Lemma RTautoChecker_sound : forall f w, RTautoChecker f w = true -> forall env, eval_bf (Reval_formula env) f. Proof. @@ -526,7 +520,7 @@ Proof. unfold RTautoChecker. intros TC env. apply tauto_checker_sound with (eval:=QReval_formula) (eval':= Qeval_nformula) (env := env) in TC. - - change (eval_f e_rtyp (QReval_formula env)) + - change (GFeval eqb e_eKind (QReval_formula env)) with (eval_bf (QReval_formula env)) in TC. rewrite eval_bf_map in TC. @@ -544,8 +538,7 @@ Proof. - apply Reval_nformula_dec. - destruct t. apply (check_inconsistent_sound Rsor QSORaddon) ; auto. - - unfold rdeduce. - intros. revert H. + - intros. revert H. eapply (nformula_plus_nformula_correct Rsor QSORaddon); eauto. - intros. diff --git a/theories/micromega/RingMicromega.v b/theories/micromega/RingMicromega.v index a0d043ebc4..21bdbf773a 100644 --- a/theories/micromega/RingMicromega.v +++ b/theories/micromega/RingMicromega.v @@ -23,7 +23,7 @@ From Stdlib Require Import List. From Stdlib Require Import Bool. From Stdlib Require Import OrderedRing. From Stdlib Require Import Refl. -From Stdlib.micromega Require Tauto. +From Stdlib.micromega Require Import Tauto. Set Implicit Arguments. @@ -114,8 +114,8 @@ Proof. exact (rminus_morph sor). (* We already proved that minus is a morphism in OrderedRing.v *) Qed. -Definition cneqb (x y : C) := negb (ceqb x y). -Definition cltb (x y : C) := (cleb x y) && (cneqb x y). +#[local] Notation cneqb := (cneqb ceqb). +#[local] Notation cltb := (cltb ceqb cleb). Notation "x [~=] y" := (cneqb x y). Notation "x [<] y" := (cltb x y). @@ -149,13 +149,7 @@ Definition PolEnv := Env R. (* For interpreting PolC *) Definition eval_pol : PolEnv -> PolC -> R := Pphi rplus rtimes phi. -Inductive Op1 : Set := (* relations with 0 *) -| Equal (* == 0 *) -| NonEqual (* ~= 0 *) -| Strict (* > 0 *) -| NonStrict (* >= 0 *). - -Definition NFormula := (PolC * Op1)%type. (* normalized formula *) +#[local] Notation NFormula := (NFormula C). Definition eval_op1 (o : Op1) : R -> Prop := match o with @@ -172,47 +166,6 @@ let (p, op) := f in eval_op1 op (eval_pol env p). (** Rule of "signs" for addition and multiplication. An arbitrary result is coded buy None. *) -Definition OpMult (o o' : Op1) : option Op1 := -match o with -| Equal => Some Equal -| NonStrict => - match o' with - | Equal => Some Equal - | NonEqual => None - | Strict => Some NonStrict - | NonStrict => Some NonStrict - end -| Strict => match o' with - | NonEqual => None - | _ => Some o' - end -| NonEqual => match o' with - | Equal => Some Equal - | NonEqual => Some NonEqual - | _ => None - end -end. - -Definition OpAdd (o o': Op1) : option Op1 := - match o with - | Equal => Some o' - | NonStrict => - match o' with - | Strict => Some Strict - | NonEqual => None - | _ => Some NonStrict - end - | Strict => match o' with - | NonEqual => None - | _ => Some Strict - end - | NonEqual => match o' with - | Equal => Some NonEqual - | _ => None - end - end. - - Lemma OpMult_sound : forall (o o' om: Op1) (x y : R), eval_op1 o x -> eval_op1 o' y -> OpMult o o' = Some om -> eval_op1 om (x * y). @@ -224,8 +177,6 @@ unfold eval_op1; intros o; destruct o; simpl; intros o' om x y H1 H2 H3. destruct o' ; inversion H3. + (* y == 0 *) rewrite H2. now rewrite (Rtimes_0_r sor). - + (* y ~= 0 *) - apply (Rtimes_neq_0 sor) ; auto. - (* 0 < x *) destruct o' ; inversion H3. + (* y == 0 *) @@ -291,25 +242,7 @@ unfold eval_op1; intros o; destruct o; simpl; intros o' oa e e' H1 H2 Hoa. now apply (Rplus_nonneg_nonneg sor). Qed. -Inductive Psatz : Type := -| PsatzLet: Psatz -> Psatz -> Psatz -| PsatzIn : nat -> Psatz -| PsatzSquare : PolC -> Psatz -| PsatzMulC : PolC -> Psatz -> Psatz -| PsatzMulE : Psatz -> Psatz -> Psatz -| PsatzAdd : Psatz -> Psatz -> Psatz -| PsatzC : C -> Psatz -| PsatzZ : Psatz. - -Register PsatzLet as micromega.Psatz.PsatzLet. -Register PsatzIn as micromega.Psatz.PsatzIn. -Register PsatzSquare as micromega.Psatz.PsatzSquare. -Register PsatzMulC as micromega.Psatz.PsatzMulC. -Register PsatzMulE as micromega.Psatz.PsatzMulE. -Register PsatzAdd as micromega.Psatz.PsatzAdd. -Register PsatzC as micromega.Psatz.PsatzC. -Register PsatzZ as micromega.Psatz.PsatzZ. - +#[local] Notation Psatz := (Psatz C). (** Given a list [l] of NFormula and an extended polynomial expression [e], if [eval_Psatz l e] succeeds (= Some f) then [f] is a @@ -317,64 +250,15 @@ Register PsatzZ as micromega.Psatz.PsatzZ. Moreover, the polynomial expression is obtained by replacing the (PsatzIn n) by the nth polynomial expression in [l] and the sign is computed by the "rule of sign" *) -(* Might be defined elsewhere *) -Definition map_option (A B:Type) (f : A -> option B) (o : option A) : option B := - match o with - | None => None - | Some x => f x - end. - -Arguments map_option [A B] f o. - -Definition map_option2 (A B C : Type) (f : A -> B -> option C) - (o: option A) (o': option B) : option C := - match o , o' with - | None , _ => None - | _ , None => None - | Some x , Some x' => f x x' - end. - -Arguments map_option2 [A B C] f o o'. - Definition Rops_wd := mk_reqe (*rplus rtimes ropp req*) (SORplus_wd sor) (SORtimes_wd sor) (SORopp_wd sor). -Definition pexpr_times_nformula (e: PolC) (f : NFormula) : option NFormula := - let (ef,o) := f in - match o with - | Equal => Some (Pmul cO cI cplus ctimes ceqb e ef , Equal) - | _ => None - end. - -Definition nformula_times_nformula (f1 f2 : NFormula) : option NFormula := - let (e1,o1) := f1 in - let (e2,o2) := f2 in - map_option (fun x => (Some (Pmul cO cI cplus ctimes ceqb e1 e2,x))) (OpMult o1 o2). - - Definition nformula_plus_nformula (f1 f2 : NFormula) : option NFormula := - let (e1,o1) := f1 in - let (e2,o2) := f2 in - map_option (fun x => (Some (Padd cO cplus ceqb e1 e2,x))) (OpAdd o1 o2). - - -Fixpoint eval_Psatz (l : list NFormula) (e : Psatz) {struct e} : option NFormula := - match e with - | PsatzLet p1 p2 => match eval_Psatz l p1 with - | None => None - | Some f => eval_Psatz (f::l) p2 - end - | PsatzIn n => Some (nth n l (Pc cO, Equal)) - | PsatzSquare e => Some (Psquare cO cI cplus ctimes ceqb e , NonStrict) - | PsatzMulC re e => map_option (pexpr_times_nformula re) (eval_Psatz l e) - | PsatzMulE f1 f2 => map_option2 nformula_times_nformula (eval_Psatz l f1) (eval_Psatz l f2) - | PsatzAdd f1 f2 => map_option2 nformula_plus_nformula (eval_Psatz l f1) (eval_Psatz l f2) - | PsatzC c => if cltb cO c then Some (Pc c, Strict) else None -(* This could be 0, or <> 0 -- but these cases are useless *) - | PsatzZ => Some (Pc cO, Equal) (* Just to make life easier *) - end. - +#[local] Notation pexpr_times_nformula := (pexpr_times_nformula cO cI cplus ctimes ceqb). +#[local] Notation nformula_times_nformula := (nformula_times_nformula cO cI cplus ctimes ceqb). +#[local] Notation nformula_plus_nformula := (nformula_plus_nformula cO cplus ceqb). +#[local] Notation eval_Psatz := (eval_Psatz cO cI cplus ctimes ceqb cleb). Lemma pexpr_times_nformula_correct : forall (env: PolEnv) (e: PolC) (f f' : NFormula), eval_nformula env f -> pexpr_times_nformula e f = Some f' -> @@ -508,19 +392,19 @@ Qed. Fixpoint xhyps_of_psatz (base:nat) (acc : list nat) (prf : Psatz) : list nat := match prf with - | PsatzC _ | PsatzZ | PsatzSquare _ => acc + | PsatzC _ | PsatzZ _ | PsatzSquare _ => acc | PsatzMulC _ prf => xhyps_of_psatz base acc prf | PsatzAdd e1 e2 | PsatzMulE e1 e2 => xhyps_of_psatz base (xhyps_of_psatz base acc e2) e1 - | PsatzIn n => if ge_bool n base then (n::acc) else acc + | PsatzIn _ n => if ge_bool n base then (n::acc) else acc | PsatzLet e1 e2 => xhyps_of_psatz base (xhyps_of_psatz (S base) acc e2) e1 end. Fixpoint nhyps_of_psatz (base:nat) (prf : Psatz) : list nat := match prf with - | PsatzC _ | PsatzZ | PsatzSquare _ => nil + | PsatzC _ | PsatzZ _ | PsatzSquare _ => nil | PsatzMulC _ prf => nhyps_of_psatz base prf | PsatzAdd e1 e2 | PsatzMulE e1 e2 => nhyps_of_psatz base e1 ++ nhyps_of_psatz base e2 - | PsatzIn n => if ge_bool n base then (n::nil) else nil + | PsatzIn _ n => if ge_bool n base then (n::nil) else nil | PsatzLet e1 e2 => nhyps_of_psatz base e1 ++ nhyps_of_psatz (S base) e2 end. @@ -568,22 +452,7 @@ Definition PaddC_ok : forall c P env, eval_pol env (paddC P c) == eval_pol env PaddC_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon). - -(* Check that a formula f is inconsistent by normalizing and comparing the -resulting constant with 0 *) - -Definition check_inconsistent (f : NFormula) : bool := -let (e, op) := f in - match e with - | Pc c => - match op with - | Equal => cneqb c cO - | NonStrict => c [<] cO - | Strict => c [<=] cO - | NonEqual => c [=] cO - end - | _ => false (* not a constant *) - end. +#[local] Notation check_inconsistent := (check_inconsistent cO ceqb cleb). Lemma check_inconsistent_sound : forall (p : PolC) (op : Op1), @@ -600,13 +469,7 @@ try rewrite <- (morph0 (SORrm addon)); trivial. - apply cltb_sound in H1. now apply -> (Rlt_nge sor). Qed. - -Definition check_normalised_formulas : list NFormula -> Psatz -> bool := - fun l cm => - match eval_Psatz l cm with - | None => false - | Some f => check_inconsistent f - end. +#[local] Notation check_normalised_formulas := (check_normalised_formulas cO cI cplus ctimes ceqb cleb). Lemma checker_nf_sound : forall (l : list NFormula) (cm : Psatz), @@ -627,73 +490,23 @@ Qed. (** Normalisation of formulae **) -Inductive Op2 : Set := (* binary relations *) -| OpEq -| OpNEq -| OpLe -| OpGe -| OpLt -| OpGt. - -Register OpEq as micromega.Op2.OpEq. -Register OpNEq as micromega.Op2.OpNEq. -Register OpLe as micromega.Op2.OpLe. -Register OpGe as micromega.Op2.OpGe. -Register OpLt as micromega.Op2.OpLt. -Register OpGt as micromega.Op2.OpGt. - -Definition eval_op2 (o : Op2) : R -> R -> Prop := -match o with -| OpEq => req -| OpNEq => fun x y : R => x ~= y -| OpLe => rle -| OpGe => fun x y : R => y <= x -| OpLt => fun x y : R => x < y -| OpGt => fun x y : R => y < x -end. +#[local] Notation eval_op2 := (eval_op2 + isProp req (fun x y => ~ req x y) rle rlt). Definition eval_pexpr : PolEnv -> PExpr C -> R := - PEeval rplus rtimes rminus ropp phi pow_phi rpow. - -#[universes(template)] -Record Formula (T:Type) : Type := Build_Formula{ - Flhs : PExpr T; - Fop : Op2; - Frhs : PExpr T -}. - -Register Formula as micromega.Formula.type. -Register Build_Formula as micromega.Formula.Build_Formula. - -Definition eval_formula (env : PolEnv) (f : Formula C) : Prop := - let (lhs, op, rhs) := f in - (eval_op2 op) (eval_pexpr env lhs) (eval_pexpr env rhs). + PEeval rO rI rplus rtimes rminus ropp pow_phi rpow phi (@Env.nth R). +#[local] Notation eval_formula := (Feval rO rI rplus rtimes rminus ropp + pow_phi rpow isProp req (fun x y => ~ req x y) rle rlt phi (@Env.nth R)). (* We normalize Formulas by moving terms to one side *) -Definition norm := norm_aux cO cI cplus ctimes cminus copp ceqb. - -Definition psub := Psub cO cplus cminus copp ceqb. - -Definition padd := Padd cO cplus ceqb. - -Definition pmul := Pmul cO cI cplus ctimes ceqb. - -Definition popp := Popp copp. - -Definition normalise (f : Formula C) : NFormula := -let (lhs, op, rhs) := f in - let lhs := norm lhs in - let rhs := norm rhs in - match op with - | OpEq => (psub lhs rhs, Equal) - | OpNEq => (psub lhs rhs, NonEqual) - | OpLe => (psub rhs lhs, NonStrict) - | OpGe => (psub lhs rhs, NonStrict) - | OpGt => (psub lhs rhs, Strict) - | OpLt => (psub rhs lhs, Strict) - end. +#[local] Notation norm := (Pol_of_PExpr cO cI cplus ctimes cminus copp ceqb). +#[local] Notation psub := (Psub cO cplus cminus copp ceqb). +#[local] Notation padd := (Padd cO cplus ceqb). +#[local] Notation pmul := (Pmul cO cI cplus ctimes ceqb). +#[local] Notation popp := (Popp copp). +#[local] Notation normalise := (normalise cO cI cplus ctimes cminus copp ceqb). Definition negate (f : Formula C) : NFormula := let (lhs, op, rhs) := f in @@ -777,31 +590,9 @@ Qed. (** Another normalisation - this is used for cnf conversion **) -Definition xnormalise (f:NFormula) : list (NFormula) := - let (e,o) := f in - match o with - | Equal => (e , Strict) :: (popp e, Strict) :: nil - | NonEqual => (e , Equal) :: nil - | Strict => (popp e, NonStrict) :: nil - | NonStrict => (popp e, Strict) :: nil - end. - -Definition xnegate (t:NFormula) : list (NFormula) := - let (e,o) := t in - match o with - | Equal => (e,Equal) :: nil - | NonEqual => (e,Strict)::(popp e,Strict)::nil - | Strict => (e,Strict) :: nil - | NonStrict => (e,NonStrict) :: nil - end. - - -Import Stdlib.micromega.Tauto. - -Definition cnf_of_list {T : Type} (l:list NFormula) (tg : T) : cnf NFormula T := - List.fold_right (fun x acc => - if check_inconsistent x then acc else ((x,tg)::nil)::acc) - (cnf_tt _ _) l. +#[local] Notation xnormalise := (normalise_aux copp). +#[local] Notation xnegate := (negate_aux copp). +#[local] Notation cnf_of_list := (cnf_of_list cO ceqb cleb). Add Ring SORRing : (SORrt sor). @@ -837,15 +628,8 @@ Proof. tauto. Qed. -Definition cnf_normalise {T: Type} (t: Formula C) (tg: T) : cnf NFormula T := - let f := normalise t in - if check_inconsistent f then cnf_ff _ _ - else cnf_of_list (xnormalise f) tg. - -Definition cnf_negate {T: Type} (t: Formula C) (tg: T) : cnf NFormula T := - let f := normalise t in - if check_inconsistent f then cnf_tt _ _ - else cnf_of_list (xnegate f) tg. +#[local] Notation cnf_normalise := (cnf_normalise cO cI cplus ctimes cminus copp ceqb cleb). +#[local] Notation cnf_negate := (cnf_negate cO cI cplus ctimes cminus copp ceqb cleb). Lemma eq0_cnf : forall x, (0 < x -> False) /\ (0 < - x -> False) <-> x == 0. @@ -954,7 +738,7 @@ Fixpoint xdenorm (jmp : positive) (p: Pol C) : PExpr C := | Pc c => PEc c | Pinj j p => xdenorm (Pos.add j jmp ) p | PX p j q => PEadd - (PEmul (xdenorm jmp p) (PEpow (PEX jmp) (Npos j))) + (PEmul (xdenorm jmp p) (PEpow (PEX _ jmp) (Npos j))) (xdenorm (Pos.succ jmp) q) end. @@ -1020,34 +804,18 @@ Variable phiS : S -> R. Variable phi_C_of_S : forall c, phiS c = phi (C_of_S c). -Fixpoint map_PExpr (e : PExpr S) : PExpr C := - match e with - | PEc c => PEc (C_of_S c) - | PEX p => PEX p - | PEadd e1 e2 => PEadd (map_PExpr e1) (map_PExpr e2) - | PEsub e1 e2 => PEsub (map_PExpr e1) (map_PExpr e2) - | PEmul e1 e2 => PEmul (map_PExpr e1) (map_PExpr e2) - | PEopp e => PEopp (map_PExpr e) - | PEpow e n => PEpow (map_PExpr e) n - end. - -Definition map_Formula (f : Formula S) : Formula C := - let (l,o,r) := f in - Build_Formula (map_PExpr l) o (map_PExpr r). - - Definition eval_sexpr : PolEnv -> PExpr S -> R := - PEeval rplus rtimes rminus ropp phiS pow_phi rpow. + PEeval rO rI rplus rtimes rminus ropp pow_phi rpow phiS (@Env.nth R). Definition eval_sformula (env : PolEnv) (f : Formula S) : Prop := let (lhs, op, rhs) := f in (eval_op2 op) (eval_sexpr env lhs) (eval_sexpr env rhs). -Lemma eval_pexprSC : forall env s, eval_sexpr env s = eval_pexpr env (map_PExpr s). +Lemma eval_pexprSC : forall env s, eval_sexpr env s = eval_pexpr env (PEmap C_of_S s). Proof. unfold eval_pexpr, eval_sexpr. intros env s; - induction s as [| |? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs|? IHs ?]; + induction s as [| | | |? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs|? IHs ?]; simpl ; try (rewrite IHs1 ; rewrite IHs2) ; try reflexivity. - apply phi_C_of_S. - rewrite IHs. reflexivity. @@ -1055,7 +823,7 @@ Proof. Qed. (** equality might be (too) strong *) -Lemma eval_formulaSC : forall env f, eval_sformula env f = eval_formula env (map_Formula f). +Lemma eval_formulaSC : forall env f, eval_sformula env f = eval_formula env (Fmap C_of_S f). Proof. intros env f; destruct f. simpl. @@ -1073,13 +841,13 @@ Definition simpl_cone (e:Psatz) : Psatz := match e with | PsatzSquare t => match t with - | Pc c => if ceqb cO c then PsatzZ else PsatzC (ctimes c c) + | Pc c => if ceqb cO c then PsatzZ _ else PsatzC (ctimes c c) | _ => PsatzSquare t end | PsatzMulE t1 t2 => match t1 , t2 with - | PsatzZ , _ => PsatzZ - | _ , PsatzZ => PsatzZ + | PsatzZ _ , _ => PsatzZ C + | _ , PsatzZ _ => PsatzZ C | PsatzC c , PsatzC c' => PsatzC (ctimes c c') | PsatzC p1 , PsatzMulE (PsatzC p2) x => PsatzMulE (PsatzC (ctimes p1 p2)) x | PsatzC p1 , PsatzMulE x (PsatzC p2) => PsatzMulE (PsatzC (ctimes p1 p2)) x @@ -1092,8 +860,8 @@ Definition simpl_cone (e:Psatz) : Psatz := end | PsatzAdd t1 t2 => match t1 , t2 with - | PsatzZ , x => x - | x , PsatzZ => x + | PsatzZ _ , x => x + | x , PsatzZ _ => x | x , y => PsatzAdd x y end | _ => e @@ -1103,6 +871,16 @@ Definition simpl_cone (e:Psatz) : Psatz := End Micromega. +Notation norm := Pol_of_PExpr (only parsing). +Notation psub := Psub (only parsing). +Notation padd := Padd (only parsing). +Notation pmul := Pmul (only parsing). +Notation popp := Popp (only parsing). + +Notation eval_formula := + (fun rO rI add mul sub opp eqProp le lt phi pow_phi pow => Feval + rO rI add mul sub opp pow_phi pow + isProp eqProp (fun x y => ~ eqProp x y) le lt phi (@Env.nth _)). (* Local Variables: *) (* coding: utf-8 *) diff --git a/theories/micromega/SatDivMod.v b/theories/micromega/SatDivMod.v index 871527d9be..4fbe7f6968 100644 --- a/theories/micromega/SatDivMod.v +++ b/theories/micromega/SatDivMod.v @@ -29,7 +29,7 @@ Instance SatDiv : Saturate Z.div := PRes := fun _ _ r => 0 <= r; SatOk := Z_div_nonneg_nonneg |}. -Add Zify Saturate SatDiv. +Add Tify Saturate SatDiv. #[global] Instance SatMod : Saturate Z.modulo := @@ -39,4 +39,4 @@ Instance SatMod : Saturate Z.modulo := PRes := fun _ _ r => 0 <= r; SatOk := Z_mod_nonneg_nonneg |}. -Add Zify Saturate SatMod. +Add Tify Saturate SatMod. diff --git a/theories/micromega/Tauto.v b/theories/micromega/Tauto.v index 3790039c1c..8b39038b81 100644 --- a/theories/micromega/Tauto.v +++ b/theories/micromega/Tauto.v @@ -14,6 +14,7 @@ (* *) (************************************************************************) +From micromega_plugin Require Export formula witness eval checker. From Stdlib Require Import List. From Stdlib Require Import Refl. From Stdlib Require Import Bool. @@ -21,49 +22,22 @@ From Stdlib Require Import Relation_Definitions Setoid. Set Implicit Arguments. -(** Formulae are either interpreted over Prop or bool. *) -Inductive kind : Type := -|isProp -|isBool. - -Register isProp as micromega.kind.isProp. -Register isBool as micromega.kind.isBool. - Inductive Trace (A : Type) := | null : Trace A | push : A -> Trace A -> Trace A | merge : Trace A -> Trace A -> Trace A . +#[local] Notation eIFF := (eIFF eqb). +Notation eval_f := (GFeval eqb). + Section S. Context {TA : Type}. (* type of interpreted atoms *) Context {TX : kind -> Type}. (* type of uninterpreted terms (Prop) *) Context {AA : Type}. (* type of annotations for atoms *) Context {AF : Type}. (* type of formulae identifiers *) - Inductive GFormula : kind -> Type := - | TT : forall (k: kind), GFormula k - | FF : forall (k: kind), GFormula k - | X : forall (k: kind), TX k -> GFormula k - | A : forall (k: kind), TA -> AA -> GFormula k - | AND : forall (k: kind), GFormula k -> GFormula k -> GFormula k - | OR : forall (k: kind), GFormula k -> GFormula k -> GFormula k - | NOT : forall (k: kind), GFormula k -> GFormula k - | IMPL : forall (k: kind), GFormula k -> option AF -> GFormula k -> GFormula k - | IFF : forall (k: kind), GFormula k -> GFormula k -> GFormula k - | EQ : GFormula isBool -> GFormula isBool -> GFormula isProp. - - Register TT as micromega.GFormula.TT. - Register FF as micromega.GFormula.FF. - Register X as micromega.GFormula.X. - Register A as micromega.GFormula.A. - Register AND as micromega.GFormula.AND. - Register OR as micromega.GFormula.OR. - Register NOT as micromega.GFormula.NOT. - Register IMPL as micromega.GFormula.IMPL. - Register IFF as micromega.GFormula.IFF. - Register EQ as micromega.GFormula.EQ. - + Local Notation GFormula := (@GFormula TA TX AA AF). Section MAPX. Variable F : forall k, TX k -> TX k. @@ -72,7 +46,7 @@ Section S. match f with | TT k => TT k | FF k => FF k - | X x => X (F x) + | X k x => X k (F x) | A k a an => A k a an | AND f1 f2 => AND (mapX f1) (mapX f2) | OR f1 f2 => OR (mapX f1) (mapX f2) @@ -92,7 +66,7 @@ Section S. match f with | TT _ => acc | FF _ => acc - | X x => acc + | X k x => acc | A _ a an => F acc an | AND f1 f2 | OR f1 f2 @@ -118,7 +92,7 @@ Section S. Fixpoint collect_annot (k: kind) (f : GFormula k) : list AA := match f with - | TT _ | FF _ | X _ => nil + | TT _ | FF _ | X _ _ => nil | A _ _ a => a ::nil | AND f1 f2 | OR f1 f2 @@ -127,66 +101,26 @@ Section S. | NOT f => collect_annot f end. - Definition rtyp (k: kind) : Type := if k then Prop else bool. - - Variable ex : forall (k: kind), TX k -> rtyp k. (* [ex] will be the identity *) + Variable ex : forall (k: kind), TX k -> eKind k. (* [ex] will be the identity *) Section EVAL. - Variable ea : forall (k: kind), TA -> rtyp k. - - Definition eTT (k: kind) : rtyp k := - if k as k' return rtyp k' then True else true. - - Definition eFF (k: kind) : rtyp k := - if k as k' return rtyp k' then False else false. - - Definition eAND (k: kind) : rtyp k -> rtyp k -> rtyp k := - if k as k' return rtyp k' -> rtyp k' -> rtyp k' - then and else andb. - - Definition eOR (k: kind) : rtyp k -> rtyp k -> rtyp k := - if k as k' return rtyp k' -> rtyp k' -> rtyp k' - then or else orb. - - Definition eIMPL (k: kind) : rtyp k -> rtyp k -> rtyp k := - if k as k' return rtyp k' -> rtyp k' -> rtyp k' - then (fun x y => x -> y) else implb. - - Definition eIFF (k: kind) : rtyp k -> rtyp k -> rtyp k := - if k as k' return rtyp k' -> rtyp k' -> rtyp k' - then iff else eqb. - - Definition eNOT (k: kind) : rtyp k -> rtyp k := - if k as k' return rtyp k' -> rtyp k' - then not else negb. - - Fixpoint eval_f (k: kind) (f:GFormula k) {struct f}: rtyp k := - match f in GFormula k' return rtyp k' with - | TT tk => eTT tk - | FF tk => eFF tk - | A k a _ => ea k a - | X p => ex p - | @AND k e1 e2 => eAND k (eval_f e1) (eval_f e2) - | @OR k e1 e2 => eOR k (eval_f e1) (eval_f e2) - | @NOT k e => eNOT k (eval_f e) - | @IMPL k f1 _ f2 => eIMPL k (eval_f f1) (eval_f f2) - | @IFF k f1 f2 => eIFF k (eval_f f1) (eval_f f2) - | EQ f1 f2 => (eval_f f1) = (eval_f f2) - end. + Variable ea : forall (k: kind), TA -> eKind k. + + #[local] Notation eval_f := (eval_f ex ea). Lemma eval_f_rew : forall k (f:GFormula k), eval_f f = - match f in GFormula k' return rtyp k' with + match f in formula.GFormula k' return eKind k' with | TT tk => eTT tk | FF tk => eFF tk | A k a _ => ea k a - | X p => ex p - | @AND k e1 e2 => eAND k (eval_f e1) (eval_f e2) - | @OR k e1 e2 => eOR k (eval_f e1) (eval_f e2) - | @NOT k e => eNOT k (eval_f e) - | @IMPL k f1 _ f2 => eIMPL k (eval_f f1) (eval_f f2) - | @IFF k f1 f2 => eIFF k (eval_f f1) (eval_f f2) + | X k p => ex p + | @AND _ _ _ _ k e1 e2 => eAND k (eval_f e1) (eval_f e2) + | @OR _ _ _ _ k e1 e2 => eOR k (eval_f e1) (eval_f e2) + | @NOT _ _ _ _ k e => eNOT k (eval_f e) + | @IMPL _ _ _ _ k f1 _ f2 => eIMPL k (eval_f f1) (eval_f f2) + | @IFF _ _ _ _ k f1 f2 => eIFF k (eval_f f1) (eval_f f2) | EQ f1 f2 => (eval_f f1) = (eval_f f2) end. Proof. @@ -194,31 +128,31 @@ Section S. Qed. End EVAL. + #[local] Notation eval_f := (eval_f ex). + Definition hold (k: kind) : eKind k -> Prop := + if k as k0 return (eKind k0 -> Prop) then fun x => x else is_true. - Definition hold (k: kind) : rtyp k -> Prop := - if k as k0 return (rtyp k0 -> Prop) then fun x => x else is_true. + Definition eiff (k: kind) : eKind k -> eKind k -> Prop := + if k as k' return eKind k' -> eKind k' -> Prop then iff else @eq bool. - Definition eiff (k: kind) : rtyp k -> rtyp k -> Prop := - if k as k' return rtyp k' -> rtyp k' -> Prop then iff else @eq bool. - - Lemma eiff_refl (k: kind) (x : rtyp k) : + Lemma eiff_refl (k: kind) (x : eKind k) : eiff k x x. Proof. destruct k ; simpl; tauto. Qed. - Lemma eiff_sym k (x y : rtyp k) : eiff k x y -> eiff k y x. + Lemma eiff_sym k (x y : eKind k) : eiff k x y -> eiff k y x. Proof. destruct k ; simpl; intros ; intuition. Qed. - Lemma eiff_trans k (x y z : rtyp k) : eiff k x y -> eiff k y z -> eiff k x z. + Lemma eiff_trans k (x y z : eKind k) : eiff k x y -> eiff k y z -> eiff k x z. Proof. destruct k ; simpl; intros ; intuition congruence. Qed. - Lemma hold_eiff (k: kind) (x y : rtyp k) : + Lemma hold_eiff (k: kind) (x y : eKind k) : (hold k x <-> hold k y) <-> eiff k x y. Proof. destruct k ; simpl. @@ -266,7 +200,7 @@ Section S. Qed. Lemma eval_f_morph : - forall (ev ev' : forall (k: kind), TA -> rtyp k), + forall (ev ev' : forall (k: kind), TA -> eKind k), (forall k a, eiff k (ev k a) (ev' k a)) -> forall (k: kind)(f : GFormula k), (eiff k (eval_f ev f) (eval_f ev' f)). @@ -292,46 +226,6 @@ End S. #[global] Hint Extern 2 (subrelation (eiff _) _) => progress cbn : typeclass_instances. -(** Typical boolean formulae *) -Definition eKind (k: kind) := if k then Prop else bool. -Register eKind as micromega.eKind. - -Definition BFormula (A : Type) := @GFormula A eKind unit unit. - -Register BFormula as micromega.BFormula.type. - -Section MAPATOMS. - Context {TA TA':Type}. - Context {TX : kind -> Type}. - Context {AA : Type}. - Context {AF : Type}. - - - Fixpoint map_bformula (k: kind)(fct : TA -> TA') (f : @GFormula TA TX AA AF k) : @GFormula TA' TX AA AF k:= - match f with - | TT k => TT k - | FF k => FF k - | X k p => X k p - | A k a t => A k (fct a) t - | AND f1 f2 => AND (map_bformula fct f1) (map_bformula fct f2) - | OR f1 f2 => OR (map_bformula fct f1) (map_bformula fct f2) - | NOT f => NOT (map_bformula fct f) - | IMPL f1 a f2 => IMPL (map_bformula fct f1) a (map_bformula fct f2) - | IFF f1 f2 => IFF (map_bformula fct f1) (map_bformula fct f2) - | EQ f1 f2 => EQ (map_bformula fct f1) (map_bformula fct f2) - end. - -End MAPATOMS. - -Lemma map_simpl : forall A B f l, @map A B f l = match l with - | nil => nil - | a :: l=> (f a) :: (@map A B f l) - end. -Proof. - intros A B f l; destruct l ; reflexivity. -Qed. - - Section S. (** A cnf tracking annotations of atoms. *) @@ -350,136 +244,34 @@ Section S. #[local] Notation push := (@push Annot). #[local] Notation merge := (@merge Annot). - Definition clause := list (Term' * Annot). - Definition cnf := list clause. + #[local] Notation clause := (clause Term' Annot). + #[local] Notation cnf := (cnf Term' Annot). Variable normalise : Term -> Annot -> cnf. Variable negate : Term -> Annot -> cnf. - - Definition cnf_tt : cnf := @nil clause. - Definition cnf_ff : cnf := cons (@nil (Term' * Annot)) nil. - - (** Our cnf is optimised and detects contradictions on the fly. *) - - Fixpoint add_term (t: Term' * Annot) (cl : clause) : option clause := - match cl with - | nil => - match deduce (fst t) (fst t) with - | None => Some (t ::nil) - | Some u => if unsat u then None else Some (t::nil) - end - | t'::cl => - match deduce (fst t) (fst t') with - | None => - match add_term t cl with - | None => None - | Some cl' => Some (t' :: cl') - end - | Some u => - if unsat u then None else - match add_term t cl with - | None => None - | Some cl' => Some (t' :: cl') - end - end - end. - - Fixpoint or_clause (cl1 cl2 : clause) : option clause := - match cl1 with - | nil => Some cl2 - | t::cl => match add_term t cl2 with - | None => None - | Some cl' => or_clause cl cl' - end - end. - - Definition xor_clause_cnf (t:clause) (f:cnf) : cnf := - List.fold_left (fun acc e => - match or_clause t e with - | None => acc - | Some cl => cl :: acc - end) f nil . - - Definition or_clause_cnf (t: clause) (f:cnf) : cnf := - match t with - | nil => f - | _ => xor_clause_cnf t f - end. - - - Fixpoint or_cnf (f : cnf) (f' : cnf) {struct f}: cnf := - match f with - | nil => cnf_tt - | e :: rst => (or_cnf rst f') +++ (or_clause_cnf e f') - end. - - - Definition and_cnf (f1 : cnf) (f2 : cnf) : cnf := - f1 +++ f2. - - (** TX is Prop in Coq and EConstr.constr in Ocaml. - AF is unit in Coq and Names.Id.t in Ocaml - *) - Definition TFormula (TX: kind -> Type) (AF: Type) := @GFormula Term TX Annot AF. - - - Definition is_cnf_tt (c : cnf) : bool := - match c with - | nil => true - | _ => false - end. - - Definition is_cnf_ff (c : cnf) : bool := - match c with - | nil::nil => true - | _ => false - end. - - Definition and_cnf_opt (f1 : cnf) (f2 : cnf) : cnf := - if is_cnf_ff f1 || is_cnf_ff f2 - then cnf_ff - else - if is_cnf_tt f2 - then f1 - else and_cnf f1 f2. - - - Definition or_cnf_opt (f1 : cnf) (f2 : cnf) : cnf := - if is_cnf_tt f1 || is_cnf_tt f2 - then cnf_tt - else if is_cnf_ff f2 - then f1 else or_cnf f1 f2. - - Section REC. - Context {TX : kind -> Type}. - Context {AF : Type}. - - Variable REC : forall (pol : bool) (k: kind) (f : TFormula TX AF k), cnf. - - Definition mk_and (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):= - (if pol then and_cnf_opt else or_cnf_opt) (REC pol f1) (REC pol f2). - - Definition mk_or (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):= - (if pol then or_cnf_opt else and_cnf_opt) (REC pol f1) (REC pol f2). - - Definition mk_impl (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):= - (if pol then or_cnf_opt else and_cnf_opt) (REC (negb pol) f1) (REC pol f2). - - - Definition mk_iff (k: kind) (pol:bool) (f1 f2: TFormula TX AF k):= - or_cnf_opt (and_cnf_opt (REC (negb pol) f1) (REC false f2)) - (and_cnf_opt (REC pol f1) (REC true f2)). - - - End REC. - - Definition is_bool {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula TX AF k) := - match f with - | TT _ => Some true - | FF _ => Some false - | _ => None - end. + #[local] Notation cnf_tt := (cnf_tt Term' Annot). + #[local] Notation cnf_ff := (cnf_ff Term' Annot). + #[local] Notation is_cnf_tt := (@is_cnf_tt Term' Annot). + #[local] Notation is_cnf_ff := (@is_cnf_ff Term' Annot). + #[local] Notation is_tauto := + (fun x y => match deduce x y with None => false | Some u => unsat u end). + #[local] Notation add_term := (add_term is_tauto). + #[local] Notation or_clause := (or_clause is_tauto). + #[local] Notation or_clause_cnf := (or_clause_cnf is_tauto). + #[local] Notation or_cnf_opt := (@or_cnf Term' Annot is_tauto). + #[local] Notation or_cnf := (@or_cnf_aux Term' Annot is_tauto). + #[local] Notation and_cnf_opt := (@and_cnf Term' Annot). + + #[local] Notation TFormula TX AF := (@GFormula Term TX Annot AF). + + #[local] Notation mk_and := (mk_and or_cnf_opt and_cnf_opt). + #[local] Notation mk_or := (mk_or or_cnf_opt and_cnf_opt). + #[local] Notation mk_impl := (mk_impl or_cnf_opt and_cnf_opt). + #[local] Notation mk_iff := (mk_iff or_cnf_opt and_cnf_opt). + #[local] Notation is_bool := (@is_bool Term Annot). + #[local] Notation xcnf := + (cnf_of_GFormula cnf_tt cnf_ff or_cnf_opt and_cnf_opt normalise negate). Lemma is_bool_inv : forall {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula TX AF k) res, is_bool f = Some res -> f = if res then TT _ else FF _. @@ -488,28 +280,6 @@ Section S. destruct f ; inversion H; reflexivity. Qed. - - Fixpoint xcnf {TX : kind -> Type} {AF: Type} (pol : bool) (k: kind) (f : TFormula TX AF k) {struct f}: cnf := - match f with - | TT _ => if pol then cnf_tt else cnf_ff - | FF _ => if pol then cnf_ff else cnf_tt - | X _ p => if pol then cnf_ff else cnf_ff (* This is not complete - cannot negate any proposition *) - | A _ x t => if pol then normalise x t else negate x t - | NOT e => xcnf (negb pol) e - | AND e1 e2 => mk_and xcnf pol e1 e2 - | OR e1 e2 => mk_or xcnf pol e1 e2 - | IMPL e1 _ e2 => mk_impl xcnf pol e1 e2 - | IFF e1 e2 => match is_bool e2 with - | Some isb => xcnf (if isb then pol else negb pol) e1 - | None => mk_iff xcnf pol e1 e2 - end - | EQ e1 e2 => - match is_bool e2 with - | Some isb => xcnf (if isb then pol else negb pol) e1 - | None => mk_iff xcnf pol e1 e2 - end - end. - Section CNFAnnot. (** Records annotations used to optimise the cnf. @@ -1249,13 +1019,14 @@ Section S. reflexivity. Qed. - Lemma xror_clause_clause : forall a f, - fst (xror_clause_cnf a f) = xor_clause_cnf a f. + Lemma xror_clause_clause : forall a a' f, + fst (xror_clause_cnf (a :: a') f) = or_clause_cnf (a :: a') f. Proof. unfold xror_clause_cnf. - unfold xor_clause_cnf. + unfold or_clause_cnf. assert (ACC: fst (@nil clause, null) = nil) by reflexivity. - intros a f. + intros a' a'' f. + set (a := a' :: a''); clearbody a. set (F1:= (fun '(acc, tg) (e : clause) => match ror_clause a e with | inl cl => (cl :: acc, tg) @@ -1396,6 +1167,7 @@ Section S. rewrite H by auto. unfold or_cnf_opt. simpl. + fold or_cnf_opt. destruct (is_cnf_tt (xcnf true f2)) eqn:EQ;auto. -- apply is_cnf_tt_inv in EQ; auto. -- destruct (is_cnf_ff (xcnf true f2)) eqn:EQ1. @@ -1492,14 +1264,13 @@ Section S. simpl. tauto. Qed. - Lemma eval_cnf_and_opt : forall env x y, eval_cnf env (and_cnf_opt x y) <-> eval_cnf env (and_cnf x y). + Lemma eval_cnf_and_opt : forall env x y, eval_cnf env (and_cnf_opt x y) <-> eval_cnf env (rev_append x y). Proof. unfold and_cnf_opt. intros env x y. destruct (is_cnf_ff x) eqn:F1. { apply is_cnf_ff_inv in F1. simpl. subst. - unfold and_cnf. rewrite eval_cnf_app. rewrite eval_cnf_ff. tauto. @@ -1508,7 +1279,6 @@ Section S. destruct (is_cnf_ff y) eqn:F2. { apply is_cnf_ff_inv in F2. simpl. subst. - unfold and_cnf. rewrite eval_cnf_app. rewrite eval_cnf_ff. tauto. @@ -1517,7 +1287,6 @@ Section S. { apply is_cnf_tt_inv in F3. subst. - unfold and_cnf. rewrite eval_cnf_app. rewrite eval_cnf_tt. tauto. @@ -1639,9 +1408,7 @@ Section S. } destruct t ; auto. - unfold eval_clause ; simpl. tauto. - - unfold xor_clause_cnf. - unfold F in H. - rewrite H. + - rewrite H. unfold make_conj at 2. tauto. Qed. @@ -1713,13 +1480,13 @@ Section S. } Qed. - Variable eval : Env -> forall (k: kind), Term -> rtyp k. + Variable eval : Env -> forall (k: kind), Term -> eKind k. Variable normalise_correct : forall env b t tg, eval_cnf env (normalise t tg) -> hold b (eval env b t). Variable negate_correct : forall env b t tg, eval_cnf env (negate t tg) -> hold b (eNOT b (eval env b t)). - Definition e_rtyp (k: kind) (x : rtyp k) : rtyp k := x. + Definition e_eKind (k: kind) (x : eKind k) : eKind k := x. Lemma hold_eTT : forall k, hold k (eTT k). Proof. @@ -1795,13 +1562,13 @@ Section S. (f2 : GFormula k) (IHf1 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f1) -> - hold k (eval_f e_rtyp (eval env) (if pol then f1 else NOT f1))) + hold k (eval_f e_eKind (eval env) (if pol then f1 else NOT f1))) (IHf2 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f2) -> - hold k (eval_f e_rtyp (eval env) (if pol then f2 else NOT f2))), + hold k (eval_f e_eKind (eval env) (if pol then f2 else NOT f2))), forall (pol : bool) (env : Env), eval_cnf env (xcnf pol (IMPL f1 o f2)) -> - hold k (eval_f e_rtyp (eval env) (if pol then IMPL f1 o f2 else NOT (IMPL f1 o f2))). + hold k (eval_f e_eKind (eval env) (if pol then IMPL f1 o f2 else NOT (IMPL f1 o f2))). Proof. simpl; intros k f1 o f2 IHf1 IHf2 pol env H. unfold mk_impl in H. destruct pol. @@ -1819,7 +1586,6 @@ Section S. auto. + (* pol = false *) rewrite eval_cnf_and_opt in H. - unfold and_cnf in H. simpl in H. rewrite eval_cnf_app in H. destruct H as [H0 H1]. @@ -1851,16 +1617,16 @@ Section S. Lemma xcnf_iff : forall (k : kind) - (f1 f2 : @GFormula Term rtyp Annot unit k) + (f1 f2 : @GFormula Term eKind Annot unit k) (IHf1 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f1) -> - hold k (eval_f e_rtyp (eval env) (if pol then f1 else NOT f1))) + hold k (eval_f e_eKind (eval env) (if pol then f1 else NOT f1))) (IHf2 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f2) -> - hold k (eval_f e_rtyp (eval env) (if pol then f2 else NOT f2))), + hold k (eval_f e_eKind (eval env) (if pol then f2 else NOT f2))), forall (pol : bool) (env : Env), eval_cnf env (xcnf pol (IFF f1 f2)) -> - hold k (eval_f e_rtyp (eval env) (if pol then IFF f1 f2 else NOT (IFF f1 f2))). + hold k (eval_f e_eKind (eval env) (if pol then IFF f1 f2 else NOT (IFF f1 f2))). Proof. simpl. intros k f1 f2 IHf1 IHf2 pol env H. @@ -1870,7 +1636,6 @@ Section S. rewrite or_cnf_opt_correct in H; rewrite or_cnf_correct in H; rewrite! eval_cnf_and_opt in H; - unfold and_cnf in H; rewrite! eval_cnf_app in H; generalize (IHf1 false env); generalize (IHf1 true env); @@ -1890,8 +1655,8 @@ Section S. tauto. Qed. - Lemma xcnf_correct : forall (k: kind) (f : @GFormula Term rtyp Annot unit k) pol env, - eval_cnf env (xcnf pol f) -> hold k (eval_f e_rtyp (eval env) (if pol then f else NOT f)). + Lemma xcnf_correct : forall (k: kind) (f : @GFormula Term eKind Annot unit k) pol env, + eval_cnf env (xcnf pol f) -> hold k (eval_f e_eKind (eval env) (if pol then f else NOT f)). Proof. intros k f; induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf @@ -1923,7 +1688,6 @@ Section S. + (* pol = true *) intros. rewrite eval_cnf_and_opt in H. - unfold and_cnf in H. rewrite eval_cnf_app in H. destruct H as [H H0]. apply hold_eAND; split. @@ -1963,7 +1727,6 @@ Section S. + (* pol = true *) intros. unfold mk_or in H. rewrite eval_cnf_and_opt in H. - unfold and_cnf. rewrite eval_cnf_app in H. destruct H as [H0 H1]. simpl. @@ -2019,17 +1782,8 @@ Section S. Variable checker_sound : forall t w, checker t w = true -> forall env, make_impl (eval_tt env) t False. - Fixpoint cnf_checker (f : cnf) (l : list Witness) {struct f}: bool := - match f with - | nil => true - | e::f => match l with - | nil => false - | c::l => match checker e c with - | true => cnf_checker f l - | _ => false - end - end - end. + #[local] Notation cnf_checker := (cnf_checker checker). + #[local] Notation tauto_checker := (tauto_checker checker). Lemma cnf_checker_sound : forall t w, cnf_checker t w = true -> forall env, eval_cnf env t. Proof. @@ -2053,22 +1807,19 @@ Section S. tauto. Qed. - Definition tauto_checker (f:@GFormula Term rtyp Annot unit isProp) (w:list Witness) : bool := - cnf_checker (xcnf true f) w. - - Lemma tauto_checker_sound : forall t w, tauto_checker t w = true -> forall env, eval_f e_rtyp (eval env) t. + Lemma tauto_checker_sound : forall t w, tauto_checker (@xcnf true isProp t) w = true -> forall env, @GFeval eqb _ _ _ unit e_eKind (eval env) _ t. Proof. unfold tauto_checker. intros t w H env. - change (eval_f e_rtyp (eval env) t) with (eval_f e_rtyp (eval env) (if true then t else TT isProp)). + change (eval_f e_eKind (eval env) t) with (eval_f e_eKind (eval env) (if true then t else TT isProp)). apply (xcnf_correct t true). eapply cnf_checker_sound ; eauto. Qed. - Definition eval_bf {A : Type} (ea : forall (k: kind), A -> rtyp k) (k: kind) (f: BFormula A k) := eval_f e_rtyp ea f. + #[local] Notation eval_bf := (BFeval eqb). Lemma eval_bf_map : forall T U (fct: T-> U) env (k: kind) (f:BFormula T k) , - eval_bf env (map_bformula fct f) = eval_bf (fun b x => env b (fct x)) f. + eval_bf env (GFmap fct f) = eval_bf (fun b x => env b (fct x)) f. Proof. intros T U fct env k f; induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf @@ -2079,7 +1830,16 @@ Section S. End S. - +Notation eval_bf := (BFeval eqb). + +Notation tauto_checker := + (fun term term' annot unsat deduce normalise negate witness check f => + @tauto_checker (clause term' annot) witness check + (@cnf_of_GFormula term annot (cnf term' annot) (cnf_tt _ _) (cnf_ff _ _) + (or_cnf (fun f1 f2 => match deduce f1 f2 : option term' with + | None => false + | Some u => unsat u end)) + (@and_cnf _ _) normalise negate eKind annot true isProp f)). (* Local Variables: *) (* coding: utf-8 *) diff --git a/theories/micromega/Tify.v b/theories/micromega/Tify.v new file mode 100644 index 0000000000..7750902644 --- /dev/null +++ b/theories/micromega/Tify.v @@ -0,0 +1,17 @@ +(************************************************************************) +(* * The Rocq Prover / The Rocq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* Z0 + | PEI => Zpos xH | PEc c => c - | PEX x => env x + | PEX _ x => env x | PEadd e1 e2 => Zeval_expr env e1 + Zeval_expr env e2 | PEmul e1 e2 => Zeval_expr env e1 * Zeval_expr env e2 | PEpow e1 n => Z.pow (Zeval_expr env e1) (Z.of_N n) @@ -108,21 +110,19 @@ Fixpoint Zeval_expr (env : PolEnv Z) (e: PExpr Z) : Z := Strategy expand [ Zeval_expr ]. -Definition eval_expr := eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => x) (pow_N 1 Z.mul). +Definition eval_expr := eval_pexpr Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => x) (pow_N 1 Z.mul). Fixpoint Zeval_const (e: PExpr Z) : option Z := match e with + | PEO => Some Z0 + | PEI => Some (Zpos xH) | PEc c => Some c - | PEX x => None - | PEadd e1 e2 => map_option2 (fun x y => Some (x + y)) - (Zeval_const e1) (Zeval_const e2) - | PEmul e1 e2 => map_option2 (fun x y => Some (x * y)) - (Zeval_const e1) (Zeval_const e2) - | PEpow e1 n => map_option (fun x => Some (Z.pow x (Z.of_N n))) - (Zeval_const e1) - | PEsub e1 e2 => map_option2 (fun x y => Some (x - y)) - (Zeval_const e1) (Zeval_const e2) - | PEopp e => map_option (fun x => Some (Z.opp x)) (Zeval_const e) + | PEX _ x => None + | PEadd e1 e2 => map_option2 Z.add (Zeval_const e1) (Zeval_const e2) + | PEmul e1 e2 => map_option2 Z.mul (Zeval_const e1) (Zeval_const e2) + | PEpow e1 n => map_option (fun x => Z.pow x (Z.of_N n)) (Zeval_const e1) + | PEsub e1 e2 => map_option2 Z.sub (Zeval_const e1) (Zeval_const e2) + | PEopp e => map_option Z.opp (Zeval_const e) end. Lemma ZNpower : forall r n, r ^ Z.of_N n = pow_N 1 Z.mul r n. @@ -180,8 +180,8 @@ Proof. - rewrite <- Z.gtb_gt; tauto. Qed. -Definition Zeval_op2 (k: Tauto.kind) : Op2 -> Z -> Z -> Tauto.rtyp k:= - if k as k0 return (Op2 -> Z -> Z -> Tauto.rtyp k0) +Definition Zeval_op2 (k: kind) : Op2 -> Z -> Z -> eKind k:= + if k as k0 return (Op2 -> Z -> Z -> eKind k0) then Zeval_pop2 else Zeval_bop2. @@ -194,34 +194,34 @@ Proof. Qed. -Definition Zeval_formula (env : PolEnv Z) (k: Tauto.kind) (f : Formula Z):= +Definition Zeval_formula (env : PolEnv Z) (k: kind) (f : Formula Z):= let (lhs, op, rhs) := f in (Zeval_op2 k op) (Zeval_expr env lhs) (Zeval_expr env rhs). Definition Zeval_formula' := - eval_formula Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt (fun x => x) (fun x => x) (pow_N 1 Z.mul). + eval_formula Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt (fun x => x) (fun x => x) (pow_N 1 Z.mul). -Lemma Zeval_formula_compat : forall env k f, Tauto.hold k (Zeval_formula env k f) <-> Zeval_formula env Tauto.isProp f. +Lemma Zeval_formula_compat : forall env k f, Tauto.hold k (Zeval_formula env k f) <-> Zeval_formula env isProp f. Proof. intros env k; destruct k ; simpl. - tauto. - intros f; destruct f ; simpl. - rewrite <- (Zeval_op2_hold Tauto.isBool). + rewrite <- (Zeval_op2_hold isBool). simpl. tauto. Qed. -Lemma Zeval_formula_compat' : forall env f, Zeval_formula env Tauto.isProp f <-> Zeval_formula' env f. +Lemma Zeval_formula_compat' : forall env f, Zeval_formula env isProp f <-> Zeval_formula' env f. Proof. intros env f. unfold Zeval_formula. destruct f as [Flhs Fop Frhs]. repeat rewrite Zeval_expr_compat. unfold Zeval_formula' ; simpl. - unfold eval_expr. - generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) - (fun x : N => x) (pow_N 1 Z.mul) env Flhs). - generalize ((eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) - (fun x : N => x) (pow_N 1 Z.mul) env Frhs)). + unfold eval_expr, eval_pexpr. + generalize (ring_eval.PEeval Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (fun x => x) + (pow_N 1 Z.mul) (fun x => x) (@Env.nth Z) env Flhs). + generalize (ring_eval.PEeval Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (fun x => x) + (pow_N 1 Z.mul) (fun x => x) (@Env.nth Z) env Frhs). destruct Fop ; simpl; intros; intuition auto using Z.le_ge, Z.ge_le, Z.lt_gt, Z.gt_lt. Qed. @@ -245,7 +245,7 @@ Proof. apply (eval_nformula_dec Zsor). Qed. -Definition ZWitness := Psatz Z. +Notation ZWitness := ZWitness. Definition ZWeakChecker := check_normalised_formulas 0 1 Z.add Z.mul Z.eqb Z.leb. @@ -331,7 +331,7 @@ Definition xnnormalise (t : Formula Z) : NFormula Z := Lemma xnnormalise_correct : forall env f, - eval_nformula env (xnnormalise f) <-> Zeval_formula env Tauto.isProp f. + eval_nformula env (xnnormalise f) <-> Zeval_formula env isProp f. Proof. intros env f. rewrite Zeval_formula_compat'. @@ -339,11 +339,11 @@ Proof. destruct f as [lhs o rhs]. destruct o eqn:O ; cbn ; rewrite ?eval_pol_sub; rewrite <- !eval_pol_norm ; simpl in *; - unfold eval_expr; - generalize ( eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) - (fun x : N => x) (pow_N 1 Z.mul) env lhs); - generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) - (fun x : N => x) (pow_N 1 Z.mul) env rhs); intros z z0. + unfold eval_expr, eval_pexpr; + generalize (ring_eval.PEeval Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (fun x => x) + (pow_N 1 Z.mul) (fun x => x) (@Env.nth Z) env lhs); + generalize (ring_eval.PEeval Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (fun x => x) + (pow_N 1 Z.mul) (fun x => x) (@Env.nth Z) env rhs); intros z z0. - split ; intros. + assert (z0 + (z - z0) = z0 + 0) as H0 by congruence. rewrite Z.add_0_r in H0. @@ -435,7 +435,7 @@ Definition normalise {T : Type} (t:Formula Z) (tg:T) : cnf (NFormula Z) T := if Zunsat f then cnf_ff _ _ else cnf_of_list tg (xnormalise f). -Lemma normalise_correct : forall (T: Type) env t (tg:T), eval_cnf eval_nformula env (normalise t tg) <-> Zeval_formula env Tauto.isProp t. +Lemma normalise_correct : forall (T: Type) env t (tg:T), eval_cnf eval_nformula env (normalise t tg) <-> Zeval_formula env isProp t. Proof. intros T env t tg. rewrite <- xnnormalise_correct. @@ -479,7 +479,7 @@ Proof. - tauto. Qed. -Lemma negate_correct : forall T env t (tg:T), eval_cnf eval_nformula env (negate t tg) <-> ~ Zeval_formula env Tauto.isProp t. +Lemma negate_correct : forall T env t (tg:T), eval_cnf eval_nformula env (negate t tg) <-> ~ Zeval_formula env isProp t. Proof. intros T env t tg. rewrite <- xnnormalise_correct. @@ -493,11 +493,23 @@ Proof. apply xnegate_correct. Qed. -Definition cnfZ (Annot: Type) (TX : Tauto.kind -> Type) (AF : Type) (k: Tauto.kind) (f : TFormula (Formula Z) Annot TX AF k) := +Definition cnfZ (Annot: Type) (TX : kind -> Type) (AF : Type) (k: kind) (f : @GFormula (Formula Z) TX Annot AF k) := rxcnf Zunsat Zdeduce normalise negate true f. -Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z) Tauto.isProp) : bool := - @tauto_checker (Formula Z) (NFormula Z) unit Zunsat Zdeduce normalise negate ZWitness (fun cl => ZWeakChecker (List.map fst cl)) f w. +Definition Zis_tauto x y := + match Zdeduce x y with None => false | Some u => Zunsat u end. + +Definition Zcnf_tt := @cnf_tt (NFormula Z) unit. +Definition Zcnf_ff := @cnf_ff (NFormula Z) unit. +Definition Zor_cnf := @or_cnf (NFormula Z) unit Zis_tauto. +Definition Zand_cnf := @and_cnf (NFormula Z) unit. + +Definition ZGFormula_to_cnf := @cnf_of_GFormula _ _ _ + Zcnf_tt Zcnf_ff Zor_cnf Zand_cnf (@normalise unit) (@negate unit) + eKind unit true isProp. + +Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z) isProp) : bool := + tauto_checker (fun cl => ZWeakChecker (List.map fst cl)) (ZGFormula_to_cnf f) w. (* To get a complete checker, the proof format has to be enriched *) @@ -539,27 +551,7 @@ Qed. (** NB: narrow_interval_upper_bound is Zdiv.Zdiv_le_lower_bound *) -Inductive ZArithProof := -| DoneProof -| RatProof : ZWitness -> ZArithProof -> ZArithProof -| CutProof : ZWitness -> ZArithProof -> ZArithProof -| SplitProof : PolC Z -> ZArithProof -> ZArithProof -> ZArithProof -| deprecated_EnumProof : ZWitness -> ZWitness -> list ZArithProof -> ZArithProof -| ExProof : positive -> ZArithProof -> ZArithProof -(*ExProof x : exists z t, x = z - t /\ z >= 0 /\ t >= 0 *) -. -#[deprecated(since="Stdlib 9.1")] -Notation EnumProof := deprecated_EnumProof (only parsing). - - -Register ZArithProof as micromega.ZArithProof.type. -Register DoneProof as micromega.ZArithProof.DoneProof. -Register RatProof as micromega.ZArithProof.RatProof. -Register CutProof as micromega.ZArithProof.CutProof. -Register SplitProof as micromega.ZArithProof.SplitProof. -Register ExProof as micromega.ZArithProof.ExProof. - - +Notation ZArithProof := ZArithProof. (* In order to compute the 'cut', we need to express a polynomial P as a * Q + b. - b is the constant @@ -831,10 +823,10 @@ Definition valid_cut_sign (op:Op1) := Definition bound_var (v : positive) : Formula Z := - Build_Formula (PEX v) OpGe (PEc 0). + Build_Formula (PEX _ v) OpGe (PEc 0). Definition mk_eq_pos (x : positive) (y:positive) (t : positive) : Formula Z := - Build_Formula (PEX x) OpEq (PEsub (PEX y) (PEX t)). + Build_Formula (PEX _ x) OpEq (PEsub (PEX _ y) (PEX _ t)). Fixpoint max_var (jmp : positive) (p : Pol Z) : positive := @@ -1336,8 +1328,8 @@ Proof. apply Z.le_ge, Z.opp_nonneg_nonpos; auto. } } Qed. -Definition ZTautoChecker (f : BFormula (Formula Z) Tauto.isProp) (w: list ZArithProof): bool := - @tauto_checker (Formula Z) (NFormula Z) unit Zunsat Zdeduce normalise negate ZArithProof (fun cl => ZChecker (List.map fst cl)) f w. +Definition ZTautoChecker (f : BFormula (Formula Z) isProp) (w: list ZArithProof): bool := + tauto_checker (fun cl => ZChecker (List.map fst cl)) (ZGFormula_to_cnf f) w. Lemma ZTautoChecker_sound : forall f w, ZTautoChecker f w = true -> forall env, eval_bf (Zeval_formula env) f. Proof. @@ -1383,7 +1375,7 @@ Definition leaf := @VarMap.Elt Z. Definition coneMember := ZWitness. -Definition eval := eval_formula. +Definition eval := Feval. #[deprecated(note="Use [prod positive nat]", since="Stdlib 9.0")] Definition prod_pos_nat := prod positive nat. diff --git a/theories/micromega/Zify.v b/theories/micromega/Zify.v index 378122e8a6..e510dff231 100644 --- a/theories/micromega/Zify.v +++ b/theories/micromega/Zify.v @@ -9,7 +9,7 @@ (************************************************************************) From Stdlib Require Import ZifyClasses ZifyInst. -Declare ML Module "rocq-runtime.plugins.zify". +From micromega_plugin Require Export Tify. (** [zify_pre_hook] and [zify_post_hook] are there to be redefined. *) Ltac zify_pre_hook := idtac. @@ -30,9 +30,9 @@ Ltac zify_to_euclidean_division_equations := Ltac zify := intros; zify_pre_hook ; - zify_elim_let ; - zify_op ; - (zify_iter_specs) ; - zify_saturate; + tify_elim_let ; + tify_op BinInt.Z; + (tify_iter_specs) ; + tify_saturate; zify_to_euclidean_division_equations ; zify_post_hook. diff --git a/theories/micromega/ZifyBool.v b/theories/micromega/ZifyBool.v index 1b9d1e1ce0..abc2dd4331 100644 --- a/theories/micromega/ZifyBool.v +++ b/theories/micromega/ZifyBool.v @@ -17,24 +17,24 @@ From Stdlib Require Import ZifyInst. Instance Inj_bool_bool : InjTyp bool bool := { inj b := b ; pred b := b = true \/ b = false ; cstr b := ltac:(destruct b; tauto) }. -Add Zify InjTyp Inj_bool_bool. +Add Tify InjTyp Inj_bool_bool. (** Boolean operators *) #[global] Instance Op_andb : BinOp andb := { TBOp := andb ; TBOpInj _ _ := eq_refl}. -Add Zify BinOp Op_andb. +Add Tify BinOp Op_andb. #[global] Instance Op_orb : BinOp orb := { TBOp := orb ; TBOpInj _ _ := eq_refl}. -Add Zify BinOp Op_orb. +Add Tify BinOp Op_orb. #[global] Instance Op_implb : BinOp implb := { TBOp := implb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_implb. +Add Tify BinOp Op_implb. Lemma xorb_eq b1 b2 : xorb b1 b2 = andb (orb b1 b2) (negb (eqb b1 b2)). Proof. @@ -44,93 +44,93 @@ Qed. #[global] Instance Op_xorb : BinOp xorb := { TBOp x y := andb (orb x y) (negb (eqb x y)); TBOpInj := xorb_eq }. -Add Zify BinOp Op_xorb. +Add Tify BinOp Op_xorb. #[global] Instance Op_eqb : BinOp eqb := { TBOp := eqb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_eqb. +Add Tify BinOp Op_eqb. #[global] Instance Op_negb : UnOp negb := { TUOp := negb ; TUOpInj _ := eq_refl}. -Add Zify UnOp Op_negb. +Add Tify UnOp Op_negb. #[global] Instance Op_eq_bool : BinRel (@eq bool) := {TR := @eq bool ; TRInj b1 b2 := iff_refl (b1 = b2) }. -Add Zify BinRel Op_eq_bool. +Add Tify BinRel Op_eq_bool. #[global] Instance Op_true : CstOp true := { TCst := true ; TCstInj := eq_refl }. -Add Zify CstOp Op_true. +Add Tify CstOp Op_true. #[global] Instance Op_false : CstOp false := { TCst := false ; TCstInj := eq_refl }. -Add Zify CstOp Op_false. +Add Tify CstOp Op_false. (** Comparison over Z *) #[global] Instance Op_Zeqb : BinOp Z.eqb := { TBOp := Z.eqb ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Zeqb. +Add Tify BinOp Op_Zeqb. #[global] Instance Op_Zleb : BinOp Z.leb := { TBOp := Z.leb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Zleb. +Add Tify BinOp Op_Zleb. #[global] Instance Op_Zgeb : BinOp Z.geb := { TBOp := Z.geb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Zgeb. +Add Tify BinOp Op_Zgeb. #[global] Instance Op_Zltb : BinOp Z.ltb := { TBOp := Z.ltb ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Zltb. +Add Tify BinOp Op_Zltb. #[global] Instance Op_Zgtb : BinOp Z.gtb := { TBOp := Z.gtb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Zgtb. +Add Tify BinOp Op_Zgtb. (** Comparison over N *) #[global] Instance Op_Neqb : BinOp N.eqb := { TBOp := Z.eqb; TBOpInj n m := ltac:(now destruct n, m) }. -Add Zify BinOp Op_Neqb. +Add Tify BinOp Op_Neqb. #[global] Instance Op_Nleb : BinOp N.leb := { TBOp := Z.leb; TBOpInj n m := ltac:(now destruct n, m) }. -Add Zify BinOp Op_Nleb. +Add Tify BinOp Op_Nleb. #[global] Instance Op_Nltb : BinOp N.ltb := { TBOp := Z.ltb; TBOpInj n m := ltac:(now destruct n, m) }. -Add Zify BinOp Op_Nltb. +Add Tify BinOp Op_Nltb. (** Comparison over positive *) #[global] Instance Op_Pos_eqb : BinOp Pos.eqb := { TBOp := Z.eqb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Pos_eqb. +Add Tify BinOp Op_Pos_eqb. #[global] Instance Op_Pos_leb : BinOp Pos.leb := { TBOp := Z.leb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Pos_leb. +Add Tify BinOp Op_Pos_leb. #[global] Instance Op_Pos_ltb : BinOp Pos.ltb := { TBOp := Z.ltb; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Pos_ltb. +Add Tify BinOp Op_Pos_ltb. (** Comparison over nat *) @@ -161,17 +161,17 @@ Qed. #[global] Instance Op_nat_eqb : BinOp Nat.eqb := { TBOp := Z.eqb; TBOpInj := Z_of_nat_eqb_iff }. -Add Zify BinOp Op_nat_eqb. +Add Tify BinOp Op_nat_eqb. #[global] Instance Op_nat_leb : BinOp Nat.leb := { TBOp := Z.leb; TBOpInj := Z_of_nat_leb_iff }. -Add Zify BinOp Op_nat_leb. +Add Tify BinOp Op_nat_leb. #[global] Instance Op_nat_ltb : BinOp Nat.ltb := { TBOp := Z.ltb; TBOpInj := Z_of_nat_ltb_iff }. -Add Zify BinOp Op_nat_ltb. +Add Tify BinOp Op_nat_ltb. Lemma b2n_b2z x : Z.of_nat (Nat.b2n x) = Z.b2z x. Proof. @@ -181,12 +181,12 @@ Qed. #[global] Instance Op_b2n : UnOp Nat.b2n := { TUOp := Z.b2z; TUOpInj := b2n_b2z }. -Add Zify UnOp Op_b2n. +Add Tify UnOp Op_b2n. #[global] Instance Op_b2z : UnOp Z.b2z := { TUOp := Z.b2z; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_b2z. +Add Tify UnOp Op_b2z. Lemma b2z_spec b : (b = true /\ Z.b2z b = 1) \/ (b = false /\ Z.b2z b = 0). Proof. @@ -197,7 +197,7 @@ Qed. Instance b2zSpec : UnOpSpec Z.b2z := { UPred b r := (b = true /\ r = 1) \/ (b = false /\ r = 0); USpec := b2z_spec }. -Add Zify UnOpSpec b2zSpec. +Add Tify UnOpSpec b2zSpec. Ltac elim_bool_cstr := repeat match goal with diff --git a/theories/micromega/ZifyClasses.v b/theories/micromega/ZifyClasses.v index eace54be57..d71ebe7b82 100644 --- a/theories/micromega/ZifyClasses.v +++ b/theories/micromega/ZifyClasses.v @@ -226,7 +226,7 @@ Proof. exact (fun H => proj2 IFF H). Qed. - +#[global] Set Warnings "-zify". (** Registering constants for use by the plugin *) Register eq_iff as ZifyClasses.eq_iff. diff --git a/theories/micromega/ZifyComparison.v b/theories/micromega/ZifyComparison.v index 8b360fe25d..b5d32f97cb 100644 --- a/theories/micromega/ZifyComparison.v +++ b/theories/micromega/ZifyComparison.v @@ -10,7 +10,6 @@ From Stdlib Require Import Bool BinInt. From Stdlib Require Import Zify ZifyClasses. -From Stdlib Require Import Lia. #[local] Open Scope Z_scope. (** [Z_of_comparison] is the injection function for comparison *) @@ -29,7 +28,7 @@ Qed. #[global] Instance Inj_comparison_Z : InjTyp comparison Z := { inj := Z_of_comparison ; pred :=(fun x => -1 <= x <= 1) ; cstr := Z_of_comparison_bound}. -Add Zify InjTyp Inj_comparison_Z. +Add Tify InjTyp Inj_comparison_Z. Definition ZcompareZ (x y : Z) := Z_of_comparison (Z.compare x y). @@ -37,27 +36,27 @@ Definition ZcompareZ (x y : Z) := #[global] Program Instance BinOp_Zcompare : BinOp Z.compare := { TBOp := ZcompareZ }. -Add Zify BinOp BinOp_Zcompare. +Add Tify BinOp BinOp_Zcompare. #[global] Instance Op_eq_comparison : BinRel (@eq comparison) := {TR := @eq Z ; TRInj := ltac:(intros [] []; simpl ; intuition congruence) }. -Add Zify BinRel Op_eq_comparison. +Add Tify BinRel Op_eq_comparison. #[global] Instance Op_Eq : CstOp Eq := { TCst := 0 ; TCstInj := eq_refl }. -Add Zify CstOp Op_Eq. +Add Tify CstOp Op_Eq. #[global] Instance Op_Lt : CstOp Lt := { TCst := -1 ; TCstInj := eq_refl }. -Add Zify CstOp Op_Lt. +Add Tify CstOp Op_Lt. #[global] Instance Op_Gt : CstOp Gt := { TCst := 1 ; TCstInj := eq_refl }. -Add Zify CstOp Op_Gt. +Add Tify CstOp Op_Gt. Lemma Zcompare_spec : forall x y, @@ -71,11 +70,18 @@ Proof. intros. destruct (x ?= y) eqn:C; simpl. - rewrite Z.compare_eq_iff in C. - lia. + subst. rewrite Z.gt_lt_iff. + specialize (Z.lt_irrefl y). + tauto. - rewrite Z.compare_lt_iff in C. - lia. + rewrite Z.gt_lt_iff. + generalize (Z.lt_neq _ _ C). + generalize (Z.lt_asymm _ _ C). + tauto. - rewrite Z.compare_gt_iff in C. - lia. + generalize (not_eq_sym (Z.lt_neq _ _ C)). + generalize (Z.lt_asymm _ _ C). + tauto. Qed. #[global] @@ -86,4 +92,4 @@ Instance ZcompareSpec : BinOpSpec ZcompareZ := /\ (x < y -> r = -1) ; BSpec := Zcompare_spec|}. -Add Zify BinOpSpec ZcompareSpec. +Add Tify BinOpSpec ZcompareSpec. diff --git a/theories/micromega/ZifyInst.v b/theories/micromega/ZifyInst.v index c90ca3d56a..4bab384ab7 100644 --- a/theories/micromega/ZifyInst.v +++ b/theories/micromega/ZifyInst.v @@ -14,7 +14,7 @@ From Stdlib Require Import BinInt BinNat Znat Nnat. From Stdlib Require Import ZifyClasses. -Declare ML Module "rocq-runtime.plugins.zify". +From micromega_plugin Require Tify. #[local] Open Scope Z_scope. Ltac refl := @@ -26,154 +26,154 @@ Ltac refl := #[global] Instance Inj_Z_Z : InjTyp Z Z := mkinj _ _ (fun x => x) (fun x => True ) (fun _ => I). -Add Zify InjTyp Inj_Z_Z. +Add Tify InjTyp Inj_Z_Z. (** Support for nat *) #[global] Instance Inj_nat_Z : InjTyp nat Z := mkinj _ _ Z.of_nat (fun x => 0 <= x ) Nat2Z.is_nonneg. -Add Zify InjTyp Inj_nat_Z. +Add Tify InjTyp Inj_nat_Z. (* zify_nat_rel *) #[global] Instance Op_ge : BinRel ge := { TR := Z.ge; TRInj := Nat2Z.inj_ge }. -Add Zify BinRel Op_ge. +Add Tify BinRel Op_ge. #[global] Instance Op_lt : BinRel lt := { TR := Z.lt; TRInj := Nat2Z.inj_lt }. -Add Zify BinRel Op_lt. +Add Tify BinRel Op_lt. #[global] Instance Op_Nat_lt : BinRel Nat.lt := Op_lt. -Add Zify BinRel Op_Nat_lt. +Add Tify BinRel Op_Nat_lt. #[global] Instance Op_gt : BinRel gt := { TR := Z.gt; TRInj := Nat2Z.inj_gt }. -Add Zify BinRel Op_gt. +Add Tify BinRel Op_gt. #[global] Instance Op_le : BinRel le := { TR := Z.le; TRInj := Nat2Z.inj_le }. -Add Zify BinRel Op_le. +Add Tify BinRel Op_le. #[global] Instance Op_Nat_le : BinRel Nat.le := Op_le. -Add Zify BinRel Op_Nat_le. +Add Tify BinRel Op_Nat_le. #[global] Instance Op_eq_nat : BinRel (@eq nat) := { TR := @eq Z ; TRInj x y := iff_sym (Nat2Z.inj_iff x y) }. -Add Zify BinRel Op_eq_nat. +Add Tify BinRel Op_eq_nat. #[global] Instance Op_Nat_eq : BinRel (Nat.eq) := Op_eq_nat. -Add Zify BinRel Op_Nat_eq. +Add Tify BinRel Op_Nat_eq. (* zify_nat_op *) #[global] Instance Op_plus : BinOp Nat.add := { TBOp := Z.add; TBOpInj := Nat2Z.inj_add }. -Add Zify BinOp Op_plus. +Add Tify BinOp Op_plus. #[global] Instance Op_sub : BinOp Nat.sub := { TBOp n m := Z.max 0 (n - m) ; TBOpInj := Nat2Z.inj_sub_max }. -Add Zify BinOp Op_sub. +Add Tify BinOp Op_sub. #[global] Instance Op_mul : BinOp Nat.mul := { TBOp := Z.mul ; TBOpInj := Nat2Z.inj_mul }. -Add Zify BinOp Op_mul. +Add Tify BinOp Op_mul. #[global] Instance Op_min : BinOp Nat.min := { TBOp := Z.min ; TBOpInj := Nat2Z.inj_min }. -Add Zify BinOp Op_min. +Add Tify BinOp Op_min. #[global] Instance Op_max : BinOp Nat.max := { TBOp := Z.max ; TBOpInj := Nat2Z.inj_max }. -Add Zify BinOp Op_max. +Add Tify BinOp Op_max. #[global] Instance Op_pred : UnOp Nat.pred := { TUOp n := Z.max 0 (n - 1) ; TUOpInj := Nat2Z.inj_pred_max }. -Add Zify UnOp Op_pred. +Add Tify UnOp Op_pred. #[global] Instance Op_S : UnOp S := { TUOp x := Z.add x 1 ; TUOpInj := Nat2Z.inj_succ }. -Add Zify UnOp Op_S. +Add Tify UnOp Op_S. #[global] Instance Op_O : CstOp O := { TCst := Z0 ; TCstInj := eq_refl (Z.of_nat 0) }. -Add Zify CstOp Op_O. +Add Tify CstOp Op_O. #[global] Instance Op_Z_abs_nat : UnOp Z.abs_nat := { TUOp := Z.abs ; TUOpInj := Zabs2Nat.id_abs }. -Add Zify UnOp Op_Z_abs_nat. +Add Tify UnOp Op_Z_abs_nat. #[global] Instance Op_nat_div2 : UnOp Nat.div2 := { TUOp x := x / 2 ; TUOpInj x := ltac:(now rewrite Nat2Z.inj_div2, Z.div2_div) }. -Add Zify UnOp Op_nat_div2. +Add Tify UnOp Op_nat_div2. #[global] Instance Op_nat_double : UnOp Nat.double := {| TUOp := Z.mul 2 ; TUOpInj := Nat2Z.inj_double |}. -Add Zify UnOp Op_nat_double. +Add Tify UnOp Op_nat_double. (** Support for positive *) #[global] Instance Inj_pos_Z : InjTyp positive Z := { inj := Zpos ; pred x := 0 < x ; cstr := Pos2Z.pos_is_pos }. -Add Zify InjTyp Inj_pos_Z. +Add Tify InjTyp Inj_pos_Z. #[global] Instance Op_pos_to_nat : UnOp Pos.to_nat := {TUOp x := x ; TUOpInj := positive_nat_Z}. -Add Zify UnOp Op_pos_to_nat. +Add Tify UnOp Op_pos_to_nat. #[global] Instance Inj_N_Z : InjTyp N Z := mkinj _ _ Z.of_N (fun x => 0 <= x ) N2Z.is_nonneg. -Add Zify InjTyp Inj_N_Z. +Add Tify InjTyp Inj_N_Z. #[global] Instance Op_N_to_nat : UnOp N.to_nat := { TUOp x := x ; TUOpInj := N_nat_Z }. -Add Zify UnOp Op_N_to_nat. +Add Tify UnOp Op_N_to_nat. (* zify_positive_rel *) #[global] Instance Op_pos_ge : BinRel Pos.ge := { TR := Z.ge; TRInj x y := iff_refl (Z.pos x >= Z.pos y) }. -Add Zify BinRel Op_pos_ge. +Add Tify BinRel Op_pos_ge. #[global] Instance Op_pos_lt : BinRel Pos.lt := { TR := Z.lt; TRInj x y := iff_refl (Z.pos x < Z.pos y) }. -Add Zify BinRel Op_pos_lt. +Add Tify BinRel Op_pos_lt. #[global] Instance Op_pos_gt : BinRel Pos.gt := { TR := Z.gt; TRInj x y := iff_refl (Z.pos x > Z.pos y) }. -Add Zify BinRel Op_pos_gt. +Add Tify BinRel Op_pos_gt. #[global] Instance Op_pos_le : BinRel Pos.le := { TR := Z.le; TRInj x y := iff_refl (Z.pos x <= Z.pos y) }. -Add Zify BinRel Op_pos_le. +Add Tify BinRel Op_pos_le. Lemma eq_pos_inj x y : x = y <-> Z.pos x = Z.pos y. Proof. @@ -183,265 +183,265 @@ Qed. #[global] Instance Op_eq_pos : BinRel (@eq positive) := { TR := @eq Z ; TRInj := eq_pos_inj }. -Add Zify BinRel Op_eq_pos. +Add Tify BinRel Op_eq_pos. (* zify_positive_op *) #[global] Instance Op_Z_of_N : UnOp Z.of_N := { TUOp x := x ; TUOpInj x := eq_refl (Z.of_N x) }. -Add Zify UnOp Op_Z_of_N. +Add Tify UnOp Op_Z_of_N. #[global] Instance Op_Z_to_N : UnOp Z.to_N := { TUOp x := Z.max 0 x ; TUOpInj x := ltac:(now destruct x) }. -Add Zify UnOp Op_Z_to_N. +Add Tify UnOp Op_Z_to_N. #[global] Instance Op_Z_neg : UnOp Z.neg := { TUOp := Z.opp ; TUOpInj x := eq_refl (Zneg x) }. -Add Zify UnOp Op_Z_neg. +Add Tify UnOp Op_Z_neg. #[global] Instance Op_Z_pos : UnOp Z.pos := { TUOp x := x ; TUOpInj x := eq_refl (Z.pos x) }. -Add Zify UnOp Op_Z_pos. +Add Tify UnOp Op_Z_pos. #[global] Instance Op_pos_succ : UnOp Pos.succ := { TUOp x := x + 1 ; TUOpInj := Pos2Z.inj_succ }. -Add Zify UnOp Op_pos_succ. +Add Tify UnOp Op_pos_succ. #[global] Instance Op_pos_pred_double : UnOp Pos.pred_double := { TUOp x := 2 * x - 1 ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_pos_pred_double. +Add Tify UnOp Op_pos_pred_double. #[global] Instance Op_pos_pred : UnOp Pos.pred := { TUOp x := Z.max 1 (x - 1) ; TUOpInj x := ltac:(rewrite <- Pos.sub_1_r; apply Pos2Z.inj_sub_max) }. -Add Zify UnOp Op_pos_pred. +Add Tify UnOp Op_pos_pred. #[global] Instance Op_pos_predN : UnOp Pos.pred_N := { TUOp x := x - 1 ; TUOpInj x := ltac: (now destruct x; rewrite N.pos_pred_spec) }. -Add Zify UnOp Op_pos_predN. +Add Tify UnOp Op_pos_predN. #[global] Instance Op_pos_of_succ_nat : UnOp Pos.of_succ_nat := { TUOp x := x + 1 ; TUOpInj := Zpos_P_of_succ_nat }. -Add Zify UnOp Op_pos_of_succ_nat. +Add Tify UnOp Op_pos_of_succ_nat. #[global] Instance Op_pos_of_nat : UnOp Pos.of_nat := { TUOp x := Z.max 1 x ; TUOpInj x := ltac: (now destruct x; [|rewrite <- Pos.of_nat_succ, <- (Nat2Z.inj_max 1)]) }. -Add Zify UnOp Op_pos_of_nat. +Add Tify UnOp Op_pos_of_nat. #[global] Instance Op_pos_add : BinOp Pos.add := { TBOp := Z.add ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_pos_add. +Add Tify BinOp Op_pos_add. #[global] Instance Op_pos_add_carry : BinOp Pos.add_carry := { TBOp x y := x + y + 1 ; TBOpInj := ltac:(now intros; rewrite Pos.add_carry_spec, Pos2Z.inj_succ) }. -Add Zify BinOp Op_pos_add_carry. +Add Tify BinOp Op_pos_add_carry. #[global] Instance Op_pos_sub : BinOp Pos.sub := { TBOp n m := Z.max 1 (n - m) ; TBOpInj := Pos2Z.inj_sub_max }. -Add Zify BinOp Op_pos_sub. +Add Tify BinOp Op_pos_sub. #[global] Instance Op_pos_mul : BinOp Pos.mul := { TBOp := Z.mul ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_pos_mul. +Add Tify BinOp Op_pos_mul. #[global] Instance Op_pos_min : BinOp Pos.min := { TBOp := Z.min ; TBOpInj := Pos2Z.inj_min }. -Add Zify BinOp Op_pos_min. +Add Tify BinOp Op_pos_min. #[global] Instance Op_pos_max : BinOp Pos.max := { TBOp := Z.max ; TBOpInj := Pos2Z.inj_max }. -Add Zify BinOp Op_pos_max. +Add Tify BinOp Op_pos_max. #[global] Instance Op_pos_pow : BinOp Pos.pow := { TBOp := Z.pow ; TBOpInj := Pos2Z.inj_pow }. -Add Zify BinOp Op_pos_pow. +Add Tify BinOp Op_pos_pow. #[global] Instance Op_pos_square : UnOp Pos.square := { TUOp := Z.square ; TUOpInj := Pos2Z.inj_square }. -Add Zify UnOp Op_pos_square. +Add Tify UnOp Op_pos_square. #[global] Instance Op_Pos_Nsucc_double : UnOp Pos.Nsucc_double := { TUOp x := 2 * x + 1 ; TUOpInj x := ltac:(now destruct x) }. -Add Zify UnOp Op_Pos_Nsucc_double. +Add Tify UnOp Op_Pos_Nsucc_double. #[global] Instance Op_Pos_Ndouble : UnOp Pos.Ndouble := { TUOp x := 2 * x ; TUOpInj x := ltac:(now destruct x) }. -Add Zify UnOp Op_Pos_Ndouble. +Add Tify UnOp Op_Pos_Ndouble. #[global] Instance Op_xO : UnOp xO := { TUOp x := 2 * x ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_xO. +Add Tify UnOp Op_xO. #[global] Instance Op_xI : UnOp xI := { TUOp x := 2 * x + 1 ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_xI. +Add Tify UnOp Op_xI. #[global] Instance Op_xH : CstOp xH := { TCst := 1%Z ; TCstInj := eq_refl }. -Add Zify CstOp Op_xH. +Add Tify CstOp Op_xH. #[global] Instance Op_Z_of_nat : UnOp Z.of_nat:= { TUOp x := x ; TUOpInj x := eq_refl (Z.of_nat x) }. -Add Zify UnOp Op_Z_of_nat. +Add Tify UnOp Op_Z_of_nat. (* zify_N_rel *) #[global] Instance Op_N_ge : BinRel N.ge := { TR := Z.ge ; TRInj := N2Z.inj_ge }. -Add Zify BinRel Op_N_ge. +Add Tify BinRel Op_N_ge. #[global] Instance Op_N_lt : BinRel N.lt := { TR := Z.lt ; TRInj := N2Z.inj_lt }. -Add Zify BinRel Op_N_lt. +Add Tify BinRel Op_N_lt. #[global] Instance Op_N_gt : BinRel N.gt := { TR := Z.gt ; TRInj := N2Z.inj_gt }. -Add Zify BinRel Op_N_gt. +Add Tify BinRel Op_N_gt. #[global] Instance Op_N_le : BinRel N.le := { TR := Z.le ; TRInj := N2Z.inj_le }. -Add Zify BinRel Op_N_le. +Add Tify BinRel Op_N_le. #[global] Instance Op_eq_N : BinRel (@eq N) := { TR := @eq Z ; TRInj x y := iff_sym (N2Z.inj_iff x y) }. -Add Zify BinRel Op_eq_N. +Add Tify BinRel Op_eq_N. (* zify_N_op *) #[global] Instance Op_N_N0 : CstOp N0 := { TCst := Z0 ; TCstInj := eq_refl }. -Add Zify CstOp Op_N_N0. +Add Tify CstOp Op_N_N0. #[global] Instance Op_N_Npos : UnOp Npos := { TUOp x := x ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_N_Npos. +Add Tify UnOp Op_N_Npos. #[global] Instance Op_N_of_nat : UnOp N.of_nat := { TUOp x := x ; TUOpInj := nat_N_Z }. -Add Zify UnOp Op_N_of_nat. +Add Tify UnOp Op_N_of_nat. #[global] Instance Op_Z_abs_N : UnOp Z.abs_N := { TUOp := Z.abs ; TUOpInj := N2Z.inj_abs_N }. -Add Zify UnOp Op_Z_abs_N. +Add Tify UnOp Op_Z_abs_N. #[global] Instance Op_N_pos : UnOp N.pos := { TUOp x := x ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_N_pos. +Add Tify UnOp Op_N_pos. #[global] Instance Op_N_add : BinOp N.add := { TBOp := Z.add ; TBOpInj := N2Z.inj_add }. -Add Zify BinOp Op_N_add. +Add Tify BinOp Op_N_add. #[global] Instance Op_N_min : BinOp N.min := { TBOp := Z.min ; TBOpInj := N2Z.inj_min }. -Add Zify BinOp Op_N_min. +Add Tify BinOp Op_N_min. #[global] Instance Op_N_max : BinOp N.max := { TBOp := Z.max ; TBOpInj := N2Z.inj_max }. -Add Zify BinOp Op_N_max. +Add Tify BinOp Op_N_max. #[global] Instance Op_N_mul : BinOp N.mul := { TBOp := Z.mul ; TBOpInj := N2Z.inj_mul }. -Add Zify BinOp Op_N_mul. +Add Tify BinOp Op_N_mul. #[global] Instance Op_N_sub : BinOp N.sub := { TBOp x y := Z.max 0 (x - y) ; TBOpInj := N2Z.inj_sub_max }. -Add Zify BinOp Op_N_sub. +Add Tify BinOp Op_N_sub. #[global] Instance Op_N_div : BinOp N.div := { TBOp := Z.div ; TBOpInj := N2Z.inj_div }. -Add Zify BinOp Op_N_div. +Add Tify BinOp Op_N_div. #[global] Instance Op_N_mod : BinOp N.modulo := { TBOp := Z.rem ; TBOpInj := N2Z.inj_rem }. -Add Zify BinOp Op_N_mod. +Add Tify BinOp Op_N_mod. #[global] Instance Op_N_pred : UnOp N.pred := { TUOp x := Z.max 0 (x - 1) ; TUOpInj x := ltac:(rewrite N.pred_sub; apply N2Z.inj_sub_max) }. -Add Zify UnOp Op_N_pred. +Add Tify UnOp Op_N_pred. #[global] Instance Op_N_succ : UnOp N.succ := { TUOp x := x + 1 ; TUOpInj := N2Z.inj_succ }. -Add Zify UnOp Op_N_succ. +Add Tify UnOp Op_N_succ. #[global] Instance Op_N_succ_double : UnOp N.succ_double := { TUOp x := 2 * x + 1 ; TUOpInj x := ltac:(now destruct x) }. -Add Zify UnOp Op_N_succ_double. +Add Tify UnOp Op_N_succ_double. #[global] Instance Op_N_double : UnOp N.double := { TUOp x := 2 * x ; TUOpInj x := ltac:(now destruct x) }. -Add Zify UnOp Op_N_double. +Add Tify UnOp Op_N_double. #[global] Instance Op_N_succ_pos : UnOp N.succ_pos := { TUOp x := x + 1 ; TUOpInj x := ltac:(now destruct x; simpl; [| rewrite Pplus_one_succ_r]) }. -Add Zify UnOp Op_N_succ_pos. +Add Tify UnOp Op_N_succ_pos. #[global] Instance Op_N_div2 : UnOp N.div2 := { TUOp x := x / 2 ; TUOpInj x := ltac:(now rewrite N2Z.inj_div2, Z.div2_div) }. -Add Zify UnOp Op_N_div2. +Add Tify UnOp Op_N_div2. #[global] Instance Op_N_pow : BinOp N.pow := { TBOp := Z.pow ; TBOpInj := N2Z.inj_pow }. -Add Zify BinOp Op_N_pow. +Add Tify BinOp Op_N_pow. #[global] Instance Op_N_square : UnOp N.square := { TUOp x := x * x ; TUOpInj x := ltac:(now rewrite N.square_spec, N2Z.inj_mul) }. -Add Zify UnOp Op_N_square. +Add Tify UnOp Op_N_square. (** Support for Z - injected to itself *) @@ -449,137 +449,137 @@ Add Zify UnOp Op_N_square. #[global] Instance Op_Z_ge : BinRel Z.ge := { TR := Z.ge ; TRInj x y := iff_refl (x>= y) }. -Add Zify BinRel Op_Z_ge. +Add Tify BinRel Op_Z_ge. #[global] Instance Op_Z_lt : BinRel Z.lt := { TR := Z.lt ; TRInj x y := iff_refl (x < y) }. -Add Zify BinRel Op_Z_lt. +Add Tify BinRel Op_Z_lt. #[global] Instance Op_Z_gt : BinRel Z.gt := { TR := Z.gt ;TRInj x y := iff_refl (x > y) }. -Add Zify BinRel Op_Z_gt. +Add Tify BinRel Op_Z_gt. #[global] Instance Op_Z_le : BinRel Z.le := { TR := Z.le ;TRInj x y := iff_refl (x <= y) }. -Add Zify BinRel Op_Z_le. +Add Tify BinRel Op_Z_le. #[global] Instance Op_eqZ : BinRel (@eq Z) := { TR := @eq Z ; TRInj x y := iff_refl (x = y) }. -Add Zify BinRel Op_eqZ. +Add Tify BinRel Op_eqZ. #[global] Instance Op_Z_Z0 : CstOp Z0 := { TCst := Z0 ; TCstInj := eq_refl }. -Add Zify CstOp Op_Z_Z0. +Add Tify CstOp Op_Z_Z0. #[global] Instance Op_Z_add : BinOp Z.add := { TBOp := Z.add ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_add. +Add Tify BinOp Op_Z_add. #[global] Instance Op_Z_min : BinOp Z.min := { TBOp := Z.min ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_min. +Add Tify BinOp Op_Z_min. #[global] Instance Op_Z_max : BinOp Z.max := { TBOp := Z.max ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_max. +Add Tify BinOp Op_Z_max. #[global] Instance Op_Z_mul : BinOp Z.mul := { TBOp := Z.mul ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_mul. +Add Tify BinOp Op_Z_mul. #[global] Instance Op_Z_sub : BinOp Z.sub := { TBOp := Z.sub ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_sub. +Add Tify BinOp Op_Z_sub. #[global] Instance Op_Z_div : BinOp Z.div := { TBOp := Z.div ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_div. +Add Tify BinOp Op_Z_div. #[global] Instance Op_Z_mod : BinOp Z.modulo := { TBOp := Z.modulo ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_mod. +Add Tify BinOp Op_Z_mod. #[global] Instance Op_Z_rem : BinOp Z.rem := { TBOp := Z.rem ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_rem. +Add Tify BinOp Op_Z_rem. #[global] Instance Op_Z_quot : BinOp Z.quot := { TBOp := Z.quot ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_quot. +Add Tify BinOp Op_Z_quot. #[global] Instance Op_Z_succ : UnOp Z.succ := { TUOp x := x + 1 ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_Z_succ. +Add Tify UnOp Op_Z_succ. #[global] Instance Op_Z_pred : UnOp Z.pred := { TUOp x := x - 1 ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_Z_pred. +Add Tify UnOp Op_Z_pred. #[global] Instance Op_Z_opp : UnOp Z.opp := { TUOp := Z.opp ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_Z_opp. +Add Tify UnOp Op_Z_opp. #[global] Instance Op_Z_abs : UnOp Z.abs := { TUOp := Z.abs ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_Z_abs. +Add Tify UnOp Op_Z_abs. #[global] Instance Op_Z_sgn : UnOp Z.sgn := { TUOp := Z.sgn ; TUOpInj _ := eq_refl }. -Add Zify UnOp Op_Z_sgn. +Add Tify UnOp Op_Z_sgn. #[global] Instance Op_Z_pow : BinOp Z.pow := { TBOp := Z.pow ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_pow. +Add Tify BinOp Op_Z_pow. #[global] Instance Op_Z_pow_pos : BinOp Z.pow_pos := { TBOp := Z.pow ; TBOpInj _ _ := eq_refl }. -Add Zify BinOp Op_Z_pow_pos. +Add Tify BinOp Op_Z_pow_pos. #[global] Instance Op_Z_double : UnOp Z.double := { TUOp := Z.mul 2 ; TUOpInj := Z.double_spec }. -Add Zify UnOp Op_Z_double. +Add Tify UnOp Op_Z_double. #[global] Instance Op_Z_pred_double : UnOp Z.pred_double := { TUOp x := 2 * x - 1 ; TUOpInj := Z.pred_double_spec }. -Add Zify UnOp Op_Z_pred_double. +Add Tify UnOp Op_Z_pred_double. #[global] Instance Op_Z_succ_double : UnOp Z.succ_double := { TUOp x := 2 * x + 1 ; TUOpInj := Z.succ_double_spec }. -Add Zify UnOp Op_Z_succ_double. +Add Tify UnOp Op_Z_succ_double. #[global] Instance Op_Z_square : UnOp Z.square := { TUOp x := x * x ; TUOpInj := Z.square_spec }. -Add Zify UnOp Op_Z_square. +Add Tify UnOp Op_Z_square. #[global] Instance Op_Z_div2 : UnOp Z.div2 := { TUOp x := x / 2 ; TUOpInj := Z.div2_div }. -Add Zify UnOp Op_Z_div2. +Add Tify UnOp Op_Z_div2. Local Lemma Zquot2_quot n : Z.quot2 n = n ÷ 2. Proof. @@ -590,7 +590,7 @@ Qed. #[global] Instance Op_Z_quot2 : UnOp Z.quot2 := { TUOp x := Z.quot x 2 ; TUOpInj := Zquot2_quot }. -Add Zify UnOp Op_Z_quot2. +Add Tify UnOp Op_Z_quot2. Lemma of_nat_to_nat_eq x : Z.of_nat (Z.to_nat x) = Z.max 0 x. Proof. @@ -603,37 +603,37 @@ Qed. #[global] Instance Op_Z_to_nat : UnOp Z.to_nat := { TUOp x := Z.max 0 x ; TUOpInj := of_nat_to_nat_eq }. -Add Zify UnOp Op_Z_to_nat. +Add Tify UnOp Op_Z_to_nat. #[global] Instance Op_Z_to_pos : UnOp Z.to_pos := { TUOp x := Z.max 1 x ; TUOpInj x := ltac:(now simpl; destruct x; [| rewrite <- Pos2Z.inj_max; rewrite Pos.max_1_l |]) }. -Add Zify UnOp Op_Z_to_pos. +Add Tify UnOp Op_Z_to_pos. (** Specification of derived operators over Z *) #[global] Instance ZmaxSpec : BinOpSpec Z.max := { BPred n m r := n < m /\ r = m \/ m <= n /\ r = n ; BSpec := Z.max_spec }. -Add Zify BinOpSpec ZmaxSpec. +Add Tify BinOpSpec ZmaxSpec. #[global] Instance ZminSpec : BinOpSpec Z.min := { BPred n m r := n < m /\ r = n \/ m <= n /\ r = m ; BSpec := Z.min_spec }. -Add Zify BinOpSpec ZminSpec. +Add Tify BinOpSpec ZminSpec. #[global] Instance ZsgnSpec : UnOpSpec Z.sgn := { UPred n r := 0 < n /\ r = 1 \/ 0 = n /\ r = 0 \/ n < 0 /\ r = - 1 ; USpec := Z.sgn_spec }. -Add Zify UnOpSpec ZsgnSpec. +Add Tify UnOpSpec ZsgnSpec. #[global] Instance ZabsSpec : UnOpSpec Z.abs := { UPred n r := 0 <= n /\ r = n \/ n < 0 /\ r = - n ; USpec := Z.abs_spec }. -Add Zify UnOpSpec ZabsSpec. +Add Tify UnOpSpec ZabsSpec. (** Saturate positivity constraints *) @@ -643,7 +643,7 @@ Instance SatPowPos : Saturate Z.pow := PArg2 y := 0 <= y; PRes _ _ r := 0 < r; SatOk := fun x y => Z.pow_pos_nonneg x y}. -Add Zify Saturate SatPowPos. +Add Tify Saturate SatPowPos. #[global] Instance SatPowNonneg : Saturate Z.pow := @@ -651,6 +651,6 @@ Instance SatPowNonneg : Saturate Z.pow := PArg2 y := True; PRes _ _ r := 0 <= r; SatOk a b Ha _ := @Z.pow_nonneg a b Ha }. -Add Zify Saturate SatPowNonneg. +Add Tify Saturate SatPowNonneg. (* TODO #14736 for compatibility only, should be removed after deprecation *) diff --git a/theories/micromega/ZifyN.v b/theories/micromega/ZifyN.v index 6b22d6882f..3bcae6c7f6 100644 --- a/theories/micromega/ZifyN.v +++ b/theories/micromega/ZifyN.v @@ -23,17 +23,17 @@ Existing Instance Inj_N_Z. #[global] Instance Op_N_div : BinOp N.div := {| TBOp := Z.div ; TBOpInj := N2Z.inj_div |}. -Add Zify BinOp Op_N_div. +Add Tify BinOp Op_N_div. #[global] Instance Op_N_mod : BinOp N.modulo := {| TBOp := Z.rem ; TBOpInj := N2Z.inj_rem |}. -Add Zify BinOp Op_N_mod. +Add Tify BinOp Op_N_mod. #[global] Instance Op_N_pow : BinOp N.pow := {| TBOp := Z.pow ; TBOpInj := N2Z.inj_pow|}. -Add Zify BinOp Op_N_pow. +Add Tify BinOp Op_N_pow. #[local] Open Scope Z_scope. @@ -64,7 +64,7 @@ Instance SatDiv : Saturate Z.div := PRes := fun _ _ r => 0 <= r; SatOk := Z_div_nonneg_nonneg |}. -Add Zify Saturate SatDiv. +Add Tify Saturate SatDiv. #[global] Instance SatMod : Saturate Z.modulo := @@ -74,4 +74,4 @@ Instance SatMod : Saturate Z.modulo := PRes := fun _ _ r => 0 <= r; SatOk := Z_mod_nonneg_nonneg |}. -Add Zify Saturate SatMod. +Add Tify Saturate SatMod. diff --git a/theories/micromega/ZifyNat.v b/theories/micromega/ZifyNat.v index ea752a3ab4..130a367158 100644 --- a/theories/micromega/ZifyNat.v +++ b/theories/micromega/ZifyNat.v @@ -23,14 +23,14 @@ Existing Instance Inj_nat_Z. #[global] Instance Op_mod : BinOp Nat.modulo := {| TBOp := Z.modulo ; TBOpInj := Nat2Z.inj_mod |}. -Add Zify BinOp Op_mod. +Add Tify BinOp Op_mod. #[global] Instance Op_div : BinOp Nat.div := {| TBOp := Z.div ; TBOpInj := Nat2Z.inj_div |}. -Add Zify BinOp Op_div. +Add Tify BinOp Op_div. #[global] Instance Op_pow : BinOp Nat.pow := {| TBOp := Z.pow ; TBOpInj := Nat2Z.inj_pow |}. -Add Zify BinOp Op_pow. +Add Tify BinOp Op_pow. diff --git a/theories/micromega/ZifySint63.v b/theories/micromega/ZifySint63.v index 15a860a3fb..aa25fde6bb 100644 --- a/theories/micromega/ZifySint63.v +++ b/theories/micromega/ZifySint63.v @@ -11,32 +11,32 @@ Proof. now apply to_Z_bounded. Qed. Instance Inj_int_Z : InjTyp int Z := mkinj _ _ to_Z (fun x => -4611686018427387904 <= x <= 4611686018427387903)%Z to_Z_bounded. -Add Zify InjTyp Inj_int_Z. +Add Tify InjTyp Inj_int_Z. #[global] Instance Op_max_int : CstOp max_int := { TCst := 4611686018427387903 ; TCstInj := eq_refl }. -Add Zify CstOp Op_max_int. +Add Tify CstOp Op_max_int. #[global] Instance Op_min_int : CstOp min_int := { TCst := -4611686018427387904 ; TCstInj := eq_refl }. -Add Zify CstOp Op_min_int. +Add Tify CstOp Op_min_int. #[global] Instance Op_digits : CstOp digits := { TCst := 63 ; TCstInj := eq_refl }. -Add Zify CstOp Op_digits. +Add Tify CstOp Op_digits. #[global] Instance Op_size : CstOp size := { TCst := 63 ; TCstInj := eq_refl }. -Add Zify CstOp Op_size. +Add Tify CstOp Op_size. #[global] Instance Op_wB : CstOp wB := { TCst := 2^63 ; TCstInj := eq_refl }. -Add Zify CstOp Op_wB. +Add Tify CstOp Op_wB. Lemma ltb_lt : forall n m, (n (to_Z n = to_Z m)%sint63. Proof. @@ -89,7 +89,7 @@ Qed. #[global] Instance Op_eq : BinRel (@eq int) := {| TR := @eq Z; TRInj := eq_int_inj |}. -Add Zify BinRel Op_eq. +Add Tify BinRel Op_eq. Notation cmodwB x := ((x + 4611686018427387904) mod 9223372036854775808 - 4611686018427387904)%Z. @@ -97,42 +97,42 @@ Notation cmodwB x := #[global] Instance Op_add : BinOp add := {| TBOp := fun x y => cmodwB (x + y); TBOpInj := add_spec |}%Z. -Add Zify BinOp Op_add. +Add Tify BinOp Op_add. #[global] Instance Op_sub : BinOp sub := {| TBOp := fun x y => cmodwB (x - y); TBOpInj := sub_spec |}%Z. -Add Zify BinOp Op_sub. +Add Tify BinOp Op_sub. #[global] Instance Op_opp : UnOp Uint63.opp := {| TUOp := fun x => cmodwB (- x); TUOpInj := (sub_spec 0) |}%Z. -Add Zify UnOp Op_opp. +Add Tify UnOp Op_opp. #[global] Instance Op_succ : UnOp succ := {| TUOp := fun x => cmodwB (x + 1); TUOpInj := succ_spec |}%Z. -Add Zify UnOp Op_succ. +Add Tify UnOp Op_succ. #[global] Instance Op_pred : UnOp Uint63.pred := {| TUOp := fun x => cmodwB (x - 1); TUOpInj := pred_spec |}%Z. -Add Zify UnOp Op_pred. +Add Tify UnOp Op_pred. #[global] Instance Op_mul : BinOp mul := {| TBOp := fun x y => cmodwB (x * y); TBOpInj := mul_spec |}%Z. -Add Zify BinOp Op_mul. +Add Tify BinOp Op_mul. #[global] Instance Op_mod : BinOp PrimInt63.mods := {| TBOp := Z.rem ; TBOpInj := mod_spec |}. -Add Zify BinOp Op_mod. +Add Tify BinOp Op_mod. #[global] Instance Op_asr : BinOp asr := {| TBOp := fun x y => x / 2^ y ; TBOpInj := asr_spec |}%Z. -Add Zify BinOp Op_asr. +Add Tify BinOp Op_asr. Definition quots (x d : Z) : Z := if ((x =? -4611686018427387904)%Z && (d =? -1)%Z)%bool then @@ -155,7 +155,7 @@ Qed. #[global] Instance Op_div : BinOp div := {| TBOp := quots ; TBOpInj := div_quots |}. -Add Zify BinOp Op_div. +Add Tify BinOp Op_div. Lemma quots_spec (x y : Z) : ((x = -4611686018427387904 /\ y = -1 /\ quots x y = -4611686018427387904) @@ -172,17 +172,17 @@ Instance quotsSpec : BinOpSpec quots := ((x = -4611686018427387904 /\ d = -1 /\ r = -4611686018427387904) \/ ((x <> -4611686018427387904 \/ d <> -1) /\ r = Z.quot x d))%Z; BSpec := quots_spec |}. -Add Zify BinOpSpec quotsSpec. +Add Tify BinOpSpec quotsSpec. #[global] Instance Op_of_Z : UnOp of_Z := { TUOp := fun x => cmodwB x; TUOpInj := of_Z_spec }. -Add Zify UnOp Op_of_Z. +Add Tify UnOp Op_of_Z. #[global] Instance Op_to_Z : UnOp to_Z := { TUOp := fun x => x ; TUOpInj := fun x : int => eq_refl }. -Add Zify UnOp Op_to_Z. +Add Tify UnOp Op_to_Z. Lemma is_zeroE : forall n : int, is_zero n = (to_Z n =? 0)%Z. Proof. @@ -195,11 +195,11 @@ Qed. #[global] Instance Op_is_zero : UnOp is_zero := { TUOp := (Z.eqb 0) ; TUOpInj := is_zeroE }. -Add Zify UnOp Op_is_zero. +Add Tify UnOp Op_is_zero. #[global] Instance Op_abs : UnOp abs := { TUOp := fun x => cmodwB (Z.abs x) ; TUOpInj := abs_spec }. -Add Zify UnOp Op_abs. +Add Tify UnOp Op_abs. Ltac Zify.zify_convert_to_euclidean_division_equations_flag ::= constr:(true). diff --git a/theories/micromega/ZifyUint63.v b/theories/micromega/ZifyUint63.v index 7deed6a801..5cd22cb92f 100644 --- a/theories/micromega/ZifyUint63.v +++ b/theories/micromega/ZifyUint63.v @@ -9,27 +9,27 @@ Proof. apply to_Z_bounded. Qed. #[global] Instance Inj_int_Z : InjTyp int Z := mkinj _ _ to_Z (fun x => 0 <= x < 9223372036854775808)%Z to_Z_bounded. -Add Zify InjTyp Inj_int_Z. +Add Tify InjTyp Inj_int_Z. #[global] Instance Op_max_int : CstOp max_int := { TCst := 9223372036854775807 ; TCstInj := eq_refl }. -Add Zify CstOp Op_max_int. +Add Tify CstOp Op_max_int. #[global] Instance Op_digits : CstOp digits := { TCst := 63 ; TCstInj := eq_refl }. -Add Zify CstOp Op_digits. +Add Tify CstOp Op_digits. #[global] Instance Op_size : CstOp size := { TCst := 63 ; TCstInj := eq_refl }. -Add Zify CstOp Op_size. +Add Tify CstOp Op_size. #[global] Instance Op_wB : CstOp wB := { TCst := 2^63 ; TCstInj := eq_refl }. -Add Zify CstOp Op_wB. +Add Tify CstOp Op_wB. Lemma ltb_lt : forall n m, (n (φ n = φ m)%uint63. Proof. @@ -82,112 +82,112 @@ Qed. #[global] Instance Op_eq : BinRel (@eq int) := {| TR := @eq Z; TRInj := eq_int_inj |}. -Add Zify BinRel Op_eq. +Add Tify BinRel Op_eq. #[global] Instance Op_add : BinOp add := {| TBOp := fun x y => (x + y) mod 9223372036854775808%Z; TBOpInj := add_spec |}%Z. -Add Zify BinOp Op_add. +Add Tify BinOp Op_add. #[global] Instance Op_sub : BinOp sub := {| TBOp := fun x y => (x - y) mod 9223372036854775808%Z; TBOpInj := sub_spec |}%Z. -Add Zify BinOp Op_sub. +Add Tify BinOp Op_sub. #[global] Instance Op_opp : UnOp Uint63.opp := {| TUOp := (fun x => (- x) mod 9223372036854775808)%Z; TUOpInj := (sub_spec 0) |}%Z. -Add Zify UnOp Op_opp. +Add Tify UnOp Op_opp. #[global] Instance Op_oppcarry : UnOp oppcarry := {| TUOp := (fun x => 2^63 - x - 1)%Z; TUOpInj := oppcarry_spec |}%Z. -Add Zify UnOp Op_oppcarry. +Add Tify UnOp Op_oppcarry. #[global] Instance Op_succ : UnOp succ := {| TUOp := (fun x => (x + 1) mod 2^63)%Z; TUOpInj := succ_spec |}%Z. -Add Zify UnOp Op_succ. +Add Tify UnOp Op_succ. #[global] Instance Op_pred : UnOp Uint63.pred := {| TUOp := (fun x => (x - 1) mod 2^63)%Z; TUOpInj := pred_spec |}%Z. -Add Zify UnOp Op_pred. +Add Tify UnOp Op_pred. #[global] Instance Op_mul : BinOp mul := {| TBOp := fun x y => (x * y) mod 9223372036854775808%Z; TBOpInj := mul_spec |}%Z. -Add Zify BinOp Op_mul. +Add Tify BinOp Op_mul. #[global] Instance Op_gcd : BinOp gcd:= {| TBOp := (fun x y => Zgcd_alt.Zgcdn (2 * 63)%nat y x) ; TBOpInj := to_Z_gcd |}. -Add Zify BinOp Op_gcd. +Add Tify BinOp Op_gcd. #[global] Instance Op_mod : BinOp Uint63.mod := {| TBOp := Z.modulo ; TBOpInj := mod_spec |}. -Add Zify BinOp Op_mod. +Add Tify BinOp Op_mod. #[global] Instance Op_subcarry : BinOp subcarry := {| TBOp := (fun x y => (x - y - 1) mod 2^63)%Z ; TBOpInj := subcarry_spec |}. -Add Zify BinOp Op_subcarry. +Add Tify BinOp Op_subcarry. #[global] Instance Op_addcarry : BinOp addcarry := {| TBOp := (fun x y => (x + y + 1) mod 2^63)%Z ; TBOpInj := addcarry_spec |}. -Add Zify BinOp Op_addcarry. +Add Tify BinOp Op_addcarry. #[global] Instance Op_lsr : BinOp lsr := {| TBOp := (fun x y => x / 2^ y)%Z ; TBOpInj := lsr_spec |}. -Add Zify BinOp Op_lsr. +Add Tify BinOp Op_lsr. #[global] Instance Op_lsl : BinOp lsl := {| TBOp := (fun x y => (x * 2^ y) mod 2^ 63)%Z ; TBOpInj := lsl_spec |}. -Add Zify BinOp Op_lsl. +Add Tify BinOp Op_lsl. #[global] Instance Op_lor : BinOp Uint63.lor := {| TBOp := Z.lor ; TBOpInj := lor_spec' |}. -Add Zify BinOp Op_lor. +Add Tify BinOp Op_lor. #[global] Instance Op_land : BinOp Uint63.land := {| TBOp := Z.land ; TBOpInj := land_spec' |}. -Add Zify BinOp Op_land. +Add Tify BinOp Op_land. #[global] Instance Op_lxor : BinOp Uint63.lxor := {| TBOp := Z.lxor ; TBOpInj := lxor_spec' |}. -Add Zify BinOp Op_lxor. +Add Tify BinOp Op_lxor. #[global] Instance Op_div : BinOp div := {| TBOp := Z.div ; TBOpInj := div_spec |}. -Add Zify BinOp Op_div. +Add Tify BinOp Op_div. #[global] Instance Op_bit : BinOp bit := {| TBOp := Z.testbit ; TBOpInj := bitE |}. -Add Zify BinOp Op_bit. +Add Tify BinOp Op_bit. #[global] Instance Op_of_Z : UnOp of_Z := { TUOp := (fun x => x mod 9223372036854775808)%Z; TUOpInj := of_Z_spec }. -Add Zify UnOp Op_of_Z. +Add Tify UnOp Op_of_Z. #[global] Instance Op_to_Z : UnOp to_Z := { TUOp := fun x => x ; TUOpInj := fun x : int => eq_refl }. -Add Zify UnOp Op_to_Z. +Add Tify UnOp Op_to_Z. #[global] Instance Op_is_zero : UnOp is_zero := { TUOp := (Z.eqb 0) ; TUOpInj := is_zeroE }. -Add Zify UnOp Op_is_zero. +Add Tify UnOp Op_is_zero. Lemma is_evenE : forall x, is_even x = Z.even (φ%uint63 x). @@ -203,7 +203,7 @@ Qed. #[global] Instance Op_is_even : UnOp is_even := { TUOp := Z.even ; TUOpInj := is_evenE }. -Add Zify UnOp Op_is_even. +Add Tify UnOp Op_is_even. Ltac Zify.zify_convert_to_euclidean_division_equations_flag ::= constr:(true). diff --git a/theories/setoid_ring/Cring.v b/theories/setoid_ring/Cring.v index b8b30a27c0..afbbf1a159 100644 --- a/theories/setoid_ring/Cring.v +++ b/theories/setoid_ring/Cring.v @@ -143,7 +143,7 @@ Ltac cring_simplify_aux lterm fv lexpr hyp := | ?t0::?lterm => match lexpr with | ?e::?le => - let t := constr:(@Ring_polynom.norm_subst + let t := constr:(@ring_checker.norm_subst Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Z.eqb Z.quotrem O nil e) in let te := constr:(@Ring_polynom.Pphi_dev diff --git a/theories/setoid_ring/Field_theory.v b/theories/setoid_ring/Field_theory.v index bfc6bb1de4..eff22b0e2f 100644 --- a/theories/setoid_ring/Field_theory.v +++ b/theories/setoid_ring/Field_theory.v @@ -10,6 +10,7 @@ From Corelib Require Import RelationClasses Setoid Morphisms. From Stdlib Require Import BinNat BinInt. +From Stdlib Require Export field_checker. From Stdlib.setoid_ring Require Import Ring_base Ring_polynom Ring_tac Ring_theory InitialRing. Set Implicit Arguments. @@ -553,23 +554,10 @@ Qed. ***************************************************************************) -#[local] Notation "a &&& b" := (if a then b else false) - (at level 40, left associativity). - (* equality test *) -Fixpoint PExpr_eq (e e' : PExpr C) {struct e} : bool := - match e, e' with - | PEc c, PEc c' => ceqb c c' - | PEX _ p, PEX _ p' => Pos.eqb p p' - | e1 + e2, e1' + e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2' - | e1 - e2, e1' - e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2' - | e1 * e2, e1' * e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2' - | - e, - e' => PExpr_eq e e' - | e ^ n, e' ^ n' => N.eqb n n' &&& PExpr_eq e e' - | _, _ => false - end%poly. - -Lemma if_true (a b : bool) : a &&& b = true -> a = true /\ b = true. +#[local] Notation PExpr_eq := (PExpr_eq ceqb). + +Lemma if_true (a b : bool) : andb a b = true -> a = true /\ b = true. Proof. destruct a, b; split; trivial. Qed. @@ -578,7 +566,7 @@ Theorem PExpr_eq_semi_ok e e' : PExpr_eq e e' = true -> (e === e')%poly. Proof. revert e'; induction e as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe|? IHe ?]; - intro e'; destruct e'; simpl; try discriminate. + intro e'; destruct e'; simpl; try reflexivity; try discriminate. - intros H l. now apply (morph_eq CRmorph). - case Pos.eqb_spec; intros; now subst. - intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2. @@ -598,15 +586,16 @@ Qed. (** Smart constructors for polynomial expression, with reduction of constants *) -Definition NPEadd e1 e2 := - match e1, e2 with - | PEc c1, PEc c2 => PEc (c1 + c2) - | PEc c, _ => if (c =? 0)%coef then e2 else e1 + e2 - | _, PEc c => if (c =? 0)%coef then e1 else e1 + e2 - (* Peut t'on factoriser ici ??? *) - | _, _ => (e1 + e2) - end%poly. +#[local] Notation NPEadd := (NPEadd cO cadd ceqb). +#[local] Notation NPEsub := (NPEsub cO csub ceqb). +#[local] Notation NPEopp := (NPEopp copp). +#[local] Notation NPEpow := (NPEpow cO cI (pow_pos cmul) ceqb). +#[local] Notation NPEmul := (NPEmul cO cI cmul (pow_pos cmul) ceqb). + Infix "++" := NPEadd (at level 60, right associativity). +Infix "--" := NPEsub (at level 50, left associativity). +Infix "^^" := NPEpow (at level 35, right associativity). +Infix "**" := NPEmul (at level 40, left associativity). Theorem NPEadd_ok e1 e2 : (e1 ++ e2 === e1 + e2)%poly. Proof. @@ -617,16 +606,6 @@ try apply eq_refl; try (ring [phi_0]). apply (morph_add CRmorph). Qed. -Definition NPEsub e1 e2 := - match e1, e2 with - | PEc c1, PEc c2 => PEc (c1 - c2) - | PEc c, _ => if (c =? 0)%coef then - e2 else e1 - e2 - | _, PEc c => if (c =? 0)%coef then e1 else e1 - e2 - (* Peut-on factoriser ici *) - | _, _ => e1 - e2 - end%poly. -Infix "--" := NPEsub (at level 50, left associativity). - Theorem NPEsub_ok e1 e2: (e1 -- e2 === e1 - e2)%poly. Proof. intros l. @@ -637,29 +616,11 @@ destruct e1, e2; simpl; try reflexivity; try case ceqb_spec; apply (morph_sub CRmorph). Qed. -Definition NPEopp e1 := - match e1 with PEc c1 => PEc (- c1) | _ => - e1 end%poly. - Theorem NPEopp_ok e : (NPEopp e === -e)%poly. Proof. intros l. destruct e; simpl; trivial. apply (morph_opp CRmorph). Qed. -Definition NPEpow x n := - match n with - | N0 => 1 - | Npos p => - if (p =? 1)%positive then x else - match x with - | PEc c => - if (c =? 1)%coef then 1 - else if (c =? 0)%coef then 0 - else PEc (pow_pos cmul c p) - | _ => x ^ n - end - end%poly. -Infix "^^" := NPEpow (at level 35, right associativity). - Theorem NPEpow_ok e n : (e ^^ n === e ^ n)%poly. Proof. intros l. unfold NPEpow; destruct n. @@ -673,16 +634,6 @@ Proof. * now rewrite pow_pos_cst. Qed. -Fixpoint NPEmul (x y : PExpr C) {struct x} : PExpr C := - match x, y with - | PEc c1, PEc c2 => PEc (c1 * c2) - | PEc c, _ => if (c =? 1)%coef then y else if (c =? 0)%coef then 0 else x * y - | _, PEc c => if (c =? 1)%coef then x else if (c =? 0)%coef then 0 else x * y - | e1 ^ n1, e2 ^ n2 => if (n1 =? n2)%N then (NPEmul e1 e2)^^n1 else x * y - | _, _ => x * y - end%poly. -Infix "**" := NPEmul (at level 40, left associativity). - Theorem NPEmul_ok e1 e2 : (e1 ** e2 === e1 * e2)%poly. Proof. intros l. @@ -697,16 +648,8 @@ revert e2; induction e1 as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe1 ? IHe2|? I destruct n; simpl; [ ring | apply pow_pos_mul_l ]. Qed. -(* simplification *) -Fixpoint PEsimp (e : PExpr C) : PExpr C := - match e with - | e1 + e2 => (PEsimp e1) ++ (PEsimp e2) - | e1 * e2 => (PEsimp e1) ** (PEsimp e2) - | e1 - e2 => (PEsimp e1) -- (PEsimp e2) - | - e1 => NPEopp (PEsimp e1) - | e1 ^ n1 => (PEsimp e1) ^^ n1 - | _ => e - end%poly. +#[local] Notation PEsimp := (PEsimp + cO cI cadd cmul csub copp (pow_pos cmul) ceqb). Theorem PEsimp_ok e : (PEsimp e === e)%poly. Proof. @@ -731,18 +674,7 @@ Qed. (* The input: syntax of a field expression *) -Inductive FExpr : Type := - | FEO : FExpr - | FEI : FExpr - | FEc: C -> FExpr - | FEX: positive -> FExpr - | FEadd: FExpr -> FExpr -> FExpr - | FEsub: FExpr -> FExpr -> FExpr - | FEmul: FExpr -> FExpr -> FExpr - | FEopp: FExpr -> FExpr - | FEinv: FExpr -> FExpr - | FEdiv: FExpr -> FExpr -> FExpr - | FEpow: FExpr -> N -> FExpr . +#[local] Notation FExpr := (FExpr C). Fixpoint FEeval (l : list R) (pe : FExpr) {struct pe} : R := match pe with @@ -763,10 +695,7 @@ Strategy expand [FEeval]. (* The result of the normalisation *) -Record linear : Type := mk_linear { - num : PExpr C; - denum : PExpr C; - condition : list (PExpr C) }. +#[local] Notation linear := (linear C). (*************************************************************************** @@ -807,9 +736,7 @@ induction l1 as [|a l1 IHl1]. - simpl app. rewrite !PCond_cons, IHl1. symmetry; apply and_assoc. Qed. - -(* An unsatisfiable condition: issued when a division by zero is detected *) -Definition absurd_PCond := cons 0%poly nil. +#[local] Notation absurd_PCond := (absurd_PCond cO). Lemma absurd_PCond_bottom : forall l, ~ PCond l absurd_PCond. Proof. @@ -825,35 +752,8 @@ Qed. ***************************************************************************) -Definition default_isIn e1 p1 e2 p2 := - if PExpr_eq e1 e2 then - match Z.pos_sub p1 p2 with - | Zpos p => Some (Npos p, 1%poly) - | Z0 => Some (N0, 1%poly) - | Zneg p => Some (N0, e2 ^^ Npos p) - end - else None. - -Fixpoint isIn e1 p1 e2 p2 {struct e2}: option (N * PExpr C) := - match e2 with - | e3 * e4 => - match isIn e1 p1 e3 p2 with - | Some (N0, e5) => Some (N0, e5 ** (e4 ^^ Npos p2)) - | Some (Npos p, e5) => - match isIn e1 p e4 p2 with - | Some (n, e6) => Some (n, e5 ** e6) - | None => Some (Npos p, e5 ** (e4 ^^ Npos p2)) - end - | None => - match isIn e1 p1 e4 p2 with - | Some (n, e5) => Some (n, (e3 ^^ Npos p2) ** e5) - | None => None - end - end - | e3 ^ N0 => None - | e3 ^ Npos p3 => isIn e1 p1 e3 (Pos.mul p3 p2) - | _ => default_isIn e1 p1 e2 p2 - end%poly. +#[local] Notation default_isIn := (default_isIn cO cI (pow_pos cmul) ceqb). +#[local] Notation isIn := (isIn cO cI cmul (pow_pos cmul) ceqb). Definition ZtoN z := match z with Zpos p => Npos p | _ => N0 end. Definition NtoZ n := match n with Npos p => Zpos p | _ => Z0 end. @@ -873,7 +773,7 @@ Fixpoint isIn e1 p1 e2 p2 {struct e2}: option (N * PExpr C) := | _ => True end. Proof. - unfold default_isIn. + unfold field_checker.default_isIn. case PExpr_eq_spec; trivial. intros EQ. rewrite Z.pos_sub_spec. case Pos.compare_spec;intros H; split; try reflexivity. @@ -900,7 +800,7 @@ Theorem isIn_ok e1 p1 e2 p2 : | _ => True end. Proof. -Opaque NPEpow. +Opaque field_checker.NPEpow. revert p1 p2. induction e2 as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe2_1 ? IHe2_2|? IHe|? IHe2 n]; intros p1 p2; try refine (default_isIn_ok e1 _ p1 p2); simpl isIn. @@ -949,33 +849,14 @@ induction e2 as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe2_1 ? IHe2_2|? IHe|? IH now rewrite <- PEpow_mul_r. Qed. -Record rsplit : Type := mk_rsplit { - rsplit_left : PExpr C; - rsplit_common : PExpr C; - rsplit_right : PExpr C}. - (* Stupid name clash *) -Notation left := rsplit_left. -Notation right := rsplit_right. -Notation common := rsplit_common. - -Fixpoint split_aux e1 p e2 {struct e1}: rsplit := - match e1 with - | e3 * e4 => - let r1 := split_aux e3 p e2 in - let r2 := split_aux e4 p (right r1) in - mk_rsplit (left r1 ** left r2) - (common r1 ** common r2) - (right r2) - | e3 ^ N0 => mk_rsplit 1 1 e2 - | e3 ^ Npos p3 => split_aux e3 (Pos.mul p3 p) e2 - | _ => - match isIn e1 p e2 1 with - | Some (N0,e3) => mk_rsplit 1 (e1 ^^ Npos p) e3 - | Some (Npos q, e3) => mk_rsplit (e1 ^^ Npos q) (e1 ^^ Npos (p - q)) e3 - | None => mk_rsplit (e1 ^^ Npos p) 1 e2 - end - end%poly. +Notation rsplit := (rsplit C). +Notation left := (@rsplit_left C). +Notation right := (@rsplit_right C). +Notation common := (@rsplit_common C). + +#[local] Notation split_aux := (split_aux cO cI cmul (pow_pos cmul) ceqb). +#[local] Notation split := (field_checker.split cO cI cmul (pow_pos cmul) ceqb). Lemma split_aux_ok1 e1 p e2 : (let res := match isIn e1 p e2 1 with @@ -987,7 +868,7 @@ Lemma split_aux_ok1 e1 p e2 : e1 ^ Npos p === left res * common res /\ e2 === right res * common res)%poly. Proof. - Opaque NPEpow NPEmul. + Opaque field_checker.NPEpow field_checker.NPEmul. intros res. unfold res;clear res; generalize (isIn_ok e1 p e2 xH). destruct (isIn e1 p e2 1) as [([|p'],e')|]; simpl. - intros (H1,H2); split; npe_simpl. @@ -1018,8 +899,6 @@ intro e1;induction e1 as [| |?|?|? IHe1_1 ? IHe1_2|? IHe1_1 ? IHe1_2|e1_1 IHe1_1 + rewrite <- PEpow_mul_r. simpl. apply IHe1. Qed. -Definition split e1 e2 := split_aux e1 xH e2. - Theorem split_ok_l e1 e2 : (e1 === left (split e1 e2) * common (split e1 e2))%poly. Proof. @@ -1046,54 +925,8 @@ Proof. now rewrite H, rmul_0_l. Qed. -Fixpoint Fnorm (e : FExpr) : linear := - match e with - | FEO => mk_linear 0 1 nil - | FEI => mk_linear 1 1 nil - | FEc c => mk_linear (PEc c) 1 nil - | FEX x => mk_linear (PEX C x) 1 nil - | FEadd e1 e2 => - let x := Fnorm e1 in - let y := Fnorm e2 in - let s := split (denum x) (denum y) in - mk_linear - ((num x ** right s) ++ (num y ** left s)) - (left s ** (right s ** common s)) - (condition x ++ condition y)%list - | FEsub e1 e2 => - let x := Fnorm e1 in - let y := Fnorm e2 in - let s := split (denum x) (denum y) in - mk_linear - ((num x ** right s) -- (num y ** left s)) - (left s ** (right s ** common s)) - (condition x ++ condition y)%list - | FEmul e1 e2 => - let x := Fnorm e1 in - let y := Fnorm e2 in - let s1 := split (num x) (denum y) in - let s2 := split (num y) (denum x) in - mk_linear (left s1 ** left s2) - (right s2 ** right s1) - (condition x ++ condition y)%list - | FEopp e1 => - let x := Fnorm e1 in - mk_linear (NPEopp (num x)) (denum x) (condition x) - | FEinv e1 => - let x := Fnorm e1 in - mk_linear (denum x) (num x) (num x :: condition x) - | FEdiv e1 e2 => - let x := Fnorm e1 in - let y := Fnorm e2 in - let s1 := split (num x) (num y) in - let s2 := split (denum x) (denum y) in - mk_linear (left s1 ** right s2) - (left s2 ** right s1) - (num y :: condition x ++ condition y)%list - | FEpow e1 n => - let x := Fnorm e1 in - mk_linear ((num x)^^n) ((denum x)^^n) (condition x) - end. +#[local] Notation Fnorm := (Fnorm + cO cI cadd cmul csub copp (pow_pos cmul) ceqb). (* Example *) (* @@ -1459,11 +1292,7 @@ Variable Fcons : PExpr C -> list (PExpr C) -> list (PExpr C). Hypothesis PCond_fcons_inv : forall l a l1, PCond l (Fcons a l1) -> ~ a @ l == 0 /\ PCond l l1. -Fixpoint Fapp (l m:list (PExpr C)) {struct l} : list (PExpr C) := - match l with - | nil => m - | cons a l1 => Fcons a (Fapp l1 m) - end. +#[local] Notation Fapp := (Fapp Fcons). Lemma fcons_ok : forall l l1, (forall lock, lock = PCond l -> lock (Fapp l1 nil)) -> PCond l l1. @@ -1500,21 +1329,16 @@ intros l a l1; induction l1 as [|e l1 IHl1]; simpl Fcons. + now apply IHl1. Qed. -(* equality of normal forms rather than syntactic equality *) -Fixpoint Fcons0 (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) := - match l with - nil => cons e nil - | cons a l1 => - if Peq ceqb (Nnorm O nil e) (Nnorm O nil a) then l - else cons a (Fcons0 e l1) - end. +#[local] Notation Fcons0 := (Fcons0 cO cI cadd cmul csub copp ceqb). Theorem PFcons0_fcons_inv: forall l a l1, PCond l (Fcons0 a l1) -> ~ a @ l == 0 /\ PCond l l1. Proof. intros l a l1; induction l1 as [|e l1 IHl1]; simpl Fcons0. - simpl; now split. -- generalize (ring_correct O l nil a e). lazy zeta; simpl Peq. +- generalize (ring_correct O l nil a e); unfold ring_checker. lazy zeta; simpl Peq. + set (na := norm_aux _ _ _ _ _ _ _ a); change na with (Nnorm 0 nil a). + set (ne := norm_aux _ _ _ _ _ _ _ e); change ne with (Nnorm 0 nil e). case Peq; intros H; rewrite !PCond_cons; intros (H1,H2); repeat split; trivial. + now rewrite H. @@ -1522,13 +1346,7 @@ intros l a l1; induction l1 as [|e l1 IHl1]; simpl Fcons0. + now apply IHl1. Qed. -(* split factorized denominators *) -Fixpoint Fcons00 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) := - match e with - PEmul e1 e2 => Fcons00 e1 (Fcons00 e2 l) - | PEpow e1 _ => Fcons00 e1 l - | _ => Fcons0 e l - end. +#[local] Notation Fcons00 := (Fcons00 cO cI cadd cmul csub copp ceqb). Theorem PFcons00_fcons_inv: forall l a l1, PCond l (Fcons00 a l1) -> ~ a @ l == 0 /\ PCond l l1. @@ -1563,14 +1381,7 @@ destruct (ceqb c1 c2); constructor. - intro E. specialize (H' E). discriminate. Qed. -Fixpoint Fcons1 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) := - match e with - | PEmul e1 e2 => Fcons1 e1 (Fcons1 e2 l) - | PEpow e _ => Fcons1 e l - | PEopp e => if (-(1) =? 0)%coef then absurd_PCond else Fcons1 e l - | PEc c => if (c =? 0)%coef then absurd_PCond else l - | _ => Fcons0 e l - end. +#[local] Notation Fcons1 := (Fcons1 cO cI cadd cmul csub copp ceqb). Theorem PFcons1_fcons_inv: forall l a l1, PCond l (Fcons1 a l1) -> ~ a @ l == 0 /\ PCond l l1. @@ -1594,7 +1405,8 @@ intros l a; elim a; try (intros; apply PFcons0_fcons_inv; trivial; fail). - intros ? H ? ? H0. destruct (H _ H0);split;trivial. apply PEpow_nz; trivial. Qed. -Definition Fcons2 e l := Fcons1 (PEsimp e) l. +#[local] Notation Fcons2 := (Fcons2 + cO cI cadd cmul csub copp (pow_pos cmul) ceqb). Theorem PFcons2_fcons_inv: forall l a l1, PCond l (Fcons2 a l1) -> ~ a @ l == 0 /\ PCond l l1. @@ -1825,5 +1637,8 @@ End Field. End Complete. +Notation Fnorm := (fun cO cI cadd cmul csub copp ceqb => + Fnorm cO cI cadd cmul csub copp (pow_pos cmul) ceqb). + Arguments FEO {C}. Arguments FEI {C}. diff --git a/theories/setoid_ring/Ncring_polynom.v b/theories/setoid_ring/Ncring_polynom.v index c8f92fec10..e009c90fd4 100644 --- a/theories/setoid_ring/Ncring_polynom.v +++ b/theories/setoid_ring/Ncring_polynom.v @@ -421,17 +421,6 @@ Qed. (** Definition of polynomial expressions *) -(* - Inductive PExpr : Type := - | PEc : C -> PExpr - | PEX : positive -> PExpr - | PEadd : PExpr -> PExpr -> PExpr - | PEsub : PExpr -> PExpr -> PExpr - | PEmul : PExpr -> PExpr -> PExpr - | PEopp : PExpr -> PExpr - | PEpow : PExpr -> N -> PExpr. -*) - (** Specification of the power function *) Section POWER. Variable Cpow : Set. diff --git a/theories/setoid_ring/Ring_polynom.v b/theories/setoid_ring/Ring_polynom.v index 469f9c7b79..3d46fb0234 100644 --- a/theories/setoid_ring/Ring_polynom.v +++ b/theories/setoid_ring/Ring_polynom.v @@ -10,6 +10,7 @@ Set Implicit Arguments. +From Stdlib Require Export ring_checker. From Stdlib Require Import Setoid Morphisms. From Stdlib Require Import BinList BinPos BinNat BinInt. From Stdlib Require Export Ring_theory. @@ -99,404 +100,45 @@ Section MakeRingPol. match goal with |- ?t == _ => mul_permut_rec t end). - (* Definition of multivariable polynomials with coefficients in C : - Type [Pol] represents [X1 ... Xn]. - The representation is Horner's where a [n] variable polynomial - (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients - are polynomials with [n-1] variables (C[X2..Xn]). - There are several optimisations to make the repr compacter: - - [Pc c] is the constant polynomial of value c - == c*X1^0*..*Xn^0 - - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables. - variable indices are shifted of j in Q. - == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn} - - [PX P i Q] is an optimised Horner form of P*X^i + Q - with P not the null polynomial - == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn} - - In addition: - - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden - since they can be represented by the simpler form (PX P (i+j) Q) - - (Pinj i (Pinj j P)) is (Pinj (i+j) P) - - (Pinj i (Pc c)) is (Pc c) - *) - - Inductive Pol : Type := - | Pc : C -> Pol - | Pinj : positive -> Pol -> Pol - | PX : Pol -> positive -> Pol -> Pol. - - Definition P0 := Pc cO. - Definition P1 := Pc cI. - - Fixpoint Peq (P P' : Pol) {struct P'} : bool := - match P, P' with - | Pc c, Pc c' => c ?=! c' - | Pinj j Q, Pinj j' Q' => - match j ?= j' with - | Eq => Peq Q Q' - | _ => false - end - | PX P i Q, PX P' i' Q' => - match i ?= i' with - | Eq => if Peq P P' then Peq Q Q' else false - | _ => false - end - | _, _ => false - end. + (* Definition of multivariable polynomials with coefficients in C *) + + #[local] Notation Pol := (Pol C). + #[local] Notation P0 := (P0 cO). + #[local] Notation P1 := (P1 cI). + #[local] Notation Peq := (Peq ceqb). + #[local] Notation mkX := (mkX cO cI). + #[local] Notation mkPinj := (@mkPinj C). + #[local] Notation mkPX := (mkPX cO ceqb). + #[local] Notation Popp := (Popp copp). + #[local] Notation PaddC := (PaddC cadd). + #[local] Notation PsubC := (PsubC csub). + #[local] Notation Padd := (Padd cO cadd ceqb). + #[local] Notation PaddI := (PaddI cadd Padd). + #[local] Notation Psub := (Psub cO cadd csub copp ceqb). + #[local] Notation PsubI := (PsubI cadd copp Psub). + #[local] Notation PaddX := (PaddX cO ceqb Padd). + #[local] Notation PsubX := (PsubX cO copp ceqb Psub). + #[local] Notation PmulC_aux := (PmulC_aux cO cmul ceqb). + #[local] Notation PmulC := (PmulC cO cI cmul ceqb). + #[local] Notation Pmul := (Pmul cO cI cadd cmul ceqb). + #[local] Notation PmulI := (PmulI cO cI cmul ceqb Pmul). Infix "?==" := Peq. - - Definition mkPinj j P := - match P with - | Pc _ => P - | Pinj j' Q => Pinj (j + j') Q - | _ => Pinj j P - end. - - Definition mkPinj_pred j P:= - match j with - | xH => P - | xO j => Pinj (Pos.pred_double j) P - | xI j => Pinj (xO j) P - end. - - Definition mkPX P i Q := - match P with - | Pc c => if c ?=! cO then mkPinj xH Q else PX P i Q - | Pinj _ _ => PX P i Q - | PX P' i' Q' => if Q' ?== P0 then PX P' (i' + i) Q else PX P i Q - end. - - Definition mkXi i := PX P1 i P0. - - Definition mkX := mkXi 1. - - (** Opposite of addition *) - - Fixpoint Popp (P:Pol) : Pol := - match P with - | Pc c => Pc (-! c) - | Pinj j Q => Pinj j (Popp Q) - | PX P i Q => PX (Popp P) i (Popp Q) - end. - Notation "-- P" := (Popp P). - - (** Addition et subtraction *) - - Fixpoint PaddC (P:Pol) (c:C) : Pol := - match P with - | Pc c1 => Pc (c1 +! c) - | Pinj j Q => Pinj j (PaddC Q c) - | PX P i Q => PX P i (PaddC Q c) - end. - - Fixpoint PsubC (P:Pol) (c:C) : Pol := - match P with - | Pc c1 => Pc (c1 -! c) - | Pinj j Q => Pinj j (PsubC Q c) - | PX P i Q => PX P i (PsubC Q c) - end. - - Section PopI. - - Variable Pop : Pol -> Pol -> Pol. - Variable Q : Pol. - - Fixpoint PaddI (j:positive) (P:Pol) : Pol := - match P with - | Pc c => mkPinj j (PaddC Q c) - | Pinj j' Q' => - match Z.pos_sub j' j with - | Zpos k => mkPinj j (Pop (Pinj k Q') Q) - | Z0 => mkPinj j (Pop Q' Q) - | Zneg k => mkPinj j' (PaddI k Q') - end - | PX P i Q' => - match j with - | xH => PX P i (Pop Q' Q) - | xO j => PX P i (PaddI (Pos.pred_double j) Q') - | xI j => PX P i (PaddI (xO j) Q') - end - end. - - Fixpoint PsubI (j:positive) (P:Pol) : Pol := - match P with - | Pc c => mkPinj j (PaddC (--Q) c) - | Pinj j' Q' => - match Z.pos_sub j' j with - | Zpos k => mkPinj j (Pop (Pinj k Q') Q) - | Z0 => mkPinj j (Pop Q' Q) - | Zneg k => mkPinj j' (PsubI k Q') - end - | PX P i Q' => - match j with - | xH => PX P i (Pop Q' Q) - | xO j => PX P i (PsubI (Pos.pred_double j) Q') - | xI j => PX P i (PsubI (xO j) Q') - end - end. - - Variable P' : Pol. - - Fixpoint PaddX (i':positive) (P:Pol) : Pol := - match P with - | Pc c => PX P' i' P - | Pinj j Q' => - match j with - | xH => PX P' i' Q' - | xO j => PX P' i' (Pinj (Pos.pred_double j) Q') - | xI j => PX P' i' (Pinj (xO j) Q') - end - | PX P i Q' => - match Z.pos_sub i i' with - | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' - | Z0 => mkPX (Pop P P') i Q' - | Zneg k => mkPX (PaddX k P) i Q' - end - end. - - Fixpoint PsubX (i':positive) (P:Pol) : Pol := - match P with - | Pc c => PX (--P') i' P - | Pinj j Q' => - match j with - | xH => PX (--P') i' Q' - | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q') - | xI j => PX (--P') i' (Pinj (xO j) Q') - end - | PX P i Q' => - match Z.pos_sub i i' with - | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' - | Z0 => mkPX (Pop P P') i Q' - | Zneg k => mkPX (PsubX k P) i Q' - end - end. - - - End PopI. - - Fixpoint Padd (P P': Pol) {struct P'} : Pol := - match P' with - | Pc c' => PaddC P c' - | Pinj j' Q' => PaddI Padd Q' j' P - | PX P' i' Q' => - match P with - | Pc c => PX P' i' (PaddC Q' c) - | Pinj j Q => - match j with - | xH => PX P' i' (Padd Q Q') - | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q') - | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q') - end - | PX P i Q => - match Z.pos_sub i i' with - | Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q') - | Z0 => mkPX (Padd P P') i (Padd Q Q') - | Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q') - end - end - end. Infix "++" := Padd. - - Fixpoint Psub (P P': Pol) {struct P'} : Pol := - match P' with - | Pc c' => PsubC P c' - | Pinj j' Q' => PsubI Psub Q' j' P - | PX P' i' Q' => - match P with - | Pc c => PX (--P') i' (*(--(PsubC Q' c))*) (PaddC (--Q') c) - | Pinj j Q => - match j with - | xH => PX (--P') i' (Psub Q Q') - | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q') - | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q') - end - | PX P i Q => - match Z.pos_sub i i' with - | Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q') - | Z0 => mkPX (Psub P P') i (Psub Q Q') - | Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q') - end - end - end. Infix "--" := Psub. - - (** Multiplication *) - - Fixpoint PmulC_aux (P:Pol) (c:C) : Pol := - match P with - | Pc c' => Pc (c' *! c) - | Pinj j Q => mkPinj j (PmulC_aux Q c) - | PX P i Q => mkPX (PmulC_aux P c) i (PmulC_aux Q c) - end. - - Definition PmulC P c := - if c ?=! cO then P0 else - if c ?=! cI then P else PmulC_aux P c. - - Section PmulI. - Variable Pmul : Pol -> Pol -> Pol. - Variable Q : Pol. - Fixpoint PmulI (j:positive) (P:Pol) : Pol := - match P with - | Pc c => mkPinj j (PmulC Q c) - | Pinj j' Q' => - match Z.pos_sub j' j with - | Zpos k => mkPinj j (Pmul (Pinj k Q') Q) - | Z0 => mkPinj j (Pmul Q' Q) - | Zneg k => mkPinj j' (PmulI k Q') - end - | PX P' i' Q' => - match j with - | xH => mkPX (PmulI xH P') i' (Pmul Q' Q) - | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q') - | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q') - end - end. - - End PmulI. - - Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol := - match P'' with - | Pc c => PmulC P c - | Pinj j' Q' => PmulI Pmul Q' j' P - | PX P' i' Q' => - match P with - | Pc c => PmulC P'' c - | Pinj j Q => - let QQ' := - match j with - | xH => Pmul Q Q' - | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q' - | xI j => Pmul (Pinj (xO j) Q) Q' - end in - mkPX (Pmul P P') i' QQ' - | PX P i Q=> - let QQ' := Pmul Q Q' in - let PQ' := PmulI Pmul Q' xH P in - let QP' := Pmul (mkPinj xH Q) P' in - let PP' := Pmul P P' in - (mkPX (mkPX PP' i P0 ++ QP') i' P0) ++ mkPX PQ' i QQ' - end - end. - Infix "**" := Pmul. (** Monomial **) - (** A monomial is X1^k1...Xi^ki. Its representation - is a simplified version of the polynomial representation: - - - [mon0] correspond to the polynom [P1]. - - [(zmon j M)] corresponds to [(Pinj j ...)], - i.e. skip j variable indices. - - [(vmon i M)] is X^i*M with X the current variable, - its corresponds to (PX P1 i ...)] - *) - - Inductive Mon: Set := - | mon0: Mon - | zmon: positive -> Mon -> Mon - | vmon: positive -> Mon -> Mon. - - Definition mkZmon j M := - match M with mon0 => mon0 | _ => zmon j M end. - - Definition zmon_pred j M := - match j with xH => M | _ => mkZmon (Pos.pred j) M end. - - Definition mkVmon i M := - match M with - | mon0 => vmon i mon0 - | zmon j m => vmon i (zmon_pred j m) - | vmon i' m => vmon (i+i') m - end. - - Fixpoint CFactor (P: Pol) (c: C) {struct P}: Pol * Pol := - match P with - | Pc c1 => let (q,r) := cdiv c1 c in (Pc r, Pc q) - | Pinj j1 P1 => - let (R,S) := CFactor P1 c in - (mkPinj j1 R, mkPinj j1 S) - | PX P1 i Q1 => - let (R1, S1) := CFactor P1 c in - let (R2, S2) := CFactor Q1 c in - (mkPX R1 i R2, mkPX S1 i S2) - end. - - Fixpoint MFactor (P: Pol) (c: C) (M: Mon) {struct P}: Pol * Pol := - match P, M with - _, mon0 => if (ceqb c cI) then (Pc cO, P) else CFactor P c - | Pc _, _ => (P, Pc cO) - | Pinj j1 P1, zmon j2 M1 => - match j1 ?= j2 with - Eq => let (R,S) := MFactor P1 c M1 in - (mkPinj j1 R, mkPinj j1 S) - | Lt => let (R,S) := MFactor P1 c (zmon (j2 - j1) M1) in - (mkPinj j1 R, mkPinj j1 S) - | Gt => (P, Pc cO) - end - | Pinj _ _, vmon _ _ => (P, Pc cO) - | PX P1 i Q1, zmon j M1 => - let M2 := zmon_pred j M1 in - let (R1, S1) := MFactor P1 c M in - let (R2, S2) := MFactor Q1 c M2 in - (mkPX R1 i R2, mkPX S1 i S2) - | PX P1 i Q1, vmon j M1 => - match i ?= j with - Eq => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in - (mkPX R1 i Q1, S1) - | Lt => let (R1,S1) := MFactor P1 c (vmon (j - i) M1) in - (mkPX R1 i Q1, S1) - | Gt => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in - (mkPX R1 i Q1, mkPX S1 (i-j) (Pc cO)) - end - end. - - Definition POneSubst (P1: Pol) (cM1: C * Mon) (P2: Pol): option Pol := - let (c,M1) := cM1 in - let (Q1,R1) := MFactor P1 c M1 in - match R1 with - (Pc c) => if c ?=! cO then None - else Some (Padd Q1 (Pmul P2 R1)) - | _ => Some (Padd Q1 (Pmul P2 R1)) - end. - - Fixpoint PNSubst1 (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat) : Pol := - match POneSubst P1 cM1 P2 with - Some P3 => match n with S n1 => PNSubst1 P3 cM1 P2 n1 | _ => P3 end - | _ => P1 - end. - - Definition PNSubst (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat): option Pol := - match POneSubst P1 cM1 P2 with - Some P3 => match n with S n1 => Some (PNSubst1 P3 cM1 P2 n1) | _ => None end - | _ => None - end. - - Fixpoint PSubstL1 (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : Pol := - match LM1 with - cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n - | _ => P1 - end. - - Fixpoint PSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : option Pol := - match LM1 with - cons (M1,P2) LM2 => - match PNSubst P1 M1 P2 n with - Some P3 => Some (PSubstL1 P3 LM2 n) - | None => PSubstL P1 LM2 n - end - | _ => None - end. - - Fixpoint PNSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (m n: nat) : Pol := - match PSubstL P1 LM1 n with - Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end - | _ => P1 - end. + #[local] Notation CFactor := (CFactor cO ceqb cdiv). + #[local] Notation MFactor := (MFactor cO cI ceqb cdiv). + #[local] Notation POneSubst := (POneSubst cO cI cadd cmul ceqb cdiv). + #[local] Notation PNSubst1 := (PNSubst1 cO cI cadd cmul ceqb cdiv). + #[local] Notation PNSubst := (PNSubst cO cI cadd cmul ceqb cdiv). + #[local] Notation PSubstL1 := (PSubstL1 cO cI cadd cmul ceqb cdiv). + #[local] Notation PSubstL := (PSubstL cO cI cadd cmul ceqb cdiv). + #[local] Notation PNSubstL := (PNSubstL cO cI cadd cmul ceqb cdiv). (** Evaluation of a polynomial towards R *) @@ -685,7 +327,7 @@ Section MakeRingPol. Lemma PaddX_ok P' P k l : (forall P l, (P++P')@l == P@l + P'@l) -> - (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k. + (PaddX P' k P) @ l == P@l + P'@l * (hd l)^k. Proof. intros IHP'. revert k l. induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. @@ -736,7 +378,6 @@ Section MakeRingPol. - destruct P as [|p0 P|P2 p0 P3]; simpl; try reflexivity. + destruct p0; now apply PX_ext. + destr_pos_sub; intros ->; apply mkPX_ext; auto. - let p1 := match goal with |- PsubX _ _ ?p1 _ === _ => p1 end in revert p1. induction P2; simpl; intros; try reflexivity. destr_pos_sub; intros ->; now apply mkPX_ext. Qed. @@ -748,7 +389,7 @@ Section MakeRingPol. Lemma PmulI_ok P' : (forall P l, (Pmul P P') @ l == P @ l * P' @ l) -> - forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l). + forall P p l, (PmulI P' p P) @ l == P @ l * P' @ (jump p l). Proof. intros IHP' P. induction P as [|p P IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. @@ -914,19 +555,10 @@ Section MakeRingPol. (** Definition of polynomial expressions *) - Inductive PExpr : Type := - | PEO : PExpr - | PEI : PExpr - | PEc : C -> PExpr - | PEX : positive -> PExpr - | PEadd : PExpr -> PExpr -> PExpr - | PEsub : PExpr -> PExpr -> PExpr - | PEmul : PExpr -> PExpr -> PExpr - | PEopp : PExpr -> PExpr - | PEpow : PExpr -> N -> PExpr. + #[local] Notation PExpr := (PExpr C). (** evaluation of polynomial expressions towards R *) - Definition mk_X j := mkPinj_pred j mkX. + Definition mk_X := mkX. (** evaluation of polynomial expressions towards R *) @@ -935,7 +567,7 @@ Section MakeRingPol. | PEO => rO | PEI => rI | PEc c => phi c - | PEX j => nth 0 j l + | PEX _ j => nth 0 j l | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2) | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2) | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2) @@ -956,20 +588,11 @@ Strategy expand [PEeval]. Hint Rewrite Padd_ok Psub_ok : Esimpl. +#[local] Notation Ppow_pos := (Ppow_pos cO cI cadd cmul ceqb). +#[local] Notation Ppow_N := (Ppow_N cO cI cadd cmul ceqb). + Section POWER. Variable subst_l : Pol -> Pol. - Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol := - match p with - | xH => subst_l (res ** P) - | xO p => Ppow_pos (Ppow_pos res P p) P p - | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P) - end. - - Definition Ppow_N P n := - match n with - | N0 => P1 - | Npos p => Ppow_pos P1 P p - end. Lemma Ppow_pos_ok l : (forall P, subst_l P@l == P@l) -> @@ -999,29 +622,14 @@ Section POWER. Variable lmp:list (C*Mon*Pol). Let subst_l P := PNSubstL P lmp n n. Let Pmul_subst P1 P2 := subst_l (P1 ** P2). - Let Ppow_subst := Ppow_N subst_l. - - Fixpoint norm_aux (pe:PExpr) : Pol := - match pe with - | PEO => Pc cO - | PEI => Pc cI - | PEc c => Pc c - | PEX j => mk_X j - | PEadd (PEopp pe1) pe2 => (norm_aux pe2) -- (norm_aux pe1) - | PEadd pe1 (PEopp pe2) => (norm_aux pe1) -- (norm_aux pe2) - | PEadd pe1 pe2 => (norm_aux pe1) ++ (norm_aux pe2) - | PEsub pe1 pe2 => (norm_aux pe1) -- (norm_aux pe2) - | PEmul pe1 pe2 => (norm_aux pe1) ** (norm_aux pe2) - | PEopp pe1 => -- (norm_aux pe1) - | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n - end. - Definition norm_subst pe := subst_l (norm_aux pe). + #[local] Notation norm_aux := (Pol_of_PExpr cO cI cadd cmul csub copp ceqb). + #[local] Notation norm_subst := (norm_subst cO cI cadd cmul csub copp ceqb cdiv n lmp). (** Internally, [norm_aux] is expanded in a large number of cases. To speed-up proofs, we use an alternative definition. *) - Definition get_PEopp pe := + Definition get_PEopp (pe : PExpr) := match pe with | PEopp pe' => Some pe' | _ => None @@ -1049,7 +657,7 @@ Section POWER. now destruct pe. Qed. - Arguments norm_aux !pe : simpl nomatch. + Arguments Pol_of_PExpr _ _ _ _ _ _ _ _ !pe : simpl nomatch. Lemma norm_aux_spec l pe : PEeval l pe == (norm_aux pe)@l. @@ -1069,7 +677,7 @@ Section POWER. - rewrite IHpe1, IHpe2. Esimpl. - rewrite IHpe1, IHpe2. now rewrite Pmul_ok. - rewrite IHpe. Esimpl. - - rewrite Ppow_N_ok by reflexivity. + - rewrite (Ppow_N_ok id) by reflexivity. rewrite (rpow_pow_N pow_th). destruct n0 as [|p]; simpl; Esimpl. induction p as [p IHp|p IHp|];simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. @@ -1084,6 +692,7 @@ Section POWER. Qed. End NORM_SUBST_REC. + #[local] Notation norm_subst := (norm_subst cO cI cadd cmul csub copp ceqb cdiv). Fixpoint interp_PElist (l:list R) (lpe:list (PExpr*PExpr)) {struct lpe} : Prop := match lpe with @@ -1095,32 +704,9 @@ Section POWER. end end. - Fixpoint mon_of_pol (P:Pol) : option (C * Mon) := - match P with - | Pc c => if (c ?=! cO) then None else Some (c, mon0) - | Pinj j P => - match mon_of_pol P with - | None => None - | Some (c,m) => Some (c, mkZmon j m) - end - | PX P i Q => - if Peq Q P0 then - match mon_of_pol P with - | None => None - | Some (c,m) => Some (c, mkVmon i m) - end - else None - end. - - Fixpoint mk_monpol_list (lpe:list (PExpr * PExpr)) : list (C*Mon*Pol) := - match lpe with - | nil => nil - | (me,pe)::lpe => - match mon_of_pol (norm_subst 0 nil me) with - | None => mk_monpol_list lpe - | Some m => (m,norm_subst 0 nil pe):: mk_monpol_list lpe - end - end. + #[local] Notation mon_of_pol := (Mon_of_Pol cO ceqb). + #[local] Notation mk_monpol_list := (mk_monpol_list cO cI cadd cmul csub copp ceqb cdiv). + #[local] Notation ring_checker := (ring_checker cO cI cadd cmul csub copp ceqb cdiv). Lemma mon_of_pol_ok : forall P m, mon_of_pol P = Some m -> forall l, [fst m] * Mphi l (snd m) == P@l. @@ -1177,8 +763,7 @@ Section POWER. Lemma ring_correct : forall n l lpe pe1 pe2, interp_PElist l lpe -> - (let lmp := mk_monpol_list lpe in - norm_subst n lmp pe1 ?== norm_subst n lmp pe2) = true -> + ring_checker n lpe pe1 pe2 = true -> PEeval l pe1 == PEeval l pe2. Proof. simpl;intros n l lpe pe1 pe2 **. @@ -1509,3 +1094,5 @@ End MakeRingPol. Arguments PEO {C}. Arguments PEI {C}. + +Notation norm_aux := Pol_of_PExpr. diff --git a/theories/setoid_ring/field_checker.v b/theories/setoid_ring/field_checker.v new file mode 100644 index 0000000000..068be6c950 --- /dev/null +++ b/theories/setoid_ring/field_checker.v @@ -0,0 +1 @@ +From micromega_plugin Require Export field_checker. diff --git a/theories/setoid_ring/field_eval.v b/theories/setoid_ring/field_eval.v new file mode 100644 index 0000000000..878b3b82ff --- /dev/null +++ b/theories/setoid_ring/field_eval.v @@ -0,0 +1 @@ +From micromega_plugin Require Export field_eval. diff --git a/theories/setoid_ring/ring_checker.v b/theories/setoid_ring/ring_checker.v new file mode 100644 index 0000000000..8ef0738ea8 --- /dev/null +++ b/theories/setoid_ring/ring_checker.v @@ -0,0 +1 @@ +From micromega_plugin Require Export ring_checker. diff --git a/theories/setoid_ring/ring_eval.v b/theories/setoid_ring/ring_eval.v new file mode 100644 index 0000000000..7044caf939 --- /dev/null +++ b/theories/setoid_ring/ring_eval.v @@ -0,0 +1 @@ +From micromega_plugin Require Export ring_eval.