diff --git a/.github/workflows/nix-action-8.18.yml b/.github/workflows/nix-action-8.18.yml index a2a3112c..fb4ee557 100644 --- a/.github/workflows/nix-action-8.18.yml +++ b/.github/workflows/nix-action-8.18.yml @@ -36,16 +36,80 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (coq) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.18\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; + true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target coq - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.18\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n - echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ - s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "coq" + jasmin: + needs: + - coq + 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@v4 + 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@v4 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v30 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup ssprove + uses: cachix/cachix-action@v15 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community, math-comp + name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (jasmin) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.18\" --argstr job \"jasmin\" \\\n --dry-run 2> err > out || (touch fail; + true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; + - id: stepCheck + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "jasmin" mathcomp-analysis: needs: - coq @@ -84,12 +148,18 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (mathcomp-analysis) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.18\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out + || (touch fail; true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target mathcomp-analysis - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.18\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1 > - /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\"\ - \ | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr @@ -118,6 +188,7 @@ jobs: needs: - coq - mathcomp-analysis + - jasmin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -153,12 +224,18 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (ssprove) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.18\" --argstr job \"ssprove\" \\\n --dry-run 2> err > out || (touch + fail; true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target ssprove - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.18\" --argstr job \"ssprove\" \\\n --dry-run 2>&1 > /dev/null)\n - echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ - s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr @@ -175,6 +252,18 @@ jobs: name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-analysis" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-experimental-reals' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-experimental-reals" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-word' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-word" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-zify' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: extructures' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr @@ -183,6 +272,10 @@ jobs: name: 'Building/fetching previous CI target: deriving' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "deriving" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: jasmin' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "jasmin" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr diff --git a/.github/workflows/nix-action-8.19.yml b/.github/workflows/nix-action-8.19.yml index b3bf53aa..0ad38aff 100644 --- a/.github/workflows/nix-action-8.19.yml +++ b/.github/workflows/nix-action-8.19.yml @@ -36,16 +36,80 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (coq) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.19\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; + true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target coq - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.19\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n - echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ - s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "coq" + jasmin: + needs: + - coq + 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@v4 + 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@v4 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v30 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup ssprove + uses: cachix/cachix-action@v15 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community, math-comp + name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (jasmin) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.19\" --argstr job \"jasmin\" \\\n --dry-run 2> err > out || (touch fail; + true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; + - id: stepCheck + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "jasmin" mathcomp-analysis: needs: - coq @@ -84,12 +148,18 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (mathcomp-analysis) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.19\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out + || (touch fail; true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target mathcomp-analysis - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.19\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1 > - /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\"\ - \ | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr @@ -118,6 +188,7 @@ jobs: needs: - coq - mathcomp-analysis + - jasmin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -153,12 +224,18 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (ssprove) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.19\" --argstr job \"ssprove\" \\\n --dry-run 2> err > out || (touch + fail; true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target ssprove - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.19\" --argstr job \"ssprove\" \\\n --dry-run 2>&1 > /dev/null)\n - echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ - s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr @@ -175,6 +252,18 @@ jobs: name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-analysis" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-experimental-reals' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "mathcomp-experimental-reals" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-word' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "mathcomp-word" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-zify' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: extructures' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr @@ -183,6 +272,10 @@ jobs: name: 'Building/fetching previous CI target: deriving' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "deriving" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: jasmin' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "jasmin" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr diff --git a/.github/workflows/nix-action-8.20.yml b/.github/workflows/nix-action-8.20.yml index 197c7243..11686daf 100644 --- a/.github/workflows/nix-action-8.20.yml +++ b/.github/workflows/nix-action-8.20.yml @@ -36,16 +36,80 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (coq) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.20\" --argstr job \"coq\" \\\n --dry-run 2> err > out || (touch fail; + true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target coq - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.20\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n - echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ - s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "coq" + jasmin: + needs: + - coq + 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@v4 + 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@v4 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v30 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup ssprove + uses: cachix/cachix-action@v15 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community, math-comp + name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (jasmin) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.20\" --argstr job \"jasmin\" \\\n --dry-run 2> err > out || (touch fail; + true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; + - id: stepCheck + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "jasmin" mathcomp-analysis: needs: - coq @@ -84,12 +148,18 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (mathcomp-analysis) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.20\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out + || (touch fail; true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target mathcomp-analysis - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.20\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1 > - /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\"\ - \ | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -118,6 +188,7 @@ jobs: needs: - coq - mathcomp-analysis + - jasmin runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -153,12 +224,18 @@ jobs: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community, math-comp name: ssprove + - id: stepGetDerivation + name: Getting derivation for current job (ssprove) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"8.20\" --argstr job \"ssprove\" \\\n --dry-run 2> err > out || (touch + fail; true)\n" + - name: Error reporting + run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" + - name: Failure check + run: if [ -e fail ]; then exit 1; else exit 0; fi; - id: stepCheck - name: Checking presence of CI target ssprove - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr - bundle \"8.20\" --argstr job \"ssprove\" \\\n --dry-run 2>&1 > /dev/null)\n - echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ - s/.*/built/\") >> $GITHUB_OUTPUT\n" + name: Checking presence of CI target for current job + run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -175,6 +252,18 @@ jobs: name: 'Building/fetching previous CI target: mathcomp-analysis' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-analysis" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-experimental-reals' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "mathcomp-experimental-reals" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-word' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "mathcomp-word" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-zify' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: extructures' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -183,6 +272,10 @@ jobs: name: 'Building/fetching previous CI target: deriving' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "deriving" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: jasmin' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "jasmin" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr diff --git a/.github/workflows/opam-build.yml b/.github/workflows/opam-build.yml index a755f870..e7afd8d5 100644 --- a/.github/workflows/opam-build.yml +++ b/.github/workflows/opam-build.yml @@ -49,6 +49,8 @@ jobs: # Runs a set of commands using the runners shell - name: Build run: | + apt install libmpfr-dev libppl-dev opam repo add coq-released https://coq.inria.fr/opam/released - opam install coq.8.18.0 coq-equations.1.3+8.18 coq-mathcomp-ssreflect.2.1.0 coq-mathcomp-analysis.1.0.0 coq-extructures.0.4.0 coq-deriving.0.2.0 + opam install coq.8.18.0 coq-equations.1.3+8.18 coq-mathcomp-ssreflect.2.1.0 coq-mathcomp-analysis.1.0.0 coq-extructures.0.4.0 coq-deriving.0.2.0 coq-mathcomp-word.3.0 coq-mathcomp-zify.1.5.0+2.0+8.16 + opam pin jasmin.dev git+https://github.com/jasmin-lang/jasmin.git#main opam exec -- make -j4 diff --git a/.nix/config.nix b/.nix/config.nix index 35126787..fb6cfbb6 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -53,18 +53,21 @@ mathcomp.job = false; mathcomp.override.version = "2.1.0"; mathcomp-analysis.override.version = "1.0.0"; + jasmin.override.version = "2024.07.2"; }; bundles."8.19".coqPackages = { coq.override.version = "8.19"; mathcomp.job = false; mathcomp.override.version = "2.2.0"; mathcomp-analysis.override.version = "1.0.0"; + jasmin.override.version = "2024.07.2"; }; bundles."8.20".coqPackages = { coq.override.version = "8.20"; mathcomp.job = false; mathcomp.override.version = "2.2.0"; mathcomp-analysis.override.version = "1.2.0"; + jasmin.override.version = "2024.07.2"; }; bundles."8.18".push-branches = ["main"]; diff --git a/.nix/coq-nix-toolbox.nix b/.nix/coq-nix-toolbox.nix index eb2e2bb9..b53317b8 100644 --- a/.nix/coq-nix-toolbox.nix +++ b/.nix/coq-nix-toolbox.nix @@ -1 +1 @@ -"fb3515feec422e546de863ad0101e2a51ec9b8db" +"23abc2d7903983f4fd414288677d6b421d412cd6" diff --git a/.nix/coq-overlays/ssprove/default.nix b/.nix/coq-overlays/ssprove/default.nix new file mode 100644 index 00000000..cd355245 --- /dev/null +++ b/.nix/coq-overlays/ssprove/default.nix @@ -0,0 +1,60 @@ +{ lib, mkCoqDerivation, coq, version ? null +, equations +, mathcomp-ssreflect +, mathcomp-analysis +, mathcomp-experimental-reals +, mathcomp-word +, mathcomp-zify +, extructures +, deriving +, jasmin +}: + +(mkCoqDerivation { + pname = "ssprove"; + owner = "SSProve"; + + inherit version; + defaultVersion = with lib.versions; lib.switch [coq.coq-version mathcomp-ssreflect.version] [ + { cases = [(range "8.18" "8.20") "2.3.0"]; out = "0.2.3"; } + { cases = [(range "8.18" "8.20") (range "2.1.0" "2.2.0")]; out = "0.2.2"; } + # This is the original dependency: + # { cases = ["8.17" "1.18.0"]; out = "0.1.0"; } + # But it is not loadable. The math-comp nixpkgs configuration + # will always only output version 1.18.0 for Coq 8.17. + # Hence, the Coq 8.17 and math-comp 1.17.0 must be explicitly set + # to load it. + # (This version is not on the math-comp CI and hence not checked.) + { cases = ["8.17" "1.17.0"]; out = "0.1.0"; } + ] null; + + releaseRev = v: "v${v}"; + + release."0.2.3".sha256 = "sha256-Y3dmNIF36IuIgrVILteofOv8e5awKfq93S4YN7enswI="; + release."0.2.2".sha256 = "sha256-tBF8equJd6hKZojpe+v9h6Tg9xEnMTVFgOYK7ZnMfxk="; + release."0.2.1".sha256 = "sha256-X00q5QFxdcGWeNqOV/PLTOqQyyfqFEinbGUTO7q8bC4="; + release."0.2.0".sha256 = "sha256-GDkWH0LUsW165vAUoYC5of9ndr0MbfBtmrPhsJVXi3o="; + release."0.1.0".sha256 = "sha256-Yj+k+mBsudi3d6bRVlZLyM4UqQnzAX5tHvxtKoIuNTE="; + + propagatedBuildInputs = [equations + mathcomp-ssreflect + mathcomp-analysis + mathcomp-experimental-reals + mathcomp-word + mathcomp-zify + extructures + deriving + jasmin]; + + meta = with lib; { + description = "SSProve: A Foundational Framework for Modular Cryptographic Proofs in Coq"; + license = licenses.mit; + maintainers = [ { + name = "Sebastian Ertel"; + email = "sebastian.ertel@gmail.com"; + github = "sertel"; + githubId = 3703100; + } ]; + }; + +}) diff --git a/README.md b/README.md index 9e9261ba..857d2cb9 100644 --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ This repository contains the Coq formalisation of the paper:\ [eprint](https://eprint.iacr.org/2021/397/20210526:113037)) Secondary literature: -* **The Last Yard: Foundational End-to-End Verification of High-Speed Cryptography** at CPP'24. +* **The Last Yard: Foundational End-to-End Verification of High-Speed Cryptography** at CPP'24. Philipp G. Haselwarter, Benjamin Salling Hvass, Lasse Letager Hansen, Théo Winterhalter, Cătălin Hriţcu, and Bas Spitters. ([DOI](https://doi.org/10.1145/3636501.3636961)) This README serves as a guide to running verification and finding the @@ -81,7 +81,7 @@ All set. ##### Project setup 1. Create a new project folder and `cd` into it. 2. Copy one of the above templates into it (removing the `.template*` suffix). -3. And finally run `nix develop` which throws you into a shell where SSProve is already installed. (`From Crypt Require Import ...`) +3. And finally run `nix develop` which throws you into a shell where SSProve is already installed. (`From SSProve.Crypt Require Import ...`) You may need to initialize the project as a Git repository and add the `flake.nix` to it. The generated `flake.lock` pins the versions and hence also needs to be added to this new project repo. diff --git a/_CoqProject b/_CoqProject index 9ac50da9..491d4dcb 100644 --- a/_CoqProject +++ b/_CoqProject @@ -52,7 +52,6 @@ theories/Crypt/rules/RulesProb.v # Crypto theories/Crypt/rules/UniformDistrLemmas.v #theories/Crypt/rules/UniformDistr.v -# theories/Crypt/examples/deprecated/otp.v theories/Crypt/package/pkg_core_definition.v theories/Crypt/package/pkg_composition.v theories/Crypt/package/pkg_notation.v @@ -75,6 +74,39 @@ theories/Crypt/rules/UniformStateProb.v #std. distributions # theories/Crypt/only_prob/SymmetricSchemeStateProbStdDistr.v +# # Jasmin +# theories/Jasmin/jasmin_translate.v +# theories/Jasmin/jasmin_x86.v +# theories/Jasmin/jasmin_asm.v +# theories/Jasmin/jasmin_utils.v +# theories/Jasmin/word.v + +# theories/Jasmin/examples/add1.v +# theories/Jasmin/examples/aes.v +# theories/Jasmin/examples/aes/aes_jazz.v +# theories/Jasmin/examples/bigadd.v +# theories/Jasmin/examples/ex.v +# theories/Jasmin/examples/int_add.v +# theories/Jasmin/examples/int_incr.v +# theories/Jasmin/examples/int_reg.v +# theories/Jasmin/examples/int_shift.v +# theories/Jasmin/examples/liveness_bork.v +# theories/Jasmin/examples/matrix_product.v +# theories/Jasmin/examples/retz.v +# theories/Jasmin/examples/test_for.v +# theories/Jasmin/examples/test_inline_var.v +# theories/Jasmin/examples/test_shift.v +# theories/Jasmin/examples/three_functions.v +# theories/Jasmin/examples/two_functions.v +# theories/Jasmin/examples/u64_incr.v +# theories/Jasmin/examples/xor.v + +# theories/Jasmin/examples/aes/aes.v +# theories/Jasmin/examples/aes/aes_prf.v +# theories/Jasmin/examples/aes/aes_utils.v +# theories/Jasmin/examples/aes/aes_valid.v +# theories/Jasmin/examples/aes/aes_spec.v + # Examples theories/Crypt/examples/package_usage_example.v theories/Crypt/examples/interpreter_test.v diff --git a/flake.nix b/flake.nix index 3098a73e..36d0a0e3 100644 --- a/flake.nix +++ b/flake.nix @@ -7,7 +7,9 @@ let ssprovePkg = { lib, mkCoqDerivation, coq , equations, extructures, deriving - , mathcomp-analysis, mathcomp-ssreflect }: + , mathcomp-analysis, mathcomp-ssreflect + , mathcomp-word, mathcomp-zify + , mathcomp-experimental-reals, jasmin }: mkCoqDerivation { pname = "ssprove"; owner = "SSProve"; @@ -19,6 +21,10 @@ mathcomp-ssreflect deriving extructures + mathcomp-word + mathcomp-zify + mathcomp-experimental-reals + jasmin ]; meta = { description = "A foundational framework for modular cryptographic proofs in Coq "; diff --git a/ssprove.opam b/ssprove.opam index f469f116..43986d8d 100644 --- a/ssprove.opam +++ b/ssprove.opam @@ -12,8 +12,14 @@ depends: [ "coq-equations" {(>= "1.3+8.18")} "coq-mathcomp-ssreflect" {(>= "2.1.0")} ("coq-mathcomp-analysis" {>= "1.0.0" & < "1.7.0"} | "coq-mathcomp-analysis" {>= "1.7.0"} & "coq-mathcomp-experimental-reals" {>= "1.7.0"}) + "coq-mathcomp-word" {>= "3.0" & < "3.3"} + "coq-mathcomp-zify" {>= "1.5.0+2.0+8.16"} "coq-extructures" {(>= "0.4.0" & < "dev")} "coq-deriving" {(>= "0.2.0" & < "dev")} + "jasmin" {= "dev"} +] +pin-depends: [ + ["jasmin.dev" "git+https://github.com/jasmin-lang/jasmin.git#main"] ] build: [ [make "-j%{jobs}%"] diff --git a/theories/Crypt/Casts.v b/theories/Crypt/Casts.v index 9fa691ff..2f339140 100644 --- a/theories/Crypt/Casts.v +++ b/theories/Crypt/Casts.v @@ -1,12 +1,23 @@ Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". -From mathcomp Require Import ssreflect ssrbool ssrnat choice fintype. +From mathcomp Require Import ssreflect ssrbool ssrnat choice fintype eqtype all_algebra. Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". +From Coq Require Import ZArith. From extructures Require Import ord fmap. From SSProve.Crypt Require Import Prelude. +From mathcomp Require Import word_ssrZ word. +From Jasmin Require Import utils word. + From HB Require Import structures. +HB.instance Definition _ nbits := + [Ord of (word nbits) by <:]. + +HB.instance Definition _ nbits := + [Choice of (word nbits) by <:]. + + (** Note for any of these types it would also be okay to write the cast, e.g., [(nat:choiceType)%type], @@ -17,20 +28,29 @@ From HB Require Import structures. Definition unit_choiceType : choiceType := Datatypes.unit. Definition nat_choiceType : choiceType := nat. +Definition int_choiceType : choiceType := Z. Definition bool_choiceType : choiceType := bool. Definition prod_choiceType (A B: choiceType) : choiceType := prod A B. Definition fmap_choiceType (A: ordType) (B: choiceType) : choiceType := {fmap A -> B}. Definition option_choiceType (A: choiceType) : choiceType := option A. Definition fin_choiceType (p: positive) : choiceType := ordinal p.(pos). +Definition word_choiceType (nbits : wsize) : choiceType := word nbits. +Definition list_choiceType (A : choiceType) : choiceType := list A. + Definition sum_choiceType (A B: choiceType) : choiceType := (A + B)%type. Definition unit_ordType: ordType := Datatypes.unit. Definition nat_ordType: ordType := nat. +Definition int_ordType: ordType := Z. Definition bool_ordType: ordType := bool. Definition prod_ordType (A B: ordType) : ordType := prod A B. Definition fmap_ordType (A B: ordType) : ordType := {fmap A -> B}. Definition option_ordType (A: ordType) : ordType := option A. Definition fin_ordType (p: positive) : ordType := ordinal p.(pos). +Definition word_ordType (nbits : wsize) : ordType := word nbits. +Definition list_ordType (A : ordType) : ordType := list A. + + Definition sum_ordType (A B: ordType) : ordType := (A + B)%type. diff --git a/theories/Crypt/choice_type.v b/theories/Crypt/choice_type.v index 733e37c0..17990467 100644 --- a/theories/Crypt/choice_type.v +++ b/theories/Crypt/choice_type.v @@ -10,14 +10,21 @@ From Coq Require Import Utf8 Lia. From SSProve.Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples GenericRulesSimple. +(* !!! Import before mathcomp, to avoid overriding instances !!! *) +(* specifically, importing after mathcomp results in conflicting instances for + Z_choiceType. *) +From deriving Require Import deriving. + Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". From mathcomp Require Import ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice reals distr realsum seq all_algebra fintype. +From mathcomp Require Import word_ssrZ word. +From Jasmin Require Import utils word. Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra. From SSProve.Crypt Require Import Prelude Axioms Casts. -From deriving Require Import deriving. From extructures Require Import ord fset fmap. From SSProve.Mon Require Import SPropBase. Require Equations.Prop.DepElim. @@ -35,40 +42,49 @@ Open Scope fset. Open Scope fset_scope. Open Scope type_scope. -(* Basic structure *) - Inductive choice_type := | chUnit | chNat +| chInt | chBool | chProd (A B : choice_type) | chMap (A B : choice_type) | chOption (A : choice_type) -| chFin (n : positive). +| chFin (n : positive) +| chWord (nbits : wsize) +| chList (A : choice_type) +| chSum (A B : choice_type). Derive NoConfusion NoConfusionHom for choice_type. - Fixpoint chElement_ordType (U : choice_type) : ordType := match U with | chUnit => unit_ordType | chNat => nat_ordType + | chInt => int_ordType | chBool => bool_ordType | chProd U1 U2 => prod_ordType (chElement_ordType U1) (chElement_ordType U2) | chMap U1 U2 => fmap_ordType (chElement_ordType U1) (chElement_ordType U2) | chOption U => option_ordType (chElement_ordType U) | chFin n => fin_ordType n + | chWord nbits => word_ordType nbits + | chList U => list_ordType (chElement_ordType U) + | chSum U1 U2 => sum_ordType (chElement_ordType U1) (chElement_ordType U2) end. Fixpoint chElement (U : choice_type) : choiceType := match U with | chUnit => unit_choiceType | chNat => nat_choiceType + | chInt => int_choiceType | chBool => bool_choiceType | chProd U1 U2 => prod_choiceType (chElement U1) (chElement U2) | chMap U1 U2 => fmap_choiceType (chElement_ordType U1) (chElement U2) | chOption U => option_choiceType (chElement U) | chFin n => fin_choiceType n + | chWord nbits => word_choiceType nbits + | chList U => list_choiceType (chElement U) + | chSum U1 U2 => sum_choiceType (chElement U1) (chElement U2) end. Coercion chElement : choice_type >-> choiceType. @@ -78,11 +94,15 @@ Coercion chElement : choice_type >-> choiceType. match T with | chUnit => Datatypes.tt | chNat => 0 + | chInt => 0 | chBool => false | chProd A B => (chCanonical A, chCanonical B) | chMap A B => _ | chOption A => None | chFin n => _ + | chWord nbits => word0 + | chList A => [::] + | chSum A B => inl (chCanonical A) end. Next Obligation. eapply fmap_of_fmap. apply emptym. @@ -97,12 +117,17 @@ Section choice_typeTypes. Fixpoint choice_type_test (u v : choice_type) : bool := match u, v with | chNat , chNat => true + | chInt , chInt => true | chUnit , chUnit => true | chBool , chBool => true | chProd a b , chProd a' b' => choice_type_test a a' && choice_type_test b b' | chMap a b , chMap a' b' => choice_type_test a a' && choice_type_test b b' | chOption a, chOption a' => choice_type_test a a' | chFin n, chFin n' => n == n' + | chWord nbits, chWord nbits' => + nbits == nbits' + | chList a, chList b => choice_type_test a b + | chSum a b, chSum a' b' => choice_type_test a a' && choice_type_test b b' | _ , _ => false end. @@ -112,30 +137,50 @@ Section choice_typeTypes. Lemma choice_type_eqP : Equality.axiom choice_type_eq. Proof. move=> x y. - induction x as [ | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x1 ih1 | x1] + induction x as [ | | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x1 ih1 | x1 | x1 | x1 ih1 | x1 ih1 x2 ih2 ] in y |- *. - all: destruct y as [ | | | y1 y2 | y1 y2 | y1 | y1]. + all: destruct y as [ | | | | y1 y2 | y1 y2 | y1 | y1 | y1 | y1 | y1 y2 ]. all: simpl. all: try solve [ right ; discriminate ]. all: try solve [ left ; reflexivity ]. + (* chProd *) - destruct (ih1 y1), (ih2 y2). all: simpl. all: subst. all: try solve [ right ; congruence ]. left. reflexivity. + (* chMap *) - destruct (ih1 y1), (ih2 y2). all: simpl. all: subst. all: try solve [ right ; congruence ]. left. reflexivity. + (* chOption *) - destruct (ih1 y1). all: subst. + left. reflexivity. + right. congruence. + (* chFin *) + - destruct (x1 == y1) eqn:e. + + move: e => /eqP e. subst. left. reflexivity. + + move: e => /eqP e. right. intro h. + apply e. inversion h. reflexivity. + (* chWord *) - destruct (x1 == y1) eqn:e. + move: e => /eqP e. subst. left. reflexivity. + move: e => /eqP e. right. intro h. apply e. inversion h. reflexivity. + (* chList *) + - destruct (ih1 y1). + all: subst. + + left. reflexivity. + + right. congruence. + (* chSum *) + - destruct (ih1 y1), (ih2 y2). + all: simpl. + all: subst. + all: try solve [right ; congruence]. + left. reflexivity. Qed. Lemma choice_type_refl : @@ -173,9 +218,15 @@ Section choice_typeTypes. | chNat, chBool => false | chNat, chNat => false | chNat, _ => true + | chInt, chUnit => false + | chInt, chBool => false + | chInt, chNat => false + | chInt, chInt => false + | chInt, _ => true | chProd _ _, chUnit => false | chProd _ _, chBool => false | chProd _ _, chNat => false + | chProd _ _, chInt => false | chProd u1 u2, chProd w1 w2 => (choice_type_lt u1 w1) || (eq_op u1 w1 && choice_type_lt u2 w2) @@ -183,6 +234,7 @@ Section choice_typeTypes. | chMap _ _, chUnit => false | chMap _ _, chBool => false | chMap _ _, chNat => false + | chMap _ _, chInt => false | chMap _ _, chProd _ _ => false | chMap u1 u2, chMap w1 w2 => (choice_type_lt u1 w1) || @@ -191,17 +243,54 @@ Section choice_typeTypes. | chOption _, chUnit => false | chOption _, chBool => false | chOption _, chNat => false + | chOption _, chInt => false | chOption _, chProd _ _ => false | chOption _, chMap _ _ => false | chOption u, chOption w => choice_type_lt u w | chOption _, _ => true - | chFin n, chUnit => false - | chFin n, chBool => false - | chFin n, chNat => false - | chFin n, chProd _ _ => false - | chFin n, chMap _ _ => false - | chFin n, chOption _ => false + | chFin _, chUnit => false + | chFin _, chBool => false + | chFin _, chNat => false + | chFin _, chInt => false + | chFin _, chProd _ _ => false + | chFin _, chMap _ _ => false + | chFin _, chOption _ => false | chFin n, chFin n' => n < n' + | chFin _, _ => true + | chWord _, chUnit => false + | chWord _, chBool => false + | chWord _, chNat => false + | chWord _, chInt => false + | chWord _, chProd _ _ => false + | chWord _, chMap _ _ => false + | chWord _, chOption _ => false + | chWord _, chFin _ => false + | chWord n, chWord n' => (n < n')%CMP + | chWord _, _ => true + | chList _, chUnit => false + | chList _, chBool => false + | chList _, chNat => false + | chList _, chInt => false + | chList _, chProd _ _ => false + | chList _, chMap _ _ => false + | chList _, chOption _ => false + | chList _, chFin _ => false + | chList _, chWord _ => false + | chList u, chList w => choice_type_lt u w + | chList _, _ => true + | chSum _ _, chUnit => false + | chSum _ _, chBool => false + | chSum _ _, chNat => false + | chSum _ _, chInt => false + | chSum _ _, chProd _ _ => false + | chSum _ _, chMap _ _ => false + | chSum _ _, chOption _ => false + | chSum _ _, chFin _ => false + | chSum _ _, chWord _ => false + | chSum _ _, chList _ => false + | chSum u1 u2, chSum w1 w2 => + (choice_type_lt u1 w1) || + (eq_op u1 w1 && choice_type_lt u2 w2) end. Definition choice_type_leq (t1 t2 : choice_type) := @@ -210,14 +299,21 @@ Section choice_typeTypes. Lemma choice_type_lt_transitive : transitive (T:=choice_type) choice_type_lt. Proof. intros v u w h1 h2. - induction u as [ | | | u1 ih1 u2 ih2 | u1 ih1 u2 ih2 | u ih | u] + induction u as [ | | | | u1 ih1 u2 ih2 | u1 ih1 u2 ih2 | u ih | u | u | u ih | u1 ih1 u2 ih2 ] in v, w, h1, h2 |- *. + (* chUnit *) - destruct w. all: try auto. destruct v. all: discriminate. + (* chNat *) - destruct w. all: try auto. all: destruct v. all: discriminate. + (* chInt *) - destruct w. all: try auto. all: destruct v. all: discriminate. + (* chBool *) + - destruct w. all: try auto. + all: destruct v. all: discriminate. + (* chProd *) - destruct v. all: try discriminate. all: destruct w. all: try discriminate. all: try reflexivity. cbn in *. @@ -233,6 +329,7 @@ Section choice_typeTypes. apply/andP. subst. split. * apply/eqP. reflexivity. * eapply ih2. all: eauto. + (* chMap *) - destruct v. all: try discriminate. all: destruct w. all: try discriminate. all: try reflexivity. simpl in *. @@ -248,21 +345,49 @@ Section choice_typeTypes. apply/andP. subst. split. * apply/eqP. reflexivity. * eapply ih2. all: eauto. + (* chOption *) - destruct v. all: try discriminate. all: destruct w. all: try reflexivity. all: try discriminate. simpl in *. eapply ih. all: eauto. + (* chFin *) - destruct v. all: try discriminate. - destruct w. all: try discriminate. + all: destruct w; try discriminate; auto. simpl in *. eapply ltn_trans. all: eauto. + (* chWord *) + - destruct v. all: try discriminate. + all: destruct w; try discriminate; auto. + simpl in *. + eapply cmp_lt_trans. all: eauto. + (* chList *) + - destruct v. all: try discriminate. + all: destruct w. all: try reflexivity. all: try discriminate. + simpl in *. + eapply ih. all: eauto. + (* chSum *) + - destruct v. all: try discriminate. + all: destruct w. all: try discriminate. all: try reflexivity. + simpl in *. + move: h1 => /orP h1. + move: h2 => /orP h2. + apply/orP. + destruct h1 as [h1|h1], h2 as [h2|h2]. + + left. eapply ih1. all: eauto. + + left. move: h2 => /andP [/eqP e h2]. subst. auto. + + left. move: h1 => /andP [/eqP e h1]. subst. auto. + + right. move: h1 => /andP [/eqP e1 h1]. + move: h2 => /andP [/eqP e2 h2]. + apply/andP. subst. split. + * apply/eqP. reflexivity. + * eapply ih2. all: eauto. Qed. Lemma choice_type_lt_areflexive : ∀ x, ~~ choice_type_lt x x. Proof. intros x. - induction x as [ | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x ih | x] in |- *. + induction x as [ | | | | x1 ih1 x2 ih2 | x1 ih1 x2 ih2 | x ih | x | x | x ih | x1 ih1 x2 ih2] in |- *. all: intuition; simpl. - simpl. apply/norP. split. @@ -275,6 +400,13 @@ Section choice_typeTypes. + apply/nandP. right. apply ih2. - rewrite ltnn. auto. + - rewrite cmp_nlt_le. + apply cmp_le_refl. + - simpl. + apply/norP. split. + + apply ih1. + + apply/nandP. + right. apply ih2. Qed. Lemma choice_type_lt_total_holds : @@ -282,21 +414,22 @@ Section choice_typeTypes. ~~ (eq_op x y) ==> (choice_type_lt x y || choice_type_lt y x). Proof. intros x. - induction x as [ | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x]. - all: try solve [ destruct y ; auto with solve_subterm; reflexivity ]. + induction x as [ | | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x | x | x ih | x1 ih1 x2 ih2]. + all: try solve [ destruct y ; auto with solve_subterm ; reflexivity ]. + (* chProd *) - destruct y. all: try (intuition; reflexivity). specialize (ih1 y1). specialize (ih2 y2). apply/implyP. - move/nandP; rewrite -/choice_type_test -/eq_op. - move => H; apply/orP. + move /nandP => H. + apply/orP. destruct (eq_op x1 y1) eqn:Heq. - + setoid_rewrite -> Heq in H. move/nandP: H; rewrite Bool.andb_true_l => H. + + destruct H. 1: now setoid_rewrite Heq in H. move: ih2. move /implyP => ih2. specialize (ih2 H). move: ih2. move /orP => ih2. destruct ih2. * left. apply/orP. right. apply/andP. split. - all: intuition auto. + all: intuition. * right. apply/orP. right. apply/andP. intuition. move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity. + destruct H. @@ -318,6 +451,7 @@ Section choice_typeTypes. destruct ih1. +++ left. apply/orP. left. assumption. +++ right. apply/orP. left. assumption. + (* chMap *) - destruct y. all: try (intuition; reflexivity). cbn. specialize (ih1 y1). specialize (ih2 y2). @@ -325,18 +459,18 @@ Section choice_typeTypes. move /nandP => H. apply/orP. destruct (eq_op x1 y1) eqn:Heq. - + setoid_rewrite -> Heq in H; move: H => /nandP H; simpl in H. + + destruct H. 1: now setoid_rewrite Heq in H. move: ih2. move /implyP => ih2. specialize (ih2 H). move: ih2. move /orP => ih2. destruct ih2. * left. apply/orP. right. apply/andP. split. - all: intuition auto. + all: intuition. * right. apply/orP. right. apply/andP. intuition. move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity. + destruct H. - * move: ih1. rewrite -Heq; move /implyP => ih1. - specialize (ih1 H). + * move: ih1. move /implyP => ih1. + specialize (ih1 isT). move: ih1. move /orP => ih1. destruct ih1. -- left. apply/orP. left. assumption. @@ -353,10 +487,56 @@ Section choice_typeTypes. destruct ih1. +++ left. apply/orP. left. assumption. +++ right. apply/orP. left. assumption. + (* chFin *) - destruct y. all: try (intuition; reflexivity). - rewrite /choice_type_lt. + unfold choice_type_lt. rewrite -neq_ltn. - by [apply/implyP]. + apply /implyP. auto. + (* chWord *) + - destruct y. all: try (intuition; reflexivity). + unfold choice_type_lt. + apply /implyP. + move => H. apply /orP. + destruct (gcmp x nbits) eqn:E. + + by move: E H => /cmp_eq -> /negP. + + left. by apply /eqP. + + right. unfold cmp_lt. rewrite cmp_sym. by move: E => ->. + (* chSum *) + - destruct y. all: try (intuition; reflexivity). + cbn. + specialize (ih1 y1). specialize (ih2 y2). + apply/implyP. + move /nandP => H. + apply/orP. + destruct (eq_op x1 y1) eqn:Heq. + + destruct H. 1: now setoid_rewrite Heq in H. + move: ih2. move /implyP => ih2. + specialize (ih2 H). + move: ih2. move /orP => ih2. + destruct ih2. + * left. apply/orP. right. apply/andP. split. + all: intuition. + * right. apply/orP. right. apply/andP. intuition. + move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity. + + destruct H. + * move: ih1. move /implyP => ih1. + specialize (ih1 isT). + move: ih1. move /orP => ih1. + destruct ih1. + -- left. apply/orP. left. assumption. + -- right. apply/orP. left. assumption. + * move: ih2. move /implyP => ih2. + specialize (ih2 H). + move: ih2. move /orP => ih2. + destruct ih2. + --- simpl in ih1. move: ih1. move /orP => ih1. + destruct ih1. + +++ left. apply/orP. left. assumption. + +++ right. apply/orP. left. assumption. + --- simpl in ih1. move: ih1. move /orP => ih1. + destruct ih1. + +++ left. apply/orP. left. assumption. + +++ right. apply/orP. left. assumption. Qed. Lemma choice_type_lt_asymmetric : @@ -394,8 +574,7 @@ Section choice_typeTypes. Proof. intros x y. destruct (eq_op x y) eqn:H. - - apply/orP. - by right. + - apply/orP. by right. - apply/orP. left. pose (choice_type_lt_total_holds x y). @@ -406,58 +585,58 @@ Section choice_typeTypes. Lemma choice_type_leqxx : reflexive choice_type_leq. Proof. - move => x; rewrite /choice_type_leq. - by [apply/orP; left; apply/eqP]. + intro x. unfold choice_type_leq. + apply/orP. left. apply /eqP. reflexivity. Qed. Lemma choice_type_leq_trans : transitive choice_type_leq. Proof. - move => v u w; rewrite /choice_type_leq. - move/orP => h1; move/orP => h2. - case: h1. - + by [move/eqP => ih1; rewrite ih1; apply/orP]. - + case: h2. - * move /eqP => H0; rewrite H0 => lt_u_w. - by [apply/orP; right]. - * move => lt_v_w lt_u_v. - apply/orP; right. - exact: (choice_type_lt_transitive _ _ _ lt_u_v lt_v_w). + intros v u w h1 h2. + move: h1 h2. unfold choice_type_leq. + move /orP => h1. move /orP => h2. + destruct h1. + + move: H. move /eqP => H. destruct H. + apply/orP. assumption. + + destruct h2. + * move: H0. move /eqP => H0. destruct H0. + apply/orP. right. assumption. + * apply/orP. right. exact (choice_type_lt_transitive _ _ _ H H0). Qed. Lemma choice_type_leq_asym : antisymmetric choice_type_leq. Proof. - move => x y; rewrite /choice_type_leq; move/andP. - rewrite /choice_type_leq. - case. - move/orP => h1; move/orP => h2. - case: h1. - - by [move/eqP]. - - case: h2. - + by [move/eqP]. - + case Heq: (~~ (eq_op x y)). - * move: Heq. move /idP => Heq. - pose (choice_type_lt_total_not_holds x y) as Hp. - move: Hp. move /implyP => Hp. specialize (Hp Heq). - move: Hp. move /nandP => Hp. - case: Hp. - ** move/eqP => nlt_x_y lt_y_x; move/eqP/eqP => lt_x_y. - by [move: nlt_x_y; rewrite lt_x_y /=; move/eqP]. - ** move/eqP => nlt_y_x lt_y_x; move/eqP/eqP => lt_x_y. - by [move: nlt_y_x; rewrite lt_y_x /=; move/eqP]. - * by [move: Heq; move /eqP]. + unfold antisymmetric. + move => x y. unfold choice_type_leq. move/andP => [h1 h2]. + move: h1 h2. unfold choice_type_leq. + move /orP => h1. move /orP => h2. + destruct h1. + 1:{ move: H. move /eqP. intuition. } + destruct h2. + 1:{ move: H0. move /eqP. intuition. } + destruct (~~ (eq_op x y)) eqn:Heq. + + move: Heq. move /idP => Heq. + pose (choice_type_lt_total_not_holds x y) as Hp. + move: Hp. move /implyP => Hp. specialize (Hp Heq). + move: Hp. move /nandP => Hp. + destruct Hp. + * move: H. move /eqP /eqP => H. rewrite H in H1. simpl in H1. + discriminate. + * move: H0. move /eqP /eqP => H0. rewrite H0 in H1. simpl in H1. + discriminate. + + move: Heq. move /eqP. auto. Qed. Lemma choice_type_leq_total : total choice_type_leq. - Proof. - move => x y; rewrite /choice_type_leq. + unfold total. + intros x y. unfold choice_type_leq. pose (choice_type_lt_tot x y). - move: i => /orP i. - case: i. - + move/orP => i. - case: i => [lt_x_y|lt_y_x]; apply/orP. - * by [left; apply/orP; right]. - * by [right; apply/orP; right]. - + by [move => i; apply/orP; left; apply/orP; left]. + move: i. move /orP => H. + destruct H. + + move: H. move /orP => H. + destruct H. + * apply/orP. left. apply/orP. right. assumption. + * apply/orP. right. apply/orP. right. assumption. + + apply/orP. left. apply/orP. left. assumption. Qed. Fixpoint encode (t : choice_type) : GenTree.tree nat := @@ -465,10 +644,14 @@ Section choice_typeTypes. | chUnit => GenTree.Leaf 1 | chBool => GenTree.Leaf 2 | chNat => GenTree.Leaf 3 + | chInt => GenTree.Leaf 4 | chProd l r => GenTree.Node 1 [:: encode l ; encode r] | chMap l r => GenTree.Node 2 [:: encode l ; encode r] | chOption u => GenTree.Node 3 [:: encode u] - | chFin n => GenTree.Leaf ((4 + n) - 1)%N + | chFin n => GenTree.Node 4 [:: GenTree.Leaf (pos n)] + | chWord n => GenTree.Node 5 [:: GenTree.Leaf (wsize_log2 n)] + | chList u => GenTree.Node 6 [:: encode u] + | chSum l r => GenTree.Node 7 [:: encode l ; encode r] end. Fixpoint decode (t : GenTree.tree nat) : option choice_type := @@ -476,8 +659,7 @@ Section choice_typeTypes. | GenTree.Leaf 1 => Some chUnit | GenTree.Leaf 2 => Some chBool | GenTree.Leaf 3 => Some chNat - | GenTree.Leaf n => - Some ( chFin (mkpos ((n - 4).+1)%N) ) + | GenTree.Leaf 4 => Some chInt | GenTree.Node 1 [:: l ; r] => match decode l, decode r with | Some l, Some r => Some (chProd l r) @@ -493,13 +675,25 @@ Section choice_typeTypes. | Some l => Some (chOption l) | _ => None end + | GenTree.Node 4 [:: GenTree.Leaf (S n)] => Some (chFin (mkpos (S n))) + | GenTree.Node 5 [:: GenTree.Leaf n] => Some (chWord (nth U8 wsizes n)) + | GenTree.Node 6 [:: l] => + match decode l with + | Some l => Some (chList l) + | _ => None + end + | GenTree.Node 7 [:: l ; r] => + match decode l, decode r with + | Some l, Some r => Some (chSum l r) + | _, _ => None + end | _ => None end. Lemma codeK : pcancel encode decode. Proof. intro t. induction t. - all: intuition. + all: intuition eauto. all: simpl. - rewrite IHt1. rewrite IHt2. reflexivity. - rewrite IHt1. rewrite IHt2. reflexivity. @@ -507,19 +701,20 @@ Section choice_typeTypes. - destruct n as [n npos]. cbn. destruct n. + discriminate. - + cbn. - rewrite ?subnE /= -subnE subn0. - repeat f_equal. apply eq_irrelevance. - Defined. + + cbn. repeat f_equal. apply eq_irrelevance. + - repeat f_equal. unfold wsizes. + destruct nbits; reflexivity. + - rewrite IHt. reflexivity. + - rewrite IHt1. rewrite IHt2. reflexivity. + Qed. - HB.instance Definition _ := Choice.copy choice_type (pcan_type codeK). + #[short(type="choice_type_choiceMixin")] + HB.instance Definition _ := PCanHasChoice codeK. HB.instance Definition _ := - hasOrd.Build - choice_type - choice_type_leqxx - choice_type_leq_trans - choice_type_leq_asym - choice_type_leq_total. - + hasOrd.Build choice_type + (choice_type_leqxx) + (choice_type_leq_trans) + (choice_type_leq_asym) + (choice_type_leq_total). End choice_typeTypes. diff --git a/theories/Crypt/examples/Executor.v b/theories/Crypt/examples/Executor.v index b59a20da..752eeff3 100644 --- a/theories/Crypt/examples/Executor.v +++ b/theories/Crypt/examples/Executor.v @@ -1,5 +1,7 @@ From SSProve.Relational Require Import OrderEnrichedCategory GenericRulesSimple. +From Coq Require Import ZArith. + Set Warnings "-notation-overridden,-ambiguous-paths". From mathcomp Require Import all_ssreflect all_algebra reals distr realsum ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice seq. @@ -13,6 +15,8 @@ From SSProve.Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings From Coq Require Import Utf8. From extructures Require Import ord fset fmap. +From Jasmin Require Import word. + From Equations Require Import Equations. Require Equations.Prop.DepElim. @@ -49,12 +53,15 @@ Section Executor. nat_ch_aux (NSProd a b) (l1 × l2) (Some v1, Some v2) := Some (v1, v2) ; nat_ch_aux (NSProd a b) (l1 × l2) _ := None ; } ; + nat_ch_aux (NSNat n) ('word u) := Some _ ; nat_ch_aux _ _ := None. Proof. - eapply @Ordinal. instantiate (1 := n %% n'). apply ltn_pmod. apply cond_pos0. + - apply wrepr. + apply (BinInt.Z.of_nat n). Defined. Definition nat_ch (x : option NatState) (l : choice_type) : option (Value l) := @@ -79,6 +86,7 @@ Section Executor. | _ => None end ; ch_nat 'option l None := Some (NSOption None) ; + ch_nat 'word u x := Some (NSNat (BinInt.Z.to_nat (wunsigned x))) ; ch_nat _ _ := None. Lemma ch_nat_ch l v: @@ -87,51 +95,14 @@ Section Executor. | _ => true end. Proof. - induction l. - - rewrite ch_nat_equation_1. - simpl. - rewrite nat_ch_aux_equation_1. - by destruct v. - - rewrite ch_nat_equation_2. - simpl. - rewrite nat_ch_aux_equation_9. - reflexivity. - - rewrite ch_nat_equation_3. - simpl. - rewrite nat_ch_aux_equation_10. - destruct v ; reflexivity. - - destruct v. - rewrite ch_nat_equation_4. - simpl. - specialize (IHl1 s). - specialize (IHl2 s0). - move: IHl1 IHl2. - case (ch_nat l1 s) ; - case (ch_nat l2 s0). - + simpl. - intros. - rewrite nat_ch_aux_equation_32. - by rewrite IHl1 IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - - rewrite ch_nat_equation_5. - done. - - destruct v eqn:e ; simpl. - + rewrite ch_nat_equation_6. - specialize (IHl s). - case (ch_nat l s) eqn:e'. - ++ simpl. - intros. - rewrite nat_ch_aux_equation_20. - f_equal. - done. - ++ done. - + rewrite ch_nat_equation_7. - done. - - rewrite ch_nat_equation_8. - simpl. - rewrite nat_ch_aux_equation_14. + funelim (ch_nat l v). all: try easy. + - simpl. by destruct v. + - simp ch_nat. simpl. simp nat_ch_aux. by destruct v. + - simp ch_nat. destruct (ch_nat l1 v1), (ch_nat l2 v2); try easy. + cbn. simp nat_ch_aux. simpl in *. now rewrite H H0. + - simp ch_nat. destruct ch_nat; try easy. + simpl in *. simp nat_ch_aux. now f_equal. + - simp ch_nat. simpl. simp nat_ch_aux. f_equal. unfold nat_ch_aux_obligation_1. have lv := ltn_ord v. @@ -142,6 +113,13 @@ Section Executor. rewrite modn_small. 2: assumption. done. + - simp ch_nat. simpl. simp nat_ch_aux. + f_equal. + unfold nat_ch_aux_obligation_2. + rewrite @Znat.Z2Nat.id. + + rewrite wrepr_unsigned. + reflexivity. + + apply (@wunsigned_range u). Qed. Definition new_state @@ -179,10 +157,11 @@ Section Executor. End Executor. -#[program] Fixpoint sampler (e : choice_type) seed : option (nat * e):= +#[program] Fixpoint sampler (e : choice_type) (seed : nat) : option (nat * e):= match e with chUnit => Some (seed, Datatypes.tt) | chNat => Some ((seed + 1)%N, seed) + | chInt => Some ((seed + 1)%nat, BinInt.Z.of_nat seed) (* FIXME: also generate negative numbers *) | chBool => Some ((seed + 1)%N, Nat.even seed) | chProd A B => match sampler A seed with @@ -199,6 +178,25 @@ End Executor. | _ => None end | chFin n => Some ((seed + 1)%N, _) + | chWord n => Some ((seed + 1)%N, _) + | chList A => + match sampler A seed with + | Some (seed', x) => Some (seed', [:: x]) + | _ => None + end + | chSum A B => + let '(seed', b) := ((seed + 1)%nat, Nat.even seed) in + if b + then + match sampler A seed' with + | Some (seed'' , x) => Some (seed'', inl x) + | _ => None + end + else + match sampler B seed' with + | Some (seed'' , y) => Some (seed'', inr y) + | _ => None + end end. Next Obligation. eapply Ordinal. @@ -206,6 +204,19 @@ Next Obligation. rewrite ltn_mod. apply n. Defined. +Local Open Scope Z_scope. +Next Obligation. + eapply word.mkWord. + instantiate (1 := ((Z.of_nat seed) mod (word.modulus (nat_of_wsize n) ))%Z). + pose (Z.mod_bound_pos (Z.of_nat seed) (word.modulus n) + (Zle_0_nat seed)). + pose (word.modulus_gt0 (nat_of_wsize n)). + apply / word.iswordZP. + apply a. + move : i => / word_ssrZ.ltzP. + auto. +Defined. +Close Scope Z_scope. Section Test. diff --git a/theories/Crypt/examples/OVN.v b/theories/Crypt/examples/OVN.v index 33974f14..4ccd3195 100644 --- a/theories/Crypt/examples/OVN.v +++ b/theories/Crypt/examples/OVN.v @@ -9,7 +9,7 @@ Set Warnings "notation-overridden,ambiguous-paths". From SSProve.Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb - pkg_composition Package Prelude SigmaProtocol Schnorr DDH Canonicals. + pkg_composition Package Prelude SigmaProtocol Schnorr DDH. From Coq Require Import Utf8 Lia. From extructures Require Import ord fset fmap. @@ -17,6 +17,9 @@ From extructures Require Import ord fset fmap. From Equations Require Import Equations. Require Equations.Prop.DepElim. +From HB Require structures. +From mathcomp Require ssreflect.bigop. + Set Equations With UIP. Set Bullet Behavior "Strict Subproofs". @@ -101,7 +104,8 @@ Proof. Qed. Definition Pid : finType := Finite.clone _ 'I_n. -Definition Secret : finComRingType := 'Z_(Zp_trunc #[g]). +Definition Secret : finType := + FinRing_ComRing__to__fintype_Finite (fintype_ordinal__canonical__FinRing_ComRing (Zp_trunc #[g])). (* Zp_finComRingType (Zp_trunc #[g]). *) Definition Public : finType := gT. Definition s0 : Secret := 0. @@ -140,10 +144,17 @@ Definition i_secret := #|Secret|. Definition i_public := #|Public|. Module Type CDSParams <: SigmaProtocolParams. - Definition Witness : finType := Secret. - Definition Statement : finType := prod_finType (prod_finType Public Public) Public. + Definition Witness : finType := prod (prod Secret 'bool) Public. + Definition Statement : finType := prod (prod Public Public) Public. - Definition Witness_pos : Positive #|Witness| := Secret_pos. + Definition Witness_pos : Positive #|Witness|. + Proof. + rewrite !card_prod. + repeat apply Positive_prod. + - apply Secret_pos. + - rewrite card_bool. done. + - apply Public_pos. + Qed. Definition Statement_pos : Positive #|Statement|. Proof. unfold Statement. @@ -153,28 +164,32 @@ Module Type CDSParams <: SigmaProtocolParams. Qed. Definition R : Statement -> Witness -> bool := - λ (h : Statement) (x : Witness), - let '(gx, gy, gyxv) := h in - (gy^+x * g^+0 == gyxv) || (gy^+x * g^+1 == gyxv). + (λ (xhy : Statement) (mv : Witness), + let '(x,h,y) := xhy in + let '(m,v,h2) := mv in + (x == g ^+ m)%g + && (h == h2)%g + && ((y == h^+m * g ^+ v))%g + ). Lemma relation_valid_left: - ∀ (x : Secret) (gy : Public), - R (g^+x, gy, gy^+x * g^+ 0) x. + ∀ (x : Secret) (h : Public), + R (g^+x, h, h^+x * g)%g (x, 1%R, h)%g. Proof. - intros x gy. + intros x yi. unfold R. - apply /orP ; left. - done. + now rewrite !eqxx. Qed. Lemma relation_valid_right: - ∀ (x : Secret) (gy : Public), - R (g^+x, gy, gy^+x * g^+ 1) x. + ∀ (x : Secret) (h : Public), + R (g ^+ x, h, h ^+x) (x, 0%R, h). Proof. - intros x y. + intros x yi. unfold R. - apply /orP ; right. - done. + rewrite expg0. + rewrite mulg1. + now rewrite !eqxx. Qed. Parameter Message Challenge Response State : finType. @@ -186,7 +201,7 @@ Module Type CDSParams <: SigmaProtocolParams. Parameter Challenge_pos : Positive #|Challenge|. Parameter Response_pos : Positive #|Response|. Parameter State_pos : Positive #|State|. - Parameter Bool_pos : Positive #|bool_choiceType|. + Parameter Bool_pos : Positive #|'bool|. End CDSParams. Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). @@ -194,7 +209,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). Module Sigma1 := Schnorr GP. Module Sigma2 := SigmaProtocol π2 Alg2. - Obligation Tactic := idtac. + Local Obligation Tactic := idtac. Set Equations Transparent. Definition skey_loc (i : nat) : Location := (secret; (100+i)%N). @@ -263,22 +278,10 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). | _ => 1 end. - From HB Require Import structures. - (*HB.about Monoid.ComLaw. - HB.howto Monoid.ComLaw.type. - HB.about Monoid.isComLaw.Build. - HB.about Monoid.ComLaw. - Check group_prodC. - Locate group_prodC. - Print mulg. - Locate "*". - Print commutative. - HB.about Monoid.isComLaw. - *) - (* - HB.instance Definition _ := Monoid.isComLaw.Build gT [1 gT] mulg group_prodA group_prodC group_1prod. - Canonical finGroup_com_law := Monoid.ComLaw group_prodC. - *) + Import structures. + Import ssreflect.bigop. + Import Monoid. + HB.instance Definition _ := isCommutativeLaw.Build _ _ group_prodC. Definition compute_key (m : chMap pid (chProd public choiceTranscript1)) @@ -319,8 +322,9 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). rewrite !big_fsetU1. 2-3: subst X; apply not_in_domm. rewrite setm_rem. + have set_rem_eq : forall P x, - \big[finGroup_com_law/1]_(k <- X :\ j | P k) + \big[Notations_mulg__canonical__Monoid_ComLaw/1]_(k <- X :\ j | P k) get_value (setm keys j x) k = \prod_(k <- X :\ j | P k) get_value (remm keys j) k. @@ -341,8 +345,8 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). rewrite eq_refl in contra. discriminate. - reflexivity. - } + case (j < i)%ord eqn:e. - rewrite !e. rewrite -2!mulgA. @@ -990,114 +994,114 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). {code x ← sample uniform i_secret ;; #put skey_loc i := x ;; - #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;; + #assert Sigma1.MyParam.R (otf (fto (expgn (T:=gT) g (otf x)))) (otf x) ;; x1 ← sample uniform Sigma1.MyAlg.i_witness ;; #put Sigma1.MyAlg.commit_loc := x1 ;; - #put RO1.queries_loc := emptym ;; + #put RO1.queries_loc := emptym ;; x2 ← get RO1.queries_loc ;; - match x2 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) with + match x2 (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)))) with | Some a => v ← get Sigma1.MyAlg.commit_loc ;; x3 ← sample uniform i_secret ;; - #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;; + #assert Sigma1.MyParam.R (otf (fto (expgn (T:=gT) g (otf x3)))) (otf x3) ;; x5 ← sample uniform Sigma1.MyAlg.i_witness ;; #put Sigma1.MyAlg.commit_loc := x5 ;; #put RO1.queries_loc := emptym ;; v0 ← get RO1.queries_loc ;; - match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with + match v0 (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)))) with | Some a0 => x6 ← get Sigma1.MyAlg.commit_loc ;; let x4 := - (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) + (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in #assert eqn (size - (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; #put ckey_loc i := fto (compute_key - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; v0 ← get skey_loc i ;; v1 ← get ckey_loc i ;; - @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + @ret 'public (fto (expgn (T:=gT) (otf v1) v0 * expgn (T:=gT) g vote)) | None => a0 ← sample uniform RO1.i_random ;; #put RO1.queries_loc := setm v0 - (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;; + (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)))) a0 ;; x6 ← get Sigma1.MyAlg.commit_loc ;; - let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + let x4 := (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in #assert eqn (size - (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; #put ckey_loc i := fto (compute_key - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; v0 ← get skey_loc i ;; v1 ← get ckey_loc i ;; - @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + @ret 'public (fto (expgn (T:=gT) (otf v1) v0 * expgn (T:=gT) g vote)) end | None => a ← sample uniform RO1.i_random ;; #put RO1.queries_loc := setm x2 - (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;; + (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)))) a ;; v ← get Sigma1.MyAlg.commit_loc ;; x3 ← sample uniform i_secret ;; - #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;; + #assert Sigma1.MyParam.R (otf (fto (expgn (T:=gT) g (otf x3)))) (otf x3) ;; x5 ← sample uniform Sigma1.MyAlg.i_witness ;; #put Sigma1.MyAlg.commit_loc := x5 ;; #put RO1.queries_loc := emptym ;; v0 ← get RO1.queries_loc ;; - match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with + match v0 (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)))) with | Some a0 => x6 ← get Sigma1.MyAlg.commit_loc ;; - let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + let x4 := (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in #assert eqn (size - (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; #put ckey_loc i := fto (compute_key - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; v0 ← get skey_loc i ;; v1 ← get ckey_loc i ;; - @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + @ret 'public (fto (expgn (T:=gT) (otf v1) v0 * expgn (T:=gT) g vote)) | None => a0 ← sample uniform RO1.i_random ;; #put RO1.queries_loc := setm v0 - (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;; + (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)))) a0 ;; x6 ← get Sigma1.MyAlg.commit_loc ;; - let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + let x4 := (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in #assert eqn (size - (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; #put ckey_loc i := fto (compute_key - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; v0 ← get skey_loc i ;; v1 ← get ckey_loc i ;; - @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + @ret 'public (fto (expgn (T:=gT) (otf v1) v0 * expgn (T:=gT) g vote)) end end }. @@ -1114,39 +1118,39 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). {code x ← sample uniform i_secret ;; #put skey_loc i := x ;; - #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;; + #assert Sigma1.MyParam.R (otf (fto (expgn (T:=gT) g (otf x)))) (otf x) ;; x1 ← sample uniform Sigma1.MyAlg.i_witness ;; #put Sigma1.MyAlg.commit_loc := x1 ;; x2 ← get RO1.queries_loc ;; a ← sample uniform RO1.i_random ;; #put RO1.queries_loc := setm x2 - (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;; + (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)))) a ;; v ← get Sigma1.MyAlg.commit_loc ;; x3 ← sample uniform i_secret ;; - #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;; + #assert Sigma1.MyParam.R (otf (fto (expgn (T:=gT) g (otf x3)))) (otf x3) ;; x5 ← sample uniform Sigma1.MyAlg.i_witness ;; #put Sigma1.MyAlg.commit_loc := x5 ;; v0 ← get RO1.queries_loc ;; a0 ← sample uniform RO1.i_random ;; #put RO1.queries_loc := setm v0 - (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;; + (Sigma1.Sigma.prod_assoc (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)))) a0 ;; x6 ← get Sigma1.MyAlg.commit_loc ;; - let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in + let x4 := (fto (expgn (T:=gT) g (otf x3)), fto (expgn (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in #assert eqn (size - (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; + (domm (T:='I_#|'I_n|) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|)) + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;; #put ckey_loc i := fto (compute_key - (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i - (fto (expgn_rec (T:=gT) g (otf x)), - (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, + (setm (T:='I_#|'I_n|) (setm (T:='I_#|'I_n|) m j (fto (expgn (T:=gT) g (otf x3)), x4)) i + (fto (expgn (T:=gT) g (otf x)), + (fto (expgn (T:=gT) g (otf x)), fto (expgn (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;; v0 ← get skey_loc i ;; v1 ← get ckey_loc i ;; - @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote)) + @ret 'public (fto (expgn (T:=gT) (otf v1) v0 * expgn (T:=gT) g vote)) }. Next Obligation. intros. @@ -1217,7 +1221,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). apply rreflexivity_rule. } subst temp1 temp2 temp3 temp4. - + apply (@r_assertD_same (chFin (mkpos #|gT|)) _). intros. @@ -1227,7 +1231,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). ssprove_contract_put_get_lhs. ssprove_contract_put_get_rhs. - + ssprove_sync_eq. simpl. @@ -1240,7 +1244,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). set (temp1 := x) ; set (temp2 := y) ; set (temp3 := z) ; set (temp4 := v) in * end. - + apply (r_transL (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))). 1:{ eapply r_transR. @@ -1358,7 +1362,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). rewrite !cast_fun_K. ssprove_code_simpl. ssprove_code_simpl_more. - + ssprove_swap_seq_rhs [:: 4 ; 5 ; 6 ; 7]%N. ssprove_swap_seq_rhs [:: 2 ; 3 ; 4 ; 5 ; 6]%N. ssprove_swap_seq_rhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N. @@ -1389,7 +1393,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). by apply /fset1P. - apply preserve_update_mem_nil. } - ssprove_sync. + eapply (@rsame_head_cmd_alt _ _ (λ z, _) (λ z, _) (cmd_put _ _)) ; [eapply cmd_put_preserve_pre ; ssprove_invariant | intros ]. ssprove_swap_seq_lhs [:: 0 ]%N. ssprove_swap_seq_rhs [:: 2 ; 1 ; 0]%N. ssprove_sync => queries. @@ -1832,7 +1836,7 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). } eapply le_trans. 1: exact ineq. clear ineq. - repeat eapply ler_add. + repeat eapply lerD. { apply eq_ler. specialize (Hf true LA A Va). @@ -2208,4 +2212,3 @@ Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2). End OVN. End OVN. - diff --git a/theories/Crypt/examples/Schnorr.v b/theories/Crypt/examples/Schnorr.v index be7a4f10..645e1e51 100644 --- a/theories/Crypt/examples/Schnorr.v +++ b/theories/Crypt/examples/Schnorr.v @@ -83,7 +83,7 @@ Module MyParam <: SigmaProtocolParams. Definition Message_pos : Positive #|Message| := _. Definition Challenge_pos : Positive #|Challenge| := _. Definition Response_pos : Positive #|Response| := _. - Definition Bool_pos : Positive #|(bool:choiceType)|. + Definition Bool_pos : Positive #|'bool|. Proof. rewrite card_bool. done. Defined. @@ -105,7 +105,7 @@ Module MyAlg <: SigmaProtocolAlgorithms MyParam. chProd (chProd (chProd choiceStatement choiceMessage) choiceChallenge) choiceResponse. - Definition choiceBool := 'fin #|bool_choiceType|. + Definition choiceBool := 'fin #|'bool|. Definition i_witness := #|Witness|. @@ -514,12 +514,11 @@ Proof. unfold "\notin". rewrite in_fset1. done. - ++ - rewrite -!fset1E. + ++ rewrite -!fset1E. rewrite fdisjoint1s. - unfold "\notin". - rewrite in_fset1. - done. + unfold "\notin". + rewrite in_fset1. + done. } rewrite Advantage_sym. erewrite schnorr_SHVZK. @@ -554,12 +553,11 @@ Proof. unfold "\notin". rewrite in_fset1. done. - ++ - rewrite -!fset1E. + ++ rewrite -!fset1E. rewrite fdisjoint1s. - unfold "\notin". - rewrite in_fset1. - done. + unfold "\notin". + rewrite in_fset1. + done. } rewrite addr0 add0r. apply eq_ler. @@ -662,6 +660,28 @@ Proof. Qed. +(* Main theorem *) +(* The commitment scheme instantiated from Schnorr' protocol *) +(* is binding equal to the hardness of the relation *) +(* (I.e. how hard is it to produce a valid witness for a fixed public input)*) +Theorem schnorr_com_binding : + ∀ LA A, + ValidPackage LA [interface + #val #[ SOUNDNESS ] : chSoundness → 'bool + ] A_export A → + fdisjoint LA (Sigma_to_Com_locs :|: KEY_locs) → + AdvantageE (Com_Binding ∘ Sigma_to_Com ∘ KEY) (Special_Soundness_f) A <= 0. +Proof. + intros LA A VA Hdisj. + eapply Order.le_trans. + 1: apply Advantage_triangle. + instantiate (1 := Special_Soundness_t). + rewrite (commitment_binding LA A VA Hdisj). + setoid_rewrite (extractor_success LA A VA). + setoid_rewrite GRing.isNmodule.add0r. + apply Order.isDuallyPOrder.le_refl. +Qed. + End Schnorr. Module GP_Z3 <: GroupParam. diff --git a/theories/Crypt/examples/SigmaProtocol.v b/theories/Crypt/examples/SigmaProtocol.v index 84d71830..0ee3afab 100644 --- a/theories/Crypt/examples/SigmaProtocol.v +++ b/theories/Crypt/examples/SigmaProtocol.v @@ -45,7 +45,7 @@ Module Type SigmaProtocolParams. Parameter Message_pos : Positive #|Message|. Parameter Challenge_pos : Positive #|Challenge|. Parameter Response_pos : Positive #|Response|. - Parameter Bool_pos : Positive #|bool_choiceType|. + Parameter Bool_pos : Positive #|'bool|. End SigmaProtocolParams. @@ -69,7 +69,7 @@ Module Type SigmaProtocolAlgorithms (π : SigmaProtocolParams). Definition choiceResponse := 'fin #|Response|. Definition choiceTranscript := chProd (chProd (chProd choiceStatement choiceMessage) choiceChallenge) choiceResponse. - Definition choiceBool := 'fin #|bool_choiceType|. + Definition choiceBool := 'fin #|'bool|. Parameter Sigma_locs : {fset Location}. @@ -224,6 +224,7 @@ Module SigmaProtocol (π : SigmaProtocolParams) } ]. + (* Simulation Sound Extractability *) (* Main security statement for 2-special soundness. *) Definition ɛ_soundness A := AdvantageE Special_Soundness_t Special_Soundness_f A. diff --git a/theories/Crypt/examples/SymmRatchet.v b/theories/Crypt/examples/SymmRatchet.v index 95a8dfa0..296e0830 100644 --- a/theories/Crypt/examples/SymmRatchet.v +++ b/theories/Crypt/examples/SymmRatchet.v @@ -200,7 +200,7 @@ Definition GEN_STRETCH_pkg_tt: [package #def #[query] (k: 'nat): ('seq 'word) × 'word { s0 <$ uniform Word_N ;; - @map_loop _ 'word _ (iota 0 k) s0 (fun _ si => + @map_loop _ Word _ (iota 0 k) s0 (fun _ si => ret (PRG si) ) } @@ -211,7 +211,7 @@ Definition GEN_STRETCH_pkg_ff: [interface #val #[query]: 'nat → ('seq 'word) × 'word ] := [package #def #[query] (k: 'nat): ('seq 'word) × 'word { - t ← @map_loop _ 'word _ (iota 0 k) tt (fun _ _ => + t ← @map_loop _ Word _ (iota 0 k) tt (fun _ _ => ti <$ uniform Word_N ;; ret (ti, tt) ) ;; @@ -231,7 +231,7 @@ Definition ATTACK_pkg_tt: [package #def #[attack] (m: 'seq 'word): ('seq 'word) × 'word { s0 <$ uniform Word_N ;; - @map_loop _ 'word _ (unzip2 m) s0 (fun mi si => + @map_loop _ Word _ (unzip2 m) s0 (fun mi si => let xy := PRG si in ret (enc xy.1 mi, xy.2) ) @@ -243,7 +243,7 @@ Definition ATTACK_pkg_ff: [interface #val #[attack]: 'seq 'word → ('seq 'word) × 'word ] := [package #def #[attack] (m: 'seq 'word): ('seq 'word) × 'word { - c ← @map_loop _ 'word _ (unzip2 m) tt (fun _ _ => + c ← @map_loop _ Word _ (unzip2 m) tt (fun _ _ => ci <$ uniform Word_N ;; ret (ci, tt) ) ;; @@ -262,7 +262,7 @@ Definition ATTACK_GEN_pkg: #def #[attack] (m: 'seq 'word): ('seq 'word) × 'word { #import {sig #[query]: 'nat → ('seq 'word) × 'word } as query ;; ts ← query (size m) ;; - c ← @map_loop _ 'word _ (zip (unzip2 ts.1) (unzip2 m)) tt (fun tm _ => + c ← @map_loop _ Word _ (zip (unzip2 ts.1) (unzip2 m)) tt (fun tm _ => let (ti, mi) := (tm.1, tm.2) in ret (enc ti mi, tt) ) ;; @@ -275,7 +275,7 @@ Definition ATTACK_HYB_pkg: [interface #val #[attack]: 'seq 'word → ('seq 'word) × 'word ] := [package #def #[attack] (m: 'seq 'word): ('seq 'word) × 'word { - c ← @map_loop _ 'word _ (unzip2 m) tt (fun mi _ => + c ← @map_loop _ Word _ (unzip2 m) tt (fun mi _ => ti <$ uniform Word_N ;; ret (enc ti mi, tt) ) ;; @@ -291,7 +291,7 @@ Definition ATTACK_CTXT_pkg: [package #def #[attack] (m: 'seq 'word): ('seq 'word) × 'word { #import {sig #[ctxt]: 'word → 'word } as ctxt ;; - c ← @map_loop _ 'word _ (unzip2 m) tt (fun mi _ => + c ← @map_loop _ Word _ (unzip2 m) tt (fun mi _ => ci ← ctxt mi ;; ret (ci, tt) ) ;; @@ -314,7 +314,7 @@ Proof. 2: by []. 2: { apply: boolp.funext => x. - erewrite (@code_link_map_loop _ 'word _ (zip _ _) tt) => /=. + erewrite (@code_link_map_loop _ Word _ (zip _ _) tt) => /=. erewrite bind_cong. 1,2: by []. apply: boolp.funext => y. @@ -338,7 +338,7 @@ Proof. ssprove_code_simpl. case: (PRG s0) => [ti si] /=. rewrite -lock. - erewrite (bind_cong _ _ (@map_loop _ 'word _ (iota a.+1 (size m)) si _)). + erewrite (bind_cong _ _ (@map_loop _ Word _ (iota a.+1 (size m)) si _)). 2: by []. 2: { apply: boolp.funext => x. @@ -365,7 +365,7 @@ Proof. 2: by []. 2: { apply: boolp.funext => x. - erewrite (@code_link_map_loop _ 'word _ (zip _ _) tt) => /=. + erewrite (@code_link_map_loop _ Word _ (zip _ _) tt) => /=. erewrite bind_cong. 1,2: by []. apply: boolp.funext => y. @@ -386,7 +386,7 @@ Proof. ssprove_code_simpl. ssprove_sync_eq=> ci. rewrite -lock. - erewrite (bind_cong _ _ (@map_loop _ 'word _ (iota a.+1 (size m)) tt _)). + erewrite (bind_cong _ _ (@map_loop _ Word _ (iota a.+1 (size m)) tt _)). 2: by []. 2: { apply: boolp.funext => x. @@ -410,7 +410,7 @@ Proof. ssprove_swap_lhs 0. ssprove_swap_rhs 0. ssprove_sync_eq=> sn. - rewrite (@code_link_map_loop _ 'word _ (unzip2 m) tt _) /=. + rewrite (@code_link_map_loop _ Word _ (unzip2 m) tt _) /=. simplify_linking. by apply: rreflexivity_rule. Qed. @@ -427,7 +427,7 @@ Proof. ssprove_swap_lhs 0. ssprove_swap_rhs 0. ssprove_sync_eq=> sn. - rewrite (@code_link_map_loop _ 'word _ (unzip2 m) tt _) /=. + rewrite (@code_link_map_loop _ Word _ (unzip2 m) tt _) /=. simplify_linking. by apply: rreflexivity_rule. Qed. diff --git a/theories/Crypt/package/pkg_heap.v b/theories/Crypt/package/pkg_heap.v index d8217d1e..c8459dca 100644 --- a/theories/Crypt/package/pkg_heap.v +++ b/theories/Crypt/package/pkg_heap.v @@ -5,6 +5,7 @@ From Coq Require Import Utf8. +Require Import ZArith. From SSProve.Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". @@ -19,6 +20,7 @@ From SSProve.Crypt Require Import Prelude Axioms ChoiceAsOrd SubDistr Couplings pkg_tactics pkg_composition. Require Import Equations.Prop.DepElim. From Equations Require Import Equations. +From mathcomp Require Import word. (* Must come after importing Equations.Equations, who knows why. *) From SSProve.Crypt Require Import FreeProbProg. @@ -58,11 +60,15 @@ Proof. intros a. induction a. - exact tt. - exact 0. + - exact Z0. - exact false. - exact (IHa1, IHa2). - exact emptym. - exact None. - exact (fintype.Ordinal n.(cond_pos)). + - exact word0. + - exact [::]. + - exact (inl IHa1). Defined. Definition heap := { h : raw_heap | valid_heap h }. diff --git a/theories/Crypt/package/pkg_interpreter.v b/theories/Crypt/package/pkg_interpreter.v index 4995f402..03604b7e 100644 --- a/theories/Crypt/package/pkg_interpreter.v +++ b/theories/Crypt/package/pkg_interpreter.v @@ -1,6 +1,7 @@ Set Warnings "-notation-overridden,-ambiguous-paths". From mathcomp Require Import all_ssreflect. Set Warnings "notation-overridden,ambiguous-paths". +Require Arith ZArith. From SSProve.Crypt Require Import Prelude choice_type pkg_core_definition pkg_tactics pkg_distr pkg_notation. @@ -8,6 +9,8 @@ From SSProve.Crypt Require Import Prelude choice_type From Coq Require Import Utf8. From extructures Require Import ord fset fmap. +From Jasmin Require Import word. + From Equations Require Import Equations. Set Equations With UIP. @@ -38,12 +41,15 @@ Section Interpreter. nat_ch_aux (NSProd a b) (l1 × l2) (Some v1, Some v2) := Some (v1, v2) ; nat_ch_aux (NSProd a b) (l1 × l2) _ := None ; } ; + nat_ch_aux (NSNat n) ('word u) := Some _ ; nat_ch_aux _ _ := None. Proof. - eapply @Ordinal. instantiate (1 := n %% n'). apply ltn_pmod. apply cond_pos0. + - apply wrepr. + apply (BinInt.Z.of_nat n). Defined. Definition nat_ch (x : option NatState) (l : choice_type) : option (Value l) := @@ -68,6 +74,7 @@ Section Interpreter. | _ => None end ; ch_nat 'option l None := Some (NSOption None) ; + ch_nat 'word u x := Some (NSNat (BinInt.Z.to_nat (wunsigned x))) ; ch_nat _ _ := None. Lemma ch_nat_ch l v: @@ -76,51 +83,14 @@ Section Interpreter. | _ => true end. Proof. - induction l. - - rewrite ch_nat_equation_1. - simpl. - rewrite nat_ch_aux_equation_1. - by destruct v. - - rewrite ch_nat_equation_2. - simpl. - rewrite nat_ch_aux_equation_9. - reflexivity. - - rewrite ch_nat_equation_3. - simpl. - rewrite nat_ch_aux_equation_10. - destruct v ; reflexivity. - - destruct v. - rewrite ch_nat_equation_4. - simpl. - specialize (IHl1 s). - specialize (IHl2 s0). - move: IHl1 IHl2. - case (ch_nat l1 s) ; - case (ch_nat l2 s0). - + simpl. - intros. - rewrite nat_ch_aux_equation_32. - by rewrite IHl1 IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - + by simpl ; intros ; try inversion IHl1 ; try inversion IHl2. - - rewrite ch_nat_equation_5. - done. - - destruct v eqn:e ; simpl. - + rewrite ch_nat_equation_6. - specialize (IHl s). - case (ch_nat l s) eqn:e'. - ++ simpl. - intros. - rewrite nat_ch_aux_equation_20. - f_equal. - done. - ++ done. - + rewrite ch_nat_equation_7. - done. - - rewrite ch_nat_equation_8. - simpl. - rewrite nat_ch_aux_equation_14. + funelim (ch_nat l v). all: try easy. + - simpl. by destruct v. + - simp ch_nat. simpl. simp nat_ch_aux. by destruct v. + - simp ch_nat. destruct (ch_nat l1 v1), (ch_nat l2 v2); try easy. + cbn. simp nat_ch_aux. simpl in *. now rewrite H H0. + - simp ch_nat. destruct ch_nat; try easy. + simpl in *. simp nat_ch_aux. now f_equal. + - simp ch_nat. simpl. simp nat_ch_aux. f_equal. unfold nat_ch_aux_obligation_1. have lv := ltn_ord v. @@ -131,6 +101,13 @@ Section Interpreter. rewrite modn_small. 2: assumption. done. + - simp ch_nat. simpl. simp nat_ch_aux. + f_equal. + unfold nat_ch_aux_obligation_2. + rewrite @Znat.Z2Nat.id. + + rewrite wrepr_unsigned. + reflexivity. + + apply (@wunsigned_range u). Qed. Definition new_state @@ -163,12 +140,12 @@ Section Interpreter. Definition Run {A} := (fun c seed => @Run_aux A c seed (fun (l : Location) => Some NSUnit)). - #[program] Fixpoint sampler (e : choice_type) seed : option (nat * e):= match e with - chUnit => Some (seed, Datatypes.tt) - | chNat => Some ((seed + 1)%N, seed) - | chBool => Some ((seed + 1)%N, Nat.even seed) + | chUnit => Some (seed, Datatypes.tt) + | chNat => Some ((seed + 1)%nat, seed) + | chInt => Some ((seed + 1)%nat, BinInt.Z.of_nat seed) (* FIXME: also generate negative numbers *) + | chBool => Some ((seed + 1)%nat, Nat.even seed) | chProd A B => match sampler A seed with | Some (seed' , x) => match sampler B seed' with @@ -184,6 +161,25 @@ Section Interpreter. | _ => None end | chFin n => Some ((seed + 1)%N, _) + | chWord n => Some ((seed + 1)%N, _) + | chList A => + match sampler A seed with + | Some (seed', x) => Some (seed', [:: x]) + | _ => None + end + | chSum A B => + let '(seed', b) := ((seed + 1)%nat, Nat.even seed) in + if b + then + match sampler A seed' with + | Some (seed'' , x) => Some (seed'', inl x) + | _ => None + end + else + match sampler B seed' with + | Some (seed'' , y) => Some (seed'', inr y) + | _ => None + end end. Next Obligation. eapply Ordinal. @@ -192,4 +188,23 @@ Section Interpreter. apply n. Defined. + Set Warnings "-notation-overridden,-ambiguous-paths". + Import ZArith. + Import all_algebra. + Set Warnings "notation-overridden,ambiguous-paths". + Local Open Scope Z_scope. + Local Open Scope ring_scope. + + Next Obligation. + eapply word.mkWord. + instantiate (1 := ((Z.of_nat seed) mod (word.modulus (nat_of_wsize n) ))%Z). + pose (Z.mod_bound_pos (Z.of_nat seed) (word.modulus n) + (Zle_0_nat seed)). + pose (word.modulus_gt0 (nat_of_wsize n)). + apply / word.iswordZP. + apply a. + move : i => / word_ssrZ.ltzP. + auto. + Defined. + End Interpreter. diff --git a/theories/Crypt/package/pkg_invariants.v b/theories/Crypt/package/pkg_invariants.v index c7675a9f..15eaa4dd 100644 --- a/theories/Crypt/package/pkg_invariants.v +++ b/theories/Crypt/package/pkg_invariants.v @@ -65,6 +65,43 @@ Definition INV' (L1 L2 : {fset Location}) (I (s1, s2) → ∀ l v, l \notin L1 → l \notin L2 → I (set_heap s1 l v, set_heap s2 l v)). +Definition pINV' (P1 P2 : Location -> Prop) + (I : heap_choiceType * heap_choiceType → Prop) + := + ∀ s1 s2, + (I (s1, s2) → ∀ l, ~ P1 l → ~ P2 l → + get_heap s1 l = get_heap s2 l) ∧ + (I (s1, s2) → ∀ l v, ~ P1 l -> ~ P2 l → + I (set_heap s1 l v, set_heap s2 l v)). + +(* TODO: move? *) +Definition pdisjoint (L : {fset Location}) (P : Location -> Prop) := forall l, ~ (l \in L /\ P l). + +Lemma pINV'_to_INV (L : {fset Location}) P1 P2 + (I : heap_choiceType * heap_choiceType → Prop) + (HpINV' : pINV' P1 P2 I) + (Hdisjoint1 : pdisjoint L P1) + (Hdisjoint2 : pdisjoint L P2) : + INV L I. +Proof. + unfold INV. + intros s1 s2. split. + - intros hi l hin. + apply HpINV'. + + assumption. + + intros contra. + eapply Hdisjoint1. eauto. + + intros contra. + eapply Hdisjoint2. eauto. + - intros hi l v hin. + apply HpINV'. + + assumption. + + intros contra. + eapply Hdisjoint1. eauto. + + intros contra. + eapply Hdisjoint2. eauto. +Qed. + Lemma INV'_to_INV (L L1 L2 : {fset Location}) (I : heap_choiceType * heap_choiceType → Prop) (HINV' : INV' L1 L2 I) @@ -89,6 +126,12 @@ Proof. apply Hdisjoint2. assumption. Qed. +(* TODO: add automation? *) +Class pInvariant P₀ P₁ pinv := { + pinv_pINV' : pINV' P₀ P₁ pinv ; + pinv_empty : pinv (empty_heap, empty_heap) +}. + Class Invariant L₀ L₁ inv := { inv_INV' : INV' L₀ L₁ inv ; inv_empty : inv (empty_heap, empty_heap) @@ -122,7 +165,12 @@ Definition heap_ignore (L : {fset Location}) : precond := λ '(h₀, h₁), ∀ (ℓ : Location), ℓ \notin L → get_heap h₀ ℓ = get_heap h₁ ℓ. +Definition heap_ignore_pred (P : Location -> Prop) : precond := + λ '(h₀, h₁), + forall (ℓ : Location), ~ P ℓ -> get_heap h₀ ℓ = get_heap h₁ ℓ. + Arguments heap_ignore : simpl never. +Arguments heap_ignore_pred : simpl never. Lemma heap_ignore_empty : ∀ L, @@ -131,6 +179,35 @@ Proof. intros L ℓ hℓ. reflexivity. Qed. +Lemma heap_ignore_pred_empty : + ∀ P, + heap_ignore_pred P (empty_heap, empty_heap). +Proof. + intros P ℓ hℓ. reflexivity. +Qed. + +Lemma INV'_heap_ignore_pred (P : Location -> Prop) : + ∀ L0 L1 : {fset Location}, + (forall ℓ : Location, P ℓ -> ℓ \in L0 :|: L1) -> + INV' L0 L1 (heap_ignore_pred P). +Proof. + intros L0 L1 hP h0 h1. split. + - intros hh l nin0 nin1. + eapply hh. + intros contra. + apply hP in contra as h. + rewrite in_fsetU in h. move: h => /orP [h | h]. + + rewrite h in nin0. discriminate. + + rewrite h in nin1. discriminate. + - intros h ℓ v n₀ n₁ ℓ' n. + destruct (ℓ' != ℓ) eqn:e. + + rewrite get_set_heap_neq. 2: auto. + rewrite get_set_heap_neq. 2: auto. + apply h. auto. + + move: e => /eqP e. subst. + rewrite !get_set_heap_eq. reflexivity. +Qed. + Lemma INV'_heap_ignore : ∀ L L₀ L₁, fsubset L (L₀ :|: L₁) → @@ -153,6 +230,16 @@ Proof. rewrite !get_set_heap_eq. reflexivity. Qed. +Lemma Invariant_heap_ignore_pred : + ∀ L0 L1 (P : Location -> Prop), + (forall ℓ : Location, P ℓ -> ℓ \in L0 :|: L1) -> + Invariant L0 L1 (heap_ignore_pred P). +Proof. + intros L P h. split. + - apply INV'_heap_ignore_pred. auto. + - apply heap_ignore_pred_empty. +Qed. + Lemma Invariant_heap_ignore : ∀ L L₀ L₁, fsubset L (L₀ :|: L₁) → @@ -167,6 +254,45 @@ Qed. eapply Invariant_heap_ignore : (* typeclass_instances *) ssprove_invariant. +(* TODO: naming? This doesn't seem to correspond to heap_ignore, due to the missing negation, but I use it that way *) +Definition pheap_ignore (P : Location -> Prop) : precond := + λ '(h₀, h₁), + forall (ℓ : Location), P ℓ -> get_heap h₀ ℓ = get_heap h₁ ℓ. + +Lemma pheap_ignore_empty : + ∀ P, + pheap_ignore P (empty_heap, empty_heap). +Proof. intros P ℓ hℓ. reflexivity. Qed. + +Lemma pINV'_pheap_ignore (P : Location -> Prop) : + ∀ P0 P1 : Location -> Prop, + (forall ℓ : Location, ~ P0 ℓ /\ ~ P1 ℓ -> P ℓ) -> + pINV' P0 P1 (pheap_ignore P). +Proof. + intros P0 P1 hP h0 h1. split. + - intros hh l nin1 nin2. + eapply hh. + apply hP. + eauto. + - intros h ℓ v nin0 nin1 ℓ' n. + destruct (ℓ' != ℓ) eqn:e. + + rewrite get_set_heap_neq. 2: auto. + rewrite get_set_heap_neq. 2: auto. + apply h. auto. + + move: e => /eqP e. subst. + rewrite !get_set_heap_eq. reflexivity. +Qed. + +Lemma pInvariant_pheap_ignore : + ∀ P0 P1 (P : Location -> Prop), + (forall ℓ : Location, ~ P0 ℓ /\ ~ P1 ℓ -> P ℓ) -> + pInvariant P0 P1 (pheap_ignore P). +Proof. + intros L P h. split. + - apply pINV'_pheap_ignore. auto. + - apply pheap_ignore_empty. +Qed. + (* Not-really-symmetric (in use) conjunction of invariants *) Definition inv_conj (inv inv' : precond) := λ s, inv s ∧ inv' s. @@ -908,12 +1034,7 @@ Proof. all: intro h. all: inversion h. all: contradiction. Qed. -(*Canonical heap_val_eqMixin := EqMixin heap_val_eqP. -Canonical heap_val_eqType := - Eval hnf in EqType heap_val heap_val_eqMixin. *) -Definition heap_val_hasDecEq := hasDecEq.Build heap_val heap_val_eqP. -HB.instance Definition _ := heap_val_hasDecEq. - +HB.instance Definition _ := hasDecEq.Build heap_val heap_val_eqP. Derive NoConfusion for heap_val. diff --git a/theories/Crypt/package/pkg_notation.v b/theories/Crypt/package/pkg_notation.v index 0770d90a..38f161b9 100644 --- a/theories/Crypt/package/pkg_notation.v +++ b/theories/Crypt/package/pkg_notation.v @@ -121,8 +121,10 @@ Module PackageNotation. *) Notation " 'nat " := (chNat) (in custom pack_type at level 2). + Notation " 'int " := (chInt) (in custom pack_type at level 2). Notation " 'bool " := (chBool) (in custom pack_type at level 2). Notation " 'unit " := (chUnit) (in custom pack_type at level 2). + Notation " 'word n " := (chWord n) (in custom pack_type at level 2). Notation " 'option x " := (chOption x) (in custom pack_type at level 2). Notation " 'fin n " := @@ -134,13 +136,16 @@ Module PackageNotation. (in custom pack_type at level 2, format "{map x → y }"). Notation " x × y " := (chProd x y) (in custom pack_type at level 2). + Notation " x ∐ y " := (chSum x y) (in custom pack_type at level 2). Notation "( x )" := x (in custom pack_type, x at level 2). (** Repeat the above notations here for package_scope. *) Notation " 'nat " := (chNat) (at level 2) : package_scope. + Notation " 'int " := (chInt) (at level 2) : package_scope. Notation " 'bool " := (chBool) (at level 2) : package_scope. Notation " 'unit " := (chUnit) (at level 2) : package_scope. + Notation " 'word n " := (chWord n) (at level 2) : package_scope. Notation " 'option x " := (chOption x) (at level 2) : package_scope. Notation " 'fin x " := @@ -153,6 +158,7 @@ Module PackageNotation. (at level 80, format "{map x → y }") : package_scope. *) Notation " x × y " := (chProd x y) (at level 80) : package_scope. + Notation " x ∐ y " := (chSum x y) (at level 80) : package_scope. Notation "[ 'interface' ]" := (fset [::]) diff --git a/theories/Crypt/package/pkg_rhl.v b/theories/Crypt/package/pkg_rhl.v index 24cbfda4..c1de74b3 100644 --- a/theories/Crypt/package/pkg_rhl.v +++ b/theories/Crypt/package/pkg_rhl.v @@ -4,7 +4,6 @@ basic crypto-style reasoning notions. *) - From Coq Require Import Utf8. From SSProve.Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples. @@ -166,9 +165,7 @@ Proof. match goal with | |- realsum.summable ?f => eassert (f = _) as Hf end. { extensionality x. - instantiate (1 := fun x1 => (f1 x1 == f3 x1)%:R * (f2 x1 == f4 x1)%:R). - simpl. - exact: (destruct_pair_eq (a:= f1 x) (b:=f3 x) (c:= f2 x) (d := f4 x)). } + exact (destruct_pair_eq (a:= f1 x) (b:=f3 x) (c:= f2 x) (d := f4 x)). } rewrite Hf. apply realsum.summableM. all: assumption. Qed. @@ -415,6 +412,105 @@ Proof. * cbn. intros s₀' s₁' [? ?]. subst. auto. Qed. +(* TODO: generalize, this proof is the same as for eq_upto_inv_perf_ind*) +Lemma eq_upto_pinv_perf_ind : + ∀ {P0 P1 L₀ L₁ LA E} (p₀ p₁ : raw_package) (I : precond) (A : raw_package) + `{ValidPackage L₀ Game_import E p₀} + `{ValidPackage L₁ Game_import E p₁} + `{ValidPackage LA E A_export A}, + pINV' P0 P1 I → + I (empty_heap, empty_heap) → + pdisjoint LA P0 → + pdisjoint LA P1 → + eq_up_to_inv E I p₀ p₁ → + AdvantageE p₀ p₁ A = 0. +Proof. + intros P0 P1 L₀ L₁ LA E p₀ p₁ I A vp₀ vp₁ vA hI' hIe hd₀ hd₁ hp. + unfold AdvantageE, Pr. + pose r := get_op_default A RUN tt. + assert (hI : INV LA I). 1: eapply pINV'_to_INV; eauto. + unshelve epose proof (eq_up_to_inv_adversary_link p₀ p₁ I r hI hp) as h. + 1:{ + eapply valid_get_op_default. + - eauto. + - auto_in_fset. + } + assert ( + ∀ x y : tgt RUN * heap_choiceType, + (let '(b₀, s₀) := x in λ '(b₁, s₁), b₀ = b₁ ∧ I (s₀, s₁)) y → + (fst x == true) ↔ (fst y == true) + ) as Ha. + { intros [b₀ s₀] [b₁ s₁]. simpl. + intros [e ?]. rewrite e. intuition auto. + } + unfold Pr_op. + unshelve epose (rhs := thetaFstd _ (repr (code_link r p₀)) empty_heap). + simpl in rhs. + epose (lhs := Pr_op (A ∘ p₀) RUN tt empty_heap). + assert (lhs = rhs) as he. + { subst lhs rhs. + unfold Pr_op. unfold Pr_code. + unfold thetaFstd. simpl. apply f_equal2. 2: reflexivity. + apply f_equal. apply f_equal. + rewrite get_op_default_link. reflexivity. + } + unfold lhs in he. unfold Pr_op in he. + rewrite he. + unshelve epose (rhs' := thetaFstd _ (repr (code_link r p₁)) empty_heap). + simpl in rhs'. + epose (lhs' := Pr_op (A ∘ p₁) RUN tt empty_heap). + assert (lhs' = rhs') as e'. + { subst lhs' rhs'. + unfold Pr_op. unfold Pr_code. + unfold thetaFstd. simpl. apply f_equal2. 2: reflexivity. + apply f_equal. apply f_equal. + rewrite get_op_default_link. reflexivity. + } + unfold lhs' in e'. unfold Pr_op in e'. + rewrite e'. + unfold rhs', rhs. + unfold SDistr_bind. unfold SDistr_unit. + rewrite !dletE. + assert ( + ∀ x : bool_choiceType * heap_choiceType, + ((let '(b, _) := x in dunit (R:=R) (T:=bool_choiceType) b) true) == + (x.1 == true)%:R + ) as h1. + { intros [b s]. + simpl. rewrite dunit1E. apply/eqP. reflexivity. + } + assert ( + ∀ y, + (λ x : prod_choiceType (tgt RUN) heap_choiceType, (y x) * (let '(b, _) := x in dunit (R:=R) (T:=tgt RUN) b) true) = + (λ x : prod_choiceType (tgt RUN) heap_choiceType, (x.1 == true)%:R * (y x)) + ) as Hrew. + + { intros y. extensionality x. + destruct x as [x1 x2]. + rewrite dunit1E. + simpl. rewrite GRing.mulrC. reflexivity. + } + rewrite !Hrew. + unfold TransformingLaxMorph.rlmm_from_lmla_obligation_1. simpl. + unfold SubDistr.SDistr_obligation_2. simpl. + unfold OrderEnrichedRelativeAdjunctionsExamples.ToTheS_obligation_1. + rewrite !SDistr_rightneutral. simpl. + pose proof (Pr_eq_empty _ _ _ _ h hIe Ha) as Heq. + simpl in Heq. + unfold θ_dens in Heq. + simpl in Heq. unfold pr in Heq. + simpl in Heq. + rewrite Heq. + rewrite /StateTransfThetaDens.unaryStateBeta'_obligation_1. + assert (∀ (x : R), `|x - x| = 0) as Hzero. + { intros x. + assert (x - x = 0) as H3. + { apply /eqP. rewrite GRing.subr_eq0. intuition. } + rewrite H3. apply normr0. + } + apply Hzero. +Qed. + Lemma eq_upto_inv_perf_ind : ∀ {L₀ L₁ LA E} (p₀ p₁ : raw_package) (I : precond) (A : raw_package) `{ValidPackage L₀ Game_import E p₀} @@ -522,6 +618,29 @@ Proof. apply Hzero. Qed. +(* TODO: move? to pkg_advantage *) +Definition padv_equiv P₀ P₁ {L₀ L₁ E} (G₀ G₁ : raw_package) + `{ValidPackage L₀ Game_import E G₀} `{ValidPackage L₁ Game_import E G₁} ε := + ∀ LA A, + ValidPackage LA E A_export A → + pdisjoint LA P₀ → + pdisjoint LA P₁ → + AdvantageE G₀ G₁ A = ε A. + +Lemma eq_rel_perf_ind' : + ∀ {P0 P1 L₀ L₁ E} (p₀ p₁ : raw_package) (inv : precond) + `{ValidPackage L₀ Game_import E p₀} + `{ValidPackage L₁ Game_import E p₁}, + pInvariant P0 P1 inv → + eq_up_to_inv E inv p₀ p₁ → + padv_equiv P0 P1 p₀ p₁ (λ _ : raw_package, 0%R). + (* p₀ ≈₀ p₁. *) +Proof. + intros P0 P1 L₀ L₁ E p₀ p₁ inv v₀ v₁ [? ?] he. + intros LA A vA hd₀ hd₁. + eapply eq_upto_pinv_perf_ind. all: eauto. +Qed. + Lemma eq_rel_perf_ind : ∀ {L₀ L₁ E} (p₀ p₁ : raw_package) (inv : precond) `{ValidPackage L₀ Game_import E p₀} @@ -865,6 +984,29 @@ Proof. eapply swap_ruleL. all: eauto. Qed. +Lemma rswap_helper : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : raw_code A₀) (c₁ : raw_code A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr c₀;; + a2 ∈ choice_incl A₁ <<- repr c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr c₀) (λ a : A₀, repr (a₁ ← c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + Theorem rswap_ruleR : ∀ {A₀ A₁ B : ord_choiceType} {post : postcond B B} (c₀ : raw_code A₀) (c₁ : raw_code A₁) (r : A₀ → A₁ → raw_code B), @@ -1058,6 +1200,134 @@ Proof. cbn. reflexivity. Qed. +(* Simpler semantics for deterministic programs *) + +Inductive deterministic {A : choiceType} : raw_code A → Type := +| deterministic_ret : + ∀ x, deterministic (ret x) +| deterministic_get : + ∀ ℓ k, (∀ x, deterministic (k x)) → deterministic (getr ℓ k) +| deterministic_put : + ∀ ℓ v k, deterministic k → deterministic (putr ℓ v k). + +Fixpoint det_run {A : choiceType} c [h : @deterministic A c] s : A * heap := + match h with + | deterministic_ret x => (x, s) + | deterministic_get ℓ k hk => det_run (k (get_heap s ℓ)) (h := hk _) s + | deterministic_put ℓ v k hk => det_run k (h := hk) (set_heap s ℓ v) + end. + +Lemma det_run_sem : + ∀ {A : choiceType} (c : raw_code A) (hd : deterministic c) s, + θ_dens (θ0 (repr c) s) = dunit (det_run c (h := hd) s). +Proof. + intros A c hd s. + induction hd as [x | ℓ k hk ihk | ℓ v k hk ihk] in s |- *. + - reflexivity. + - simpl. rewrite <- ihk. reflexivity. + - simpl. rewrite <- ihk. reflexivity. +Qed. + +Definition det_jdg {A B : choiceType} (pre : precond) (post : postcond A B) + (p : raw_code A) (q : raw_code B) hp hq := + ∀ (s₀ s₁ : heap), + pre (s₀, s₁) → + post (det_run p (h := hp) s₀) (det_run q (h := hq) s₁). + +Lemma det_to_sem : + ∀ {A₀ A₁ : ord_choiceType} pre post (c₀ : raw_code A₀) (c₁ : raw_code A₁) + (hd₀ : deterministic c₀) + (hd₁ : deterministic c₁), + det_jdg pre post c₀ c₁ hd₀ hd₁ → + ⊢ ⦃ pre ⦄ c₀ ≈ c₁ ⦃ post ⦄. +Proof. + intros A₀ A₁ pre post c₀ c₁ dc₀ dc₁ h. + eapply from_sem_jdg. intros [s₀ s₁]. hnf. intro P. hnf. + intros [hpre hpost]. simpl. + unfold SDistr_carrier. unfold F_choice_prod_obj. simpl. + + unfold det_jdg in h. specialize (h s₀ s₁ hpre). + set (u := det_run c₀ _) in *. + set (v := det_run c₁ _) in *. + + eexists (dunit (u, v)). + split. + - unfold coupling. split. + + unfold lmg. unfold dfst. + apply distr_ext. intro. + rewrite dlet_unit. simpl. + rewrite - det_run_sem. reflexivity. + + unfold rmg. unfold dsnd. + apply distr_ext. intro. + rewrite dlet_unit. simpl. + rewrite - det_run_sem. reflexivity. + - intros [] [] hh. + eapply hpost. + rewrite dunit1E in hh. + lazymatch type of hh with + | context [ ?x == ?y ] => + destruct (x == y) eqn:e + end. + 2:{ + rewrite e in hh. simpl in hh. + rewrite order.Order.POrderTheory.ltxx in hh. discriminate. + } + move: e => /eqP e. inversion e. + subst. assumption. +Qed. + +Lemma sem_to_det : + ∀ {A₀ A₁ : ord_choiceType} pre post (c₀ : raw_code A₀) (c₁ : raw_code A₁) + (hd₀ : deterministic c₀) + (hd₁ : deterministic c₁), + ⊢ ⦃ pre ⦄ c₀ ≈ c₁ ⦃ post ⦄ → + det_jdg pre post c₀ c₁ hd₀ hd₁. +Proof. + intros A₀ A₁ pre post c₀ c₁ hd₀ hd₁ h. + intros s₀ s₁ hpre. + eapply to_sem_jdg in h. specialize (h (s₀, s₁)). hnf in h. simpl in h. + specialize (h (λ '(v₀, s₀', (v₁, s₁')), post (v₀, s₀') (v₁, s₁'))). + destruct h as [c [hc h]]. + - split. 1: assumption. + intros [] []. tauto. + - set (u := det_run c₀ _) in *. + set (v := det_run c₁ _) in *. + specialize (h u v). + assert (hc' : coupling c (dunit u) (dunit v)). + { rewrite - !det_run_sem. exact hc. } + destruct u, v. + apply h. + apply coupling_SDistr_unit_F_choice_prod in hc'. subst. + unfold SDistr_unit. rewrite dunit1E. rewrite eq_refl. simpl. + apply ltr0n. +Qed. + +(* Similar to r_transL but relaxed for deterministic programs and for + stateless conditions. +*) +Lemma r_transL_val : + ∀ {A₀ A₁ : ord_choiceType} {P Q} + (c₀ c₀' : raw_code A₀) (c₁ : raw_code A₁), + deterministic c₀' → + deterministic c₀ → + deterministic c₁ → + ⊢ ⦃ λ '(_, _), P ⦄ c₀ ≈ c₀' ⦃ λ '(v₀, _) '(v₁, _), v₀ = v₁ ⦄ → + ⊢ ⦃ λ '(_, _), P ⦄ c₀ ≈ c₁ ⦃ λ '(v₀, _) '(v₁, _), Q v₀ v₁ ⦄ → + ⊢ ⦃ λ '(_, _), P ⦄ c₀' ≈ c₁ ⦃ λ '(v₀, _) '(v₁, _), Q v₀ v₁ ⦄. +Proof. + intros A₀ A₁ P Q c₀ c₀' c₁ hd₀' hd₀ hd₁ he h. + unshelve eapply det_to_sem. 1,2: assumption. + unshelve eapply sem_to_det in he. 1,2: assumption. + unshelve eapply sem_to_det in h. 1,2: assumption. + intros s₀ s₁ hP. + specialize (h s₀ s₁ hP). specialize (he s₀ s₀ hP). + destruct (det_run c₀ _). + destruct (det_run c₀' _). + destruct (det_run c₁ _). + subst. + assumption. +Qed. + (* Rules using commands instead of bind *) Theorem rsame_head_cmd : @@ -1711,6 +1981,30 @@ Proof. eapply restore_update_mem. all: eauto. Qed. +Lemma rswap_cmd_helper : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : command A₀) (c₁ : command A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr_cmd c₀;; + a2 ∈ choice_incl A₁ <<- repr_cmd c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr_cmd c₀) (λ a : A₀, repr (a₁ ← cmd c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr_cmd c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← cmd c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_cmd_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + + Lemma rswap_cmd : ∀ (A₀ A₁ B : choiceType) (post : postcond B B) (c₀ : command A₀) (c₁ : command A₁) @@ -1762,6 +2056,53 @@ Proof. - auto. Qed. + +Lemma rswap_helper_cmd : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : command A₀) (c₁ : raw_code A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr_cmd c₀;; + a2 ∈ choice_incl A₁ <<- repr c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr_cmd c₀) (λ a : A₀, repr (a₁ ← c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + +Lemma rswap_repr_cmd_helper : + forall {A₀ A₁ B : ord_choiceType} + (c₀ : raw_code A₀) (c₁ : command A₁) (r : A₀ → A₁ → raw_code B), + ((a1 ∈ choice_incl A₀ <<- repr c₀;; + a2 ∈ choice_incl A₁ <<- repr_cmd c₁;; (λ (a₀ : A₀) (a₁ : A₁), repr (r a₀ a₁)) a1 a2) = + bindrFree (repr c₀) (λ a : A₀, repr (a₁ ← cmd c₁ ;; r a a₁))). +Proof. + intros. + unfold RulesStateProb.bindF. + simpl. + unfold FreeProbProg.rFree_obligation_2. + + assert ((λ a1 : A₀, bindrFree (repr_cmd c₁) (λ a2 : A₁, repr (r a1 a2))) = (λ a : A₀, repr (a₁ ← cmd c₁ ;; + r a a₁))). + { extensionality a. + rewrite repr_cmd_bind. + simpl. + reflexivity. + } + rewrite H. + reflexivity. +Qed. + Lemma rswap_cmd_bind_eq : ∀ {A₀ A₁ B : choiceType} c₀ c₁ (r : A₀ → A₁ → raw_code B), ⊢ ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄ @@ -1775,8 +2116,10 @@ Lemma rswap_cmd_bind_eq : Proof. intros A₀ A₁ B c₀ c₁ r h. eapply from_sem_jdg. simpl. - setoid_rewrite repr_cmd_bind. setoid_rewrite repr_bind. - simpl. setoid_rewrite repr_cmd_bind. + setoid_rewrite repr_cmd_bind. rewrite repr_bind. + rewrite <- rswap_helper_cmd. + rewrite <- rswap_repr_cmd_helper. + simpl. eapply (swap_ruleR (λ a₀ a₁, repr (r a₀ a₁)) (repr_cmd c₀) (repr c₁)). - intros a₀ a₁. eapply to_sem_jdg. apply rsym_pre. 1: auto. @@ -1786,8 +2129,10 @@ Proof. + exact: (λ '(h₀, h₁), h₀ = h₁). + eapply to_sem_jdg in h. setoid_rewrite repr_cmd_bind in h. simpl in h. + rewrite <- rswap_helper_cmd in h. setoid_rewrite repr_bind in h. simpl in h. - setoid_rewrite repr_cmd_bind in h. simpl in h. + rewrite <- rswap_repr_cmd_helper in h. + simpl in h. auto. + reflexivity. Qed. @@ -1817,7 +2162,18 @@ Proof. rewrite bind_assoc in h. rewrite bind_cmd_bind in h. setoid_rewrite bind_cmd_bind in h. - setoid_rewrite bind_assoc in h. + simpl in h. + replace + (x ← cmd _ ;; + pat ← (a₀ ← c₀ ;; + ret (a₀, x)) ;; + (let '(x0, y) := pat in ret (y, x0))) + with + (x ← cmd c₁ ;; + a₀ ← c₀ ;; + pat ← ret (a₀, x) ;; + (let '(x0, y) := pat in ret (y, x0))) in h by (f_equal ; extensionality x ; now rewrite bind_assoc). + (* setoid_rewrite bind_assoc in h. *) simpl in h. apply rsymmetry. apply rsym_pre. 1: auto. eapply rpost_weaken_rule. 1: eauto. diff --git a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v index 9a70f023..f3abe89f 100644 --- a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v +++ b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v @@ -41,7 +41,7 @@ Section Prod_of_choiceTypes. Obj ord_choiceType. Proof. rewrite /prod_cat /=. move => [C1 C2]. - exact (prod_choiceType C1 C2). + exact (C1 * C2)%type. Defined. Definition F_choice_prod_morph : forall T1 T2 : (prod_cat ord_choiceType ord_choiceType), @@ -76,4 +76,3 @@ Section Prod_of_choiceTypes. End Prod_of_choiceTypes. - diff --git a/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v b/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v index 5255eaaa..2bbe7cf7 100644 --- a/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v +++ b/theories/Crypt/rhl_semantics/more_categories/LaxFunctorsAndTransf.v @@ -315,7 +315,3 @@ Section FromStrict2LaxTransf. Qed. End FromStrict2LaxTransf. - - - - diff --git a/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v b/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v index 9a49b6d5..232cccc4 100644 --- a/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v +++ b/theories/Crypt/rhl_semantics/more_categories/LaxMorphismOfRelAdjunctions.v @@ -69,5 +69,3 @@ Section LaxMorphismLeftRelativeAdjunctions. ((natIso_sym phi2)⟨A,lmlad_KD Y⟩)∙1 (lmlad_beta Y ∙ ofmap lmlad_KC ( (phi1 ⟨A,Y⟩) ∙1 f ) ∙ lmlad_baseIso A) ∙ lmlad_alpha A }. End LaxMorphismLeftRelativeAdjunctions. - - diff --git a/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v b/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v index 7176d1ee..771f791d 100644 --- a/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v +++ b/theories/Crypt/rhl_semantics/more_categories/TransformingLaxMorph.v @@ -603,6 +603,3 @@ chi A End TransformedLaxMorphAdj. - - - diff --git a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v index e6ad222a..4f6628e3 100644 --- a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v +++ b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v @@ -265,7 +265,7 @@ End SemanticNotation. Import SemanticNotation. #[local] Open Scope semantic_scope. -Definition flip (r : R) : SDistr (bool_choiceType). +Definition flip (r : R) : SDistr (bool). rewrite /SDistr_carrier. apply mkdistrd. intros b. destruct b. @@ -353,4 +353,3 @@ Qed. (* move => π Hwm. *) (* rewrite /SubDistr.SDistr_obligation_2. *) (* Admitted. *) - diff --git a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v index 22b223b5..5e6ed765 100644 --- a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v +++ b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v @@ -216,7 +216,7 @@ Section UnaryInterpretState. fun s : S => retrFree_filled (F_choice_prod_obj ⟨ S, S ⟩) (s, s). Definition putStP : S -> stT_Frp unit_choiceType := fun new_s old_s => - retrFree_filled (F_choice_prod ⟨ unit_choiceType, S ⟩) (tt, new_s). + retrFree_filled (F_choice_prod ⟨unit_choiceType, S⟩) (tt, new_s). Definition probopStP {T : choice_type} (sd: SDistr T) : stT_Frp (chElement T). @@ -330,4 +330,3 @@ Section MakeTheDomainFree. *) End MakeTheDomainFree. - diff --git a/theories/Crypt/rules/RulesProb.v b/theories/Crypt/rules/RulesProb.v index cd65ec9f..40b45b0e 100644 --- a/theories/Crypt/rules/RulesProb.v +++ b/theories/Crypt/rules/RulesProb.v @@ -151,7 +151,7 @@ End RulesNotation. Import RulesNotation. Open Scope Rules_scope. -Definition flip (r : R) : SDistr (bool_choiceType). +Definition flip (r : R) : SDistr (bool). rewrite /SDistr_carrier. apply mkdistrd. intros b. destruct b. @@ -517,8 +517,8 @@ Fixpoint for_loop {A : choiceType} (c : A -> MFreePr A) (n : nat) (a : A) := end. (* Rem.: this is a bounded version of the iteration operator found in monads with iteration *) -Fixpoint bounded_iter {A B : choiceType} (n : nat) (c : A -> MFreePr (sum_choiceType A B)) (a : A) : - MFreePr (sum_choiceType unit_choiceType B) := +Fixpoint bounded_iter {A B : choiceType} (n : nat) (c : A -> MFreePr (A + B)%type) (a : A) : + MFreePr (unit_choiceType + B)%type := match n with | 0 => ord_relmon_unit MFreePr _ (inl Datatypes.tt) | S m => (ord_relmon_bind MFreePr) (fun v => match v with @@ -527,16 +527,16 @@ Fixpoint bounded_iter {A B : choiceType} (n : nat) (c : A -> MFreePr (sum_choice end) (c a) end. -Definition bounded_loop {A B : choiceType} (n : nat) (b : A -> MFreePr bool_choiceType) (c : A -> MFreePr A) (a : A) : - MFreePr (sum_choiceType unit_choiceType A) := +Definition bounded_loop {A B : choiceType} (n : nat) (b : A -> MFreePr bool) (c : A -> MFreePr A) (a : A) : + MFreePr (unit_choiceType + A)%type := bounded_iter n (fun a' => ord_relmon_bind MFreePr (fun b => match b with | true => ord_relmon_bind MFreePr (fun a2 => ord_relmon_unit MFreePr _ (inr a2)) (c a') | false => ord_relmon_unit MFreePr _ (inl a') end) (b a')) a. (* Rem.: this a variant following what's in The next 700... *) -Fixpoint bounded_do_while (n : nat) (c : MFreePr bool_choiceType) : - MFreePr bool_choiceType := +Fixpoint bounded_do_while (n : nat) (c : MFreePr bool) : + MFreePr bool := (* false means fuel emptied, true means execution finished *) match n with | 0 => ord_relmon_unit MFreePr _ false @@ -652,23 +652,23 @@ Proof. move: H. move/idP. intuition. by rewrite H !GRing.mulr0. (* summable B*) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ( (Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(_, y) := x in B y))%:R * d x) = (fun '(x, y) => (B y)%:R * d (x, y))) as Heq1. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable A *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY))%type => (nat_of_bool (let '(x, _) := x in A x))%:R * d x) = (fun '(x, y) => (A x)%:R * d (x, y))) as Heq2. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq2. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => A x) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. Qed. @@ -757,33 +757,33 @@ Proof. exfalso. by apply: true_false_False. auto. (* summable B *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(_, y) := x in B y))%:R * d x) = (fun '(x, y) => (B y)%:R * d (x, y))) as Heq1. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable B *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(_, y) := x in B y))%:R * d x) = (fun '(x, y) => (B y)%:R * d (x, y))) as Heq1. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable A *) - assert ((fun x : (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) => + assert ((fun x : ((Choice.Pack chX) * (Choice.Pack chY)) => (nat_of_bool (let '(x, _) := x in A x))%:R * d x) = (fun '(x, y) => (A x)%:R * d (x, y))) as Heq2. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq2. - pose (@summable_pr R (prod_choiceType (Choice.Pack chX) (Choice.Pack chY)) + pose (@summable_pr R ((Choice.Pack chX) * (Choice.Pack chY))%type (fun '(x, y) => A x) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. Qed. @@ -988,4 +988,3 @@ Qed. End DerivedRules. - diff --git a/theories/Crypt/rules/RulesStateProb.v b/theories/Crypt/rules/RulesStateProb.v index ff247dd4..4139ca7f 100644 --- a/theories/Crypt/rules/RulesStateProb.v +++ b/theories/Crypt/rules/RulesStateProb.v @@ -551,8 +551,8 @@ Qed. (* TODO: asymmetric variants of if_rule: if_ruleL and if_ruleR *) -Fixpoint bounded_do_while {S : choiceType} (n : nat) (c : FrStP S bool_choiceType) : - FrStP S bool_choiceType := +Fixpoint bounded_do_while {S : choiceType} (n : nat) (c : FrStP S bool) : + FrStP S bool := (* false means fuel emptied, true means execution finished *) match n with | 0 => retF false @@ -565,8 +565,8 @@ Fixpoint bounded_do_while {S : choiceType} (n : nat) (c : FrStP S bool_choiceTy Theorem bounded_do_while_rule {A1 A2 : ord_choiceType} {S1 S2 : choiceType} {n : nat} - (c1 : FrStP S1 bool_choiceType) - (c2 : FrStP S2 bool_choiceType) + (c1 : FrStP S1 bool) + (c2 : FrStP S2 bool) {inv : bool -> bool -> (S1 * S2) -> Prop} {H : ⊨ ⦃ inv true true ⦄ c1 ≈ c2 ⦃ fun bs1 bs2 => (inv bs1.1 bs2.1) (bs1.2, bs2.2) /\ bs1.1 = bs2.1 ⦄ } : ⊨ ⦃ inv true true ⦄ @@ -668,8 +668,7 @@ Proof. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq1. - pose (@summable_pr R (prod_choiceType (prod_choiceType X S1) - (prod_choiceType Y S2)) + pose (@summable_pr R ((X * S1) * (Y * S2))%type (fun '(x, y) => B y) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. (* summable A *) @@ -679,8 +678,7 @@ Proof. { extensionality k. destruct k as [k1 k2]. case (B k2). reflexivity. reflexivity. } rewrite -Heq2. - pose (@summable_pr R (prod_choiceType (prod_choiceType X S1) - (prod_choiceType Y S2)) + pose (@summable_pr R ((X * S1) *(Y * S2))%type (fun '(x, y) => A x) d). simpl in *. unfold nat_of_bool in s. rewrite /nat_of_bool. exact s. Qed. @@ -694,7 +692,7 @@ Proof. move => s1 s2 psi_s1_s2. apply distr_ext => /= w. assert (\P_[ θ_dens (θ0 K1 s1) ] (pred1 w) = \P_[ θ_dens (θ0 K2 s2) ] (pred1 w)). - { apply: (Pr_eq ψ eq); rewrite //= => x y Heq. by subst. } + { apply: (Pr_eq ψ eq); rewrite //= => x y Heq. by subst. } by repeat rewrite -pr_pred1 in H0. Qed. @@ -786,7 +784,7 @@ Proof. clear Hpsum. eapply neq0_psum in Hpsum'. destruct Hpsum'. apply aux_domain in H. - destruct (eqType_lem _ ((x,x) == (a1,a2)) true) as [Houi | Hnon]. + destruct (eqType_lem _ ((x,x) == (a1,a2)) true) as [Houi | Hnon]. move: Houi => /eqP Houi. move: Houi => [H1 H2]. rewrite -H1 -H2. reflexivity. have Hnon' : (x,x) == (a1,a2) = false. destruct ((x,x) == (a1,a2)). contradiction. reflexivity. @@ -1131,6 +1129,7 @@ Proof. apply Hcomm. - rewrite (@smMonEqu2 A1 A2 B S r c1 c2). move=> s. + pose some_commutativity. unshelve erewrite <- some_commutativity. exact post. reflexivity. apply HR. diff --git a/theories/Crypt/rules/UniformDistrLemmas.v b/theories/Crypt/rules/UniformDistrLemmas.v index e3ff5ea2..8e750021 100644 --- a/theories/Crypt/rules/UniformDistrLemmas.v +++ b/theories/Crypt/rules/UniformDistrLemmas.v @@ -161,7 +161,7 @@ Qed. (* TODO RENAME *) Lemma sum_prod_bij {T : finType} {f : T -> T} - (π : (prod_finType T T) -> R) + (π : ( prod_finType T T : finType) -> R) (π_geq0 : forall t, 0 <= π t) : \sum_(jj <- enum (prod_finType T T)) (if f jj.1 == jj.2 then π jj else 0) = \sum_(j <- enum T) (π (j, f j)). @@ -297,7 +297,7 @@ Proof. Qed. Lemma support_sub_diag_mgs { A : choiceType } - ( d : SDistr (prod_choiceType A A) ) + ( d : SDistr (A * A)%type ) (Hsupp : forall a1 a2, 0 < d (a1, a2) -> a1 = a2) : forall a : A, lmg d a = d (a, a) /\ rmg d a = d (a, a). Proof. @@ -371,7 +371,7 @@ Section prod_uniform. @psum_pair _ X Y (fun (x12 : prod_finType X Y) => let (x1,x2) := x12 in - SDistr_unit (prod_choiceType X Y) (x1,x2) (x,y)) + SDistr_unit (X * Y)%type (x1,x2) (x,y)) ). rewrite -hlp. - unshelve erewrite eq_psum. @@ -394,5 +394,3 @@ Section prod_uniform. Qed. End prod_uniform. - - diff --git a/theories/Crypt/rules/UniformStateProb.v b/theories/Crypt/rules/UniformStateProb.v index 6b204d83..86565a43 100644 --- a/theories/Crypt/rules/UniformStateProb.v +++ b/theories/Crypt/rules/UniformStateProb.v @@ -222,12 +222,12 @@ Proof. rewrite ler_pM2l. * rewrite ler_int. auto. * unfold r. apply mulr_gt0. - -- cbn. rewrite ltr01. reflexivity. + -- cbn. exact ltr01. -- rewrite -(@pmulr_rgt0 _ #|F1|%:~R). ++ rewrite -(GRing.mul1r (#|F1|%:~R / #|F1|%:~R)). rewrite GRing.mulrA. rewrite GRing.Theory.mulfK. - ** rewrite ltr01. reflexivity. + ** exact ltr01. ** unshelve eapply card_non_zero. auto. ++ eapply fintype0 in w0 as h. destruct #|F1| eqn:e. 1: contradiction. diff --git a/theories/Jasmin/examples/add1.cprog b/theories/Jasmin/examples/add1.cprog new file mode 100644 index 00000000..0bc34613 --- /dev/null +++ b/theories/Jasmin/examples/add1.cprog @@ -0,0 +1,81 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = arg.141}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (4, 0); + loc_end = (4, 9); loc_bchar = 52; loc_echar = 61}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (4, 0); + loc_end = (4, 1); loc_bchar = 52; loc_echar = 53}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = arg.141}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (4, 5); + loc_end = (4, 8); loc_bchar = 57; loc_echar = 60}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (5, 0); + loc_end = (5, 7); loc_bchar = 62; loc_echar = 69}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (5, 0); + loc_end = (5, 1); loc_bchar = 62; loc_echar = 63}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; + loc_start = (5, 0); loc_end = (5, 1); loc_bchar = 62; + loc_echar = 63}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.142}; + v_info = + {Jasmin.Location.loc_fname = "add1.jazz"; loc_start = (6, 7); + loc_end = (6, 8); loc_bchar = 77; loc_echar = 78}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/add1.jazz b/theories/Jasmin/examples/add1.jazz new file mode 100644 index 00000000..7086214c --- /dev/null +++ b/theories/Jasmin/examples/add1.jazz @@ -0,0 +1,7 @@ +export +fn add1(reg u64 arg) -> reg u64 { +reg u64 z; +z = arg; +z += 1; +return z; +} diff --git a/theories/Jasmin/examples/add1.v b/theories/Jasmin/examples/add1.v new file mode 100644 index 00000000..2ebd1c24 --- /dev/null +++ b/theories/Jasmin/examples/add1.v @@ -0,0 +1,79 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + +Section Test. +Context `{AsmOp : asmOp}. + +From Coq Require Import PrimInt63. + +Import FunName. +Definition f : funname. +Proof. + unfold funname. + Transparent t. + exact 1%uint63. + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add1 *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "arg.139" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "arg.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "z.140" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD1 := ( xH ). diff --git a/theories/Jasmin/examples/aes.jazz b/theories/Jasmin/examples/aes.jazz new file mode 100644 index 00000000..08cf1c30 --- /dev/null +++ b/theories/Jasmin/examples/aes.jazz @@ -0,0 +1,20 @@ +from AES require "aes.jinc" + +/* We typically pack all functions that may be used + by other jasmin programs in jinc files. + Then we create jazz files just for entry-point + specific code */ + +export +fn aes_jazz(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + out = aes(key,in); + return out; +} + +export +fn invaes_jazz(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + out = invaes(key,in); + return out; +} diff --git a/theories/Jasmin/examples/aes.jinc b/theories/Jasmin/examples/aes.jinc new file mode 100644 index 00000000..30e8742c --- /dev/null +++ b/theories/Jasmin/examples/aes.jinc @@ -0,0 +1,124 @@ +/* Jasmin implementation of AES using AES-NI */ +/* This can be reused without change wherever + AES-NI is needed to compute vanilla AES or + its inverse */ + +inline fn RCON (inline int i) -> inline int { + inline int c; + c = (i == 1) ? 1 : + ((i == 2) ? 2 : + ((i == 3) ? 4 : + ((i == 4) ? 8 : + ((i == 5) ? 16 : + ((i == 6) ? 32 : + ((i == 7) ? 64 : + ((i == 8) ? 128 : + ((i == 9) ? 27 : + /* i == 10 */ 54)))))))); + return c; +} + +inline fn key_combine(reg u128 rkey, reg u128 temp1, reg u128 temp2) + -> reg u128, reg u128 { + temp1 = #VPSHUFD(temp1, (4u2)[3,3,3,3]); + temp2 = #VSHUFPS(temp2, rkey, (4u2)[0,1,0,0]); + rkey ^= temp2; + temp2 = #VSHUFPS(temp2, rkey, (4u2)[2,0,3,0]); + rkey ^= temp2; + rkey ^= temp1; + return rkey, temp2; +} + +inline fn key_expand(inline int rcon, reg u128 rkey, reg u128 temp2) + -> reg u128, reg u128 { + reg u128 temp1; + temp1 = #VAESKEYGENASSIST(rkey, rcon); + rkey, temp2 = key_combine(rkey, temp1, temp2); + return rkey, temp2; +} + +inline fn keys_expand(reg u128 key) -> reg u128[11] { + reg u128[11] rkeys; + reg u128 temp2; + inline int round, rcon; + rkeys[0] = key; + temp2 = #set0_128(); + for round = 1 to 11 { + rcon = RCON(round); + (key, temp2) = key_expand(rcon, key, temp2); + rkeys[round] = key; + } + return rkeys; +} + +inline fn keys_expand_inv(reg u128 key) -> reg u128[11] { + reg u128[11] rkeys; + reg u128 temp2; + inline int round, rcon; + rkeys[0] = key; + temp2 = #set0_128(); + for round = 1 to 11 { + rcon = RCON(round); + (key, temp2) = key_expand(rcon, key, temp2); + if (round != 10) { + rkeys[round] = #AESIMC(key); + } else { + rkeys[round] = key; + } + } + return rkeys; +} + +inline fn aes_rounds (reg u128[11] rkeys, reg u128 in) -> reg u128 { + reg u128 state; + inline int round; + state = in; + state ^= rkeys[0]; + for round = 1 to 10 { + state = #AESENC(state, rkeys[round]); + } + state = #AESENCLAST(state, rkeys[10]); + return state; +} + +inline fn AddRoundKey(reg u128 state, stack u128 rk) -> reg u128 { + state = state ^ rk; + return state; +} + +inline fn invaes_rounds (reg u128[11] rkeys, reg u128 in) -> reg u128 { + reg u128 state; + inline int round; + stack u128 rk; + state = in; + rk = rkeys[10]; + state = AddRoundKey(state,rk); + for round = 9 downto 0 { + state = #AESDEC(state, rkeys[round]); + } + state = #AESDECLAST(state, rkeys[0]); + return state; +} + +/* Functions typically called from other Jasmin programs. + Note they always compute key expansion, and this may + not be a good in terms of performance. */ +inline +fn aes(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + reg u128[11] rkeys; + + rkeys = keys_expand(key); + out = aes_rounds(rkeys, in); + return out; +} + +inline +fn invaes(reg u128 key, reg u128 in) -> reg u128 { + reg u128 out; + reg u128[11] rkeys; + + rkeys = keys_expand_inv(key); + out = invaes_rounds(rkeys, in); + return out; +} diff --git a/theories/Jasmin/examples/aes.v b/theories/Jasmin/examples/aes.v new file mode 100644 index 00000000..64e3ed0c --- /dev/null +++ b/theories/Jasmin/examples/aes.v @@ -0,0 +1,1043 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* invaes_jazz *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.278" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.279" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.280" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.279" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.280" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes_jazz *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.281" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.282" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.283" |} + ; v_info := dummy_var_info |}] + (xO (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.281" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.282" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.283" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.284" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.285" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.287" |} + ; v_info := dummy_var_info |}] + (xO (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.284" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.286" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.287" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.285" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.286" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes *) xO (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.288" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.289" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.291" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.288" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.290" |} + ; v_info := dummy_var_info |}] + (xI (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.289" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.290" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes_rounds *) xI (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.293" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.293" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rk.295" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH)))))))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.295" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.296" |} + ; v_info := dummy_var_info |}) + ((DownTo, (Pconst (Z0))), (Pconst (Zpos (xI (xO (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDEC *) (BaseOp (None, AESDEC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.296" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDECLAST *) (BaseOp (None, AESDECLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.294" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* AddRoundKey *) xI (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rk.298" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.297" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes_rounds *) xI (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.300" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.300" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.302" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENC *) (BaseOp (None, AESENC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.302" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENCLAST *) (BaseOp (None, AESENCLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH))))))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.301" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand_inv *) xO (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.305" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.307" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.305" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.307" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.305" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oneq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep + (Oasm (* AESIMC *) (BaseOp (None, AESIMC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.304" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand *) xO (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.309" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.310" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.311" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.312" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.310" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.312" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.309" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.309" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_expand *) xO (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint; (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "rcon.313" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.316" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VAESKEYGENASSIST *) + (BaseOp (None, VAESKEYGENASSIST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.316" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.314" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.315" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_combine *) xO (xO (xI xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VPSHUFD_128 *) (BaseOp (None, (VPSHUFD U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH))); + (Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH)))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Z0)); (Pconst (Zpos (xH))); (Pconst (Z0)); + (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xO xH))); (Pconst (Z0)); + (Pconst (Zpos (xI xH))); (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.317" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.319" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* RCON *) xI (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "c.321" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xO xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH)))) + (Pconst (Zpos (xO (xO xH)))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO xH))))) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xO xH))))) + (Pconst (Zpos (xO (xO (xO (xO xH)))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI xH))))) + (Pconst (Zpos (xO (xO (xO (xO (xO xH))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.320" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.320" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO (xO xH)))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO (xO xH))))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := + sint + ; vname := + "i.320" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst + (Zpos (xI (xO (xO xH)))))) + (Pconst + (Zpos (xI (xI (xO (xI xH)))))) + (Pconst + (Zpos (xO (xI (xI (xO (xI xH)))))))))))))))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "c.321" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation INVAES_JAZZ := ( xH ). +Notation AES_JAZZ := ( xI xH ). +Notation INVAES := ( xO xH ). +Notation AES := ( xO (xO xH) ). +Notation INVAES_ROUNDS := ( xI (xO xH) ). +Notation ADDROUNDKEY := ( xI (xO (xO xH)) ). +Notation AES_ROUNDS := ( xI (xI xH) ). +Notation KEYS_EXPAND_INV := ( xO (xI xH) ). +Notation KEYS_EXPAND := ( xO (xO (xO xH)) ). +Notation KEY_EXPAND := ( xO (xI (xO xH)) ). +Notation KEY_COMBINE := ( xO (xO (xI xH)) ). +Notation RCON := ( xI (xI (xO xH)) ). diff --git a/theories/Jasmin/examples/aes/aes.v b/theories/Jasmin/examples/aes/aes.v new file mode 100644 index 00000000..795a9430 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes.v @@ -0,0 +1,672 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra zify. +From mathcomp Require Import word_ssrZ word. +Set Warnings "notation-overridden,ambiguous-paths". + +From Coq Require Import Utf8 ZArith micromega.Lia List. + +From Jasmin Require Import expr xseq waes word x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_utils jasmin_translate word aes_jazz aes_utils aes_spec. + +From SSProve.Relational Require Import OrderEnrichedCategory. +From SSProve.Crypt Require Import Prelude Package ChoiceAsOrd choice_type. + +From extructures Require Import ord fset fmap. + +Import ListNotations. +Import JasminNotation JasminCodeNotation. +Import PackageNotation. +Import AesNotation. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Local Open Scope Z. + +Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. + +Lemma rcon_E (id0 : p_id) pre (i : Z) : + (pdisj pre id0 fset0) -> + (forall s0 s1, pre (s0, s1) -> (1 <= i < 11)%Z) -> + ⊢ ⦃ fun '(s0, s1) => pre (s0, s1) ⦄ JRCON id0 i + ≈ ret tt + ⦃ fun '(v0, s0) '(v1, s1) => pre (s0, s1) /\ exists (o : (λ i0 : Choice.sort choice_type_choiceType, Choice.sort (chElement i0)) 'int), v0 = [('int ; o)] /\ o = wunsigned (rcon i) ⦄. +Proof. + unfold JRCON. + unfold get_translated_static_fun. + intros Hpdisj H. + simpl_fun. + repeat setjvars. + repeat match goal with + | |- context[(?a =? ?b)%Z] => let E := fresh in destruct (a =? b)%Z eqn:E; [rewrite ?Z.eqb_eq in E; subst|] + | |- _ => simpl; ssprove_contract_put_get_lhs; rewrite !coerce_to_choice_type_K + end. + all: ssprove_code_simpl; rewrite !coerce_to_choice_type_K; eapply r_put_lhs; ssprove_contract_put_get_lhs; eapply r_put_lhs; eapply r_ret. + all: intros; destruct_pre; split_post; [ pdisj_apply Hpdisj | rewrite coerce_to_choice_type_K; eexists; split; eauto ]. + destruct (i =? 10)%Z eqn:E. + - rewrite Z.eqb_eq in E. subst. reflexivity. + - apply H in H13. lia. +Qed. + +Arguments nat_of_wsize : simpl never. +Arguments wsize_size_minus_1 : simpl never. + +Lemma key_expand_aux rcon rkey temp2 rcon_ : + word.toword rcon_ = rcon -> + word.subword 0 U32 temp2 = word.word0 -> + ((rkey ⊕ lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey) + ⊕ lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 3; 0; 2])) U128 (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey) + (rkey ⊕ lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey)) ⊕ wpshufd_128 (wAESKEYGENASSIST rkey (wrepr U8 rcon)) (wunsigned (wpack U8 2 [3; 3; 3; 3])) = + key_expand rkey rcon_. +Proof. + Set Printing Implicit. + intros. + subst. + unfold key_expand. + apply (wcat_eq U32 4). + intros [[ | [ | [ | [ | i]]]] j]; simpl; unfold tnth; simpl. + - rewrite !subword_xor; auto. + rewrite mul0n. + unfold lift2_vec. + rewrite !make_vec_ws. + simpl. + rewrite !subword_u. + simpl. + rewrite !subword_make_vec_32_0_32_128. + unfold wpack. + simpl. + unfold wpshufd1. + simpl. + rewrite !wshr0. + rewrite !subword_make_vec_32_0_32_128. + simpl. + unfold wAESKEYGENASSIST. + rewrite subword_wshr; auto. + rewrite subword_make_vec_32_3_32_128. + simpl. + rewrite !wxorA. + f_equal. + unfold wpshufd1. + simpl. + rewrite wshr0. + rewrite -wxorA. + rewrite wxor_involutive. + rewrite wxor_0_l. + rewrite RotWord_SubWord. + unfold word.wxor. + f_equal. + rewrite wreprI. + reflexivity. + - simpl. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite mul1n. + unfold wpack. + simpl. + rewrite mul0n. + rewrite !subword_u. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_1_32_128. + simpl. + unfold wpshufd1. + simpl. + rewrite !subword_wshr; auto. + rewrite !addn0. + rewrite !subword_make_vec_32_3_32_128. + simpl. + unfold wpshufd1. + rewrite subword_wshr; auto. + simpl. + rewrite addn0. + rewrite !wxorA. + f_equal. + rewrite H0. + rewrite wxor_0_l. + f_equal. + rewrite RotWord_SubWord. + unfold word.wxor. + f_equal. + rewrite wreprI. + reflexivity. + - simpl. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite mul1n. + unfold wpack. + simpl. + rewrite mul0n. + rewrite !subword_u. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_2_32_128. + simpl. + unfold wpshufd1. + simpl. + rewrite !subword_wshr; auto. + rewrite !addn0. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_3_32_128. + simpl. + rewrite !subword_make_vec_32_0_32_128. + unfold wpshufd1. + rewrite subword_wshr; auto. + simpl. + rewrite addn0. + rewrite !wxorA. + f_equal. + rewrite H0. + rewrite wxor_0_l. + f_equal. + f_equal. + rewrite RotWord_SubWord. + unfold word.wxor. + f_equal. + rewrite wreprI. + reflexivity. + - simpl. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite mul1n. + unfold wpack. + simpl. + rewrite mul0n. + rewrite !subword_u. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_3_32_128. + simpl. + unfold wpshufd1. + simpl. + rewrite !subword_wshr; auto. + rewrite !addn0. + rewrite !subword_xor; auto. + rewrite !subword_make_vec_32_3_32_128. + simpl. + rewrite !subword_make_vec_32_2_32_128. + unfold wpshufd1. + rewrite subword_wshr; auto. + simpl. + rewrite !wxorA. + f_equal. + rewrite wxorC. + rewrite !wxorA. + f_equal. + rewrite subword_wshr; auto. + rewrite addn0. + f_equal. + rewrite RotWord_SubWord. + rewrite wxorC. + rewrite wxorA. + f_equal. + f_equal. + rewrite wreprI. + reflexivity. + all: auto. + - lia. +Qed. + +Lemma key_expand_aux2 rkey temp2 : + word.subword 0 U32 temp2 = word.word0 -> + word.subword 0 U32 + (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 3; 0; 2])) U128 (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey) + (word.wxor rkey (lift2_vec U128 (wshufps_128 (wpack U8 2 [0; 0; 1; 0])) U128 temp2 rkey))) = word.word0. +Proof. + intros. + unfold lift2_vec. + rewrite !make_vec_ws. + rewrite subword_make_vec_32_0_32_128. simpl. + unfold wpshufd1. simpl. + rewrite subword_wshr; auto. simpl. + rewrite addn0. + rewrite subword_u. + rewrite subword_make_vec_32_0_32_128. simpl. + rewrite subword_u. + unfold wpshufd1. simpl. + rewrite subword_wshr; auto. +Qed. + +Lemma key_expand_E pre id0 rcon rkey temp2 rcon_ : + pdisj pre id0 fset0 → + word.toword rcon_ = rcon → + (forall s0 s1, pre (s0, s1) -> word.subword 0 U32 temp2 = word.word0) → + ⊢ ⦃ λ '(s0, s1), pre (s0, s1) ⦄ + JKEY_EXPAND id0 rcon rkey temp2 + ≈ ret tt + ⦃ λ '(v0, s0) '(v1, s1), + pre (s0, s1) ∧ + ∃ o1 o2, + v0 = [ ('word U128 ; o1) ; ('word U128 ; o2) ] ∧ + o1 = key_expand rkey rcon_ ∧ + word.subword 0 U32 o2 = word.word0 + ⦄. +Proof. + unfold JKEY_EXPAND, get_translated_static_fun. + intros disj Hrcon Htemp2. + simpl_fun. simpl. + repeat setjvars. + repeat clear_get. + unfold sopn_sem, tr_app_sopn_tuple, tr_app_sopn_single. + simpl. + rewrite !zero_extend_u. + rewrite !coerce_to_choice_type_K. + repeat eapply r_put_lhs. + eapply r_ret. + intros s0 s1 Hpre. + destruct_pre; split_post. + - pdisj_apply disj. + - eexists _, _. intuition auto. + + apply key_expand_aux; eauto. + + apply key_expand_aux2; eauto. +Qed. + +Lemma keyExpansion_E pre id0 rkey : + (pdisj pre id0 (fset [rkeys])) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JKEYS_EXPAND id0 rkey + ≈ + keyExpansion rkey + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ exists o, v0 = [( 'array ; o)] /\ to_arr U128 (Zpos 11) o = v1 ⦄. +Proof. + intros disj. + unfold JKEYS_EXPAND, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_call. + Opaque wrange. + Opaque for_loop. + + simpl. simpl_fun. + repeat setjvars. + repeat clear_get. + ssprove_code_simpl. + ssprove_code_simpl_more. + + eapply r_put_lhs. + eapply r_get_remember_lhs. intros v. + eapply r_put_lhs. + eapply r_put_lhs. + + unfold keyExpansion. + eapply r_put_rhs. + eapply r_get_remember_rhs. intros v0. + eapply r_put_rhs. + + eapply r_bind. + - simpl. + eapply rpre_weaken_rule. + + eapply translate_for_rule with + (I := fun i => fun '(h0, h1) => pre (h0, h1) + /\ word.subword 0 U32 (get_heap h0 temp2) = word.word0 + /\ (get_heap h0 key = chArray_get U128 (get_heap h0 rkeys) (i - 1) 16) + /\ (forall j, (0 <= j < i) -> (to_arr U128 (Zpos 11) (get_heap h0 rkeys)) j = (get_heap h1 aes_spec.rkeys) j) + /\ (forall j, (j < 0) \/ (11 <= j) -> get_heap h1 aes_spec.rkeys j = None)). + + (* the two following bullets are small assumptions of the translate_for rule *) + * intros. simpl. solve_preceq. + * lia. + (* Inductive step of the for loop rule, we have to prove the bodies are equivalent and imply the successor predicate *) + * intros i s_id Hs_id ile. + ssprove_code_simpl. + + eapply r_get_remember_lhs. intros. + + (* Now we apply the correctnes of rcon *) + eapply r_bind with (m₁ := ret _) (f₁ := fun _ => _). + ** eapply rcon_E with (id0 := (s_id~1)%positive) (i:=x). + (* We have to prove the precond is disjoint from the variables of rcon, i.e. any variables stored locally in rcon does not change the precond *) + *** split. + (* rcon_correct does not use any variables on the rhs *) + 2: { easy. } + intros s0 s1 l a vr s_id' Hl Hs_id' H. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_I. etransitivity. 1: eassumption. etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: eapply preceq_prec_trans. 1: etransitivity. 1: eapply preceq_I. 1: eassumption. 1: eapply prec_I. assumption. + } + intros. destruct_pre. split_post. + { eapply disj; eauto. } + { sheap. assumption. } + { sheap. assumption. } + { sheap. assumption. } + { assumption. } + { rewrite set_heap_commut; auto. + apply injective_translate_var2. assumption. } + { simpl. sheap. reflexivity. } + (* this is an assumption of rcon_correct *) + *** intros; destruct_pre. fold round. sheap. rewrite coerce_to_choice_type_K. lia. + (* we continue after the rcon call *) + ** intros a0 a1. + simpl; ssprove_code_simpl. + (* we need to know the value of a0 here *) + eapply rpre_weak_hypothesis_rule; intros. + destruct_pre; simpl. + fold rcon. + repeat clear_get. + eapply r_put_lhs with (pre := λ '(s0',s1'), _ ). + eapply r_get_remember_lhs. intros x1. + eapply r_get_remember_lhs. intros x2. + sheap. + + eapply r_bind with (m₁ := ret _) (f₁ := fun _ => _). + + (* First we apply correctness of key_expandP *) + *** (* Here the rewrite is necessary. How should correctness be phrased in general such that this is not important? *) + rewrite !coerce_to_choice_type_K. + eapply key_expand_E with (id0 := (s_id~0~1)%positive) (rcon := (wunsigned (aes_spec.rcon i))) (rkey := x1) (temp2 := x2) (rcon_ := aes_spec.rcon i). + (* again, we have to prove that our precond does not depend key_expand locations *) + { split. + (* key_expandP also does not use variables on the rhs *) + 2: { easy. } + intros s0 s1 l a vr s_id' Hl Hs_id' H1. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_I. etransitivity. 1: eassumption. etransitivity. 1: eapply preceq_O. etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: eapply preceq_prec_trans. 1: etransitivity. 1: eapply preceq_I. 1: eassumption. 1: eapply prec_O. etransitivity. 1: eapply prec_I. assumption. + } + destruct_pre. sheap. split_post. + { eapply disj; eauto. } + { sheap; assumption. } + { sheap; assumption. } + { sheap; assumption. } + { assumption. } + { reflexivity. } + { simpl. sheap. reflexivity. } + { eexists. eauto. } + { rewrite set_heap_commut; [ | neq_loc_auto ]. + rewrite [set_heap _ _ a](set_heap_commut); [ | neq_loc_auto ]. + reflexivity. } + { simpl. sheap. reflexivity. } + { simpl. sheap. reflexivity. } + } + (* this is an assumption of key_expandP, true by definition of rcon *) + { reflexivity. } + { intros. destruct_pre. sheap. assumption. } + (* we continue after the call *) + *** intros. + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. simpl. + rewrite !zero_extend_u. + + eapply r_put_lhs with (pre := λ '(s0',s1'), _). + eapply r_put_lhs. + eapply r_get_remember_lhs. intros x2. + eapply r_get_remember_lhs. intros x3. + eapply r_get_remember_lhs. intros x4. + eapply r_put_lhs. + eapply r_get_remember_rhs. intros x5. + eapply r_put_rhs. + eapply r_ret. + + sheap. + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + intros s6 s7 H24. + + destruct_pre. + sheap. + + split_post. + (* here we prove that the invariant is preserved after a single loop, assuming it holds before *) + { pdisj_apply disj. auto_in_fset. } + { assumption. } + { replace (Z.succ i - 1) with i by lia. + rewrite chArray_get_set_eq. + reflexivity. } + { intros j Hj. + destruct (Z.eq_dec i j). + + (* i = j *) + - subst. simpl. + pose proof to_arr_set_eq. + simpl. + rewrite to_arr_set_eq. 2: lia. + rewrite setmE. rewrite eq_refl. + + f_equal. unfold getmd. rewrite -H41. 2: lia. rewrite getm_to_arr. 2: lia. + f_equal. rewrite !get_set_heap_neq in H33. 2-3: neq_loc_auto. rewrite -H33. assumption. + + (* i <> j *) + - rewrite to_arr_set_neq. 2-3: lia. + rewrite setmE. + assert (@eq bool (@eq_op Z_ordType j i) false). 1: apply/eqP; auto. + rewrite H3. + apply H41. lia. } + { intros j Hj. + + rewrite setmE. + (* why do I have to set printing off to realize this? Shouldn't j == i always mean the same on the same type? *) + assert (@eq_op (Ord.eqType Z_ordType) j i = false). 1: apply/eqP; lia. + rewrite H3. + apply H43. + assumption. } + (* the next bullet is the proof that the invariant of the for loop is true at the beginning (this goal is generated by pre_weaken rule and translate_for) *) + + intros s0 s1 H. + destruct_pre. + sheap. + + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + + split_post. + (* prove that pre is preserved *) + * pdisj_apply disj. all: auto_in_fset. + (* first invariant *) + * simpl. unfold tr_app_sopn_tuple. simpl. rewrite subword_word0. reflexivity. + (* second invariant *) + * rewrite chArray_get_set_eq. reflexivity. + (* third invariant *) + * intros j Hj. assert (j = 0) by lia. subst. + rewrite to_arr_set_eq. 1: rewrite setmE; rewrite eq_refl; reflexivity. lia. + * intros. rewrite setmE. + (* Set Printing All. *) + replace (_ == _) with false. + 1: apply emptymE. symmetry. apply/eqP. lia. + (* after for loop *) + - intros a0 a1. + simpl. + eapply r_get_remember_lhs with (pre := fun '(s0, s1) => _). intros x. + eapply r_get_remember_rhs. intros x0. + eapply r_ret. + intros s0 s1 H. + destruct_pre. split_post. + (* prove the final post conditions: pre and that the values of rkeys agree *) + + assumption. + + eexists. split. 1: reflexivity. + eapply eq_fmap. intros j. + simpl. + destruct ((0 <=? j) && (j getm_to_arr_None' by lia. + rewrite H6; auto. + lia. +Qed. + +Lemma aes_rounds_E pre id0 rkeys msg : + (pdisj pre id0 (fset [state])) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JAES_ROUNDS id0 rkeys msg + ≈ + aes_rounds (to_arr U128 (Zpos 11) rkeys) msg + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ exists o, v0 = [ ('word U128 ; o) ] /\ o = v1 ⦄. +Proof. + unfold JAES_ROUNDS, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + intros disj. + + Opaque translate_call. + Opaque wrange. + Opaque for_loop. + + simpl. simpl_fun. + repeat setjvars. + ssprove_code_simpl. + ssprove_code_simpl_more. + unfold aes_rounds. + + repeat clear_get. + do 4 eapply r_put_lhs. + eapply r_put_rhs. + + eapply r_bind. + - eapply translate_for_rule_weaken with + (I := fun i => fun '(h0, h1) => pre (h0, h1) + /\ get_heap h0 state = get_heap h1 aes_spec.state + /\ get_heap h0 rkeys0 = rkeys). + + intros; destruct_pre. + rewrite !zero_extend_u. + rewrite !coerce_to_choice_type_K. + sheap. + split_post. + * pdisj_apply disj. auto_in_fset. + * rewrite getmd_to_arr; auto. lia. + * reflexivity. + + intros. simpl. auto with preceq. + + lia. + + intros. + repeat (eapply r_get_remember_lhs; intros). + eapply r_put_lhs. + eapply r_get_remember_rhs; intros. + eapply r_put_rhs. + eapply r_ret. + intros s0 s1 Hpre; destruct_pre. + unfold tr_app_sopn_tuple. + simpl. + rewrite !zero_extend_u. + rewrite !coerce_to_choice_type_K. + sheap. + split_post. + * pdisj_apply disj. auto_in_fset. + * rewrite -> H12. + rewrite wAESENC_wAESENC_. + rewrite getmd_to_arr; auto. + lia. + * reflexivity. + - intros a0 a. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x. + eapply r_get_remember_lhs. intros x0. + eapply r_put_lhs. + eapply r_get_remember_lhs. intros x1. + + eapply r_get_remember_rhs. intros x2. + eapply r_put_rhs. + eapply r_get_remember_rhs. intros x3. + eapply r_ret. + + intros s0 s1 Hpre; destruct_pre. + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + sheap. + split_post. + + pdisj_apply disj. auto_in_fset. + + unfold tr_app_sopn_tuple. + simpl. + rewrite !zero_extend_u. + rewrite -> H6. + rewrite getmd_to_arr; try lia. + rewrite wAESENCLAST_wAESENCLAST_. + eexists. split. + * reflexivity. + * simpl. + rewrite zero_extend_u. + reflexivity. +Qed. + +Lemma aes_E pre id0 k m : + (pdisj pre id0 (fset Cenc_locs)) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JAES id0 k m + ≈ + Caes k m + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ exists o, v0 = [ ('word U128 ; o )] /\ v1 = o ⦄. +Proof. + unfold JAES, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + intros disj. + + simpl. simpl_fun. + repeat setjvars. + ssprove_code_simpl. + repeat clear_get. + unfold Caes. + + eapply r_put_lhs. + eapply r_put_lhs. + eapply r_bind. + - rewrite !zero_extend_u. + eapply keyExpansion_E. + split. + + intros s0 s1 l a vr s_id' Hl Hs_id' H. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: eapply prec_I. eassumption. + } + destruct_pre. split_post. + * eapply disj; eauto. + * reflexivity. + * rewrite set_heap_commut. 2: neq_loc_auto. rewrite [set_heap (set_heap H2 _ _) _ _]set_heap_commut. 1: reflexivity. + neq_loc_auto. + + intros; destruct_pre; split_post. + * eapply disj. + ** move: H. rewrite !in_fset !in_cons=>/orP [] ;[|easy] => /eqP ->. simpl. apply/orP; auto. + ** eassumption. + * reflexivity. + * reflexivity. + - intros. + eapply rpre_weak_hypothesis_rule. + Opaque aes_rounds. + intros; destruct_pre. + simpl. + rewrite !coerce_to_choice_type_K. + fold rkeys. clear_get. + + eapply r_put_lhs with (pre := fun _ => _). + eapply r_get_remember_lhs. intros. + (* this is a very brute force way of remembering the value of 'in', should be done differently *) + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. sheap. + eapply r_bind. + + eapply aes_rounds_E. + split. + * intros s0 s1 l a vr s_id' Hl Hs_id' H. + assert (id0_preceq : id0 ⪯ s_id'). { + etransitivity. 1: eapply preceq_O. etransitivity. 1: eapply preceq_I. eassumption. + } + assert (id0_neq : id0 <> s_id'). { + apply prec_neq. eapply prec_preceq_trans. 1: etransitivity. 1: eapply prec_O. 1: eapply prec_I. eassumption. + } + destruct_pre. sheap. split_post. + ** eapply disj; eauto. + ** reflexivity. + ** reflexivity. + ** eexists. eauto. + ** rewrite set_heap_commut. + 1: rewrite [set_heap (set_heap _ _ _) _ a]set_heap_commut. + 1: rewrite [set_heap (set_heap _ _ _) _ a]set_heap_commut. + 1: reflexivity. + all: neq_loc_auto. + ** simpl. sheap. reflexivity. + * intros; destruct_pre; split_post. + ** eapply disj. + *** move: H. rewrite [l \in @fset _ [state]]in_fset in_cons =>/orP []. 1: move=> /eqP ->; solve_in. + 1: unfold Cenc_locs; auto_in_fset. + simpl. clear -l. easy. + *** eassumption. + ** reflexivity. + ** reflexivity. + ** eexists. eauto. + ** reflexivity. + ** simpl. sheap. reflexivity. + + intros. + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. + simpl. fold out. clear_get. + eapply r_put_lhs with (pre := fun _ => _). + eapply r_ret. + intros. + destruct_pre; sheap; split_post. + * pdisj_apply disj. + * eexists. + split; [reflexivity|]. + simpl. + rewrite !zero_extend_u. + reflexivity. +Qed. diff --git a/theories/Jasmin/examples/aes/aes_jazz.v b/theories/Jasmin/examples/aes/aes_jazz.v new file mode 100644 index 00000000..9d8d5157 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_jazz.v @@ -0,0 +1,1158 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr sem. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate jasmin_utils. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Import JasminNotation JasminCodeNotation. +Import PackageNotation. +Local Open Scope string. + +Set Bullet Behavior "Strict Subproofs". +(* Set Default Goal Selector "!". *) (* I give up on this for now. *) + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* dec *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "k.297" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "n.298" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "c.299" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "mask.301" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "k.297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "n.298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "p.300" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "mask.301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "c.299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "p.300" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* enc *) xO (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "k.302" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "n.303" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "p.304" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "mask.306" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "k.302" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "n.303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "c.305" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "mask.306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "p.304" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "c.305" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* xor *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "a.307" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "b.308" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "r.309" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "a.307" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "b.308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "r.309" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes *) xI (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.310" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.311" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.313" |} + ; v_info := dummy_var_info |}] + (xI (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.312" |} + ; v_info := dummy_var_info |}] + (xO (xI xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.312" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.314" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.315" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.317" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.314" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "out.316" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.315" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "out.316" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* invaes_rounds *) xO (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.319" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rk.321" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH)))))))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.321" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.322" |} + ; v_info := dummy_var_info |}) + ((DownTo, (Pconst (Z0))), (Pconst (Zpos (xI (xO (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDEC *) (BaseOp (None, AESDEC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.322" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESDECLAST *) (BaseOp (None, AESDECLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.320" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* AddRoundKey *) xO (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rk.324" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rk.324" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.323" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* aes_rounds *) xO (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))); (sword U128)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "in.326" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "in.326" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.328" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENC *) (BaseOp (None, AESENC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.328" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* AESENCLAST *) (BaseOp (None, AESENCLAST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U128 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Zpos (xO (xI (xO xH))))))]) ] + ; f_tyout := [(sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "state.327" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand_inv *) xI (xI xH), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.331" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.333" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.331" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.333" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.331" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oneq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Copn + [Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep + (Oasm (* AESIMC *) (BaseOp (None, AESIMC))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.330" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* keys_expand *) xI (xO (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.335" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.336" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_128 *) (ExtOp (Oset0 U128))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "round.337" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), + (Pconst (Zpos (xI (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := sint + ; vname := "rcon.338" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.337" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.336" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.338" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.336" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U128 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.335" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "round.337" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U128)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "key.334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI (xO xH))))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI (xO xH)))))))) + ; vname := "rkeys.335" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_expand *) xI (xI (xO xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint; (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "rcon.339" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.342" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VAESKEYGENASSIST *) + (BaseOp (None, VAESKEYGENASSIST))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "rcon.339" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.342" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.340" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.341" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* key_combine *) xI (xO (xI xH)), + {| f_info := FunInfo.witness + ; f_tyin := [(sword U128); (sword U128); (sword U128)] + ; f_params := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VPSHUFD_128 *) (BaseOp (None, (VPSHUFD U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH))); + (Pconst (Zpos (xI xH))); (Pconst (Zpos (xI xH)))])]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Z0)); (Pconst (Zpos (xH))); (Pconst (Z0)); + (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* VSHUFPS_128 *) (BaseOp (None, (VSHUFPS U128)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (PappN (Opack U8 PE2) + [(Pconst (Zpos (xO xH))); (Pconst (Z0)); + (Pconst (Zpos (xI xH))); (Pconst (Z0))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U128)) + ((Papp2 (Olxor U128) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U128) + ; vname := "temp1.344" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U128); (sword U128)] + ; f_res := + [{| v_var := {| vtype := (sword U128) + ; vname := "rkey.343" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U128) + ; vname := "temp2.345" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* RCON *) xO (xO (xI xH)), + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "c.347" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xO xH))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH)))) + (Pconst (Zpos (xO (xO xH)))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO xH))))) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xO xH))))) + (Pconst (Zpos (xO (xO (xO (xO xH)))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI xH))))) + (Pconst (Zpos (xO (xO (xO (xO (xO xH))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.346" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO xH)))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := + "i.346" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xO (xO xH)))))) + (Pconst + (Zpos (xO (xO (xO (xO (xO (xO (xO xH))))))))) + (Pif (sint) + (Papp2 (Oeq Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := + sint + ; vname := + "i.346" |} + ; v_info := + dummy_var_info |} ; gs := Slocal |}) + (Pconst + (Zpos (xI (xO (xO xH)))))) + (Pconst + (Zpos (xI (xI (xO (xI xH)))))) + (Pconst + (Zpos (xO (xI (xI (xO (xI xH)))))))))))))))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "c.347" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation DEC := ( xH ). +Notation ENC := ( xO (xO xH) ). +Notation XOR := ( xO xH ). +Notation INVAES := ( xI (xO xH) ). +Notation AES := ( xI xH ). +Notation INVAES_ROUNDS := ( xO (xI xH) ). +Notation ADDROUNDKEY := ( xO (xI (xO xH)) ). +Notation AES_ROUNDS := ( xO (xO (xO xH)) ). +Notation KEYS_EXPAND_INV := ( xI (xI xH) ). +Notation KEYS_EXPAND := ( xI (xO (xO xH)) ). +Notation KEY_EXPAND := ( xI (xI (xO xH)) ). +Notation KEY_COMBINE := ( xI (xO (xI xH)) ). +Notation RCON := ( xO (xO (xI xH)) ). + +Notation trp := (translate_prog' ssprove_jasmin_prog).1. +Notation trc := (fun fn i => translate_call ssprove_jasmin_prog fn trp i). +Notation funlist := [seq f.1 | f <- p_funcs ssprove_jasmin_prog]. + +Definition static_fun fn := (fn, match assoc trp fn with Some c => c | None => fun _ => ret tt end). + +Definition static_funs := [seq static_fun f | f <- funlist]. + +Definition strp := (translate_prog_static ssprove_jasmin_prog static_funs). +Opaque strp. + +Definition call fn i := (get_translated_static_fun ssprove_jasmin_prog fn static_funs i). + +Notation JRCON i j := (call RCON i [('int ; j)]). + +Notation JKEY_COMBINE i rkey temp1 temp2 := (call KEY_COMBINE i [('word U128 ; rkey) ; ('word U128 ; temp1) ; ('word U128 ; temp2)]). +Notation JKEY_EXPAND i rcon rkey temp2 := (call KEY_EXPAND i [ ('int ; rcon) ; ('word U128 ; rkey) ; ('word U128 ; temp2) ]). +Notation JKEYS_EXPAND i rkey := (call KEYS_EXPAND i [('word U128 ; rkey)]). +Notation JKEYS_EXPAND_INV i key := (call KEYS_EXPAND_INV i [('word U128 ; key)]). + +Notation JADDROUNDKEY i state rk := (call KEYS_EXPAND i [('word U128 ; state) ; ('word U128 ; rk)]). + +Notation JAES_ROUNDS i rkeys m := (call AES_ROUNDS i [('array ; rkeys) ; ('word U128 ; m)]). +Notation JINVAES_ROUNDS i rkeys m := (call INVAES_ROUNDS i [('array ; rkeys) ; ('word U128 ; m)]). + +Notation JAES i key m := (call AES i [('word U128 ; key) ; ('word U128 ; m)]). +Notation JINVAES i key m := (call INVAES i [('word U128 ; key) ; ('word U128 ; m)]). + +Notation JXOR i a1 a2 := (call XOR i [('word U128 ; a1) ; ('word U128 ; a2)]). +Notation JENC i n k m := (call ENC i [('word U128 ; n) ; ('word U128 ; k) ; ('word U128 ; m)]). +Notation JDEC i n k m := (call DEC i [('word U128 ; n) ; ('word U128 ; k) ; ('word U128 ; m)]). diff --git a/theories/Jasmin/examples/aes/aes_prf.v b/theories/Jasmin/examples/aes/aes_prf.v new file mode 100644 index 00000000..d21fe632 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_prf.v @@ -0,0 +1,789 @@ +(** PRF Example + + Inspired by "State Separation for Code-Based Game-Playing Proofs" + by Brzuska et al. + + Appendix A. + + "Given a pseudorandom function (PRF) we construct a symmetric encryption + scheme that is indistinguishable under chosen plaintext attacks (IND-CPA)." + +*) +From SSProve.Jasmin Require Import jasmin_translate aes_valid aes_spec aes.aes word aes_utils. + +From SSProve.Relational Require Import OrderEnrichedCategory GenericRulesSimple. + +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + ssrnat ssreflect ssrfun ssrbool ssrnum eqtype choice seq word word_ssrZ. +Set Warnings "notation-overridden,ambiguous-paths". + +From SSProve.Mon Require Import SPropBase. +From SSProve.Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings + UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb + pkg_core_definition choice_type pkg_composition pkg_rhl Package Prelude. + +From Coq Require Import Utf8. +From extructures Require Import ord fset fmap. + +Import SPropNotations. + +Import PackageNotation. + +From Equations Require Import Equations. +Require Equations.Prop.DepElim. + +Set Equations With UIP. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. + +Import Num.Def. +Import Num.Theory. +Import Order.POrderTheory. + +From Jasmin Require Import word. + +Section PRF_example. + + Context (n : wsize). + + Notation key := 'word n. + Notation pt := 'word n. + Notation ct := 'word n. + + Notation " 'word " := ('word n) (in custom pack_type at level 2). + Notation " 'key " := ('word n) (in custom pack_type at level 2). + + Context (f : key -> pt -> ct). + + Notation N := ((expn 2 n).-1.+1). + + #[export] Instance : Positive N. + Proof. red; by rewrite prednK_modulus expn_gt0. Qed. + + #[export] Instance word_pos (i : wsize.wsize) : Positive i. + Proof. by case i. Qed. + + #[local] Open Scope package_scope. + + Definition key_location : Location := ('option key ; 0). + + Definition i0 : nat := 3. + Definition i1 : nat := 4. + + Definition table_location : Location := + (chMap 'nat ('word n) ; 7). + + Definition enc (m : pt) (k : key) : + code fset0 [interface] ('fin N × 'word n) := + {code + r ← sample uniform N ;; + let pad := f (word_of_ord r) k in + let c := m ⊕ pad in + ret (r, c) + }. + + Definition kgen : code (fset [:: key_location]) [interface] 'word n := + {code + k ← get key_location ;; + match k with + | None => + k_val ← sample uniform N ;; + #put key_location := Some (word_of_ord k_val) ;; + ret (word_of_ord k_val) + | Some k_val => + ret k_val + end + }. + + Definition EVAL_location_tt := (fset [:: key_location]). + Definition EVAL_location_ff := (fset [:: table_location]). + + Definition EVAL_pkg_tt : + package EVAL_location_tt [interface] + [interface #val #[i0] : 'word → 'key ] := + [package + #def #[i0] (r : 'word) : 'key + { + k_val ← kgen ;; + ret (f r k_val) + } + ]. + + Definition EVAL_pkg_ff : + package EVAL_location_ff [interface] + [interface #val #[i0] : 'word → 'key ] := + [package + #def #[i0] (r : 'word) : 'key + { + T ← get table_location ;; + match getm T (ord_of_word r) with + | None => + T_key ← sample uniform N ;; + #put table_location := (setm T (ord_of_word r) (word_of_ord T_key)) ;; + ret (word_of_ord T_key) + | Some T_key => ret T_key + end + } + ]. + + Definition EVAL : loc_GamePair [interface #val #[i0] : 'word → 'key ] := + λ b, if b then {locpackage EVAL_pkg_tt } else {locpackage EVAL_pkg_ff }. + + Definition MOD_CPA_location : {fset Location} := fset0. + + Definition MOD_CPA_tt_pkg : + package MOD_CPA_location + [interface #val #[i0] : 'word → 'key ] + [interface #val #[i1] : 'word → ('fin N) × 'word ] := + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + #import {sig #[i0] : 'word → 'key } as eval ;; + r ← sample uniform N ;; + pad ← eval (word_of_ord r) ;; + let c := m ⊕ pad in + ret (r, c) + } + ]. + + Definition MOD_CPA_ff_pkg : + package MOD_CPA_location + [interface #val #[i0] : 'word → 'key] + [interface #val #[i1] : 'word → ('fin N) × 'word ]:= + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + #import {sig #[i0] : 'word → 'key } as eval ;; + r ← sample uniform N ;; + m' ← sample uniform N ;; + pad ← eval (word_of_ord r) ;; + let c := (word_of_ord m' ⊕ pad) in + ret (r, c) + } + ]. + + Definition IND_CPA_location : {fset Location} := fset [:: key_location]. + + Program Definition IND_CPA_pkg_tt : + package IND_CPA_location + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word ] := + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + enc m k_val + } + ]. + (* why is this not inferred? *) + Next Obligation. + repeat constructor. red. + intros []. + rewrite in_fset in_cons. move=>/orP []. 2: easy. move=>/eqP H. noconf H. simpl. + eexists. + split. + 1: reflexivity. + intros. repeat constructor. + 1: auto_in_fset. destruct v. + 1: intros; repeat constructor. + 1: intros; repeat constructor. + auto_in_fset. + Defined. + + Program Definition IND_CPA_pkg_ff : + package IND_CPA_location + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word ] := + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + m' ← sample uniform N ;; + enc (word_of_ord m') k_val + } + ]. + (* TODO: infer this *) + Next Obligation. + repeat constructor. red. + intros []. + rewrite in_fset in_cons. move=>/orP []. 2: easy. move=>/eqP H. noconf H. simpl. + eexists. + split. + 1: reflexivity. + intros. repeat constructor. + 1: auto_in_fset. destruct v. + 1: intros; repeat constructor. + 1: intros; repeat constructor. + auto_in_fset. + Defined. + + Program Definition IND_CPA : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_tt } else {locpackage IND_CPA_pkg_ff }. + + Local Open Scope ring_scope. + + Definition prf_epsilon A := Advantage EVAL A. + + Definition statistical_gap := + AdvantageE (MOD_CPA_ff_pkg ∘ EVAL false) (MOD_CPA_tt_pkg ∘ EVAL false). + + Lemma IND_CPA_equiv_false : + IND_CPA false ≈₀ MOD_CPA_ff_pkg ∘ (EVAL true). + Proof. + (* We go to the relation logic using equality as invariant. *) + eapply eq_rel_perf_ind_eq. + simplify_eq_rel m. + simplify_linking. + (* We now conduct the proof in relational logic. *) + ssprove_swap_rhs 1%N. + ssprove_swap_rhs 0%N. + ssprove_sync_eq. cbn -[expn]. intros [k|]. + - cbn -[expn]. ssprove_swap_rhs 0%N. + eapply rpost_weaken_rule. + 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + - cbn -[expn]. + ssprove_swap_rhs 0%N. + ssprove_swap_rhs 1%N. + ssprove_swap_rhs 0%N. + ssprove_swap_rhs 2%N. + ssprove_swap_rhs 1%N. + eapply rpost_weaken_rule. 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + Qed. + + Lemma IND_CPA_equiv_true : + MOD_CPA_tt_pkg ∘ (EVAL true) ≈₀ IND_CPA true. + Proof. + (* We go to the relation logic using equality as invariant. *) + eapply eq_rel_perf_ind_eq. + simplify_eq_rel m. + simplify_linking. + (* We now conduct the proof in relational logic. *) + ssprove_swap_lhs 0%N. + ssprove_sync_eq. cbn -[expn]. intros [k|]. + - cbn -[expn]. eapply rpost_weaken_rule. 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + - cbn -[expn]. + ssprove_swap_rhs 1%N. + ssprove_swap_rhs 0%N. + eapply rpost_weaken_rule. 1: eapply rreflexivity_rule. + cbn. intros [? ?] [? ?] e. inversion e. intuition auto. + Qed. + + (** Security of PRF + + The bound is given by using the triangle inequality several times, + using the following chain of computational indistinguishabilities: + IND_CPA false ≈ MOD_CPA_ff_pkg ∘ EVAL true + ≈ MOD_CPA_ff_pkg ∘ EVAL false + ≈ MOD_CPA_tt_pkg ∘ EVAL false + ≈ MOD_CPA_tt_pkg ∘ EVAL true + ≈ IND_CPA true + + *) + Theorem security_based_on_prf : + ∀ LA A, + ValidPackage LA + [interface #val #[i1] : 'word → ('fin N) × 'word ] A_export A → + fdisjoint LA (IND_CPA false).(locs) → + fdisjoint LA (IND_CPA true).(locs) → + Advantage IND_CPA A <= + prf_epsilon (A ∘ MOD_CPA_ff_pkg) + + statistical_gap A + + prf_epsilon (A ∘ MOD_CPA_tt_pkg). + Proof. + intros LA A vA hd₀ hd₁. unfold prf_epsilon, statistical_gap. + rewrite !Advantage_E. + ssprove triangle (IND_CPA false) [:: + MOD_CPA_ff_pkg ∘ EVAL true ; + MOD_CPA_ff_pkg ∘ EVAL false ; + MOD_CPA_tt_pkg ∘ EVAL false ; + MOD_CPA_tt_pkg ∘ EVAL true + ] (IND_CPA true) A + as ineq. + eapply le_trans. 1: exact ineq. + clear ineq. + erewrite IND_CPA_equiv_false. all: eauto. + 2:{ simpl. unfold MOD_CPA_location. rewrite fset0U. auto. } + erewrite IND_CPA_equiv_true. all: eauto. + 2:{ simpl. unfold MOD_CPA_location. rewrite fset0U. auto. } + rewrite GRing.add0r GRing.addr0. + rewrite !Advantage_link. rewrite Advantage_sym. auto. + Qed. +End PRF_example. + +From SSProve.Jasmin Require Import aes.aes aes_jazz jasmin_utils aes_valid. +From Jasmin Require Import expr sem. + +Import JasminNotation JasminCodeNotation. + +(* From Jasmin Require Import expr. *) +Require Import String. +Local Open Scope string. + +Section JasminPRF. + + Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. + + Notation n := U128. + + Definition key := 'word n. + Definition pt := 'word n. + Definition ct := 'word n. + + Notation " 'word " := ('word n) (in custom pack_type at level 2). + Notation " 'key " := ('word n) (in custom pack_type at level 2). + Notation N := ((expn 2 n).-1.+1). + + Notation enc := (enc U128 aes). + Notation kgen := (kgen U128). + Notation key_location := (key_location U128). + + Definition Cenc (m : pt) (k : key) : + code (fset [:: state ; rkeys]) [interface] (('fin N) × 'word n). + Proof. + refine + {code + r ← sample uniform N ;; + pad ← Caes (word_of_ord r) k ;; + ret (r, (m ⊕ pad)) + }. + repeat constructor. + all: auto_in_fset. + Defined. + + Opaque wrange. + Opaque expn. + + Definition IND_CPA_pkg_Cenc : + package (fset (key_location :: Cenc_locs)) + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word]. + Proof. + refine + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + Cenc m k_val + } + ]. + (* infer this *) + repeat constructor. red. + intros []. + rewrite in_fset in_cons. move=>/orP []. 2: easy. move=>/eqP H. noconf H. simpl. + eexists. + split. + 1: reflexivity. + intros. repeat constructor. + all: auto_in_fset. + intros. destruct v. + 1: repeat constructor; auto_in_fset. + 1: repeat constructor; auto_in_fset. + Defined. + + Notation hdtc128 l := (coerce_to_choice_type ('word U128) (head ( 'word U128 ; word0 ) l).π2). + + Definition IND_CPA_pkg_JENC (id0 : p_id) : + package (fset (key_location :: (JENC_valid id0).π1)) + [interface] + [interface #val #[i1] : 'word → ('fin N) × 'word ]. + Proof. + refine + [package + #def #[i1] (m : 'word) : ('fin N) × 'word + { + k_val ← kgen ;; + r ← sample uniform N ;; + res ← JENC id0 (word_of_ord r) k_val m ;; + ret (r, hdtc128 res) + } + ]. + repeat constructor. + intros []. + rewrite in_fset in_cons => /orP []; [|easy]; move=> /eqP H; noconf H. + cbv zeta match. + eexists. + split. + 1: reflexivity. + intros x. + constructor. + 1: auto_in_fset. + intros. destruct v. + - constructor. intros. + eapply valid_bind. + + red. eapply valid_code_cons. + 1: eapply (JENC_valid id0).π2. + + constructor. + - constructor. + intros. + constructor. + 1: auto_in_fset. + constructor. intros. + eapply valid_bind. + + red. eapply valid_code_cons. + 1: eapply (JENC_valid id0).π2. + + constructor. + Unshelve. all: exact _. + Defined. + + (* Notation KG_pkg := (KG_pkg U128). *) + Notation IND_CPA_pkg_ff := (IND_CPA_pkg_ff U128 aes). + Notation IND_CPA_pkg_tt := (IND_CPA_pkg_tt U128 aes). + Notation MOD_CPA_ff_pkg := (MOD_CPA_ff_pkg U128). + Notation MOD_CPA_tt_pkg := (MOD_CPA_tt_pkg U128). + Notation IND_CPA := (IND_CPA U128 aes). + Notation EVAL := (EVAL U128 aes). + + Lemma fsubset_ext2 : ∀ [T : ordType] (s1 s2 : {fset T}), fsubset s1 s2 -> (forall x, x \in s1 -> x \in s2). + Proof. + intros. + rewrite -fsub1set. + eapply fsubset_trans. 2: eassumption. + rewrite fsub1set. assumption. + Qed. + + Lemma fsubset_cons : ∀ [T : ordType] a (s1 s2 : {fset T}), fsubset s1 s2 -> fsubset s1 (a |: s2). + Proof. + intros. + apply fsubset_ext. + intros. rewrite in_fset in_cons. + apply/orP. right. + eapply fsubset_ext2. + 1: eassumption. + assumption. + Qed. + + Definition IND_CPA_Cenc : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_Cenc } else (IND_CPA true). + + Definition IND_CPA_JENC id0 : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_JENC id0} else {locpackage IND_CPA_pkg_Cenc}. + + (* TODO: move *) + Lemma JXOR_E pre id0 x y : + (pdisj pre id0 fset0) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + JXOR id0 x y + ≈ + ret (chCanonical chUnit) + ⦃ fun '(v0, h0) '(v1, h1) => pre (h0, h1) /\ (exists o, (v0 = cons ('word U128 ; o ) nil ) /\ (o = x ⊕ y)) ⦄. + Proof. + unfold JXOR, get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + intros disj. + simpl. simpl_fun. + repeat setjvars. + ssprove_code_simpl. + repeat clear_get. + repeat eapply r_put_lhs. + eapply r_ret. + rewrite !zero_extend_u. + intros. destruct_pre; split_post. + 1: pdisj_apply disj. + eexists; split; [reflexivity|]. reflexivity. + Qed. + + (* TODO: move *) + Arguments pheap_ignore : simpl never. + + Lemma translate_var_option {A} s_id v i : ( 'option A ; i ) != translate_var s_id v. + Proof. + unfold translate_var. + apply/eqP => contra. + apply EqdepFacts.eq_sigT_fst in contra. + destruct v. + destruct vtype0; simpl in contra; noconf contra. + Qed. + + (* NOTE: the next 5 lemmas are not used, but might useful. Move *) + Lemma nat_of_stype_bound s : 5 <= nat_of_stype s. + Proof. + destruct s. 1-2: simpl; try micromega.Lia.lia. + - simpl. pose proof Pos2Nat.is_succ p as []. rewrite H. + pose proof Nat.pow_le_mono_r 11 1 (x.+1) ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). simpl in *. micromega.Lia.lia. + - cbn [nat_of_stype]. + assert (0 < nat_of_wsize w). 1: destruct w; unfold nat_of_wsize; simpl; try micromega.Lia.lia. + pose proof Nat.pow_le_mono_r 13 1 w ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). simpl in *. micromega.Lia.lia. + Qed. + + Lemma nat_of_p_id_ident_bound s_id v : 2 <= nat_of_p_id_ident s_id v. + Proof. + unfold nat_of_p_id_ident. + pose proof nat_of_p_id_pos s_id. + pose proof nat_of_ident_pos v. + pose proof Nat.pow_le_mono_r 3 1 (nat_of_p_id s_id) ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). + pose proof Nat.pow_le_mono_r 2 1 (nat_of_ident v) ltac:(micromega.Lia.lia) ltac:(micromega.Lia.lia). + simpl in *; micromega.Lia.lia. + Qed. + + Lemma nat_of_p_id_var_bound s_id v : 10 <= nat_of_p_id_var s_id v. + Proof. + unfold nat_of_p_id_var. + pose proof nat_of_stype_bound (vtype v). + pose proof nat_of_p_id_ident_bound s_id (vname v). + micromega.Lia.nia. + Qed. + + Lemma translate_var_bound {A} s_id v i : i < 10 -> ( A ; i ) != translate_var s_id v. + Proof. + intros. + apply/eqP => contra. + inversion contra. + pose proof nat_of_p_id_var_bound s_id v. + micromega.Lia.lia. + Qed. + + Lemma IND_CPA_JENC_equiv_false id0 : + padv_equiv (fun l => exists s_id v, id0 ⪯ s_id /\ l = translate_var s_id v) (fun l => l \in fset Cenc_locs) (IND_CPA_JENC id0 true) (IND_CPA_JENC id0 false) (λ _ : raw_package, 0%R). + Proof. + eapply eq_rel_perf_ind'. + (* invariant *) + { eapply pInvariant_pheap_ignore with + (P := fun l => (forall s_id v, id0 ⪯ s_id -> l != translate_var s_id v) /\ l \notin fset Cenc_locs). + { intros. + split. + - intros. apply/eqP. intros contra. + destruct H. apply H. + exists s_id, v. split; auto. + - apply/negP; easy. } } + unfold eq_up_to_inv, get_op_default, lookup_op, IND_CPA_JENC, IND_CPA_pkg_JENC. + Opaque Caes. + Opaque translate_call. + Opaque wrange. + Opaque expn. + simpl. + simplify_eq_rel m. + simplify_linking. + rewrite !cast_fun_K. + ssprove_sync. + { intros h0 h1 hpre. apply hpre. split. + - intros. apply translate_var_option. + - unfold Cenc_locs. rewrite in_fset in_cons; auto. } + intros. + eapply r_bind with (mid := fun '(a₀, s₀) '(a₁, s₁) => pheap_ignore (λ l : ∑ _ : choice_type, nat, (∀ (s_id : p_id) (v : var), id0 ⪯ s_id → l != translate_var s_id v) /\ l \notin fset Cenc_locs) (s₀, s₁) /\ a₀ = a₁). + { destruct a. + - eapply r_ret. easy. + - ssprove_sync. intros. + ssprove_sync. + { intros h0 h1 Hh l H. + destruct (l == key_location) eqn:E. + - move: E => /eqP heq. subst. rewrite !get_set_heap_eq. reflexivity. + - move: E => /negP Hneq. rewrite !get_set_heap_neq; auto. 1-2: apply /negP; auto. } + eapply r_ret. easy. } + intros. + (* TODO: find easier way to do next three lines *) + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. + eapply rpre_weaken_rule with (pre:= fun '(s₀, s₁) => pheap_ignore (λ l : ∑ _ : choice_type, nat, (∀ (s_id : p_id) (v : var), id0 ⪯ s_id → l != translate_var s_id v) /\ l \notin fset Cenc_locs) (s₀, s₁)); try easy. + ssprove_code_simpl. + simpl. + ssprove_sync. intros. + rewrite !zero_extend_u. + repeat clear_get. + do 3 eapply r_put_lhs. + eapply r_bind. + - eapply aes_E; split. + + intros. + destruct_pre. + do 2 eexists. + 1: do 2 eexists. + 1: do 2 eexists. + 1: instantiate (1 := set_heap H7 (translate_var s_id' v) a1). + all: try reflexivity. + { intros l lnin. rewrite get_set_heap_neq. 1: eapply H8; auto. + apply lnin. + etransitivity. + 2: eassumption. + solve_preceq. } + { repeat rewrite [set_heap _ _ a1]set_heap_commut; auto. + 1-3: apply injective_translate_var2; apply prec_neq; eapply prec_preceq_trans; try eassumption; apply prec_I. } + + intros. + destruct_pre. + do 2 eexists. + 1: do 2 eexists. + 1: do 2 eexists. + 1: instantiate (1 := H6). + all: try reflexivity. + intros l2 lnin. + rewrite get_set_heap_neq. + 1: eapply H7. 1: assumption. + unfold Cenc_locs in lnin. + destruct lnin. apply /eqP => contra; subst. + rewrite H in H2. easy. + - simpl. intros. + eapply rpre_weak_hypothesis_rule; intros. + destruct_pre. + simpl. + clear_get. + eapply r_put_lhs with (pre := fun _ => _). + eapply r_get_remember_lhs. intros. + eapply r_bind with (m₁ := ret (chCanonical chUnit)) (f₁ := fun _ => _). + 1: eapply JXOR_E; split. + + intros. + destruct_pre. + 1: do 1 eexists. + 1: do 2 eexists. + 1: do 7 eexists. + 1: instantiate (1:= (set_heap H14 (translate_var s_id' v) a1)). + all: try reflexivity. + { intros l hl. rewrite get_set_heap_neq. 1: eapply H15. 1: assumption. apply hl. + etransitivity. 2: eauto. + solve_preceq. } + { repeat rewrite [set_heap _ _ a1]set_heap_commut; auto. + 1-4: apply injective_translate_var2; apply prec_neq; eapply prec_preceq_trans; try eassumption; solve_prec. } + { sheap. simpl. rewrite get_set_heap_neq. 1: sheap. 1: reflexivity. + apply injective_translate_var2; apply prec_neq; eapply prec_preceq_trans; try eassumption; solve_prec. } + + intros. easy. + + intros. + eapply rpre_weak_hypothesis_rule; intros. + destruct_pre; simpl. + clear_get. + eapply r_put_lhs with (pre := fun _ => _). + eapply r_ret. + rewrite !coerce_to_choice_type_K. + rewrite !zero_extend_u. + intros. + destruct_pre; simpl; split_post. + { sheap. by rewrite wxorC. } + { intros l s_id. + rewrite !get_set_heap_neq. + 1: eapply H19; auto. + 1-5: apply s_id; reflexivity. } + Qed. + + Lemma IND_CPA_jazz_equiv_false : + (IND_CPA_Cenc) true ≈₀ (IND_CPA_Cenc) false. + Proof. + eapply eq_rel_perf_ind_ignore with (L := fset Cenc_locs). + { eapply fsubsetU. apply/orP; left. simpl. + rewrite [fset (key_location :: _)]fset_cons. + eapply fsubset_cons. + eapply fsubsetxx. } + unfold eq_up_to_inv. + Opaque Caes. + Opaque wrange. + Opaque expn. + simplify_eq_rel m. + ssprove_sync. intros. + eapply r_bind with (mid := fun '(a0, s0) '(a1, s1) => a0 = a1 /\ heap_ignore (fset Cenc_locs) (s0, s1)). + { destruct a. + - eapply r_ret. easy. + - ssprove_sync. intros. + ssprove_sync. + eapply r_ret. easy. } + intros. simpl. + (* TODO: find easier way to do next three lines *) + eapply rpre_weak_hypothesis_rule. + intros; destruct_pre. + eapply rpre_weaken_rule with (pre:= fun '(s₀, s₁) => heap_ignore (fset Cenc_locs) (s₀, s₁)); try easy. + ssprove_sync. intros. + eapply r_bind with (m₁ := ret (chCanonical chUnit)) (f₁ := fun _ => _). + - 1: eapply aes_h. + intros h1 h2 l a2 lin h. + intros l2 lnin. + unfold Cenc_locs in *. + rewrite get_set_heap_neq. + 1: apply h; auto. + apply/eqP=>contra; subst. + move: lnin => /negP. easy. + - intros. eapply r_ret. + intros. destruct_pre; split_post; auto. + Qed. + + Definition JIND_CPA id0 : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_JENC id0 } else (IND_CPA true). + + Theorem jasmin_security_based_on_prf id0 : + ∀ LA A, + ValidPackage LA + [interface #val #[i1] : 'word → ('fin N) × 'word ] A_export A → + pdisjoint LA (λ l : Location, ∃ (s_id : p_id) (v : var), id0 ⪯ s_id ∧ l = translate_var s_id v) -> + pdisjoint LA (λ l : Location, l \in fset Cenc_locs) -> + fdisjoint LA (IND_CPA_Cenc false).(locs) → + fdisjoint LA (IND_CPA_Cenc true).(locs) → + Advantage (JIND_CPA id0) A = 0%R. + Proof. + intros LA A vA hd₀ hd₁ hd2 hd3. + rewrite !Advantage_E. + eapply AdvantageE_le_0. + ssprove triangle (JIND_CPA id0 false) [:: + IND_CPA_pkg_Cenc : raw_package + ] (JIND_CPA id0 true) A + as ineq. + eapply Order.POrderTheory.le_trans. + 1: exact ineq. + clear ineq. + rewrite Advantage_sym. + erewrite IND_CPA_jazz_equiv_false. all: eauto. + rewrite Advantage_sym. + pose proof IND_CPA_JENC_equiv_false id0. + unfold padv_equiv in H. + specialize (H LA A vA hd₀ hd₁). + rewrite H. + rewrite GRing.addr0. + apply Order.POrderTheory.le_refl. + Qed. + + Notation prf_epsilon := (prf_epsilon U128 aes). + Notation statistical_gap := (statistical_gap U128 aes). + + Local Open Scope ring_scope. + + Program Definition JIND_CPA' id0 : + loc_GamePair [interface #val #[i1] : 'word → ('fin N) × 'word ] := + λ b, + if b then {locpackage IND_CPA_pkg_JENC id0 } else (IND_CPA false). + + Theorem jsecurity_based_on_prf (id0 : p_id) : + ∀ LA A, + ValidPackage LA + [interface #val #[i1] : 'word → ('fin N) × 'word ] A_export A → + pdisjoint LA (λ l : Location, ∃ (s_id : p_id) (v : var), id0 ⪯ s_id ∧ l = translate_var s_id v) -> + pdisjoint LA (λ l : Location, l \in fset Cenc_locs) -> + fdisjoint LA (IND_CPA_Cenc false).(locs) → + fdisjoint LA (IND_CPA_Cenc true).(locs) → + Advantage (JIND_CPA' id0) A <= + prf_epsilon (A ∘ MOD_CPA_ff_pkg) + + statistical_gap A + + prf_epsilon (A ∘ MOD_CPA_tt_pkg). + Proof. + intros LA A vA hd₀ hd₁ hd2 hd3. + rewrite !Advantage_E. + ssprove triangle (JIND_CPA' id0 true) [:: + IND_CPA_pkg_Cenc : raw_package ; + IND_CPA true : raw_package + ] (JIND_CPA' id0 false) A + as ineq. + rewrite Advantage_sym. + + eapply Order.POrderTheory.le_trans. 1: eapply ineq. + + erewrite IND_CPA_jazz_equiv_false. all: eauto. + rewrite IND_CPA_JENC_equiv_false. all: eauto. + + rewrite GRing.add0r. + rewrite GRing.add0r. + + unshelve epose proof security_based_on_prf n aes LA A vA hd2 _. + 1: { simpl. simpl in hd2. eauto. } + rewrite Advantage_E in H. + + rewrite Advantage_sym. + eapply H. + Qed. + + Print Assumptions jsecurity_based_on_prf. + +End JasminPRF. diff --git a/theories/Jasmin/examples/aes/aes_spec.v b/theories/Jasmin/examples/aes/aes_spec.v new file mode 100644 index 00000000..b92a8f93 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_spec.v @@ -0,0 +1,244 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra zify. +From mathcomp Require Import word_ssrZ word. +Set Warnings "notation-overridden,ambiguous-paths". + +From Coq Require Import Utf8 ZArith micromega.Lia List. + +From Jasmin Require Import expr xseq waes word. +From SSProve.Jasmin Require Import jasmin_translate word aes_utils. + +From SSProve.Relational Require Import OrderEnrichedCategory. +From SSProve.Crypt Require Import Prelude Package ChoiceAsOrd choice_type. + +From extructures Require Import ord fset fmap. + +Import ListNotations. +Import JasminNotation. +Import PackageNotation. +Import AesNotation. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Local Open Scope Z. + +(** Specs *) + +Definition rcon (i : Z) : u8 := nth (wrepr U8 54%Z) [:: (wrepr U8 1%Z); (wrepr U8 2%Z); (wrepr U8 4%Z); (wrepr U8 8%Z); (wrepr U8 16%Z); (wrepr U8 32%Z); (wrepr U8 64%Z); (wrepr U8 128%Z); (wrepr U8 27%Z); (wrepr U8 54%Z)]%Z ((Z.to_nat i) - 1). + +Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. + +Definition key_expand (wn1 : u128) (rcon : u8) : 'word U128 := + let rcon := zero_extend U32 rcon in + let w0 := subword 0 U32 wn1 in + let w1 := subword (1 * U32) U32 wn1 in + let w2 := subword (2 * U32) U32 wn1 in + let w3 := subword (3 * U32) U32 wn1 in + let tmp := w3 in + let tmp := SubWord (RotWord tmp) ⊕ rcon in + let w4 := w0 ⊕ tmp in + let w5 := w1 ⊕ w4 in + let w6 := w2 ⊕ w5 in + let w7 := w3 ⊕ w6 in + wcat [tuple w4; w5; w6; w7]. + +Definition key_i (k : u128) i := + iteri i (fun i ki => key_expand ki (rcon ((Z_of_nat i) + 1))) k. + +Definition aes (key msg : u128) := + let state := wxor msg (key_i key 0) in + let state := iteri 9 (fun i state => wAESENC_ state (key_i key (i + 1))) state in + wAESENCLAST_ state (key_i key 10). + +Definition invaes (key cipher : u128) := + let state := wxor cipher (key_i key 10) in + let state := iteri 9 (fun i state => wAESDEC_ state (key_i key (10 -(i + 1)))) state in + wAESDECLAST state (key_i key 0). + +Definition rkeys : Location := ( 'arr U128 ; 0%nat ). +Definition state : Location := ( 'word U128 ; 0%nat). +Definition Cenc_locs := [:: state ; rkeys]. + +Definition keyExpansion (key : u128) : raw_code ('arr U128) := + #put rkeys := @emptym (chElement_ordType 'int) u128 ;; + rkeys0 ← get rkeys ;; + #put rkeys := setm rkeys0 0 key ;; + lfor_loop (fun i => + rkeys0 ← get rkeys ;; + #put rkeys := setm rkeys0 i (key_expand (zero_extend _ (getmd rkeys0 word0 (i - 1))) (rcon i)) ;; + ret tt) 1 11 ;; + rkeys0 ← get rkeys ;; + ret rkeys0. + +Definition aes_rounds (rkeys : 'arr U128) (msg : 'word U128) : raw_code u128 := + #put state := wxor msg (getmd rkeys word0 0) ;; + lfor_loop (fun i => + state0 ← get state ;; + #put state := wAESENC_ state0 (getmd rkeys word0 i) ;; + ret tt + ) 1 10 ;; + state0 ← get state ;; + #put state := wAESENCLAST_ state0 (getmd rkeys word0 10) ;; + state0 ← get state ;; + ret state0. + +Definition Caes (key msg : u128) := + rkeys ← keyExpansion key ;; + cipher ← aes_rounds rkeys msg ;; + ret cipher. + +(** Correctness proofs *) + +Lemma keyExpansion_h (pre : precond) k : + u_pdisj pre [fset rkeys] -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + keyExpansion k + ≈ + ret tt + ⦃ fun '(v0, h0) '(_, h1) => pre (h0, h1) /\ forall i, 0 <= i < 11 -> (getmd v0 word0 i) = key_i k (Z.to_nat i) ⦄. +Proof. + intros Hdisj. + unfold keyExpansion. + eapply r_put_lhs with (pre := fun '(_, _) => _). + eapply r_get_remember_lhs. intros x. + eapply r_put_lhs. + eapply r_bind with (m₁ := ret _). + { eapply u_lfor_loop_rule_weaken with + (I:= fun i => fun h0 h1 => pre (h0, h1) /\ forall j, 0 <= j < i -> getmd (get_heap h0 rkeys) word0 j = key_i k (Z.to_nat j)). + { lia. } + - intros h1 h2 Hset. + destruct_pre. + split_post. + + u_pdisj_apply Hdisj. + + intros j Hj. + sheap. + unfold getmd. + rewrite setmE. + assert (@eq_op (Ord.eqType Z_ordType) j Z0) by (apply/eqP; lia). + rewrite H. + move: H=>/eqP ->. + simpl. + reflexivity. + - intros i ile. + ssprove_code_simpl. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x0. + eapply r_put_lhs. + eapply r_ret. + intros s0 s1 Hpre. + destruct_pre. split_post. + + u_pdisj_apply Hdisj. + + intros j Hj. + rewrite get_set_heap_eq. + rewrite -> H6 by lia. + unfold getmd in *. + rewrite setmE. + destruct (Z.eq_dec j i). + * subst. + rewrite eq_refl. + rewrite zero_extend_u. + replace (Z.to_nat i) with (Z.to_nat (i - 1)).+1 by lia. + unfold key_i at 2. + rewrite iteriS. + f_equal. f_equal. simpl. lia. + * assert (@eq_op (Ord.eqType Z_ordType) j i = false). + { apply/eqP. assumption. } + rewrite H1; auto. + rewrite H6; auto. + lia. } + intros s0 s1. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x0. + eapply r_ret. + intros s2 s3 Hpre. + destruct_pre. + split. + - easy. + - apply H2. +Qed. + +Lemma aes_rounds_h rkeys k m pre : + u_pdisj pre [fset state] -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) /\ (forall i, 0 <= i < 11 -> getmd rkeys word0 i = key_i k (Z.to_nat i)) ⦄ + aes_rounds rkeys m + ≈ + ret tt + ⦃ fun '(v0, h0) '(_, h1) => pre (h0, h1) /\ v0 = aes k m ⦄. +Proof. + unfold aes_rounds. + intros Hdisj. + set (st0 := m ⊕ (key_i k 0%nat)). + eapply r_put_lhs with (pre := fun '(_, _) => _). + eapply r_bind with (m₁ := ret _). + { eapply u_lfor_loop_rule_weaken with + (I := fun i => fun h0 h1 => pre (h0, h1) /\ get_heap h0 state = iteri (Z.to_nat i - 1) (fun i state => wAESENC_ state (key_i k (i + 1))) st0 + /\ (forall i, 0 <= i < 11 -> getmd rkeys word0 i = key_i k (Z.to_nat i))). + - lia. + - intros. + simpl. + destruct_pre. sheap. split_post. + + u_pdisj_apply Hdisj. + + rewrite H3; auto. lia. + + assumption. + - intros i Hi. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x. + eapply r_put_lhs. eapply r_ret. + intros s0 s1 Hpre. + destruct_pre; sheap; split_post. + + u_pdisj_apply Hdisj. + + replace (Z.to_nat (Z.succ i) - 1)%nat with ((Z.to_nat i - 1).+1) by lia. + rewrite iteriS. + rewrite H4. + rewrite H7. 2: lia. repeat f_equal. lia. + + assumption. } + intros a0 a1. + eapply r_get_remember_lhs with (pre := fun '(_, _) => _). intros x. + eapply r_put_lhs. + eapply r_get_remember_lhs. intros x0. + eapply r_ret. + intros s0 s1 Hpre. + destruct Hpre as [[s2 [[[H5 [H4 H6]] H3] H2]] H1]. + simpl in H3, H1. subst. + sheap. + split; [u_pdisj_apply Hdisj|]. + unfold aes. + rewrite H4. + rewrite H6. 2: lia. + replace ((Z.to_nat 10) - 1)%nat with 9%nat by reflexivity. + reflexivity. +Qed. + +Lemma aes_h k m pre : + (u_pdisj pre (fset Cenc_locs)) -> + ⊢ ⦃ fun '(h0, h1) => pre (h0, h1) ⦄ + Caes k m + ≈ + ret tt + ⦃ fun '(v0, h0) '(_, h1) => pre (h0, h1) /\ v0 = aes k m ⦄. +Proof. + unfold Caes. + intros Hdisj. + eapply r_bind with (m₁ := ret _). + { eapply keyExpansion_h. + u_pdisj_apply Hdisj. + intros h1 h2 l a lin Hpre. + eapply Hdisj; auto. + rewrite in_fset in lin. + simpl in lin. + unfold Cenc_locs. + move: lin => /InP []; [move=> ->|by []]. + auto_in_fset. } + intros a0 []. + eapply r_bind with (m₁ := ret _). + { eapply aes_rounds_h. + intros h1 h2 l a lin Hpre. + eapply Hdisj; auto. + rewrite in_fset in lin. + simpl in lin. + unfold Cenc_locs. + move: lin => /InP []; [move=> ->|by []]. + auto_in_fset. } + intros a1 []. + eapply r_ret. + intros. + assumption. +Qed. diff --git a/theories/Jasmin/examples/aes/aes_utils.v b/theories/Jasmin/examples/aes/aes_utils.v new file mode 100644 index 00000000..abf0759b --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_utils.v @@ -0,0 +1,646 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra zify. +From mathcomp Require Import word_ssrZ word. +Set Warnings "notation-overridden,ambiguous-paths". + +From Coq Require Import Utf8 ZArith micromega.Lia List. + +From Jasmin Require Import expr xseq. +From SSProve.Jasmin Require Import jasmin_translate. + +From SSProve.Relational Require Import OrderEnrichedCategory. +From SSProve.Crypt Require Import Prelude Package ChoiceAsOrd. + +From extructures Require Import ord fset fmap. + +Import ListNotations. +Import JasminNotation. +Import PackageNotation. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +(** Notations *) + +Module AesNotation. + Notation " 'arr ws " := (chMap 'int ('word ws)) (at level 2) : package_scope. +End AesNotation. + +(** For loops *) + +Local Open Scope Z. + +Fixpoint for_list (c : Z → raw_code 'unit) (vs : seq Z) : raw_code 'unit := + match vs with + | [::] => ret tt + | v :: vs => c v ;; for_list c vs + end. + +Definition lfor_loop (c : Z -> raw_code 'unit) lo hi := for_list c (wrange UpTo lo hi). + +Lemma iota_aux {A} k c n (f : nat -> A) g : + (forall a, a \in (iota k n) -> f a = g (a + c)%nat) -> + [seq f i | i <- iota k n] = [seq g i | i <- iota (k + c) n]. +Proof. + revert k c. + induction n. + - reflexivity. + - intros k c ex. + simpl. rewrite -addSn -IHn. + + f_equal. + apply ex. + rewrite in_cons eq_refl => //=. + + intros a ain. apply ex. + simpl. rewrite in_cons. + apply/orP. right. assumption. +Qed. + +Lemma u_lfor_loop_rule I c lo hi : + lo <= hi -> + (∀ i, (lo <= i < hi)%Z -> + ⊢ ⦃ λ '(s₀, s₁), I i s₀ s₁ ⦄ + c i ≈ ret tt + ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) s₀ s₁ ⦄) → + ⊢ ⦃ λ '(s₀, s₁), I lo s₀ s₁ ⦄ + lfor_loop c lo hi ≈ ret tt + ⦃ λ '(_,s₀) '(_,s₁), I hi s₀ s₁ ⦄. +Proof. + intros hle h. + remember (Z.to_nat (hi - lo)). + revert hle h Heqn. revert lo hi. + induction n as [| n ih]; intros. + - assert (hi = lo) by lia. + unfold lfor_loop=>/=. + rewrite -Heqn. + subst. + apply r_ret. easy. + - unfold lfor_loop=>/=. + rewrite -Heqn. simpl. rewrite Z.add_0_r. + eapply r_bind with (m₁ := ret tt) (f₁ := fun _ => _). + + eapply h. lia. + + intros a1 a2. + destruct a1, a2. + replace [seq lo + Z.of_nat i | i <- iota 1 n] with [seq (Z.succ lo) + Z.of_nat i | i <- iota 0 n]. + 2: { replace (iota 1 n) with (iota (0 + 1) n) by f_equal. apply iota_aux. intros. lia. } + replace n with (Z.to_nat (hi - Z.succ lo)) by lia. + eapply ih. + all: try lia. + intros i hi2. apply h. lia. +Qed. + +Lemma u_lfor_loop_rule_weaken (I : Z -> heap -> heap -> Prop) c lo hi (pre : precond) : + lo <= hi -> + (forall h1 h2, pre (h1, h2) -> I lo h1 h2) -> + (∀ i, (lo <= i < hi)%Z -> + ⊢ ⦃ λ '(s₀, s₁), I i s₀ s₁ ⦄ + c i ≈ ret tt + ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) s₀ s₁ ⦄) → + ⊢ ⦃ pre ⦄ + lfor_loop c lo hi ≈ ret tt + ⦃ λ '(_,s₀) '(_,s₁), I hi s₀ s₁ ⦄. +Proof. + intros. + eapply rpre_weaken_rule. + 1: eapply u_lfor_loop_rule; eauto. + assumption. +Qed. + +Lemma lfor_loop_rule I c₀ c₁ lo hi : + lo <= hi -> + (∀ i, (lo <= i < hi)%Z -> ⊢ ⦃ λ '(s₀, s₁), I i (s₀, s₁) ⦄ c₀ i ≈ c₁ i ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) (s₀,s₁) ⦄) → + ⊢ ⦃ λ '(s₀, s₁), I lo (s₀, s₁) ⦄ + lfor_loop c₀ lo hi ≈ lfor_loop c₁ lo hi + ⦃ λ '(_,s₀) '(_,s₁), I hi (s₀,s₁) ⦄. +Proof. + intros hle h. + remember (Z.to_nat (hi - lo)). + revert hle h Heqn. revert lo hi. + induction n as [| n ih]; intros. + - assert (hi = lo) by lia. + unfold lfor_loop=>/=. + rewrite -Heqn. + subst. + apply r_ret. easy. + - unfold lfor_loop=>/=. + rewrite -Heqn. simpl. rewrite Z.add_0_r. + eapply r_bind. + + eapply h. lia. + + intros a1 a2. + destruct a1, a2. + replace [seq lo + Z.of_nat i | i <- iota 1 n] with [seq (Z.succ lo) + Z.of_nat i | i <- iota 0 n]. + 2: { replace (iota 1 n) with (iota (0 + 1) n) by f_equal. apply iota_aux. intros. lia. } + replace n with (Z.to_nat (hi - Z.succ lo)) by lia. + eapply ih. + all: try lia. + intros i hi2. apply h. lia. +Qed. + +Lemma translate_for_rule I lo hi (v : var_i) m_id s_id (body1 : p_id -> p_id * raw_code 'unit) body2 : + (* it is annoying that this is a proof obligation, since its true for all translated programs, but I don't know how to prove the theorem without it *) + (forall s_id', s_id' ⪯ (body1 s_id').1) -> + lo <= hi -> + (forall i s_id', (s_id ⪯ s_id') -> (lo <= i < hi) -> + ⊢ ⦃ λ '(s₀, s₁), set_lhs (translate_var m_id v) (truncate_el (vtype v) (i : chInt)) (I i) (s₀, s₁) ⦄ + let (_, body1') := body1 s_id' in + body1' ≈ body2 i + ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) (s₀,s₁) ⦄) → + ⊢ ⦃ λ '(s₀,s₁), I lo (s₀, s₁)⦄ + translate_for v (wrange UpTo lo hi) m_id body1 s_id + ≈ lfor_loop body2 lo hi + ⦃ λ '(_,s₀) '(_,s₁), I hi (s₀,s₁) ⦄. +Proof. + intros Hbody1 Hle ih. + remember (Z.to_nat (hi - lo)). + revert Heqn Hle ih. revert n lo hi s_id. + induction n as [|n ih2]; intros. + - assert (hi = lo). { zify. lia. } + subst. + unfold translate_for, lfor_loop. simpl. + rewrite -Heqn. + simpl. + apply r_ret. + easy. + - unfold translate_for, lfor_loop. + unfold wrange. + rewrite -Heqn. + simpl. + specialize (ih lo s_id) as ih''. + specialize (Hbody1 s_id). + destruct (body1 s_id). + eapply r_put_lhs. + eapply r_bind. + + eapply r_transL. + 2: rewrite Z.add_0_r; eapply ih''; [ reflexivity | lia ]. + eapply rreflexivity_rule. + + intros a0 a1. + replace (iota 1 n) with (iota (0 + 1) n) by f_equal. + rewrite <- iota_aux with (f := fun i => Z.succ lo + Z.of_nat i) by lia. + replace n with (Z.to_nat (hi - Z.succ lo)) by lia. + specialize (ih2 (Z.succ lo) hi p ltac:(lia) ltac:(lia)). + eapply ih2. + intros i s_id' Hs_id' ile. + specialize (ih i s_id'). + destruct (body1 s_id'). apply ih. + 1: etransitivity; eauto. + lia. +Qed. + +Lemma translate_for_rule_weaken (pre : precond) (I : Z -> heap * heap -> Prop) lo hi (v : var_i) m_id s_id (body1 : p_id -> p_id * raw_code 'unit) body2 : + (forall h0 h1, pre (h0, h1) -> I lo (h0, h1)) -> + (* it is annoying that this is a proof obligation, since its true for all translated programs, but I don't know how to prove the theorem without it *) + (forall s_id', s_id' ⪯ (body1 s_id').1) -> + lo <= hi -> + (forall i s_id', (s_id ⪯ s_id') -> (lo <= i < hi) -> + ⊢ ⦃ λ '(s₀, s₁), set_lhs (translate_var m_id v) (truncate_el (vtype v) (i : chInt)) (I i) (s₀, s₁) ⦄ + let (_, body1') := body1 s_id' in + body1' + ≈ body2 i ⦃ λ '(_, s₀) '(_, s₁), I (Z.succ i) (s₀,s₁) ⦄) → + ⊢ ⦃ pre ⦄ + translate_for v (wrange UpTo lo hi) m_id body1 s_id + ≈ lfor_loop body2 lo hi + ⦃ λ '(_,s₀) '(_,s₁), I hi (s₀,s₁) ⦄. +Proof. + intros. + eapply rpre_weaken_rule. + 1: eapply translate_for_rule. + all: easy. +Qed. + +(** Arrays *) + +Definition getmd {T S} m d i := match @getm T S m i with Some a => a | _ => d end. + +Definition to_oarr ws len (a : 'array) : (chMap (chFin len) ('word ws)) := + mkfmapf (fun (i : 'I_len) => chArray_get ws a (Z.of_nat i) (wsize_size ws)) (ord_enum len). +Definition to_arr ws len (a : 'array) := + mkfmapf (fun i => chArray_get ws a i (wsize_size ws)) (ziota 0 len). + +Lemma wsize_size_aux (ws : wsize.wsize) : + (ws %/ U8 + ws %% U8)%nat = Z.to_nat (wsize_size ws). +Proof. destruct ws; reflexivity. Qed. + +Lemma encode_aux {ws} (w : word.word ws) : + LE.encode w = [seq word.subword ((Z.to_nat i0) * U8) U8 w | i0 <- ziota 0 (wsize_size ws)]. +Proof. + unfold LE.encode. + unfold split_vec. + unfold ziota. + rewrite -wsize_size_aux. + simpl. + rewrite -map_comp. + unfold comp. + apply map_ext. + intros a Ha. + rewrite Nat2Z.id. + reflexivity. +Qed. + +Lemma wsize_size_bits ws: + wsize_size ws < wsize_bits ws. +Proof. + unfold wsize_size, wsize_bits. + destruct ws; simpl; lia. +Qed. + +Lemma chArray_get_set_eq ws a i w : + chArray_get ws (chArray_set a AAscale i w) i (wsize_size ws) = w. +Proof. + unfold chArray_get. + unfold chArray_set. + rewrite <- LE.decodeK. + f_equal. + rewrite encode_aux. + apply map_ext. + intros j Hj. + unfold chArray_get8. + rewrite chArray_write_get. + assert ((0 <=? i * wsize_size ws + j - i * mk_scale AAscale ws) && (i * wsize_size ws + j - i * mk_scale AAscale ws /InP. rewrite in_ziota=>/andP [] H1 h2. lia. } + rewrite H. + unfold LE.wread8. + unfold LE.encode. + unfold split_vec. + unshelve erewrite nth_map. 1: exact 0%nat. + { simpl. + rewrite nth_iota. + 1: f_equal; lia. + simpl. move: Hj=>/InP. rewrite in_ziota=>/andP [] H1 h2. + replace (ws %/ U8 + ws %% U8)%nat with (Z.to_nat (wsize_size ws)); [lia|]. + destruct ws; simpl; reflexivity. } + rewrite size_iota. + simpl. move: Hj=>/InP. rewrite in_ziota=>/andP [] H1 h2. + replace (ws %/ U8 + ws %% U8)%nat with (Z.to_nat (wsize_size ws)); [lia|]. + destruct ws; simpl; reflexivity. +Qed. + +Lemma chArray_get_set_neq ws a i j (w : 'word ws) : + i <> j -> + chArray_get ws (chArray_set a AAscale i w) j (wsize_size ws) = chArray_get ws a j (wsize_size ws). +Proof. + intros H. + unfold chArray_get. + unfold chArray_set. + f_equal. + apply map_ext. + intros a0 Ha0. + unfold chArray_get8. + rewrite chArray_write_get. + assert ((0 <=? j * wsize_size ws + a0 - i * mk_scale AAscale ws) && (j * wsize_size ws + a0 - i * mk_scale AAscale ws /InP. rewrite in_ziota=>/andP [] H1 h2. nia. } + rewrite H0. + reflexivity. +Qed. + +Lemma in_ziota' i p z : + @in_mem (Ord.sort Z_ordType) i (@mem (Equality.sort (Ord.eqType Z_ordType)) (seq_predType (Ord.eqType Z_ordType)) (ziota p z)) = (p <=? i) && (i ∀ p : Z, @in_mem (Ord.sort Z_ordType) i (@mem (Equality.sort (Ord.eqType Z_ordType)) (seq_predType (Ord.eqType Z_ordType)) (ziota p z)) = (p <=? i) && (i P z). + 1: { apply natlike_ind. + - unfold P. intros. rewrite in_nil. lia. + - unfold P. intros. + rewrite ziotaS_cons. 2: auto. + destruct (Z.eq_dec x i). + + subst. + simpl. + unfold in_mem. + simpl. + unfold in_mem in H0. + simpl in H0. + rewrite H0. + destruct (Z.eq_dec i p). + * subst. rewrite eq_refl. lia. + * assert ((@eq_op (Ord.eqType Z_ordType) i p) = false). + 1: { apply/eqP. intros contra. subst. easy. } + rewrite H1. lia. + + simpl. + unfold in_mem. + simpl. + unfold in_mem in H0. + simpl in H0. + rewrite H0. + destruct (Z.eq_dec i p). + * subst. rewrite eq_refl. lia. + * assert ((@eq_op (Ord.eqType Z_ordType) i p) = false). + 1: { apply/eqP. intros contra. subst. easy. } + rewrite H1. lia. } + assumption. +Qed. + +Lemma getm_to_arr_None' ws len a (i: Z) : + ((len <=? i) || (i + to_arr ws len a i = None. +Proof. + intros. unfold to_arr. + rewrite mkfmapfE. + rewrite in_ziota'. + assert ((0 <=? i) && (i + to_arr ws len a i = Some (chArray_get ws a i (wsize_size ws)). +Proof. + unfold to_arr. + rewrite mkfmapfE. + intros H. + rewrite in_ziota'. + assert ((0 <=? i) && (i + getmd (to_arr ws len a) x i = chArray_get ws a i (wsize_size ws). +Proof. + intros. + unfold getmd. + rewrite getm_to_arr; auto. +Qed. + +Lemma to_oarr_set_eq ws len a (i : 'I_(pos len)) w : + (to_oarr ws len (chArray_set a AAscale (Z.of_nat (nat_of_ord i)) w)) i = Some w. +Proof. + rewrite getm_to_oarr. + rewrite chArray_get_set_eq. + reflexivity. +Qed. + +Lemma to_arr_set_eq ws len a i w : + (0 <= i < len) -> + (to_arr ws len (chArray_set a AAscale i w)) i = Some w. +Proof. + intros H. + rewrite getm_to_arr; auto. + rewrite chArray_get_set_eq; auto. +Qed. + +Lemma to_arr_set_neq' ws len a i j (w : 'word ws) : + (i <> j) -> + (0 <= j < len) -> + (to_arr ws len (chArray_set a AAscale i w)) j = Some (chArray_get ws a j (wsize_size ws)). +Proof. + intros Hneq H. + rewrite getm_to_arr; auto. + rewrite chArray_get_set_neq; auto. +Qed. + +Lemma to_arr_set_neq ws len a i j (w : 'word ws) : + (i <> j) -> + (0 <= j < len) -> + (to_arr ws len (chArray_set a AAscale i w)) j = (to_arr ws len a) j. +Proof. + intros Hneq H. + rewrite !getm_to_arr; auto. + rewrite chArray_get_set_neq; auto. +Qed. + +(** Additional rules *) + +Theorem rpre_weak_hypothesis_rule : + ∀ {A₀ A₁ : ord_choiceType} {p₀ : raw_code A₀} {p₁ : raw_code A₁} + (pre : precond) post, + (∀ s₀ s₁, + pre (s₀, s₁) → ⊢ ⦃ λ '(s0, s1), pre (s0, s1) ⦄ p₀ ≈ p₁ ⦃ post ⦄ + ) → + ⊢ ⦃ pre ⦄ p₀ ≈ p₁ ⦃ post ⦄. +Proof. + intros A₀ A₁ p₀ p₁ pre post h. + eapply rpre_hypothesis_rule. + intros. eapply rpre_weaken_rule. + 1: eapply h; eauto. + intros s0' s1' [H0 H1]. + subst. + assumption. +Qed. + +(** Valid code *) + +Lemma valid_code_cons {A} a l I (c : raw_code A) : + valid_code (fset l) I c -> valid_code (fset (a :: l)) I c. +Proof. + intros. + induction c; econstructor. + - apply inversion_valid_opr in H as []. easy. + - intros. apply H0. apply inversion_valid_opr in H as []. easy. + - apply inversion_valid_getr in H as []. rewrite in_fset in_cons. apply/orP; right. rewrite -in_fset. easy. + - intros. apply H0. apply inversion_valid_getr in H as []. easy. + - apply inversion_valid_putr in H as []. rewrite in_fset in_cons. apply/orP; right. rewrite -in_fset. easy. + - apply inversion_valid_putr in H as []. apply IHc. easy. + - intros. apply H0. eapply inversion_valid_sampler. easy. +Qed. + +Lemma valid_code_catC {A} l1 l2 I (c : raw_code A) : + valid_code (fset (l1 ++ l2)) I c -> valid_code (fset (l2 ++ l1)) I c. +Proof. by rewrite !fset_cat fsetUC. Qed. + +Lemma valid_code_cat_r {A} l1 l2 I (c : raw_code A) : + valid_code (fset l1) I c -> valid_code (fset (l1 ++ l2)) I c. +Proof. + intros. + induction l2. + - rewrite cats0. easy. + - apply valid_code_catC. simpl. apply valid_code_cons. apply valid_code_catC. easy. +Qed. + +Lemma valid_code_cat_l {A} l1 l2 I (c : raw_code A) : + valid_code (fset l2) I c -> valid_code (fset (l1 ++ l2)) I c. +Proof. intros; apply valid_code_catC. apply valid_code_cat_r. easy. Qed. + +Lemma valid_translate_write_lvals1 I id0 (v : var_i) vs : + valid_code (fset [:: translate_var id0 v]) I (translate_write_lvals [::] id0 [:: (Lvar v)] vs) . +Proof. + destruct vs. + - constructor. + - constructor. + 1: auto_in_fset. + constructor. +Qed. + +Lemma valid_translate_write_lvals2 I id0 (v1 v2 : var_i) vs : + valid_code (fset [:: translate_var id0 v1 ; translate_var id0 v2]) I (translate_write_lvals [::] id0 [:: (Lvar v1) ; (Lvar v2)] vs) . +Proof. + destruct vs. + - constructor. + - constructor. + 1: auto_in_fset. + destruct vs. + + constructor. + + constructor. + 1: auto_in_fset. + constructor. +Qed. + +(** Invariants and tactics *) + +Definition pdisj (P : precond) (s_id : p_id) (rhs : {fset Location}) := + (forall h1 h2 l a v s_id', l = translate_var s_id' v -> (s_id ⪯ s_id') -> (P (h1, h2) -> P (set_heap h1 l a, h2))) /\ + (forall h1 h2 l a, l \in rhs -> (P (h1, h2) -> P (h1, set_heap h2 l a))). + +Definition u_pdisj (P : precond) (lhs : {fset Location}) := + (forall h1 h2 l a, l \in lhs -> (P (h1, h2) -> P (set_heap h1 l a, h2))). + +Definition pdisj' (P : precond) (s_id : p_id) (lhs : {fset Location}) (rhs : {fset Location}) := + (forall h1 h2 l a, l \in lhs -> (P (h1, h2) -> P (set_heap h1 l a, h2))) /\ + (forall h1 h2 l a, l \in rhs -> (P (h1, h2) -> P (h1, set_heap h2 l a))). + +Ltac solve_in := + repeat match goal with + | |- is_true (?v \in fset1 ?v :|: _) => apply/fsetU1P; left; auto + | |- is_true (_ \in fsetU _ _) => apply/fsetU1P; right + end. + +Ltac destruct_pre := + repeat + match goal with + | [ H : set_lhs _ _ _ _ |- _ ] => + let sn := fresh in + let Hsn := fresh in + destruct H as [sn [Hsn]] + | [ H : set_rhs _ _ _ _ |- _ ] => + let sn := fresh in + let Hsn := fresh in + destruct H as [sn [Hsn]] + | [ H : _ /\ _ |- _ ] => + let H1 := fresh in + let H2 := fresh in + destruct H as [H1 H2] + | [ H : (_ ⋊ _) _ |- _ ] => + let H1 := fresh in + let H2 := fresh in + destruct H as [H1 H2] + | [ H : exists _, _ |- _ ] => + let o := fresh in + destruct H as [o] + end; simpl in *; subst. + +(* I don't know what rewrite * means, but this is much faster than regular rewrite, which also sometimes overflows the stack *) +Ltac sheap := + repeat first [ rewrite * get_set_heap_neq; [| neq_loc_auto ] | + rewrite * get_set_heap_eq ]. + +(* This works sometimes, but might be very slow *) +Ltac simpl_heap := + repeat lazymatch goal with + | |- context [ get_heap (set_heap _ ?l _) ?l ] => rewrite -> get_set_heap_eq + | |- context [ get_heap (set_heap (translate_var ?s_id _) (translate_var ?s_id _ ) _ ) _ ] => (rewrite -> get_set_heap_neq by (apply injective_translate_var3; auto)) + | |- context [ get_heap (set_heap _ (translate_var _ _ ) _ ) _ ] => (rewrite -> get_set_heap_neq by (apply injective_translate_var2; assumption)) + end. + +Ltac split_post := + repeat + match goal with + | |- (_ ⋊ _) _ => split + | |- _ /\ _ => split + | |- set_lhs _ _ _ _ => eexists + end. + +(* NB: this redefines neq_loc_auto, which helps some tactics, since checking for inequality by computation is not feasible for translated variables *) +(* Ltac neq_loc_auto ::= solve [ eapply injective_translate_var3; auto | eapply injective_translate_var2; auto ]. *) + +#[global] Hint Resolve preceq_I preceq_O preceq_refl : preceq. +Ltac solve_preceq := + repeat lazymatch goal with + | |- ?a ⪯ ?a => reflexivity + | |- ?a ⪯ ?b~1 => etransitivity; [|apply preceq_I] + | |- ?a ⪯ ?b~0 => etransitivity; [|apply preceq_O] + end. + +Ltac esolve_in := + rewrite in_fset; apply/xseq.InP; + repeat lazymatch goal with + | |- List.In _ (_ :: _) => eapply List.in_cons + | |- _ => eapply List.in_eq + end. + +Ltac tr_inseq_try := + apply/orP ; first [ left ; rewrite translate_var_eq eq_refl ; reflexivity + | right ; tr_inseq_try ]. + +Ltac tr_inset_try := + rewrite in_fset ; tr_inseq_try. + +Ltac tr_auto_in_fset := + eauto ; + try tr_inset_try. + +Ltac until_call := + simpl; repeat match goal with + | |- ValidCode _ _ _ => red + | |- valid_code _ _ (_ ← translate_call _ _ _ _ _ ;; _) => eapply valid_bind + | |- valid_code _ _ (_ ← (x ← _ ;; _) ;; _) => rewrite bind_assoc + | |- _ => constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]; intros + | |- _ -> _ => intros + end. + +Ltac pdisj_apply h := + lazymatch goal with + | |- ?pre (set_heap _ _ _, set_heap _ _ _) => eapply h; [ solve_in | pdisj_apply h ] + | |- ?pre (set_heap _ _ _, _) => + eapply h ; [ reflexivity | auto with preceq | pdisj_apply h ] + | |- _ => try assumption + end. + +Ltac pdisj'_apply h := + lazymatch goal with + | |- ?pre (set_heap _ _ _, _) => eapply h; [ tr_auto_in_fset | pdisj'_apply h ] + | |- ?pre (_, set_heap _ _ _) => eapply h; [ auto_in_fset | pdisj'_apply h ] + | |- _ => try assumption + end. + +Ltac u_pdisj_apply h := + lazymatch goal with + | |- ?pre (set_heap _ _ _, _) => eapply h; [ solve_in | u_pdisj_apply h ] + | |- _ => try assumption + end. + +Ltac clear_fset := + repeat match goal with + | |- ValidCode _ _ _ => red + | |- valid_code (fset (_ :: _)) _ _ => eapply valid_code_cons + | |- valid_code (fset (_ ++ _)) _ _ => eapply valid_code_cat_l + end; eapply valid_code_cat_r. + +(** Misc (TODO: move these) *) + +(* TODO: move these, note they are the same as fresh1 and fresh2 *) +Lemma prec_O : + forall i, i ≺ i~0. +Proof. + simpl; split. + - apply preceq_O. + - apply nesym. apply xO_neq. +Qed. + +Lemma prec_I : + forall i, i ≺ i~1. +Proof. + simpl; split. + - apply preceq_I. + - apply nesym. apply xI_neq. +Qed. + +Ltac solve_prec := + repeat lazymatch goal with + | |- ?a ≺ ?a~1 => apply prec_I + | |- ?a ≺ ?a~0 => apply prec_O + | |- ?a ≺ ?b~1 => etransitivity; [|apply prec_I] + | |- ?a ≺ ?b~0 => etransitivity; [|apply prec_O] + end. + +(** *) diff --git a/theories/Jasmin/examples/aes/aes_valid.v b/theories/Jasmin/examples/aes/aes_valid.v new file mode 100644 index 00000000..e9fd8282 --- /dev/null +++ b/theories/Jasmin/examples/aes/aes_valid.v @@ -0,0 +1,279 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect seq. +Set Warnings "notation-overridden,ambiguous-paths". + +From SSProve.Jasmin Require Import jasmin_translate aes_utils aes_jazz. +From SSProve.Relational Require Import OrderEnrichedCategory GenericRulesSimple. +From SSProve.Crypt Require Import Axioms ChoiceAsOrd pkg_core_definition choice_type Prelude. + +From extructures Require Import fset ord. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Local Open Scope positive_scope. + +Ltac fix_lvals1 := clear_fset; eapply valid_translate_write_lvals1. +Ltac fix_lvals2 := clear_fset; eapply valid_translate_write_lvals2. + +Lemma JRCON_valid id0 : + ∑ L, forall I j, ValidCode (fset L) I (JRCON id0 j). +Proof. + eexists. + intros I j. + unfold JRCON. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + simpl. unfold ValidCode. + repeat match goal with + | |- context[BinInt.Z.eqb _ _] => rewrite ?coerce_to_choice_type_K; destruct (BinInt.Z.eqb _ _) + | |- valid_code _ _ _ => constructor + | |- is_true (_ \in _) => solve [ tr_auto_in_fset | esolve_in ] + | _ => intros + end. + Unshelve. exact [::]. +Defined. + +Definition JRCON_locs id0 : {fset Location} := fset (JRCON_valid id0).π1. + +Lemma JKEY_EXPAND_valid id0 : + ∑ L, forall I rcon rkey temp2, ValidCode (fset L) I (JKEY_EXPAND id0 rcon rkey temp2). +Proof. + eexists. + intros rcon rkey temp2. + unfold JRCON. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + simpl. unfold ValidCode. + repeat match goal with + | |- valid_code _ _ _ => constructor + | |- is_true (_ \in _) => solve [ tr_auto_in_fset | esolve_in ] + | _ => intros + end. + Unshelve. exact [::]. +Defined. + +Definition JKEY_EXPAND_locs id0 : {fset Location} := fset (JKEY_EXPAND_valid id0).π1. + +Lemma JKEYS_EXPAND_valid id0 : + ∑ L, forall I rkey, ValidCode (fset L) I (JKEYS_EXPAND id0 rkey). +Proof. + eexists. + intros. + unfold JAES. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + (* Opaque translate_for. *) + Opaque translate_call. + simpl. + unfold translate_for. + rewrite !coerce_typed_code_K. + + Ltac fix_rcon := clear_fset; eapply (JRCON_valid _).π2. + Ltac fix_key_expand := clear_fset; eapply (JKEY_EXPAND_valid _).π2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + until_call. + 1: fix_rcon. + eapply valid_bind. + 1: fix_lvals1. + + until_call. + 1: fix_key_expand. + eapply valid_bind. + 1: fix_lvals2. + + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JKEYS_EXPAND_locs id0 : {fset Location} := fset (JKEYS_EXPAND_valid id0).π1. + +Lemma JAES_ROUNDS_valid id0 : + ∑ L, forall I rkeys m, ValidCode (fset L) I (JAES_ROUNDS id0 rkeys m). +Proof. + eexists. + intros. + unfold JAES. + unfold get_translated_static_fun. + unfold translate_prog_static. + unfold translate_funs_static. + unfold translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + rewrite !coerce_typed_code_K. + until_call. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JAES_ROUNDS_locs id0 : {fset Location} := fset (JAES_ROUNDS_valid id0).π1. + +Lemma JAES_valid id0 : + ∑ L, forall I key m, ValidCode (fset L) I (JAES id0 key m). +Proof. + eexists. + unfold JAES. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + until_call. + 1: clear_fset. + 1: eapply (JKEYS_EXPAND_valid _).π2. + eapply valid_bind. + 1: clear_fset. + 1: eapply valid_translate_write_lvals1. + until_call. + + 1: clear_fset. + 1: eapply (JAES_ROUNDS_valid _).π2. + eapply valid_bind. + 1: clear_fset. + 1: eapply valid_translate_write_lvals1. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JAES_locs id0 : {fset Location} := fset (JAES_valid id0).π1. + +Lemma JXOR_valid id0 : + ∑ L, forall I a1 a2, ValidCode (fset L) I (JXOR id0 a1 a2). +Proof. + eexists. + unfold JXOR. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + until_call. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JXOR_locs id0 : {fset Location} := fset (JXOR_valid id0).π1. + +Lemma JENC_valid id0 : + ∑ L, forall I n k m, ValidCode (fset L) I (JENC id0 n k m). +Proof. + + unfold JENC. + unfold get_translated_static_fun, translate_prog_static, translate_funs_static, translate_call_body. + Opaque translate_for. + Opaque translate_call. + simpl. + + eexists. + intros. + until_call. + + 1: clear_fset. + 1: eapply (JAES_valid _).π2. + eapply valid_bind. + 1: clear_fset; eapply valid_translate_write_lvals1. + until_call. + 1: clear_fset; eapply (JXOR_valid _).π2. + eapply valid_bind. + 1: clear_fset; eapply valid_translate_write_lvals1. + constructor; [solve [ tr_auto_in_fset | esolve_in ]| ]. + constructor. + Unshelve. exact [::]. +Defined. + +Definition JENC_locs id0 : {fset Location} := fset (JENC_valid id0).π1. diff --git a/theories/Jasmin/examples/bigadd.cprog b/theories/Jasmin/examples/bigadd.cprog new file mode 100644 index 00000000..1ffa67f5 --- /dev/null +++ b/theories/Jasmin/examples/bigadd.cprog @@ -0,0 +1,435 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; loc_start = (8, 2); + loc_end = (8, 12); loc_bchar = 123; loc_echar = 133}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (8, 2); loc_end = (8, 4); loc_bchar = 123; + loc_echar = 125}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (8, 7); loc_end = (8, 8); loc_bchar = 128; + loc_echar = 129}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; loc_start = (9, 2); + loc_end = (9, 12); loc_bchar = 136; loc_echar = 146}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (9, 2); loc_end = (9, 4); loc_bchar = 136; + loc_echar = 138}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (9, 7); loc_end = (9, 8); loc_bchar = 141; + loc_echar = 142}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 2); loc_end = (10, 15); loc_bchar = 149; + loc_echar = 162}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.156}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 2); loc_end = (10, 4); loc_bchar = 149; + loc_echar = 151}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 6); loc_end = (10, 8); loc_bchar = 153; + loc_echar = 155}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 6); loc_end = (10, 8); loc_bchar = 153; + loc_echar = 155}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (10, 12); loc_end = (10, 14); loc_bchar = 159; + loc_echar = 161}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pbool false])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (12, 2); loc_end = (12, 14); loc_bchar = 166; + loc_echar = 178}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = res.153}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (12, 2); loc_end = (12, 5); loc_bchar = 166; + loc_echar = 169}}, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (12, 11); loc_end = (12, 13); loc_bchar = 175; + loc_echar = 177}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 10; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (14, 2); loc_end = (20, 3); loc_bchar = 182; + loc_echar = 273}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (14, 6); loc_end = (14, 7); loc_bchar = 186; + loc_echar = 187}}, + ((Jasmin.Expr.UpTo, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 6; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 4); loc_end = (15, 14); loc_bchar = 203; + loc_echar = 213}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 4); loc_end = (15, 6); loc_bchar = 203; + loc_echar = 205}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 9); loc_end = (15, 10); loc_bchar = 208; + loc_echar = 209}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (15, 11); loc_end = (15, 12); + loc_bchar = 210; loc_echar = 211}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 7; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 4); loc_end = (16, 14); loc_bchar = 218; + loc_echar = 228}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 4); loc_end = (16, 6); loc_bchar = 218; + loc_echar = 220}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 9); loc_end = (16, 10); loc_bchar = 223; + loc_echar = 224}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (16, 11); loc_end = (16, 12); + loc_bchar = 225; loc_echar = 226}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 8; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 4); loc_end = (17, 22); loc_bchar = 233; + loc_echar = 251}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.156}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 4); loc_end = (17, 6); loc_bchar = 233; + loc_echar = 235}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 8); loc_end = (17, 10); loc_bchar = 237; + loc_echar = 239}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 8); loc_end = (17, 10); + loc_bchar = 237; loc_echar = 239}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = yr.155}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 14); loc_end = (17, 16); + loc_bchar = 243; loc_echar = 245}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.156}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (17, 19); loc_end = (17, 21); + loc_bchar = 248; loc_echar = 250}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 9; + base_loc = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 4); loc_end = (19, 16); loc_bchar = 257; + loc_echar = 269}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = res.153}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 4); loc_end = (19, 7); loc_bchar = 257; + loc_echar = 260}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.157}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 8); loc_end = (19, 9); + loc_bchar = 261; loc_echar = 262}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xr.154}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; + loc_start = (19, 13); loc_end = (19, 15); + loc_bchar = 266; loc_echar = 268}}; + gs = Jasmin.Expr.Slocal}))]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))); + vname = res.153}; + v_info = + {Jasmin.Location.loc_fname = "bigadd.jazz"; loc_start = (21, 9); + loc_end = (21, 12); loc_bchar = 283; loc_echar = 286}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/bigadd.jazz b/theories/Jasmin/examples/bigadd.jazz new file mode 100644 index 00000000..e3902c21 --- /dev/null +++ b/theories/Jasmin/examples/bigadd.jazz @@ -0,0 +1,22 @@ +export fn add_inline(reg u64[4] x y) -> reg u64[4] { + inline int i; + reg u64[4] res; + + reg u64 xr yr; + reg bool cf; + + xr = x[0]; + yr = y[0]; + cf, xr += yr; + + res[0] = xr; + + for i = 1 to 4 { + xr = x[i]; + yr = y[i]; + cf, xr += yr + cf; + + res[i] = xr; + } + return res; +} \ No newline at end of file diff --git a/theories/Jasmin/examples/bigadd.v b/theories/Jasmin/examples/bigadd.v new file mode 100644 index 00000000..086b8b85 --- /dev/null +++ b/theories/Jasmin/examples/bigadd.v @@ -0,0 +1,208 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add_inline *) xH, + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO xH)))))); + (sarr (xO (xO (xO (xO (xO xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "x.149" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "y.150" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "x.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "y.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.154" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "res.151" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xO (xO xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "x.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "y.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.154" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "yr.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.154" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "res.151" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "xr.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xO xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xO xH)))))) + ; vname := "res.151" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD_INLINE := ( xH ). diff --git a/theories/Jasmin/examples/deextract.pl b/theories/Jasmin/examples/deextract.pl new file mode 100755 index 00000000..2baa524b --- /dev/null +++ b/theories/Jasmin/examples/deextract.pl @@ -0,0 +1,30 @@ +#!/usr/bin/perl +use Regexp::Common; + +my $string = <>; + +# change easy stuff (remove names added by extraction, quote strings, etc.) +$string =~ s/Jasmin\.[[:graph:]]*\.//g ; +$string =~ s/Coq_//g ; +$string =~ s/=/:=/g ; +$string =~ s/{/{| /g ; +$string =~ s/}/ |}/g ; +$string =~ s/v_info :=[ \t\n]*[^{}]*{[^}]*}/v_info := dummy_var_info/g ; +$string =~ s/(MkI[^(]*\()\(([^()]*(\([^)]*\))*)*\)/$1dummy_instr_info/g ; +$string =~ s/([[:graph:]]*\.[[:graph:]]*)/"$1"/g ; +$string =~ s/\(\)/tt/g ; + +# curry functions +# pattern which matches balanced expression with either () {} or "" +my $bal = qr/$RE{balanced}{-parens=>'(){}""'}/; + +# pattern which matches an alnum (function) followed by a tuple, e.g. f (a, b) +my $pat = qr/([[:alnum:]][ \n\t]*\(([^()]|($bal))*),([ \n\t]*)(([^(),]|($bal))*)\)/; + +# propagate the final parenthesis of the tuple down and parenthesise: +# f (a, b, c) -> f (a, b) (c) -> f (a) (b) (c) +while ( $string =~ m/$pat/g ) { + $string =~ s/$pat/$1\)$5\($6\)/g; +} + +print($string); diff --git a/theories/Jasmin/examples/ex.cprog b/theories/Jasmin/examples/ex.cprog new file mode 100644 index 00000000..bdd765f1 --- /dev/null +++ b/theories/Jasmin/examples/ex.cprog @@ -0,0 +1,120 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 2); + loc_end = (5, 13); loc_bchar = 81; loc_echar = 92}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.146}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 2); + loc_end = (5, 4); loc_bchar = 81; loc_echar = 83}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 6); + loc_end = (5, 7); loc_bchar = 85; loc_echar = 86}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 6); + loc_end = (5, 7); loc_bchar = 85; loc_echar = 86}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (5, 11); + loc_end = (5, 12); loc_bchar = 90; loc_echar = 91}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pbool false])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 2); + loc_end = (6, 13); loc_bchar = 95; loc_echar = 106}; + stack_loc = []}, + []), + Jasmin.Expr.Copn + ([Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sbool; + vname = cf.146}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 2); + loc_end = (6, 4); loc_bchar = 95; loc_echar = 97}}; + Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 6); + loc_end = (6, 7); loc_bchar = 99; loc_echar = 100}}], + Jasmin.Expr.AT_keep, Jasmin.Sopn.Oaddcarry Jasmin.Wsize.U64, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 6); + loc_end = (6, 7); loc_bchar = 99; loc_echar = 100}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.144}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (6, 11); + loc_end = (6, 12); loc_bchar = 104; loc_echar = 105}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pbool false]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.145}; + v_info = + {Jasmin.Location.loc_fname = "ex.jazz"; loc_start = (8, 9); + loc_end = (8, 10); loc_bchar = 117; loc_echar = 118}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/ex.jazz b/theories/Jasmin/examples/ex.jazz new file mode 100644 index 00000000..7d49a837 --- /dev/null +++ b/theories/Jasmin/examples/ex.jazz @@ -0,0 +1,9 @@ +param int KEYSIZE = 4; + +inline fn add(reg u64 x y) -> reg u64 { + reg bool cf; + cf, x += y; + cf, y += x; + + return y; +} diff --git a/theories/Jasmin/examples/ex.v b/theories/Jasmin/examples/ex.v new file mode 100644 index 00000000..8f42c224 --- /dev/null +++ b/theories/Jasmin/examples/ex.v @@ -0,0 +1,92 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.144" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.144" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.143" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD := ( xH ). diff --git a/theories/Jasmin/examples/gen_and_test.sh b/theories/Jasmin/examples/gen_and_test.sh new file mode 100755 index 00000000..7f265433 --- /dev/null +++ b/theories/Jasmin/examples/gen_and_test.sh @@ -0,0 +1,19 @@ +#!/bin/bash +# test deextraction of all .jazz in this folder, note that their corresponding .v will be overwritten + +JASMINC=${JASMINC:-$(which jasminc)} + +# assuming jasmin is in home directory +for f in *.jazz +do + echo $f + $JASMINC -I AES:../examples -coq $f > $(basename $f .jazz).v + # JASMINC=~/jasmin/compiler/jasminc.byte ./gen_ast.sh $f + cd ../../.. + coqc -Q theories/Mon Mon \ + -Q theories/Relational Relational \ + -Q theories/Crypt Crypt \ + -Q theories/Jasmin JasminSSProve \ + theories/Jasmin/examples/"$(basename $f .jazz)".v + cd - +done diff --git a/theories/Jasmin/examples/gen_ast.sh b/theories/Jasmin/examples/gen_ast.sh new file mode 100755 index 00000000..3855e607 --- /dev/null +++ b/theories/Jasmin/examples/gen_ast.sh @@ -0,0 +1,50 @@ +#!/bin/bash + +# you might have install the perl module Regexp::Common via cpan + +# set path to jasminc.byte on command line by invoking the script with +# JASMINC=... ./gen_ast.sh foo.jazz +# JASMINC=${JASMINC:-$(which jasminc.byte)} + +# use this variable to e.g. include paths +# e.g.: ./gen_ast.sh aes '-I AES:../examples' +OPTS=${2} +echo $OPTS +echo "open Format + +let print_vname (fmt : formatter) (t : Obj.t) = + let t = Obj.magic t in + ignore (List.map (pp_print_char fmt) t)" > print_vname.ml + +ocamlc -c print_vname.ml + +name=$(basename "${1}" .jazz) +echo $name + +echo -n "Require Import List. +From Jasmin Require Import expr. +From Jasmin Require Import x86_extra. + +Import ListNotations. +Local Open Scope string. + +Definition ${name} :=" > $name.v + +(ocamldebug $JASMINC < $name.cprog + +# delete all but the 12 first lines and then delete the last line +sed -i '12,$!d;$d' $name.cprog + +perl -0777 deextract.pl $name.cprog >> $name.v + +echo -n "." >> $name.v diff --git a/theories/Jasmin/examples/int_add.cprog b/theories/Jasmin/examples/int_add.cprog new file mode 100644 index 00000000..a30e666b --- /dev/null +++ b/theories/Jasmin/examples/int_add.cprog @@ -0,0 +1,173 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sint; Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = n.154}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (12, 3); loc_end = (14, 4); loc_bchar = 199; + loc_echar = 238}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.156}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (12, 7); loc_end = (12, 8); loc_bchar = 203; + loc_echar = 204}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = n.154}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (12, 16); loc_end = (12, 17); loc_bchar = 212; + loc_echar = 213}}; + gs = Jasmin.Expr.Slocal}), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (13, 7); loc_end = (13, 17); loc_bchar = 223; + loc_echar = 233}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (13, 7); loc_end = (13, 8); loc_bchar = 223; + loc_echar = 224}}, + Jasmin.Expr.AT_inline, Jasmin.Type.Coq_sint, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (13, 11); loc_end = (13, 12); + loc_bchar = 227; loc_echar = 228}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH))))]))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.155}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; loc_start = (15, 10); + loc_end = (15, 11); loc_bchar = 249; loc_echar = 250}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.157}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (3, 3); loc_end = (5, 4); loc_bchar = 63; + loc_echar = 102}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.159}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 67; + loc_echar = 68}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp1 (Jasmin.Expr.Oint_of_word Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.157}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (3, 16); loc_end = (3, 17); loc_bchar = 76; + loc_echar = 77}}; + gs = Jasmin.Expr.Slocal})), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (4, 7); loc_end = (4, 17); loc_bchar = 87; + loc_echar = 97}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (4, 7); loc_end = (4, 8); loc_bchar = 87; + loc_echar = 88}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; + loc_start = (4, 11); loc_end = (4, 12); loc_bchar = 91; + loc_echar = 92}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.158}; + v_info = + {Jasmin.Location.loc_fname = "int_add.jazz"; loc_start = (6, 10); + loc_end = (6, 11); loc_bchar = 113; loc_echar = 114}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_add.jazz b/theories/Jasmin/examples/int_add.jazz new file mode 100644 index 00000000..523e27e2 --- /dev/null +++ b/theories/Jasmin/examples/int_add.jazz @@ -0,0 +1,16 @@ +fn odd (reg u64 n, reg u64 m) -> reg u64 { + inline int i; + for i = 0 to n { + m = m + 1; + } + return m; +} + + +inline fn add (inline int n, inline int m) -> inline int { + inline int i; + for i = 0 to n { + m = m + 1; + } + return m; +} diff --git a/theories/Jasmin/examples/int_add.v b/theories/Jasmin/examples/int_add.v new file mode 100644 index 00000000..3887ac5d --- /dev/null +++ b/theories/Jasmin/examples/int_add.v @@ -0,0 +1,117 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* add *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint; sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "n.152" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.154" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "n.152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH))))))]) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "m.153" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* odd *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.155" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.157" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp1 (Oint_of_word U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "m.156" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ADD := ( xH ). +Notation ODD := ( xO xH ). diff --git a/theories/Jasmin/examples/int_incr.cprog b/theories/Jasmin/examples/int_incr.cprog new file mode 100644 index 00000000..a66edf22 --- /dev/null +++ b/theories/Jasmin/examples/int_incr.cprog @@ -0,0 +1,141 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (11, 2); loc_end = (11, 14); loc_bchar = 167; + loc_echar = 179}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.153}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (11, 2); loc_end = (11, 3); loc_bchar = 167; + loc_echar = 168}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pconst Jasmin.BinNums.Z0])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (12, 2); loc_end = (12, 9); loc_bchar = 182; + loc_echar = 189}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = xx.154}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (12, 2); loc_end = (12, 4); loc_bchar = 182; + loc_echar = 184}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (12, 7); loc_end = (12, 8); loc_bchar = 187; + loc_echar = 188}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (13, 2); loc_end = (13, 15); loc_bchar = 192; + loc_echar = 205}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (13, 2); loc_end = (13, 3); loc_bchar = 192; + loc_echar = 193}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = x.153}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (13, 12); loc_end = (13, 13); loc_bchar = 202; + loc_echar = 203}}; + gs = Jasmin.Expr.Slocal})))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.152}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; loc_start = (14, 9); + loc_end = (14, 10); loc_bchar = 215; loc_echar = 216}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = n.155}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 13); loc_bchar = 65; + loc_echar = 75}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.156}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 65; + loc_echar = 66}}, + Jasmin.Expr.AT_inline, Jasmin.Type.Coq_sint, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = n.155}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; + loc_start = (3, 8); loc_end = (3, 9); loc_bchar = 70; + loc_echar = 71}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH))))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.156}; + v_info = + {Jasmin.Location.loc_fname = "int_incr.jazz"; loc_start = (4, 10); + loc_end = (4, 11); loc_bchar = 86; loc_echar = 87}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_incr.jazz b/theories/Jasmin/examples/int_incr.jazz new file mode 100644 index 00000000..13f687e3 --- /dev/null +++ b/theories/Jasmin/examples/int_incr.jazz @@ -0,0 +1,15 @@ +inline fn incr(inline int n) -> inline int { + inline int m; + m = (n+1); + return m; + } + +export fn f() -> reg u64 { + inline int x; + reg u64 xx; + reg u64 y; + x = incr(0); + xx = y; + y = ((64u)x); + return y; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/int_incr.v b/theories/Jasmin/examples/int_incr.v new file mode 100644 index 00000000..a519cdc1 --- /dev/null +++ b/theories/Jasmin/examples/int_incr.v @@ -0,0 +1,103 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sint + ; vname := "x.151" |} + ; v_info := dummy_var_info |}] + (xO xH) [(Pconst (Z0))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "xx.152" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "y.150" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "x.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.150" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* incr *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "n.153" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "m.154" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "n.153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "m.154" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation INCR := ( xO xH ). diff --git a/theories/Jasmin/examples/int_reg.cprog b/theories/Jasmin/examples/int_reg.cprog new file mode 100644 index 00000000..b41979ef --- /dev/null +++ b/theories/Jasmin/examples/int_reg.cprog @@ -0,0 +1,46 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = k.141}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_reg.jazz"; + loc_start = (3, 3); loc_end = (3, 9); loc_bchar = 49; + loc_echar = 55}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.142}; + v_info = + {Jasmin.Location.loc_fname = "int_reg.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 49; + loc_echar = 50}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sint, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = k.141}; + v_info = + {Jasmin.Location.loc_fname = "int_reg.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 53; + loc_echar = 54}}; + gs = Jasmin.Expr.Slocal}))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.142}; + v_info = + {Jasmin.Location.loc_fname = "int_reg.jazz"; loc_start = (4, 10); + loc_end = (4, 11); loc_bchar = 66; loc_echar = 67}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_reg.jazz b/theories/Jasmin/examples/int_reg.jazz new file mode 100644 index 00000000..87981cca --- /dev/null +++ b/theories/Jasmin/examples/int_reg.jazz @@ -0,0 +1,5 @@ +fn foo (reg int k) -> reg int { + reg int x; + x = k; + return x; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/int_reg.v b/theories/Jasmin/examples/int_reg.v new file mode 100644 index 00000000..de712513 --- /dev/null +++ b/theories/Jasmin/examples/int_reg.v @@ -0,0 +1,55 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* foo *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "k.139" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "x.140" |} + ; v_info := dummy_var_info |}) + AT_none (sint) + ((Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "x.140" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation FOO := ( xH ). diff --git a/theories/Jasmin/examples/int_shift.cprog b/theories/Jasmin/examples/int_shift.cprog new file mode 100644 index 00000000..4ece35fd --- /dev/null +++ b/theories/Jasmin/examples/int_shift.cprog @@ -0,0 +1,120 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (10, 2); loc_end = (10, 14); loc_bchar = 155; + loc_echar = 167}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (10, 2); loc_end = (10, 3); loc_bchar = 155; + loc_echar = 156}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pconst Jasmin.BinNums.Z0])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (11, 2); loc_end = (11, 15); loc_bchar = 170; + loc_echar = 183}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (11, 2); loc_end = (11, 3); loc_bchar = 170; + loc_echar = 171}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = x.151}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (11, 12); loc_end = (11, 13); loc_bchar = 180; + loc_echar = 181}}; + gs = Jasmin.Expr.Slocal})))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (12, 9); loc_end = (12, 10); loc_bchar = 193; + loc_echar = 194}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sint]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = n.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (3, 3); loc_end = (3, 15); loc_bchar = 65; + loc_echar = 77}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.153}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 65; + loc_echar = 66}}, + Jasmin.Expr.AT_inline, Jasmin.Type.Coq_sint, + Jasmin.Expr.Papp2 (Jasmin.Expr.Olsl Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = n.152}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 69; + loc_echar = 70}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))))))]; + f_tyout = [Jasmin.Type.Coq_sint]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = m.153}; + v_info = + {Jasmin.Location.loc_fname = "int_shift.jazz"; + loc_start = (4, 10); loc_end = (4, 11); loc_bchar = 88; + loc_echar = 89}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/int_shift.jazz b/theories/Jasmin/examples/int_shift.jazz new file mode 100644 index 00000000..0c03c4e1 --- /dev/null +++ b/theories/Jasmin/examples/int_shift.jazz @@ -0,0 +1,13 @@ +inline fn incr(inline int n) -> inline int { + inline int m; + m = n << 65; + return m; + } + +export fn f() -> reg u64 { + inline int x; + reg u64 y; + x = incr(0); + y = ((64u)x); + return y; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/int_shift.v b/theories/Jasmin/examples/int_shift.v new file mode 100644 index 00000000..60c05ed7 --- /dev/null +++ b/theories/Jasmin/examples/int_shift.v @@ -0,0 +1,90 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sint + ; vname := "x.149" |} + ; v_info := dummy_var_info |}] + (xO xH) [(Pconst (Z0))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "x.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* incr *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [sint] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "n.150" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "m.151" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Olsl Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "n.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xO (xO (xO (xO (xO xH))))))))))) ] + ; f_tyout := [sint] + ; f_res := + [{| v_var := {| vtype := sint + ; vname := "m.151" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation INCR := ( xO xH ). diff --git a/theories/Jasmin/examples/liveness_bork.cprog b/theories/Jasmin/examples/liveness_bork.cprog new file mode 100644 index 00000000..5e051290 --- /dev/null +++ b/theories/Jasmin/examples/liveness_bork.cprog @@ -0,0 +1,86 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (3, 3); loc_end = (5, 4); loc_bchar = 55; + loc_echar = 94}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.142}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (3, 7); loc_end = (3, 8); loc_bchar = 59; + loc_echar = 60}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp1 (Jasmin.Expr.Oint_of_word Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (3, 16); loc_end = (3, 17); loc_bchar = 68; + loc_echar = 69}}; + gs = Jasmin.Expr.Slocal})), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (4, 7); loc_end = (4, 17); loc_bchar = 79; + loc_echar = 89}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (4, 7); loc_end = (4, 8); loc_bchar = 79; + loc_echar = 80}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (4, 11); loc_end = (4, 12); loc_bchar = 83; + loc_echar = 84}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.141}; + v_info = + {Jasmin.Location.loc_fname = "liveness_bork.jazz"; + loc_start = (6, 10); loc_end = (6, 11); loc_bchar = 105; + loc_echar = 106}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/liveness_bork.jazz b/theories/Jasmin/examples/liveness_bork.jazz new file mode 100644 index 00000000..0581fff6 --- /dev/null +++ b/theories/Jasmin/examples/liveness_bork.jazz @@ -0,0 +1,7 @@ +fn double (reg u64 n) -> reg u64 { + inline int i; + for i = 0 to n { + n = n + 1; + } + return n; +} diff --git a/theories/Jasmin/examples/liveness_bork.v b/theories/Jasmin/examples/liveness_bork.v new file mode 100644 index 00000000..45a8692f --- /dev/null +++ b/theories/Jasmin/examples/liveness_bork.v @@ -0,0 +1,70 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* double *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.140" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp1 (Oint_of_word U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.139" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation DOUBLE := ( xH ). diff --git a/theories/Jasmin/examples/matrix_product.cprog b/theories/Jasmin/examples/matrix_product.cprog new file mode 100644 index 00000000..8d3ab0dd --- /dev/null +++ b/theories/Jasmin/examples/matrix_product.cprog @@ -0,0 +1,1767 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.218}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.219}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.220}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 24; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (68, 2); loc_end = (73, 3); loc_bchar = 1344; + loc_echar = 1458}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (68, 6); loc_end = (68, 7); loc_bchar = 1348; + loc_echar = 1349}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 20; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 4); loc_end = (69, 27); loc_bchar = 1369; + loc_echar = 1392}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 4); loc_end = (69, 7); loc_bchar = 1369; + loc_echar = 1372}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pload (Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.218}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 16); loc_end = (69, 17); loc_bchar = 1381; + loc_echar = 1382}}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (69, 24); loc_end = (69, 25); + loc_bchar = 1389; loc_echar = 1390}}; + gs = Jasmin.Expr.Slocal}))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 21; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 4); loc_end = (70, 16); loc_bchar = 1397; + loc_echar = 1409}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mx.223}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 4); loc_end = (70, 6); loc_bchar = 1397; + loc_echar = 1399}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 7); loc_end = (70, 8); + loc_bchar = 1400; loc_echar = 1401}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (70, 12); loc_end = (70, 15); + loc_bchar = 1405; loc_echar = 1408}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 22; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 4); loc_end = (71, 27); loc_bchar = 1414; + loc_echar = 1437}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 4); loc_end = (71, 7); loc_bchar = 1414; + loc_echar = 1417}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pload (Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.219}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 16); loc_end = (71, 17); loc_bchar = 1426; + loc_echar = 1427}}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (71, 24); loc_end = (71, 25); + loc_bchar = 1434; loc_echar = 1435}}; + gs = Jasmin.Expr.Slocal}))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 23; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 4); loc_end = (72, 16); loc_bchar = 1442; + loc_echar = 1454}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = my.224}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 4); loc_end = (72, 6); loc_bchar = 1442; + loc_echar = 1444}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 7); loc_end = (72, 8); + loc_bchar = 1445; loc_echar = 1446}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (72, 12); loc_end = (72, 15); + loc_bchar = 1450; loc_echar = 1453}}; + gs = Jasmin.Expr.Slocal}))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 25; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 2); loc_end = (74, 41); loc_bchar = 1461; + loc_echar = 1500}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mz.225}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 2); loc_end = (74, 4); loc_bchar = 1461; + loc_echar = 1463}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mx.223}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 29); loc_end = (74, 31); loc_bchar = 1488; + loc_echar = 1490}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = my.224}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 33); loc_end = (74, 35); loc_bchar = 1492; + loc_echar = 1494}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mz.225}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (74, 37); loc_end = (74, 39); loc_bchar = 1496; + loc_echar = 1498}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 28; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (75, 2); loc_end = (78, 3); loc_bchar = 1503; + loc_echar = 1572}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (75, 6); loc_end = (75, 7); loc_bchar = 1507; + loc_echar = 1508}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 26; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 4); loc_end = (76, 16); loc_bchar = 1528; + loc_echar = 1540}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 4); loc_end = (76, 7); loc_bchar = 1528; + loc_echar = 1531}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = mz.225}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 10); loc_end = (76, 12); + loc_bchar = 1534; loc_echar = 1536}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (76, 13); loc_end = (76, 14); + loc_bchar = 1537; loc_echar = 1538}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 27; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 4); loc_end = (77, 27); loc_bchar = 1545; + loc_echar = 1568}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lmem (Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.220}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 10); loc_end = (77, 11); + loc_bchar = 1551; loc_echar = 1552}}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.221}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 18); loc_end = (77, 19); + loc_bchar = 1559; loc_echar = 1560}}; + gs = Jasmin.Expr.Slocal}))), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.222}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (77, 23); loc_end = (77, 26); + loc_bchar = 1564; loc_echar = 1567}}; + gs = Jasmin.Expr.Slocal}))]))]; + f_tyout = []; f_res = []; f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m1.226}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m2.227}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 14; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (49, 2); loc_end = (49, 13); loc_bchar = 924; + loc_echar = 935}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = pres.229}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (49, 2); loc_end = (49, 6); loc_bchar = 924; + loc_echar = 928}}, + Jasmin.Expr.AT_none, + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (49, 9); loc_end = (49, 12); loc_bchar = 931; + loc_echar = 934}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 15; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 2); loc_end = (50, 28); loc_bchar = 938; + loc_echar = 964}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2t.230}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 2); loc_end = (50, 5); loc_bchar = 938; + loc_echar = 941}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2.227}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 19); loc_end = (50, 21); loc_bchar = 955; + loc_echar = 957}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2t.230}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (50, 23); loc_end = (50, 26); loc_bchar = 959; + loc_echar = 962}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 17; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (51, 2); loc_end = (53, 3); loc_bchar = 967; + loc_echar = 1057}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (51, 6); loc_end = (51, 7); loc_bchar = 971; + loc_echar = 972}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 16; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 4); loc_end = (52, 69); loc_bchar = 988; + loc_echar = 1053}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lasub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = rest.232}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 4); loc_end = (52, 8); loc_bchar = 988; + loc_echar = 992}}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 9); loc_end = (52, 10); + loc_bchar = 993; loc_echar = 994}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))], + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m1.226}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 40); loc_end = (52, 42); + loc_bchar = 1024; loc_echar = 1026}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Psub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m2t.230}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 44); loc_end = (52, 47); + loc_bchar = 1028; loc_echar = 1031}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 48); loc_end = (52, 49); + loc_bchar = 1032; loc_echar = 1033}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Expr.Psub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = rest.232}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 56); loc_end = (52, 60); + loc_bchar = 1040; loc_echar = 1044}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.231}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (52, 61); loc_end = (52, 62); + loc_bchar = 1045; loc_echar = 1046}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 18; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (54, 2); loc_end = (54, 13); loc_bchar = 1060; + loc_echar = 1071}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (54, 2); loc_end = (54, 5); loc_bchar = 1060; + loc_echar = 1063}}, + Jasmin.Expr.AT_none, + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = pres.229}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (54, 8); loc_end = (54, 12); loc_bchar = 1066; + loc_echar = 1070}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 19; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 2); loc_end = (55, 30); loc_bchar = 1074; + loc_echar = 1102}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 2); loc_end = (55, 5); loc_bchar = 1074; + loc_echar = 1077}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = rest.232}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 19); loc_end = (55, 23); loc_bchar = 1091; + loc_echar = 1095}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (55, 25); loc_end = (55, 28); loc_bchar = 1097; + loc_echar = 1100}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.228}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (57, 9); loc_end = (57, 12); loc_bchar = 1113; + loc_echar = 1116}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m.233}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.234}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 13; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (32, 2); loc_end = (37, 3); loc_bchar = 580; + loc_echar = 673}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.235}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (32, 6); loc_end = (32, 7); loc_bchar = 584; + loc_echar = 585}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 12; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (33, 4); loc_end = (36, 5); loc_bchar = 601; + loc_echar = 669}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = j.236}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (33, 8); loc_end = (33, 9); loc_bchar = 605; + loc_echar = 606}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 10; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 6); loc_end = (34, 21); + loc_bchar = 624; loc_echar = 639}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.237}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 6); loc_end = (34, 9); + loc_bchar = 624; loc_echar = 627}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m.233}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 12); loc_end = (34, 13); + loc_bchar = 630; loc_echar = 631}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = j.236}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 14); loc_end = (34, 15); + loc_bchar = 632; loc_echar = 633}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.235}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (34, 16); loc_end = (34, 17); + loc_bchar = 634; loc_echar = 635}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 11; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 6); loc_end = (35, 23); + loc_bchar = 646; loc_echar = 663}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, + Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = res.234}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 6); loc_end = (35, 9); + loc_bchar = 646; loc_echar = 649}}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Oadd Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.235}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 10); loc_end = (35, 11); + loc_bchar = 650; loc_echar = 651}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = j.236}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 12); loc_end = (35, 13); + loc_bchar = 652; loc_echar = 653}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.237}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (35, 19); loc_end = (35, 22); + loc_bchar = 659; loc_echar = 662}}; + gs = Jasmin.Expr.Slocal}))]))]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))))))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = res.234}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (39, 9); loc_end = (39, 12); loc_bchar = 684; + loc_echar = 687}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))))))); + vname = m.238}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v.239}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = res.240}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 9; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (21, 2); loc_end = (24, 3); loc_bchar = 373; + loc_echar = 447}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.241}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (21, 6); loc_end = (21, 7); loc_bchar = 377; + loc_echar = 378}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 7; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 4); loc_end = (22, 35); loc_bchar = 394; + loc_echar = 425}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.242}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 4); loc_end = (22, 7); loc_bchar = 394; + loc_echar = 397}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + [Jasmin.Expr.Psub (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + Jasmin.BinNums.Coq_xH))))))))); + vname = m.238}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 22); loc_end = (22, 23); + loc_bchar = 412; loc_echar = 413}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 (Jasmin.Expr.Omul Jasmin.Expr.Op_int, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.241}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 24); loc_end = (22, 25); + loc_bchar = 414; loc_echar = 415}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v.239}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (22, 32); loc_end = (22, 33); + loc_bchar = 422; loc_echar = 423}}; + gs = Jasmin.Expr.Slocal}])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 8; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 4); loc_end = (23, 17); loc_bchar = 430; + loc_echar = 443}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Laset (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = res.240}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 4); loc_end = (23, 7); loc_bchar = 430; + loc_echar = 433}}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.241}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 8); loc_end = (23, 9); + loc_bchar = 434; loc_echar = 435}}; + gs = Jasmin.Expr.Slocal}), + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.242}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (23, 13); loc_end = (23, 16); + loc_bchar = 439; loc_echar = 442}}; + gs = Jasmin.Expr.Slocal}))]))]; + f_tyout = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = res.240}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (25, 9); loc_end = (25, 12); loc_bchar = 457; + loc_echar = 460}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)); + f_tyin = + [Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v1.243}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v2.244}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (8, 2); loc_end = (8, 10); loc_bchar = 135; + loc_echar = 143}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (8, 2); loc_end = (8, 5); loc_bchar = 135; + loc_echar = 138}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 6; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (9, 2); loc_end = (13, 3); loc_bchar = 146; + loc_echar = 217}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.246}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (9, 6); loc_end = (9, 7); loc_bchar = 150; + loc_echar = 151}}, + ((Jasmin.Expr.UpTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 4); loc_end = (10, 16); loc_bchar = 167; + loc_echar = 179}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 4); loc_end = (10, 7); loc_bchar = 167; + loc_echar = 170}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v1.243}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 10); loc_end = (10, 12); + loc_bchar = 173; loc_echar = 175}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.246}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (10, 13); loc_end = (10, 14); + loc_bchar = 176; loc_echar = 177}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 4); loc_end = (11, 17); loc_bchar = 184; + loc_echar = 197}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 4); loc_end = (11, 7); loc_bchar = 184; + loc_echar = 187}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Omul (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 4); loc_end = (11, 7); loc_bchar = 184; + loc_echar = 187}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pget (Jasmin.Warray_.AAscale, Jasmin.Wsize.U64, + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sarr + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))); + vname = v2.244}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 11); loc_end = (11, 13); + loc_bchar = 191; loc_echar = 193}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; + vname = i.246}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (11, 14); loc_end = (11, 15); + loc_bchar = 194; loc_echar = 195}}; + gs = Jasmin.Expr.Slocal})))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 4); loc_end = (12, 15); loc_bchar = 202; + loc_echar = 213}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 4); loc_end = (12, 7); loc_bchar = 202; + loc_echar = 205}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 4); loc_end = (12, 7); loc_bchar = 202; + loc_echar = 205}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = tmp.247}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (12, 11); loc_end = (12, 14); + loc_bchar = 209; loc_echar = 212}}; + gs = Jasmin.Expr.Slocal})))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res.245}; + v_info = + {Jasmin.Location.loc_fname = "matrix_product.jazz"; + loc_start = (14, 9); loc_end = (14, 12); loc_bchar = 227; + loc_echar = 230}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/matrix_product.jazz b/theories/Jasmin/examples/matrix_product.jazz new file mode 100644 index 00000000..bcf43377 --- /dev/null +++ b/theories/Jasmin/examples/matrix_product.jazz @@ -0,0 +1,79 @@ +param int N = 10; + +fn dot_product (reg ptr u64[N] v1, reg ptr u64[N] v2) -> reg u64 { + reg u64 res; + reg u64 tmp; + inline int i; + + res = 0; + for i = 0 to N { + tmp = v1[i]; + tmp *= v2[i]; + res += tmp; + } + return res; +} + +fn product_matrix_vector (reg ptr u64[N*N] m, reg ptr u64[N] v, reg ptr u64[N] res) -> reg ptr u64[N] { + reg u64 tmp; + inline int i; + + for i = 0 to N { + tmp = dot_product(m[i*N:N], v); + res[i] = tmp; + } + return res; +} + +fn transpose (reg ptr u64[N*N] m, reg ptr u64[N*N] res) -> reg ptr u64[N*N] { + inline int i, j; + reg u64 tmp; + + for i = 0 to N { + for j = 0 to N { + tmp = m[j+i*N]; + res[i+j*N] = tmp; + } + } + + return res; +} + +// m2 and res are transposed +fn product_matrix_matrix (reg ptr u64[N*N] m1, reg ptr u64[N*N] m2, reg ptr u64[N*N] res) -> reg ptr u64[N*N] { + inline int i; + stack u64[N*N] m2t; + stack u64[N*N] rest; + reg ptr u64[N * N] pres; + + pres = res; + m2t = transpose (m2, m2t); + for i = 0 to N { + rest[i*N:N] = product_matrix_vector(m1, m2t[i*N:N], rest[i*N:N]); + } + res = pres; + res = transpose (rest, res); + + return res; +} + +/* Multiplies row-major matrices in memory at adresses x and y and writes the result at adress z. + Regions may overlap. +*/ +export +fn productMM(reg u64 x y z) { + inline int i; + stack u64[N * N] mx my mz; + reg u64 tmp; + for i = 0 to N * N { + tmp = (u64)[x + 8 * i]; + mx[i] = tmp; + tmp = (u64)[y + 8 * i]; + my[i] = tmp; + } + mz = product_matrix_matrix(mx, my, mz); + for i = 0 to N * N { + tmp = mz[i]; + (u64)[z + 8 * i] = tmp; + } +} diff --git a/theories/Jasmin/examples/matrix_product.v b/theories/Jasmin/examples/matrix_product.v new file mode 100644 index 00000000..92c974ef --- /dev/null +++ b/theories/Jasmin/examples/matrix_product.v @@ -0,0 +1,647 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* productMM *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.216" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.217" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "z.218" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO (xI (xO xH))))) + (Pconst (Zpos (xO (xI (xO xH))))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "x.216" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mx.221" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "y.217" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "my.222" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mz.223" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mx.221" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "my.222" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mz.223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO (xI (xO xH))))) + (Pconst (Zpos (xO (xI (xO xH))))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "mz.223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "z.218" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* product_matrix_matrix *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_params := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m1.224" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2.225" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "pres.227" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2t.228" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2.225" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2t.228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall DoNotInline + [Lasub AAscale U64 (xO (xI (xO xH))) + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "rest.230" |} + ; v_info := dummy_var_info |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH))))))] + (xO (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m1.224" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Psub AAscale U64 (xO (xI (xO xH))) + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m2t.228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH))))))); + (Psub AAscale U64 (xO (xI (xO xH))) + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "rest.230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "pres.227" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "rest.230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_res := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.226" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* transpose *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_params := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.231" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.232" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.233" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "j.234" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.235" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.231" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.234" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.233" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.232" |} + ; v_info := dummy_var_info |} + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.233" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.234" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH)))))))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.235" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH))))))))))] + ; f_res := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "res.232" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* product_matrix_vector *) xO (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))); + (sarr (xO (xO (xO (xO (xI (xO xH))))))); + (sarr (xO (xO (xO (xO (xI (xO xH)))))))] + ; f_params := + [{| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.236" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v.237" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "res.238" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.239" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.240" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Psub AAscale U64 (xO (xI (xO xH))) + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xO (xI (xO (xO (xI xH)))))))))) + ; vname := "m.236" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omul Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.239" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO (xI (xO xH))))))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v.237" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "res.238" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.239" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.240" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xO xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "res.238" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* dot_product *) xI (xO xH), + {| f_info := FunInfo.witness + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xO xH))))))); + (sarr (xO (xO (xO (xO (xI (xO xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v1.241" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v2.242" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.244" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xO (xI (xO xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v1.241" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.244" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Omul (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xO xH))))))) + ; vname := "v2.242" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.244" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tmp.245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res.243" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation PRODUCTMM := ( xH ). +Notation PRODUCT_MATRIX_MATRIX := ( xO xH ). +Notation TRANSPOSE := ( xI xH ). +Notation PRODUCT_MATRIX_VECTOR := ( xO (xO xH) ). +Notation DOT_PRODUCT := ( xI (xO xH) ). diff --git a/theories/Jasmin/examples/print_vname.ml b/theories/Jasmin/examples/print_vname.ml new file mode 100644 index 00000000..7e97deef --- /dev/null +++ b/theories/Jasmin/examples/print_vname.ml @@ -0,0 +1,5 @@ +open Format + +let print_vname (fmt : formatter) (t : Obj.t) = + let t = Obj.magic t in + ignore (List.map (pp_print_char fmt) t) diff --git a/theories/Jasmin/examples/retz.cprog b/theories/Jasmin/examples/retz.cprog new file mode 100644 index 00000000..e9030039 --- /dev/null +++ b/theories/Jasmin/examples/retz.cprog @@ -0,0 +1,34 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "retz.jazz"; loc_start = (4, 0); + loc_end = (4, 6); loc_bchar = 41; loc_echar = 47}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.139}; + v_info = + {Jasmin.Location.loc_fname = "retz.jazz"; loc_start = (4, 0); + loc_end = (4, 1); loc_bchar = 41; loc_echar = 42}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0)))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.139}; + v_info = + {Jasmin.Location.loc_fname = "retz.jazz"; loc_start = (5, 7); + loc_end = (5, 8); loc_bchar = 55; loc_echar = 56}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/retz.jazz b/theories/Jasmin/examples/retz.jazz new file mode 100644 index 00000000..ccfb944e --- /dev/null +++ b/theories/Jasmin/examples/retz.jazz @@ -0,0 +1,6 @@ +export +fn zero() -> reg u64 { +reg u64 z; +z = 0; +return z; +} diff --git a/theories/Jasmin/examples/retz.v b/theories/Jasmin/examples/retz.v new file mode 100644 index 00000000..b409b26c --- /dev/null +++ b/theories/Jasmin/examples/retz.v @@ -0,0 +1,48 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* zero *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.137" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "z.137" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation ZERO := ( xH ). diff --git a/theories/Jasmin/examples/sike434/sike434.v b/theories/Jasmin/examples/sike434/sike434.v new file mode 100644 index 00000000..df8bcd72 --- /dev/null +++ b/theories/Jasmin/examples/sike434/sike434.v @@ -0,0 +1,7006 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* __bn_load *) xI (xO xH), + {| f_info := xO (xI (xI (xO (xI (xI xH))))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1377" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1379" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1380" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1377" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1379" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1378" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1379" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1380" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1378" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_store *) xI xH, + {| f_info := xI (xO (xI (xO (xI (xI xH))))) + ; f_tyin := [(sword U64); (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1373" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1374" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1375" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1376" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1374" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1375" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1373" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1375" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1376" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* _bn2_load_ *) xI (xI (xO (xO (xI (xI xH))))), + {| f_info := xO (xO (xI (xO (xI (xI xH))))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1369" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1371" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1372" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1369" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1371" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "x.1370" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1371" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1372" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "x.1370" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn2_store *) xI (xO (xI (xI xH))), + {| f_info := xO (xI (xO (xO (xI (xI xH))))) + ; f_tyin := [(sword U64); (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.1365" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "b.1366" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1367" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH)))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1368" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "b.1366" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1367" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "a.1365" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1367" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1368" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* __bn2_unpack *) xO (xO (xO (xO (xI (xI xH))))), + {| f_info := xI (xO (xO (xO (xI (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1359" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1363" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1359" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t2.1364" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1359" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Oadd Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1361" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1363" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1360" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1362" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t2.1364" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1360" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1361" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_pack2 *) xO (xI (xI (xI (xO (xI xH))))), + {| f_info := xI (xI (xI (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1354" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1355" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "lo.1354" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1356" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "hi.1355" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1356" |} + ; v_info := dummy_var_info |} + (Papp2 (Oadd Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1357" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1358" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1356" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_eq *) xO (xO (xI (xI (xO (xI xH))))), + {| f_info := xI (xO (xI (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1346" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1347" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "are_equal.1349" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1351" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1346" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1351" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olxor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1347" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1351" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1352" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))]); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lvar + {| v_var := {| vtype := sbool + ; vname := "zf.1353" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info (sword U64)] + AT_keep (Oasm (* AND_64 *) (BaseOp (None, (AND U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1350" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "zf.1353" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "are_equal.1349" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res.1348" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_eq *) xO (xI (xO (xI (xO (xI xH))))), + {| f_info := xI (xI (xO (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1343" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1344" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1345" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xI (xO (xI xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1343" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1344" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1345" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_eq_ *) xI (xO (xO (xO (xI xH)))), + {| f_info := xI (xO (xO (xI (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1338" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1339" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1341" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1338" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1342" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1339" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xI (xO (xI xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1341" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1342" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1340" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_test0 *) xO (xI (xI (xI (xO xH)))), + {| f_info := xO (xO (xO (xI (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1332" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "is_zero.1334" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1336" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1332" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1336" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))]); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lvar + {| v_var := {| vtype := sbool + ; vname := "zf.1337" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info (sword U64)] + AT_keep (Oasm (* AND_64 *) (BaseOp (None, (AND U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "acc.1335" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "zf.1337" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "is_zero.1334" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res.1333" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_test0 *) xO (xI (xI (xO (xO (xI xH))))), + {| f_info := xI (xI (xI (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1330" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1331" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1330" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1331" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_copy *) xI (xI (xO (xI (xO (xO xH))))), + {| f_info := xI (xO (xI (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1326" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1328" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1329" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1326" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1328" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1327" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1328" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1329" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1327" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_copy2 *) xI (xO (xO (xI (xI xH)))), + {| f_info := xO (xO (xI (xO (xO (xI xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1322" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1323" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1324" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1325" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1322" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1324" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1323" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1324" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1325" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1323" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_cmov *) xO (xI (xO (xI (xO (xO xH))))), + {| f_info := xI (xI (xO (xO (xO (xI xH))))) + ; f_tyin := + [sbool; (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := {| vtype := sbool + ; vname := "cond.1317" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1319" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cond.1317" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1319" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1320" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1321" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1318" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_set0 *) xI (xO (xO (xO (xO (xI xH))))), + {| f_info := xO (xI (xO (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1314" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1315" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1316" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1314" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1316" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1315" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1314" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_add1c *) xI (xI (xI (xI (xI (xO xH))))), + {| f_info := xO (xO (xO (xO (xO (xI xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH)))))); (sword U64)] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "b.1311" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b.1311" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1313" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1313" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})); + (Papp1 (Oword_of_int U64) (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1312" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1310" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_addc *) xI (xI (xI (xO (xO xH)))), + {| f_info := xO (xI (xI (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1306" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1306" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1309" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1308" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1307" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1305" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_addc *) xO (xO (xI (xI (xI (xO xH))))), + {| f_info := xI (xO (xI (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1303" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1304" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1303" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1304" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1302" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_subc *) xO (xO (xI (xO (xO xH)))), + {| f_info := xI (xI (xO (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1298" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Osubcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1298" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})] + AT_keep (Osubcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1301" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1300" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1299" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1297" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_subc *) xI (xO (xO (xI (xI (xO xH))))), + {| f_info := xO (xI (xO (xI (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1295" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1296" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1295" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := {| vtype := sbool + ; vname := "cf.1296" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1294" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __addacc3 *) xO (xO (xO (xO (xO (xO xH))))), + {| f_info := xO (xO (xO (xI (xI (xO xH))))) + ; f_tyin := + [(sword U64); (sword U64); (sarr (xO (xO (xO (xI xH))))); sint] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "b1.1289" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "b0.1290" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1290" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1289" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1292" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))); + (Papp1 (Oword_of_int U64) (Pconst (Z0))); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1293" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1291" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __muln_innerloop *) xI (xO (xO (xO (xO (xO xH))))), + {| f_info := xI (xI (xI (xO (xI (xO xH))))) + ; f_tyin := + [sint; sint; sint; (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI xH)))))] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "k.1279" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "istart.1280" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "iend.1281" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1282" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1283" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1285" |} + ; v_info := dummy_var_info |}) + ((UpTo, + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "istart.1280" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})), + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "iend.1281" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "j.1286" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1279" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1285" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1282" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1285" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1288" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1283" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.1286" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1288" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1287" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1279" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1284" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_muln *) xI (xO (xO (xO (xO xH)))), + {| f_info := xO (xI (xI (xO (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1276" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0)))]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xH)))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1276" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xO xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pconst (Z0)); + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xI (xI xH))))), + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp2 (Oadd Op_int) + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))); + (Pconst (Zpos (xI (xI xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1272" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1273" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1278" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1275" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1277" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))))) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1274" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_muln *) xO (xO (xI (xO (xI (xO xH))))), + {| f_info := xI (xO (xI (xO (xI (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1269" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1270" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1269" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1270" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1271" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __addacc3x2 *) xO (xI (xO (xO (xI (xO xH))))), + {| f_info := xI (xI (xO (xO (xI (xO xH))))) + ; f_tyin := + [(sword U64); (sword U64); (sarr (xO (xO (xO (xI xH))))); sint] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.1260" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.1261" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.1260" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.1261" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1266" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olsl (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U8) (Pconst (Zpos (xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* SHLD_64 *) (BaseOp (None, (SHLD U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1266" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) (Pconst (Zpos (xH))))]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* MOV_64 *) (BaseOp (None, (MOV U64)))) + [(Papp1 (Oword_of_int U64) (Pconst (Z0)))]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |}] + AT_keep (Oaddcarry (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b0.1265" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pbool false)]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b1.1264" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |}; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))] + AT_keep (Oaddcarry (U64)) + [(Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1263" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Zpos (xI xH))))); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "b2.1268" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1267" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "a.1262" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __sqrn_innerloop *) xO (xO (xO (xO (xI (xO xH))))), + {| f_info := xI (xO (xO (xO (xI (xO xH))))) + ; f_tyin := + [sint; sint; sint; (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI xH)))))] + ; f_params := + [{| v_var := {| vtype := sint + ; vname := "k.1251" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "istart.1252" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := sint + ; vname := "iend.1253" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1254" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1256" |} + ; v_info := dummy_var_info |}) + ((UpTo, + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "istart.1252" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})), + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "iend.1253" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := sint + ; vname := "j.1257" |} + ; v_info := dummy_var_info |}) + AT_inline (sint) + ((Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1251" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1256" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "ti.1258" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1254" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1256" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "tj.1259" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1254" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.1257" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xO (xI (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ti.1258" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "tj.1259" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1251" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI xH)))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1255" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __bn_sqrn *) xO (xI (xI (xI xH))), + {| f_info := xI (xI (xI (xI (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xH)))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xO xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xH)))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xI (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pconst (Z0)); + (Papp2 (Odiv Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xO xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oeq Op_int) + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Z0))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Odiv Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH))))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xI (xI xH))))), + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + [MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xI (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp2 (Oadd Op_int) + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))); + (Papp2 (Odiv Cmp_int) + (Papp2 (Oadd Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xO xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cif + (Papp2 (Oeq Op_int) + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH)))) + (Pconst (Z0))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1245" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Odiv Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xO xH))))))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1248" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])] + []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + []); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1250" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1247" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1249" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))))) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1246" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _bn_sqrn *) xI (xO (xI (xI (xO (xO xH))))), + {| f_info := xO (xI (xI (xI (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1243" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1243" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xO (xI (xI xH)))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1244" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_caddP *) xI (xO (xI (xO (xO (xO xH))))), + {| f_info := xO (xO (xI (xI (xO (xO xH))))) + ; f_tyin := [sbool; (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := {| vtype := sbool + ; vname := "cf.1235" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1237" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xI (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1237" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1239" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1240" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1240" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pif ((sword U64)) + (Papp1 Onot + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1235" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1239" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1240" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1241" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1242" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1238" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1242" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1236" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_cminusP *) xI (xI (xI (xI (xI xH)))), + {| f_info := xI (xO (xO (xI (xO (xO xH))))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1231" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xI (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_tmp.1231" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mpp.1233" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mp.1069" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "_cf.1234" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mpp.1233" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xI (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "_cf.1234" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "tmp.1232" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1230" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_add *) xI (xI (xI (xO (xO (xO xH))))), + {| f_info := xO (xO (xO (xI (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1229" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1229" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1228" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_add *) xO (xI (xO (xI xH))), + {| f_info := xO (xI (xI (xO (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1227" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1227" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1226" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_sub *) xI (xI (xO (xO (xO (xO xH))))), + {| f_info := xO (xO (xI (xO (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1224" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := sbool + ; vname := "cf.1225" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1224" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1225" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1223" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_sub *) xI (xI (xI (xO xH))), + {| f_info := xO (xI (xO (xO (xO (xO xH))))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1222" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1222" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1221" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_rdcn *) xI (xO (xI (xO (xI xH)))), + {| f_info := xO (xI (xI (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xO (xI (xI xH))))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "zero.1213" |} + ; v_info := dummy_var_info |}] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "u0r.1214" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "glob_u0.1067" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "p0.1215" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |} + (Pconst (Z0))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Pconst (Z0))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Pconst (Zpos (xO xH)))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) []); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pconst (Z0)); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "zero.1213" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info (sword U64); + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "u0r.1214" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1220" |} + ; v_info := dummy_var_info |}; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}] + AT_keep (Omulu (U64)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "p0.1215" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t1.1220" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})])]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Zpos (xI (xI xH))))), + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp2 (Oadd Op_int) + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))); + (Pconst (Zpos (xI (xI xH)))); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pp.1217" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xO (xO (xO xH)))))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "zero.1213" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI (xI xH)))))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t0.1219" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "k.1218" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pconst (Zpos (xI xH))))] + AT_keep (Oasm (* set0_64 *) (ExtOp (Oset0 U64))) + [])]); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))) + (Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "a.1211" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))))))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} + (Papp2 (Osub Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pconst (Zpos (xH))))) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := (sarr (xO (xO (xO (xI xH))))) + ; vname := "x.1216" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Papp2 (Omod Cmp_int) + (Papp2 (Osub Op_int) + (Papp2 (Omul Op_int) (Pconst (Zpos (xO xH))) + (Pconst (Zpos (xI (xI xH))))) + (Pconst (Zpos (xH)))) + (Pconst (Zpos (xI xH))))))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1212" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_mul *) xO (xO (xI (xO xH))), + {| f_info := xI (xO (xI (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1206" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1207" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1209" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1206" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1207" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1210" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1208" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_mulU *) xI (xI (xO (xO (xI xH)))), + {| f_info := xO (xO (xI (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1203" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1204" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1203" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1205" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1202" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_sqr *) xI (xO (xO (xO xH))), + {| f_info := xI (xI (xO (xI (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1198" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1200" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1198" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1201" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1199" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_sqrU *) xO (xO (xO (xI (xI xH)))), + {| f_info := xO (xI (xO (xI (xI xH)))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1196" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1197" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1195" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_exp *) xO (xI (xI xH)), + {| f_info := xI (xI (xI (xO (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1181" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1182" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneMp.1186" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneM.1066" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1181" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneMp.1186" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "bb.1187" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1182" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "j.1190" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1189" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "bb.1187" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1191" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1189" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "j.1190" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Pconst (Zpos (xO (xO (xO (xO (xO (xO xH))))))))))); + MkI InstrInfo.witness + (Cwhile NoAlign [] + ((Papp2 (Oneq (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Z0))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "ss.1193" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Copn + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := sbool + ; vname := "cf.1194" |} + ; v_info := dummy_var_info |}; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1191" |} + ; v_info := dummy_var_info |}] + AT_keep + (Oasm (* SHR_64 *) (BaseOp (None, (SHR U64)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1191" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U8) (Pconst (Zpos (xH))))]); + MkI InstrInfo.witness + (Cif + (Pvar + {| gv := {| v_var := + {| vtype := sbool + ; vname := "cf.1194" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |}) + AT_none + ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))] + []); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO (xI (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_x.1184" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "x.1185" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ss.1193" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Osub (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "k.1192" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) + (Pconst (Zpos (xH)))))))])]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "rr.1188" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1183" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* __fp_inv *) xI (xI (xO xH)), + {| f_info := xO (xI (xI (xO (xI xH)))) + ; f_tyin := + [(sarr (xO (xO (xO (xI (xI xH)))))); + (sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1178" |} + ; v_info := dummy_var_info |}; + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2p.1180" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2.1068" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1178" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2p.1180" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1179" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_fromM *) xO (xO xH), + {| f_info := xO (xO (xI (xO (xI xH)))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1175" |} + ; v_info := dummy_var_info |} + (Papp2 (Oadd Op_int) (Pconst (Zpos (xI (xI xH)))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0)))))]); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1176" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pget AAscale U64 + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |} ; gs := Slocal |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Laset AAscale U64 + {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1175" |} + ; v_info := dummy_var_info |} + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1174" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1176" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1177" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_tmp.1175" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}] + (xI (xO (xI (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "tmp.1177" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1173" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* _fp_toM *) xO (xO (xO xH)), + {| f_info := xO (xI (xO (xO (xI xH)))) + ; f_tyin := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_params := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rMp.1172" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rM.1065" |} + ; v_info := dummy_var_info |} ; gs := Sglob |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rMp.1172" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sarr (xO (xO (xO (xI (xI xH))))))] + ; f_res := + [{| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1171" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* bn_eq *) xI (xI (xI (xI (xO xH)))), + {| f_info := xO (xO (xO (xO (xI xH)))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "ap.1164" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1165" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1167" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1164" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1168" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1167" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1169" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1165" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1170" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1169" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1166" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xI xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1168" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1170" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1166" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* bn_test0 *) xO (xO (xI (xI (xO xH)))), + {| f_info := xI (xO (xI (xI (xO xH)))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "ap.1160" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1162" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1160" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1163" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1162" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1163" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.1161" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* bn_copy *) xO (xI (xO (xI (xO xH)))), + {| f_info := xI (xI (xO (xI (xO xH)))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1156" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1157" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1158" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "t.1159" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pload U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1157" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1158" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))))); + MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1156" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1158" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "t.1159" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_set0 *) xO (xO (xO (xI (xO xH)))), + {| f_info := xI (xO (xO (xI (xO xH)))) + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1154" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.1155" |} + ; v_info := dummy_var_info |}) + ((UpTo, (Pconst (Z0))), (Pconst (Zpos (xI (xI xH))))) + [MkI InstrInfo.witness + (Cassgn + (Lmem U64 + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1154" |} + ; v_info := dummy_var_info |} + (Papp1 (Oword_of_int U64) + (Papp2 (Omul Op_int) + (Pconst (Zpos (xO (xO (xO xH))))) + (Pvar + {| gv := {| v_var := + {| vtype := sint + ; vname := "i.1155" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0)))))]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_addn *) xI (xO (xI (xO (xO xH)))), + {| f_info := xO (xI (xI (xO (xO xH)))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1147" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1148" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1149" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1150" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1148" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1152" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1153" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1152" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1153" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1147" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_subn *) xO (xI (xO (xO (xO xH)))), + {| f_info := xI (xI (xO (xO (xO xH)))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1140" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1141" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1142" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1143" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1141" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1145" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1146" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1145" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lnone dummy_var_info sbool; + Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1146" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1140" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1144" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_muln *) xI (xI (xI (xI xH))), + {| f_info := xO (xO (xO (xO (xO xH)))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1131" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1132" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1133" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1134" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1132" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1135" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1134" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1136" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1133" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1137" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1136" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_r.1138" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO (xO xH))))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1135" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1137" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI (xO (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1131" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* bn_sqrn *) xI (xI (xO (xI xH))), + {| f_info := xO (xO (xI (xI xH))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1125" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1126" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1127" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1126" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1128" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1127" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xO (xI (xI xH)))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "_r.1129" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1128" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI (xO (xI (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1125" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xO (xI (xI xH))))))) + ; vname := "r.1130" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_add *) xO (xO (xO (xI xH))), + {| f_info := xI (xO (xO (xI xH))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1118" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1119" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1120" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1121" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1119" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1121" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1123" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1120" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1124" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1123" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |}] + (xO (xI (xO (xI xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1124" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1118" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1122" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_sub *) xI (xO (xI (xO xH))), + {| f_info := xO (xI (xI (xO xH))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1111" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1112" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1113" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1114" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1112" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1114" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1116" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1113" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1117" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1116" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |}] + (xI (xI (xI (xO xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1117" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1111" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1115" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_mul *) xO (xI (xO (xO xH))), + {| f_info := xI (xI (xO (xO xH))) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1102" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1103" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1104" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1105" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1103" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1106" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1105" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1107" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1104" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1108" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1107" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1109" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |}] + (xO (xO (xI (xO xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1106" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1108" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1102" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1110" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_sqr *) xI (xI (xI xH)), + {| f_info := xO (xO (xO (xO xH))) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1096" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1097" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1098" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1097" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1099" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1098" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1100" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |}] + (xI (xO (xO (xO xH)))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1099" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1096" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1101" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_expm_noct *) xO (xO (xI xH)), + {| f_info := xI (xO (xI xH)) + ; f_tyin := [(sword U64); (sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1087" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "bp.1088" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1089" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1090" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1087" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1091" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1090" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1092" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "bp.1088" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1093" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_b.1092" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1094" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |}] + (xO (xI (xI xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1091" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "b.1093" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1089" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1086" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1095" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_inv *) xI (xO (xO xH)), + {| f_info := xO (xI (xO xH)) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1080" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1081" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1082" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1080" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1083" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1082" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_r.1084" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |}] + (xI (xI (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1083" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "_rp.1081" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1079" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "r.1085" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_toM *) xO (xI xH), + {| f_info := xI (xI xH) + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1075" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1076" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1077" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1076" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1077" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |}] + (xO (xO (xO xH))) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1075" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1078" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) + ; ( (* fp_fromM *) xH, + {| f_info := xO xH + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "rp.1071" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "ap.1072" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1073" |} + ; v_info := dummy_var_info |}] + (xI (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "ap.1072" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |}) + AT_none ((sarr (xO (xO (xO (xI (xI xH))))))) + ((Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "_a.1073" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |}] + (xO (xO xH)) + [(Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]); + MkI InstrInfo.witness + (Ccall InlineFun [] (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "rp.1071" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Pvar + {| gv := {| v_var := + {| vtype := + (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "a.1074" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [] + ; f_res := [] + ; f_extra := tt + ; |} ) ] ; + p_globs := [({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_rM.1065" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_oneM.1066" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sword U64) + ; vname := "glob_u0.1067" |}, + (@Gword U64 (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_pm2.1068" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_mp.1069" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _)) + ; ({| vtype := (sarr (xO (xO (xO (xI (xI xH)))))) + ; vname := "glob_p.1070" |}, + (@Garr (xO (xO (xO (xI (xI xH))))) (* TODO: pp_gd *) _))] ; + p_extra := tt |}. + + set rMZ := [48 ; 155 ; 214 ; 220 ; 101 ; 91 ; 229 ; 40 ; 194 ; 152 ; 135 ; 118 ; 103 ; 115 ; 236 ; 172 ; 141 ; 104 ; 17 ; 131 ; 63 ; 151 ; 39 ; 171 ; 11 ; 124 ; 108 ; 141 ; 175 ; 198 ; 92 ; 23 ; 126 ; 52 ; 222 ; 45 ; 191 ; 146 ; 205 ; 171 ; 154 ; 109 ; 104 ; 199 ; 97 ; 106 ; 225 ; 105 ; 42 ; 209 ; 205 ; 155 ; 168 ; 37 ; 0 ; 0]%Z. + set rM := WArray.fill 56 [seq word.mkword U8 i | i <- rMZ]. + destruct rM as [rM|]; [ exact rM | exact (WArray.empty 56) ]. + + set oneMZ := [44 ; 116 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 252 ; 4 ; 244 ; 15 ; 185 ; 212 ; 172 ; 159 ; 85 ; 251 ; 164 ; 1 ; 216 ; 12 ; 65 ; 119 ; 95 ; 84 ; 84 ; 50 ; 233 ; 218 ; 46 ; 189 ; 167 ; 238 ; 236 ; 0 ; 0]%Z. + set oneM := WArray.fill 56 [seq word.mkword U8 i | i <- oneMZ]. + destruct oneM as [oneM|]; [ exact oneM | exact (WArray.empty 56) ]. + + set u0 := (word.mkword U64 1 : u64). + exact u0. + + set pm2Z := [253 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 226 ; 122 ; 118 ; 193 ; 253 ; 163 ; 174 ; 88 ; 49 ; 120 ; 92 ; 198 ; 123 ; 86 ; 32 ; 197 ; 129 ; 214 ; 95 ; 252 ; 108 ; 68 ; 115 ; 23 ; 39 ; 31 ; 52 ; 2 ; 0]%Z. + set pm2 := WArray.fill 56 [seq word.mkword U8 i | i <- pm2Z]. + destruct pm2 as [pm2|]; [ exact pm2 | exact (WArray.empty 56) ]. + + set mpZ := [ (Zpos 1) (* FIXME: 1 *) ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 0 ; 29 ; 133 ; 137 ; 62 ; 2 ; 92 ; 81 ; 167 ; 206 ; 135 ; 163 ; 57 ; 132 ; 169 ; 223 ; 58 ; 126 ; 41 ; 160 ; 3 ; 147 ; 187 ; 140 ; 232 ; 216 ; 224 ; 203 ; 253 ; 255]%Z. + set mp := WArray.fill 56 [seq word.mkword U8 i | i <- mpZ]. + destruct mp as [mp|]; [ exact mp | exact (WArray.empty 56) ]. + + + set pZ := [255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 255 ; 226 ; 122 ; 118 ; 193 ; 253 ; 163 ; 174 ; 88 ; 49 ; 120 ; 92 ; 198 ; 123 ; 86 ; 32 ; 197 ; 129 ; 214 ; 95 ; 252 ; 108 ; 68 ; 115 ; 23 ; 39 ; 31 ; 52 ; 2 ; 0]%Z. + set p := WArray.fill 56 [seq word.mkword U8 i | i <- pZ]. + destruct p as [p|]; [ exact p | exact (WArray.empty 56) ]. +Defined. diff --git a/theories/Jasmin/examples/test_for.cprog b/theories/Jasmin/examples/test_for.cprog new file mode 100644 index 00000000..63ac79cb --- /dev/null +++ b/theories/Jasmin/examples/test_for.cprog @@ -0,0 +1,90 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (5, 0); loc_end = (5, 6); loc_bchar = 52; + loc_echar = 58}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (5, 0); loc_end = (5, 1); loc_bchar = 52; + loc_echar = 53}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (6, 0); loc_end = (8, 1); loc_bchar = 59; + loc_echar = 89}; + stack_loc = []}, + []), + Jasmin.Expr.Cfor + ({Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sint; vname = i.142}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (6, 4); loc_end = (6, 5); loc_bchar = 63; + loc_echar = 64}}, + ((Jasmin.Expr.DownTo, Jasmin.Expr.Pconst Jasmin.BinNums.Z0), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))), + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (7, 0); loc_end = (7, 7); loc_bchar = 80; + loc_echar = 87}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (7, 0); loc_end = (7, 1); loc_bchar = 80; + loc_echar = 81}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; + loc_start = (7, 0); loc_end = (7, 1); loc_bchar = 80; + loc_echar = 81}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.141}; + v_info = + {Jasmin.Location.loc_fname = "test_for.jazz"; loc_start = (9, 7); + loc_end = (9, 8); loc_bchar = 97; loc_echar = 98}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/test_for.jazz b/theories/Jasmin/examples/test_for.jazz new file mode 100644 index 00000000..6ab80164 --- /dev/null +++ b/theories/Jasmin/examples/test_for.jazz @@ -0,0 +1,10 @@ +export +fn f() -> reg u64 { +reg u64 r; +inline int i; +r = 0; +for i = 3 downto 0 { +r += 1; +} +return r; +} diff --git a/theories/Jasmin/examples/test_for.v b/theories/Jasmin/examples/test_for.v new file mode 100644 index 00000000..0d35149c --- /dev/null +++ b/theories/Jasmin/examples/test_for.v @@ -0,0 +1,69 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) (Pconst (Z0))))); + MkI InstrInfo.witness + (Cfor + ({| v_var := {| vtype := sint + ; vname := "i.140" |} + ; v_info := dummy_var_info |}) + ((DownTo, (Pconst (Z0))), (Pconst (Zpos (xI xH)))) + [MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH)))))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.139" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). diff --git a/theories/Jasmin/examples/test_inline_var.cprog b/theories/Jasmin/examples/test_inline_var.cprog new file mode 100644 index 00000000..8e149b9d --- /dev/null +++ b/theories/Jasmin/examples/test_inline_var.cprog @@ -0,0 +1,286 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r1.150}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (10, 0); loc_end = (10, 7); loc_bchar = 149; + loc_echar = 156}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (10, 0); loc_end = (10, 1); loc_bchar = 149; + loc_echar = 150}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r1.150}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (10, 4); loc_end = (10, 6); loc_bchar = 153; + loc_echar = 155}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (11, 0); loc_end = (11, 16); loc_bchar = 157; + loc_echar = 173}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (11, 0); loc_end = (11, 1); loc_bchar = 157; + loc_echar = 158}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (11, 10); loc_end = (11, 11); loc_bchar = 167; + loc_echar = 168}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH))))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 6; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (12, 0); loc_end = (12, 16); loc_bchar = 174; + loc_echar = 190}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (12, 0); loc_end = (12, 1); loc_bchar = 174; + loc_echar = 175}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (12, 10); loc_end = (12, 11); loc_bchar = 184; + loc_echar = 185}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH)))])); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 7; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (13, 0); loc_end = (13, 16); loc_bchar = 191; + loc_echar = 207}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (13, 0); loc_end = (13, 1); loc_bchar = 191; + loc_echar = 192}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (13, 10); loc_end = (13, 11); loc_bchar = 201; + loc_echar = 202}}; + gs = Jasmin.Expr.Slocal}; + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.151}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (14, 7); loc_end = (14, 8); loc_bchar = 215; + loc_echar = 216}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 2); loc_end = (3, 12); loc_bchar = 56; + loc_echar = 66}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 2); loc_end = (3, 3); loc_bchar = 56; + loc_echar = 57}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 6); loc_end = (3, 7); loc_bchar = 60; + loc_echar = 61}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (3, 10); loc_end = (3, 11); loc_bchar = 64; + loc_echar = 65}}; + gs = Jasmin.Expr.Slocal}))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 2); loc_end = (4, 18); loc_bchar = 69; + loc_echar = 85}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 2); loc_end = (4, 3); loc_bchar = 69; + loc_echar = 70}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 6); loc_end = (4, 7); loc_bchar = 73; + loc_echar = 74}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 11); loc_end = (4, 12); loc_bchar = 78; + loc_echar = 79}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.153}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (4, 15); loc_end = (4, 16); loc_bchar = 82; + loc_echar = 83}}; + gs = Jasmin.Expr.Slocal}))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.152}; + v_info = + {Jasmin.Location.loc_fname = "test_inline_var.jazz"; + loc_start = (5, 9); loc_end = (5, 10); loc_bchar = 95; + loc_echar = 96}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/test_inline_var.jazz b/theories/Jasmin/examples/test_inline_var.jazz new file mode 100644 index 00000000..c07f94b8 --- /dev/null +++ b/theories/Jasmin/examples/test_inline_var.jazz @@ -0,0 +1,15 @@ +inline +fn addn (reg u64 r, inline u64 n) -> reg u64 { + r = r + n; + r = r + (n + n); + return r; +} + +export fn f(reg u64 r1) -> reg u64 { +reg u64 r; +r = r1; +r = addn(r, 6); +r = addn(r, 3); +r = addn(r, 5); +return r; +} diff --git a/theories/Jasmin/examples/test_inline_var.v b/theories/Jasmin/examples/test_inline_var.v new file mode 100644 index 00000000..eb224e99 --- /dev/null +++ b/theories/Jasmin/examples/test_inline_var.v @@ -0,0 +1,155 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "r1.148" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r1.148" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xO (xI xH)))))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xI xH))))]); + MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}); + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xI (xO xH)))))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.149" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* addn *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.151" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.150" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation ADDN := ( xO xH ). diff --git a/theories/Jasmin/examples/test_shift.cprog b/theories/Jasmin/examples/test_shift.cprog new file mode 100644 index 00000000..d9e8c511 --- /dev/null +++ b/theories/Jasmin/examples/test_shift.cprog @@ -0,0 +1,53 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = a.142}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "test_shift.jazz"; + loc_start = (6, 2); loc_end = (6, 23); loc_bchar = 78; + loc_echar = 99}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = u.143}; + v_info = + {Jasmin.Location.loc_fname = "test_shift.jazz"; + loc_start = (6, 2); loc_end = (6, 3); loc_bchar = 78; + loc_echar = 79}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Osub Jasmin.Expr.Op_int, + Jasmin.Expr.Papp2 (Jasmin.Expr.Olsl Jasmin.Expr.Op_int, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH), + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))), + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = u.143}; + v_info = + {Jasmin.Location.loc_fname = "test_shift.jazz"; + loc_start = (7, 9); loc_end = (7, 10); loc_bchar = 109; + loc_echar = 110}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/test_shift.jazz b/theories/Jasmin/examples/test_shift.jazz new file mode 100644 index 00000000..8eb53c35 --- /dev/null +++ b/theories/Jasmin/examples/test_shift.jazz @@ -0,0 +1,9 @@ +param int rlog = 18; + +export fn reduce(reg u64 a) -> reg u64 +{ + reg u64 u; + u = (1 << rlog) - 1 ; + return u; +} + diff --git a/theories/Jasmin/examples/test_shift.v b/theories/Jasmin/examples/test_shift.v new file mode 100644 index 00000000..9c264cd8 --- /dev/null +++ b/theories/Jasmin/examples/test_shift.v @@ -0,0 +1,55 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* reduce *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "a.140" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "u.141" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp1 (Oword_of_int U64) + (Papp2 (Osub Op_int) + (Papp2 (Olsl Op_int) (Pconst (Zpos (xH))) + (Pconst (Zpos (xO (xI (xO (xO xH))))))) + (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "u.141" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation REDUCE := ( xH ). diff --git a/theories/Jasmin/examples/three_functions.cprog b/theories/Jasmin/examples/three_functions.cprog new file mode 100644 index 00000000..1c863b6a --- /dev/null +++ b/theories/Jasmin/examples/three_functions.cprog @@ -0,0 +1,202 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 4; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (15, 2); loc_end = (15, 10); loc_bchar = 212; + loc_echar = 220}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (15, 2); loc_end = (15, 3); loc_bchar = 212; + loc_echar = 213}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (15, 2); loc_end = (15, 3); loc_bchar = 212; + loc_echar = 213}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO + (Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH)))))))))); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 5; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (16, 2); loc_end = (16, 15); loc_bchar = 223; + loc_echar = 236}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_z.160}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (16, 2); loc_end = (16, 7); loc_bchar = 223; + loc_echar = 228}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = z.159}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (16, 12); loc_end = (16, 13); loc_bchar = 233; + loc_echar = 234}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_z.160}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (17, 9); loc_end = (17, 14); loc_bchar = 246; + loc_echar = 251}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.161}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 15); loc_bchar = 130; + loc_echar = 143}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.162}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 7); loc_bchar = 130; + loc_echar = 135}}], + Jasmin.BinNums.Coq_xI + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.161}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (9, 12); loc_end = (9, 13); loc_bchar = 140; + loc_echar = 141}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.162}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (10, 9); loc_end = (10, 14); loc_bchar = 153; + loc_echar = 158}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH), + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.163}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 14); loc_bchar = 49; + loc_echar = 61}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.164}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 7); loc_bchar = 49; + loc_echar = 54}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.163}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (3, 10); loc_end = (3, 11); loc_bchar = 57; + loc_echar = 58}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.164}; + v_info = + {Jasmin.Location.loc_fname = "three_functions.jazz"; + loc_start = (4, 9); loc_end = (4, 14); loc_bchar = 71; + loc_echar = 76}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/three_functions.jazz b/theories/Jasmin/examples/three_functions.jazz new file mode 100644 index 00000000..f2fe9611 --- /dev/null +++ b/theories/Jasmin/examples/three_functions.jazz @@ -0,0 +1,18 @@ +fn f (reg u64 x) -> reg u64 { + reg u64 res_x; + res_x = x+1; + return res_x; +} + +fn g (reg u64 y) -> reg u64 { + reg u64 res_y; + res_y = f(y); + return res_y; +} + +fn h (reg u64 z) -> reg u64 { + reg u64 res_z; + z += 42; + res_z = g(z); + return res_z; +} diff --git a/theories/Jasmin/examples/three_functions.v b/theories/Jasmin/examples/three_functions.v new file mode 100644 index 00000000..a999793e --- /dev/null +++ b/theories/Jasmin/examples/three_functions.v @@ -0,0 +1,131 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* h *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) + (Pconst (Zpos (xO (xI (xO (xI (xO xH))))))))))); + MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_z.158" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "z.157" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_z.158" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* g *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.159" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_y.160" |} + ; v_info := dummy_var_info |}] + (xI xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.159" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_y.160" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* f *) xI xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.161" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_x.162" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.161" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_x.162" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation H := ( xH ). +Notation G := ( xO xH ). +Notation F := ( xI xH ). diff --git a/theories/Jasmin/examples/two_functions.cprog b/theories/Jasmin/examples/two_functions.cprog new file mode 100644 index 00000000..4188c0fc --- /dev/null +++ b/theories/Jasmin/examples/two_functions.cprog @@ -0,0 +1,109 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 15); loc_bchar = 130; + loc_echar = 143}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.DoNotInline, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.151}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (9, 2); loc_end = (9, 7); loc_bchar = 130; + loc_echar = 135}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.150}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (9, 12); loc_end = (9, 13); loc_bchar = 140; + loc_echar = 141}}; + gs = Jasmin.Expr.Slocal}]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_y.151}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (10, 9); loc_end = (10, 14); loc_bchar = 153; + loc_echar = 158}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.152}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 14); loc_bchar = 49; + loc_echar = 61}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.153}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (3, 2); loc_end = (3, 7); loc_bchar = 49; + loc_echar = 54}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.152}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (3, 10); loc_end = (3, 11); loc_bchar = 57; + loc_echar = 58}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst (Jasmin.BinNums.Zpos Jasmin.BinNums.Coq_xH)))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = res_x.153}; + v_info = + {Jasmin.Location.loc_fname = "two_functions.jazz"; + loc_start = (4, 9); loc_end = (4, 14); loc_bchar = 71; + loc_echar = 76}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/two_functions.jazz b/theories/Jasmin/examples/two_functions.jazz new file mode 100644 index 00000000..52a08250 --- /dev/null +++ b/theories/Jasmin/examples/two_functions.jazz @@ -0,0 +1,11 @@ +fn f (reg u64 x) -> reg u64 { + reg u64 res_x; + res_x = x+1; + return res_x; +} + +fn g (reg u64 y) -> reg u64 { + reg u64 res_y; + res_y = f(y); + return res_y; +} \ No newline at end of file diff --git a/theories/Jasmin/examples/two_functions.v b/theories/Jasmin/examples/two_functions.v new file mode 100644 index 00000000..70a88c48 --- /dev/null +++ b/theories/Jasmin/examples/two_functions.v @@ -0,0 +1,87 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* g *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Ccall DoNotInline + [Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_y.149" |} + ; v_info := dummy_var_info |}] + (xO xH) + [(Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.148" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_y.149" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* f *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.150" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := + {| vtype := (sword U64) + ; vname := "res_x.151" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.150" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "res_x.151" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation G := ( xH ). +Notation F := ( xO xH ). diff --git a/theories/Jasmin/examples/u64_incr.cprog b/theories/Jasmin/examples/u64_incr.cprog new file mode 100644 index 00000000..67d68965 --- /dev/null +++ b/theories/Jasmin/examples/u64_incr.cprog @@ -0,0 +1,93 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = []; f_params = []; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (9, 2); loc_end = (9, 14); loc_bchar = 128; + loc_echar = 140}; + stack_loc = []}, + []), + Jasmin.Expr.Ccall (Jasmin.Expr.InlineFun, + [Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.148}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (9, 2); loc_end = (9, 3); loc_bchar = 128; + loc_echar = 129}}], + Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + [Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst Jasmin.BinNums.Z0)]))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.148}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; loc_start = (10, 9); + loc_end = (10, 10); loc_bchar = 150; loc_echar = 151}}]; + f_extra = ()}); + (Jasmin.BinNums.Coq_xI Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = + Jasmin.BinNums.Coq_xO (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH); + f_tyin = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.149}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 13); loc_bchar = 56; + loc_echar = 66}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.150}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (3, 3); loc_end = (3, 4); loc_bchar = 56; + loc_echar = 57}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 + (Jasmin.Expr.Oadd (Jasmin.Expr.Op_w Jasmin.Wsize.U64), + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = n.149}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; + loc_start = (3, 8); loc_end = (3, 9); loc_bchar = 61; + loc_echar = 62}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Papp1 (Jasmin.Expr.Oword_of_int Jasmin.Wsize.U64, + Jasmin.Expr.Pconst + (Jasmin.BinNums.Zpos + (Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH))))))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = m.150}; + v_info = + {Jasmin.Location.loc_fname = "u64_incr.jazz"; loc_start = (4, 10); + loc_end = (4, 11); loc_bchar = 77; loc_echar = 78}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/u64_incr.jazz b/theories/Jasmin/examples/u64_incr.jazz new file mode 100644 index 00000000..2492336e --- /dev/null +++ b/theories/Jasmin/examples/u64_incr.jazz @@ -0,0 +1,11 @@ +inline fn incr(reg u64 n) -> reg u64 { + reg u64 m; + m = (n+2); + return m; + } + +export fn f() -> reg u64 { + reg u64 x; + x = incr(0); + return x; + } \ No newline at end of file diff --git a/theories/Jasmin/examples/u64_incr.v b/theories/Jasmin/examples/u64_incr.v new file mode 100644 index 00000000..93eab74f --- /dev/null +++ b/theories/Jasmin/examples/u64_incr.v @@ -0,0 +1,77 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* f *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [] + ; f_params := [] + ; f_body := + [ MkI InstrInfo.witness + (Ccall InlineFun + [Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "x.146" |} + ; v_info := dummy_var_info |}] + (xO xH) [(Papp1 (Oword_of_int U64) (Pconst (Z0)))]) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.146" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) + ; ( (* incr *) xO xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "n.147" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "m.148" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Oadd (Op_w U64)) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "n.147" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Papp1 (Oword_of_int U64) (Pconst (Zpos (xO xH))))))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "m.148" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation F := ( xH ). +Notation INCR := ( xO xH ). diff --git a/theories/Jasmin/examples/xor.cprog b/theories/Jasmin/examples/xor.cprog new file mode 100644 index 00000000..b1351cdf --- /dev/null +++ b/theories/Jasmin/examples/xor.cprog @@ -0,0 +1,95 @@ + {Jasmin.Expr.p_funcs = + [(Jasmin.BinNums.Coq_xH, + {Jasmin.Expr.f_info = Jasmin.BinNums.Coq_xO Jasmin.BinNums.Coq_xH; + f_tyin = + [Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_params = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.143}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}; + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.144}; + v_info = + {Jasmin.Location.loc_fname = ""; loc_start = (-1, -1); + loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1}}]; + f_body = + [Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 2; + base_loc = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (3, 2); + loc_end = (3, 8); loc_bchar = 64; loc_echar = 70}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (3, 2); + loc_end = (3, 3); loc_bchar = 64; loc_echar = 65}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = x.143}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (3, 6); + loc_end = (3, 7); loc_bchar = 68; loc_echar = 69}}; + gs = Jasmin.Expr.Slocal})); + Jasmin.Expr.MkI + (({Jasmin.Location.uid_loc = 3; + base_loc = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 2); + loc_end = (4, 9); loc_bchar = 73; loc_echar = 80}; + stack_loc = []}, + []), + Jasmin.Expr.Cassgn + (Jasmin.Expr.Lvar + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 2); + loc_end = (4, 3); loc_bchar = 73; loc_echar = 74}}, + Jasmin.Expr.AT_none, Jasmin.Type.Coq_sword Jasmin.Wsize.U64, + Jasmin.Expr.Papp2 (Jasmin.Expr.Olxor Jasmin.Wsize.U64, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 2); + loc_end = (4, 3); loc_bchar = 73; loc_echar = 74}}; + gs = Jasmin.Expr.Slocal}, + Jasmin.Expr.Pvar + {Jasmin.Expr.gv = + {Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = + Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = y.144}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (4, 7); + loc_end = (4, 8); loc_bchar = 78; loc_echar = 79}}; + gs = Jasmin.Expr.Slocal})))]; + f_tyout = [Jasmin.Type.Coq_sword Jasmin.Wsize.U64]; + f_res = + [{Jasmin.Expr.v_var = + {Jasmin.Var0.Var.vtype = Jasmin.Type.Coq_sword Jasmin.Wsize.U64; + vname = r.145}; + v_info = + {Jasmin.Location.loc_fname = "xor.jazz"; loc_start = (5, 9); + loc_end = (5, 10); loc_bchar = 90; loc_echar = 91}}]; + f_extra = ()})]; + p_globs = []; p_extra = ()} diff --git a/theories/Jasmin/examples/xor.jazz b/theories/Jasmin/examples/xor.jazz new file mode 100644 index 00000000..c7b9a8ce --- /dev/null +++ b/theories/Jasmin/examples/xor.jazz @@ -0,0 +1,6 @@ +export fn xor(reg u64 x, reg u64 y) -> reg u64 { + reg u64 r; + r = x; + r ^= y; + return r; +} diff --git a/theories/Jasmin/examples/xor.v b/theories/Jasmin/examples/xor.v new file mode 100644 index 00000000..acd8bd93 --- /dev/null +++ b/theories/Jasmin/examples/xor.v @@ -0,0 +1,76 @@ +Set Warnings "-notation-overridden,-ambiguous-paths". +From mathcomp Require Import all_ssreflect all_algebra reals distr realsum + fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool + ssrnum eqtype choice seq. +Set Warnings "notation-overridden,ambiguous-paths". + +Require Import List. +Set Warnings "-notation-overridden". +From Jasmin Require Import expr. +Set Warnings "notation-overridden". +From Jasmin Require Import x86_instr_decl x86_extra. +From SSProve.Jasmin Require Import jasmin_translate. +From SSProve.Crypt Require Import Prelude Package. + +Import ListNotations. +Local Open Scope string. + + + + +Definition ssprove_jasmin_prog : uprog. +Proof. + refine {| p_funcs := + [ ( (* xor *) xH, + {| f_info := FunInfo.witness + ; f_tyin := [(sword U64); (sword U64)] + ; f_params := + [{| v_var := {| vtype := (sword U64) + ; vname := "x.141" |} + ; v_info := dummy_var_info |}; + {| v_var := {| vtype := (sword U64) + ; vname := "y.142" |} + ; v_info := dummy_var_info |}] + ; f_body := + [ MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "x.141" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}))); + MkI InstrInfo.witness + (Cassgn + (Lvar + {| v_var := {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |}) + AT_none ((sword U64)) + ((Papp2 (Olxor U64) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |} ; gs := Slocal |}) + (Pvar + {| gv := {| v_var := + {| vtype := (sword U64) + ; vname := "y.142" |} + ; v_info := dummy_var_info |} ; gs := Slocal |})))) ] + ; f_tyout := [(sword U64)] + ; f_res := + [{| v_var := {| vtype := (sword U64) + ; vname := "r.143" |} + ; v_info := dummy_var_info |}] + ; f_extra := tt + ; |} ) ] ; + p_globs := [] ; + p_extra := tt |}. + +Defined. +Notation XOR := ( xH ). diff --git a/theories/Jasmin/jasmin_asm.v b/theories/Jasmin/jasmin_asm.v new file mode 100644 index 00000000..2f36afb4 --- /dev/null +++ b/theories/Jasmin/jasmin_asm.v @@ -0,0 +1,79 @@ +(* From mathcomp Require Import all_ssreflect all_algebra. *) + +(* From Jasmin Require Import *) +(* arch_params_proof *) +(* compiler *) +(* compiler_proof. *) + +(* From Jasmin Require Import *) +(* arch_decl *) +(* arch_extra *) +(* arch_sem *) +(* asm_gen_proof. *) + +(* From Jasmin Require Import sem. *) + +(* From SSProve.Jasmin Require Import jasmin_translate. *) +(* From SSProve.Crypt Require Import Prelude Package. *) + +(* Import PackageNotation. *) +(* Import JasminNotation. *) +(* Import Utf8. *) + +(* Local Open Scope positive. *) + +(* Set Implicit Arguments. *) +(* Unset Strict Implicit. *) +(* Unset Printing Implicit Defensive. *) + +(* Section __. *) + +(* Context *) +(* {syscall_state : Type} {sc_sem : syscall.syscall_sem syscall_state} {gf : glob_decls} *) +(* `{asm_e : asm_extra} {call_conv : calling_convention} {asm_scsem : asm_syscall_sem} *) +(* {fresh_vars lowering_options : Type} *) +(* (aparams : architecture_params fresh_vars lowering_options) *) +(* (haparams : h_architecture_params aparams) *) +(* (cparams : compiler_params fresh_vars lowering_options). *) + +(* Hypothesis print_uprogP : forall s p, cparams.(print_uprog) s p = p. *) +(* Hypothesis print_sprogP : forall s p, cparams.(print_sprog) s p = p. *) +(* Hypothesis print_linearP : forall s p, cparams.(print_linear) s p = p. *) + +(* Context `(asm_correct : ∀ o, sem_correct (tin (get_instr_desc (Oasm o))) (sopn_sem (Oasm o))). *) + +(* Theorem equiv_to_asm subroutine p xp entries scs vm m fn scs' m' va vr xm m_id s_id s_st st : *) +(* compile_prog_to_asm aparams cparams entries subroutine p = ok xp *) +(* -> fn \in entries *) +(* -> sem.sem_call p scs m fn va scs' m' vr *) +(* -> handled_program p *) +(* -> mem_agreement m (asm_mem xm) (asm_rip xm) (asm_globs xp) *) +(* -> enough_stack_space xp fn (top_stack m) (asm_mem xm) *) +(* -> ⊢ ⦃ rel_estate (sem.Estate scs m vm) m_id s_id s_st st ⦄ *) +(* get_translated_fun p fn s_id~1 [seq totce (translate_value v) | v <- va] *) +(* ⇓ [seq totce (translate_value v) | v <- vr] *) +(* ⦃ rel_estate (sem.Estate scs' m' vm) m_id s_id~0 s_st st ⦄ *) +(* /\ exists xd : asm_fundef, *) +(* get_fundef (asm_funcs xp) fn = Some xd *) +(* /\ forall args', *) +(* asm_scs xm = scs *) +(* -> asm_reg xm ad_rsp = top_stack m *) +(* -> get_typed_reg_values xm (asm_fd_arg xd) = ok args' *) +(* -> List.Forall2 value_uincl va args' *) +(* -> exists xm' res', *) +(* get_typed_reg_values xm' (asm_fd_res xd) = ok res' *) +(* /\ List.Forall2 value_uincl vr res'. *) +(* Proof. *) +(* intros cmp fn_in sc hp mem ss. *) +(* split. *) +(* unshelve eapply translate_prog_correct; try eauto. *) +(* unshelve epose proof compile_prog_to_asmP haparams _ _ _ cmp fn_in sc mem ss as [xd [get_fd _ cmp_correct]]; eauto. *) +(* exists xd. split; eauto. *) +(* intros args'. *) +(* specialize (cmp_correct args'). *) +(* intros asm_scs asm_reg reg_args' args'_va. *) +(* specialize (cmp_correct asm_scs asm_reg reg_args' args'_va) as [xm' [res' []]]. *) +(* exists xm', res'; eauto. *) +(* Qed. *) + +(* End __. *) diff --git a/theories/Jasmin/jasmin_translate.v b/theories/Jasmin/jasmin_translate.v new file mode 100644 index 00000000..062e98df --- /dev/null +++ b/theories/Jasmin/jasmin_translate.v @@ -0,0 +1,5409 @@ +Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word word_ssrZ. +From Jasmin Require Import expr compiler_util values sem_params flag_combination sem_op_typed sopn low_memory psem_of_sem_proof varmap psem. +(* From Jasmin Require Import sem_one_varmap. *) +(* From Jasmin Require Import sem_one_varmap_facts. *) +(* From Jasmin Require Import sem_op_typed sem_params sem_params_of_arch_extra sem_type. *) +Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". + +From extructures Require Import ord fset fmap. +Set Warnings "-ambiguous-paths". +(* Silencing the following warning: *) +(* New coercion path [Pbool] : bool >-> pexpr is ambiguous with existing *) +(* [nat_of_bool; Posz; int_to_Z; Pconst] : bool >-> pexpr. *) +From Jasmin Require Import expr_facts. +Set Warnings "ambiguous-paths". + +From Coq Require Import Utf8. + +From SSProve.Crypt Require Import Prelude Package. +Import PackageNotation. + +From Equations Require Import Equations. +Set Equations With UIP. +Set Equations Transparent. + +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. +Set Default Proof Using "Type". + +Derive NoConfusion for result. +Derive NoConfusion for value. +Derive NoConfusion for wsize. +(* Derive NoConfusion for (word wsize). *) +Derive EqDec for wsize. + +Local Open Scope positive_scope. + +Notation p_id := BinNums.positive. + +Lemma nat_of_pos_nonzero : + ∀ p, + nat_of_pos p ≠ 0%nat. +Proof. + intros p. induction p as [p ih | p ih |]. + - simpl. micromega.Lia.lia. + - simpl. rewrite NatTrec.doubleE. + move => /eqP. rewrite double_eq0. move /eqP. assumption. + - simpl. micromega.Lia.lia. +Qed. + +Lemma injective_nat_of_pos : + forall p1 p2, nat_of_pos p1 = nat_of_pos p2 -> p1 = p2. +Proof. + intros p1. induction p1 as [p1 ih | p1 ih |]; intros. + - destruct p2. + + inversion H. + f_equal. apply ih. + apply double_inj. + rewrite -!NatTrec.doubleE. + assumption. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + + inversion H. + move: H1 => /eqP. + rewrite NatTrec.doubleE double_eq0 => /eqP H1. + apply nat_of_pos_nonzero in H1 as []. + - destruct p2. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + + inversion H. + f_equal. apply ih. + apply double_inj. + rewrite -!NatTrec.doubleE. + assumption. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + - destruct p2. + + inversion H. + move: H1 => /eqP. + rewrite eq_sym NatTrec.doubleE double_eq0 => /eqP H1. + apply nat_of_pos_nonzero in H1 as []. + + inversion H. + rewrite !NatTrec.doubleE in H1. + apply f_equal with (f:=odd) in H1. + simpl in H1. + rewrite !odd_double in H1. + easy. + + reflexivity. +Qed. + +Definition nat_of_p_id : p_id -> nat := nat_of_pos. +Definition nat_of_p_id_nonzero : forall p, nat_of_p_id p <> 0%nat := nat_of_pos_nonzero. +Definition nat_of_p_id_injective : injective nat_of_p_id := injective_nat_of_pos. + +Inductive preceq : p_id -> p_id -> Prop := +| preceqEq : forall i, preceq i i +| preceqI : forall i1 i2, preceq i1 i2 -> preceq i1 i2~1 +| preceqO : forall i1 i2, preceq i1 i2 -> preceq i1 i2~0. +Infix "⪯" := preceq (at level 70). + +Definition prec i1 i2 := i1 ⪯ i2 /\ i1 <> i2. +Infix "≺" := prec (at level 70). + +#[export] Instance preceq_trans : Transitive preceq. +Proof. + intros i1 i2 i3 hi1 hi2. + induction hi2. + - assumption. + - constructor. + apply IHhi2. + assumption. + - constructor. + apply IHhi2. + assumption. +Qed. + +#[export] Instance preceq_refl : Reflexive preceq. +Proof. + intros i. induction i; constructor; assumption. +Qed. + +Lemma preceq_size : + forall i j, i ⪯ j -> Pos.size i <= Pos.size j. +Proof. + intros i j h. + induction h. + - reflexivity. + - simpl; micromega.Lia.lia. + - simpl; micromega.Lia.lia. +Qed. + +Lemma preceq_I : + forall i, i ⪯ i~1. +Proof. + intros. constructor. reflexivity. +Qed. + +Lemma preceq_O : + forall i, i ⪯ i~0. +Proof. + intros. constructor. reflexivity. +Qed. + +Lemma xO_neq : + forall i, i~0 <> i. +Proof. + induction i; congruence. +Qed. + +Lemma xI_neq : + forall i, i~1 <> i. +Proof. + induction i; congruence. +Qed. + +Lemma precneq_O : + forall i, ~ i~0 ⪯ i. +Proof. + intros i contra. + apply preceq_size in contra. + simpl in contra. + micromega.Lia.lia. +Qed. + +Lemma precneq_I : + forall i, ~ i~1 ⪯ i. +Proof. + intros i contra. + apply preceq_size in contra. + simpl in contra. + micromega.Lia.lia. +Qed. + +Lemma size_1 : + forall i, Pos.size i = 1 -> i = 1. +Proof. + intros i h. + induction i. + - simpl in *. + micromega.Lia.lia. + - simpl in *. + micromega.Lia.lia. + - reflexivity. +Qed. + +Lemma preceq_size_eq_eq : + forall i j, Pos.size i = Pos.size j -> i ⪯ j -> i = j. +Proof. + intros i j; revert i; induction j; intros i hsize hprec. + - simpl in *. + inversion hprec; subst. + + reflexivity. + + destruct i. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + etransitivity. + 1: eapply preceq_I. + assumption. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + 1: apply precneq_O in H1; easy. + etransitivity. + 1: eapply preceq_O. + assumption. + * simpl in hsize. + micromega.Lia.lia. + - simpl in *. + inversion hprec; subst. + + reflexivity. + + destruct i. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + 1: apply precneq_I in H1; easy. + etransitivity. + 1: eapply preceq_I. + assumption. + * simpl in *. + apply Pos.succ_inj in hsize. + apply IHj in hsize. + 1: subst; auto. + etransitivity. + 1: eapply preceq_O. + assumption. + * simpl in hsize. + micromega.Lia.lia. + - simpl in hsize. + apply size_1. + assumption. +Qed. + +#[export] Instance preceq_antisym : Antisymmetric _ _ preceq. +Proof. + intros i1 i2 h1 h2. + apply preceq_size in h1 as hsize1. + apply preceq_size in h2 as hsize2. + apply preceq_size_eq_eq. + 1: micromega.Lia.lia. + assumption. +Qed. + +Lemma preceq_prefix : forall i1 i2 i3, i1 ⪯ i3 -> i2 ⪯ i3 -> i1 ⪯ i2 \/ i2 ⪯ i1. +Proof. + intros i1 i2 i3. revert i1 i2. + induction i3; intros. + - inversion H; subst. + + right. assumption. + + inversion H0; subst. + * left; assumption. + * apply IHi3; assumption. + - inversion H; subst. + + right. assumption. + + inversion H0; subst. + * left; assumption. + * apply IHi3; assumption. + - inversion H; subst. + inversion H0; subst. + left; constructor. +Qed. + +Definition fresh_id i := + (i~0, i~1). + +Lemma prec_neq p fp : p ≺ fp -> p <> fp. +Proof. unfold prec. easy. Qed. + +Lemma prec_precneq i1 i2 : i1 ≺ i2 -> ~ i2 ⪯ i1. +Proof. + intros H contra. + eapply prec_neq. + 1: exact H. + apply antisymmetry; auto. + apply H. +Qed. + +#[export] Instance prec_trans : Transitive prec. +Proof. + intros i1 i2 i3. + intros [hpre1 hneq1] [hpre2 hneq2]. + split. + - etransitivity; eauto. + - intro contra; subst. + apply hneq2. + apply antisymmetry; assumption. +Qed. + +Lemma fresh1 i : i ≺ (fresh_id i).1. +Proof. + simpl; split. + - apply preceq_O. + - apply nesym. apply xO_neq. +Qed. + +Lemma fresh2 i : i ≺ (fresh_id i).2. +Proof. + simpl; split. + - apply preceq_I. + - apply nesym. apply xI_neq. +Qed. + +Lemma preceq_prec_trans : forall p1 p2 p3, p1 ⪯ p2 -> p2 ≺ p3 -> p1 ≺ p3. +Proof. + intros p1 p2 p3 h1 [h2 h3]. + split. + - etransitivity; eauto. + - intros contra; subst. + apply h3. apply antisymmetry; assumption. +Qed. + +Lemma prec_preceq_trans : forall p1 p2 p3, p1 ≺ p2 -> p2 ⪯ p3 -> p1 ≺ p3. +Proof. + intros p1 p2 p3 [h1 h2] h3. + split. + - etransitivity; eauto. + - intros contra; subst. + apply h2. apply antisymmetry; assumption. +Qed. + +Lemma fresh1_weak s_id : s_id ⪯ s_id~0. +Proof. apply fresh1. Qed. + +Lemma fresh2_weak s_id : s_id ⪯ s_id~1. +Proof. apply fresh2. Qed. + +Definition disj i1 i2 := + forall i3, i1 ⪯ i3 -> ~ i2 ⪯ i3. + +Lemma disj_antirefl i : ~ disj i i. +Proof. + intros contra. + unfold disj in contra. + specialize (contra i ltac:(reflexivity)). + apply contra. reflexivity. +Qed. + +#[export] Instance disj_sym : Symmetric disj. +Proof. + intros i1 i2 hi1 i3 hi2. + intros contra. + apply hi1 in contra. + contradiction. +Qed. + +Lemma fresh_disj i : + disj (fresh_id i).1 (fresh_id i).2. +Proof. + intros i' h contra. + simpl in *. + pose proof preceq_prefix i~0 i~1 i' h contra. + destruct H. + - inversion H; subst. + eapply precneq_O; eassumption. + - inversion H; subst. + eapply precneq_I; eassumption. +Qed. + +Lemma disj_prec_l : forall id1 id2 id3, id1 ⪯ id2 -> disj id1 id3 -> disj id2 id3. +Proof. + intros id1 id2 id3 hpre hdisj. + intros id' hprec. + apply hdisj. + etransitivity; eauto. +Qed. + +Lemma disj_prec_r : forall id1 id2 id3, id1 ⪯ id2 -> disj id3 id1 -> disj id3 id2. +Proof. + intros id1 id2 id3 hpre hdisj. + apply disj_sym. + eapply disj_prec_l; eauto. + apply disj_sym; assumption. +Qed. + +Lemma disj_prec : forall id1 id2 id3 id4, id1 ⪯ id2 -> id3 ⪯ id4 -> disj id1 id3 -> disj id2 id4. +Proof. + intros. + eapply disj_prec_l; eauto. + eapply disj_prec_r; eauto. +Qed. + +#[export] Hint Resolve fresh1 fresh2 fresh1_weak fresh2_weak preceq_refl preceq_trans prec_trans : prefix. + +(* Unary judgment concluding on evaluation of program *) + +Definition eval_jdg {A : choiceType} + (pre : heap → Prop) (post : heap → Prop) + (c : raw_code A) (v : A) := + ⊢ ⦃ λ '(h₀, h₁), pre h₀ ⦄ + c ≈ ret v + ⦃ λ '(a₀, h₀) '(a₁, h₁), post h₀ ∧ a₀ = a₁ ∧ a₁ = v ⦄. + +Notation "⊢ ⦃ pre ⦄ c ⇓ v ⦃ post ⦄" := + (eval_jdg pre post c v) + (format "⊢ ⦃ pre ⦄ '/ ' '[' c ']' '/' ⇓ '/ ' '[' v ']' '/' ⦃ post ⦄") + : package_scope. + +Lemma u_ret : + ∀ {A : choiceType} (v v' : A) (p q : heap → Prop), + (∀ hp, p hp → q hp ∧ v = v') → + ⊢ ⦃ p ⦄ ret v ⇓ v' ⦃ q ⦄. +Proof. + intros A v v' p q h. + unfold eval_jdg. + apply r_ret. + intros hp hp' hhp. + specialize (h hp). + intuition eauto. +Qed. + +Lemma u_ret_eq : + ∀ {A : choiceType} (v : A) (p q : heap → Prop), + (∀ hp, p hp → q hp) → + ⊢ ⦃ p ⦄ ret v ⇓ v ⦃ q ⦄. +Proof. + intros A v p q h. + apply u_ret. intuition eauto. +Qed. + +Lemma u_bind : + ∀ {A B : choiceType} m f v₁ v₂ (p q r : heap → Prop), + ⊢ ⦃ p ⦄ m ⇓ v₁ ⦃ q ⦄ → + ⊢ ⦃ q ⦄ f v₁ ⇓ v₂ ⦃ r ⦄ → + ⊢ ⦃ p ⦄ @bind A B m f ⇓ v₂ ⦃ r ⦄. +Proof. + intros A B m f v₁ v₂ p q r hm hf. + unfold eval_jdg. + change (ret v₂) with (ret v₁ ;; ret v₂). + eapply r_bind. + - exact hm. + - intros a₀ a₁. + eapply rpre_hypothesis_rule. + intuition subst. + eapply rpre_weaken_rule. + 1: apply hf. + simpl. intuition subst. assumption. +Qed. + +(* Unary variant of set_lhs *) +Definition u_set_pre (ℓ : Location) (v : ℓ) (pre : heap → Prop): heap → Prop := + λ m, ∃ m', pre m' ∧ m = set_heap m' ℓ v. + +Lemma u_put : + ∀ {A : choiceType} (ℓ : Location) (v : ℓ) (r : raw_code A) (v' : A) p q, + ⊢ ⦃ u_set_pre ℓ v p ⦄ r ⇓ v' ⦃ q ⦄ → + ⊢ ⦃ p ⦄ #put ℓ := v ;; r ⇓ v' ⦃ q ⦄. +Proof. + intros A ℓ v r v' p q h. + eapply r_put_lhs with (pre := λ '(_,_), _). + eapply rpre_weaken_rule. 1: eapply h. + intros m₀ m₁ hm. simpl. + destruct hm as [m' hm]. + exists m'. exact hm. +Qed. + +(* Unary variant of inv_conj (⋊) *) +Definition u_pre_conj (p q : heap → Prop) : heap → Prop := + λ m, p m ∧ q m. + +Notation "p ≪ q" := + (u_pre_conj p q) (at level 19, left associativity) : package_scope. + +(* Unary variant of rem_lhs *) +Definition u_get (ℓ : Location) (v : ℓ) : heap → Prop := + λ m, get_heap m ℓ = v. + +Lemma u_get_remember : + ∀ (A : choiceType) (ℓ : Location) (k : ℓ → raw_code A) (v : A) p q, + (∀ x, ⊢ ⦃ p ≪ u_get ℓ x ⦄ k x ⇓ v ⦃ q ⦄) → + ⊢ ⦃ p ⦄ x ← get ℓ ;; k x ⇓ v ⦃ q ⦄. +Proof. + intros A ℓ k v p q h. + eapply r_get_remember_lhs with (pre := λ '(_,_), _). + intro x. + eapply rpre_weaken_rule. 1: eapply h. + simpl. intuition eauto. +Qed. + +(* Unary rpre_weaken_rule *) +Lemma u_pre_weaken_rule : + ∀ A (r : raw_code A) v (p1 p2 : heap → Prop) q, + ⊢ ⦃ p1 ⦄ r ⇓ v ⦃ q ⦄ → + (∀ h, p2 h → p1 h) → + ⊢ ⦃ p2 ⦄ r ⇓ v ⦃ q ⦄. +Proof. + intros A r v p1 p2 q h hp. + eapply rpre_weaken_rule. + - eapply h. + - intros. apply hp. assumption. +Qed. + +(* Unary rpost_weaken_rule *) +Lemma u_post_weaken_rule : + ∀ A (r : raw_code A) v p (q1 q2 : heap → Prop), + ⊢ ⦃ p ⦄ r ⇓ v ⦃ q1 ⦄ → + (∀ h, q1 h → q2 h) → + ⊢ ⦃ p ⦄ r ⇓ v ⦃ q2 ⦄. +Proof. + intros A r v p q1 q2 h hq. + eapply rpost_weaken_rule. + - eapply h. + - intros [] []. intuition eauto. +Qed. + +Definition typed_chElement := + pointed_value. + +Definition to_typed_chElement {t : choice_type} (v : t) : typed_chElement := + (t ; v). + +Definition typed_code := + ∑ (a : choice_type), raw_code a. + +Definition encode (t : stype) : choice_type := + match t with + | sbool => 'bool + | sint => 'int + | sarr n => (chMap 'int ('word U8)) + | sword n => 'word n + end. + +Definition embed_array {len} (a : WArray.array len) : (chMap 'int ('word U8)) := + Mz.fold (λ k v m, setm m k v) a.(WArray.arr_data) emptym. + +Definition embed {t} : sem_t t → encode t := + match t with + | sbool => λ x, x + | sint => λ x, x + | sarr n => embed_array + | sword n => λ x, x + end. + +(* from pkg_invariants *) +Definition cast_ct_val {t t' : choice_type} (e : t = t') (v : t) : t'. +Proof. + subst. auto. +Defined. + +Lemma cast_ct_val_K : + ∀ t e v, + @cast_ct_val t t e v = v. +Proof. + intros t e v. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. +Qed. + +Equations? coerce_to_choice_type (t : choice_type) {tv : choice_type} (v : tv) : t := + @coerce_to_choice_type t tv v with inspect (tv == t) := { + | @exist true e => cast_ct_val _ v + | @exist false e => chCanonical t + }. +Proof. + symmetry in e. + move: e => /eqP e. subst. reflexivity. +Qed. + +Definition cast_typed_code (t' : choice_type) (c : typed_code) (e : c.π1 = t') : + raw_code t'. +Proof. + subst. exact (projT2 c). +Defined. + +Lemma cast_typed_code_K : + ∀ t c e, + @cast_typed_code t (t ; c) e = c. +Proof. + intros t c e. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. +Qed. + +Equations? coerce_typed_code (ty : choice_type) (tc : typed_code) : raw_code ty := + @coerce_typed_code ty tc with inspect (tc.π1 == ty) := { + | @exist true e => @cast_typed_code ty tc _ + | @exist false e => ret (chCanonical ty) + }. +Proof. + symmetry in e. + move: e => /eqP e. subst. reflexivity. +Qed. + +Lemma coerce_typed_code_neq : + ∀ (ty ty' : choice_type) c, + ty ≠ ty' → + coerce_typed_code ty' (ty ; c) = ret (chCanonical _). +Proof. + intros ty ty' c ne. + funelim (coerce_typed_code ty' (ty ; c)). + 1:{ + clear - e ne. symmetry in e. move: e => /eqP e. simpl in e. contradiction. + } + symmetry. assumption. +Qed. + +Lemma coerce_typed_code_K : + ∀ (ty : choice_type) c, + coerce_typed_code ty (ty ; c) = c. +Proof. + intros ty c. + funelim (coerce_typed_code ty (ty ; c)). + 2:{ + clear - e. symmetry in e. move: e => /eqP e. simpl in e. contradiction. + } + rewrite <- Heqcall. + apply cast_typed_code_K. +Qed. + +Definition choice_type_of_val (val : value) : choice_type := + encode (type_of_val val). + +(* Tactic to deal with Let _ := _ in _ = ok _ in assumption h *) +(* x and hx are introduced names for the value and its property *) +Ltac jbind h x hx := + eapply rbindP ; [| exact h ] ; + clear h ; intros x hx h ; + cbn beta in h. + +Module JasminNotation. + Notation " 'array " := (chMap 'int ('word U8)) (at level 2) : package_scope. + Notation " 'array " := (chMap 'int ('word U8)) (in custom pack_type at level 2). + Notation " 'mem " := (chMap ('word Uptr) ('word U8)) (at level 2) : package_scope. + Notation " 'mem " := (chMap ('word Uptr) ('word U8)) (in custom pack_type at level 2). + Notation totce := to_typed_chElement. + Notation coe_cht := coerce_to_choice_type. + Notation coe_tyc := coerce_typed_code. + +End JasminNotation. + +Import JasminNotation. + +Section Translation. + +Context `{asmop : asmOp}. + +Context {pd : PointerData}. + +Context (gd : glob_decls). + +Context `{sc_sem : syscall_sem }. + +Definition mem_index : nat := 0. +Definition mem_loc : Location := ('mem ; mem_index). + +Lemma elementsNIn : + ∀ (T : Type) (k : Z) (v : T) (m : Mz.Map.t T), + Mz.get m k = None → + ¬ List.In (k, v) (Mz.elements m). +Proof. + intros S k v m H contra. + apply Mz.elementsIn in contra. + rewrite H in contra. + discriminate. +Qed. + +Lemma foldl_In_uniq {S : eqType} (k : Mz.K.t) (v : S) (data : seq (Mz.K.t * S)) : + List.In (k, v) data → + @uniq Mz.K.t [seq i.1 | i <- data] → + foldr (λ (kv : Mz.K.t * S) (a : {fmap Mz.K.t → S}), setm a kv.1 kv.2) emptym data k = Some v. +Proof. + intros. + induction data. + - easy. + - simpl in H. + simpl. + destruct H. + + subst. simpl. + rewrite setmE. + rewrite eq_refl. + reflexivity. + + move: H0 => /andP [H1 H2]. + move: H1 => /in_map H3. + assert (negb (@eq_op BinNums_Z__canonical__Ord_Ord k a.1)). { + apply /eqP => contra; case: H3; exists (a.1, v); by move: contra <-. + } + rewrite setmE. + rewrite <- negbK. + rewrite H0. + simpl. + apply IHdata; assumption. +Qed. + +Lemma foldl_NIn {S : eqType} (k : Mz.K.t) (data : seq (Mz.K.t * S)) : + (∀ w, ¬ List.In (k, w) data) → + foldr (λ (kv : Mz.K.t * S) (a : {fmap Mz.K.t → S}), setm a kv.1 kv.2) emptym data k = None. +Proof. + intros. + induction data. + - easy. + - specialize (H a.2) as H0. + simpl. apply List.not_in_cons in H0 as [H0 H1]. + assert (negb (@eq_op BinNums_Z__canonical__Ord_Ord k a.1)). { + apply /eqP => contra. apply H0. move: contra ->. symmetry. apply surjective_pairing. } + rewrite setmE. + rewrite <- negbK. + rewrite H2. + simpl. + apply IHdata. + intros. + specialize (H w). + apply List.not_in_cons in H. easy. +Qed. + +Lemma rev_list_rev {S} : + ∀ (l : seq S), List.rev l = rev l. +Proof. + induction l; intuition subst; simpl. + rewrite rev_cons. rewrite IHl. rewrite <- cats1. reflexivity. +Qed. + +Lemma fold_get {S : eqType} (data : Mz.Map.t S) i : + Mz.fold (λ k v m, setm m k v) data emptym i = Mz.get data i. +Proof. + rewrite Mz.foldP. + replace (Mz.elements data) with (rev (rev (Mz.elements data))). 2: by rewrite revK. + rewrite foldl_rev. + destruct Mz.get eqn:E. + - set (kv := (i, s)). + replace i with kv.1 in * by reflexivity. + replace s with kv.2 in * by reflexivity. + apply Mz.elementsIn in E. subst kv. + apply foldl_In_uniq. + + rewrite <- rev_list_rev. apply -> List.in_rev. assumption. + + rewrite map_rev. rewrite rev_uniq. apply Mz.elementsU. + - apply foldl_NIn. + intros. + rewrite <- rev_list_rev. + rewrite <- List.in_rev. + apply elementsNIn. + assumption. +Qed. + +Lemma embed_array_get : + ∀ len (a : WArray.array len) (k : Z), + embed_array a k = Mz.get a.(WArray.arr_data) k. +Proof. + intros len a k. + unfold embed_array. + rewrite fold_get. reflexivity. +Qed. + +Lemma eq_op_MzK : + ∀ (k x : BinNums_Z__canonical__Ord_Ord), + @eq_op Mz.K.t k x = (k == x). +Proof. + intros k x. + destruct (k == x) eqn: e. + - apply /eqP. move: e => /eqP. auto. + - apply /eqP. move: e => /eqP. auto. +Qed. + +Lemma fold_set {S : eqType} (data : Mz.Map.t S) k v : + setm (Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) data emptym) k v = + Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) (Mz.set data k v) emptym. +Proof. + apply eq_fmap. + intros x. + rewrite fold_get. + rewrite setmE Mz.setP. + rewrite eq_sym. + rewrite eq_op_MzK. + destruct (k == x). + - reflexivity. + - rewrite fold_get. reflexivity. +Qed. + +Lemma embed_array_set : + ∀ len (a : WArray.array len) (k : Z) v, + setm (embed_array a) k v = + embed_array (WArray.Build_array len (Mz.set a.(WArray.arr_data) k v)). +Proof. + intros len a k v. + unfold embed_array. + rewrite fold_set. reflexivity. +Qed. + +Lemma fold_rem {S : eqType} (data : Mz.Map.t S) k : + remm (Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) data emptym) k = + Mz.fold (λ (k : Mz.Map.key) (v : S) (m : {fmap Z → S}), setm m k v) (Mz.remove data k) emptym. +Proof. + apply eq_fmap. + intros x. + rewrite fold_get. + rewrite remmE Mz.removeP. + rewrite eq_sym. + rewrite eq_op_MzK. + destruct (k == x). + - reflexivity. + - rewrite fold_get. reflexivity. +Qed. + +Lemma embed_array_rem : + ∀ len (a : WArray.array len) (k : Z), + remm (embed_array a) k = + embed_array (WArray.Build_array len (Mz.remove a.(WArray.arr_data) k)). +Proof. + intros len a k. + unfold embed_array. + rewrite fold_rem. reflexivity. +Qed. + +Definition unembed {t : stype} : encode t → sem_t t := + match t return encode t → sem_t t with + | sbool => λ x, x + | sint => λ x, x + | sarr n => λ x, + foldr (λ kv m, + {| WArray.arr_data := Mz.set m.(WArray.arr_data) kv.1 kv.2 |} + ) (WArray.empty _) x + (* (λ kv m, Let m' := m in WArray.set8 m' kv.1 kv.2) *) + (* (Ok _ (WArray.empty _)) x *) + | sword n => λ x, x + end. + +Fixpoint nat_of_string_name (s : string) : nat := + match s with + | EmptyString => 1 + | String a s => 256 * nat_of_string_name s + (Ascii.nat_of_ascii a) + end. + +Definition nat_of_ident (id : Ident.ident) : nat := + nat_of_string_name (Ident.string_of_name (Ident.id_name id)). + +Definition nat_of_stype t : nat := + match t with + | sbool => 5 + | sint => 7 + | sarr len => 11 ^ (Pos.to_nat len) + | sword ws => 13 ^ ws + end. + +(* injection *) +Definition nat_of_p_id_ident (p : p_id) (id : Ident.ident) : nat := + 3^(nat_of_p_id p) * 2^(nat_of_ident id). + +Definition nat_of_p_id_var (p : p_id) (x : var) : nat := + (nat_of_stype x.(vtype) * (nat_of_p_id_ident p x.(vname)))%coq_nat. + +Definition translate_var (p : p_id) (x : var) : Location := + (encode x.(vtype) ; nat_of_p_id_var p x). + +Lemma Natpow_expn : + ∀ (n m : nat), + (n ^ m)%nat = expn n m. +Proof. + intros n m. + induction m as [| m ih] in n |- *. + - cbn. reflexivity. + - simpl. rewrite expnS. rewrite -ih. reflexivity. +Qed. + +Lemma Mpowmodn : + ∀ d n, + n ≠ 0%nat → + d ^ n %% d = 0%nat. +Proof. + intros d n hn. + destruct n as [| n]. 1: contradiction. + simpl. apply modnMr. +Qed. + +Lemma nat_of_ident_pos : + ∀ x, (0 < nat_of_ident x)%coq_nat. +Proof. + intros x. + unfold nat_of_ident. + induction (Ident.string_of_name (Ident.id_name x)) as [| a s ih]. + - auto. + - simpl. + rewrite -word_ssrZ.mulP. rewrite -plusE. + micromega.Lia.lia. +Qed. + +Lemma injective_nat_of_ident : + ∀ x y, + nat_of_ident x = nat_of_ident y → + x = y. +Proof. + intros x y e. + unfold nat_of_ident in e. + destruct ident_eqType. + destruct class. + destruct eqtype_hasDecEq_mixin. + + admit. + (* induction (Ident.string_of_name (Ident.id_name x)) as [| a x_] in y, e |- *. *) + (* (* induction x as [| a x] in y, e |- *. *) *) + (* all: destruct (Ident.string_of_name (Ident.id_name y)) as [| b y_]. *) + (* all: simpl in e. *) + (* - reflexivity. *) + (* - rewrite -word_ssrZ.mulP in e. rewrite -plusE in e. *) + (* pose proof (nat_of_ident_pos y). *) + (* micromega.Lia.lia. *) + (* - rewrite -word_ssrZ.mulP in e. rewrite -plusE in e. *) + (* pose proof (nat_of_ident_pos x). *) + (* micromega.Lia.lia. *) + (* - apply (f_equal (λ a, Nat.modulo a 256)) in e as xy_eq. *) + (* rewrite -Nat.add_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite -Nat.mul_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mod_same in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mul_0_l in xy_eq. *) + (* rewrite Nat.mod_0_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.add_0_l in xy_eq. *) + (* rewrite -Nat.add_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite -Nat.mul_mod_idemp_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mod_same in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.mul_0_l in xy_eq. *) + (* rewrite Nat.mod_0_l in xy_eq. 2: micromega.Lia.lia. *) + (* rewrite Nat.add_0_l in xy_eq. *) + (* rewrite !Nat.mod_small in xy_eq. 2,3: apply Ascii.nat_ascii_bounded. *) + (* apply OrderedTypeEx.String_as_OT.nat_of_ascii_inverse in xy_eq. *) + (* subst. f_equal. *) + (* apply IHx. *) + (* rewrite -!word_ssrZ.addP in e. *) + (* rewrite -!word_ssrZ.mulP in e. *) + (* micromega.Lia.lia. *) +(* Qed. *) +Admitted. + +Lemma injective_nat_of_p_id_ident : + ∀ p x y, + nat_of_p_id_ident p x = nat_of_p_id_ident p y → + x = y. +Proof. + intros p x y e. + unfold nat_of_p_id_ident in e. + apply Nat.mul_cancel_l in e. 2: apply Nat.pow_nonzero ; auto. + eapply Nat.pow_inj_r in e. 2: auto. + apply injective_nat_of_ident. assumption. +Qed. + +Lemma coprime_mul_inj a b c d : + coprime a d → + coprime a b → + coprime c b → + coprime c d → + (a * b = c * d)%nat → + a = c ∧ b = d. +Proof. + intros ad ab cb cd e. + move: e => /eqP. rewrite eqn_dvd. move=> /andP [d1 d2]. + rewrite Gauss_dvd in d1. 2: assumption. + rewrite Gauss_dvd in d2. 2: assumption. + move: d1 d2 => /andP [d11 d12] /andP [d21 d22]. + rewrite Gauss_dvdl in d11. 2: assumption. + rewrite Gauss_dvdr in d12. 2: rewrite coprime_sym; assumption. + rewrite Gauss_dvdl in d21. 2: assumption. + rewrite Gauss_dvdr in d22. 2: rewrite coprime_sym; assumption. + split. + - apply /eqP. rewrite eqn_dvd. by apply /andP. + - apply /eqP. rewrite eqn_dvd. by apply /andP. +Qed. + +Lemma coprime_nat_of_stype_nat_of_fun_ident t p v : + coprime (nat_of_stype t) (nat_of_p_id_ident p v). +Proof. + unfold nat_of_p_id_ident. + unfold nat_of_stype. + rewrite coprimeMr. + apply /andP. + destruct t. + - rewrite !Natpow_expn. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. + - rewrite !Natpow_expn. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2,3: apply/ltP; micromega.Lia.lia. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2,3: auto. + rewrite !coprime_pexpr. + 1: auto. + 1: apply /ltP; apply nat_of_ident_pos. + 1: apply /ltP; pose proof nat_of_p_id_nonzero p; micromega.Lia.lia. +Qed. + +Lemma nat_of_p_id_pos : forall p, (0 < nat_of_p_id p)%coq_nat. +Proof. + intros. pose proof nat_of_p_id_nonzero p. micromega.Lia.lia. +Qed. + +Lemma injective2_nat_of_p_id_ident : + injective2 nat_of_p_id_ident. +Proof. + intros p gn x y e. + unfold nat_of_p_id_ident in e. + apply coprime_mul_inj in e as [p1_p2 x_y]. + - apply Nat.pow_inj_r in p1_p2; [|micromega.Lia.lia]. + apply Nat.pow_inj_r in x_y; [|micromega.Lia.lia]. + split. + + apply injective_nat_of_pos. assumption. + + apply injective_nat_of_ident. assumption. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. + - rewrite !Natpow_expn. + rewrite !coprime_pexpl. + 2: apply /ltP; apply nat_of_p_id_pos. + rewrite !coprime_pexpr. + 2: apply /ltP; apply nat_of_ident_pos. + reflexivity. +Qed. + +Lemma injective_translate_var : + ∀ p, injective (translate_var p). +Proof. + intros p u v e. + unfold translate_var in e. + destruct u as [uty u], v as [vty v]. + simpl in e. noconf e. + unfold nat_of_p_id_var in H0. + simpl in H0. + apply coprime_mul_inj in H0 as [e1 e2]. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + f_equal. + - destruct uty, vty; auto; try discriminate. + + apply Nat.pow_inj_r in e1. 2: auto. + 2: micromega.Lia.lia. + apply Pos2Nat.inj in e1. + subst; reflexivity. + + noconf H. reflexivity. + - eapply injective_nat_of_p_id_ident. + eassumption. +Qed. + +Lemma injective_translate_var2 : + forall (p1 p2 : p_id) v1 v2, p1 <> p2 -> translate_var p1 v1 != translate_var p2 v2. +Proof. + intros. + apply /eqP => contra. + unfold translate_var in contra. + noconf contra. + unfold nat_of_p_id_var in H1. + apply coprime_mul_inj in H1 as [e1 e2]. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + apply injective2_nat_of_p_id_ident in e2 as [p_gn _]. + easy. +Qed. + +Lemma injective_translate_var3 : + forall (p1 p2 : p_id) v1 v2, vname v1 != vname v2 -> translate_var p1 v1 != translate_var p2 v2. +Proof. + intros. + apply /eqP => contra. + unfold translate_var in contra. + noconf contra. + unfold nat_of_p_id_var in H1. + apply coprime_mul_inj in H1 as [e1 e2]. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + apply injective2_nat_of_p_id_ident in e2 as [p_gn ?]. + move: H => /eqP contra. + easy. +Qed. + +Lemma coprimenn n : (coprime n n) = (n == 1%nat). +Proof. by unfold coprime; rewrite gcdnn. Qed. + +Lemma coprime_neq p q : p != 1%nat -> coprime p q -> p <> q. +Proof. + intros. + move=>contra; subst. + move: H=>/eqP H; apply H; apply/eqP. + by rewrite -coprimenn. +Qed. + +Lemma nat_of_wsize_inj : injective nat_of_wsize. +Proof. intros ws1 ws2. by case ws1; case ws2. Qed. + +Lemma nat_of_stype_injective : injective nat_of_stype. +Proof. + intros s t. + case s; case t; try by []. + - intros p H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr ; [ | apply is_positive ]. + - intros. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr. + - intros l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr ; [ | apply is_positive ]. + - intros ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + reflexivity. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpr ; [ | apply is_positive ]. + - intros l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + all: micromega.Lia.lia. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl ; [ | apply is_positive ]. + - intros l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + all: micromega.Lia.lia. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl ; [ | apply is_positive ]. + - intros l1 l2 H. + destruct (l2 == l1) eqn:E. + + by move: E=>/eqP ->. + + exfalso. + move: E=>/eqP=>contra; apply contra. + eapply Pos2Nat.inj. eapply Nat.pow_inj_r. + 2: eapply H. micromega.Lia.lia. + - intros ws l H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + all: micromega.Lia.lia. + + unfold nat_of_stype. rewrite !Natpow_expn coprime_pexpl; [ | apply is_positive ]. + by rewrite coprime_pexpr. + - intros ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + 1: micromega.Lia.lia. + apply/eqP. by case ws. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl. + - intros ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + 1: micromega.Lia.lia. + apply/eqP. by case ws. + + unfold nat_of_stype. by rewrite Natpow_expn coprime_pexpl. + - intros l ws H. + exfalso. + eapply coprime_neq. + 3: eapply H. + + unfold nat_of_stype. apply/eqP. apply nesym. apply Nat.lt_neq. + apply Nat.pow_gt_1. + 1: micromega.Lia.lia. + apply/eqP. by case ws. + + unfold nat_of_stype. rewrite !Natpow_expn coprime_pexpl; [ | apply is_positive ]. + by rewrite coprime_pexpr; [ | apply is_positive ]. + - intros ws1 ws2 H. + destruct (ws2 == ws1) eqn:E. + + by move: E=>/eqP ->. + + exfalso. + move: E=>/eqP=>contra; apply contra. + eapply nat_of_wsize_inj. + eapply Nat.pow_inj_r. + 2: eapply H. micromega.Lia.lia. +Qed. + +Lemma nat_of_p_id_var_injective2 : + injective2 nat_of_p_id_var. +Proof. + intros i1 i2 v1 v2. + unfold nat_of_p_id_var. + intros H. + apply coprime_mul_inj in H as []. + 2,3,4,5: apply coprime_nat_of_stype_nat_of_fun_ident. + apply nat_of_stype_injective in H. + apply injective2_nat_of_p_id_ident in H0 as [? ?]. + destruct v1, v2. simpl in *; subst. + easy. +Qed. + +Lemma translate_var_injective2 : + injective2 translate_var. +Proof. + intros i1 i2 v1 v2. + unfold translate_var. + move=> H. + noconf H. + apply nat_of_p_id_var_injective2 in H0. + assumption. +Qed. + +Lemma translate_var_eq i1 i2 v1 v2 : + (translate_var i1 v1 == translate_var i2 v2) = (i1 == i2) && (v1 == v2). +Proof. + apply/eqP. + destruct (_ && _) eqn:E. + - by move: E=>/andP [] /eqP -> /eqP ->. + - move=>contra. + apply translate_var_injective2 in contra as [? ?]. + subst. + move: E=>/andP []. split; by apply/eqP. +Qed. + +Lemma mem_loc_translate_var_neq : + ∀ p x, + mem_loc != translate_var p x. +Proof. + intros p x. + unfold mem_loc, translate_var. + apply /eqP. intro e. + destruct x as [ty i]. simpl in e. noconf e. + destruct ty. all: discriminate. +Qed. + +#[local] Definition unsupported : typed_code := + ('unit ; assert false). + +Lemma truncate_val_type : + ∀ ty v v', + truncate_val ty v = ok v' → + type_of_val v' = ty. +Proof. + intros ty v v' e. + unfold truncate_val in e. + jbind e x ev. noconf e. + apply type_of_to_val. +Qed. + +Definition truncate_chWord {t : choice_type} (n : wsize) : t → 'word n := + match t with + | chWord m => + λ w, + match truncate_word n w with + | Ok w' => w' + | _ => chCanonical _ + end + | _ => λ x, chCanonical _ + end. + +Definition truncate_el {t : choice_type} (s : stype) : t → encode s := + match s return t → encode s with + | sbool => λ b, coerce_to_choice_type 'bool b + | sint => λ i, coerce_to_choice_type 'int i + | sarr n => + (* Here we do not perform the check on the length of the array as + performed by to_arr n. + *) + λ a, coerce_to_choice_type 'array a + | sword n => + λ w, truncate_chWord n w + end. + +Definition translate_to_pointer {t : choice_type} (c : t) : 'word Uptr := + truncate_el (sword Uptr) c. + +Definition truncate_code (s : stype) (c : typed_code) : typed_code := + (encode s ; x ← c.π2 ;; ret (truncate_el s x)). + +Definition translate_value (v : value) : choice_type_of_val v. +Proof. + destruct v as [b | z | size a | size wd | undef_ty]. + - apply embed. exact b. + - apply embed. exact z. + - apply embed. exact a. + - apply embed. exact wd. + - apply chCanonical. + (* It shouldn't matter which value we pick, because when coercing an undef + value at type ty back to ty via to_{bool,int,word,arr} (defined in + values.v), all of these functions raise an error on Vundef. *) +Defined. + +Definition translate_write_var (p : p_id) (x : var_i) (v : typed_chElement) := + let l := translate_var p (v_var x) in + #put l := truncate_el x.(vtype) v.π2 ;; + ret tt. + +Definition translate_get_var (p : p_id) (x : var) : raw_code (encode x.(vtype)) := + x ← get (translate_var p x) ;; ret x. + +Fixpoint satisfies_globs (globs : glob_decls) : heap * heap → Prop. +Proof. + exact (λ '(x, y), False). (* TODO *) +Defined. + +Program Definition translate_gvar (p : p_id) (x : gvar) : raw_code (encode x.(gv).(vtype)) := + if is_lvar x + then translate_get_var p x.(gv).(v_var) + else + match get_global gd x.(gv).(v_var) with + | Ok v => ret (coerce_to_choice_type _ (translate_value v)) + | _ => ret (chCanonical _) + end. + +Definition chArray_get8 (a : 'array) ptr := + match a ptr with + | None => chCanonical ('word U8) + | Some x => x + end. + +Lemma chArray_get8_correct len (a : WArray.array len) s ptr : + WArray.get8 a ptr = ok s → + chArray_get8 (embed_array a) ptr = translate_value (Vword s). +Proof. + intros H. simpl. + unfold WArray.get8 in H. + jbind H x Hx. + jbind H y Hy. + noconf H. + unfold chArray_get8, odflt, oapp, embed_array. + rewrite fold_get. + reflexivity. +Qed. + +Definition chArray_get ws (a : 'array) ptr scale := + (* Jasmin fails if ptr is not aligned; we may not need it. *) + (* if negb (is_align ptr sz) then chCanonical ws else *) + let f k := chArray_get8 a (ptr * scale + k)%Z in + let l := map f (ziota 0 (wsize_size ws)) in + Jasmin.memory_model.LE.decode ws l. + +Definition chArray_get_sub ws len (a : 'array) ptr scale := + let size := arr_size ws len in + let start := (ptr * scale)%Z in + if (0 <=? start)%Z (* && (start + size <=? ) *) + then ( + foldr (λ (i : Z) (data : 'array), + match a (start + i)%Z with + | Some w => setm data i w + | None => remm data i + end + ) emptym (ziota 0 size) + ) + else chCanonical 'array. + +Definition totc (ty : choice_type) (c : raw_code ty) : typed_code := + (ty ; c). + +(* Almost chArray_get but with a different key type *) +Definition read_mem (m : 'mem) ptr ws : 'word ws := + let f k := + match m (ptr + (wrepr Uptr k))%R with + | None => chCanonical ('word U8) + | Some x => x + end + in + let l := map f (ziota 0 (wsize_size ws)) in + Jasmin.memory_model.LE.decode ws l. + +Definition chRead ptr ws : raw_code ('word ws) := + (* memory as array *) + mem ← get mem_loc ;; + ret (read_mem mem ptr ws). + +Definition chArray_set8 (a : 'array) ptr w := + setm a ptr w. + +Lemma chArray_set8_correct {len} (a : WArray.array len) ptr w s : + WArray.set8 a ptr w = ok s → + chArray_set8 (embed_array a) ptr w = embed_array s. +Proof. + intros H. simpl. + unfold WArray.set8 in H. + jbind H x Hx. + noconf H. + unfold chArray_set8, embed_array. + simpl. + rewrite <- fold_set. + reflexivity. +Qed. + +(* Jasmin's write on 'array *) +Definition chArray_write {sz} (a : 'array) ptr (w : word sz) : 'array := + (* For now we do not worry about alignment *) + foldr (λ (k : Z) (a' : 'array), + chArray_set8 a' (ptr + k)%Z (LE.wread8 w k) + ) a (ziota 0 (wsize_size sz)). + +Definition chArray_write_foldl {sz} (a : 'array) ptr (w : word sz) : 'array := + foldl (λ (a' : 'array) (k : Z), + chArray_set8 a' (ptr + k)%Z (LE.wread8 w k) + ) a (ziota 0 (wsize_size sz)). + +Lemma foldr_set_not_eq {K : ordType} {K' : eqType} {V : eqType} m f g (k : K) (v : V) (l : seq K') : + (forall k', k' \in l -> k <> f k') -> + setm (foldr (λ k m, setm m (f k) (g k)) m l) k v = foldr (λ k m, setm m (f k) (g k)) (setm m k v) l. +Proof. + intros. + apply eq_fmap. + intros z. revert z. + induction l. + - reflexivity. + - simpl. + intros. + assert (k <> f a). + { apply H. unfold in_mem. simpl. rewrite eq_refl. auto. } + rewrite !setmE. + destruct (_ == _) eqn:E. + + move: E => /eqP. intros. subst. + assert (k == f a = false). + { apply /eqP. assumption. } + rewrite H1. rewrite <- IHl. + { + rewrite setmE. + rewrite eq_refl. + reflexivity. + } + intros. apply H. + rewrite in_cons. + rewrite H2. + rewrite Bool.orb_true_r. auto. + + + destruct (_ == f a). 1: reflexivity. + rewrite <- IHl. + { rewrite setmE. + rewrite E. + reflexivity. + } + intros. + apply H. + rewrite in_cons. + rewrite H1. + rewrite Bool.orb_true_r. auto. +Qed. + +Lemma foldl_set_not_eq {K : ordType} {K' : eqType} {V : eqType} m f g (k : K) (v : V) (l : seq K') : + (∀ k', k' \in l -> k ≠ f k') → + setm (foldl (λ m k, setm m (f k) (g k)) m l) k v = foldl (λ m k, setm m (f k) (g k)) (setm m k v) l. +Proof. + intros h. + rewrite <- revK. + rewrite !foldl_rev. + apply foldr_set_not_eq. + intros k' hk'. + rewrite <- rev_list_rev in hk'. + move: hk' => /InP hk'. + apply List.in_rev in hk'. + apply h. + apply /InP. assumption. +Qed. + +Lemma foldl_foldr_setm + {K : ordType} {K' : eqType} {V : eqType} m (f : K' → K) (g : K' → V) (l : seq K') : + uniq [seq f i | i <- l] → + foldl (λ m k, setm m (f k) (g k)) m l = foldr (λ k m, setm m (f k) (g k)) m l. +Proof. + intros. + induction l. + - reflexivity. + - simpl. + rewrite <- foldl_set_not_eq. + 1: rewrite IHl. + 1: reflexivity. + { intros. simpl in H. move: H => /andP. easy. } + { intros. simpl in H. move: H => /andP [] H _. + clear -H0 H. + induction l. + { simpl in *. inversion H0. } + { simpl in *. rewrite in_cons in H0. + rewrite notin_cons in H. + move: H => /andP [] H1 H2. + move: H0 => /orP [/eqP -> | H0 ]. + { apply /eqP. assumption. } + { apply IHl; assumption. } } } +Qed. + +Lemma chArray_write_aux {sz} (a : 'array) ptr (w : word sz) : + chArray_write a ptr w = chArray_write_foldl a ptr w. +Proof. + unfold chArray_write_foldl, chArray_write, chArray_set8. + rewrite foldl_foldr_setm. 1: reflexivity. + rewrite map_inj_uniq. + - unfold ziota. + admit. + (* rewrite map_inj_uniq. *) + (* + apply iota_uniq. *) + (* + intros n m H. *) + (* micromega.Lia.lia. *) + (* - intros n m H. *) + (* micromega.Lia.lia. *) + (* Qed. *) +Admitted. + +(* From WArray.set *) +Definition chArray_set {ws} (a : 'array) (aa : arr_access) (p : Z) (w : word ws) := + chArray_write a (p * mk_scale aa ws)%Z w. + +(* WArray.set_sub *) +Definition chArray_set_sub (ws : wsize) (len : BinNums.positive) (aa : arr_access) (a : 'array) (p : Z) (b : 'array) : 'array := + let size := arr_size ws len in + let start := (p * mk_scale aa ws)%Z in + foldr (λ i data, + match b i with + | Some w => setm data (start + i)%Z w + | None => remm data (start + i)%Z + end + ) a (ziota 0 size). + +(* Jasmin's write on 'mem *) +Definition write_mem {sz} (m : 'mem) (ptr : word Uptr) (w : word sz) : 'mem := + (* For now we do not worry about alignment *) + foldr (λ (k : Z) (m' : 'mem), + setm m' (ptr + (wrepr Uptr k))%R (LE.wread8 w k) + ) m (ziota 0 (wsize_size sz)). + +Definition translate_write {sz} (p : word Uptr) (w : word sz) : raw_code 'unit := + m ← get mem_loc ;; #put mem_loc := write_mem m p w ;; ret tt. + +Fixpoint lchtuple (ts : seq choice_type) : choice_type := + match ts with + | [::] => 'unit + | [:: t1 ] => t1 + | t1 :: ts => t1 × (lchtuple ts) + end. + +(* Unpack `t : lchtuple stys` into a list `xs` s.t. `nth i xs = (nth i sty, t.i)`. *) +Definition coerce_chtuple_to_list (ty : choice_type) (stys : seq stype) (t : ty) + : list typed_chElement. +Proof. + pose (lchtuple (map encode stys)) as ty'. + destruct (ty == ty') eqn:E. + 2: exact [::]. + move: E. move /eqP => E. + subst. unfold ty' in t. clear ty'. + move: t. induction stys. + - move => _. exact [::]. + - intros. + destruct stys in IHstys, t |- *. + + simpl in *. apply cons. 2: exact [::]. + econstructor. exact t. + + destruct t as [t1 ts]. + pose (IHstys ts) as tl. + pose ((encode a; t1) : typed_chElement) as hd. + exact (hd :: tl). +Defined. + +Fixpoint bind_list (cs : list typed_code) {struct cs} : raw_code ([choiceType of list typed_chElement]) := + match cs with + | [::] => ret [::] + | c :: cs => + v ← c.π2 ;; + vs ← bind_list cs ;; + ret (to_typed_chElement v :: vs) + end. + +Fixpoint type_of_values vs : choice_type := + match vs with + | [::] => 'unit + | [:: v ] => choice_type_of_val v + | hd :: tl => choice_type_of_val hd × type_of_values tl + end. + +(* lchtuple (map choice_type_of_val vs) *) +Definition translate_values (vs : seq value) : + lchtuple (map choice_type_of_val vs). +Proof. + induction vs as [| v vs tr_vs]. + - exact tt. + - destruct vs as [| v' vs']. + + exact (translate_value v). + + exact (translate_value v, tr_vs). +Defined. + +Fixpoint tr_app_sopn {S R} (can : R) (emb : S → R) (ts : list stype) := + match ts as ts' + return (sem_prod ts' (exec S) → [choiceType of list typed_chElement] → R) + with + | [::] => + λ (o : exec S) (vs : list typed_chElement), + match vs with + | [::] => + match o with + | Ok o => emb o + | _ => can + end + | _ :: _ => can + end + | t :: ts' => + λ (o : sem_t t → sem_prod ts' (exec S)) (vs : list typed_chElement), + match vs with + | [::] => can + | v :: vs' => tr_app_sopn can emb ts' (o (unembed (truncate_el t v.π2))) vs' + end + end. + +Section bind_list_alt. + + Definition bind_typed_list (cs : list typed_code) + : raw_code (lchtuple ([seq tc.π1 | tc <- cs])). + Proof. + induction cs as [| c cs bind_cs]. + - exact (ret tt). + - destruct cs as [|c' cs']. + + exact c.π2. + + exact ( vs ← bind_cs ;; + v ← c.π2 ;; + ret (v, vs) ). + Defined. + + Definition bind_list_truncate (l : list (stype * typed_code)) + : raw_code (lchtuple ([seq encode ttc.1 | ttc <- l])). + Proof. + induction l as [| [t c] tcs bind_tcs]. + - exact (ret tt). + - destruct tcs as [| [t' c'] tcs']. + + pose (truncate_code t c) as c'. + exact c'.π2. + + exact ( vs ← bind_tcs ;; + v ← (truncate_code t c).π2 ;; + ret (v, vs) ). + Defined. + + Lemma map_fst {A B C} (xs : seq A) (ys : seq B) (f : A -> C) (H : size xs = size ys) + : [seq f xy.1 | xy <- zip xs ys] = [seq f x | x <- xs]. + Proof. + set (f' := fun xy => f (fst xy)). + assert ([seq f' i | i <- zip xs ys] = map f (unzip1 (zip xs ys))) as mc by apply map_comp. + rewrite mc. + rewrite unzip1_zip. + 1: reflexivity. + now rewrite H. + Qed. + + Definition bind_list_trunc_aux (ts : list stype) (cs : list typed_code) + (H : size ts = size cs) + : raw_code (lchtuple ([seq encode t | t <- ts])). + Proof. + erewrite <- map_fst. + 1: exact (bind_list_truncate (zip ts cs)). + assumption. + Defined. + + Definition bind_list' (ts : list stype) (cs : list typed_code) + : raw_code (lchtuple ([seq encode t | t <- ts])). + Proof. + destruct (size ts == size cs) eqn:e. + - eapply bind_list_trunc_aux. + apply: eqP e. + - exact (ret (chCanonical _)). + Defined. + +End bind_list_alt. +Context {fcp : FlagCombinationParams}. +Definition embed_ot {t} : sem_ot t → encode t := + match t with + | sbool => λ x, + match x with + | Some b => b + | None => false + end + | sint => λ x, x + | sarr n => embed_array + | sword n => λ x, x + end. + +Definition encode_tuple (ts : list stype) : choice_type := + lchtuple [seq encode t | t <- ts]. + +(* takes a tuple of jasmin values and embeds each component *) +Fixpoint embed_tuple {ts} : sem_tuple ts → encode_tuple ts := + match ts as ts0 + return sem_tuple ts0 -> lchtuple [seq encode t | t <- ts0] + with + | [::] => λ (_ : unit), tt + | t' :: ts' => + let rec := @embed_tuple ts' in + match ts' as ts'0 + return + (sem_tuple ts'0 -> lchtuple [seq encode t | t <- ts'0]) → + sem_tuple (t'::ts'0) -> lchtuple [seq encode t | t <- (t'::ts'0)] + with + | [::] => λ _ (v : sem_ot t'), embed_ot v + | t'' :: ts'' => λ rec (p : (sem_ot t') * (sem_tuple (t''::ts''))), (embed_ot p.1, rec p.2) + end rec + end. + +(* tr_app_sopn specialized to when there is only one return value *) +Definition tr_app_sopn_single {t} := + tr_app_sopn (chCanonical (encode t)) embed. + +(* tr_app_sopn specialized to when there is several return values *) +Definition tr_app_sopn_tuple {ts} := + tr_app_sopn (chCanonical (encode_tuple ts)) embed_tuple. + +(* Following sem_pexpr *) +Fixpoint translate_pexpr (p : p_id) (e : pexpr) {struct e} : typed_code := + match e with + | Pconst z => totc 'int (@ret 'int z) (* Why do we need to give 'int twice? *) + | Pbool b => totc 'bool (ret b) + | Parr_init n => + (* Parr_init only gets produced by ArrayInit() in jasmin source. *) + (* The EC export asserts false on it. *) + totc 'array (ret emptym) + | Pvar v => totc _ (translate_gvar p v) + | Pget aa ws x e => + totc ('word ws) ( + arr ← translate_gvar p x ;; (* Performs the lookup in gd *) + let a := coerce_to_choice_type 'array arr in + i ← (truncate_code sint (translate_pexpr p e)).π2 ;; (* to_int *) + let scale := mk_scale aa ws in + ret (chArray_get ws a i scale) + ) + | Psub aa ws len x e => + totc 'array ( + arr ← translate_gvar p x ;; (* Performs the lookup in gd *) + let a := coerce_to_choice_type 'array arr in + i ← (truncate_code sint (translate_pexpr p e)).π2 ;; (* to_int *) + let scale := mk_scale aa ws in + ret (chArray_get_sub ws len a i scale) + ) + | Pload sz x e => + totc ('word sz) ( + w ← translate_get_var p x ;; + let w1 : word _ := truncate_el (sword Uptr) w in + w2 ← (truncate_code (sword Uptr) (translate_pexpr p e)).π2 ;; + chRead (w1 + w2)%R sz + ) + | Papp1 o e => + totc _ ( + (* We truncate and call sem_sop1_typed instead of calling sem_sop1 + which does the truncation and then calls sem_sop1_typed. + *) + x ← (truncate_code (type_of_op1 o).1 (translate_pexpr p e)).π2 ;; + ret (embed (sem_sop1_typed o (unembed x))) + ) + | Papp2 o e1 e2 => + totc _ ( + (* Same here *) + r1 ← (truncate_code (type_of_op2 o).1.1 (translate_pexpr p e1)).π2 ;; + r2 ← (truncate_code (type_of_op2 o).1.2 (translate_pexpr p e2)).π2 ;; + ret match sem_sop2_typed o (unembed r1) (unembed r2) with + | Ok y => embed y + | _ => chCanonical _ + end + ) + | PappN op es => + (* note that this is sligtly different from Papp2 and Papp1, in that + we don't truncate when we bind, but when we apply (in app_sopn_list). + This made the proof easier, but is also more faithful to + how it is done in jasmin. + *) + totc _ ( + vs ← bind_list [seq translate_pexpr p e | e <- es] ;; + ret (tr_app_sopn_single (type_of_opN op).1 (sem_opN_typed op) vs) + ) + | Pif t eb e1 e2 => + totc _ ( + b ← (truncate_code sbool (translate_pexpr p eb)).π2 ;; (* to_bool *) + if b + then (truncate_code t (translate_pexpr p e1)).π2 + else (truncate_code t (translate_pexpr p e2)).π2 + ) + end. + + +Definition translate_write_lval (p : p_id) (l : lval) (v : typed_chElement) + : raw_code 'unit + := + match l with + | Lnone _ ty => ret tt + | Lvar x => translate_write_var p x v + | Lmem sz x e => + vx' ← translate_get_var p x ;; + let vx : word _ := translate_to_pointer vx' in + ve' ← (translate_pexpr p e).π2 ;; + let ve := translate_to_pointer ve' in + let p := (vx + ve)%R in + let w := truncate_chWord sz v.π2 in + translate_write p w + | Laset aa ws x i => + (* Let (n,t) := s.[x] in is a notation calling on_arr_varr on get_var *) + (* We just cast it since we do not track lengths *) + t' ← translate_get_var p x ;; + let t := coerce_to_choice_type 'array t' in + i ← (truncate_code sint (translate_pexpr p i)).π2 ;; (* to_int *) + let v := truncate_chWord ws v.π2 in + let t := chArray_set t aa i v in + translate_write_var p x (totce t) + | Lasub aa ws len x i => + (* Same observation as Laset *) + t ← translate_get_var p x ;; + let t := coerce_to_choice_type 'array t in + i ← (truncate_code sint (translate_pexpr p i)).π2 ;; (* to_int *) + let t' := truncate_el (sarr (Z.to_pos (arr_size ws len))) v.π2 in + let t := chArray_set_sub ws len aa t i t' in + translate_write_var p x (totce t) + end. + +(* the argument to c is its (valid) sub id, the return is the resulting (valid) sub id *) +Fixpoint translate_for (v : var_i) (ws : seq Z) (m_id : p_id) (c : p_id -> p_id * raw_code 'unit) (s_id : p_id) : raw_code 'unit := + match ws with + | [::] => ret tt + | w :: ws => + let (s_id', c') := c s_id in + translate_write_var m_id v (totce (translate_value w)) ;; + c' ;; + translate_for v ws m_id c s_id' + end. + +(* list_ltuple *) +Fixpoint list_lchtuple {ts} : lchtuple ([seq encode t | t <- ts]) → [choiceType of list typed_chElement] := + match ts as ts0 + return + lchtuple ([seq encode t | t <- ts0]) → + [choiceType of list typed_chElement] + with + | [::] => λ _, [::] + | t' :: ts' => + let rec := @list_lchtuple ts' in + match ts' as ts'0 + return + (lchtuple ([seq encode t | t <- ts'0]) → + [choiceType of list typed_chElement]) → + lchtuple [seq encode t | t <- (t'::ts'0)] → + [choiceType of list typed_chElement] + with + | [::] => λ _ (v : encode t'), [:: totce v] + | t'' :: ts'' => λ rec (p : (encode t') × (lchtuple [seq encode t | t <- (t''::ts'')])), totce p.1 :: rec p.2 + end rec + end. + +(* corresponds to exec_sopn *) +Definition translate_exec_sopn (o : sopn) (vs : seq typed_chElement) := + list_lchtuple (tr_app_sopn_tuple _ (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ o) vs). + +Fixpoint foldl2 {A B R} (f : R → A → B → R) (la : seq A) (lb : seq B) r := + match la with + | [::] => r + | a :: la' => + match lb with + | [::] => r + | b :: lb' => foldl2 f la' lb' (f r a b) + end + end. + +Fixpoint foldr2 {A B R} (f : A → B → R → R) (la : seq A) (lb : seq B) r := + match la with + | [::] => r + | a :: la' => + match lb with + | [::] => r + | b :: lb' => f a b (foldr2 f la' lb' r) + end + end. + +Definition translate_write_lvals p ls vs := + foldr2 (λ l v c, translate_write_lval p l v ;; c) ls vs (ret tt). + +Definition translate_write_vars p xs vs := + foldr2 (λ x v c, translate_write_var p x v ;; c) xs vs (ret tt). + +Lemma eq_rect_K : + ∀ (A : eqType) (x : A) (P : A -> Type) h e, + @eq_rect A x P h x e = h. +Proof. + intros A x P' h e. + replace e with (@erefl A x) by apply eq_irrelevance. + reflexivity. +Qed. + +Lemma eq_rect_r_K : + ∀ (A : eqType) (x : A) (P : A → Type) h e, + @eq_rect_r A x P h x e = h. +Proof. + intros A x P' h e. + replace e with (@erefl A x) by apply eq_irrelevance. + reflexivity. +Qed. + +Lemma translate_value_to_val : + ∀ (s : stype) (v : sem_t s), + translate_value (to_val v) = eq_rect_r encode (embed v) (type_of_to_val v). +Proof. + intros s v. + destruct s as [| | size | size]. + all: simpl ; rewrite eq_rect_r_K ; reflexivity. +Qed. + +Definition nat_of_ptr (ptr : pointer) := + (7 ^ Z.to_nat (wunsigned ptr))%nat. + +Definition translate_ptr (ptr : pointer) : Location := + ('word U8 ; nat_of_ptr ptr). + +Lemma ptr_var_nat_neq (ptr : pointer) (p : p_id) (v : var) : + nat_of_ptr ptr != nat_of_p_id_var p v. +Proof. + unfold nat_of_ptr. + unfold nat_of_p_id_var. + apply /eqP. intro e. + apply (f_equal (λ n, n %% 3)) in e. + rewrite -modnMm in e. + rewrite -(modnMm (3 ^ _)) in e. + rewrite Mpowmodn in e. 2: apply nat_of_p_id_nonzero. + rewrite mul0n in e. + rewrite mod0n in e. + rewrite muln0 in e. + move: e => /eqP e. rewrite eqn_mod_dvd in e. 2: auto. + rewrite subn0 in e. + rewrite Natpow_expn in e. rewrite Euclid_dvdX in e. 2: auto. + move: e => /andP [e _]. + rewrite dvdn_prime2 in e. 2,3: auto. + move: e => /eqP e. micromega.Lia.lia. +Qed. + +Lemma ptr_var_neq (ptr : pointer) (p : p_id) (v : var) : + translate_ptr ptr != translate_var p v. +Proof. + unfold translate_ptr. + unfold translate_var. + unfold nat_of_p_id_ident. + apply /eqP. intro e. + noconf e. + move: (ptr_var_nat_neq ptr p v) => /eqP. contradiction. +Qed. + +Definition rel_mem (m : mem) (h : heap) := + ∀ (ptr : pointer) (v : (word U8)), + (* mem as array model: *) + read m ptr U8 = ok v → + (get_heap h mem_loc) ptr = Some v. + +Lemma translate_read : + ∀ s ptr sz w m, + rel_mem s m → + read s ptr sz = ok w → + read_mem (get_heap m mem_loc) ptr sz = w. +Proof. + intros s ptr sz w m hm h. + rewrite readE in h. + jbind h _u eb. apply assertP in eb. + jbind h l hl. noconf h. + unfold read_mem. f_equal. + revert l hl. apply ziota_ind. + - simpl. intros l h. noconf h. reflexivity. + - simpl. intros i l' hi ih l h. + jbind h y hy. jbind h ys hys. noconf h. + erewrite ih. 2: exact hys. + eapply hm in hy. rewrite hy. reflexivity. +Qed. + +Lemma get_mem_read8 : + ∀ m p, + read_mem m p U8 = + match m p with + | Some w => w + | None => chCanonical _ + end. +Proof. + intros m p. + unfold read_mem. simpl. + rewrite <- addE. + rewrite add_0. + destruct (m p) eqn:E. + all: rewrite E; rewrite <- LE.encode8E; apply LE.decodeK. +Qed. + +Lemma write_mem_get ws m p (w : word ws) p' : + write_mem m p w p' = + if (0 <=? sub p' p)%Z && (sub p' p /eqP <-. + rewrite setmE. + rewrite add_sub. + rewrite !eq_refl. + reflexivity. + + move: eb => /eqP. + rewrite setmE. + destruct (p' == add p i) eqn:E. + * rewrite E. + move: E => /eqP E eb. + rewrite E in eb. + rewrite sub_add in eb. + 2:{ destruct ws. all: unfold wsize_size. all: micromega.Lia.lia. } + contradiction. + * rewrite E. intros. apply Ih. +Qed. + +(* Copy of write_read8 *) +Lemma write_read_mem8 : + ∀ m p ws w p', + read_mem (write_mem (sz := ws) m p w) p' U8 = + (let i := sub p' p in + if (0 <=? i)%Z && (i m_id' -> rel_vmap vm m_id h -> rel_vmap vm m_id (set_heap h (translate_var m_id' i) v). +Proof. + intros hneq hrel i' v' H. + rewrite get_set_heap_neq. + 1: apply hrel; auto. + apply injective_translate_var2. + assumption. +Qed. + +(* empty stack/valid *) +Definition empty_stack stack h : Prop := forall i, get_heap h (translate_var stack i) = chCanonical _. + +Lemma coerce_to_choice_type_K : + ∀ (t : choice_type) (v : t), + coerce_to_choice_type t v = v. +Proof. + intros t v. + funelim (coerce_to_choice_type t v). + 2:{ clear - e. rewrite eqxx in e. discriminate. } + rewrite <- Heqcall. + apply cast_ct_val_K. +Qed. + +Lemma empty_stack_spec m_id : + forall h, empty_stack m_id h -> rel_vmap Vm.init m_id h. +Proof. + intros h emp i v hv. + rewrite coerce_to_choice_type_K. + rewrite Vm.initP in hv. + rewrite emp. + unfold translate_var. + destruct (vtype i); now inversion hv. +Qed. + +Definition valid (sid : p_id) (h : heap) := + forall i, sid ≺ i -> empty_stack i h. + +Lemma valid_prec : forall id1 id2 m, id1 ⪯ id2 -> valid id1 m -> valid id2 m. +Proof. + intros id1 id2 m hpre hvalid. + intros id' hprec. + apply hvalid. + eapply preceq_prec_trans; eauto. +Qed. + +Lemma valid_set_heap_disj m_id s_id i v h : + valid m_id h -> disj m_id s_id -> valid m_id (set_heap h (translate_var s_id i) v). +Proof. + intros hvalid hdisj s_id' hpre i'. + rewrite get_set_heap_neq. + 1: apply hvalid; assumption. + apply injective_translate_var2. + intros contra; subst. + eapply disj_antirefl. + eapply disj_prec_l. + 1: eapply hpre. + assumption. +Qed. + +Lemma valid_set_heap_prec m_id s_id i v h : + valid s_id h -> m_id ⪯ s_id -> valid s_id (set_heap h (translate_var m_id i) v). +Proof. + intros hvalid hpre s_id' hpre' i'. + rewrite get_set_heap_neq. + 1: apply hvalid; auto. + apply injective_translate_var2. + apply nesym. + apply prec_neq. + eapply preceq_prec_trans; eauto. +Qed. + +Hint Resolve valid_prec : prefix. + +(* stack *) +Definition stack_frame := (Vm.t (wsw := nosubword) (* TODO: nosubword or withsubword *) * p_id * p_id * list p_id)%type. + +Definition stack := list stack_frame. + +Definition stack_cons s_id (stf : stack_frame) : stack_frame := + (stf.1.1.1, stf.1.1.2, s_id, stf.1.2 :: stf.2). +Notation "s_id ⊔ stf" := (stack_cons s_id stf) (at level 60). + +Definition stf_disjoint m_id s_id s_st := disj m_id s_id /\ forall s_id', List.In s_id' s_st -> disj m_id s_id'. + +Definition valid_stack_frame '(vm, m_id, s_id, s_st) (h : heap) := + rel_vmap vm m_id h /\ + m_id ⪯ s_id /\ + valid s_id h /\ + ~ List.In s_id s_st /\ + List.NoDup s_st /\ + (forall s_id', List.In s_id' s_st -> valid s_id' h) /\ + (forall s_id', List.In s_id' s_st -> m_id ⪯ s_id') /\ + (forall s_id', List.In s_id' s_st -> disj s_id s_id') /\ + (forall s_id' s_id'', List.In s_id' s_st -> List.In s_id'' s_st -> s_id' <> s_id'' -> disj s_id' s_id''). + +Inductive valid_stack' : stack -> heap -> Prop := +| valid_stack'_nil : forall h, valid_stack' [::] h +| valid_stack'_cons : + forall h stf st, + valid_stack' st h -> + (forall stf' : stack_frame, List.In stf' st -> stf_disjoint stf.1.1.2 stf'.1.2 stf'.2) -> + valid_stack_frame stf h -> + valid_stack' (stf :: st) h. + +Inductive valid_stack : stack -> heap -> Prop := +| valid_stack_nil : forall h, valid_stack [::] h +| valid_stack_new : forall st vm m_id s_id h, + valid_stack st h -> + rel_vmap vm m_id h -> + m_id ⪯ s_id -> + valid s_id h -> + (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id') -> + valid_stack ((vm, m_id, s_id, [::]) :: st) h +| valid_stack_sub : forall st vm m_id s_id s_id' s_st h, + valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + m_id ⪯ s_id' -> + valid s_id' h -> + ~ List.In s_id' s_st -> + disj s_id s_id' -> + (forall s_id'', List.In s_id'' s_st -> disj s_id' s_id'') -> + valid_stack ((vm, m_id, s_id', s_id :: s_st) :: st) h. + +Lemma valid_stack_single vm m_id s_id s_st h : + valid_stack_frame (vm, m_id, s_id, s_st) h -> + valid_stack [::(vm, m_id, s_id, s_st)] h. +Proof. + revert s_id. + induction s_st; intros s_id [hrel [hpre1 [hvalid [hnin [hnodup [hvalid2 [hpre2 [hdisj1 hdisj2]]]]]]]]. + - constructor; auto. + + constructor. + - constructor; auto. + + eapply IHs_st; repeat split; auto. + * eapply hpre2; left; auto. + * eapply hvalid2; left; auto. + * inversion hnodup; auto. + * inversion hnodup; auto. + * intros s_id' s_in'. + apply hvalid2; right; auto. + * intros s_id' s_in'. + apply hpre2; right; auto. + * intros s_id' s_in'. + apply hdisj2. + ** left; auto. + ** right; auto. + ** inversion hnodup; subst. + intros contra; subst. + easy. + * intros s_id' s_id'' s_in' s_in'' s_neq. + apply hdisj2. + ** right; auto. + ** right; auto. + ** assumption. + + intros contra. + apply hnin. + right; auto. + + apply disj_sym. + apply hdisj1. + left; auto. + + intros s_id' s_in'. + apply hdisj1. + right; auto. +Qed. + +Lemma valid_stack_cons vm m_id s_id s_st st h : + valid_stack st h -> + (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id') -> + valid_stack_frame (vm, m_id, s_id, s_st) h -> + valid_stack ((vm, m_id, s_id, s_st) :: st) h. +Proof. + revert vm m_id s_id st h. + intros vm m_id s_id st h hvs hdisj1 [hrel [hpre1 [hvalid1 [hnin [hnodup [hvalid2 [hpre2 [hdisj2 hdisj3]]]]]]]]. + revert s_id hpre1 hvalid1 hnin hdisj2. induction s_st. + - constructor; auto. + - constructor; auto. + + eapply IHs_st. + * inversion hnodup; auto. + * intros s_id' s_in'. + apply hvalid2; right; auto. + * intros s_id' s_in'. + apply hpre2; right; auto. + * intros s_id' s_id'' s_in' s_in'' s_neq. + eapply hdisj3. + ** right; auto. + ** right; auto. + ** assumption. + * apply hpre2. + left; auto. + * apply hvalid2. + left; auto. + * inversion hnodup. + auto. + * + intros s_id' s_in'. + apply hdisj3. + ** left; auto. + ** right; auto. + ** inversion hnodup; subst. + intros contra; subst. + auto. + + intros contra. + apply hnin. + right; auto. + + apply disj_sym. + apply hdisj2. + left; auto. + + intros s_id' s_in'. + apply hdisj2. + right; auto. +Qed. + +Lemma valid_stack_valid_stack vm m_id s_id s_st st h : valid_stack ((vm, m_id, s_id, s_st) :: st) h -> valid_stack st h. +Proof. + revert vm m_id s_id. + induction s_st; intros. + - inversion H; assumption. + - inversion H. + eapply IHs_st. + eassumption. +Qed. + +Lemma valid_stack_rel_vmap vm m_id s_id s_st st h : valid_stack ((vm, m_id, s_id, s_st) :: st) h -> rel_vmap vm m_id h. +Proof. + revert vm m_id s_id. + induction s_st; intros. + - inversion H; assumption. + - inversion H. + eapply IHs_st. + eassumption. +Qed. + +Lemma valid_stack_disj vm m_id s_id s_st st h : + valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id'). + revert vm m_id s_id. + induction s_st; intros vm m_id s_id H. + - inversion H. + assumption. + - inversion H. + eapply IHs_st. + eassumption. +Qed. + +Ltac split_and := + repeat lazymatch goal with + | |- _ /\ _ => split + end. + +Lemma invert_valid_stack st vm m_id s_id s_st h : + valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + valid_stack st h + /\ (forall stf, List.In stf st -> disj m_id stf.1.2 /\ forall s_id', List.In s_id' stf.2 -> disj m_id s_id') + /\ valid_stack_frame (vm, m_id, s_id, s_st) h. +Proof. + intros H. unfold valid_stack_frame. + split_and; subst; auto. + - eapply valid_stack_valid_stack; eassumption. + - revert s_id H. + induction s_st. + + intros. + inversion H; subst. + eapply H10; eauto. + + intros s_id H stf. + inversion H; subst. + eapply IHs_st; eauto. + - eapply valid_stack_rel_vmap; eassumption. + - inversion H; auto. + - inversion H; auto. + - inversion H; subst; auto. + intros [contra|contra]; subst. + + eapply disj_antirefl; eauto. + + easy. + - revert s_id H. induction s_st. + + constructor. + + constructor. + * inversion H; subst; auto. + inversion H6; subst; auto. + intros [contra|contra]; subst. + ** eapply disj_antirefl; eauto. + ** eapply disj_antirefl. + eapply H17. + assumption. + * eapply IHs_st. + inversion H; eauto. + - revert s_id H. induction s_st. + + easy. + + intros s_id hvalid s_id' [|s_in']; subst. + * inversion hvalid; subst. + inversion H5; auto. + * eapply IHs_st. + ** inversion hvalid; eassumption. + ** assumption. + - revert s_id H. induction s_st. + + easy. + + intros s_id hvalid s_id' [|s_in']; subst. + * inversion hvalid; subst. + inversion H5; auto. + * eapply IHs_st. + ** inversion hvalid; eassumption. + ** assumption. + - inversion H; subst; auto. + + easy. + + intros s_id' [|s_in']; subst; auto. + inversion H; subst; auto. + apply disj_sym; auto. + - revert s_id H. induction s_st. + + easy. + + intros s_id hvalid s_id' s_id'' [|s_in'] [|s_in''] hneq; subst; auto. + * easy. + * inversion hvalid; subst; auto. + inversion H5; subst; auto. + ** easy. + ** destruct s_in'' as [|s_in'']; subst; auto. + apply disj_sym; auto. + * inversion hvalid; subst; auto. + inversion H5; subst; auto. + ** easy. + ** destruct s_in' as [|s_in']; subst; auto. + apply disj_sym; auto. + * inversion hvalid; subst. + eapply IHs_st; eauto. +Qed. + +Lemma valid_stack'_spec st h : + valid_stack' st h <-> valid_stack st h. +Proof. + split. + - intros. + induction st. + + constructor. + + inversion H; subst. + destruct a as [[[vm m_id] s_id] s_st]. + revert s_id H H3 H5. + induction s_st; intros; destruct H5 as [h1 [h2 [h3 [h4 [h5 [h6 [h7 [h8]]]]]]]]; auto. + * intros; constructor; auto; try easy. + * assert (valid_stack_frame (vm, m_id, a, s_st) h). + { repeat split; eauto. + { apply h7. left. auto. } + { apply h6; left; auto. } + { inversion h5; auto. } + { inversion h5; auto. } + { intros. eapply h6. right; auto. } + { intros; apply h7; right; auto. } + { intros. apply H0. 1: left; auto. + 1: right; auto. + inversion h5; subst. + intros contra; subst. auto. } + { intros. apply H0. 1: right; auto. + 1: right; auto. + auto. } } + constructor; auto. + ** apply IHs_st; auto. + constructor; auto. + ** intros contra. apply h4. right; auto. + ** apply disj_sym. eapply h8. + 1: left; auto. + ** intros. + apply h8. right; auto. + - intros. + induction st. + 1: constructor. + destruct a as [[[vm m_id] s_id] s_st]. + eapply invert_valid_stack in H as [H [H1]]. + constructor. + + apply IHst. easy. + + intros. + unfold stf_disjoint. + intros. + eapply H1. + easy. + + assumption. +Qed. + +Ltac invert_stack st hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2 := + apply invert_valid_stack in st as [hst [hdisj [hevm [hpre [hvalid [hnin [hnodup [hvalid1 [hpre1 [hdisj1 hdisj2]]]]]]]]]]. + +Lemma valid_stack_pop stf st : + ∀ h, valid_stack (stf :: st) h -> + valid_stack st h. +Proof. + intros h H. + destruct stf as [[[? ?] ?] ?]. + eapply valid_stack_valid_stack; eassumption. +Qed. + +Lemma valid_stack_push_sub vm m_id s_id s_st st : + ∀ h, valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + valid_stack ((vm, m_id, s_id~1, s_id~0 :: s_st) :: st) h. +Proof. + intros h vst. + invert_stack vst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + constructor; eauto with prefix. + - eapply valid_stack_cons; unfold valid_stack_frame; split_and; eauto with prefix. + + intros contra. + eapply disj_antirefl. + eapply disj_prec_l. + 1: eapply fresh1. + eapply hdisj1. + assumption. + + intros s_id' s_in'. + eapply disj_prec_l. + 1: eapply fresh1. + apply hdisj1. + assumption. + - intros contra. + eapply disj_antirefl. + eapply disj_prec_l. + 1: eapply fresh2. + eapply hdisj1. + assumption. + - apply fresh_disj. + - intros s_id' s_in'. + eapply disj_prec_l. + 1: eapply fresh2. + apply hdisj1. + assumption. +Qed. + +Lemma valid_stack_pop_sub vm m_id s_id s_id' s_st st : + ∀ h, valid_stack ((vm, m_id, s_id', s_id :: s_st) :: st) h -> + valid_stack ((vm, m_id, s_id, s_st) :: st) h. +Proof. + intros h vst. + inversion vst. + assumption. +Qed. + +Lemma valid_stack_push vm m_id s_id s_st st : + ∀ h, valid_stack ((vm, m_id, s_id, s_st) :: st) h -> + valid_stack ((Vm.init, s_id~1, s_id~1, [::]) :: ((vm, m_id, s_id~0, s_st) :: st)) h. +Proof. + intros h vst. + assert (vst2:=vst). + invert_stack vst2 hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + eapply valid_stack_push_sub in vst. + eapply valid_stack_pop_sub in vst. + constructor; eauto with prefix. + - eapply empty_stack_spec. + eapply hvalid. + apply fresh2. + - intros stf [|stf_in]; subst; split. + + apply disj_sym. apply fresh_disj. + + intros s_id' s_in'. + eapply disj_prec_l. + 1: apply fresh2. + eapply hdisj1. + assumption. + + eapply disj_prec_l. + 1: etransitivity. + 1: eapply hpre. + 1: eapply fresh2. + eapply (proj1 (hdisj stf stf_in)). + + intros s_id' s_in'. + eapply disj_prec_l. + 1: etransitivity. + 1: eapply hpre. + 1: eapply fresh2. + eapply hdisj; eauto. +Qed. + +Lemma valid_stack_set_glob ptr sz (w : word sz) st m : + valid_stack st m -> + valid_stack st (set_heap m mem_loc (write_mem (get_heap m mem_loc) ptr w)). +Proof. + intros val. + induction val; auto. + - constructor; auto. + - constructor; auto. + + intros v hv ev. + rewrite get_set_heap_neq. + 2:{ rewrite eq_sym. apply mem_loc_translate_var_neq. } + apply H. assumption. + + intros i' hpre v. + rewrite get_set_heap_neq. + 2:{ rewrite eq_sym. apply mem_loc_translate_var_neq. } + apply H1. + assumption. + - constructor; auto. + intros i' hpre v. + rewrite get_set_heap_neq. + 2:{ rewrite eq_sym. apply mem_loc_translate_var_neq. } + apply H0. + assumption. +Qed. + +Lemma valid_stack_set_heap i v vm m_id s_id s_st st m : + valid_stack ((vm, m_id, s_id, s_st) :: st) m -> + valid_stack st (set_heap m (translate_var m_id i) v). +Proof. + intros vs. + invert_stack vs hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + induction hst as [ + |st vm' m_id' s_id' h hst IH hevm' hpre' hvalid' hdisj' + |st vm' m_id' s_id' s_id'' s_st' h hst IH hpre' hvalid' hnin' hdisj1' hdisj2']. + - constructor. + - constructor; auto. + + eapply IH; auto; simpl. + intros stf stf_in. + apply hdisj. + right; auto. + + apply rel_vmap_set_heap_neq; auto. + intros contra; subst. + eapply disj_antirefl. + eapply disj_prec_r. + 1: eapply hpre'. + apply disj_sym. + specialize (hdisj (vm', m_id, s_id', [::]) ltac:(left;auto)). + easy. + + apply valid_set_heap_disj; auto. + apply disj_sym. + specialize (hdisj (vm', m_id', s_id', [::]) ltac:(left;auto)). + easy. + - constructor; auto. + + eapply IH; auto. + intros stf [|stf_in]; subst; split. + * eapply hdisj. + 1: left; auto. + left; auto. + * intros s_id''' s_in'''. + eapply hdisj. + 1: left; auto. + right; auto. + * specialize (hdisj stf ltac:(right;auto)). + easy. + * intros s_id''' s_in'''. + eapply hdisj. + 1: right; eauto. + assumption. + + eapply valid_set_heap_disj; auto. + eapply disj_sym . + specialize (hdisj (vm', m_id', s_id'', s_id' :: s_st') ltac:(left;auto)). + easy. +Qed. + +Definition rel_estate (s : @estate (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd ; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |}) (m_id : p_id) (s_id : p_id) (s_st : list p_id) (st : stack) (h : heap) := + (rel_mem (s.(emem)) h /\ valid_stack ((s.(evm), m_id, s_id, s_st) :: st) h). + +Lemma translate_read_estate : + ∀ s ptr sz w m_id s_id s_st c_stack m, + rel_estate s m_id s_id s_st c_stack m → + read (emem s) ptr sz = ok w → + read_mem (get_heap m mem_loc) ptr sz = w. +Proof. + intros s ptr sz w m m_id s_id s_st c_stack rel h. + eapply translate_read. 2: eassumption. + apply rel. +Qed. + +Lemma translate_write_estate : + ∀ sz s cm ptr w m_id s_id s_st st m, + write s.(emem) ptr (sz := sz) w = ok cm → + rel_estate s m_id s_id s_st st m → + rel_estate {| escs := s.(escs) ; emem := cm ; evm := s.(evm) |} m_id s_id s_st st (set_heap m mem_loc (write_mem (get_heap m mem_loc) ptr w)). +Proof. + intros sz s cm ptr w m_id s_id s_st st m hw [hmem hstack]. + split. + - simpl. eapply translate_write_mem_correct. all: eassumption. + - simpl. + apply valid_stack_set_glob. + assumption. +Qed. + +Lemma coerce_cast_code (ty vty : choice_type) (v : vty) : + ret (coerce_to_choice_type ty v) = coerce_typed_code ty (vty ; ret v). +Proof. + simpl. + funelim (coerce_to_choice_type ty v) ; + funelim (coerce_typed_code t (tv ; ret v)). + - rewrite <- Heqcall, <- Heqcall0. + pose proof e as e'. symmetry in e'. + move: e' => /eqP e'. subst. + rewrite cast_ct_val_K. + rewrite cast_typed_code_K. reflexivity. + - simpl in *. congruence. + - simpl in *. congruence. + - rewrite <- Heqcall, <- Heqcall0. + reflexivity. +Qed. + +Lemma coerce_to_choice_type_neq : + ∀ (ty ty' : choice_type) (v : ty), + ty ≠ ty' → + coerce_to_choice_type ty' v = chCanonical _. +Proof. + intros ty ty' v ne. + funelim (coerce_to_choice_type ty' v). + 1:{ + clear - e ne. symmetry in e. move: e => /eqP e. simpl in e. contradiction. + } + symmetry. assumption. +Qed. + +Lemma coerce_to_choice_type_translate_value_to_val : + ∀ ty (v : sem_t ty), + coerce_to_choice_type (encode ty) (translate_value (to_val v)) = + embed v. +Proof. + intros ty v. + destruct ty. + all: simpl. all: rewrite coerce_to_choice_type_K. all: reflexivity. +Qed. + +Lemma totce_coerce t (tv : choice_type) (v : tv) : + t = tv → + totce (coerce_to_choice_type t v) = totce v. +Proof. + intro e. + rewrite e. rewrite coerce_to_choice_type_K. + reflexivity. +Qed. + +Lemma get_var_get_heap : + ∀ x (s : @estate (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |}) (v : value) m_id m, + get_var (true (* TODO: wdb *)) (evm s) x = ok v → + rel_vmap (evm s) m_id m → + get_heap m (translate_var m_id x) = + coerce_to_choice_type _ (translate_value v). +Proof. +(* intros x s v m c_stack ev hevm. *) +(* intros. *) +(* unfold get_var in ev. *) +(* rewrite (@hevm x v). *) +(* + simpl. *) +(* rewrite coerce_to_choice_type_K. *) +(* rewrite <- coerce_to_choice_type_translate_value_to_val. *) +(* reflexivity. *) +(* + destruct ((evm s).[x]) ; [ .. | discriminate ] ; now apply ok_inj in ev. *) +(* Qed. *) +Admitted. + +Lemma translate_get_var_correct : + ∀ x s (v : value) m_id s_id s_st st (cond : heap → Prop), + get_var (true (* TODO: wdb *)) (evm s) x = ok v → + (∀ m, cond m → rel_estate s m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + translate_get_var m_id x ⇓ coerce_to_choice_type _ (translate_value v) + ⦃ cond ⦄. +Proof. + intros x s v m_id s_id s_st st cond ev hcond. + unfold translate_get_var. + eapply u_get_remember. intros vx. + eapply u_ret. intros m [hm hx]. + split. 1: assumption. + unfold u_get in hx. subst. + eapply get_var_get_heap. + - eassumption. + - apply hcond in hm as [_ hst]. + invert_stack hst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. +Qed. + +Lemma translate_gvar_correct (x : gvar) (v : value) s (cond : heap → Prop) m_id s_id s_st st : + get_gvar (true (* TODO: wdb *)) gd (evm s) x = ok v → + (∀ m, cond m → rel_estate s m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + translate_gvar m_id x ⇓ coerce_to_choice_type _ (translate_value v) + ⦃ cond ⦄. +Proof. + intros ev hcond. + unfold translate_gvar. + unfold get_gvar in ev. + destruct is_lvar. + - epose (translate_get_var_correct (x.(gv))). + unfold to_val in e. + simpl in e. + + eapply translate_get_var_correct. all: eassumption. + - rewrite ev. + apply u_ret. intros m hm. + split. 1: assumption. + reflexivity. +Qed. + +Lemma translate_of_val : + ∀ ty v v', + of_val ty v = ok v' → + truncate_el ty (translate_value v) = + coerce_to_choice_type (encode ty) (translate_value (to_val v')). +Proof. + intros ty v v' e. + destruct ty, v. all: simpl in e. all: try discriminate. + all: try solve [ + lazymatch type of e with + | match ?t with _ => _ end = _ => destruct t ; discriminate + end + ]. + - noconf e. simpl. rewrite !coerce_to_choice_type_K. reflexivity. + - noconf e. simpl. rewrite !coerce_to_choice_type_K. reflexivity. + - simpl. rewrite !coerce_to_choice_type_K. + unfold WArray.cast in e. + destruct (p == len) in e. 2: discriminate. + noconf e. simpl. reflexivity. + - simpl. rewrite !coerce_to_choice_type_K. + rewrite e. reflexivity. +Qed. + +Lemma translate_truncate_val : + ∀ ty v v', + truncate_val ty v = ok v' → + truncate_el ty (translate_value v) = + coerce_to_choice_type (encode ty) (translate_value v'). +Proof. + intros ty v v' h. + unfold truncate_val in h. + jbind h vx e. noconf h. + apply translate_of_val. assumption. +Qed. + +Lemma totce_truncate_translate : + ∀ ty v v', + truncate_val ty v = ok v' → + totce (truncate_el ty (translate_value v)) = totce (translate_value v'). +Proof. + intros ty v v' h. + erewrite translate_truncate_val by eassumption. + apply totce_coerce. + unfold choice_type_of_val. + erewrite truncate_val_type by eassumption. + reflexivity. +Qed. + +Lemma bind_list_correct cond cs vs : + [seq c.π1 | c <- cs] = [seq choice_type_of_val v | v <- vs] → + List.Forall2 (λ c v, ⊢ ⦃ cond ⦄ c.π2 ⇓ coerce_to_choice_type _ (translate_value v) ⦃ cond ⦄) cs vs → + ⊢ ⦃ cond ⦄ bind_list cs ⇓ [seq to_typed_chElement (translate_value v) | v <- vs ] ⦃ cond ⦄. +Proof. + revert vs. + induction cs; intros. + - destruct vs. + 2: inversion H. + apply u_ret. + intros; auto. + - simpl. + destruct vs. + 1: inversion H0. + inversion H0; subst. + inversion H; subst. + eapply u_bind. + 1: eassumption. + eapply u_bind. + + apply IHcs; eassumption. + + apply u_ret. + intros; split; auto. + simpl. + rewrite H2. + rewrite coerce_to_choice_type_K. + reflexivity. +Qed. + +Lemma translate_truncate_word : + ∀ sz sz' (w : word sz) (w' : word sz'), + truncate_word sz' w = ok w' → + truncate_chWord sz' (@embed (sword _) w) = w'. +Proof. + intros sz sz' w w' h. + simpl. rewrite h. reflexivity. +Qed. + +Lemma translate_to_word : + ∀ sz v w, + to_word sz v = ok w → + truncate_chWord sz (translate_value v) = w. +Proof. + intros sz v w h. + destruct v as [| | | sz' w' | []]. all: try discriminate. + simpl in h. + unfold translate_value. + apply translate_truncate_word. assumption. +Qed. + +Lemma translate_to_bool : + ∀ v b, + to_bool v = ok b → + coerce_to_choice_type 'bool (translate_value v) = b. +Proof. + intros v b e. + destruct v as [| | | | t]. all: try discriminate. + 2:{ destruct t. all: discriminate. } + simpl in e. noconf e. + rewrite coerce_to_choice_type_K. reflexivity. +Qed. + +Lemma translate_to_int : + ∀ v z, + to_int v = ok z → + coerce_to_choice_type 'int (translate_value v) = z. +Proof. + intros v z e. + destruct v as [| | | | t]. all: try discriminate. + 2:{ destruct t. all: discriminate. } + simpl in e. noconf e. + rewrite coerce_to_choice_type_K. reflexivity. +Qed. + +Lemma translate_to_arr : + ∀ len v a, + to_arr len v = ok a → + coerce_to_choice_type 'array (translate_value v) = translate_value (Varr a). +Proof. + intros len v a e. + destruct v as [| | len' t' | |]. all: try discriminate. + simpl in e. unfold WArray.cast in e. + destruct (_ : bool) eqn:eb. 2: discriminate. + noconf e. simpl. + rewrite coerce_to_choice_type_K. reflexivity. +Qed. + +Lemma translate_truncate_code : + ∀ (c : typed_code) (ty : stype) v v' p q, + truncate_val ty v = ok v' → + c.π1 = choice_type_of_val v → + ⊢ ⦃ p ⦄ c.π2 ⇓ coerce_to_choice_type _ (translate_value v) ⦃ q ⦄ → + ⊢ ⦃ p ⦄ (truncate_code ty c).π2 ⇓ coerce_to_choice_type _ (translate_value v') ⦃ q ⦄. +Proof. + intros c ty v v' p q hv e h. + destruct c as [ty' c]. simpl in *. subst. + eapply u_bind. 1: eapply h. + eapply u_ret. intros m hm. + split. 1: assumption. + rewrite coerce_to_choice_type_K. + apply translate_truncate_val. assumption. +Qed. + +Lemma translate_pexpr_type p s₁ e v : + @sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s₁ e = ok v → + (translate_pexpr p e).π1 = choice_type_of_val v. +Proof. + intros. + revert v H. + destruct e; intros; simpl in *. + 1-3: noconf H; reflexivity. + - eapply type_of_get_gvar in H. + unfold choice_type_of_val. + apply (ssrbool.elimT eqP) in H. + now rewrite H. + - simpl in H. + jbind H x h1. + destruct x. all: try discriminate. + jbind H x h2. + jbind H y h3. + noconf H. + reflexivity. + - jbind H x h1. + destruct x. all: try discriminate. + jbind H x h2. + jbind H y h3. + noconf H. + reflexivity. + - jbind H x h1. + jbind H y h2. + jbind H z h3. + noconf H. + reflexivity. + - jbind H x h1. + jbind H y h2. + noconf H. + unfold choice_type_of_val. + rewrite type_of_to_val. + reflexivity. + - jbind H v1 h1. + jbind H v2 h2. + jbind H v3 h3. + jbind H v4 h4. + jbind H v5 h5. + noconf H. + unfold choice_type_of_val. + rewrite type_of_to_val. + reflexivity. + - jbind H v1 h1. + jbind H v2 h2. + noconf H. + unfold choice_type_of_val. + rewrite type_of_to_val. + reflexivity. + - jbind H v1 h1. + jbind H v2 h2. + jbind H v3 h3. + noconf H. + jbind h2 v4 h4. + jbind h3 v5 h5. + unfold choice_type_of_val. + destruct v1. + all: erewrite truncate_val_type. 1,3: reflexivity. 1,2: eassumption. +Qed. + +Lemma mapM_nil {eT aT bT} f l : + @mapM eT aT bT f l = ok [::] → + l = [::]. +Proof. + intro h. + induction l in h |- *. + - reflexivity. + - simpl in h. + jbind h y hy. jbind h ys hys. noconf h. +Qed. + +Lemma chArray_get_correct (len : BinNums.positive) (a : WArray.array len) (z : Z) ws aa s : + WArray.get aa ws a z = ok s → + chArray_get ws (translate_value (Varr a)) z (mk_scale aa ws) = translate_value (Vword s). +Proof. +Admitted. +(* intros H. *) +(* simpl. *) +(* unfold WArray.get, read in H. *) +(* destruct is_align. 2: discriminate. *) +(* cbn in H. *) +(* jbind H l E. noconf H. *) +(* unfold chArray_get. *) +(* f_equal. *) +(* revert l E. *) +(* apply ziota_ind. *) +(* - intros l E. noconf E. reflexivity. *) +(* - intros i l E IH l0 H. *) +(* destruct l0. *) +(* { apply mapM_nil in H. discriminate. } *) +(* apply mapM_cons in H as [H H0]. *) +(* simpl. *) +(* rewrite (IH l0). 2: assumption. *) +(* apply f_equal2. 2: reflexivity. *) +(* apply chArray_get8_correct. *) +(* assumption. *) +(* Qed. *) + +Lemma chArray_write_correct : + ∀ ws len (a : WArray.array len) i (w : word ws) t, + write (Pointer := WArray.PointerZ) a i w = ok t → + chArray_write (translate_value (Varr a)) i w = translate_value (Varr t). +Proof. + intros. + unfold write in H. + jbind H x Hx. + rewrite chArray_write_aux. + unfold chArray_write_foldl. + revert a H. + apply ziota_ind. + - intros. + simpl in *. + noconf H. + reflexivity. + - intros. + simpl in *. + jbind H1 y Hy. + apply chArray_set8_correct in Hy. + rewrite Hy. + eapply H0. + assumption. +Qed. + +Lemma chArray_get_sub_correct (lena len : BinNums.positive) a aa sz i t : + WArray.get_sub aa sz len a i = ok t → + chArray_get_sub sz len (translate_value (@Varr lena a)) i (mk_scale aa sz) = translate_value (Varr t). +Proof. + intros H. + unfold WArray.get_sub in H. + destruct (_ && _) eqn:E. 2: discriminate. + noconf H. + unfold chArray_get_sub. + unfold WArray.get_sub_data. + move: E => /andP []-> h2. + rewrite <- !foldl_rev. + apply ziota_ind. + - reflexivity. + - intros. + rewrite rev_cons. + rewrite !foldl_rcons. + rewrite H0. + rewrite fold_get. + destruct (Mz.get (WArray.arr_data a) (i * mk_scale aa sz + i0)%Z) eqn:E. + + rewrite E. + rewrite fold_set. + reflexivity. + + rewrite E. + rewrite fold_rem. + reflexivity. +Qed. + +Lemma chArray_set_sub_correct : + ∀ ws (lena len : BinNums.positive) a aa b p t, + @WArray.set_sub lena aa ws len a p b = ok t → + chArray_set_sub ws len aa (translate_value (Varr a)) p (translate_value (Varr b)) + = translate_value (Varr t). +Proof. + intros ws lena len a aa b p t e. + unfold WArray.set_sub in e. + destruct (_ : bool) eqn:eb. 2: discriminate. + noconf e. + unfold chArray_set_sub. unfold WArray.set_sub_data. + move: eb => /andP [e1 e2]. + rewrite <- !foldl_rev. + apply ziota_ind. + - reflexivity. + - intros i l hi ih. + rewrite rev_cons. + rewrite !foldl_rcons. + rewrite ih. + rewrite fold_get. + destruct Mz.get eqn:e. + + rewrite fold_set. + reflexivity. + + rewrite fold_rem. + reflexivity. +Qed. + +(* Like write_mem_get *) +Lemma chArray_write_get : + ∀ ws (a : 'array) (w : word ws) (i j : Z), + chArray_write a i w j = + if (0 <=? j - i)%Z && (j - i /eqP eb. subst. + unfold chArray_set8. + rewrite setmE. + replace (i + (j - i))%Z with j by micromega.Lia.lia. + rewrite eq_refl. + reflexivity. + + simpl. move: eb => /eqP eb. + rewrite setmE. + destruct (_ == _) eqn: e. + 1:{ move: e => /eqP e. subst. micromega.Lia.lia. } + apply ih. +Qed. + +Lemma embed_read8 : + ∀ len (a : WArray.array len) (z : Z) v, + read (Pointer := WArray.PointerZ) a z U8 = ok v → + chArray_get U8 (embed_array a) z 1 = translate_value (Vword v). +Proof. + intros len a z v h. + unfold read in h. jbind h _u hb. jbind h l hl. noconf h. + simpl in hl. jbind hl y hy. noconf hl. + unfold WArray.get8 in hy. jbind hy _u1 hb1. jbind hy _u2 hb2. noconf hy. + unfold odflt, oapp. rewrite <- embed_array_get. rewrite add_0. + simpl. + unfold chArray_get. simpl. + replace (z * 1 + 0)%Z with z by micromega.Lia.lia. + reflexivity. +Qed. + +Lemma chArray_set_correct : + ∀ ws len (a : WArray.array len) aa i (w : word ws) t, + WArray.set a aa i w = ok t → + chArray_set (translate_value (Varr a)) aa i w = translate_value (Varr t). +Proof. + intros ws len a aa i w t h. + unfold WArray.set in h. + unfold chArray_set. + apply chArray_write_correct. assumption. +Qed. + +Lemma sop1_unembed_embed op v : + sem_sop1_typed op (unembed (embed v)) = sem_sop1_typed op v. +Proof. + destruct op as [| | | | | | o]. 1-6: reflexivity. + destruct o. all: reflexivity. +Qed. + +Lemma sop2_unembed_embed op v1 v2 : + sem_sop2_typed op (unembed (embed v1)) (unembed (embed v2)) = + sem_sop2_typed op v1 v2. +Proof. + destruct op. + all: try reflexivity. + all: try destruct o. + all: try destruct c. + all: reflexivity. +Qed. + +Lemma translate_pexprs_types p s1 es vs : + mapM (@sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s1) es = ok vs → + [seq (translate_pexpr p e).π1 | e <- es] = [seq choice_type_of_val v | v <- vs]. +Proof. + revert vs. induction es; intros. + - destruct vs. 2: discriminate. + reflexivity. + - inversion H. + jbind H1 v Hv. + jbind H1 vs' Hvs'. + noconf H1. + simpl. + erewrite IHes by eassumption. + erewrite translate_pexpr_type by eassumption. + reflexivity. +Qed. + +(* jbind with fresh names *) +Ltac jbind_fresh h := + eapply rbindP ; [| exact h ] ; + let x := fresh in + let hx := fresh in + clear h ; intros x hx h ; + cbn beta in h. + +Lemma app_sopn_nil_ok_size {T} {of_T : forall t, T -> exec (sem_t t)} : + ∀ A ts (f : sem_prod ts (exec A)) vs v, + app_sopn of_T f vs = ok v → + size ts = size vs. +Proof. + intros A ts f vs v h. + induction ts as [| t ts ih] in f, vs, v, h |- *. + - destruct vs. 2: discriminate. + reflexivity. + - destruct vs as [| v' vs]. 1: discriminate. + simpl in *. + jbind h v1 hv. + f_equal. eapply ih. eassumption. +Qed. + +Definition WArray_ext_eq {len} (a b : WArray.array len) := + ∀ i, Mz.get a.(WArray.arr_data) i = Mz.get b.(WArray.arr_data) i. + +Notation "a =ₑ b" := (WArray_ext_eq a b) (at level 90). +Notation "(=ₑ)" := WArray_ext_eq (only parsing). + +#[export] Instance WArray_ext_eq_equiv {len} : Equivalence (@WArray_ext_eq len). +Proof. + split. + - intros x. + unfold WArray_ext_eq. + intros. + reflexivity. + - intros x y H. + unfold WArray_ext_eq. + intros. + rewrite H. + reflexivity. + - intros x y z H1 H2. + unfold WArray_ext_eq. + intros. + rewrite H1. + rewrite H2. + reflexivity. +Qed. + +Lemma embed_unembed {t} (a : encode t) : + embed (unembed a) = a. +Proof. + destruct t. 1,2,4: reflexivity. + apply eq_fmap. + intros x. + unfold embed, embed_array, unembed. + rewrite fold_get. + simpl in *. + destruct a. + cbn. + induction fmval; intros; simpl in *. + - rewrite Mz.get0. reflexivity. + - rewrite Mz.setP. + rewrite eq_sym. + destruct (_ == _)%B eqn:E. + + move: E => /eqP ->. + rewrite eq_refl. + reflexivity. + + destruct (@eq_op (BinNums_Z__canonical__Ord_Ord) _ _)%B eqn:E2. + { move: E2 E => /eqP ->. rewrite eq_refl. easy. } + apply IHfmval. + eapply path_sorted. + eassumption. +Qed. + +Lemma unembed_embed_sarr {len} (a : sem_t (sarr len)) : + unembed (embed a) =ₑ a. +Proof. + intros x. + rewrite <- embed_array_get. + change (embed_array (unembed (embed a))) with (embed (unembed (embed a))). + rewrite embed_unembed. + unfold embed, embed_array. + rewrite fold_get. + reflexivity. +Qed. + +Lemma unembed_embed t a : + match t as t0 return sem_t t0 -> Prop with + | sbool => λ a, unembed (embed a) = a + | sint => λ a, unembed (embed a) = a + | sarr p => λ a, unembed (embed a) =ₑ a + | sword s => λ a, unembed (embed a) = a + end a. +Proof. + destruct t. + - reflexivity. + - reflexivity. + - apply unembed_embed_sarr. + - reflexivity. +Qed. + +#[export] Instance unembed_embed_Proper {len} : Proper ((=ₑ) ==> (=ₑ)) (λ (a : sem_t (sarr len)), unembed (embed a)). +Proof. + intros x y H. + rewrite !(unembed_embed (sarr len)). + assumption. +Qed. + +#[export] Instance WArray_get8_Proper {len} : Proper ((=ₑ) ==> eq ==> eq) (@WArray.get8 len). + intros a b H ? ? Hi. + unfold WArray.get8, WArray.in_bound, WArray.is_init. + rewrite H Hi. + reflexivity. +Qed. + +#[export] Instance WArray_get_Proper {len ws} : Proper ((=ₑ) ==> eq ==> eq) (@WArray.get len AAscale ws). +Proof. + intros a b H i j Hij. + unfold WArray.get, read. + rewrite Hij. + destruct is_align. 2: reflexivity. + simpl. f_equal. Admitted. +(* apply eq_mapM. intros. *) +(* rewrite H. *) +(* reflexivity. *) +(* Qed. *) + +(* this should be moved to the jasmin repo *) +Lemma in_rcons_r {S : eqType} (a : S) l : + a \in rcons l a. +Proof. + induction l. + - apply mem_head. + - simpl. + rewrite in_cons IHl. + by apply /orP; right. +Qed. + +Lemma in_rcons_l {S : eqType} (a b : S) l : + a \in l → a \in rcons l b. +Proof. + induction l. + - easy. + - intros. + rewrite in_cons in H. + move: H => /orP []. + + move=> /eqP ->. + rewrite rcons_cons. + rewrite in_cons. + by apply /orP; left. + + move=> H. + rewrite rcons_cons. + rewrite in_cons. + apply /orP; right. + apply IHl; assumption. +Qed. + +Lemma foldM_rcons eT (aT: eqType) bT (f: aT → bT → result eT bT) (a:aT) (b:bT) (l:list aT) : + foldM f b (rcons l a) = Let b' := foldM f b l in f a b'. +Proof. + induction l as [| c l ih] in a, b |- *. + - simpl. destruct (f a b). all: reflexivity. + - simpl. + destruct (f c b). + + simpl. rewrite ih. reflexivity. + + reflexivity. +Qed. + +Lemma eq_foldM eT (aT: eqType) bT (f1 f2: aT → bT → result eT bT) (b:bT) (l:list aT) : + (∀ a b, a \in l → f1 a b = f2 a b) → + foldM f1 b l = foldM f2 b l. +Proof. + replace l with (rev (rev l)) by (apply revK). + set (l' := rev l). + induction l'; intros. + - reflexivity. + - rewrite rev_cons. + rewrite !foldM_rcons. + rewrite IHl'. + + destruct (foldM f2 b (rev l')). 2: reflexivity. + apply H. + rewrite rev_cons. + apply in_rcons_r. + + intros. apply H. + rewrite rev_cons. + apply in_rcons_l. + assumption. +Qed. + +#[export] Instance WArray_copy_Proper {ws p} : Proper ((=ₑ) ==> eq) (@WArray.copy ws p). +Proof. + intros a b H. + unfold WArray.copy, WArray.fcopy. + apply eq_foldM. + intros. + rewrite H. + reflexivity. +Qed. + +Lemma list_tuple_cons_cons {t1 t2 : stype} {ts : seq stype} (p : sem_tuple (t1 :: t2 :: ts)) : + list_ltuple p = (oto_val p.1) :: (list_ltuple (p.2 : sem_tuple (t2 :: ts))). +Proof. reflexivity. Qed. + +Lemma embed_tuple_cons_cons {t1 t2 : stype} {ts : seq stype} (p : sem_tuple (t1 :: t2 :: ts)) : + embed_tuple p = (embed_ot p.1, embed_tuple (p.2 : sem_tuple (t2 :: ts))). +Proof. reflexivity. Qed. + +Lemma list_lchtuple_cons_cons {t1 t2 : stype} {ts : seq stype} (p1 : encode t1) (p2 : lchtuple [seq encode t | t <- (t2 :: ts)]) : + list_lchtuple ((p1, p2) : lchtuple [seq encode t | t <- (t1 :: t2 :: ts)]) = (totce p1) :: (list_lchtuple p2). +Proof. reflexivity. Qed. + +Lemma app_sopn_cons {rT} t ts v vs sem : + @app_sopn _ of_val rT (t :: ts) sem (v :: vs) = + Let v' := of_val t v in @app_sopn _ of_val rT ts (sem v') vs. +Proof. reflexivity. Qed. + +Lemma sem_prod_cons t ts S : + sem_prod (t :: ts) S = (sem_t t → sem_prod ts S). +Proof. reflexivity. Qed. + +Inductive sem_correct {R} : ∀ (ts : seq stype), (sem_prod ts (exec R)) → Prop := +| sem_nil s : sem_correct [::] s +| sem_cons t ts s : (∀ v, (s (unembed (embed v)) = s v)) → (∀ v, sem_correct ts (s v)) → sem_correct (t :: ts) s. + +Lemma tr_app_sopn_correct {R S} (can : S) emb ts vs vs' (s : sem_prod ts (exec R)) : + sem_correct ts s → + app_sopn of_val s vs = ok vs' → + tr_app_sopn can emb ts s [seq to_typed_chElement (translate_value v) | v <- vs] + = emb vs'. +Proof. + intros hs H. + induction hs as [s | t ts s es hs ih] in vs, vs', H |- *. + - destruct vs. 2: discriminate. + simpl in *. subst. + reflexivity. + - simpl in *. + destruct vs as [| v₀ vs]. 1: discriminate. + jbind H v' hv'. + eapply ih in H. + simpl. + erewrite translate_of_val. 2: eassumption. + rewrite coerce_to_choice_type_translate_value_to_val. + rewrite es. + assumption. +Qed. + +Context `{asm_correct : ∀ o, sem_correct (tin (get_instr_desc (Oasm o))) (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ (Oasm o))}. + +Lemma app_sopn_list_tuple_correct o vs vs' : + app_sopn of_val (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ o) vs = ok vs' → + tr_app_sopn_tuple _ (sopn_sem o) [seq to_typed_chElement (translate_value v) | v <- vs] + = + embed_tuple vs'. +Proof using asm_correct. + intros. + unfold tr_app_sopn_tuple. + erewrite tr_app_sopn_correct. + - reflexivity. + - destruct o. + + destruct p ; [ repeat constructor ; + cbn -[wsize_size WArray.copy unembed embed truncate_el] in *; intros ; + rewrite (unembed_embed (sarr _)) ; + reflexivity | .. ] ; repeat constructor. + + destruct s ; try now repeat constructor. + * admit. + * admit. + + apply asm_correct. + - assumption. +Admitted. (* Qed. *) + +Lemma translate_exec_sopn_correct (o : sopn) (ins outs : values) : + @exec_sopn _ values {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} _ o ins = ok outs → + translate_exec_sopn o [seq totce (translate_value v) | v <- ins] = + [seq totce (translate_value v) | v <- outs]. +Proof using asm_correct. + intros H. + unfold translate_exec_sopn. + jbind H vs Hvs. + noconf H. + erewrite app_sopn_list_tuple_correct by eassumption. + clear Hvs. + induction tout. + - reflexivity. + - destruct l. + + destruct a; destruct vs; reflexivity. + + rewrite list_tuple_cons_cons. + rewrite embed_tuple_cons_cons. + rewrite list_lchtuple_cons_cons. + rewrite map_cons. + rewrite IHl. + f_equal. + destruct vs as [e es]. simpl. + destruct a. 2-4: reflexivity. + destruct e. all: reflexivity. +Qed. + +Lemma tr_app_sopn_single_correct (op : opN) (v : sem_t (type_of_opN op).2) (vs : values) : + app_sopn of_val (sem_opN_typed op) vs = ok v → + tr_app_sopn_single + (type_of_opN op).1 + (sem_opN_typed op) + [seq to_typed_chElement (translate_value v) | v <- vs] + = + embed v. +Proof. + intro H. + unfold tr_app_sopn_single. + destruct op as [w p | c]. + - simpl in *. + apply app_sopn_nil_ok_size in H as hl. + rewrite size_nseq in hl. rewrite hl. + rewrite hl in H. + set (f := curry _ _) in *. clearbody f. + induction vs as [| v' vs ih] in v, w, f, H |- *. + + simpl in *. rewrite H. reflexivity. + + simpl in *. jbind H v1 hv1. + eapply ih. eapply translate_to_int in hv1. + rewrite hv1. assumption. + - erewrite tr_app_sopn_correct. + + reflexivity. + + repeat constructor. + + assumption. +Qed. + +Lemma translate_pexpr_correct : + ∀ (e : pexpr) s₁ v (cond : heap → Prop) m_id s_id s_st st, + (@sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s₁ e) = ok v → + (∀ m, cond m → rel_estate s₁ m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + (translate_pexpr m_id e).π2 ⇓ + coerce_to_choice_type _ (translate_value v) + ⦃ cond ⦄. +Proof. + intros e s1 v cond m_id s_id s_st st h1 hcond. + induction e as [z|b| |x|aa ws x e| | | | | | ] in s1, v, h1, cond, hcond |- *. + - simpl in h1. noconf h1. + rewrite coerce_to_choice_type_K. + apply u_ret_eq. auto. + - simpl in h1. noconf h1. + rewrite coerce_to_choice_type_K. + apply u_ret_eq. auto. + - simpl in h1. noconf h1. + rewrite coerce_to_choice_type_K. + apply u_ret_eq. auto. + - simpl in h1. + apply type_of_get_gvar in h1 as es. + unfold translate_pexpr. + unfold translate_gvar. unfold translate_var. + unfold get_gvar in h1. + destruct is_lvar eqn:hlvar. + + destruct x as [gx gs]. simpl in *. + unfold is_lvar in hlvar. simpl in hlvar. move: hlvar => /eqP hlvar. subst. + unfold get_var in h1. + admit. + (* 2:{ destruct e. all: discriminate. } *) + (* noconf h1. *) + (* eapply u_get_remember. simpl. *) + (* intro v. apply u_ret. *) + (* intros m [hm e]. unfold u_get in e. subst. *) + (* split. 1: assumption. *) + (* apply hcond in hm. *) + (* destruct hm as [hm hst]. *) + (* invert_stack hst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. *) + (* apply hevm in e1. rewrite e1. *) + (* simpl. rewrite coerce_to_choice_type_K. *) + (* rewrite coerce_to_choice_type_translate_value_to_val. *) + (* reflexivity. *) + + simpl. + rewrite h1. + apply u_ret. auto. + - simpl in *. + jbind h1 nt ent. destruct nt. all: try discriminate. + jbind h1 j ej. jbind ej j' ej'. + jbind h1 w ew. noconf h1. + rewrite coerce_to_choice_type_K. + eapply u_bind. + + eapply translate_gvar_correct. all: eassumption. + + rewrite !bind_assoc. + eapply u_bind. + * eapply IHe. all: eassumption. + * eapply u_ret. + intros m hm. + split. 1: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + eapply type_of_get_gvar in ent as ety. admit. (* rewrite <- ety. *) + (* rewrite !coerce_to_choice_type_K. *) + (* erewrite translate_to_int. 2: eassumption. *) + (* apply chArray_get_correct. assumption. *) + - (* Psub *) + simpl. simpl in h1. + jbind h1 nt hnt. destruct nt. all: try discriminate. + jbind h1 j hj. jbind hj j' hj'. jbind h1 t ht. noconf h1. + eapply u_bind. + 1:{ eapply translate_gvar_correct. all: eauto. } + rewrite bind_assoc. + eapply u_bind. + 1:{ eapply IHe. all: eauto. } + eapply u_ret. intros m hm. + split. 1: assumption. + rewrite coerce_to_choice_type_K. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + erewrite translate_to_int. 2: eassumption. + apply type_of_get_gvar in hnt. admit. (* rewrite <- hnt. *) + (* rewrite !coerce_to_choice_type_K. *) + (* apply chArray_get_sub_correct. *) + (* assumption. *) + - (* Pload *) + simpl in h1. jbind h1 w1 hw1. jbind hw1 vx hvx. + jbind h1 w2 hw2. jbind hw2 v2 hv2. jbind h1 w hw. noconf h1. + simpl. + eapply u_get_remember. simpl. intros x'. + rewrite bind_assoc. + eapply u_bind. + 1:{ + eapply IHe. 1: eassumption. + intros ? []. eauto. + } + simpl. + eapply u_get_remember. intros mem. + eapply u_ret. unfold u_get. intros m [[hm e1] e2]. + split. 1: assumption. + subst. + rewrite coerce_to_choice_type_K. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + erewrite translate_to_word. 2: eassumption. + eapply hcond in hm. + assert (hm2:=hm). + destruct hm2 as [hm2 hst]. + invert_stack hst hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + erewrite get_var_get_heap. 2-3: eassumption. + simpl. admit. (* erewrite <- type_of_get_var. 2: eassumption. *) + (* rewrite coerce_to_choice_type_K. *) + (* eapply translate_to_word in hw1 as e1. rewrite e1. clear e1. *) + (* eapply translate_read_estate. all: eassumption. *) + - (* Papp1 *) + simpl in *. + jbind h1 v' h2. + rewrite bind_assoc. simpl. + eapply u_bind. + + eapply IHe; eauto. + + apply u_ret. + intros. + split. 1: assumption. + unfold sem_sop1 in h1. + jbind h1 v'' h3. + noconf h1. + rewrite coerce_to_choice_type_translate_value_to_val. + apply translate_pexpr_type with (p:=m_id) in h2. + rewrite h2. + rewrite !coerce_to_choice_type_K. + erewrite translate_of_val. + 2: exact h3. + rewrite coerce_to_choice_type_translate_value_to_val. + f_equal. + apply sop1_unembed_embed. + - (* Papp2 *) + simpl in *. + jbind h1 v' h2. + jbind h1 v'' h3. + rewrite bind_assoc. simpl. + eapply u_bind. + 1: eapply IHe1; eauto. + rewrite bind_assoc. simpl. + eapply u_bind. + 1: eapply IHe2; eauto. + apply u_ret. + intuition subst. + unfold sem_sop2 in h1. + jbind h1 v''' h4. + jbind h1 v'''' h5. + jbind h1 v''''' h6. + noconf h1. + rewrite coerce_to_choice_type_translate_value_to_val. + apply translate_pexpr_type with (p:=m_id) in h2. + apply translate_pexpr_type with (p:=m_id) in h3. + rewrite h2 h3. + rewrite !coerce_to_choice_type_K. + erewrite translate_of_val. + 2: exact h4. + erewrite translate_of_val. + 2: exact h5. + rewrite coerce_to_choice_type_translate_value_to_val. + rewrite coerce_to_choice_type_translate_value_to_val. + rewrite sop2_unembed_embed. + rewrite h6. + reflexivity. + - (* PappN *) + simpl in *. + jbind h1 v' h2. + jbind h1 v'' h3. + noconf h1. + (* jbind h3 v''' h4. *) + eapply u_bind. + + eapply bind_list_correct with (vs := v'). + * rewrite <- map_comp. + unfold comp. + eapply translate_pexprs_types. + eassumption. + * { + clear -h2 H hcond. + revert v' h2 H. + induction es; intros. + - inversion h2. + constructor. + - inversion h2. + jbind H1 x Hx. + jbind H1 y Hy. + noconf H1. + constructor. + + eapply H. + 1: now constructor. + 1: eassumption. + assumption. + + eapply IHes. + 1: assumption. + intros. + eapply H. + { apply List.in_cons. assumption. } + 1: eassumption. + assumption. + } + + apply u_ret. + intros; split; auto. + rewrite coerce_to_choice_type_translate_value_to_val. + apply tr_app_sopn_single_correct. + assumption. + - (* Pif *) + simpl in h1. jbind h1 b eb. jbind eb b' eb'. + jbind h1 v1 ev1. jbind ev1 v1' ev1'. + jbind h1 v2 ev2. jbind ev2 v2' ev2'. + noconf h1. + simpl. rewrite bind_assoc. + eapply u_bind. + 1:{ eapply IHe1. all: eauto. } + simpl. erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + erewrite translate_to_bool. 2: eassumption. + destruct b. + + eapply u_bind. + 1:{ eapply IHe2. all: eauto. } + simpl. eapply u_ret. intros m hm. + split. 1: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + apply translate_truncate_val. assumption. + + eapply u_bind. + 1:{ eapply IHe3. all: eauto. } + simpl. eapply u_ret. intros m hm. + split. 1: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite coerce_to_choice_type_K. + apply translate_truncate_val. assumption. +Admitted. (* Qed. *) + +Lemma translate_pexprs_correct s m_id s_id s_st st vs es : + @sem_pexprs (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s es = ok vs → + List.Forall2 (λ c v, + ⊢ ⦃ rel_estate s m_id s_id s_st st ⦄ + c.π2 + ⇓ coerce_to_choice_type _ (translate_value v) + ⦃ rel_estate s m_id s_id s_st st ⦄ + ) [seq translate_pexpr m_id e | e <- es] vs. +Proof. + intro hvs. + induction es in vs, hvs |- *. + - destruct vs. + + constructor. + + inversion hvs. + - destruct vs. + + simpl in hvs. + jbind hvs vs' hvs'. + jbind hvs vs'' hvs''. + noconf hvs. + + simpl in hvs. + jbind hvs vs' hvs'. + jbind hvs vs'' hvs''. + noconf hvs. + rewrite map_cons. + constructor. + * eapply translate_pexpr_correct. 1: eassumption. + eauto. + * eapply IHes. + assumption. +Qed. + +Corollary bind_list_pexpr_correct + (cond : heap → Prop) (es : pexprs) (vs : list value) + (s1 : estate) m_id s_id s_st st + (hc : ∀ m : heap, cond m → rel_estate s1 m_id s_id s_st st m) + (h : @sem_pexprs (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s1 es = ok vs) : + ⊢ ⦃ cond ⦄ + bind_list [seq translate_pexpr m_id e | e <- es] ⇓ + [seq totce (translate_value v) | v <- vs] + ⦃ cond ⦄. +Proof. + eapply bind_list_correct with (vs := vs). + - rewrite <- map_comp. + unfold comp. + eapply translate_pexprs_types. + exact h. + - revert vs h. + induction es; intros. + + inversion h. + constructor. + + inversion h as [H1]. + jbind H1 x Hx. + jbind H1 y Hy. + noconf H1. + constructor. + * eapply translate_pexpr_correct. + all: eassumption. + * simpl. eapply IHes. + assumption. +Qed. + +Corollary translate_pexpr_correct_cast : + ∀ (e : pexpr) s₁ v m_id s_id s_st st (cond : heap → Prop), + @sem_pexpr (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s₁ e = ok v → + (∀ m, cond m → rel_estate s₁ m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ + coerce_typed_code _ (translate_pexpr m_id e) ⇓ + translate_value v + ⦃ cond ⦄. +Proof. + intros e s v m_id s_id s_st st cond he hcond. + eapply translate_pexpr_correct in he as h. 2: exact hcond. + eapply translate_pexpr_type with (p := m_id) in he. + unfold choice_type_of_val in he. + destruct (translate_pexpr) as [? exp] eqn:?. simpl in *. subst. + rewrite coerce_to_choice_type_K in h. + rewrite coerce_typed_code_K. assumption. +Qed. + + +Lemma translate_write_correct : + ∀ sz s ptr (w : word sz) cm m_id s_id s_st st (cond : heap → Prop), + (∀ m, cond m → write s.(emem) ptr w = ok cm ∧ rel_estate s m_id s_id s_st st m) → + ⊢ ⦃ cond ⦄ translate_write ptr w ⇓ tt ⦃ rel_estate {| escs := s.(escs) ; emem := cm ; evm := s.(evm) |} m_id s_id s_st st ⦄. +Proof. + intros sz s ptr w cm m_id s_id s_st st cond h. + unfold translate_write. + eapply u_get_remember. intros m. + eapply u_put. + eapply u_ret_eq. + intros ? [m' [[h1 h2] ?]]. subst. + unfold u_get in h2. subst. + eapply h in h1. destruct h1. + eapply translate_write_estate. all: assumption. +Qed. + +Lemma valid_stack_set_var i v vm (s : @estate (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |}) m_id s_id s_st st m : + valid_stack ((s.(evm), m_id, s_id, s_st) :: st) m -> + set_var (true (* TODO: wdb *)) (evm s) i v = ok vm -> + valid_stack ((vm, m_id, s_id, s_st) :: st) (set_heap m (translate_var m_id i) (truncate_el (vtype i) (translate_value v))). +Proof. + intros vs hsv. + assert (vs':=vs). + invert_stack vs hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2; auto. + admit. +(* eapply set_varP. 3: exact hsv. *) +(* - intros v1 hv1 eyl; subst. *) +(* eapply valid_stack_cons; unfold valid_stack_frame; split_and; eauto. *) +(* + eapply valid_stack_set_heap. *) +(* eassumption. *) +(* + intros vi vt ev. *) +(* destruct (vi == i) eqn:evar. *) +(* all: move: evar => /eqP evar. *) +(* * subst. rewrite Fv.setP_eq in ev. noconf ev. *) +(* rewrite get_set_heap_eq. rewrite coerce_to_choice_type_K. *) +(* eapply translate_of_val in hv1 as e. *) +(* rewrite e. apply coerce_to_choice_type_translate_value_to_val. *) +(* * rewrite Fv.setP_neq in ev. *) +(* 2:{ apply /eqP. eauto. } *) +(* rewrite get_set_heap_neq. *) +(* 2:{ *) +(* apply /eqP. intro ee. *) +(* apply injective_translate_var in ee. *) +(* contradiction. *) +(* } *) +(* eapply hevm in ev. assumption. *) +(* + eapply valid_set_heap_prec; auto. *) +(* + intros s_id' s_in'. *) +(* eapply valid_set_heap_prec. *) +(* 1: apply hvalid1; auto. *) +(* apply hpre1. assumption. *) +(* - intros hbo hyl hset; subst. *) +(* eapply valid_stack_cons; unfold valid_stack_frame; split_and; auto. *) +(* + eapply valid_stack_set_heap. *) +(* eassumption. *) +(* + intros vi vt ev. *) +(* destruct (vi == i) eqn:evar. *) +(* all: move: evar => /eqP evar. *) +(* 1:{ *) +(* exfalso. subst. rewrite Fv.setP_eq in ev. *) +(* clear - ev hbo. destruct (vtype i). all: discriminate. *) +(* } *) +(* rewrite Fv.setP_neq in ev. *) +(* 2:{ apply /eqP. eauto. } *) +(* rewrite get_set_heap_neq. *) +(* 2:{ *) +(* apply /eqP. intro ee. *) +(* apply injective_translate_var in ee. *) +(* contradiction. *) +(* } *) +(* eapply hevm in ev. assumption. *) +(* + eapply valid_set_heap_prec; auto. *) +(* + intros s_id' s_in'. *) +(* eapply valid_set_heap_prec. *) +(* 1: apply hvalid1; auto. *) +(* apply hpre1. assumption. *) +(* Qed. *) +Admitted. + +Lemma translate_write_var_estate : + ∀ i v s1 s2 m_id s_id s_st st m, + write_var (true (* TODO: wdb *)) i v s1 = ok s2 → + rel_estate s1 m_id s_id s_st st m → + rel_estate s2 m_id s_id s_st st (set_heap m (translate_var m_id i) (truncate_el i.(vtype) (translate_value v))). +Proof using asm_correct gd. + intros i v s1 s2 m_id s_id s_st st m hw [hmem hst]. + unfold write_var in hw. jbind hw vm hvm. noconf hw. + all: simpl. + split. + - intros ptr v' er. + eapply hmem in er. + rewrite get_set_heap_neq. 2: apply mem_loc_translate_var_neq. + assumption. + - eapply valid_stack_set_var; eauto. +Qed. + +Lemma translate_write_var_correct : + ∀ es₁ es₂ m_id s_id s_st st y v, + write_var (true (* TODO: wdb *)) y v es₁ = ok es₂ → + ⊢ ⦃ rel_estate es₁ m_id s_id s_st st ⦄ + translate_write_var m_id y (totce (translate_value v)) + ⇓ tt + ⦃ rel_estate es₂ m_id s_id s_st st ⦄. +Proof using asm_correct gd. + intros es₁ es₂ m_id s_id s_st st y v hw. + simpl. unfold translate_write_var. simpl in hw. + simpl. + eapply u_put. + apply u_ret_eq. + intros m' [m [hm e]]. subst. + eapply translate_write_var_estate. all: eassumption. +Qed. + +Lemma translate_write_lval_correct : + ∀ es₁ es₂ m_id s_id s_st st y v, + @write_lval (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd y v es₁ = ok es₂ → + ⊢ ⦃ rel_estate es₁ m_id s_id s_st st ⦄ + translate_write_lval m_id y (totce (translate_value v)) + ⇓ tt + ⦃ rel_estate es₂ m_id s_id s_st st ⦄. +Proof using asm_correct. + intros es₁ es₂ m_id s_id s_st st y v hw. + destruct y as [ | yl | | aa ws x ei | ] eqn:case_lval. + - simpl. apply u_ret_eq. + intros hp hr. + simpl in hw. unfold write_none in hw. + admit. + (* destruct is_sbool eqn:eb. *) + (* + unfold on_vu in hw. destruct of_val as [| []]. *) + (* all: noconf hw. all: assumption. *) + (* + unfold on_vu in hw. destruct of_val as [| []]. *) + (* all: noconf hw. assumption. *) + - now eapply translate_write_var_correct. + - simpl. simpl in hw. + jbind hw vx hvx. jbind hvx vx' hvx'. jbind hw ve hve. + jbind hve ve' hve'. jbind hw w hw'. jbind hw m hm. + noconf hw. + eapply u_get_remember. intros tv. + eapply u_bind. + 1:{ + eapply translate_pexpr_correct. + - eassumption. + - intros ? []. eassumption. + } + simpl. + eapply translate_write_correct. intros m' [hm' em']. + unfold u_get in em'. subst. + split. 2: assumption. + erewrite translate_pexpr_type. 2: eassumption. + rewrite !coerce_to_choice_type_K. + eapply translate_to_word in hw' as ew. rewrite ew. clear ew. + unfold translate_to_pointer. simpl. + eapply translate_to_word in hve as ew. rewrite ew. clear ew. + erewrite get_var_get_heap. + 3: eapply invert_valid_stack; apply hm'. + 2: eassumption. + simpl. admit. (* erewrite <- type_of_get_var. 2: eassumption. *) + (* rewrite coerce_to_choice_type_K. *) + (* eapply translate_to_word in hvx as ew. rewrite ew. clear ew. *) + (* assumption. *) + - simpl. simpl in hw. + jbind hw nt hnt. destruct nt. all: try discriminate. + jbind hw i hi. jbind hi i' hi'. + jbind hw w ew. jbind hw t ht. + eapply u_get_remember. simpl. intros vx. + rewrite !bind_assoc. simpl. + eapply u_bind. + 1:{ + eapply translate_pexpr_correct. + - eassumption. + - intros ? []. eassumption. + } + simpl. unfold translate_write_var. simpl. + eapply u_put. + eapply u_ret_eq. + intros ? [m [[hs hm] ?]]. subst. + unfold u_get in hm. subst. + erewrite translate_pexpr_type. 2: eassumption. + rewrite !coerce_to_choice_type_K. + eapply translate_to_word in ew. rewrite ew. + erewrite translate_to_int. 2: eassumption. + erewrite get_var_get_heap. + 3: eapply invert_valid_stack; apply hs. + 2: eassumption. + Opaque translate_value. simpl. Transparent translate_value. + eapply type_of_get_var in hnt as ety. simpl in ety. + admit. + (* apply (f_equal encode) in ety. simpl in ety. *) + (* rewrite -ety. rewrite !coerce_to_choice_type_K. *) + (* erewrite chArray_set_correct. 2: eassumption. *) + (* eapply translate_write_var_estate in hs. *) + (* 2: eassumption. *) + (* assumption. *) + - simpl. simpl in hw. + jbind hw nt hnt. destruct nt. all: try discriminate. + jbind hw i hi. jbind hi i' hi'. + jbind hw t' ht'. jbind hw t ht. + eapply u_get_remember. simpl. intros vx. + rewrite !bind_assoc. simpl. + eapply u_bind. + 1:{ + eapply translate_pexpr_correct. + - eassumption. + - intros ? []. eassumption. + } + unfold translate_write_var. simpl. + eapply u_put. + eapply u_ret_eq. + intros ? [m [[hs hm] ?]]. subst. + unfold u_get in hm. subst. + erewrite translate_pexpr_type. 2: eassumption. + rewrite !coerce_to_choice_type_K. + erewrite translate_to_int. 2: eassumption. + erewrite translate_to_arr. 2: eassumption. + erewrite get_var_get_heap. + 3: eapply invert_valid_stack; apply hs. + 2: eassumption. + Opaque translate_value. simpl. Transparent translate_value. + eapply type_of_get_var in hnt as ety. simpl in ety. + admit. + (* apply (f_equal encode) in ety. simpl in ety. *) + (* rewrite -ety. rewrite !coerce_to_choice_type_K. *) + (* erewrite chArray_set_sub_correct. 2: eassumption. *) + (* eapply translate_write_var_estate in hs. *) + (* 2: eassumption. *) + (* assumption. *) +Admitted. (* Qed. *) + +Lemma translate_write_lvals_cons p l ls v vs : + translate_write_lvals p (l :: ls) (v :: vs) = (translate_write_lval p l v ;; translate_write_lvals p ls vs). +Proof. reflexivity. Qed. + +Lemma translate_write_lvals_correct m_id s_id s_st st s1 ls vs s2 : + @write_lvals (nosubword) (* TODO: nosubword or withsubword *) syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)) |} mk_spp (true (* TODO: wdb *)) gd s1 ls vs = ok s2 → + ⊢ ⦃ rel_estate s1 m_id s_id s_st st ⦄ + translate_write_lvals m_id ls [seq totce (translate_value v) | v <- vs] + ⇓ tt + ⦃ rel_estate s2 m_id s_id s_st st ⦄. +Proof using asm_correct. + intros h. + induction ls as [| l ls] in s1, vs, h |- *. + - destruct vs. 2: discriminate. + noconf h. + apply u_ret_eq. auto. + - destruct vs. 1: noconf h. + simpl in h. + jbind h s3 Hs3. + rewrite map_cons. + rewrite translate_write_lvals_cons. + eapply u_bind. + + eapply translate_write_lval_correct. + all: eassumption. + + apply IHls. + assumption. +Qed. + +Lemma translate_write_vars_cons p l ls v vs : + translate_write_vars p (l :: ls) (v :: vs) = + (translate_write_var p l v ;; translate_write_vars p ls vs). +Proof. + reflexivity. +Qed. + +Lemma translate_write_vars_correct m_id s_id s_st st s1 ls vs s2 : + write_vars (true (* TODO: wdb *)) ls vs s1 = ok s2 → + ⊢ ⦃ rel_estate s1 m_id s_id s_st st ⦄ + translate_write_vars m_id ls [seq totce (translate_value v) | v <- vs] + ⇓ tt + ⦃ rel_estate s2 m_id s_id s_st st ⦄. +Proof using asm_correct gd. + intros h. + induction ls as [| l ls] in s1, vs, h |- *. + - destruct vs. 2: discriminate. + noconf h. + apply u_ret_eq. auto. + - destruct vs. 1: noconf h. + simpl in h. + jbind h s3 Hs3. + rewrite map_cons. + rewrite translate_write_vars_cons. + eapply u_bind. + + simpl. + eapply translate_write_var_correct. + all: eassumption. + + apply IHls. + assumption. +Qed. + +End Translation. + +Section Translation. + +Context `{asmop : asmOp}. + +Context {pd : PointerData}. +Context {fcp : FlagCombinationParams}. + +Context (P : uprog). + +Definition instr_d (i : instr) : instr_r := + match i with MkI _ i => i end. + +Definition trunc_list := + (λ tys (vs : seq typed_chElement), + [seq let '(ty, v) := ty_v in totce (truncate_el ty v.π2) | ty_v <- zip tys vs]). + +(* The type of translated function *bodies* *) +Definition fdefs := + (* ∀ p fdef, get_fundef (p_funcs P) p = Some fdef → raw_code 'unit. *) + list (funname * (p_id -> raw_code 'unit)). + +Definition tchlist := [choiceType of seq typed_chElement]. + +(* The type of translated function "calls" *) +Definition trfun := + p_id -> tchlist → raw_code tchlist. + +Definition translate_call_body + (fn : funname) (tr_f_body : p_id -> raw_code 'unit) : trfun. +Proof using P asm_op asmop pd. + (* sem_call *) + refine (λ sid vargs', + match (get_fundef (p_funcs P) fn) with + | Some f => _ + | None => ret [::] end). + pose (trunc_list (f_tyin f) vargs') as vargs. + apply (bind (translate_write_vars sid (f_params f) vargs)) => _. + (* Perform the function body. *) + apply (bind (tr_f_body sid)) => _. + eapply bind. + - (* Look up the results in their locations... *) + exact (bind_list [seq totc _ (translate_get_var sid (v_var x)) + | x <- f_res f]). + - intros vres. + (* ...and coerce them to the codomain of f. *) + pose (trunc_list (f_tyout f) vres) as vres'. + exact (ret vres'). +Defined. + +Definition translate_call (fn : funname) (tr_f_body : fdefs) : trfun. +Proof using P asm_op asmop pd. + refine (λ sid vargs, match assoc tr_f_body fn with + | Some tr_f => _ | None => ret [::] end). + exact (translate_call_body fn tr_f sid vargs). +Defined. + +Fixpoint translate_instr_r + (tr_f_body : fdefs) + (i : instr_r) (m_id : p_id) (s_id : p_id) {struct i} + : p_id * raw_code 'unit + +with translate_instr (tr_f_body : fdefs) + (i : instr) (m_id : p_id) (s_id : p_id) {struct i} : p_id * raw_code 'unit := + translate_instr_r tr_f_body (instr_d i) m_id s_id. +Proof using P asm_op asmop pd fcp. + pose proof (translate_cmd := + (fix translate_cmd (tr_f_body : fdefs) (c : cmd) (m_id : p_id) (s_id : p_id) : p_id * raw_code 'unit := + match c with + | [::] => (s_id, ret tt) + | i :: c => + let (s_id', i') := translate_instr tr_f_body i m_id s_id in + let (s_id'', c') := translate_cmd tr_f_body c m_id s_id' in + (s_id'', i' ;; c') + end + ) + ). + refine + match i with + | Cassgn l _ s e => + let tr_p := translate_pexpr (p_globs P) m_id e in + (s_id, + v ← tr_p.π2 ;; + (translate_write_lval (p_globs P) m_id l (totce (truncate_el s v))) + ) + | Copn ls _ o es => + let cs := [seq (translate_pexpr (p_globs P) m_id e) | e <- es] in + let vs := bind_list cs in + + (s_id, + bvs ← vs ;; + translate_write_lvals (p_globs P) m_id ls (translate_exec_sopn o bvs) + ) + | Cif e c1 c2 => + let (s_id', c1') := translate_cmd tr_f_body c1 m_id s_id in + let (s_id'', c2') := translate_cmd tr_f_body c2 m_id s_id' in + let e' := translate_pexpr (p_globs P) m_id e in + let rb := coerce_typed_code 'bool e' in + (s_id'', + b ← rb ;; if b then c1' else c2' + ) + | Cfor i r c => + let '(d, lo, hi) := r in + let (s_id', fresh) := fresh_id s_id in + let loᵗ := coerce_typed_code 'int (translate_pexpr (p_globs P) m_id lo) in + let hiᵗ := coerce_typed_code 'int (translate_pexpr (p_globs P) m_id hi) in + let cᵗ := translate_cmd tr_f_body c m_id in + (s_id', + vlo ← loᵗ ;; + vhi ← hiᵗ ;; + translate_for i (wrange d vlo vhi) m_id cᵗ fresh) + | Ccall (* ii *) xs f args => + let (s_id', fresh) := fresh_id s_id in + let cs := [seq (translate_pexpr (p_globs P) m_id e) | e <- args] in + (s_id', + vargs ← bind_list cs ;; + vres ← translate_call f tr_f_body fresh vargs ;; + translate_write_lvals (p_globs P) m_id xs vres + ) + | _ => (s_id, unsupported.π2) + end. +Defined. + +(* translate_instr is blocked because it is a fixpoint *) +Lemma translate_instr_unfold : + ∀ ep i st, + translate_instr ep i st = translate_instr_r ep (instr_d i) st. +Proof. + intros ep i st. + destruct i. reflexivity. +Qed. + +(* Trick to have it expand to the same as the translate_cmd above *) +Section TranslateCMD. + +Fixpoint translate_cmd (tr_f_body : fdefs) (c : cmd) (id : p_id) (sid : p_id) : p_id * raw_code 'unit := + match c with + | [::] => (sid, ret tt) + | i :: c => + let (sid', i') := translate_instr tr_f_body i id sid in + let (sid'', c') := translate_cmd tr_f_body c id sid' in + (sid'', i' ;; c') + end. + +End TranslateCMD. + +Record fdef := { + ffun : typed_raw_function ; + locs : {fset Location} ; + imp : Interface ; +}. +#[local] Definition ty_in fd := (ffun fd).π1. +#[local] Definition ty_out fd := ((ffun fd).π2).π1. +Definition translate_fundef + (tr_f_body : fdefs) + (p : p_id) + (fd : _ufun_decl (* extra_fun_t *)) : funname * fdef. +Proof using P asm_op asmop pd fcp. + destruct fd. destruct _f. + split. 1: exact f. + constructor. + - pose (lchtuple (map encode f_tyin)) as tyin'. + pose (lchtuple (map encode f_tyout)) as tyout'. + exists tyin', tyout'. intros vargs'. + + (* NB: We coerce rather than truncating here, i.e. we expect the arguments + provided to us to be of the correct type. This differs slightly from + Jasmin where the truncation is performed in `sem_call`. However, as + explained in the translation of `Ccall` in `translate_instr_r`, we need + the types of the arguments to match the function in order to write the + function application, so we truncate at the caller side. We thus expect + the arguments to already be of the type `f_tyin` prescribed by the + function `f`. *) + apply (coerce_chtuple_to_list _ f_tyin) in vargs'. + + (* Write the arguments to their locations. *) + pose (map (λ '(x, (ty; v)), translate_write_var p x (totce v)) + (zip f_params vargs')) + as cargs. + apply (foldl (λ c k, c ;; k) (ret tt)) in cargs. + apply (bind cargs) => _. + + (* Perform the function body. *) + apply (bind (translate_cmd tr_f_body f_body p p).2) => _. + + (* Look up the results in their locations and return them. *) + pose (map (λ x, totc _ (translate_get_var p(* f *) (v_var x))) f_res) as cres. + exact (bind_list' f_tyout cres). + - exact fset0. + - exact [interface]. +Defined. + +(* Apply cast_fun or return default value, like lookup_op *) +Equations? cast_typed_raw_function {dom cod : choice_type} (rf : typed_raw_function) : dom → raw_code cod := + cast_typed_raw_function rf with inspect ((dom == rf.π1) && (cod == rf.π2.π1)) := { + | @exist true e => pkg_composition.cast_fun _ _ rf.π2.π2 ; + | @exist false e => λ _, ret (chCanonical _) + }. +Proof. + all: symmetry in e. + all: move: e => /andP [/eqP e1 /eqP e2]. + all: eauto. +Defined. + +Definition get_fundef_ssp (sp : seq (funname * fdef)) (fn : funname) (dom cod : choice_type) : + option (dom → raw_code cod) := + match assoc sp fn with + | Some fd => Some (cast_typed_raw_function fd.(ffun)) + | None => None + end. + +End Translation. + +Section Translation. + +Context `{asmop : asmOp}. + +Context {pd : PointerData}. +Context {fcp : FlagCombinationParams}. + +Definition ssprove_prog := seq (funname * trfun). + +Definition translate_prog (prog : uprog) : fdefs. +Proof using asm_op asmop pd fcp. + destruct prog. + induction p_funcs. + - exact [::]. + - unfold fdefs. unfold ssprove_prog. + apply cons. 2: exact IHp_funcs. + pose a.1 as fn. + split. 1: exact fn. + destruct a. destruct _f. + intros s_id. + exact (translate_cmd (Build__prog p_funcs p_globs p_extra) IHp_funcs f_body s_id s_id).2. +Defined. + +Definition tr_p (prog : uprog) : ssprove_prog. +Proof using asm_op asmop pd fcp. + pose (fs := translate_prog prog). + induction fs as [|f fs ?]. + - constructor 1. + - constructor 2. + 2: assumption. + exact (f.1, translate_call prog f.1 (f::fs)). +Defined. + +Definition translate_funs (P : uprog) : seq _ufun_decl → fdefs * ssprove_prog := + let fix translate_funs (fs : seq _ufun_decl) : fdefs * ssprove_prog := + match fs with + | [::] => ([::], [::]) + | f :: fs' => + let '(fn, f_extra) := f in + let tr_body := fun sid => (translate_cmd P (translate_funs fs').1 (f_body f_extra) sid sid).2 in + let tr_fs := (fn, tr_body) :: (translate_funs fs').1 in + let tr_p := (fn, translate_call_body P fn tr_body) :: (translate_funs fs').2 in + (tr_fs, tr_p) + end + in translate_funs. + +Definition translate_prog' P := + translate_funs P (p_funcs P). + +Fixpoint translate_funs_static (P : uprog) (fs : seq _ufun_decl) (st_funcs : fdefs) : fdefs * ssprove_prog := + match fs with + | [::] => ([::], [::]) + | f :: fs' => + let '(tr_fs', tr_p') := translate_funs_static P fs' st_funcs in + let '(fn, f_extra) := f in + let tr_body := fun sid => (translate_cmd P st_funcs (f_body f_extra) sid sid).2 in + let tr_fs := (fn, tr_body) :: tr_fs' in + let tr_p := (fn, translate_call_body P fn tr_body) :: tr_p' in + (tr_fs, tr_p) + end. + +Definition translate_prog_static P st_funcs := + translate_funs_static P (p_funcs P) st_funcs. + +Definition get_translated_static_fun P fn st_func := + match assoc (translate_prog_static P st_func).2 fn with + | Some f => f + | None => fun _ _ => ret [::] + end. + +Lemma tr_prog_inv {P fn f} : + get_fundef (p_funcs P) fn = Some f → + ∑ fs' l, + p_funcs P = l ++ (fn, f) :: fs' ∧ + assoc (translate_prog' P).1 fn = Some (fun sid => (translate_cmd P (translate_funs P fs').1 (f_body f) sid sid).2) /\ + assoc (translate_prog' P).2 fn = Some (translate_call P fn (translate_funs P ((fn, f) :: fs')).1). +Proof. + unfold translate_prog'. + induction (p_funcs P) as [|[gn g] fs' ih_fs']. + - move => //. + - (* simpl in *. *) + move => h //. + simpl in h. + destruct (fn == gn) eqn:e. + + move /eqP in e. + subst. + noconf h. + exists fs'. + exists [::]. + simpl. + destruct (translate_funs P fs') as [f_body f_prog] eqn:E2. + simpl. + unfold translate_call. simpl. + assert (E : gn == gn) by now apply /eqP. + rewrite E. easy. + + specialize (ih_fs' h). + simpl. + destruct (translate_funs P fs') as [fdefs ctrrogs] eqn:E2. + destruct ih_fs' as [fs'0 [l0 [ihl [iha ihb]]]]. simpl. + rewrite e. + rewrite ihl. + exists fs'0. exists ((gn, g) :: l0). + subst. split; [|split]; try easy. +Qed. + +(** Handled programs + + This predicate eliminates programs that are currently not supported by the + translation. This is mainly used to disallow while loops. + It also checks programs for acyclicity and correct ordering. +*) + +Fixpoint instr_r_fs + (i : instr_r) (fs : seq _ufun_decl) {struct i} + : bool +with instr_fs (i : instr) (fs : seq _ufun_decl) {struct i} + : bool := + instr_r_fs (instr_d i) fs. +Proof. + pose proof (cmd_fs := + (fix cmd_fs (c : cmd) (fs : seq _ufun_decl) : bool := + match c with + | [::] => true + | i :: c => + cmd_fs c fs && instr_fs i fs + end + )). + refine + match i with + | Cassgn l _ s e => + true + | Copn ls _ o es => + true + | Csyscall ls sc es => + true + | Cif e c1 c2 => + cmd_fs c1 fs && cmd_fs c2 fs + | Cfor i r c => + cmd_fs c fs + | Cwhile _ c1 _ c2 => cmd_fs c1 fs && cmd_fs c2 fs + | Ccall (* ii *) xs f args => + f \in [seq p.1 | p <- fs] + end. +Defined. + +Section CmdFS. + +Fixpoint cmd_fs (c : cmd) (fs : seq _ufun_decl) : bool := + match c with + | [::] => true + | i :: c => + cmd_fs c fs && instr_fs i fs + end. + +End CmdFS. + +Fixpoint handled_instr (i : instr) := + match i with + | MkI ii i => handled_instr_r i + end + +with handled_instr_r (i : instr_r) := + match i with + | Cassgn l tag sty e => true + | Copn l tag o es => true + | Csyscall _ _ _ => false + | Cif e c₁ c₂ => List.forallb handled_instr c₁ && List.forallb handled_instr c₂ + | Cfor i r c => List.forallb handled_instr c + | Cwhile al cb e c => false + | Ccall (* ii *) l fn es => true + end. + +Definition handled_cmd (c : cmd) := + List.forallb handled_instr c. + +Definition handled_fundecl (f : _ufun_decl) := + handled_cmd f.2.(f_body). + +Lemma lemma3 suf pre : + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) (suf ++ pre)).1 -> + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) pre).1. +Proof. + intros H. + induction suf. + - easy. + - simpl in *. + apply IHsuf. + destruct foldr. + destruct b. + + easy. + + easy. +Qed. + +Lemma lemma4 pre : + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) pre).2 = pre. +Proof. + induction pre. + - reflexivity. + - simpl. + destruct foldr. + destruct b; simpl in *; congruence. +Qed. + +Lemma lemma2 g gn (pre suf : list _ufun_decl) : + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) (suf ++ (gn,g) :: pre)).1 -> + cmd_fs g.(f_body) pre. +Proof. + intros. + eapply lemma3 in H. + simpl in H. + pose proof lemma4 pre. + destruct foldr. + destruct b; simpl in *; congruence. +Qed. + +Definition handled_program (P : uprog) := + List.forallb handled_fundecl P.(p_funcs) && + (foldr (fun f '(b, l) => if b then (cmd_fs f.2.(f_body) l, f :: l) else (false, f :: l)) (true, [::]) P.(p_funcs)).1 && + uniq [seq p.1 | p <- P.(p_funcs)]. +Context `{sc_sem : syscall_sem }. + +Fact sem_call_get_some {P m1 scs1 gn vargs m2 scs2 vres} : + (@sem_call (nosubword) (* TODO: nosubword or withsubword *) direct_c (* TODO: direct? *) asm_op syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)); |} mk_spp {| + _asmop := asmop; _sc_sem := sc_sem |} _ (sCP_unit (* TODO *)) P (tt (* TODO *)) scs1 m1 gn vargs scs2 m2 vres → + ∃ f, get_fundef (p_funcs P) gn = Some f ). +Proof. intros H. inversion H. exists f. easy. +Qed. + +Definition get_translated_fun P fn : trfun := + match assoc (translate_prog' P).2 fn with + | Some f => f + | None => λ _ _, ret [::] + end. + +Lemma translate_call_head {P gn fs' f} : + assoc (translate_prog' P).1 gn = + Some (fun sid => (translate_cmd P (translate_funs P fs').1 (f_body f) sid sid).2) + → + translate_call P gn (translate_funs P (p_funcs P)).1 + = translate_call P gn (translate_funs P ((gn,f) :: fs')).1. +Proof. + intros ef. + unfold translate_call at 1. + rewrite ef. + simpl. + destruct (translate_funs P fs'). simpl. + unfold translate_call, assoc at 1. + assert (E : gn == gn) by now apply /eqP. + now rewrite E. +Qed. + +Context `{asm_correct : ∀ o, sem_correct (tin (get_instr_desc (Oasm o))) (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ (Oasm o))}. +Context (gd : glob_decls). + +Lemma translate_instr_r_if P SP e c1 c2 id sid : + translate_instr_r P SP (Cif e c1 c2) id sid = + let (sid', c1') := translate_cmd P SP c1 id sid in + let (sid'', c2') := translate_cmd P SP c2 id sid' in + let e' := translate_pexpr (p_globs P) id e in + let rb := coe_tyc 'bool e' in (sid'', b ← rb ;; + if b + then c1' + else c2'). +Proof. reflexivity. Qed. + +Lemma translate_instr_r_for P SP i r c id sid : + translate_instr_r P SP (Cfor i r c) id sid = + let '(d, lo, hi) := r in + let (sid', fresh) := fresh_id sid in + let loᵗ := coe_tyc 'int (translate_pexpr (p_globs P) id lo) in + let hiᵗ := coe_tyc 'int (translate_pexpr (p_globs P) id hi) in + let cᵗ := translate_cmd P SP c id in (sid', vlo ← loᵗ ;; + vhi ← hiᵗ ;; + translate_for i (wrange d vlo vhi) id cᵗ fresh). +Proof. reflexivity. Qed. + + +Ltac invert_stack st hst hdisj hevm hpre hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2 := + apply invert_valid_stack in st as [hst [hdisj [hevm [hpre [hvalid [hnin [hnodup [hvalid1 [hpre1 [hdisj1 hdisj2]]]]]]]]]]. + +Ltac split_and := + repeat lazymatch goal with + | |- _ /\ _ => split + end. + +Lemma valid_stack_prec vm m_id s_id1 s_id2 s_st st h : + s_id1 ⪯ s_id2 -> + valid_stack ((vm, m_id, s_id1, s_st) :: st) h -> + valid_stack ((vm, m_id, s_id2, s_st) :: st) h. +Proof. + intros hpre12 vst. + invert_stack vst hst hevm hpre hdisj hvalid hnin hnodup hvalid1 hpre1 hdisj1 hdisj2. + eapply valid_stack_cons; unfold valid_stack_frame; split_and; eauto with prefix. + - eapply valid_prec; eauto. + - intros contra. + eapply disj_antirefl. + eapply disj_prec_r. + 1: eapply hpre12. + apply disj_sym. + apply hdisj1. + assumption. + - intros s_id' s_in'. + eapply disj_prec_l. + 1: eapply hpre12. + apply hdisj1. + assumption. +Qed. + +Lemma rel_estate_prec : forall h s m_id s_id1 s_id2 s_st st, + s_id1 ⪯ s_id2 -> + rel_estate s m_id s_id1 s_st st h -> + rel_estate (syscall_state := syscall_state) s m_id s_id2 s_st st h. +Proof. + intros h s m_id s_id1 s_id2 s_st st hpre12 [hmem hstack]; split; auto. + eapply valid_stack_prec; eauto. +Qed. + +Lemma rel_estate_pop_sub s m_id s_id s_id' s_st st : + ∀ h, rel_estate s m_id s_id (s_id' :: s_st) st h → rel_estate (syscall_state := syscall_state) s m_id s_id' s_st st h. +Proof. + intros h [hmem hstack]. + split. + - assumption. + - eapply valid_stack_pop_sub; eassumption. +Qed. + +Lemma rel_estate_pop scs m vm vm' m_id m_id' s_id s_id' s_st s_st' st : + ∀ h, rel_estate {| escs := scs ; emem := m ; evm := vm |} m_id s_id s_st ((vm',m_id',s_id',s_st') :: st) h → + rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m ; evm := vm' |} m_id' s_id' s_st' st h. +Proof. + intros h [hmem hstack]. + split. + - assumption. + - eapply valid_stack_pop; eassumption. +Qed. + +Lemma rel_estate_push_sub s m_id s_id s_st st : + ∀ h : heap, rel_estate s m_id s_id s_st st h → + rel_estate (syscall_state := syscall_state) s m_id s_id~1 (s_id~0 :: s_st) st h. +Proof. + intros h [hmem hstack]; split. + - assumption. + - eapply valid_stack_push_sub; eassumption. +Qed. + +Lemma rel_estate_push m vm scs m_id s_id s_st st : + ∀ h : heap, rel_estate {| escs := scs ; emem := m ; evm := vm |} m_id s_id s_st st h → + rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m ; evm := Vm.init |} s_id~1 s_id~1 [::] ((vm, m_id, s_id~0, s_st) :: st) h. +Proof. + intros h [hmem hstack]; split. + - assumption. + - eapply valid_stack_push; eassumption. +Qed. + +Lemma translate_cmd_preceq P SP c m_id s_id : + let (s_id', _) := translate_cmd P SP c m_id s_id in s_id ⪯ s_id'. +Proof. + revert s_id. + set (Pr := fun (i : instr_r) => + forall s_id, let (s_id', _) := translate_instr_r P SP i m_id s_id in + s_id ⪯ s_id'). + set (Pi := fun (i : instr) => + Pr (instr_d i)). + set (Pc := fun (c : cmd) => + forall s_id, + let (s_id', _) := translate_cmd P SP c m_id s_id in + s_id ⪯ s_id'). + eapply cmd_rect with + (Pr := Pr) + (Pi := Pi) + (Pc := Pc); + try easy + . + - intros s_id. + simpl; reflexivity. + - intros i c0 ihi ihc s_id. + simpl. + rewrite translate_instr_unfold. + specialize (ihi s_id). + destruct translate_instr_r as [s_id' ?]. + specialize (ihc s_id'). + destruct translate_cmd. + etransitivity; eauto. + - intros x tg ty e i; simpl; reflexivity. + - intros xs t o es i; simpl; reflexivity. + - intros xs o es i; simpl; reflexivity. + - intros e c1 c2 ihc1 ihc2 s_id. + rewrite translate_instr_r_if. + specialize (ihc1 s_id). + destruct translate_cmd as [s_id' ?]. + specialize (ihc2 s_id'). + destruct translate_cmd as [s_id'' ?]. + simpl. + etransitivity; eauto. + - intros v dir lo hi c' ihc s_id. + rewrite translate_instr_r_for. + simpl. + apply fresh1. + - intros a c1 e c2 ihc1 ihc2 s_id. + simpl; reflexivity. + - intros ? ? ? ?. + simpl. + apply fresh1. +Qed. + +Lemma translate_instr_r_preceq P SP i id s_id : + let (s_id', _) := translate_instr_r P SP i id s_id in s_id ⪯ s_id'. +Proof. + revert s_id. + set (Pr := fun (i : instr_r) => + forall s_id, let (s_id', _) := translate_instr_r P SP i id s_id in + s_id ⪯ s_id'). + set (Pi := fun (i : instr) => + Pr (instr_d i)). + set (Pc := fun (c : cmd) => + forall s_id, + let (s_id', _) := translate_cmd P SP c id s_id in + s_id ⪯ s_id'). + eapply instr_r_Rect with + (Pr := Pr) + (Pi := Pi) + (Pc := Pc); + try easy + . + - intros s_id. + simpl; reflexivity. + - intros i' c0 ihi ihc s_id. + simpl. + rewrite translate_instr_unfold. + specialize (ihi s_id). + destruct translate_instr_r as [s_id' ?]. + specialize (ihc s_id'). + destruct translate_cmd. + etransitivity; eauto. + - intros x tg ty e i'; simpl; reflexivity. + - intros xs t o es i'; simpl; reflexivity. + - intros xs o es i'; simpl; reflexivity. + - intros e c1 c2 ihc1 ihc2 s_id. + rewrite translate_instr_r_if. + specialize (ihc1 s_id). + destruct translate_cmd as [s_id' ?]. + specialize (ihc2 s_id'). + destruct translate_cmd as [s_id'' ?]. + simpl. + etransitivity; eauto. + - intros v dir lo hi c' ihc s_id. + rewrite translate_instr_r_for. + simpl. + apply fresh1. + - intros a c1 e c2 ihc1 ihc2 s_id. + simpl; reflexivity. + - intros ? ? ? ?. + simpl. + apply fresh1. +Qed. + +Lemma translate_instr_r_pres P SP c s m_id s_id s_st st h : + let (s_id', _) := translate_instr_r P SP c m_id s_id in + rel_estate s m_id s_id s_st st h -> rel_estate (syscall_state := syscall_state) s m_id s_id' s_st st h. +Proof. + pose proof translate_instr_r_preceq P SP c m_id s_id. + destruct translate_instr_r as [s_id' ?]. + apply rel_estate_prec; assumption. +Qed. + +Lemma translate_cmd_pres P SP c s m_id s_id s_st st h : + let (s_id', _) := translate_cmd P SP c m_id s_id in + rel_estate s m_id s_id s_st st h -> rel_estate (syscall_state := syscall_state) s m_id s_id' s_st st h. +Proof. + pose proof translate_cmd_preceq P SP c m_id s_id. + destruct translate_cmd as [s_id' ?]. + apply rel_estate_prec; assumption. +Qed. + +Definition Pfun (P : uprog) (fn : funname) scs m va scs' m' vr vm m_id s_id s_st st := + ⊢ ⦃ rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m; evm := vm |} m_id s_id s_st st ⦄ + get_translated_fun P fn s_id~1 [seq totce (translate_value v) | v <- va] + ⇓ [seq totce (translate_value v) | v <- vr] + ⦃ rel_estate (syscall_state := syscall_state) {| escs := scs' ; emem := m' ; evm := vm |} m_id s_id~0 s_st st ⦄. + +Lemma hget_lemma (l : seq var_i) vm vres : + mapM (λ x : var_i, get_var (wsw := (nosubword) (* TODO: nosubword or withsubword *)) (true (* TODO: wdb *)) vm x) l = ok vres -> + [seq encode (vtype (v_var x)) | x <- l] = [seq choice_type_of_val v | v <- vres]. +Proof. + revert vres vm. + induction l; intros. + - inversion H; reflexivity. + - inversion H. + jbind H1 v Hv. + jbind H1 v' Hv'. + noconf H1. + simpl. + unfold choice_type_of_val. + admit. + (* erewrite type_of_get_var by eassumption. *) + (* erewrite IHl by eassumption. *) + (* reflexivity. *) +Admitted. (* Qed. *) + +Lemma hget_lemma2 l scs m vm vres m_id s_id s_st st : + mapM (λ x : var_i, get_var (wsw := (nosubword) (* TODO: nosubword or withsubword *)) (true (* TODO: wdb *)) vm x) l = ok vres -> + List.Forall2 + (λ (c : ∑ a : choice_type, raw_code a) (v : value), + ⊢ ⦃ rel_estate {| escs := scs ; emem := m; evm := vm |} m_id s_id s_st st ⦄ + c.π2 ⇓ coe_cht c.π1 (translate_value v) + ⦃ rel_estate (syscall_state := syscall_state) {| escs := scs ; emem := m; evm := vm |} m_id s_id s_st st ⦄) + [seq totc (encode (vtype (v_var x))) (translate_get_var m_id x) | x <- l] vres. +Proof. + revert m vm vres m_id s_id s_st st. + induction l; intros. + - inversion H. constructor. + - inversion H. + jbind H1 v Hv. + jbind H1 v' Hv'. + noconf H1. + constructor. + + simpl. + eapply translate_get_var_correct; eauto. + simpl. assumption. + + eapply IHl. assumption. +Qed. + +Lemma htrunc_lemma1 l vargs vargs': + mapM2 ErrType truncate_val l vargs' = ok vargs + -> (trunc_list l [seq totce (translate_value v) | v <- vargs']) = [seq totce (translate_value v) | v <- vargs]. +Proof. + revert vargs vargs'. + induction l; intros. + - destruct vargs'. + + inversion H; reflexivity. + + inversion H. + - destruct vargs'. + + inversion H. + + inversion H. + jbind H1 v' Hv'. + jbind H1 v'' Hv''. + noconf H1. + simpl. + unfold trunc_list. + simpl. + erewrite totce_truncate_translate by eassumption. + f_equal. + apply IHl. + assumption. +Qed. + +Lemma translate_for_ext v l m_id s_id c c' : + (forall s_id, c s_id = c' s_id) -> + translate_for v l m_id c s_id = translate_for v l m_id c' s_id. +Proof. + revert s_id. + induction l; intros s_id hext. + - reflexivity. + - simpl. + rewrite hext. + destruct c'. + rewrite IHl; auto. +Qed. + +Lemma lemma1 P pre c suf m_id : + uniq [seq p.1 | p <- suf ++ pre] -> + forall s_id, + cmd_fs c pre -> + translate_cmd P (translate_funs P (suf ++ pre)).1 c m_id s_id + = translate_cmd P (translate_funs P pre).1 c m_id s_id. +Proof. + intros huniq. + set (Pr := fun (i : instr_r) => + forall s_id, + instr_r_fs i pre -> + translate_instr_r P (translate_funs P (suf ++ pre)).1 i m_id s_id + = translate_instr_r P (translate_funs P pre).1 i m_id s_id). + set (Pi := fun (i : instr) => + Pr (instr_d i)). + set (Pc := fun (c : cmd) => + forall s_id, + cmd_fs c pre -> + translate_cmd P (translate_funs P (suf ++ pre)).1 c m_id s_id + = translate_cmd P (translate_funs P pre).1 c m_id s_id). + eapply cmd_rect with + (Pr := Pr) + (Pi := Pi) + (Pc := Pc); + try easy + . + - intros i c' ihi ihc s_id' hpre. + unfold Pc. + simpl. + unfold Pi in ihi. + red in ihi. + rewrite !translate_instr_unfold. + simpl in hpre. + move: hpre => /andP [hi hc]. + rewrite ihi. + 2: destruct i; auto. + destruct translate_instr_r as [s_id'' i']. + rewrite ihc; auto. + - intros e c1 c2 ihc1 ihc2 s_id' hpre. + rewrite !translate_instr_r_if. + simpl in hpre. + fold cmd_fs in hpre. + move: hpre => /andP [hc1 hc2]. + rewrite ihc1; auto. + destruct translate_cmd as [s_id'' c']. + rewrite ihc2; auto. + - intros v d lo hi c' ihc s_id hpre. + simpl in hpre. + fold cmd_fs in hpre. + rewrite !translate_instr_r_for. + red in ihc. + simpl. + f_equal. + f_equal. + apply functional_extensionality. + intros lb. + f_equal. + apply functional_extensionality. + intros ub. + erewrite translate_for_ext; eauto. + - intros (* i *) lvals f es s_id hpre. + simpl in hpre. + unfold translate_instr_r. + simpl. + f_equal. + unfold translate_call. + symmetry; destruct assoc eqn:E. + + assert (H2 : exists r', assoc pre f = Some r'). + * clear -E. + induction pre. 1: discriminate. + destruct a. + simpl in *. + destruct (f == s). + ** eexists. reflexivity. + ** apply IHpre; auto. + * destruct H2 as [r']. + assert (assoc (translate_funs P (suf ++ pre)).1 f = Some r). + ** eapply mem_uniq_assoc. + *** clear -E. + induction suf. + **** induction pre. + ***** discriminate. + ***** + destruct a. + simpl in *. + destruct (f==s) eqn:E2. + ****** + move: E2 => /eqP ->. left. noconf E. + reflexivity. + ****** right. + apply IHpre. assumption. + **** destruct a. + simpl. + right. + assumption. + *** clear -huniq. + induction suf. + **** induction pre. + ***** easy. + ***** destruct a. + simpl in *. + move: huniq => /andP [huniq1 huniq2]. + apply /andP; split. + ****** clear -huniq1. induction pre. + ******* easy. + ******* destruct a. + Check [eqType of BinNums.positive]. + simpl in huniq1. + admit. + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- pre] s. *) + (* rewrite H in huniq1. *) + (* move: huniq1 => /andP [huniq11 huniq12]. *) + (* simpl. *) + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- (translate_funs P pre).1] s. *) + (* rewrite H0. *) + (* apply /andP. *) + (* split; auto. *) + ****** apply IHpre. assumption. + **** destruct a. + simpl in *. + move: huniq => /andP [huniq1 huniq2]. + apply /andP. + split. + ****** clear -huniq1. induction suf. + ******* induction pre. + ******** easy. + ******** destruct a. + simpl in *. + admit. + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- pre] s. *) + (* rewrite H in huniq1. *) + (* move: huniq1 => /andP [huniq11 huniq12]. *) + (* simpl. *) + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- (translate_funs P pre).1] s. *) + (* rewrite H0. *) + (* apply /andP. *) + (* split; auto. *) + ******* + destruct a. + simpl in *. + admit. + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- suf ++ pre] s. *) + (* rewrite H in huniq1. *) + (* move: huniq1 => /andP [huniq11 huniq12]. *) + (* pose proof notin_cons [eqType of BinNums.positive] p [seq p.1 | p <- (translate_funs P (suf ++ pre)).1] s. *) + (* rewrite H0. *) + (* apply /andP. *) + (* split; auto. *) + ****** apply IHsuf; auto. + ** rewrite H0. reflexivity. + + exfalso. + assert (H2 : assoc pre f = None). + * clear -E. + induction pre. + ** reflexivity. + ** simpl in *. + destruct a. + simpl in *. + destruct (f == t). + *** discriminate. + *** apply IHpre; auto. + * clear -H2 hpre. + induction pre. + ** easy. + ** destruct a. + simpl in *. + rewrite in_cons in hpre. + destruct (f == s). + *** simpl in *. + discriminate. + *** simpl in *. + apply IHpre; auto. +Admitted. (* Qed. *) + +Theorem translate_prog_correct P scs m vargs scs' m' vres : + ∀ fn, + @sem_call (nosubword) (* TODO: nosubword or withsubword *) direct_c (* TODO: direct? *) asm_op syscall_state {| _pd := pd; _msf_size := (Build_MSFsize U32 (* TOOD: what size? *)); |} mk_spp {| + _asmop := asmop; _sc_sem := sc_sem |} _ (sCP_unit (* TODO *)) (P : @uprog asm_op asmop) (tt (* TODO *)) scs m fn vargs scs' m' vres → + handled_program P -> + ∀ vm m_id s_id s_st st, + Pfun P fn scs m vargs scs' m' vres vm m_id s_id s_st st. +Proof using gd asm_correct. + intros fn H hP. + set (Pfun := λ (scs : syscall_state_t) (m : mem) (fn : funname) (va : seq value) (scs' : syscall_state_t) (m' : mem) (vr : seq value), + handled_program P -> forall vm m_id s_id s_st st, Pfun P fn scs m va scs' m' vr vm m_id s_id s_st st + ). + set (SP := (translate_prog' P).1). + set (Pi_r := + λ (s1 : estate) (i : instr_r) (s2 : estate), + ∀ m_id s_id s_st st, + handled_instr_r i → + let (s_id', i') := translate_instr_r P SP i m_id s_id in + ⊢ ⦃ rel_estate (syscall_state := syscall_state) s1 m_id s_id s_st st ⦄ + i' ⇓ tt + ⦃ rel_estate (syscall_state := syscall_state) s2 m_id s_id' s_st st ⦄). + set (Pi := λ s1 i s2, Pi_r s1 (instr_d i) s2). + set (Pc := + λ (s1 : estate) (c : cmd) (s2 : estate), + ∀ m_id s_id s_st st, + handled_cmd c → + let (s_id', c') := translate_cmd P SP c m_id s_id in + ⊢ ⦃ rel_estate (syscall_state := syscall_state) s1 m_id s_id s_st st ⦄ + c' ⇓ tt + ⦃ rel_estate (syscall_state := syscall_state) s2 m_id s_id' s_st st ⦄). + set (Pfor := + λ (v : var_i) (ws : seq Z) (s1 : estate) (c : cmd) (s2 : estate), + ∀ m_id s_id s_id' s_st st, + handled_cmd c → + s_id~1 ⪯ s_id' -> + exists s_id'', + ⊢ ⦃ rel_estate (syscall_state := syscall_state) s1 m_id s_id' (s_id~0 :: s_st) st ⦄ + translate_for v ws m_id (translate_cmd P SP c m_id) s_id' ⇓ tt + ⦃ rel_estate (syscall_state := syscall_state) s2 m_id s_id'' (s_id~0 :: s_st) st ⦄ + ). + + unshelve eapply (@sem_call_Ind _ _ asm_op syscall_state {| _pd := pd |} mk_spp {| + _asmop := asmop; _sc_sem := sc_sem |} _ _ _ _ Pc Pi_r Pi Pfor Pfun _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H). + - (* nil *) + intros s m_id s_id s_st st _. simpl. + eapply u_ret_eq. + intros h preh. auto. + - (* cons *) + red. + intros s1 s2 s3 i c hi ihi hc ihc m_id s_id s_st st hp. (* sp fp ctr h fp_prec. *) + inversion hp. + move: H1 => /andP [hdi hdc]. + unfold Pi in ihi. unfold Pi_r in ihi. + simpl. + rewrite translate_instr_unfold. + pose proof translate_instr_r_preceq P SP (instr_d i) m_id s_id. + specialize (ihi m_id s_id). + pose proof (translate_instr_r_pres P SP (instr_d i) s1 m_id s_id). + destruct translate_instr_r as [s_id' i'] eqn:E. + unfold Pc in ihc. + specialize (ihc m_id s_id'). + pose proof (translate_cmd_preceq P SP c m_id s_id'). + pose proof (translate_cmd_pres P SP c s1 m_id s_id'). + destruct translate_cmd as [s_id'' c'] eqn:Ec. + split. + + eapply u_bind. + * eapply ihi. + 1: destruct i; apply hdi. + * eapply ihc. + 1: assumption. + - (* mkI *) + red. intros ii i s1 s2 hi ihi. + apply ihi. + - (* assgn *) + red. intros s₁ s₂ x tag ty e v v' he hv hw m_id s_id s_st st hp. + eapply u_bind. + 1:{ eapply translate_pexpr_correct. all: eauto. } + erewrite translate_pexpr_type by eassumption. + rewrite coerce_to_choice_type_K. + erewrite totce_truncate_translate by eassumption. + eapply u_post_weaken_rule. + 1: eapply u_pre_weaken_rule. + 1: eapply translate_write_lval_correct. all: eauto. + - (* opn *) + red. + (* easy. *) + intros s1 s2 tag o xs es ho m_id s_id s_st st hp. + jbind ho vs hv. + jbind hv vs' hv'. + eapply u_bind. + + eapply bind_list_pexpr_correct. 2: eassumption. + eauto. + + unshelve erewrite translate_exec_sopn_correct by eassumption. + 1: assumption. + eapply u_post_weaken_rule. + 1: apply translate_write_lvals_correct. + all: eauto. + - (* sys_call *) + easy. + - (* if_true *) + intros s1 s2 e c1 c2 he hc1 ihc1 m_id s_id s_st st hp. + inversion hp. + move: H1 => /andP [hdc1 hdc2]. + rewrite translate_instr_r_if. + simpl. + unfold Pc in ihc1. + specialize (ihc1 m_id s_id s_st st). + pose proof translate_cmd_pres P SP c1 s1 m_id s_id s_st st. + destruct (translate_cmd P SP c1 m_id s_id) as [s_id'' c1'] eqn:E1. + pose proof translate_cmd_pres P SP c2 s2 m_id s_id'' s_st st. + destruct (translate_cmd P SP c2 m_id s_id'') as [s_id''' c2'] eqn:E2. + split. + + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in he. all: eauto. } + eapply u_post_weaken_rule. + 1: eapply ihc1. + 1: eapply hdc1. + 1: assumption. + - (* if_false *) + intros s1 s2 e c1 c2 he hc2 ihc2 m_id s_id s_st st hp. + inversion hp. + move: H1 => /andP [hdc1 hdc2]. + rewrite translate_instr_r_if. + simpl. + unfold Pc in ihc2. + pose proof translate_cmd_pres P SP c1 s1 m_id s_id s_st st. + destruct (translate_cmd P SP c1 m_id s_id) as [s_id'' c1'] eqn:E1. + specialize (ihc2 m_id s_id'' s_st st). + destruct (translate_cmd P SP c2 m_id s_id'') as [s_id''' c2'] eqn:E2. + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in he. all: eauto. } + eapply u_pre_weaken_rule. + 1: eapply u_post_weaken_rule. + 1: eapply ihc2. + 1: assumption. + 1: { intros h rel. eapply rel_estate_prec. 1:reflexivity. 1: eassumption. } + assumption. + - (* while_true *) + easy. + - (* while_false *) + easy. + - (* for *) + intros s s2 i d lo hi c vlo vhi hlo hhi hfor ihfor m_id s_id s_st st hp. + rewrite translate_instr_r_for. + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in hlo. all: eauto. } + eapply u_bind. + 1:{ eapply translate_pexpr_correct_cast in hhi. all: eauto. } + unfold Pfor in ihfor. + simpl in ihfor. + specialize (ihfor m_id s_id s_id~1 s_st st ltac:(apply hp) ltac:(reflexivity)). + destruct ihfor as [s_id'']. + eapply u_pre_weaken_rule. + 1: eapply u_post_weaken_rule. + 1: exact H0. + 1: apply rel_estate_pop_sub. + apply rel_estate_push_sub. + - (* for_nil *) + intros s i c m_id s_id s_id' s_st st hdc hpre. + simpl. + exists s_id'. + apply u_ret_eq. + easy. + - (* for_cons *) + intros s1 s1' s2 s3 i w ws c hw hc ihc hfor ihfor m_id s_id s_id' s_st st hdc hpre. + simpl. + specialize (ihc m_id s_id' (s_id~0 :: s_st) st hdc). + pose proof translate_cmd_preceq P SP c m_id s_id'. + destruct translate_cmd as [s_id'' c'] eqn:E. + specialize (ihfor m_id s_id s_id'' s_st st hdc ltac:(etransitivity;eauto)) as [s_id''' ihfor]. + exists s_id'''. + eapply u_put. + eapply u_pre_weaken_rule. + 2: { + intros ? [me [hme ?]]. subst. + eapply translate_write_var_estate. all: try eassumption. + } + eapply u_bind. + 1: eapply ihc. + eapply ihfor. + - (* call *) + intros s1 scs1 m2 s2 (* ii *) xs gn args vargs' vres' hargs hgn ihgn hwr_vres m_id s_id s_st st hdi. + unfold Pfun, Translation.Pfun, get_translated_fun in ihgn. + simpl. + eapply u_bind. + 1: admit. + (* 1: eapply bind_list_pexpr_correct with (s_id:=s_id) (s_st:=s_st) (st:=st); try eassumption; easy. *) + eapply u_bind with (v₁ := [seq totce (translate_value v) | v <- vres']). + 1: specialize (ihgn hP (evm s1) m_id s_id s_st st). + 1: eapply u_pre_weaken_rule. + * destruct (sem_call_get_some hgn) as [f hf]. + destruct (tr_prog_inv hf) as [fs' [l [hl [ef ep]]]]. + simpl in ep. + rewrite ep in ihgn. + pose (translate_call_head ef) as hc. + rewrite hc. + eapply ihgn. + * admit. + * eapply translate_write_lvals_correct. + 1:assumption. + admit. + (* exact hwr_vres. *) + - (* proc *) + intros scs1 m1 scs2 m2 gn g vargs' vargs'' s1 vm2 vres' vres''. + intros hg hvars hwr hbody ihbody hget htrunc. + intros hp vm m_id s_id s_st st. + unfold Translation.Pfun. + unfold get_translated_fun. + admit. + (* destruct (tr_prog_inv hg) as [fs' [l [hl ]]]. *) + (* unfold Pc, SP, translate_prog' in ihbody. *) + (* unfold translate_prog' in *. *) + (* rewrite hl in ihbody. *) + (* rewrite hl. *) + (* destruct H0 as [ef ep]. *) + (* rewrite hl in ef. *) + (* rewrite hl in ep. *) + (* subst SP. *) + (* rewrite ep. *) + (* unfold translate_call. *) + (* simpl. *) + (* destruct (translate_funs P fs') as [tr_fs' tsp'] eqn:Efuns. *) + (* simpl. *) + (* assert (E : gn == gn) by now apply /eqP. *) + (* rewrite E; clear E. *) + (* unfold translate_call_body. *) + (* rewrite hg. *) + (* eapply u_bind. *) + (* 1: { *) + (* erewrite htrunc_lemma1 by eassumption. *) + (* eapply u_pre_weaken_rule. *) + (* 1: eapply translate_write_vars_correct; eassumption. *) + (* eapply rel_estate_push. *) + (* } *) + (* assert (handled_cmd (f_body g)) as hpbody. *) + (* { *) + (* clear -hg hp. *) + (* pose (gd := (gn, g)). *) + (* unfold handled_program in *. *) + (* move: hp => /andP [] /andP [] hp1 hp2 hp3. *) + (* pose (hh := (List.forallb_forall handled_fundecl (p_funcs P)).1 hp1 gd). *) + (* destruct g. *) + (* apply hh. simpl. *) + (* now apply (assoc_mem' hg). *) + (* } *) + (* specialize (ihbody s_id~1 s_id~1 [::] ((vm, m_id, s_id~0, s_st) :: st) hpbody). clear hpbody. *) + (* assert ((l ++ (gn,g) :: fs') = ((l ++ [:: (gn,g)]) ++ fs')) by (rewrite <- List.app_assoc; reflexivity). *) + (* assert (htr : translate_cmd P (translate_funs P (l ++ ((gn,g) :: fs'))).1 (f_body g) s_id~1 s_id~1 *) + (* = translate_cmd P (translate_funs P fs').1 (f_body g) s_id~1 s_id~1). *) + (* { rewrite H0. *) + (* eapply lemma1. *) + (* { clear -hp hl H0. *) + (* unfold handled_program in *. *) + (* move: hp => /andP [] /andP [_ _]. *) + (* now rewrite hl H0. *) + (* } *) + (* clear -hp hl. *) + (* move: hp => /andP [] /andP [_ hp2 _]. *) + (* rewrite hl in hp2. *) + (* eapply lemma2. *) + (* eassumption. *) + (* } *) + (* rewrite htr in ihbody. *) + (* rewrite Efuns in ihbody. *) + (* destruct (translate_cmd P tr_fs' (f_body g) s_id~1 s_id~1) as [s_id' c'] eqn:E. *) + (* rewrite E in ihbody. *) + (* rewrite E. *) + (* simpl. *) + + (* eapply u_bind with (v₁ := tt). *) + (* + eapply ihbody. *) + (* + eapply u_bind. *) + (* * eapply bind_list_correct. *) + (* ** rewrite <- map_comp. *) + (* unfold comp. *) + (* simpl. *) + (* eapply hget_lemma; eassumption. *) + (* ** eapply hget_lemma2. *) + (* assumption. *) + (* * clear -htrunc. *) + (* eapply u_ret. *) + (* split. *) + (* 1: eapply rel_estate_pop. *) + (* 1: eassumption. *) + (* eapply htrunc_lemma1. *) + (* eassumption. *) + - assumption. +Admitted. (* Qed. *) + +End Translation. + +From Jasmin Require Import x86_instr_decl x86_extra (* x86_gen *) (* x86_linear_sem *). +Import arch_decl. + +Lemma id_tin_instr_desc : + ∀ (a : asm_op_msb_t), + id_tin (instr_desc a) = id_tin (x86_instr_desc a.2). +Proof. + intros [[ws|] a]. + - simpl. destruct (_ == _). all: reflexivity. + - reflexivity. +Qed. + +Definition cast_sem_prod_dom {ts tr} ts' (f : sem_prod ts tr) (e : ts = ts') : + sem_prod ts' tr. +Proof. + subst. exact f. +Defined. + +Lemma cast_sem_prod_dom_K : + ∀ ts tr f e, + @cast_sem_prod_dom ts tr ts f e = f. +Proof. + intros ts tr f e. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. +Qed. + +Lemma sem_correct_rewrite : + ∀ R ts ts' f e, + sem_correct ts' (cast_sem_prod_dom ts' f e) → + @sem_correct R ts f. +Proof. + intros R ts ts' f e h. + subst. rewrite cast_sem_prod_dom_K in h. + assumption. +Qed. + +Lemma no_arr_correct {R} ts s : + List.Forall (λ t, ∀ len, t != sarr len) ts → + @sem_correct R ts s. +Proof. + intros h. + induction h as [| t ts ht h ih]. + - constructor. + - constructor. + + intros v. + pose proof unembed_embed t v as e. + destruct t as [| | len |]. + 1,2,4: rewrite e ; reflexivity. + specialize (ht len). move: ht => /eqP. contradiction. + + intros v. + apply ih. +Qed. + +Context `{asmop : asmOp}. +Lemma x86_correct : + ∀ (o : @asm_op_t asm_op _), + sem_correct (tin (sopn.get_instr_desc (Oasm o))) (@sopn_sem _ (Build_MSFsize U32 (* TOOD: what size? *)) _ (Oasm o)). +Proof. + intros o. + admit. + (* destruct o as [a | e]. *) + (* - Opaque instr_desc. simpl. *) + (* pose proof (id_tin_instr_desc a) as e. *) + (* eapply sem_correct_rewrite with (e := e). *) + (* destruct a as [o x]. simpl in *. *) + (* eapply no_arr_correct. *) + (* destruct x ; simpl. *) + (* all: repeat constructor. *) + (* Transparent instr_desc. *) + (* - destruct e ; simpl ; repeat constructor. *) + (* destruct w ; repeat constructor. *) + (* Qed. *) +Admitted. diff --git a/theories/Jasmin/jasmin_utils.v b/theories/Jasmin/jasmin_utils.v new file mode 100644 index 00000000..8e448c1f --- /dev/null +++ b/theories/Jasmin/jasmin_utils.v @@ -0,0 +1,190 @@ +From Coq Require String Ascii. + +From Jasmin Require Import expr. + +From SSProve.Crypt Require Import Prelude Package. +From SSProve.Jasmin Require Import jasmin_translate. + +From Ltac2 Require Ltac2 Printf. +From Ltac2 Require String Char Fresh Ident. + + +Module JasminCodeNotation. + + Notation " ⸨ ws ⸩ a .[ ptr * scale ] " := (chArray_get ws a ptr scale) + (format " ⸨ ws ⸩ a .[ ptr * scale ] "). + Notation " a [ w / p ] " := + (chArray_set a AAscale p w) + (at level 99, no associativity, + format " a [ w / p ] "). + + Notation "$$ i" := (translate_var _ {| vtype := _; vname := i |}) + (at level 99, format "$$ i"). + + Notation "$$$ i" := ({| v_var := {| vtype := _; vname := i |}; v_info := _ |}) + (at level 99, + format "$$$ i"). + + Notation "'for var ∈ seq" := (translate_for _ ($$$var) seq) + (at level 99). +End JasminCodeNotation. + +Module jtac. + +Import JasminNotation JasminCodeNotation. + +Import Ltac2.Ltac2 Ltac2.Printf. + +Ltac2 rec ltac_int_of_pos (p : constr) : int := + let res := + lazy_match! p with + | xH => 1 + | xO ?p' => Int.mul 2 (ltac_int_of_pos p') + | xI ?p' => Int.add (Int.mul 2 (ltac_int_of_pos p')) 1 + end in + if Int.lt res 0 + then Control.throw (Out_of_bounds (Some (fprintf "ltac_int_of_pos: value is too large: %t" p))) + else res. + +Ltac2 ltac_int_of_Z (z : constr) : int := + lazy_match! z with + | Z0 => 0 + | Zpos ?p => ltac_int_of_pos p + | Zneg ?p => Int.sub 0 (ltac_int_of_pos p) + end. + +Ltac2 ltac_char_of_ascii (c : constr) : char := + let c := constr:(Z.of_nat (Ascii.nat_of_ascii $c)) in + let c := eval cbv in $c in + Char.of_int (ltac_int_of_Z c). + +Ltac2 ltac_string_of_string (s : constr) : string := + let s := eval cbv in $s in + let rec ltac_copy_to_string (s : constr) (out : string) (i : int) : unit := + lazy_match! s with + | EmptyString => () + | String ?c ?s => String.set out i (ltac_char_of_ascii c) ; + ltac_copy_to_string s out (Int.add i 1) + end + in + let len := constr:(Z.of_nat (String.length $s)) in + let len := eval cbv in $len in + let out := String.make (ltac_int_of_Z len) (Char.of_int 0) in + ltac_copy_to_string s out 0 ; + out. + +Ltac2 base_length (s : string) : int := + let full_stop := 46 in + let n := String.length s in + let rec f i len_ext := + if Int.equal i 0 + then None + else + let i := Int.sub i 1 in + let c := String.get s i in + let len_ext := Int.add 1 len_ext in + if Int.equal full_stop (Char.to_int c) + then Some len_ext + else f i len_ext + in + match f n 0 with + | None => n + | Some l => Int.sub n l end. + +Ltac2 basename (s : string) : string := + let len := base_length s in + if Int.equal len 0 then s else + let s' := String.make len (Char.of_int 0) in + let rec cp i := + if Int.equal i 0 then () else + let i := Int.sub i 1 in + String.set s' i (String.get s i) ; cp i + in cp len ; + s'. + +Ltac2 setjvars () := + lazy_match! goal with + | [ |- context [ $$ ?i ] ] => + let s := basename (ltac_string_of_string i) in + match Ident.of_string s with + | None => Control.throw (Tactic_failure (Some (fprintf "Not a valid ident: %s (was: %t)" s i))) + | Some id => + let x := Fresh.fresh (Fresh.Free.of_goal ()) id in + set ($x := $$ $i) in * + end + end. + +End jtac. + +Ltac setjvars := ltac2:(jtac.setjvars ()). + +Ltac prog_unfold := unfold translate_prog', translate_prog, + translate_call, translate_call_body, + translate_write_lvals, translate_write_var, translate_instr, + coerce_chtuple_to_list, bind_list', bind_list_trunc_aux, + wsize_size, trunc_list, + List.nth_default. + + +#[export] Hint Rewrite coerce_typed_code_K eq_rect_K eq_rect_r_K : prog_rewrite. + +Ltac simpl_fun := + repeat (match goal with + | _ => progress autorewrite with prog_rewrite + | _ => prog_unfold; simpl + end). + +Import PackageNotation. + +Ltac swap_first_occ loc := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ _ ≈ ?c1 ⦃ _ ⦄ => + lazymatch c1 with + | #put _ := _ ;; #put loc := _ ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | #put _ := _ ;; _ ← get loc ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | _ ← get _ ;; #put loc := _ ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | _ ← get _ ;; _ ← get loc ;; _ => ssprove_rswap_cmd_eq_rhs; ssprove_swap_auto + | _ => ssprove_sync_eq ; try intro ; swap_first_occ loc + end + end. + +Ltac swap_loc loc := + eapply r_transL; [ solve [ swap_first_occ loc ] | cmd_bind_simpl ; cbn beta ]. + +Ltac swap_loc_ignore_head loc := + eapply r_transL; [ solve [ ssprove_sync_eq ; try intro ; swap_first_occ loc ] | cmd_bind_simpl ; cbn beta ]. + +Ltac set_at_head loc := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ ?c1 ≈ _ ⦃ _ ⦄ => + lazymatch c1 with + | #put loc := _ ;; _ => idtac + | _ ← get loc ;; _ => idtac + | _ => swap_loc loc; set_at_head loc + end + end. + +Ltac set_at_snd loc := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ ?c1 ≈ _ ⦃ _ ⦄ => + lazymatch c1 with + | #put _ := _ ;; #put loc := _ ;; _ => idtac + | #put _ := _ ;; _ ← get loc ;; _ => idtac + | _ ← get _ ;; #put loc := _ ;; _ => idtac + | _ ← get _ ;; _ ← get loc ;; _ => idtac + | _ => swap_loc_ignore_head loc; set_at_snd loc + end + end. + +Ltac clear_loc loc := set_at_head loc; set_at_snd loc; first [ ssprove_contract_put_get_lhs | ssprove_contract_put_lhs ]. + +Ltac clear_get_aux c1 := + lazymatch c1 with + | _ ← get ?loc ;; _ => clear_loc loc + | #put _ := _ ;; ?c2 => clear_get_aux c2 + end. + +Ltac clear_get := + lazymatch goal with + | |- ⊢ ⦃ _ ⦄ ?c1 ≈ _ ⦃ _ ⦄ => clear_get_aux c1 + end. diff --git a/theories/Jasmin/jasmin_x86.v b/theories/Jasmin/jasmin_x86.v new file mode 100644 index 00000000..52a910c2 --- /dev/null +++ b/theories/Jasmin/jasmin_x86.v @@ -0,0 +1,134 @@ +Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format". +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word_ssrZ word. +From Jasmin Require Import expr compiler_util values expr compiler_util values sem_params flag_combination sem_op_typed sopn low_memory psem_of_sem_proof varmap psem lowering. +Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format". + +From extructures Require Import ord fset fmap. +Set Warnings "-ambiguous-paths". +(* Silencing the following warning: *) +(* New coercion path [Pbool] : bool >-> pexpr is ambiguous with existing *) +(* [nat_of_bool; Posz; int_to_Z; Pconst] : bool >-> pexpr. *) +From Jasmin Require Import expr_facts. +Set Warnings "ambiguous-paths". + +From Coq Require Import Utf8. + +From SSProve.Crypt Require Import Prelude Package. +Import PackageNotation. + +From Equations Require Import Equations. +Set Equations With UIP. +Set Equations Transparent. + +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". +Set Primitive Projections. +Set Default Proof Using "Type". + +From SSProve.Jasmin Require Import jasmin_translate jasmin_asm. + +From Jasmin Require Import + x86_instr_decl + x86_extra + x86_params + x86_params_proof + x86_decl + x86_lowering + x86. + +From Jasmin Require Import + arch_sem + compiler + compiler_proof. + +Section x86_correct. + + Lemma id_tin_instr_desc : + ∀ (a : asm_op_msb_t), + id_tin (instr_desc a) = id_tin (x86_instr_desc a.2). + Proof. + intros [[ws|] a]. + - simpl. destruct (_ == _). all: reflexivity. + - reflexivity. + Qed. + + Definition cast_sem_prod_dom {ts tr} ts' (f : sem_prod ts tr) (e : ts = ts') : + sem_prod ts' tr. + Proof. + subst. exact f. + Defined. + + Lemma cast_sem_prod_dom_K : + ∀ ts tr f e, + @cast_sem_prod_dom ts tr ts f e = f. + Proof. + intros ts tr f e. + assert (e = erefl). + { apply eq_irrelevance. } + subst. reflexivity. + Qed. + + Lemma sem_correct_rewrite : + ∀ R ts ts' f e, + sem_correct ts' (cast_sem_prod_dom ts' f e) → + @sem_correct R ts f. + Proof. + intros R ts ts' f e h. + subst. rewrite cast_sem_prod_dom_K in h. + assumption. + Qed. + + Lemma no_arr_correct {R} ts s : + List.Forall (λ t, ∀ len, t != sarr len) ts → + @sem_correct R ts s. + Proof. + intros h. + induction h as [| t ts ht h ih]. + - constructor. + - constructor. + + intros v. + pose proof unembed_embed t v as e. + destruct t as [| | len |]. + 1,2,4: rewrite e ; reflexivity. + specialize (ht len). move: ht => /eqP. contradiction. + + intros v. + apply ih. + Qed. + + Lemma x86_correct : + ∀ (o : asm_op_t), + sem_correct (tin (sopn.get_instr_desc (Oasm o))) (sopn_sem (Oasm o)). + Proof. + intros o. + simpl. admit. (* destruct o as [a | e]. *) + (* - Opaque instr_desc. simpl. *) + (* pose proof (id_tin_instr_desc a) as e. *) + (* eapply sem_correct_rewrite with (e := e). *) + (* destruct a as [o x]. simpl in *. *) + (* eapply no_arr_correct. *) + (* destruct x ; simpl. *) + (* all: repeat constructor. *) + (* Transparent instr_desc. *) + (* - destruct e ; simpl ; repeat constructor. *) + (* destruct w ; repeat constructor. *) + (* Qed. *) + Admitted. + +Context + {syscall_state : Type} + {sc_sem : syscall.syscall_sem syscall_state} + {gf : glob_decls} + {asm_scsem : asm_syscall_sem (call_conv:=x86_linux_call_conv)} + (cparams : compiler_params fresh_vars (* lowering_options *)). + + Hypothesis print_uprogP : forall s p, cparams.(print_uprog) s p = p. + Hypothesis print_sprogP : forall s p, cparams.(print_sprog) s p = p. + Hypothesis print_linearP : forall s p, cparams.(print_linear) s p = p. + + (* Definition equiv_to_x86 := @equiv_to_asm syscall_state sc_sem gf _ _ _ _ _ _ _ _ x86_linux_call_conv _ _ _ _ x86_h_params cparams print_uprogP print_sprogP print_linearP x86_correct. *) + +End x86_correct. diff --git a/theories/Jasmin/word.v b/theories/Jasmin/word.v new file mode 100644 index 00000000..082f292a --- /dev/null +++ b/theories/Jasmin/word.v @@ -0,0 +1,563 @@ +From Coq Require Import Utf8 ZArith micromega.Lia. + +From mathcomp Require Import all_ssreflect all_algebra. +From mathcomp Require Import word_ssrZ word. + +(* NB: This changes the behaviour of lia, making it work on goals with ssr types *) +From mathcomp Require Import zify. + +Set Bullet Behavior "Strict Subproofs". +Set Default Goal Selector "!". + +Notation "m ⊕ k" := (wxor m k) (at level 20). +Notation "m ⟫ k" := (lsr m k) (at level 20). + +Lemma lsr_word0 {n} a : word0 ⟫ a = @word0 n. +Proof. + unfold lsr. + rewrite Z.shiftr_0_l. + apply val_inj. + reflexivity. +Qed. + +Lemma wxor_0_r {n} (a : word n) : a ⊕ word0 = a. +Proof. + unfold wxor. + apply val_inj. simpl. + by rewrite Z.lxor_0_r. +Qed. + +Lemma wxor_0_l {n} (a : word n) : wxor word0 a = a. +Proof. + apply val_inj. + reflexivity. +Qed. + +Lemma wxor_involutive {n} : forall k : word n, k ⊕ k = word0. +Proof. + intros k. + apply/eqP/eq_from_wbit=> i. + rewrite !wxorE addbb. + unfold wbit. + rewrite Z.testbit_0_l. + reflexivity. +Qed. + +Lemma wxorA {n} : forall m k l : word n, ((m ⊕ k) ⊕ l) = (m ⊕ (k ⊕ l)). +Proof. + intros m k l. + apply/eqP/eq_from_wbit=> i. + by rewrite !wxorE addbA. +Qed. + +Lemma wxorC {n} (a b : word n) : a ⊕ b = b ⊕ a. +Proof. + apply/eqP/eq_from_wbit=> i. rewrite !wxorE. + rewrite addbC. reflexivity. +Qed. + +Lemma subword_word0 {n} a m : @subword n a m word0 = word0. +Proof. + unfold subword. + rewrite lsr_word0. + apply val_inj. + reflexivity. +Qed. + +Lemma wcat_eq ws p a t : + (forall (i : 'I_p), subword (i * ws) ws a = tnth t i) -> a = wcat t. +Proof. + intros. + rewrite -[a]wcat_subwordK. + apply f_equal. apply eq_from_tnth. + intros i. + rewrite -H tnth_map tnth_ord_tuple. + reflexivity. +Qed. + +Lemma nth_aux {T} (a : T) l : + [seq nth a l (val i) | i <- enum 'I_(size l)] = l. +Proof. + replace [seq nth a l (val i) | i <- enum 'I_(size l)] with [seq nth a l i | i <- [seq val i | i <- enum 'I_(size l)]]. + 2: { rewrite -map_comp. reflexivity. } + rewrite val_enum_ord. + rewrite map_nth_iota0. 2: lia. + rewrite take_size. reflexivity. +Qed. + +Lemma wcat_r_wcat {n} (l : seq (word n)) : + wcat_r l = wcat [tuple nth word0 l i | i < size l]. +Proof. + rewrite/wcat=>/=. + rewrite nth_aux. + reflexivity. +Qed. + +From Coq Require Import ZArith. + +(* following three lemmas are from fiat crypto, consider importing *) +Local Open Scope Z. +Lemma mod_pow_same_base_larger a b n m : + 0 <= n <= m -> 0 < b -> + (a mod (b^n)) mod (b^m) = a mod b^n. +Proof. + intros. + pose proof Z.mod_pos_bound a (b^n) ltac:(auto with zarith). + assert (b^n <= b^m). + { eapply Z.pow_le_mono_r; lia. } + apply Z.mod_small. auto with zarith. +Qed. + +Lemma mod_pow_same_base_smaller a b n m : + 0 <= m <= n -> 0 < b -> + (a mod (b^n)) mod (b^m) = a mod b^m. +Proof. + intros. replace n with (m+(n-m)) by lia. + rewrite -> Z.pow_add_r, Z.rem_mul_r by auto with zarith. + rewrite <- Zplus_mod_idemp_r. + rewrite <- Zmult_mod_idemp_l. + rewrite Z.mod_same. 2: eapply Z.pow_nonzero ; lia. + rewrite Z.mul_0_l. + rewrite Z.mod_0_l. 2: eapply Z.pow_nonzero ; lia. + rewrite Z.add_0_r. + rewrite Z.mod_mod. 2: eapply Z.pow_nonzero ; lia. + reflexivity. +Qed. +(* end of fiat crypto lemmas *) + +Lemma larger_modulus a n m : + (n <= m)%nat -> + (a mod modulus n) mod modulus m = a mod modulus n. +Proof. + intros H. + rewrite !modulusZE. + apply mod_pow_same_base_larger. 2: lia. + zify. simpl. lia. +Qed. + +Lemma smaller_modulus a n m : + (m <= n)%nat -> + (a mod modulus n) mod modulus m = a mod modulus m. +Proof. + intros H. + rewrite !modulusZE. + apply mod_pow_same_base_smaller. 2: lia. + zify. simpl. lia. +Qed. + +Lemma wbit_subword {ws1} i ws2 (w : word ws1) (j : 'I_ws2) : + wbit (subword i ws2 w) j = wbit w (i + j)%nat. +Proof. + intros. + unfold subword. + rewrite wbit_mkword. + apply wbit_lsr. +Qed. + +Lemma subword_wshr {n} i j m (w : word n) : + subword i m (lsr w j) = subword (j + i) m w. +Proof. + intros. + apply/eqP/eq_from_wbit. + intros. + rewrite !wbit_subword. + rewrite wbit_lsr. + f_equal. + lia. +Qed. + +Lemma subword_xor {n} i ws (a b : n.-word) : + subword i ws (a ⊕ b) = (subword i ws a) ⊕ (subword i ws b). +Proof. + apply/eqP/eq_from_wbit. + intros. rewrite !wbit_subword. + rewrite !wxorE. + rewrite !wbit_subword. + reflexivity. +Qed. + +(** AES *) + +Lemma subword_subword {k} i j n m (w : k.-word) : (i + n <= m)%nat -> subword i n (subword j m w) = subword (i + j) n w. +Proof. + intros. + apply/eqP/eq_from_wbit => l. + rewrite !wbit_subword. + assert (i + l < m)%nat. 1: destruct l; simpl; lia. + change (i + l)%nat with (@Ordinal m (i + l) H0 : nat). + rewrite wbit_subword. + f_equal. + simpl. lia. +Qed. + +Locate "`_". + +Lemma divn_aux j i n : + (j < n)%nat -> + (n <= j %% n + i %% n)%nat = false -> + (j + i) %/ n = i %/ n. +Proof. + intros H1 H2. + rewrite divnD. 2: lia. + rewrite H2. + rewrite divn_small. all: lia. +Qed. + +Lemma modn_aux j i n : + (j < n)%nat -> + (n <= j %% n + i %% n)%nat = false -> + (j + i) %% n = (j + i %% n)%nat. +Proof. + intros H1 H2. + rewrite modnD. 2: lia. + rewrite H2. + rewrite modn_small. all: lia. +Qed. + +(* Local Open Scope ring_scope. *) +Lemma subword_wcat {n p} i l (s : p.-tuple n.-word) : + (* i + l does 'reach across' a single word in the tuple *) + (l <= n)%nat -> + ((l - 1) %% n + i %% n < n)%nat -> + subword i l (wcat s) = subword (i %% n) l (s`_(i %/ n))%R. +Proof. + intros H1 (* H2 *) H3. + rewrite !subwordE. + f_equal. + apply eq_mktuple => j. + rewrite wcat_wbitE. + destruct j. simpl. + f_equal. + - f_equal. f_equal. + apply divn_aux. 1:{ simpl. lia. } + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 2: lia. + lia. + - apply modn_aux. 1: lia. + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 1: lia. + lia. +Qed. + +(* Lemma nth_wsplitnec {n p} (i : 'I_p) (w : (n * p).-word) : *) +(* (* (n < n %/ l + n %% l)%nat -> *) *) +(* ((wsplitn w)`_i)%R = subword (i * n) n w. *) +(* Proof. *) +(* (* intros H. *) *) +(* (* unfold split_vec. *) *) +(* unfold wsplitn. *) +(* (* Unset Printing Notations. *) *) +(* (* pose proof nth_mktuple . *) *) +(* rewrite *) +(* rewrite (nth_map 0). *) +(* erewrite nth_map. *) +(* 1: f_equal; rewrite nth_iota; try lia. *) +(* rewrite size_iota. *) +(* assumption. *) +(* Unshelve. exact 0%nat. *) +(* Qed. *) + +Lemma mkword_word {n} (w : n.-word) : + mkword n w = w. +Proof. + apply val_inj; simpl. + rewrite Z.mod_small. + 1: reflexivity. + destruct w. simpl. lia. +Qed. + +Lemma subword_u {n} (w : n.-word) : subword 0 n w = w. +Proof. + unfold subword. unfold lsr. rewrite Z.shiftr_0_r. rewrite ureprK. + apply mkword_word. +Qed. + +From Jasmin Require Import word. + +(* Lemma make_vec_eq {ws1 ws2 : wsize} {p : nat} a t : *) +(* (p * ws1 = ws2) -> *) +(* (forall (i : 'I_p), subword (i * ws1) ws1 a = nth word0 t i) -> a = make_vec ws2 t. *) +(* Proof. *) +(* intros. *) +(* unfold make_vec. *) +(* unfold wrepr. *) +(* apply val_inj. *) +(* simpl. *) +(* rewrite wcat *) + +(* Lemma wcat_eq ws p a t : *) +(* (forall (i : 'I_p), subword (i * ws) ws a = tnth t i) -> a = wcat t. *) +(* Proof. *) +(* intros. *) +(* rewrite -[a]wcat_subwordK. *) +(* apply f_equal. apply eq_from_tnth. *) +(* intros i. *) +(* rewrite -H tnth_map tnth_ord_tuple. *) +(* reflexivity. *) +(* Qed. *) + +Lemma wbit_wrepr (ws : wsize.wsize) a i : + (i < ws)%nat -> + word.word.wbit (urepr (wrepr ws a)) i = word.word.wbit a i. +Proof. + move=>H/=. + rewrite/word.word.wbit/wrepr/urepr=>/=. + rewrite/modulus two_power_nat_equiv Z.mod_pow2_bits_low=>//. + unfold nat_of_wsize in *. lia. +Qed. + +Lemma wbit_make_vec {ws1} (ws2 : wsize) (l : seq (word.word ws1)) i : + (i < ws2)%nat -> + word.word.wbit (urepr (make_vec ws2 l)) i = word.word.wbit (nth word0 l (i %/ ws1)) (i %% ws1). +Proof. + move=> H. + rewrite /make_vec wcat_r_wcat wbit_wrepr=>//. + rewrite wcat_wbitE=>/=. + repeat f_equal. + apply nth_aux. +Qed. + +Lemma wbit_n_make_vec {ws1} (ws2 : wsize) (l : seq (word ws1)) i : + (i < ws2)%nat -> + wbit_n (make_vec ws2 l) i = wbit_n (nth word0 l (i %/ ws1)) (i %% ws1). +Proof. + move=> H. + unfold wbit_n. + rewrite /make_vec wcat_r_wcat wbit_wrepr=>//. + rewrite wcat_wbitE=>/=. + repeat f_equal. + rewrite nth_aux. + reflexivity. +Qed. + +Lemma subword_make_vec_full {ws1} i (ws2 ws3 : wsize.wsize) (l : seq (word.word ws1)) : + (* i + ws2 does 'reach across' a single word in the list *) + (ws2 <= ws1)%nat -> + (i + ws2 <= ws3)%nat -> + (ws1 <= (ws2 - 1) %% ws1 + i %% ws1)%nat = false -> + (* i think this condition is equivalent, but the others fit with other lemmas *) + (* ((i + ws2 - 1) / ws1)%nat = (i / ws1)%nat -> *) + subword i ws2 (make_vec ws3 l) = subword (i %% ws1) ws2 (nth word0 l (i %/ ws1)%nat). +Proof. + intros H1 H2 H3. + rewrite !subwordE. + f_equal. + apply eq_mktuple. + intros j. + destruct j. simpl. + rewrite wbit_make_vec. 2: lia. + f_equal. + - f_equal. f_equal. + apply divn_aux. 1:{ simpl. lia. } + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 2: lia. + lia. + - apply modn_aux. 1: lia. + rewrite modn_small in H3. 2: lia. + rewrite modn_small. 1: lia. + lia. +Qed. + +(* Lemma subw *) + +Lemma subword_make_vec {ws1} i (ws2 : wsize.wsize) (l : seq (word.word ws1)) : + (ws1 <= ws2)%nat -> + ((i + 1) * ws1 <= ws2)%nat -> + subword (i * ws1) ws1 (make_vec ws2 l) = nth word0 l i. +Proof. + intros H1 H2. + rewrite subword_make_vec_full. + all: try lia. + { rewrite modnMl mulnK. + 2: { unfold nat_of_wsize; lia. } + apply subword_u. } + rewrite modnMl. unfold nat_of_wsize. lia. +Qed. + +Lemma make_vec_ws ws (l : seq (word ws)) : + make_vec ws l = nth word0 l 0. +Proof. + apply/eqP. apply/eq_from_wbit. + intros [i]. + rewrite wbit_make_vec=>/=. + 2: unfold nat_of_wsize in *; lia. + rewrite divn_small. + 2: unfold nat_of_wsize in *; lia. + rewrite modn_small. + 2: unfold nat_of_wsize in *; lia. + reflexivity. +Qed. + +Lemma make_vec_single {ws1} ws2 (a : word ws1) : + make_vec ws2 [:: a] = zero_extend ws2 a. +Proof. + unfold make_vec. cbn -[Z.of_nat]. + by rewrite Z.shiftl_0_l Z.lor_0_r. +Qed. + +Lemma wshr_word0 {ws} i : @wshr ws 0 i = word0. +Proof. + unfold wshr. by rewrite lsr_word0. +Qed. + +Lemma nth_split_vec {ws1} ws2 n (d : word ws2) (w : word ws1) : + (n < ws1 %/ ws2 + ws1 %% ws2)%nat -> + nth d (split_vec ws2 w) n = subword (n * ws2) ws2 w. +Proof. + intros H. + unfold split_vec. + erewrite nth_map. + 1: f_equal; rewrite nth_iota; try lia. + rewrite size_iota. + assumption. + Unshelve. exact 0%nat. +Qed. + +From Jasmin Require Import waes utils xseq. + +Lemma subword_U8_SubWord n w : + (0 <= n < 4)%nat -> + subword (n * U8) U8 (SubWord w) = Sbox (subword (n * U8) U8 w). +Proof. + intros. + unfold SubWord. + rewrite subword_make_vec. + 1: erewrite nth_map; f_equal. + all: try (unfold nat_of_wsize, wsize_size_minus_1; zify; simpl; lia). + apply nth_split_vec. + cbn. lia. + Unshelve. exact word0. +Qed. + +Lemma split_vec_make_vec {ws1} (ws2 : wsize.wsize) (l : seq (word.word ws1)) : + (ws2 %% ws1 = 0)%nat -> + (size l = ws2 %/ ws1)%nat -> + split_vec ws1 (make_vec ws2 l) = l. +Proof. + destruct l. + - intros . + unfold make_vec, split_vec. + rewrite -H0 H. + reflexivity. + - intros Hmod Hsize. + unfold split_vec. + rewrite <- take_size. + erewrite <- map_nth_iota0. + 2: easy. + rewrite Hsize Hmod addn0. + apply map_ext. + intros. + apply subword_make_vec. + 1: simpl in Hsize; nia. + move: H => /InP. rewrite mem_iota. + nia. +Qed. + +Lemma SubWord_make_vec l : + (size l = 4)%nat -> + SubWord (make_vec U32 l) = make_vec U32 [seq Sbox i | i <- l]. +Proof. + intros. + unfold SubWord. + rewrite split_vec_make_vec. + all: unfold nat_of_wsize, wsize_size_minus_1; easy. +Qed. + +Lemma SubBytes_make_vec l : + (size l = 4)%nat -> + SubBytes (make_vec U128 l) = make_vec U128 [seq SubWord i | i <- l]. +Proof. + intros. + unfold SubBytes. + rewrite split_vec_make_vec. + all: unfold nat_of_wsize, wsize_size_minus_1; easy. +Qed. + +Lemma subword_make_vec_32_0_32_128 (l : seq u32) : subword 0 U32 (make_vec U128 l) = nth word0 l 0. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + +Lemma subword_make_vec_32_1_32_128 (l : seq u32) : subword U32 U32 (make_vec U128 l) = nth word0 l 1. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + +Lemma subword_make_vec_32_2_32_128 (l : seq u32) : subword (2 * U32) U32 (make_vec U128 l) = nth word0 l 2. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + +Lemma subword_make_vec_32_3_32_128 (l : seq u32) : subword (3 * U32) U32 (make_vec U128 l) = nth word0 l 3. +Proof. + rewrite subword_make_vec_full; rewrite ?subword_u. + all: auto. +Qed. + + +Lemma wreprI ws (a : word.word ws) : wrepr ws (toword a) = a. +Proof. + apply val_inj. simpl. destruct a. rewrite Z.mod_small. 1: reflexivity. + simpl in *. lia. +Qed. + +(** AES *) + +Lemma subword_SubWord n w : + (0 <= n < 4)%nat -> subword (n * U8) U8 (SubWord w) = Sbox (subword (n * U8) U8 w). +Proof. + intros. + unfold SubWord. + rewrite subword_make_vec. + 1: erewrite nth_map; f_equal. + all: try (unfold nat_of_wsize, wsize_size_minus_1; zify; simpl; lia). + apply nth_split_vec. + cbn. lia. + Unshelve. exact word0. +Qed. + +Lemma subword_SubBytes n w : (0 <= n < 4)%nat -> subword (n * U32) U32 (SubBytes w) = SubWord (subword (n * U32) U32 w). +Proof. + intros. + unfold SubBytes. + rewrite subword_make_vec. + 1: erewrite nth_map; f_equal. + all: try (unfold nat_of_wsize, wsize_size_minus_1; zify; simpl; lia). + apply nth_split_vec. + cbn. lia. + Unshelve. exact word0. +Qed. + +Lemma ShiftRows_SubBytes s : ShiftRows (SubBytes s) = SubBytes (ShiftRows s). +Proof. + unfold ShiftRows. simpl. + rewrite !subword_SubBytes; try reflexivity. + rewrite !subword_SubWord; try reflexivity. + rewrite SubBytes_make_vec; auto. simpl. + rewrite !SubWord_make_vec; auto. +Qed. + +Lemma RotWord_SubWord w : RotWord (SubWord w) = SubWord (RotWord w). +Proof. + unfold RotWord. + rewrite SubWord_make_vec; auto. + rewrite !subword_SubWord; auto. +Qed. + +Lemma wAESENC_wAESENC_ s k : wAESENC s k = wAESENC_ s k. +Proof. + unfold wAESENC, wAESENC_. + f_equal. f_equal. + rewrite ShiftRows_SubBytes. + reflexivity. +Qed. + +Lemma wAESENCLAST_wAESENCLAST_ s k : wAESENCLAST s k = wAESENCLAST_ s k. +Proof. + unfold wAESENCLAST, wAESENCLAST_. + rewrite ShiftRows_SubBytes. + reflexivity. +Qed. diff --git a/theories/Relational/GenericRulesSimple.v b/theories/Relational/GenericRulesSimple.v index 617fde4e..7c5b41ed 100644 --- a/theories/Relational/GenericRulesSimple.v +++ b/theories/Relational/GenericRulesSimple.v @@ -297,4 +297,3 @@ End GoingPractical. Ltac apply_seq := refine (gp_seq_rule _ _ _ _ (wf:=extend_to_Jprod _ (fun '⟨a1, a2⟩ => _)) _ _ _). -