├── .github └── workflows │ ├── docker-action.yml │ ├── nix-action-8.16.yml │ └── nix-action-8.17.yml ├── .gitignore ├── .nix ├── config.nix └── coq-nix-toolbox.nix ├── LICENSE ├── Makefile ├── Makefile.coq.local ├── README.md ├── _CoqProject ├── coq-reglang.opam ├── default.nix ├── dune-project ├── extra ├── LICENSE.coqdocjs ├── config.js ├── coqdoc.css ├── coqdocjs.css ├── coqdocjs.js ├── footer.html ├── header.html ├── index.html └── index.md ├── meta.yml └── theories ├── dfa.v ├── dune ├── languages.v ├── minimization.v ├── misc.v ├── myhill_nerode.v ├── nfa.v ├── regexp.v ├── setoid_leq.v ├── shepherdson.v ├── two_way.v ├── vardi.v └── wmso.v /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Docker CI 4 | 5 | on: 6 | schedule: 7 | - cron: '10 1 * * 0' 8 | push: 9 | branches: 10 | - master 11 | pull_request: 12 | branches: 13 | - '**' 14 | 15 | jobs: 16 | build: 17 | # the OS must be GNU/Linux to be able to use the docker-coq-action 18 | runs-on: ubuntu-latest 19 | strategy: 20 | matrix: 21 | image: 22 | - 'mathcomp/mathcomp-dev:rocq-prover-dev' 23 | - 'mathcomp/mathcomp:2.3.0-coq-8.20' 24 | - 'mathcomp/mathcomp:2.2.0-coq-8.19' 25 | - 'mathcomp/mathcomp:2.2.0-coq-8.18' 26 | - 'mathcomp/mathcomp:2.1.0-coq-8.18' 27 | - 'mathcomp/mathcomp:2.1.0-coq-8.17' 28 | - 'mathcomp/mathcomp:2.1.0-coq-8.16' 29 | - 'mathcomp/mathcomp:2.0.0-coq-8.18' 30 | - 'mathcomp/mathcomp:2.0.0-coq-8.17' 31 | - 'mathcomp/mathcomp:2.0.0-coq-8.16' 32 | fail-fast: false 33 | steps: 34 | - uses: actions/checkout@v4 35 | - uses: coq-community/docker-coq-action@v1 36 | with: 37 | opam_file: 'coq-reglang.opam' 38 | custom_image: ${{ matrix.image }} 39 | 40 | 41 | # See also: 42 | # https://github.com/coq-community/docker-coq-action#readme 43 | # https://github.com/erikmd/docker-coq-github-action-demo 44 | -------------------------------------------------------------------------------- /.github/workflows/nix-action-8.16.yml: -------------------------------------------------------------------------------- 1 | jobs: 2 | coq: 3 | needs: [] 4 | runs-on: ubuntu-latest 5 | steps: 6 | - name: Determine which commit to initially checkout 7 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ 8 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ 9 | \ }}\" >> $GITHUB_ENV\nfi\n" 10 | - name: Git checkout 11 | uses: actions/checkout@v3 12 | with: 13 | fetch-depth: 0 14 | ref: ${{ env.target_commit }} 15 | - name: Determine which commit to test 16 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ 17 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ 18 | \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ 19 | \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ 20 | \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ 21 | \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ 22 | \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ 23 | \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" 24 | - name: Git checkout 25 | uses: actions/checkout@v3 26 | with: 27 | fetch-depth: 0 28 | ref: ${{ env.tested_commit }} 29 | - name: Cachix install 30 | uses: cachix/install-nix-action@v20 31 | with: 32 | nix_path: nixpkgs=channel:nixpkgs-unstable 33 | - name: Cachix setup coq-community 34 | uses: cachix/cachix-action@v12 35 | with: 36 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 37 | extraPullNames: coq, math-comp 38 | name: coq-community 39 | - id: stepCheck 40 | name: Checking presence of CI target coq 41 | run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ 42 | \ bundle \"8.16\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ 43 | echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ 44 | \ \"built:\" | sed \"s/.*/built/\")\n" 45 | - if: steps.stepCheck.outputs.status == 'built' 46 | name: Building/fetching current CI target 47 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 48 | job "coq" 49 | mathcomp: 50 | needs: 51 | - coq 52 | runs-on: ubuntu-latest 53 | steps: 54 | - name: Determine which commit to initially checkout 55 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ 56 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ 57 | \ }}\" >> $GITHUB_ENV\nfi\n" 58 | - name: Git checkout 59 | uses: actions/checkout@v3 60 | with: 61 | fetch-depth: 0 62 | ref: ${{ env.target_commit }} 63 | - name: Determine which commit to test 64 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ 65 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ 66 | \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ 67 | \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ 68 | \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ 69 | \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ 70 | \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ 71 | \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" 72 | - name: Git checkout 73 | uses: actions/checkout@v3 74 | with: 75 | fetch-depth: 0 76 | ref: ${{ env.tested_commit }} 77 | - name: Cachix install 78 | uses: cachix/install-nix-action@v20 79 | with: 80 | nix_path: nixpkgs=channel:nixpkgs-unstable 81 | - name: Cachix setup coq-community 82 | uses: cachix/cachix-action@v12 83 | with: 84 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 85 | extraPullNames: coq, math-comp 86 | name: coq-community 87 | - id: stepCheck 88 | name: Checking presence of CI target mathcomp 89 | run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ 90 | \ bundle \"8.16\" --argstr job \"mathcomp\" \\\n --dry-run 2>&1 > /dev/null)\n\ 91 | echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ 92 | \ \"built:\" | sed \"s/.*/built/\")\n" 93 | - if: steps.stepCheck.outputs.status == 'built' 94 | name: 'Building/fetching previous CI target: coq' 95 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 96 | job "coq" 97 | - if: steps.stepCheck.outputs.status == 'built' 98 | name: 'Building/fetching previous CI target: mathcomp-ssreflect' 99 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 100 | job "mathcomp-ssreflect" 101 | - if: steps.stepCheck.outputs.status == 'built' 102 | name: 'Building/fetching previous CI target: mathcomp-fingroup' 103 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 104 | job "mathcomp-fingroup" 105 | - if: steps.stepCheck.outputs.status == 'built' 106 | name: 'Building/fetching previous CI target: mathcomp-algebra' 107 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 108 | job "mathcomp-algebra" 109 | - if: steps.stepCheck.outputs.status == 'built' 110 | name: 'Building/fetching previous CI target: mathcomp-solvable' 111 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 112 | job "mathcomp-solvable" 113 | - if: steps.stepCheck.outputs.status == 'built' 114 | name: 'Building/fetching previous CI target: mathcomp-field' 115 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 116 | job "mathcomp-field" 117 | - if: steps.stepCheck.outputs.status == 'built' 118 | name: 'Building/fetching previous CI target: mathcomp-character' 119 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 120 | job "mathcomp-character" 121 | - if: steps.stepCheck.outputs.status == 'built' 122 | name: 'Building/fetching previous CI target: hierarchy-builder' 123 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 124 | job "hierarchy-builder" 125 | - if: steps.stepCheck.outputs.status == 'built' 126 | name: Building/fetching current CI target 127 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 128 | job "mathcomp" 129 | reglang: 130 | needs: 131 | - coq 132 | runs-on: ubuntu-latest 133 | steps: 134 | - name: Determine which commit to initially checkout 135 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ 136 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ 137 | \ }}\" >> $GITHUB_ENV\nfi\n" 138 | - name: Git checkout 139 | uses: actions/checkout@v3 140 | with: 141 | fetch-depth: 0 142 | ref: ${{ env.target_commit }} 143 | - name: Determine which commit to test 144 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ 145 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ 146 | \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ 147 | \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ 148 | \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ 149 | \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ 150 | \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ 151 | \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" 152 | - name: Git checkout 153 | uses: actions/checkout@v3 154 | with: 155 | fetch-depth: 0 156 | ref: ${{ env.tested_commit }} 157 | - name: Cachix install 158 | uses: cachix/install-nix-action@v20 159 | with: 160 | nix_path: nixpkgs=channel:nixpkgs-unstable 161 | - name: Cachix setup coq-community 162 | uses: cachix/cachix-action@v12 163 | with: 164 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 165 | extraPullNames: coq, math-comp 166 | name: coq-community 167 | - id: stepCheck 168 | name: Checking presence of CI target reglang 169 | run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ 170 | \ bundle \"8.16\" --argstr job \"reglang\" \\\n --dry-run 2>&1 > /dev/null)\n\ 171 | echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ 172 | \ \"built:\" | sed \"s/.*/built/\")\n" 173 | - if: steps.stepCheck.outputs.status == 'built' 174 | name: 'Building/fetching previous CI target: coq' 175 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 176 | job "coq" 177 | - if: steps.stepCheck.outputs.status == 'built' 178 | name: 'Building/fetching previous CI target: mathcomp-ssreflect' 179 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 180 | job "mathcomp-ssreflect" 181 | - if: steps.stepCheck.outputs.status == 'built' 182 | name: Building/fetching current CI target 183 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr 184 | job "reglang" 185 | name: Nix CI for bundle 8.16 186 | 'on': 187 | pull_request: 188 | paths: 189 | - .github/workflows/** 190 | pull_request_target: 191 | types: 192 | - opened 193 | - synchronize 194 | - reopened 195 | push: 196 | branches: 197 | - master 198 | -------------------------------------------------------------------------------- /.github/workflows/nix-action-8.17.yml: -------------------------------------------------------------------------------- 1 | jobs: 2 | coq: 3 | needs: [] 4 | runs-on: ubuntu-latest 5 | steps: 6 | - name: Determine which commit to initially checkout 7 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ 8 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ 9 | \ }}\" >> $GITHUB_ENV\nfi\n" 10 | - name: Git checkout 11 | uses: actions/checkout@v3 12 | with: 13 | fetch-depth: 0 14 | ref: ${{ env.target_commit }} 15 | - name: Determine which commit to test 16 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ 17 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ 18 | \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ 19 | \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ 20 | \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ 21 | \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ 22 | \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ 23 | \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" 24 | - name: Git checkout 25 | uses: actions/checkout@v3 26 | with: 27 | fetch-depth: 0 28 | ref: ${{ env.tested_commit }} 29 | - name: Cachix install 30 | uses: cachix/install-nix-action@v20 31 | with: 32 | nix_path: nixpkgs=channel:nixpkgs-unstable 33 | - name: Cachix setup coq-community 34 | uses: cachix/cachix-action@v12 35 | with: 36 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 37 | extraPullNames: coq, math-comp 38 | name: coq-community 39 | - id: stepCheck 40 | name: Checking presence of CI target coq 41 | run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ 42 | \ bundle \"8.17\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ 43 | echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ 44 | s/.*/built/\") >> $GITHUB_OUTPUT\n" 45 | - if: steps.stepCheck.outputs.status == 'built' 46 | name: Building/fetching current CI target 47 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 48 | job "coq" 49 | mathcomp: 50 | needs: 51 | - coq 52 | runs-on: ubuntu-latest 53 | steps: 54 | - name: Determine which commit to initially checkout 55 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ 56 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ 57 | \ }}\" >> $GITHUB_ENV\nfi\n" 58 | - name: Git checkout 59 | uses: actions/checkout@v3 60 | with: 61 | fetch-depth: 0 62 | ref: ${{ env.target_commit }} 63 | - name: Determine which commit to test 64 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ 65 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ 66 | \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ 67 | \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ 68 | \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ 69 | \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ 70 | \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ 71 | \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" 72 | - name: Git checkout 73 | uses: actions/checkout@v3 74 | with: 75 | fetch-depth: 0 76 | ref: ${{ env.tested_commit }} 77 | - name: Cachix install 78 | uses: cachix/install-nix-action@v20 79 | with: 80 | nix_path: nixpkgs=channel:nixpkgs-unstable 81 | - name: Cachix setup coq-community 82 | uses: cachix/cachix-action@v12 83 | with: 84 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 85 | extraPullNames: coq, math-comp 86 | name: coq-community 87 | - id: stepCheck 88 | name: Checking presence of CI target mathcomp 89 | run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ 90 | \ bundle \"8.17\" --argstr job \"mathcomp\" \\\n --dry-run 2>&1 > /dev/null)\n\ 91 | echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ 92 | s/.*/built/\") >> $GITHUB_OUTPUT\n" 93 | - if: steps.stepCheck.outputs.status == 'built' 94 | name: 'Building/fetching previous CI target: coq' 95 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 96 | job "coq" 97 | - if: steps.stepCheck.outputs.status == 'built' 98 | name: 'Building/fetching previous CI target: mathcomp-ssreflect' 99 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 100 | job "mathcomp-ssreflect" 101 | - if: steps.stepCheck.outputs.status == 'built' 102 | name: 'Building/fetching previous CI target: mathcomp-fingroup' 103 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 104 | job "mathcomp-fingroup" 105 | - if: steps.stepCheck.outputs.status == 'built' 106 | name: 'Building/fetching previous CI target: mathcomp-algebra' 107 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 108 | job "mathcomp-algebra" 109 | - if: steps.stepCheck.outputs.status == 'built' 110 | name: 'Building/fetching previous CI target: mathcomp-solvable' 111 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 112 | job "mathcomp-solvable" 113 | - if: steps.stepCheck.outputs.status == 'built' 114 | name: 'Building/fetching previous CI target: mathcomp-field' 115 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 116 | job "mathcomp-field" 117 | - if: steps.stepCheck.outputs.status == 'built' 118 | name: 'Building/fetching previous CI target: mathcomp-character' 119 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 120 | job "mathcomp-character" 121 | - if: steps.stepCheck.outputs.status == 'built' 122 | name: 'Building/fetching previous CI target: hierarchy-builder' 123 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 124 | job "hierarchy-builder" 125 | - if: steps.stepCheck.outputs.status == 'built' 126 | name: Building/fetching current CI target 127 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 128 | job "mathcomp" 129 | reglang: 130 | needs: 131 | - coq 132 | runs-on: ubuntu-latest 133 | steps: 134 | - name: Determine which commit to initially checkout 135 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ 136 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ 137 | \ }}\" >> $GITHUB_ENV\nfi\n" 138 | - name: Git checkout 139 | uses: actions/checkout@v3 140 | with: 141 | fetch-depth: 0 142 | ref: ${{ env.target_commit }} 143 | - name: Determine which commit to test 144 | run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ 145 | \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ 146 | \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ 147 | \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ 148 | \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ 149 | \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ 150 | \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ 151 | \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" 152 | - name: Git checkout 153 | uses: actions/checkout@v3 154 | with: 155 | fetch-depth: 0 156 | ref: ${{ env.tested_commit }} 157 | - name: Cachix install 158 | uses: cachix/install-nix-action@v20 159 | with: 160 | nix_path: nixpkgs=channel:nixpkgs-unstable 161 | - name: Cachix setup coq-community 162 | uses: cachix/cachix-action@v12 163 | with: 164 | authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} 165 | extraPullNames: coq, math-comp 166 | name: coq-community 167 | - id: stepCheck 168 | name: Checking presence of CI target reglang 169 | run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ 170 | \ bundle \"8.17\" --argstr job \"reglang\" \\\n --dry-run 2>&1 > /dev/null)\n\ 171 | echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ 172 | s/.*/built/\") >> $GITHUB_OUTPUT\n" 173 | - if: steps.stepCheck.outputs.status == 'built' 174 | name: 'Building/fetching previous CI target: coq' 175 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 176 | job "coq" 177 | - if: steps.stepCheck.outputs.status == 'built' 178 | name: 'Building/fetching previous CI target: mathcomp-ssreflect' 179 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 180 | job "mathcomp-ssreflect" 181 | - if: steps.stepCheck.outputs.status == 'built' 182 | name: Building/fetching current CI target 183 | run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr 184 | job "reglang" 185 | name: Nix CI for bundle 8.17 186 | 'on': 187 | pull_request: 188 | paths: 189 | - .github/workflows/nix-action-8.17.yml 190 | pull_request_target: 191 | paths-ignore: 192 | - .github/workflows/nix-action-8.17.yml 193 | types: 194 | - opened 195 | - synchronize 196 | - reopened 197 | push: 198 | branches: 199 | - master 200 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.vo 2 | *.glob 3 | *.v.d 4 | *.aux 5 | *.vio 6 | *.vos 7 | *.vok 8 | .Makefile.coq.d 9 | Makefile.coq 10 | Makefile.coq.bak 11 | Makefile.coq.conf 12 | .coqdeps.d 13 | *~ 14 | .coq-native/ 15 | _build/ 16 | docs/ 17 | .lia.cache 18 | -------------------------------------------------------------------------------- /.nix/config.nix: -------------------------------------------------------------------------------- 1 | { 2 | ## DO NOT CHANGE THIS 3 | format = "1.0.0"; 4 | ## unless you made an automated or manual update 5 | ## to another supported format. 6 | 7 | ## The attribute to build from the local sources, 8 | ## either using nixpkgs data or the overlays located in `.nix/coq-overlays` 9 | ## Will determine the default main-job of the bundles defined below 10 | attribute = "reglang"; 11 | 12 | ## If you want to select a different attribute (to build from the local sources as well) 13 | ## when calling `nix-shell` and `nix-build` without the `--argstr job` argument 14 | # shell-attribute = "{{nix_name}}"; 15 | 16 | ## Maybe the shortname of the library is different from 17 | ## the name of the nixpkgs attribute, if so, set it here: 18 | # pname = "{{shortname}}"; 19 | 20 | ## Lists the dependencies, phrased in terms of nix attributes. 21 | ## No need to list Coq, it is already included. 22 | ## These dependencies will systematically be added to the currently 23 | ## known dependencies, if any more than Coq. 24 | ## /!\ Remove this field as soon as the package is available on nixpkgs. 25 | ## /!\ Manual overlays in `.nix/coq-overlays` should be preferred then. 26 | # buildInputs = [ ]; 27 | 28 | ## Indicate the relative location of your _CoqProject 29 | ## If not specified, it defaults to "_CoqProject" 30 | # coqproject = "_CoqProject"; 31 | 32 | ## select an entry to build in the following `bundles` set 33 | ## defaults to "default" 34 | default-bundle = "8.16"; 35 | 36 | ## write one `bundles.name` attribute set per 37 | ## alternative configuration 38 | ## When generating GitHub Action CI, one workflow file 39 | ## will be created per bundle 40 | bundles = { 41 | ## You can override Coq and other Coq coqPackages 42 | ## through the following attribute 43 | # coqPackages.coq.override.version = "8.11"; 44 | 45 | ## In some cases, light overrides are not available/enough 46 | ## in which case you can use either 47 | # coqPackages..overrideAttrs = o: ; 48 | ## or a "long" overlay to put in `.nix/coq-overlays 49 | ## you may use `nix-shell --run fetchOverlay ` 50 | ## to automatically retrieve the one from nixpkgs 51 | ## if it exists and is correctly named/located 52 | 53 | ## You can override Coq and other coqPackages 54 | ## through the following attribute 55 | ## If does not support light overrides, 56 | ## you may use `overrideAttrs` or long overlays 57 | ## located in `.nix/ocaml-overlays` 58 | ## (there is no automation for this one) 59 | # ocamlPackages..override.version = "x.xx"; 60 | 61 | ## You can also override packages from the nixpkgs toplevel 62 | # .override.overrideAttrs = o: ; 63 | ## Or put an overlay in `.nix/overlays` 64 | 65 | ## you may mark a package as a main CI job (one to take deps and 66 | ## rev deps from) as follows 67 | # coqPackages..main-job = true; 68 | ## by default the current package and its shell attributes are main jobs 69 | 70 | ## you may mark a package as a CI job as follows 71 | # coqPackages..job = "test"; 72 | ## It can then built through 73 | ## nix-build --argstr bundle "default" --arg job "test"; 74 | ## in the absence of such a directive, the job "another-pkg" will 75 | ## is still available, but will be automatically included in the CI 76 | ## via the command genNixActions only if it is a dependency or a 77 | ## reverse dependency of a job flagged as "main-job" (see above). 78 | 79 | ## Run on push on following branches (default [ "master" ]) 80 | # push-branches = [ "master" "branch2" ]; 81 | 82 | "master" = { 83 | coqPackages = { 84 | coq.override.version = "master"; 85 | coq-elpi.override.version = "coq-master"; 86 | hierarchy-builder.override.version = "master"; 87 | mathcomp.override.version = "master"; 88 | }; 89 | ocamlPackages.elpi.override.version = "v1.18.1"; 90 | }; 91 | "8.17".coqPackages = { 92 | coq.override.version = "8.17"; 93 | mathcomp.override.version = "2.0.0"; 94 | }; 95 | "8.16".coqPackages = { 96 | coq.override.version = "8.16"; 97 | mathcomp.override.version = "2.0.0"; 98 | }; 99 | }; 100 | 101 | ## Cachix caches to use in CI 102 | ## Below we list some standard ones 103 | cachix.coq = {}; 104 | cachix.math-comp = {}; 105 | cachix.coq-community.authToken = "CACHIX_AUTH_TOKEN"; 106 | 107 | ## If you have write access to one of these caches you can 108 | ## provide the auth token or signing key through a secret 109 | ## variable on GitHub. Then, you should give the variable 110 | ## name here. For instance, coq-community projects can use 111 | ## the following line instead of the one above: 112 | # cachix.coq-community.authToken = "CACHIX_AUTH_TOKEN"; 113 | 114 | ## Or if you have a signing key for a given Cachix cache: 115 | # cachix.my-cache.signingKey = "CACHIX_SIGNING_KEY" 116 | 117 | ## Note that here, CACHIX_AUTH_TOKEN and CACHIX_SIGNING_KEY 118 | ## are the names of secret variables. They are set in 119 | ## GitHub's web interface. 120 | } 121 | -------------------------------------------------------------------------------- /.nix/coq-nix-toolbox.nix: -------------------------------------------------------------------------------- 1 | "4e48948fa8252a2fc755182abdd4b199f4798724" 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rocq-community/reglang/f4b5167168cb7022cffe39ec948d6581a82d368e/LICENSE -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Makefile.coq 2 | @+$(MAKE) -f Makefile.coq all 3 | 4 | clean: Makefile.coq 5 | @+$(MAKE) -f Makefile.coq cleanall 6 | @rm -f Makefile.coq Makefile.coq.conf 7 | 8 | Makefile.coq: _CoqProject 9 | $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq 10 | 11 | force _CoqProject Makefile: ; 12 | 13 | %: Makefile.coq force 14 | @+$(MAKE) -f Makefile.coq $@ 15 | 16 | .PHONY: all clean force 17 | -------------------------------------------------------------------------------- /Makefile.coq.local: -------------------------------------------------------------------------------- 1 | GLOBFILES = $(VFILES:.v=.glob) 2 | CSSFILES = extra/coqdoc.css extra/coqdocjs.css 3 | JSFILES = extra/config.js extra/coqdocjs.js 4 | HTMLFILES = extra/header.html extra/footer.html 5 | DOCDIR = docs 6 | COQDOCDIR = $(DOCDIR)/coqdoc 7 | 8 | COQDOCHTMLFLAGS = --toc -s --external 'http://math-comp.github.io/htmldoc/' mathcomp --html \ 9 | --with-header extra/header.html --with-footer extra/footer.html --index indexpage --parse-comments 10 | 11 | coqdoc: $(GLOBFILES) $(VFILES) $(CSSFILES) $(JSFILES) $(HTMLFILES) 12 | $(SHOW)'COQDOC -d $(COQDOCDIR)' 13 | $(HIDE)mkdir -p $(COQDOCDIR) 14 | $(HIDE)$(COQDOC) $(COQDOCHTMLFLAGS) $(COQDOCLIBS) -d $(COQDOCDIR) $(VFILES) 15 | $(SHOW)'COPY extra' 16 | $(HIDE)cp $(CSSFILES) $(JSFILES) $(COQDOCDIR) 17 | .PHONY: coqdoc 18 | 19 | extra/index.html: extra/index.md 20 | pandoc -s -o $@ $< 21 | 22 | clean:: 23 | $(HIDE)rm -rf $(DOCDIR) 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 5 | # Regular Language Representations in Coq 6 | 7 | [![Docker CI][docker-action-shield]][docker-action-link] 8 | [![Contributing][contributing-shield]][contributing-link] 9 | [![Code of Conduct][conduct-shield]][conduct-link] 10 | [![Zulip][zulip-shield]][zulip-link] 11 | [![coqdoc][coqdoc-shield]][coqdoc-link] 12 | [![DOI][doi-shield]][doi-link] 13 | 14 | [docker-action-shield]: https://github.com/coq-community/reglang/actions/workflows/docker-action.yml/badge.svg?branch=master 15 | [docker-action-link]: https://github.com/coq-community/reglang/actions/workflows/docker-action.yml 16 | 17 | [contributing-shield]: https://img.shields.io/badge/contributions-welcome-%23f7931e.svg 18 | [contributing-link]: https://github.com/coq-community/manifesto/blob/master/CONTRIBUTING.md 19 | 20 | [conduct-shield]: https://img.shields.io/badge/%E2%9D%A4-code%20of%20conduct-%23f15a24.svg 21 | [conduct-link]: https://github.com/coq-community/manifesto/blob/master/CODE_OF_CONDUCT.md 22 | 23 | [zulip-shield]: https://img.shields.io/badge/chat-on%20zulip-%23c1272d.svg 24 | [zulip-link]: https://coq.zulipchat.com/#narrow/stream/237663-coq-community-devs.20.26.20users 25 | 26 | [coqdoc-shield]: https://img.shields.io/badge/docs-coqdoc-blue.svg 27 | [coqdoc-link]: https://coq-community.org/reglang 28 | 29 | [doi-shield]: https://zenodo.org/badge/DOI/10.1007/s10817-018-9460-x.svg 30 | [doi-link]: https://doi.org/10.1007/s10817-018-9460-x 31 | 32 | This library provides definitions and verified translations between 33 | different representations of regular languages: various forms of 34 | automata (deterministic, nondeterministic, one-way, two-way), 35 | regular expressions, and the logic WS1S. It also contains various 36 | decidability results and closure properties of regular languages. 37 | 38 | ## Meta 39 | 40 | - Author(s): 41 | - Christian Doczkal (initial) 42 | - Jan-Oliver Kaiser (initial) 43 | - Gert Smolka (initial) 44 | - Coq-community maintainer(s): 45 | - Christian Doczkal ([**@chdoc**](https://github.com/chdoc)) 46 | - Karl Palmskog ([**@palmskog**](https://github.com/palmskog)) 47 | - License: [CeCILL-B](LICENSE) 48 | - Compatible Coq versions: 8.16 or later (use releases for other Coq versions) 49 | - Additional dependencies: 50 | - [MathComp](https://math-comp.github.io) 2.0 or later (`ssreflect` suffices) 51 | - [Hierarchy Builder](https://github.com/math-comp/hierarchy-builder) 1.4.0 or later 52 | - Coq namespace: `RegLang` 53 | - Related publication(s): 54 | - [Regular Language Representations in the Constructive Type Theory of Coq](https://hal.archives-ouvertes.fr/hal-01832031/document) doi:[10.1007/s10817-018-9460-x](https://doi.org/10.1007/s10817-018-9460-x) 55 | 56 | ## Building and installation instructions 57 | 58 | The easiest way to install the latest released version of Regular Language Representations in Coq 59 | is via [OPAM](https://opam.ocaml.org/doc/Install.html): 60 | 61 | ```shell 62 | opam repo add coq-released https://coq.inria.fr/opam/released 63 | opam install coq-reglang 64 | ``` 65 | 66 | To instead build and install manually, do: 67 | 68 | ``` shell 69 | git clone https://github.com/coq-community/reglang.git 70 | cd reglang 71 | make # or make -j 72 | make install 73 | ``` 74 | 75 | 76 | ## HTML Documentation 77 | 78 | To generate HTML documentation, run `make coqdoc` and point your browser at `docs/coqdoc/toc.html`. 79 | 80 | See also the pregenerated HTML documentation for the [latest release](https://coq-community.org/reglang/docs/latest/coqdoc/toc.html). 81 | 82 | ## File Contents 83 | 84 | * `misc.v`, `setoid_leq.v`: basic infrastructure independent of regular languages 85 | * `languages.v`: languages and decidable languages 86 | * `dfa.v`: 87 | * results on deterministic one-way automata 88 | * definition of regularity 89 | * criteria for nonregularity 90 | * `nfa.v`: Results on nondeterministic one-way automata 91 | * `regexp.v`: Regular expressions and Kleene Theorem 92 | * `minimization.v`: minimization and uniqueness of minimal DFAs 93 | * `myhill_nerode.v`: classifiers and the constructive Myhill-Nerode theorem 94 | * `two_way.v`: deterministic and nondeterministic two-way automata 95 | * `vardi.v`: translation from 2NFAs to NFAs for the complement language 96 | * `shepherdson.v`: translation from 2NFAs and 2DFAs to DFAs (via classifiers) 97 | * `wmso.v`: 98 | * decidability of WS1S 99 | * WS1S as representation of regular languages 100 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q theories RegLang 2 | -arg -w -arg -notation-overridden 3 | -arg -w -arg -redundant-canonical-projection 4 | theories/misc.v 5 | theories/setoid_leq.v 6 | theories/languages.v 7 | theories/dfa.v 8 | theories/nfa.v 9 | theories/regexp.v 10 | theories/minimization.v 11 | theories/myhill_nerode.v 12 | theories/two_way.v 13 | theories/vardi.v 14 | theories/shepherdson.v 15 | theories/wmso.v 16 | -------------------------------------------------------------------------------- /coq-reglang.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "palmskog@gmail.com" 3 | version: "dev" 4 | 5 | homepage: "https://github.com/coq-community/reglang" 6 | dev-repo: "git+https://github.com/coq-community/reglang.git" 7 | bug-reports: "https://github.com/coq-community/reglang/issues" 8 | doc: "https://coq-community.github.io/reglang/" 9 | license: "CECILL-B" 10 | 11 | synopsis: "Representations of regular languages (i.e., regexps, various types of automata, and WS1S) with equivalence proofs, in Coq and MathComp" 12 | description: """ 13 | This library provides definitions and verified translations between 14 | different representations of regular languages: various forms of 15 | automata (deterministic, nondeterministic, one-way, two-way), 16 | regular expressions, and the logic WS1S. It also contains various 17 | decidability results and closure properties of regular languages.""" 18 | 19 | build: ["dune" "build" "-p" name "-j" jobs] 20 | depends: [ 21 | "dune" {>= "3.5"} 22 | "coq" {>= "8.16"} 23 | "coq-mathcomp-ssreflect" {>= "2.0"} 24 | "coq-hierarchy-builder" {>= "1.4.0"} 25 | ] 26 | 27 | tags: [ 28 | "category:Computer Science/Formal Languages Theory and Automata" 29 | "keyword:regular languages" 30 | "keyword:regular expressions" 31 | "keyword:finite automata" 32 | "keyword:two-way automata" 33 | "keyword:monadic second-order logic" 34 | "logpath:RegLang" 35 | ] 36 | authors: [ 37 | "Christian Doczkal" 38 | "Jan-Oliver Kaiser" 39 | "Gert Smolka" 40 | ] 41 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, 2 | update-nixpkgs ? false, ci-matrix ? false, 3 | override ? {}, ocaml-override ? {}, global-override ? {}, 4 | bundle ? null, job ? null, inNixShell ? null, src ? ./., 5 | }@args: 6 | let auto = fetchGit { 7 | url = "https://github.com/coq-community/coq-nix-toolbox.git"; 8 | ref = "master"; 9 | rev = import .nix/coq-nix-toolbox.nix; 10 | }; 11 | in 12 | import auto ({inherit src;} // args) 13 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.5) 2 | (using coq 0.6) 3 | (name reglang) 4 | -------------------------------------------------------------------------------- /extra/LICENSE.coqdocjs: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Tobias Tebbi 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | * Redistributions of source code must retain the above copyright 7 | notice, this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright 9 | notice, this list of conditions and the following disclaimer in the 10 | documentation and/or other materials provided with the distribution. 11 | 12 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 13 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 14 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 15 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY 16 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 17 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 18 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 19 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 20 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 21 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 22 | -------------------------------------------------------------------------------- /extra/config.js: -------------------------------------------------------------------------------- 1 | var coqdocjs = coqdocjs || {}; 2 | 3 | coqdocjs.repl = { 4 | "forall": "∀", 5 | "exists": "∃", 6 | "~": "¬", 7 | "/\\": "∧", 8 | "\\/": "∨", 9 | "->": "→", 10 | "<-": "←", 11 | "<->": "↔", 12 | "=>": "⇒", 13 | "<>": "≠", 14 | "<=": "≤", 15 | ">=": "≥", 16 | "el": "∈", 17 | "nel": "∉", 18 | "<<=": "⊆", 19 | "|-": "⊢", 20 | ">>": "»", 21 | "<<": "⊆", 22 | "++": "⧺", 23 | "===": "≡", 24 | "=/=": "≢", 25 | "=~=": "≅", 26 | "==>": "⟹", 27 | "lhd": "⊲", 28 | "rhd": "⊳", 29 | "nat": "ℕ", 30 | // "alpha": "α", 31 | // "beta": "β", 32 | // "gamma": "γ", 33 | // "delta": "δ", 34 | // "epsilon": "ε", 35 | // "eta": "η", 36 | // "iota": "ι", 37 | // "kappa": "κ", 38 | // "lambda": "λ", 39 | // "mu": "μ", 40 | // "nu": "ν", 41 | // "omega": "ω", 42 | // "phi": "ϕ", 43 | // "pi": "π", 44 | // "psi": "ψ", 45 | // "rho": "ρ", 46 | // "sigma": "σ", 47 | // "tau": "τ", 48 | // "theta": "θ", 49 | // "xi": "ξ", 50 | // "zeta": "ζ", 51 | // "Delta": "Δ", 52 | // "Gamma": "Γ", 53 | // "Pi": "Π", 54 | // "Sigma": "Σ", 55 | // "Omega": "Ω", 56 | // "Xi": "Ξ" 57 | }; 58 | 59 | coqdocjs.subscr = { 60 | "0" : "₀", 61 | "1" : "₁", 62 | "2" : "₂", 63 | "3" : "₃", 64 | "4" : "₄", 65 | "5" : "₅", 66 | "6" : "₆", 67 | "7" : "₇", 68 | "8" : "₈", 69 | "9" : "₉", 70 | }; 71 | 72 | coqdocjs.replInText = ["==>","<=>", "=>", "->", "<-", ":="]; 73 | -------------------------------------------------------------------------------- /extra/coqdoc.css: -------------------------------------------------------------------------------- 1 | @import url(https://fonts.googleapis.com/css?family=Open+Sans:400,700); 2 | 3 | body{ 4 | font-family: 'Open Sans', sans-serif; 5 | font-size: 14px; 6 | color: #2D2D2D 7 | } 8 | 9 | a { 10 | text-decoration: none; 11 | border-radius: 3px; 12 | padding-left: 3px; 13 | padding-right: 3px; 14 | margin-left: -3px; 15 | margin-right: -3px; 16 | color: inherit; 17 | font-weight: bold; 18 | } 19 | 20 | #main .code a, #main .inlinecode a, #toc a { 21 | font-weight: inherit; 22 | } 23 | 24 | a[href]:hover, [clickable]:hover{ 25 | background-color: rgba(0,0,0,0.1); 26 | cursor: pointer; 27 | } 28 | 29 | h, h1, h2, h3, h4, h5 { 30 | line-height: 1; 31 | color: black; 32 | text-rendering: optimizeLegibility; 33 | font-weight: normal; 34 | letter-spacing: 0.1em; 35 | text-align: left; 36 | } 37 | 38 | div + br { 39 | display: none; 40 | } 41 | 42 | div:empty{ display: none;} 43 | 44 | #main h1 { 45 | font-size: 2em; 46 | } 47 | 48 | #main h2 { 49 | font-size: 1.667rem; 50 | } 51 | 52 | #main h3 { 53 | font-size: 1.333em; 54 | } 55 | 56 | #main h4, #main h5, #main h6 { 57 | font-size: 1em; 58 | } 59 | 60 | #toc h2 { 61 | padding-bottom: 0; 62 | } 63 | 64 | #main .doc { 65 | margin: 0; 66 | text-align: justify; 67 | } 68 | 69 | .inlinecode, .code, #main pre { 70 | font-family: monospace; 71 | } 72 | 73 | .code > br:first-child { 74 | display: none; 75 | } 76 | 77 | .doc + .code{ 78 | margin-top:0.5em; 79 | } 80 | 81 | .block{ 82 | display: block; 83 | margin-top: 5px; 84 | margin-bottom: 5px; 85 | padding: 10px; 86 | text-align: center; 87 | } 88 | 89 | .block img{ 90 | margin: 15px; 91 | } 92 | 93 | table.infrule { 94 | border: 0px; 95 | margin-left: 50px; 96 | margin-top: 10px; 97 | margin-bottom: 10px; 98 | } 99 | 100 | td.infrule { 101 | font-family: "Droid Sans Mono", "DejaVu Sans Mono", monospace; 102 | text-align: center; 103 | padding: 0; 104 | line-height: 1; 105 | } 106 | 107 | tr.infrulemiddle hr { 108 | margin: 1px 0 1px 0; 109 | } 110 | 111 | .infrulenamecol { 112 | color: rgb(60%,60%,60%); 113 | padding-left: 1em; 114 | padding-bottom: 0.1em 115 | } 116 | 117 | .id[type="constructor"], .id[type="projection"], .id[type="method"], 118 | .id[title="constructor"], .id[title="projection"], .id[title="method"] { 119 | color: #A30E16; 120 | } 121 | 122 | .id[type="var"], .id[type="variable"], 123 | .id[title="var"], .id[title="variable"] { 124 | color: inherit; 125 | } 126 | 127 | .id[type="definition"], .id[type="record"], .id[type="class"], .id[type="instance"], .id[type="inductive"], .id[type="library"], 128 | .id[title="definition"], .id[title="record"], .id[title="class"], .id[title="instance"], .id[title="inductive"], .id[title="library"] { 129 | color: #A6650F; 130 | } 131 | 132 | .id[type="lemma"], 133 | .id[title="lemma"]{ 134 | color: #188B0C; 135 | } 136 | 137 | .id[type="keyword"], .id[type="notation"], .id[type="abbreviation"], 138 | .id[title="keyword"], .id[title="notation"], .id[title="abbreviation"]{ 139 | color : #2874AE; 140 | } 141 | 142 | .comment { 143 | color: #808080; 144 | } 145 | 146 | /* TOC */ 147 | 148 | #toc h2{ 149 | letter-spacing: 0; 150 | font-size: 1.333em; 151 | } 152 | 153 | /* Index */ 154 | 155 | #index { 156 | margin: 0; 157 | padding: 0; 158 | width: 100%; 159 | } 160 | 161 | #index #frontispiece { 162 | margin: 1em auto; 163 | padding: 1em; 164 | width: 60%; 165 | } 166 | 167 | .booktitle { font-size : 140% } 168 | .authors { font-size : 90%; 169 | line-height: 115%; } 170 | .moreauthors { font-size : 60% } 171 | 172 | #index #entrance { 173 | text-align: center; 174 | } 175 | 176 | #index #entrance .spacer { 177 | margin: 0 30px 0 30px; 178 | } 179 | 180 | ul.doclist { 181 | margin-top: 0em; 182 | margin-bottom: 0em; 183 | white-space:nowrap; 184 | } 185 | 186 | #toc > * { 187 | clear: both; 188 | } 189 | 190 | #toc > a { 191 | display: block; 192 | float: left; 193 | margin-top: 1em; 194 | } 195 | 196 | #toc a h2{ 197 | display: inline; 198 | } 199 | -------------------------------------------------------------------------------- /extra/coqdocjs.css: -------------------------------------------------------------------------------- 1 | /* replace unicode */ 2 | 3 | .id[repl] .hidden { 4 | font-size: 0; 5 | } 6 | 7 | .id[repl]:before{ 8 | content: attr(repl); 9 | } 10 | 11 | /* folding proofs */ 12 | 13 | @keyframes show-proof { 14 | 0% { 15 | max-height: 1.2em; 16 | opacity: 1; 17 | } 18 | 99% { 19 | max-height: 1000em; 20 | } 21 | 100%{ 22 | } 23 | } 24 | 25 | @keyframes hide-proof { 26 | from { 27 | visibility: visible; 28 | max-height: 10em; 29 | opacity: 1; 30 | } 31 | to { 32 | max-height: 1.2em; 33 | } 34 | } 35 | 36 | .proof { 37 | cursor: pointer; 38 | } 39 | .proof * { 40 | cursor: pointer; 41 | } 42 | 43 | .proof { 44 | overflow: hidden; 45 | position: relative; 46 | display: inline-block; 47 | } 48 | 49 | .proof[show="false"] { 50 | max-height: 1.2em; 51 | visibility: hidden; 52 | opacity: 0; 53 | } 54 | 55 | .proof[show="false"][animate] { 56 | animation-name: hide-proof; 57 | animation-duration: 0.25s; 58 | } 59 | 60 | .proof[show=true] { 61 | animation-name: show-proof; 62 | animation-duration: 10s; 63 | } 64 | 65 | .proof[show="false"]:before { 66 | position: absolute; 67 | visibility: visible; 68 | width: 100%; 69 | height: 100%; 70 | display: block; 71 | opacity: 0; 72 | content: "M"; 73 | } 74 | .proof[show="false"]:hover:before { 75 | content: ""; 76 | } 77 | 78 | .proof[show="false"] + br + br { 79 | display: none; 80 | } 81 | 82 | .proof[show="false"]:hover { 83 | visibility: visible; 84 | opacity: 0.5; 85 | } 86 | 87 | #toggle-proofs[proof-status="no-proofs"] { 88 | display: none; 89 | } 90 | 91 | #toggle-proofs[proof-status="some-hidden"]:before { 92 | content: "Show Proofs"; 93 | } 94 | 95 | #toggle-proofs[proof-status="all-shown"]:before { 96 | content: "Hide Proofs"; 97 | } 98 | 99 | 100 | /* page layout */ 101 | 102 | html, body { 103 | height: 100%; 104 | margin:0; 105 | padding:0; 106 | } 107 | 108 | body { 109 | display: flex; 110 | flex-direction: column 111 | } 112 | 113 | #content { 114 | flex: 1; 115 | overflow: auto; 116 | display: flex; 117 | flex-direction: column; 118 | } 119 | #content:focus { 120 | outline: none; /* prevent glow in OS X */ 121 | } 122 | 123 | #main { 124 | display: block; 125 | padding: 16px; 126 | padding-top: 1em; 127 | padding-bottom: 2em; 128 | margin-left: auto; 129 | margin-right: auto; 130 | max-width: 60em; 131 | flex: 1 0 auto; 132 | } 133 | 134 | .libtitle { 135 | display: none; 136 | } 137 | 138 | /* header */ 139 | #header { 140 | width:100%; 141 | padding: 0; 142 | margin: 0; 143 | display: flex; 144 | align-items: center; 145 | background-color: rgb(21,57,105); 146 | color: white; 147 | font-weight: bold; 148 | overflow: hidden; 149 | } 150 | 151 | 152 | .button { 153 | cursor: pointer; 154 | } 155 | 156 | #header * { 157 | text-decoration: none; 158 | vertical-align: middle; 159 | margin-left: 15px; 160 | margin-right: 15px; 161 | } 162 | 163 | #header > .right, #header > .left { 164 | display: flex; 165 | flex: 1; 166 | align-items: center; 167 | } 168 | #header > .left { 169 | text-align: left; 170 | } 171 | #header > .right { 172 | flex-direction: row-reverse; 173 | } 174 | 175 | #header a, #header .button { 176 | color: white; 177 | box-sizing: border-box; 178 | } 179 | 180 | #header a { 181 | border-radius: 0; 182 | padding: 0.2em; 183 | } 184 | 185 | #header .button { 186 | background-color: rgb(63, 103, 156); 187 | border-radius: 1em; 188 | padding-left: 0.5em; 189 | padding-right: 0.5em; 190 | margin: 0.2em; 191 | } 192 | 193 | #header a:hover, #header .button:hover { 194 | background-color: rgb(181, 213, 255); 195 | color: black; 196 | } 197 | 198 | #header h1 { padding: 0; 199 | margin: 0;} 200 | 201 | /* footer */ 202 | #footer { 203 | text-align: center; 204 | opacity: 0.5; 205 | font-size: 75%; 206 | } 207 | 208 | /* hyperlinks */ 209 | 210 | @keyframes highlight { 211 | 50%{ 212 | background-color: black; 213 | } 214 | } 215 | 216 | :target * { 217 | animation-name: highlight; 218 | animation-duration: 1s; 219 | } 220 | 221 | a[name]:empty { 222 | float: right; 223 | } 224 | 225 | /* Proviola */ 226 | 227 | div.code { 228 | width: auto; 229 | float: none; 230 | } 231 | 232 | div.goal { 233 | position: fixed; 234 | left: 75%; 235 | width: 25%; 236 | top: 3em; 237 | } 238 | 239 | div.doc { 240 | clear: both; 241 | } 242 | 243 | span.command:hover { 244 | background-color: inherit; 245 | } 246 | -------------------------------------------------------------------------------- /extra/coqdocjs.js: -------------------------------------------------------------------------------- 1 | var coqdocjs = coqdocjs || {}; 2 | (function(){ 3 | 4 | function replace(s){ 5 | var m; 6 | if (m = s.match(/^(.+)'/)) { 7 | return replace(m[1])+"'"; 8 | } else if (m = s.match(/^([A-Za-z]+)_?(\d+)$/)) { 9 | return replace(m[1])+m[2].replace(/\d/g, function(d){return coqdocjs.subscr[d]}); 10 | } else if (coqdocjs.repl.hasOwnProperty(s)){ 11 | return coqdocjs.repl[s] 12 | } else { 13 | return s; 14 | } 15 | } 16 | 17 | function toArray(nl){ 18 | return Array.prototype.slice.call(nl); 19 | } 20 | 21 | function replInTextNodes() { 22 | coqdocjs.replInText.forEach(function(toReplace){ 23 | toArray(document.getElementsByClassName("code")).concat(toArray(document.getElementsByClassName("inlinecode"))).forEach(function(elem){ 24 | toArray(elem.childNodes).forEach(function(node){ 25 | if (node.nodeType != Node.TEXT_NODE) return; 26 | var fragments = node.textContent.split(toReplace); 27 | node.textContent = fragments[fragments.length-1]; 28 | for (var k = 0; k < fragments.length - 1; ++k) { 29 | node.parentNode.insertBefore(document.createTextNode(fragments[k]),node); 30 | var replacement = document.createElement("span"); 31 | replacement.appendChild(document.createTextNode(toReplace)); 32 | replacement.setAttribute("class", "id"); 33 | replacement.setAttribute("type", "keyword"); 34 | node.parentNode.insertBefore(replacement, node); 35 | } 36 | }); 37 | }); 38 | }); 39 | } 40 | 41 | function replNodes() { 42 | toArray(document.getElementsByClassName("id")).forEach(function(node){ 43 | if (["var", "variable", "keyword", "notation", "definition", "inductive"].indexOf(node.getAttribute("type"))>=0){ 44 | var text = node.textContent; 45 | var replText = replace(text); 46 | if(text != replText) { 47 | node.setAttribute("repl", replText); 48 | node.setAttribute("title", text); 49 | var hidden = document.createElement("span"); 50 | hidden.setAttribute("class", "hidden"); 51 | while (node.firstChild) { 52 | hidden.appendChild(node.firstChild); 53 | } 54 | node.appendChild(hidden); 55 | } 56 | } 57 | }); 58 | } 59 | 60 | function isVernacStart(l, t){ 61 | t = t.trim(); 62 | for(var s of l){ 63 | if (t == s || t.startsWith(s+" ") || t.startsWith(s+".")){ 64 | return true; 65 | } 66 | } 67 | return false; 68 | } 69 | 70 | function isProofStart(s){ 71 | return isVernacStart(["Proof"], s); 72 | } 73 | 74 | function isProofEnd(s){ 75 | return isVernacStart(["Qed", "Admitted", "Defined"], s); 76 | } 77 | 78 | function proofStatus(){ 79 | var proofs = toArray(document.getElementsByClassName("proof")); 80 | if(proofs.length) { 81 | for(var proof of proofs) { 82 | if (proof.getAttribute("show") === "false") { 83 | return "some-hidden"; 84 | } 85 | } 86 | return "all-shown"; 87 | } 88 | else { 89 | return "no-proofs"; 90 | } 91 | } 92 | 93 | function updateView(){ 94 | document.getElementById("toggle-proofs").setAttribute("proof-status", proofStatus()); 95 | } 96 | 97 | function foldProofs() { 98 | var hasCommands = true; 99 | var nodes = document.getElementsByClassName("command"); 100 | if(nodes.length == 0) { 101 | hasCommands = false; 102 | console.log("no command tags found") 103 | nodes = document.getElementsByClassName("id"); 104 | } 105 | toArray(nodes).forEach(function(node){ 106 | if(isProofStart(node.textContent)) { 107 | var proof = document.createElement("span"); 108 | proof.setAttribute("class", "proof"); 109 | 110 | node.parentNode.insertBefore(proof, node); 111 | if(proof.previousSibling.nodeType === Node.TEXT_NODE) 112 | proof.appendChild(proof.previousSibling); 113 | while(node && !isProofEnd(node.textContent)) { 114 | proof.appendChild(node); 115 | node = proof.nextSibling; 116 | } 117 | if (proof.nextSibling) proof.appendChild(proof.nextSibling); // the Qed 118 | if (!hasCommands && proof.nextSibling) proof.appendChild(proof.nextSibling); // the dot after the Qed 119 | 120 | proof.addEventListener("click", function(proof){return function(e){ 121 | if (e.target.parentNode.tagName.toLowerCase() === "a") 122 | return; 123 | proof.setAttribute("show", proof.getAttribute("show") === "true" ? "false" : "true"); 124 | proof.setAttribute("animate", ""); 125 | updateView(); 126 | };}(proof)); 127 | proof.setAttribute("show", "false"); 128 | } 129 | }); 130 | } 131 | 132 | function toggleProofs(){ 133 | var someProofsHidden = proofStatus() === "some-hidden"; 134 | toArray(document.getElementsByClassName("proof")).forEach(function(proof){ 135 | proof.setAttribute("show", someProofsHidden); 136 | proof.setAttribute("animate", ""); 137 | }); 138 | updateView(); 139 | } 140 | 141 | function repairDom(){ 142 | // pull whitespace out of command 143 | toArray(document.getElementsByClassName("command")).forEach(function(node){ 144 | while(node.firstChild && node.firstChild.textContent.trim() == ""){ 145 | console.log("try move"); 146 | node.parentNode.insertBefore(node.firstChild, node); 147 | } 148 | }); 149 | toArray(document.getElementsByClassName("id")).forEach(function(node){ 150 | node.setAttribute("type", node.getAttribute("title")); 151 | }); 152 | toArray(document.getElementsByClassName("idref")).forEach(function(ref){ 153 | toArray(ref.childNodes).forEach(function(child){ 154 | if (["var", "variable"].indexOf(child.getAttribute("type")) > -1) 155 | ref.removeAttribute("href"); 156 | }); 157 | }); 158 | 159 | } 160 | 161 | function fixTitle(){ 162 | var url = "/" + window.location.pathname; 163 | var modulename = "." + url.substring(url.lastIndexOf('/')+1, url.lastIndexOf('.')); 164 | modulename = modulename.substring(modulename.lastIndexOf('.')+1); 165 | if (modulename === "toc") {modulename = "Table of Contents";} 166 | else if (modulename === "indexpage") {modulename = "Index";} 167 | else {modulename = modulename + ".v";}; 168 | document.title = modulename; 169 | } 170 | 171 | function postprocess(){ 172 | repairDom(); 173 | replInTextNodes() 174 | replNodes(); 175 | foldProofs(); 176 | document.getElementById("toggle-proofs").addEventListener("click", toggleProofs); 177 | updateView(); 178 | } 179 | 180 | fixTitle(); 181 | document.addEventListener('DOMContentLoaded', postprocess); 182 | 183 | coqdocjs.toggleProofs = toggleProofs; 184 | })(); 185 | -------------------------------------------------------------------------------- /extra/footer.html: -------------------------------------------------------------------------------- 1 | 2 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /extra/header.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 26 |
27 |
28 | -------------------------------------------------------------------------------- /extra/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Regular Language Representations in Coq 8 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
22 |

Regular Language Representations in Coq

23 |
24 | 27 |

About

28 |

Welcome to the Regular Language Representations in Coq project website! This project is part of coq-community.

29 |

This library provides definitions and verified translations between different representations of regular languages: various forms of automata (deterministic, nondeterministic, one-way, two-way), regular expressions, and the logic WS1S. It also contains various decidability results and closure properties of regular languages.

30 |

This is an open source project, licensed under CeCILL-B.

31 |

Get the code

32 |

The current stable release of Regular Language Representations in Coq can be downloaded from GitHub.

33 |

Documentation

34 |

The coqdoc presentations of releases can be browsed online:

35 | 39 |

See also related publications:

40 | 43 |

Help and contact

44 |
    45 |
  • Report issues on GitHub
    • 46 |
  • Chat with us on Zulip
    • 47 |
  • Discuss with us on Coq’s Discourse forum
    • 48 |
49 |

Authors and contributors

50 |
    51 |
  • Christian Doczkal
    • 52 |
  • Jan-Oliver Kaiser
    • 53 |
  • Gert Smolka
    • 54 |
55 | 56 | 57 | -------------------------------------------------------------------------------- /extra/index.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Regular Language Representations in Coq 3 | lang: en 4 | header-includes: 5 | - | 6 | 7 | 8 | 9 | 10 | 11 | --- 12 | 13 |
14 | [View the project on GitHub](https://github.com/coq-community/reglang) 15 |
16 | 17 | ## About 18 | 19 | Welcome to the Regular Language Representations in Coq project website! This project is part of [coq-community](https://github.com/coq-community/manifesto). 20 | 21 | This library provides definitions and verified translations between 22 | different representations of regular languages: various forms of 23 | automata (deterministic, nondeterministic, one-way, two-way), 24 | regular expressions, and the logic WS1S. It also contains various 25 | decidability results and closure properties of regular languages. 26 | 27 | This is an open source project, licensed under CeCILL-B. 28 | 29 | ## Get the code 30 | 31 | The current stable release of Regular Language Representations in Coq can be [downloaded from GitHub](https://github.com/coq-community/reglang/releases). 32 | 33 | ## Documentation 34 | 35 | The coqdoc presentations of releases can be browsed online: 36 | 37 | - [v1.1.1](docs/v1.1.1/coqdoc/toc.html) 38 | - [v1.1](docs/v1.1/coqdoc/toc.html) 39 | 40 | See also related publications: 41 | 42 | - [Regular Language Representations in the Constructive Type Theory of Coq](https://hal.archives-ouvertes.fr/hal-01832031/document) doi:[10.1007/s10817-018-9460-x](https://doi.org/10.1007/s10817-018-9460-x) 43 | 44 | ## Help and contact 45 | 46 | - Report issues on [GitHub](https://github.com/coq-community/reglang/issues) 47 | - Chat with us on [Zulip](https://coq.zulipchat.com/#narrow/stream/237663-coq-community-devs.20.26.20users) 48 | - Discuss with us on Coq's [Discourse](https://coq.discourse.group) forum 49 | 50 | ## Authors and contributors 51 | 52 | - Christian Doczkal 53 | - Jan-Oliver Kaiser 54 | - Gert Smolka 55 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | --- 2 | fullname: Regular Language Representations in Coq 3 | shortname: reglang 4 | organization: coq-community 5 | community: true 6 | action: true 7 | nix: false 8 | coqdoc: true 9 | dune: true 10 | doi: 10.1007/s10817-018-9460-x 11 | 12 | synopsis: >- 13 | Representations of regular languages (i.e., regexps, various types 14 | of automata, and WS1S) with equivalence proofs, in Coq and MathComp 15 | 16 | description: |- 17 | This library provides definitions and verified translations between 18 | different representations of regular languages: various forms of 19 | automata (deterministic, nondeterministic, one-way, two-way), 20 | regular expressions, and the logic WS1S. It also contains various 21 | decidability results and closure properties of regular languages. 22 | 23 | publications: 24 | - pub_url: https://hal.archives-ouvertes.fr/hal-01832031/document 25 | pub_title: Regular Language Representations in the Constructive Type Theory of Coq 26 | pub_doi: 10.1007/s10817-018-9460-x 27 | 28 | authors: 29 | - name: Christian Doczkal 30 | initial: true 31 | - name: Jan-Oliver Kaiser 32 | initial: true 33 | - name: Gert Smolka 34 | initial: true 35 | 36 | maintainers: 37 | - name: Christian Doczkal 38 | nickname: chdoc 39 | - name: Karl Palmskog 40 | nickname: palmskog 41 | 42 | opam-file-maintainer: palmskog@gmail.com 43 | 44 | opam-file-version: dev 45 | 46 | license: 47 | fullname: CeCILL-B 48 | identifier: CECILL-B 49 | 50 | supported_coq_versions: 51 | text: 8.16 or later (use releases for other Coq versions) 52 | opam: '{>= "8.16"}' 53 | 54 | dependencies: 55 | - opam: 56 | name: coq-mathcomp-ssreflect 57 | version: '{>= "2.0"}' 58 | description: |- 59 | [MathComp](https://math-comp.github.io) 2.0 or later (`ssreflect` suffices) 60 | - opam: 61 | name: coq-hierarchy-builder 62 | version: '{>= "1.4.0"}' 63 | description: |- 64 | [Hierarchy Builder](https://github.com/math-comp/hierarchy-builder) 1.4.0 or later 65 | 66 | tested_coq_opam_versions: 67 | - version: 'rocq-prover-dev' 68 | repo: 'mathcomp/mathcomp-dev' 69 | - version: '2.3.0-coq-8.20' 70 | repo: 'mathcomp/mathcomp' 71 | - version: '2.2.0-coq-8.19' 72 | repo: 'mathcomp/mathcomp' 73 | - version: '2.2.0-coq-8.18' 74 | repo: 'mathcomp/mathcomp' 75 | - version: '2.1.0-coq-8.18' 76 | repo: 'mathcomp/mathcomp' 77 | - version: '2.1.0-coq-8.17' 78 | repo: 'mathcomp/mathcomp' 79 | - version: '2.1.0-coq-8.16' 80 | repo: 'mathcomp/mathcomp' 81 | - version: '2.0.0-coq-8.18' 82 | repo: 'mathcomp/mathcomp' 83 | - version: '2.0.0-coq-8.17' 84 | repo: 'mathcomp/mathcomp' 85 | - version: '2.0.0-coq-8.16' 86 | repo: 'mathcomp/mathcomp' 87 | 88 | ci_cron_schedule: '10 1 * * 0' 89 | 90 | namespace: RegLang 91 | 92 | keywords: 93 | - name: regular languages 94 | - name: regular expressions 95 | - name: finite automata 96 | - name: two-way automata 97 | - name: monadic second-order logic 98 | 99 | categories: 100 | - name: Computer Science/Formal Languages Theory and Automata 101 | 102 | documentation: |- 103 | ## HTML Documentation 104 | 105 | To generate HTML documentation, run `make coqdoc` and point your browser at `docs/coqdoc/toc.html`. 106 | 107 | See also the pregenerated HTML documentation for the [latest release](https://coq-community.org/reglang/docs/latest/coqdoc/toc.html). 108 | 109 | ## File Contents 110 | 111 | * `misc.v`, `setoid_leq.v`: basic infrastructure independent of regular languages 112 | * `languages.v`: languages and decidable languages 113 | * `dfa.v`: 114 | * results on deterministic one-way automata 115 | * definition of regularity 116 | * criteria for nonregularity 117 | * `nfa.v`: Results on nondeterministic one-way automata 118 | * `regexp.v`: Regular expressions and Kleene Theorem 119 | * `minimization.v`: minimization and uniqueness of minimal DFAs 120 | * `myhill_nerode.v`: classifiers and the constructive Myhill-Nerode theorem 121 | * `two_way.v`: deterministic and nondeterministic two-way automata 122 | * `vardi.v`: translation from 2NFAs to NFAs for the complement language 123 | * `shepherdson.v`: translation from 2NFAs and 2DFAs to DFAs (via classifiers) 124 | * `wmso.v`: 125 | * decidability of WS1S 126 | * WS1S as representation of regular languages 127 | --- 128 | -------------------------------------------------------------------------------- /theories/dfa.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From Coq Require Import Setoid. 4 | From mathcomp Require Import all_ssreflect. 5 | From RegLang Require Import misc languages. 6 | 7 | Set Default Proof Using "Type". 8 | 9 | Set Implicit Arguments. 10 | Unset Printing Implicit Defensive. 11 | Unset Strict Implicit. 12 | 13 | Section FA. 14 | Variable char : finType. 15 | #[local] Notation word := (word char). 16 | 17 | (** * Deterministic Finite Automata *) 18 | 19 | Record dfa : Type := { 20 | dfa_state :> finType; 21 | dfa_s : dfa_state; 22 | dfa_fin : {set dfa_state}; 23 | dfa_trans : dfa_state -> char -> dfa_state }. 24 | 25 | (* Arguments dfa_fin d _ : clear implicits. *) 26 | 27 | (** We define acceptance for every state of a DFA. The language of a 28 | DFA is then just the language of the starting state. *) 29 | 30 | Section DFA_Acceptance. 31 | Variable A : dfa. 32 | Implicit Types (p q : A) (x y : word). 33 | 34 | Fixpoint delta (p : A) x := 35 | if x is a :: x' then delta (dfa_trans p a) x' else p. 36 | 37 | Lemma delta_cons p a x : delta (dfa_trans p a) x = delta p (a :: x). 38 | Proof. by []. Qed. 39 | 40 | Lemma delta_cat p x y : delta p (x ++ y) = delta (delta p x) y. 41 | Proof. elim: x p => // a x /= IH p. by rewrite IH. Qed. 42 | 43 | Definition dfa_accept (p : A) x := delta p x \in dfa_fin A. 44 | 45 | Definition delta_s w := delta (dfa_s A) w. 46 | Definition dfa_lang := [pred x | dfa_accept (dfa_s A) x]. 47 | 48 | Lemma accept_nil p : dfa_accept p [::] = (p \in dfa_fin A). 49 | Proof. by []. Qed. 50 | 51 | Lemma accept_cons (x : A) a w : 52 | dfa_accept x (a :: w) = dfa_accept (dfa_trans x a) w. 53 | Proof. by []. Qed. 54 | 55 | Lemma delta_lang x : (delta_s x \in dfa_fin A) = (x \in dfa_lang). 56 | Proof. by []. Qed. 57 | 58 | Definition accE := (accept_nil,accept_cons). 59 | 60 | End DFA_Acceptance. 61 | 62 | (** ** Regularity 63 | 64 | We formalize the notion of regularity as the type of DFAs accpepting 65 | the language under consideration. This allows closure properties to be 66 | used for the construction of translation functions. Where required, 67 | the propositional variant of regularity is obtained as [inhabited (regular L)]. *) 68 | 69 | Definition regular (L : lang char) := { A : dfa | forall x, L x <-> x \in dfa_lang A }. 70 | 71 | Lemma regular_ext L1 L2 : regular L2 -> L1 =p L2 -> regular L1. 72 | Proof. case => A HA B. exists A => w. by rewrite B. Qed. 73 | 74 | (** ** Operations on DFAs 75 | 76 | To prepare the translation from regular expresstions to DFAs, we show 77 | that finite automata are closed under all regular operations. We build 78 | the primitive automata, complement and boolean combinations using 79 | DFAs. *) 80 | 81 | Definition dfa_void := 82 | {| dfa_s := tt; dfa_fin := set0 ; dfa_trans x a := tt |}. 83 | 84 | Lemma dfa_void_correct (x: dfa_void) w: ~~ dfa_accept x w. 85 | Proof. by rewrite /dfa_accept inE. Qed. 86 | 87 | Section DFAOps. 88 | 89 | Variable op : bool -> bool -> bool. 90 | Variable A1 A2 : dfa. 91 | 92 | (** Complement automaton **) 93 | Definition dfa_compl := 94 | {| dfa_s := dfa_s A1; 95 | dfa_fin := ~: (dfa_fin A1); 96 | dfa_trans := (@dfa_trans A1) |}. 97 | 98 | Lemma dfa_compl_correct w : 99 | w \in dfa_lang dfa_compl = (w \notin dfa_lang A1). 100 | Proof. 101 | rewrite /dfa_lang !inE {2}/dfa_compl /=. 102 | by rewrite /dfa_accept inE. 103 | Qed. 104 | 105 | (** BinOp Automaton *) 106 | 107 | Definition dfa_op := 108 | {| dfa_s := (dfa_s A1, dfa_s A2); 109 | dfa_fin := [set q | op (q.1 \in dfa_fin A1) (q.2 \in dfa_fin A2)]; 110 | dfa_trans x a := (dfa_trans x.1 a, dfa_trans x.2 a) |}. 111 | 112 | Lemma dfa_op_correct w : 113 | w \in dfa_lang dfa_op = op (w \in dfa_lang A1) (w \in dfa_lang A2). 114 | Proof. 115 | rewrite !inE {2}/dfa_op /=. 116 | elim: w (dfa_s A1) (dfa_s A2) => [| a w IHw] x y; by rewrite !accE ?inE /=. 117 | Qed. 118 | 119 | Definition dfa0 := {| dfa_s := tt; dfa_trans q a := tt; dfa_fin := set0 |}. 120 | 121 | Lemma dfa0_correct x : x \in dfa_lang dfa0 = false. 122 | Proof. by rewrite -delta_lang inE. Qed. 123 | 124 | End DFAOps. 125 | 126 | Lemma regular_inter (L1 L2 : lang char) : 127 | regular L1 -> regular L2 -> regular (fun x => L1 x /\ L2 x). 128 | Proof. 129 | move => [A LA] [B LB]. exists (dfa_op andb A B) => x. 130 | by rewrite dfa_op_correct LA LB (rwP andP). 131 | Qed. 132 | 133 | Lemma regular0 : regular (fun _ : word => False). 134 | Proof. exists (dfa0) => x. by rewrite dfa0_correct. Qed. 135 | 136 | Lemma regularU (L1 L2 : lang char) : 137 | regular L1 -> regular L2 -> regular (fun x => L1 x \/ L2 x). 138 | Proof. 139 | move => [A1 acc_L1] [A2 acc_L2]. exists (dfa_op orb A1 A2) => x. 140 | by rewrite dfa_op_correct -(rwP orP) -acc_L1 -acc_L2. 141 | Qed. 142 | 143 | Lemma regular_bigU (T : eqType) (L : T -> lang char) (s : seq T) : 144 | (forall a, a \in s -> regular (L a)) -> regular (fun x => exists2 a, a \in s & L a x). 145 | Proof. 146 | elim: s => //. 147 | - move => _. apply: regular_ext regular0 _. by split => // [[a]]. 148 | - move => a s IH /forall_consT [H1 H2]. 149 | pose L' := (fun x => L a x \/ (fun x : word => exists2 a : T, a \in s & L a x) x). 150 | apply: (regular_ext (L2 := L')); first by apply: regularU => //; exact: IH. 151 | move => x. rewrite /L'. exact: exists_cons. 152 | Qed. 153 | 154 | 155 | 156 | (** ** Cut-Off Criterion *) 157 | 158 | Section CutOff. 159 | Variables (aT rT : finType) (f : seq aT -> rT). 160 | Hypothesis RC_f : forall x y a, f x = f y -> f (x++[::a]) = f (y++[::a]). 161 | #[local] Set Default Proof Using "RC_f". 162 | 163 | Lemma RC_seq x y z : f x = f y -> f (x++z) = f (y++z). 164 | Proof. 165 | elim: z x y => [|a z IHz] x y; first by rewrite !cats0. 166 | rewrite -(cat1s a) (catA x [::a]) (catA y [::a]). move/(RC_f a). exact: IHz. 167 | Qed. 168 | 169 | Lemma RC_rep x (i j : 'I_(size x)) : 170 | i < j -> f (take i x) = f (take j x) -> f (take i x ++ drop j x) = f x. 171 | Proof. move => Hij Hfij. rewrite -{5}(cat_take_drop j x). exact: RC_seq. Qed. 172 | 173 | 174 | Definition exseqb (p : pred rT) := 175 | [exists n : 'I_#|rT|.+1, exists x : n.-tuple aT, p (f x)]. 176 | 177 | Lemma exseqP (p : pred rT) : reflect (exists x, p (f x)) (exseqb p). 178 | Proof. 179 | apply: (iffP idP); last case. 180 | - case/existsP => n. case/existsP => x Hx. by exists x. 181 | - apply: (size_induction (measure := size)) => x IHx px. 182 | case H: (size x < #|rT|.+1). 183 | + apply/existsP. exists (Ordinal H). apply/existsP. by exists (in_tuple x). 184 | + have: ~ injective (fun i : 'I_(size x) => f (take i x)). 185 | { move/leq_card. by rewrite -ltnS /= card_ord H. } 186 | move/injectiveP/injectivePn => [i [j]] Hij. 187 | wlog ltn_ij : i j {Hij} / i < j => [W|] E. 188 | { move: Hij. rewrite neq_ltn. case/orP => l; exact: W l _. } 189 | apply: (IHx (take i x ++ drop j x)); last by rewrite RC_rep. 190 | by rewrite size_cat size_take size_drop ltn_ord -ltn_subRL ltn_sub2l. 191 | Qed. 192 | 193 | Lemma exseq_dec (p : pred rT) : decidable (exists x, p (f x)). 194 | Proof. apply: decP. exact: exseqP. Qed. 195 | 196 | Lemma allseq_dec (p : pred rT) : decidable (forall x, p (f x)). 197 | Proof. 198 | case: (exseq_dec (predC p)) => H;[right|left]. 199 | - move => A. case: H => [x /= Hx]. by rewrite A in Hx. 200 | - move => x. apply/negPn/negP => C. apply: H. by exists x. 201 | Qed. 202 | 203 | (** Construction of Image *) 204 | 205 | Definition image_type := { a : rT | exseq_dec (pred1 a) }. 206 | 207 | Lemma image_fun_proof (x : seq aT) : exseq_dec (pred1 (f x)). 208 | Proof. apply/dec_eq. by exists x => /=. Qed. 209 | 210 | Definition image_fun (x : seq aT) : image_type := Sub (f x) (image_fun_proof x). 211 | 212 | Lemma surjective_image_fun : surjective (image_fun). 213 | Proof. move => [y Py]. case/dec_eq : (Py) => /= x ?. by exists x. Qed. 214 | 215 | End CutOff. 216 | 217 | (** ** Decidability of Language Equivalence 218 | 219 | Language emptiness and inhabitation of DFAs is deciadable since the [delta] 220 | function is right congruent *) 221 | 222 | Section Emptyness. 223 | Variable A : dfa. 224 | 225 | Lemma delta_rc x y a : let s := dfa_s A in 226 | delta s x = delta s y -> delta s (x ++ [::a]) = delta s (y ++ [::a]). 227 | Proof. by rewrite /= !delta_cat => <-. Qed. 228 | 229 | Definition dfa_inhab : decidable (exists x, x \in dfa_lang A) := 230 | exseq_dec delta_rc (fun x => x \in dfa_fin A). 231 | 232 | Lemma dfa_inhabP : reflect (exists x, x \in dfa_lang A) (dfa_inhab). 233 | Proof. apply: (iffP idP); by rewrite dec_eq. Qed. 234 | 235 | Definition dfa_empty := allseq_dec delta_rc (fun x => x \notin dfa_fin A). 236 | 237 | Lemma dfa_emptyP : reflect (dfa_lang A =i pred0) (dfa_empty). 238 | Proof. 239 | apply: (iffP idP) => [/dec_eq H x|H]; first by rewrite inE /dfa_accept (negbTE (H _)). 240 | apply/dec_eq => x. by rewrite -[_ \notin _]/(x \notin dfa_lang A) H. 241 | Qed. 242 | End Emptyness. 243 | 244 | (** The problem of deciding language eqivalence reduces to the problem 245 | of deciding emptiness of [A [+] B] *) 246 | 247 | Definition dfa_equiv A1 A2 := dfa_empty (dfa_op addb A1 A2). 248 | 249 | Lemma dfa_equiv_correct A1 A2 : 250 | reflect (dfa_lang A1 =i dfa_lang A2) (dfa_equiv A1 A2). 251 | Proof. 252 | apply: (iffP (dfa_emptyP _)) => H w. 253 | - move/negbT: (H w). rewrite !dfa_op_correct -addNb. 254 | move/addbP. by rewrite negbK. 255 | - apply/negbTE. by rewrite !dfa_op_correct H addbb. 256 | Qed. 257 | 258 | Definition dfa_incl A1 A2 := dfa_empty (dfa_op (fun a b => a && ~~ b) A1 A2). 259 | 260 | Lemma dfa_incl_correct A1 A2 : 261 | reflect {subset dfa_lang A1 <= dfa_lang A2} (dfa_incl A1 A2). 262 | Proof. 263 | apply: (iffP (dfa_emptyP _)) => H w. 264 | - move/negbT: (H w). rewrite dfa_op_correct -negb_imply negbK. 265 | by move/implyP. 266 | - rewrite dfa_op_correct -negb_imply. apply/negbTE. rewrite negbK. 267 | apply/implyP. exact: H. 268 | Qed. 269 | 270 | End FA. 271 | 272 | (** ** DFA for preimages of homomorphisms *) 273 | 274 | Section Preimage. 275 | Variables (char char' : finType). 276 | 277 | Variable (h : word char -> word char'). 278 | Hypothesis h_hom : homomorphism h. 279 | 280 | Definition dfa_preim (A : dfa char') : dfa char := 281 | {| dfa_s := dfa_s A; 282 | dfa_fin := dfa_fin A; 283 | dfa_trans x a := delta x (h [:: a]) |}. 284 | 285 | Lemma dfa_preimP A : dfa_lang (dfa_preim A) =i preim h (dfa_lang A). 286 | Proof using h_hom. 287 | move => w. rewrite !inE /dfa_accept /dfa_preim /=. 288 | elim: w (dfa_s A) => [|a w IHw] x /= ; first by rewrite h0. 289 | by rewrite -[a :: w]cat1s h_hom !delta_cat -IHw. 290 | Qed. 291 | 292 | End Preimage. 293 | 294 | Lemma preim_regular (char char' : finType) (h : word char -> word char') L : 295 | homomorphism h -> regular L -> regular (preimage h L). 296 | Proof. 297 | move => hom_h [A HA]. exists (dfa_preim h A) => w. 298 | by rewrite dfa_preimP // unfold_in /= -HA. 299 | Qed. 300 | 301 | (** ** Closure under Right Quotients *) 302 | 303 | Section RightQuotient. 304 | Variables (char: finType) (L1 L2 : lang char). 305 | 306 | Definition quotR := fun x => exists2 y, L2 y & L1 (x++y). 307 | 308 | Variable (A : dfa char). 309 | Hypothesis acc_L1 : dfa_lang A =p L1. 310 | Hypothesis dec_L2 : forall (q:A), decidable (exists2 y, L2 y & dfa_accept q y). 311 | 312 | (** It would be better to not make the DFA explicit and require 313 | decidabiliy of [(exists2 y, L2 y & L1 (x ++ y))] but that would 314 | require a connected DFA in order to define the final states via 315 | canonical words *) 316 | 317 | Definition dfa_quot := 318 | {| dfa_s := dfa_s A; 319 | dfa_trans := @dfa_trans _ A; 320 | dfa_fin := [set q | dec_L2 q] |}. 321 | 322 | Lemma dfa_quotP x : reflect (quotR x) (x \in dfa_lang dfa_quot). 323 | Proof using acc_L1. 324 | apply: (iffP idP). 325 | - rewrite inE /dfa_accept inE. case/dec_eq => y inL2. 326 | rewrite /dfa_accept -delta_cat => H. exists y => //. by rewrite -acc_L1. 327 | - case => y y1 y2. rewrite inE /dfa_accept inE /= dec_eq. 328 | exists y => //. by rewrite /dfa_accept -delta_cat acc_L1. 329 | Qed. 330 | 331 | End RightQuotient. 332 | 333 | (** Useful special case of the right-quotient construction. Other 334 | special cases would be where [L2] is context free, the case for 335 | arbitrary [L2] is non-constructive. *) 336 | 337 | Lemma regular_quotR (char : finType) (L1 L2 : lang char) : 338 | regular L1 -> regular L2 -> regular (quotR L1 L2). 339 | Proof. 340 | move => [A LA] reg2. 341 | suff dec_L1 q : decidable (exists2 y, L2 y & delta q y \in dfa_fin A). 342 | { exists (dfa_quot dec_L1) => x. apply: (rwP (dfa_quotP _ _ _)) => {} x. by rewrite LA. } 343 | case: reg2 => {LA} [B LB]. 344 | pose C := {| dfa_s := q ; dfa_fin := dfa_fin A ; dfa_trans := @dfa_trans _ A |}. 345 | pose dec := dfa_inhab (dfa_op andb B C). 346 | apply: (dec_iff dec); split. 347 | - move => [x X1 X2]. exists x. rewrite dfa_op_correct. apply/andP;split => //. exact/LB. 348 | - move => [x]. rewrite dfa_op_correct. case/andP => *. exists x => //. exact/LB. 349 | Qed. 350 | 351 | (** ** Closure under Left Quotients *) 352 | 353 | 354 | Section LeftQuotient. 355 | Variables (char: finType) (L1 L2 : lang char). 356 | 357 | Definition quotL := fun y => exists2 x, L1 x & L2 (x++y). 358 | 359 | Variable (A : dfa char). 360 | Hypothesis acc_L2 : L2 =p dfa_lang A. 361 | Hypothesis dec_L1 : forall (q:A), decidable (exists2 y, L1 y & delta_s A y = q). 362 | 363 | Let A_start q := {| dfa_s := q; dfa_fin := dfa_fin A; dfa_trans := @dfa_trans _ A |}. 364 | 365 | 366 | Lemma A_start_cat x y : (x ++ y \in dfa_lang A) = (y \in dfa_lang (A_start (delta_s A x))). 367 | Proof. rewrite inE /delta_s. elim: x (dfa_s A)=> //= a x IH q. by rewrite accE IH. Qed. 368 | 369 | Lemma regular_quotL_aux : regular quotL. 370 | Proof using acc_L2 dec_L1. 371 | pose S := [seq q | q <- enum A & dec_L1 q]. 372 | pose L (q:A) := mem (dfa_lang (A_start q)). 373 | pose R x := exists2 a, a \in S & L a x. 374 | suff: quotL =p R. 375 | { apply: regular_ext. apply: regular_bigU => q qS. by exists (A_start q). } 376 | move => y; split. 377 | - case => x H1 /acc_L2 H2. exists (delta_s A x). 378 | + apply/mapP. exists (delta_s A x) => //. rewrite mem_filter mem_enum inE andbT. 379 | apply/dec_eq. by exists x. 380 | + by rewrite /L topredE -A_start_cat. 381 | - case => ? /mapP [q]. rewrite mem_filter mem_enum inE andbT => /dec_eq [x L1_x <- ->]. 382 | rewrite /L topredE -A_start_cat => Hxy. exists x => //. exact/acc_L2. 383 | Qed. 384 | End LeftQuotient. 385 | 386 | Lemma regular_quotL (char: finType) (L1 L2 : lang char) : 387 | regular L1 -> regular L2 -> regular (quotL L1 L2). 388 | Proof. 389 | move => [A acc_L1] [B acc_L2]. apply: regular_quotL_aux acc_L2 _ => q. 390 | pose B_q := {| dfa_s := dfa_s B; dfa_fin := [set q] ; dfa_trans := @dfa_trans _ B |}. 391 | have B_qP y : delta_s B y = q <-> y \in dfa_lang B_q. 392 | { rewrite -delta_lang inE. by split => ?; exact/eqP. } 393 | pose dec := dfa_inhab (dfa_op andb A B_q). 394 | apply: dec_iff dec _. split. 395 | - move => [y] H1 Hq. exists y. rewrite dfa_op_correct. 396 | apply/andP;split; first exact/acc_L1. exact/B_qP. 397 | - move => [y]. rewrite dfa_op_correct => /andP [H1 H2]. exists y; first exact/acc_L1. 398 | exact/B_qP. 399 | Qed. 400 | 401 | (** regular languages are logically determined and since propositions 402 | can be embedded into languages, there are some languages that are regular 403 | iff we assume excluded middle. (take [P] to be any independent proposition) *) 404 | 405 | Lemma regular_det (char : finType) L (w : word char): 406 | inhabited (regular L) -> (L w) \/ (~ L w). 407 | Proof. case. case => A ->. by case: (w \in dfa_lang A); [left|right]. Qed. 408 | 409 | Lemma regular_xm (char : finType) : 410 | (forall P, inhabited (regular (fun _ : word char => P))) <-> (forall P, P \/ ~ P). 411 | Proof. 412 | split => [H|H] P ; first exact: regular_det [::] (H P). 413 | case: (H P) => HP; constructor. 414 | + exists (dfa_compl (dfa_void char)) => x. by rewrite dfa_compl_correct dfa_void_correct. 415 | + exists (dfa_void char) => w. by rewrite /dfa_lang inE (negbTE (dfa_void_correct _ _)). 416 | Qed. 417 | 418 | (** ** Residual Criterion *) 419 | 420 | Section NonRegular. 421 | Variables (char : finType) . 422 | 423 | Implicit Types (L : lang char). 424 | 425 | Definition residual_lang L x := fun y => L (x ++ y). 426 | 427 | Lemma residual_langP (f : nat -> word char) (L : lang char) : 428 | (forall n1 n2, residual_lang L (f n1) =p residual_lang L (f n2) -> n1 = n2) -> 429 | ~ inhabited (regular L). 430 | Proof. 431 | move => f_spec [[A E]]. 432 | pose g (n : 'I_#|A|.+1) := delta_s A (f n). 433 | suff: injective g by move/leq_card; rewrite card_ord ltnn. 434 | move => [n1 H1] [n2 H2]. rewrite /g /delta_s /= => H. 435 | apply/eqP; change (n1 == n2); apply/eqP. apply: f_spec => w. 436 | by rewrite /residual_lang !E !inE /dfa_accept !delta_cat H. 437 | Qed. 438 | 439 | Hypothesis (a b : char) (Hab : a != b). 440 | #[local] Set Default Proof Using "Hab". 441 | 442 | Definition Lab w := exists n, w = nseq n a ++ nseq n b. 443 | 444 | Lemma countL n1 n2 : count (pred1 a) (nseq n1 a ++ nseq n2 b) = n1. 445 | Proof. 446 | by rewrite count_cat !count_nseq /= eqxx eq_sym (negbTE Hab) mul1n mul0n addn0. 447 | Qed. 448 | 449 | Lemma countR n1 n2 : count (pred1 b) (nseq n1 a ++ nseq n2 b) = n2. 450 | Proof. by rewrite count_cat !count_nseq /= (negbTE Hab) eqxx //= mul1n mul0n. Qed. 451 | 452 | Lemma Lab_eq n1 n2 : Lab (nseq n1 a ++ nseq n2 b) -> n1 = n2. 453 | Proof. 454 | move => [n H]. 455 | by rewrite -[n1](countL _ n2) -{2}[n2](countR n1 n2) H countL countR. 456 | Qed. 457 | 458 | Lemma Lab_not_regular : ~ inhabited (regular Lab). 459 | Proof. 460 | pose f n := nseq n a. 461 | apply: (@residual_langP f) => n1 n2. move/(_ (nseq n2 b)) => H. 462 | apply: Lab_eq. apply/H. by exists n2. 463 | Qed. 464 | 465 | End NonRegular. 466 | 467 | (** ** Pumping Lemma *) 468 | 469 | Section Pumping. 470 | Definition sub (T:eqType) i j (s : seq T) := take (j-i) (drop i s). 471 | 472 | Definition rep (T : eqType) (s : seq T) n := iter n (cat s) [::]. 473 | 474 | Variable char : finType. 475 | 476 | Lemma delta_rep (A : dfa char) (p : A) x i : delta p x = p -> delta p (rep x i) = p. 477 | Proof. elim: i => //= i IH H. by rewrite delta_cat H IH. Qed. 478 | 479 | Lemma pump_dfa (A : dfa char) x y z : 480 | x ++ y ++ z \in dfa_lang A -> #|A| < size y -> 481 | exists u v w, 482 | [/\ ~~ nilp v, y = u ++ v ++ w & forall i, (x ++ u ++ rep v i ++ w ++ z) \in dfa_lang A]. 483 | Proof. 484 | rewrite -delta_lang => H1 H2. 485 | have/injectivePn : ~~ injectiveb (fun i : 'I_(size y) => delta (delta_s A x) (take i y)). 486 | apply: contraL H2 => /injectiveP/leq_card. by rewrite leqNgt card_ord. 487 | move => [i] [j] ij fij. 488 | wlog {ij} ij : i j fij / i < j. rewrite neq_ltn in ij. case/orP : ij => ij W; exact: W _ ij. 489 | exists (take i y), (sub i j y), (drop j y). split => [||k]. 490 | - apply: contraL ij. 491 | by rewrite /nilp size_take size_drop ltn_sub2r ?ltn_ord // subn_eq0 leqNgt. 492 | - by rewrite catA -takeD subnKC 1?ltnW // cat_take_drop. 493 | - rewrite inE /dfa_accept !delta_cat delta_rep. 494 | by rewrite fij -!delta_cat !catA -[(x ++ _) ++ _]catA cat_take_drop -!catA. 495 | rewrite -delta_cat -takeD subnKC //. exact: ltnW. 496 | Qed. 497 | 498 | Lemma pumping (L : word char -> Prop) : 499 | (forall k, exists x y z, k <= size y /\ L (x ++ y ++ z) /\ 500 | (forall u v w, y = u ++ v ++ w -> ~~ nilp v -> 501 | exists i, L (x ++ u ++ rep v i ++ w ++ z) -> False)) 502 | -> ~ inhabited (regular L). 503 | Proof. 504 | move => H [[A LA]]. 505 | move/(_ #|A|.+1) : H => [x] [y] [z] [size_y [/LA Lxyz]]. 506 | move: (pump_dfa Lxyz size_y) => [u] [v] [w] [Hn Hy Hv] /(_ u v w Hy Hn). 507 | move => [i]. apply. exact/LA. 508 | Qed. 509 | 510 | Lemma cat_nseq_eq n1 n2 (a : char) : 511 | nseq n1 a ++ nseq n2 a = nseq (n1+n2) a. 512 | Proof. elim: n1 => [|n1 IHn1] //=. by rewrite -cat1s IHn1. Qed. 513 | 514 | Example pump_Lab (a b : char) : a != b -> ~ inhabited (regular (Lab a b)). 515 | Proof. 516 | move => neq. apply: pumping => k. 517 | exists [::], (nseq k a), (nseq k b). repeat split. 518 | - by rewrite size_nseq. 519 | - by exists k. 520 | - move => u [|c v] w // /eqP e _. exists 0 => /= H. 521 | have Hk: k = size (u ++ (c::v) ++ w) by rewrite -[k](@size_nseq _ _ a) (eqP e). 522 | rewrite Hk !size_cat -!cat_nseq_eq !eqseq_cat ?size_nseq // in e. 523 | case/and3P : e => [/eqP Hu /eqP Hv /eqP Hw]. 524 | rewrite -Hu -Hw catA cat_nseq_eq in H. move/(Lab_eq neq) : H. 525 | move/eqP. by rewrite Hk !size_cat eqn_add2l -{1}[size w]add0n eqn_add2r. 526 | Qed. 527 | 528 | End Pumping. 529 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name RegLang) 3 | (package coq-reglang) 4 | (synopsis "Representations of regular languages (i.e., regexps, various types of automata, and WS1S) with equivalence proofs, in Coq and MathComp") 5 | (flags :standard -w -notation-overridden -w -redundant-canonical-projection)) 6 | -------------------------------------------------------------------------------- /theories/languages.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From HB Require Import structures. 4 | From mathcomp Require Import all_ssreflect. 5 | From RegLang Require Import misc. 6 | 7 | Set Default Proof Using "Type". 8 | 9 | Set Implicit Arguments. 10 | Unset Strict Implicit. 11 | Unset Printing Implicit Defensive. 12 | 13 | (** * Languages in Type Theory 14 | 15 | This file mainly defines aliases for (decidable) languages. It also 16 | shows that decidable languages are closed under the primitive regular 17 | operations (e.g., concatenation and iteration). This will allow us to 18 | assign decidable languages to regular expressions. We allow for 19 | infinite (but discrete) alphabets. *) 20 | 21 | (** The definitions of [conc] and [star] as well as the proofs of 22 | [starP] and [concP] are taken from regexp.v in: 23 | 24 | Thierry Coquand, Vincent Siles, A Decision Procedure for Regular 25 | Expression Equivalence in Type Theory (DOI: 26 | 10.1007/978-3-642-25379-9_11). See also: 27 | https://github.com/coq-community/regexp-Brzozowski *) 28 | 29 | Section Basics. 30 | Variables char : eqType. 31 | Definition word := seq char. 32 | Definition lang := word -> Prop. 33 | Definition dlang := pred word. 34 | 35 | HB.instance Definition _ := Equality.on word. 36 | Identity Coercion pred_of_dlang : dlang >-> pred. 37 | End Basics. 38 | 39 | Section HomDef. 40 | Variables (char char' : finType) (h : seq char -> seq char'). 41 | 42 | Definition image (L : word char -> Prop) v := exists w, L w /\ h w = v. 43 | 44 | Lemma image_ext L1 L2 w : 45 | (forall v, L1 v <-> L2 v) -> (image L1 w <-> image L2 w). 46 | Proof. by move => H; split; move => [v] [] /H; exists v. Qed. 47 | 48 | Definition preimage (L : word char' -> Prop) v := L (h v). 49 | 50 | Definition homomorphism := forall w1 w2, h (w1 ++ w2) = h w1 ++ h w2. 51 | Hypothesis h_hom : homomorphism. 52 | #[local] Set Default Proof Using "h_hom". 53 | 54 | Lemma h0 : h [::] = [::]. 55 | Proof. 56 | apply: size0nil. apply/eqP. 57 | by rewrite -(eqn_add2r (size (h [::]))) -size_cat -h_hom /=. 58 | Qed. 59 | 60 | Lemma h_seq w : h w = flatten [seq h [:: a] | a <- w]. 61 | Proof. elim: w => [|a w IHw] /= ; by rewrite ?h0 // -cat1s h_hom IHw. Qed. 62 | 63 | Lemma h_flatten vv : h (flatten vv) = flatten (map h vv). 64 | Proof. 65 | elim: vv => //= [|v vv IHvv]; first exact: h0. 66 | by rewrite h_hom IHvv. 67 | Qed. 68 | 69 | End HomDef. 70 | 71 | (** ** Closure Properties for Decidable Languages *) 72 | 73 | Section DecidableLanguages. 74 | 75 | Variable char : eqType. 76 | Implicit Types (x y z : char) (u v w : word char) (l : dlang char). 77 | 78 | Definition void : dlang char := pred0. 79 | 80 | Definition eps : dlang char := pred1 [::]. 81 | 82 | Definition dot : dlang char := [pred w | size w == 1]. 83 | 84 | Definition atom x : dlang char := pred1 [:: x]. 85 | 86 | Definition compl l : dlang char := predC l. 87 | 88 | Definition prod l1 l2 : dlang char := [pred w in l1 | w \in l2]. 89 | 90 | Definition plus l1 l2 : dlang char := [pred w | (w \in l1) || (w \in l2)]. 91 | 92 | Definition residual x l : dlang char := [pred w | x :: w \in l]. 93 | 94 | (** For the concatenation of two decidable languages, we use finite 95 | types. Note that we need to use [l1] and [l2] applicatively in order 96 | for the termination check for [star] to succeed. *) 97 | 98 | Definition conc l1 l2 : dlang char := 99 | fun v => [exists i : 'I_(size v).+1, l1 (take i v) && l2 (drop i v)]. 100 | 101 | (** The iteration (Kleene star) operator is defined using residual 102 | languages. Termination of star relies on the fact that conc applies 103 | its second argument only to [drop i v] which is "structurally less 104 | than or equal" to [v] *) 105 | 106 | Definition star l : dlang char := 107 | fix star v := if v is x :: v' then conc (residual x l) star v' else true. 108 | 109 | Lemma in_dot u : (u \in dot) = (size u == 1). 110 | Proof. by []. Qed. 111 | 112 | Lemma in_compl l v : (v \in compl l) = (v \notin l). 113 | Proof. by []. Qed. 114 | 115 | Lemma compl_invol l : compl (compl l) =i l. 116 | Proof. by move => w; rewrite inE /= /compl /= negbK. Qed. 117 | 118 | Lemma in_prod l1 l2 v : (v \in prod l1 l2) = (v \in l1) && (v \in l2). 119 | Proof. by rewrite inE. Qed. 120 | 121 | Lemma plusP r s w : 122 | reflect (w \in r \/ w \in s) (w \in plus r s). 123 | Proof. rewrite !inE. exact: orP. Qed. 124 | 125 | Lemma in_residual x l u : (u \in residual x l) = (x :: u \in l). 126 | Proof. by []. Qed. 127 | 128 | Lemma concP {l1 l2 w} : 129 | reflect (exists w1 w2, w = w1 ++ w2 /\ w1 \in l1 /\ w2 \in l2) (w \in conc l1 l2). 130 | Proof. apply: (iffP existsP) => [[n] /andP [H1 H2] | [w1] [w2] [e [H1 H2]]]. 131 | - exists (take n w), (drop n w). by rewrite cat_take_drop. 132 | - have lt_w1: size w1 < (size w).+1 by rewrite e size_cat ltnS leq_addr. 133 | exists (Ordinal lt_w1); subst. 134 | rewrite take_size_cat // drop_size_cat //. exact/andP. 135 | Qed. 136 | 137 | Lemma conc_cat w1 w2 l1 l2 : w1 \in l1 -> w2 \in l2 -> w1 ++ w2 \in conc l1 l2. 138 | Proof. move => H1 H2. apply/concP. exists w1. by exists w2. Qed. 139 | 140 | Lemma conc_eq l1 l2 l3 l4 : 141 | l1 =i l2 -> l3 =i l4 -> conc l1 l3 =i conc l2 l4. 142 | Proof. 143 | move => H1 H2 w. apply: eq_existsb => n. 144 | by rewrite (_ : l1 =1 l2) // (_ : l3 =1 l4). 145 | Qed. 146 | 147 | Lemma starP : forall {l v}, 148 | reflect (exists2 vv, all [predD l & eps] vv & v = flatten vv) (v \in star l). 149 | Proof. 150 | move=> l v; 151 | elim: {v}_.+1 {-2}v (ltnSn (size v)) => // n IHn [|x v] /= le_v_n. 152 | by left; exists [::]. 153 | apply: (iffP concP) => [[u] [v'] [def_v [Lxu starLv']] | [[|[|y u] vv] //=]]. 154 | case/IHn: starLv' => [|vv lvv def_v']. 155 | by rewrite -ltnS (leq_trans _ le_v_n) // def_v size_cat !ltnS leq_addl. 156 | by exists ((x :: u) :: vv); [exact/andP | rewrite def_v def_v']. 157 | case/andP=> lyu lvv [def_x def_v]; exists u, (flatten vv). 158 | subst; do 2![split=>//]. apply/IHn; last by exists vv. 159 | by rewrite -ltnS (leq_trans _ le_v_n) // size_cat !ltnS leq_addl. 160 | Qed. 161 | 162 | Lemma star_cat w1 w2 l : w1 \in l -> w2 \in (star l) -> w1 ++ w2 \in star l. 163 | Proof. 164 | case: w1 => [|a w1] // H1 /starP [vv Ha Hf]. apply/starP. 165 | by exists ((a::w1) :: vv); rewrite ?Hf //= H1. 166 | Qed. 167 | 168 | Lemma starI l vv : 169 | (forall v, v \in vv -> v \in l) -> flatten vv \in star l. 170 | Proof. 171 | elim: vv => /= [//| v vv IHvv /forall_cons [H1 H2]]. 172 | exact: star_cat _ (IHvv _). 173 | Qed. 174 | 175 | Lemma star_eq l1 l2 : l1 =i l2 -> star l1 =i star l2. 176 | Proof. 177 | move => H1 w. apply/starP/starP; move => [] vv H3 H4; exists vv => //; 178 | erewrite eq_all; try eexact H3; move => x /=; by rewrite ?H1 // -?H1. 179 | Qed. 180 | 181 | Lemma star_id l : star (star l) =i star l. 182 | Proof. 183 | move => u. apply/starP/starP => [[vs h1 h2]|]. 184 | elim: vs u h1 h2 => [|hd tl Ih] u h1 h2; first by exists [::]. 185 | move: h1 => /= h1. case/andP: h1; case/andP => hhd1 hhd2 htl. 186 | case: (Ih (flatten tl)) => //= [xs x1 x2]. 187 | case/starP: hhd2 => hds j1 j2. 188 | exists (hds ++ xs); first by rewrite all_cat; apply/andP. 189 | by rewrite h2 j2 /= x2 flatten_cat. 190 | move => [hs h1 h2]. exists hs => //. apply/allP => x x1. 191 | move/allP: h1 => h1. case/andP: (h1 x x1) => /= h3 h4. 192 | rewrite h3 /=. apply/starP. exists [:: x] => /=; first by rewrite h3 h4. 193 | by rewrite cats0. 194 | Qed. 195 | 196 | End DecidableLanguages. 197 | -------------------------------------------------------------------------------- /theories/minimization.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From HB Require Import structures. 4 | From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. 5 | From mathcomp Require Import fintype path fingraph finfun finset generic_quotient. 6 | From RegLang Require Import misc languages dfa. 7 | 8 | Set Default Proof Using "Type". 9 | 10 | Set Implicit Arguments. 11 | Unset Printing Implicit Defensive. 12 | Unset Strict Implicit. 13 | 14 | #[local] Open Scope quotient_scope. 15 | 16 | (** * DFA Minimization *) 17 | 18 | Section Minimization. 19 | Variable (char : finType). 20 | #[local] Notation word := (word char). 21 | #[local] Notation dfa := (dfa char). 22 | 23 | Definition coll (A : dfa) x y := forall w, (delta x w \in dfa_fin A) = (delta y w \in dfa_fin A). 24 | 25 | Definition connected (A : dfa) := surjective (delta_s A). 26 | Definition collapsed (A : dfa) := forall x y: A, coll x y <-> x = y. 27 | Definition minimal (A : dfa) := forall B, dfa_lang A =i dfa_lang B -> #|A| <= #|B|. 28 | 29 | (** ** Uniqueness of connected and collapsed automata *) 30 | 31 | Definition dfa_iso (A1 A2 : dfa) := 32 | exists i: A1 -> A2, 33 | [/\ bijective i, 34 | forall x a, i (dfa_trans x a) = dfa_trans (i x) a, 35 | forall x, i (x) \in dfa_fin A2 = (x \in dfa_fin A1) & 36 | i (dfa_s A1) = dfa_s A2 ]. 37 | 38 | Section Isomopism. 39 | Variables (A B : dfa). 40 | Hypothesis L_AB : dfa_lang A =i dfa_lang B. 41 | 42 | Hypothesis (A_coll: collapsed A) (B_coll: collapsed B). 43 | Hypothesis (A_conn : connected A) (B_conn : connected B). 44 | 45 | Definition iso := delta_s B \o cr A_conn. 46 | Definition iso_inv := delta_s A \o cr B_conn. 47 | 48 | Lemma delta_iso w x : delta (iso x) w \in dfa_fin B = (delta x w \in dfa_fin A). 49 | Proof using L_AB. by rewrite -{2}[x](crK (Sf := A_conn)) -!delta_cat !delta_lang L_AB. Qed. 50 | 51 | Lemma delta_iso_inv w x : delta (iso_inv x) w \in dfa_fin A = (delta x w \in dfa_fin B). 52 | Proof using L_AB. by rewrite -{2}[x](crK (Sf := B_conn)) -!delta_cat !delta_lang L_AB. Qed. 53 | 54 | Lemma can_iso : cancel iso_inv iso. 55 | Proof using B_coll L_AB. move => x. apply/B_coll => w. by rewrite delta_iso delta_iso_inv. Qed. 56 | 57 | Lemma can_iso_inv : cancel iso iso_inv. 58 | Proof using A_coll L_AB. move => x. apply/A_coll => w. by rewrite delta_iso_inv delta_iso. Qed. 59 | 60 | Lemma coll_iso : dfa_iso A B. 61 | Proof using A_coll B_coll A_conn B_conn L_AB. 62 | exists iso. split. 63 | - exact: Bijective can_iso_inv can_iso. 64 | - move => x a. apply/B_coll => w. rewrite -[_ (iso x) a]/(delta (iso x) [::a]). 65 | by rewrite -delta_cat -!delta_iso_inv !can_iso_inv. 66 | - move => x. by rewrite -[iso x]/(delta _ [::]) delta_iso. 67 | - apply/B_coll => w. by rewrite delta_iso !delta_lang. 68 | Qed. 69 | 70 | Lemma dfa_iso_size : dfa_iso A B -> #|A| = #|B|. 71 | Proof. move => [iso [H _ _ _]]. exact (bij_eq_card H). Qed. 72 | End Isomopism. 73 | 74 | Lemma abstract_minimization A f : 75 | (forall B, dfa_lang (f B) =i dfa_lang B /\ #|f B| <= #|B| /\ connected (f B) /\ collapsed (f B)) 76 | -> minimal (f A). 77 | Proof. 78 | move => H B L_AB. apply: (@leq_trans #|f B|); last by firstorder. apply: eq_leq. 79 | apply: dfa_iso_size. (apply: coll_iso; try apply H) => w. rewrite L_AB. by case (H B) => ->. 80 | Qed. 81 | 82 | (** ** Construction of the Connected Sub-Automaton *) 83 | 84 | Section Prune. 85 | Variable A : dfa. 86 | 87 | Definition reachable (q:A) := exseq_dec (@delta_rc _ A) (pred1 q). 88 | Definition connectedb := [forall x: A, reachable x]. 89 | 90 | Lemma connectedP : reflect (connected A) (connectedb). 91 | Proof. 92 | apply: (iffP forallP) => H y; first by move/dec_eq: (H y). 93 | apply/dec_eq. case (H y) => x Hx. by exists x. 94 | Qed. 95 | 96 | Definition reachable_type := { x:A | reachable x }. 97 | 98 | Lemma reachable_trans_proof (x : reachable_type) a : reachable (dfa_trans (val x) a). 99 | Proof. 100 | apply/dec_eq. case/dec_eq : (svalP x) => /= y /eqP <-. 101 | exists (y++[::a]). by rewrite delta_cat. 102 | Qed. 103 | 104 | Definition reachable_trans (x : reachable_type) a : reachable_type := 105 | Sub (dfa_trans (val x) a) (reachable_trans_proof x a). 106 | 107 | Lemma reachabe_s_proof : reachable (dfa_s A). 108 | Proof. apply/dec_eq. exists nil. exact: eqxx. Qed. 109 | 110 | Definition reachable_s : reachable_type := Sub (dfa_s A) reachabe_s_proof. 111 | 112 | Definition dfa_prune := {| 113 | dfa_s := reachable_s; 114 | dfa_fin := [set x | val x \in dfa_fin A]; 115 | dfa_trans := reachable_trans |}. 116 | 117 | Lemma dfa_prune_correct : dfa_lang dfa_prune =i dfa_lang A. 118 | Proof. 119 | rewrite /dfa_lang /= -[dfa_s A]/(val reachable_s) => w. 120 | rewrite !inE. elim: w (reachable_s) => [|a w IHw] [x Hx] //=. 121 | + by rewrite /dfa_accept inE. 122 | + by rewrite accE IHw. 123 | Qed. 124 | 125 | Lemma dfa_prune_connected : connected dfa_prune. 126 | Proof. 127 | move => q. case/dec_eq: (svalP q) => /= x Hx. exists x. 128 | elim/last_ind : x q Hx => //= x a IHx q. 129 | rewrite -!cats1 /delta_s !delta_cat -!/(delta_s _ x) => H. 130 | have X : reachable (delta_s A x). apply/dec_eq; exists x. exact: eqxx. 131 | by rewrite (eqP (IHx (Sub (delta_s A x) X) _)). 132 | Qed. 133 | 134 | #[local] Hint Resolve dfa_prune_connected : core. 135 | 136 | Lemma dfa_prune_size : #|dfa_prune| <= #|A|. 137 | Proof. by rewrite card_sig subset_leq_card // subset_predT. Qed. 138 | 139 | (** If pruning does not remove any states, the automaton is connected *) 140 | 141 | Lemma prune_eq_connected : #|A| = #|dfa_prune| -> connected A. 142 | Proof. 143 | move => H. apply/connectedP. apply/forallP => x. 144 | by move: (cardT_eq (Logic.eq_sym H)) ->. 145 | Qed. 146 | 147 | End Prune. 148 | 149 | (** ** Quotient modulo collapsing relation 150 | 151 | For the minimization of connected automata we construct the quotient of the 152 | input automaton with respect to the collapsing relation. To form the quotient 153 | constructively, we have to show that the collapsing relation is decidable. *) 154 | 155 | Section Collapse. 156 | Variable A : dfa. 157 | 158 | (** Decidabilty of the collapsing relation *) 159 | 160 | Definition coll_fun (p q : A) x := (delta p x,delta q x). 161 | 162 | Lemma coll_fun_RC p q x y a : 163 | coll_fun p q x = coll_fun p q y -> coll_fun p q (x++[::a]) = coll_fun p q (y++[::a]). 164 | Proof. move => [H1 H2]. by rewrite /coll_fun !delta_cat H1 H2. Qed. 165 | 166 | Definition collb p q : bool := 167 | allseq_dec (@coll_fun_RC p q) [pred p | (p.1 \in dfa_fin A) == (p.2 \in dfa_fin A)]. 168 | 169 | Lemma collP p q : reflect (coll p q) (collb p q). 170 | Proof. 171 | apply: (iffP idP). 172 | - move/dec_eq => H x. by move/eqP: (H x). 173 | - move => H. apply/dec_eq => x. apply/eqP. exact: H. 174 | Qed. 175 | 176 | Lemma collb_refl x : collb x x. 177 | Proof. apply/collP. rewrite /coll. auto. Qed. 178 | 179 | Lemma collb_sym : symmetric collb. 180 | Proof. move => x y. by apply/collP/collP; move => H w; rewrite H. Qed. 181 | 182 | Lemma collb_trans : transitive collb. 183 | Proof. move => x y z /collP H1 /collP H2. apply/collP => w. by rewrite H1 H2. Qed. 184 | 185 | Lemma collb_step a x y : collb x y -> collb (dfa_trans x a) (dfa_trans y a). 186 | Proof. move => /collP H. apply/collP => w. by rewrite !delta_cons H. Qed. 187 | 188 | (** We make collb the canonical equivalence relation on [A] and take 189 | the corresponding quotient type as state space for the minimized automaton *) 190 | 191 | Canonical collb_equiv := EquivRelPack (EquivClass collb_refl collb_sym collb_trans). 192 | 193 | Definition collapse_state := {eq_quot collb_equiv}. 194 | 195 | HB.instance Definition _ := Quotient.on collapse_state. 196 | HB.instance Definition _ := [Sub collapse_state of A by %/]. 197 | HB.instance Definition _ := [Finite of collapse_state by <:%/]. 198 | 199 | Definition collapse : dfa := {| 200 | dfa_s := \pi_(collapse_state) (dfa_s A); 201 | dfa_trans x a := \pi (dfa_trans (repr x) a); 202 | dfa_fin := [set x : collapse_state | repr x \in dfa_fin A ] |}. 203 | 204 | Lemma collapse_delta (x : A) w : 205 | delta (\pi x : collapse) w = \pi (delta x w). 206 | Proof. 207 | elim: w x => //= a w IHw x. rewrite -IHw. f_equal. 208 | apply/eqmodP. apply: collb_step. exact: epiK. 209 | Qed. 210 | 211 | Lemma collapse_fin (x : A) : 212 | (\pi x \in dfa_fin collapse) = (x \in dfa_fin A). 213 | Proof. 214 | rewrite /collapse /= inE. 215 | by move/collP: (epiK collb_equiv x) => /(_ [::]). 216 | Qed. 217 | 218 | End Collapse. 219 | 220 | (** ** Correctness of Minimization *) 221 | 222 | (** Minimization yields a fully collapsed DFA accepting the same language *) 223 | 224 | Lemma collapse_collapsed (A : dfa) : collapsed (collapse A). 225 | Proof. 226 | split => [H|->]; last by apply/collP; exact: collb_refl. 227 | rewrite -[x]reprK -[y]reprK. apply/eqmodP/collP => w. 228 | by rewrite -!collapse_fin -!collapse_delta !reprK. 229 | Qed. 230 | 231 | Lemma collapse_correct A : dfa_lang (collapse A) =i dfa_lang A. 232 | Proof. 233 | move => w. rewrite !inE /dfa_accept {1}/dfa_s /= inE collapse_delta. 234 | by rewrite -!collapse_fin reprK. 235 | Qed. 236 | 237 | Lemma collapse_size A : #|collapse A| <= #|A|. 238 | Proof. rewrite card_sub. exact: max_card. Qed. 239 | 240 | Lemma collapse_connected A : connected A -> connected (collapse A). 241 | Proof. 242 | move => H x. case: (H (repr x)) => w /eqP Hw. exists w. 243 | by rewrite /delta_s collapse_delta -/(delta_s A w) Hw reprK. 244 | Qed. 245 | 246 | (** Combine pruning and collapsing into minimization function *) 247 | 248 | Definition minimize := collapse \o dfa_prune. 249 | 250 | Lemma minimize_size (A : dfa) : #|minimize A| <= #|A|. 251 | Proof. exact: leq_trans (collapse_size _) (dfa_prune_size _). Qed. 252 | 253 | Lemma minimize_collapsed (A : dfa) : collapsed (minimize A). 254 | Proof. exact: collapse_collapsed. Qed. 255 | 256 | Lemma minimize_connected (A : dfa) : connected (minimize A). 257 | Proof. apply collapse_connected. exact: dfa_prune_connected. Qed. 258 | 259 | Lemma minimize_correct (A : dfa) : dfa_lang (minimize A) =i dfa_lang A. 260 | Proof. move => x. by rewrite collapse_correct dfa_prune_correct. Qed. 261 | 262 | #[local] Hint Resolve minimize_size minimize_collapsed minimize_connected : core. 263 | 264 | Lemma minimize_minimal A : minimal (minimize A). 265 | Proof. apply: abstract_minimization => B. auto using minimize_correct. (* and hints *) Qed. 266 | 267 | (** ** Uniqueness of minimal automaton *) 268 | 269 | Lemma minimal_connected A : minimal A -> connected A. 270 | Proof. 271 | move => MA. apply: prune_eq_connected. 272 | apply/eqP. rewrite eqn_leq dfa_prune_size andbT. 273 | apply: MA => x. by rewrite dfa_prune_correct. 274 | Qed. 275 | 276 | Lemma minimal_collapsed A : minimal A -> collapsed A. 277 | Proof. 278 | move => MA. 279 | have B : bijective (\pi_(collapse_state A)). 280 | apply: surj_card_bij. 281 | - move => x. exists (repr x). by rewrite reprK. 282 | - apply/eqP. rewrite eqn_leq collapse_size (MA (collapse A)) // => x. 283 | by rewrite collapse_correct. 284 | move => x y. split => [|->]; last exact/collP/collb_refl. 285 | move/collP/eqmodP. exact: bij_inj. 286 | Qed. 287 | 288 | (** In order to generalize the reasoning above to arbitrary quotients 289 | types over finite types we would first have to ensure that [{eq_quot e}] 290 | inherits the finType structure on the carrier of [e]. By default 291 | this is not the case *) 292 | 293 | Lemma minimalP A : minimal A <-> (connected A /\ collapsed A). 294 | Proof. 295 | split. 296 | - move => H. split. exact: minimal_connected. exact: minimal_collapsed. 297 | - move => [H1 H2] B L_AB. apply: leq_trans _ (minimize_size _). apply: eq_leq. 298 | apply: dfa_iso_size. apply: coll_iso => // x. by rewrite minimize_correct. 299 | Qed. 300 | 301 | Lemma minimal_iso A B : 302 | dfa_lang A =i dfa_lang B -> minimal A -> minimal B -> dfa_iso A B. 303 | Proof. move => L_AB /minimalP [? ?] /minimalP [? ?]. exact: coll_iso. Qed. 304 | 305 | End Minimization. 306 | -------------------------------------------------------------------------------- /theories/misc.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import all_ssreflect. 4 | 5 | Set Default Proof Using "Type". 6 | 7 | Set Implicit Arguments. 8 | Unset Strict Implicit. 9 | Unset Printing Implicit Defensive. 10 | 11 | (** * Preliminaries 12 | 13 | This file contains a number of auxiliary lemmas that do not mention 14 | any of the representations of regular languages and may thus also be 15 | useful in other contexts *) 16 | 17 | (** ** Generic Lemmas not in MathComp *) 18 | 19 | (** Logic *) 20 | 21 | Notation "P =p Q" := (forall x, P x <-> Q x) (at level 30). 22 | 23 | Lemma dec_iff P Q : decidable P -> Q <-> P -> decidable Q. 24 | Proof. firstorder. Qed. 25 | 26 | Lemma eqb_iff (b1 b2 : bool) : (b1 <-> b2) <-> (b1 = b2). 27 | Proof. split => [[A B]|->//]. exact/idP/idP. Qed. 28 | 29 | Lemma dec_eq (P : Prop) (decP : decidable P) : decP <-> P. 30 | Proof. by case: decP. Qed. 31 | 32 | (* equivalence of type inhabitation *) 33 | Variant iffT T1 T2 := IffT of (T1 -> T2) & (T2 -> T1). 34 | Notation "T1 <-T-> T2" := (iffT T1 T2) (at level 30). 35 | 36 | Definition iffT_LR T1 T2 : iffT T1 T2 -> T1 -> T2. by case. Qed. 37 | Definition iffT_RL T1 T2 : iffT T1 T2 -> T2 -> T1. by case. Qed. 38 | 39 | Hint View for move/ iffT_LR|2 iffT_RL|2. 40 | Hint View for apply/ iffT_LR|2 iffT_RL|2. 41 | 42 | (** Arithmetic *) 43 | 44 | Lemma size_induction {X : Type} (measure : X -> nat) (p : X ->Prop) : 45 | ( forall x, ( forall y, measure y < measure x -> p y) -> p x) -> forall x, p x. 46 | Proof. 47 | move => A x. apply: (A). elim: (measure x) => // n IHn y Hy. 48 | apply: A => z Hz. apply: IHn. exact: leq_trans Hz Hy. 49 | Qed. 50 | 51 | (** Sequences - seq.v *) 52 | 53 | Arguments nth T x0 !s !n. 54 | 55 | Lemma index_take (T : eqType) (a : T) n (s : seq T) : 56 | a \in take n s -> index a (take n s) = index a s. 57 | Proof. move => H. by rewrite -{2}[s](cat_take_drop n) index_cat H. Qed. 58 | 59 | Lemma orS (b1 b2 : bool) : b1 || b2 -> {b1} + {b2}. 60 | Proof. by case: b1 => /= [_|H]; [left|right]. Qed. 61 | 62 | Lemma forall_consT {T : eqType} {a : T} {s} {P : T -> Type} : 63 | (forall b, b \in a :: s -> P b) <-T-> (P a * (forall b, b \in s -> P b)). 64 | Proof. 65 | split => [A|[A B] b]. 66 | - by split => [|b b_s]; apply: A; rewrite inE ?b_s ?orbT ?eqxx. 67 | - rewrite inE. case/orS => [/eqP -> //|]. exact: B. 68 | Qed. 69 | 70 | Lemma max_mem n0 (s : seq nat) : n0 \in s -> \max_(i <- s) i \in s. 71 | Proof. 72 | case: s => // a s _. rewrite big_cons big_seq. 73 | elim/big_ind : _ => [|n m|n A]; first exact: mem_head. 74 | - rewrite -{5}[a]maxnn maxnACA => ? ?. rewrite {1}/maxn. by case: ifP. 75 | - rewrite /maxn. case: ifP; by rewrite ?mem_head // inE A orbT. 76 | Qed. 77 | 78 | (* reasoning about singletons *) 79 | Lemma seq1P (T : eqType) (x y : T) : reflect (x = y) (x \in [:: y]). 80 | Proof. rewrite inE. exact: eqP. Qed. 81 | 82 | Lemma sub1P (T : eqType) x (p : pred T) : reflect {subset [:: x] <= p} (x \in p). 83 | Proof. 84 | apply: (iffP idP) => [A y|]; by [rewrite inE => /eqP->|apply; exact: mem_head]. 85 | Qed. 86 | 87 | (** Finite Types - fintype.v *) 88 | 89 | Lemma sub_forall (T: finType) (p q : pred T) : 90 | subpred p q -> [forall x : T, p x] -> [forall x : T, q x]. 91 | Proof. move => sub /forallP H. apply/forallP => x. exact: sub. Qed. 92 | 93 | Lemma sub_exists (T : finType) (P1 P2 : pred T) : 94 | subpred P1 P2 -> [exists x, P1 x] -> [exists x, P2 x]. 95 | Proof. move => H. case/existsP => x /H ?. apply/existsP. by exists x. Qed. 96 | 97 | Lemma cardT_eq (T : finType) (p : pred T) : #|{: { x | p x}}| = #|T| -> p =1 predT. 98 | Proof. 99 | move=> eq_pT; have [|g g1 g2 x] := @inj_card_bij (sig p) T _ val_inj. 100 | by rewrite eq_pT. 101 | rewrite -(g2 x); exact: valP. 102 | Qed. 103 | 104 | (** Finite Ordinals *) 105 | 106 | Lemma inord_max n : ord_max = inord n :> 'I_n.+1. 107 | Proof. by rewrite -[ord_max]inord_val. Qed. 108 | 109 | Lemma inord0 n : ord0 = inord 0 :> 'I_n.+1. 110 | Proof. by rewrite -[ord0]inord_val. Qed. 111 | 112 | Definition ord1 {n} := (@Ordinal (n.+2) 1 (erefl _)). 113 | 114 | Lemma inord1 n : ord1 = inord 1 :> 'I_n.+2. 115 | Proof. apply: ord_inj => /=. by rewrite inordK. Qed. 116 | 117 | (** Finite Sets - finset.v *) 118 | 119 | Lemma card_set (T:finType) : #|{set T}| = 2^#|T|. 120 | Proof. rewrite -!cardsT -powersetT. exact: card_powerset. Qed. 121 | 122 | (** Miscellaneous *) 123 | 124 | #[local] Open Scope quotient_scope. 125 | Lemma epiK {T:choiceType} (e : equiv_rel T) x : e (repr (\pi_{eq_quot e} x)) x. 126 | Proof. by rewrite -eqmodE reprK. Qed. 127 | 128 | Lemma set_enum (T : finType) : [set x in enum T] = [set: T]. 129 | Proof. apply/setP => x. by rewrite !inE mem_enum. Qed. 130 | 131 | Lemma find_minn_bound (p : pred nat) m : 132 | {n | [/\ n < m, p n & forall i, i < n -> ~~ p i]} + {(forall i, i < m -> ~~ p i)}. 133 | Proof. 134 | case: (boolP [exists n : 'I_m, p n]) => C ; [left|right]. 135 | - have/find_ex_minn: exists n, (n < m) && p n. 136 | case/existsP : C => [[n Hn pn]] /=. exists n. by rewrite Hn. 137 | case => n /andP [lt_m pn] min_n. exists n. split => // i Hi. 138 | apply: contraTN (Hi) => pi. rewrite -leqNgt min_n // pi andbT. 139 | exact: ltn_trans lt_m. 140 | - move => i lt_m. move: C. by rewrite negb_exists => /forallP /(_ (Ordinal lt_m)). 141 | Qed. 142 | 143 | (** Relations *) 144 | 145 | Section Functional. 146 | Variables (T T' : finType) (e : rel T) (e' : rel T') (f : T -> T'). 147 | 148 | Definition terminal x := forall y, e x y = false. 149 | Definition functional := forall x y z, e x y -> e x z -> y = z. 150 | 151 | Lemma term_uniq x y z : functional -> 152 | terminal y -> terminal z -> connect e x y -> connect e x z -> y = z. 153 | Proof. 154 | move => fun_e Ty Tz /connectP [p] p1 p2 /connectP [q]. 155 | elim: p q x p1 p2 => [|a p IH] [|b q] x /=; first congruence. 156 | - move => _ <-. by rewrite Ty. 157 | - case/andP => xa _ _ _ H. by rewrite -H Tz in xa. 158 | - case/andP => xa p1 p2 /andP [xb] q1 q2. 159 | move: (fun_e _ _ _ xa xb) => ?; subst b. exact: IH q2. 160 | Qed. 161 | 162 | Hypothesis f_inj : injective f. 163 | Hypothesis f_eq : forall x y, e x y = e' (f x) (f y). 164 | Hypothesis f_inv: forall x z, e' (f x) z -> exists y, z = f y. 165 | 166 | Lemma connect_transfer x y : connect e x y = connect e' (f x) (f y). 167 | Proof using f_eq f_inj f_inv. 168 | apply/idP/idP. 169 | - case/connectP => s. 170 | elim: s x => //= [x _ -> |z s IH x]; first exact: connect0. 171 | case/andP => xz pth Hy. rewrite f_eq in xz. 172 | apply: connect_trans (connect1 xz) _. exact: IH. 173 | - case/connectP => s. 174 | elim: s x => //= [x _ /f_inj -> |z s IH x]; first exact: connect0. 175 | case/andP => xz pth Hy. case: (f_inv xz) => z' ?; subst. 176 | rewrite -f_eq in xz. apply: connect_trans (connect1 xz) _. exact: IH. 177 | Qed. 178 | End Functional. 179 | 180 | Lemma functional_sub (T : finType) (e1 e2 : rel T) : 181 | functional e2 -> subrel e1 e2 -> functional e1. 182 | Proof. move => f_e2 sub x y z /sub E1 /sub E2. exact: f_e2 E1 E2. Qed. 183 | 184 | (** ** Inverting surjective functions *) 185 | 186 | Definition surjective aT {rT : eqType} (f : aT -> rT) := forall y, exists x, f x == y. 187 | 188 | Lemma surjectiveE (rT aT : finType) (f : aT -> rT) : surjective f -> #|codom f| = #|rT|. 189 | Proof. 190 | move => H. apply: eq_card => x. rewrite inE. apply/codomP. 191 | move: (H x) => [y /eqP]. eauto. 192 | Qed. 193 | 194 | Lemma surj_card_bij (T T' : finType) (f : T -> T') : 195 | surjective f -> #|T| = #|T'| -> bijective f. 196 | Proof. 197 | move => S E. apply: inj_card_bij; last by rewrite E. 198 | apply/injectiveP; apply/card_uniqP. rewrite size_map -cardT E. exact: surjectiveE. 199 | Qed. 200 | 201 | (* We define a general inverse of surjective functions from choiceType -> eqType. 202 | This function gives a canonical representative, thus the name "cr". *) 203 | Definition cr {X : choiceType} {Y : eqType} {f : X -> Y} (Sf : surjective f) y : X := 204 | xchoose (Sf y). 205 | 206 | Lemma crK {X : choiceType} {Y : eqType} {f : X->Y} {Sf : surjective f} x: f (cr Sf x) = x. 207 | Proof. by rewrite (eqP (xchooseP (Sf x))). Qed. 208 | -------------------------------------------------------------------------------- /theories/myhill_nerode.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import all_ssreflect. 4 | From RegLang Require Import misc languages dfa minimization regexp. 5 | 6 | Set Default Proof Using "Type". 7 | 8 | Set Implicit Arguments. 9 | Unset Strict Implicit. 10 | Unset Printing Implicit Defensive. 11 | 12 | (** * Classifiers *) 13 | 14 | (** For us, classifiers (right-congruent functions from words into 15 | some finite type) serve as a constructive approximation of 16 | Myhill-Nerode partition. We show that classifiers for given language 17 | can be turned into DFAs and vice versa. Moreover, we show that there 18 | exist most general classifiers corresponding to minimal automata. *) 19 | 20 | Section Clasifiers. 21 | 22 | Variable char: finType. 23 | #[local] Notation word := (word char). 24 | 25 | Record classifier := Classifier { 26 | classifier_classes : finType; 27 | classifier_fun :> word -> classifier_classes }. 28 | 29 | Notation classes_of := classifier_classes. 30 | 31 | (** It would be desirable to have classifiers also coerce to [finType] 32 | (to be able to write #|E| for the number of classes). However, this 33 | introduces an ambiguity since [finType] already coerces to Funclass 34 | (as the universally true predicate). *) 35 | 36 | 37 | Definition right_congruent (X : eqType) (E : word -> X) := 38 | forall u v a, E u = E v -> E (u ++ [::a]) = E (v ++ [::a]). 39 | 40 | Definition refines (X: eqType) (L : dlang char) (E : word -> X) := 41 | forall u v, E u = E v -> (u \in L) = (v \in L). 42 | 43 | Record classifier_for L := { 44 | cf_classifier :> classifier; 45 | cf_congruent : right_congruent cf_classifier; 46 | cf_refines : refines L cf_classifier 47 | }. 48 | 49 | Lemma cf_lang_eq_proof L1 L2 (M1 : classifier_for L1) : L1 =i L2 -> refines L2 M1. 50 | Proof. move => H0 u v /cf_refines. by rewrite -!H0. Qed. 51 | 52 | Definition cf_lang_eq L1 L2 (M1 : classifier_for L1) (H : L1 =i L2) := 53 | {| cf_congruent := @cf_congruent L1 M1; cf_refines := cf_lang_eq_proof H |}. 54 | 55 | 56 | (** ** Conversions between Classifiers and DFAs *) 57 | 58 | Section DFAtoClassifier. 59 | Variable (A : dfa char). 60 | 61 | Lemma delta_s_right_congruent : right_congruent (delta_s A). 62 | Proof. move => u v a H. rewrite /= /delta_s !delta_cat. by f_equal. Qed. 63 | 64 | Lemma delta_s_refines : refines (dfa_lang A) (delta_s A). 65 | Proof. move => u v H. rewrite -!delta_lang. by f_equal. Qed. 66 | 67 | Definition dfa_to_cf : classifier_for (dfa_lang A) := 68 | {| cf_classifier := Classifier (delta_s A); 69 | cf_congruent := delta_s_right_congruent; 70 | cf_refines := delta_s_refines |}. 71 | 72 | Lemma dfa_to_cf_size : #|A| = #|classes_of dfa_to_cf|. by []. Qed. 73 | End DFAtoClassifier. 74 | 75 | 76 | Section ClassifierToDFA. 77 | Variables (L : dlang char) (M : classifier_for L). 78 | 79 | Definition imfun_of := image_fun (@cf_congruent _ M). 80 | Definition imfun_of_surj := @surjective_image_fun _ _ _ (@cf_congruent _ M). 81 | 82 | Lemma imfun_of_refines : refines L imfun_of. 83 | Proof. move => x y []. exact: cf_refines. Qed. 84 | 85 | Lemma imfun_of_congruent : right_congruent imfun_of. 86 | Proof. 87 | move => x y a [] /cf_congruent. 88 | move/(_ a) => /eqP H. exact/eqP. 89 | Qed. 90 | 91 | Definition classifier_to_dfa := 92 | {| dfa_s := imfun_of [::]; 93 | dfa_fin := [set x | cr (imfun_of_surj) x \in L]; 94 | dfa_trans x a := imfun_of (cr (imfun_of_surj) x ++ [::a]) |}. 95 | 96 | Lemma classifier_to_dfa_delta : delta_s classifier_to_dfa =1 imfun_of. 97 | Proof. 98 | apply: last_ind => [|w a IHw] //=. 99 | rewrite /delta_s -cats1 delta_cat -!/(delta_s _ _) IHw. 100 | apply: imfun_of_congruent. by rewrite crK. 101 | Qed. 102 | 103 | Lemma classifier_to_dfa_correct : dfa_lang classifier_to_dfa =i L. 104 | Proof. 105 | move => w. rewrite -delta_lang classifier_to_dfa_delta inE. 106 | apply: imfun_of_refines. by rewrite crK. 107 | Qed. 108 | End ClassifierToDFA. 109 | 110 | Lemma classifier_to_dfa_connected L (M : classifier_for L) : 111 | connected (classifier_to_dfa M). 112 | Proof. 113 | move => q. exists (cr (@imfun_of_surj _ M) q). 114 | rewrite -{2}[q](crK (Sf:=(@imfun_of_surj _ M))). 115 | by rewrite -/(delta_s _ _) classifier_to_dfa_delta. 116 | Qed. 117 | 118 | (** ** Most General Classifiers 119 | 120 | Just like there exists a coarsest Myhill-Nerode relation, there also 121 | exist most general classifiers. For these classifiers, the classes 122 | correspond exactly to those of the coarsest Myhill-Nerode relation. *) 123 | 124 | Definition nerode (X : eqType) (L : dlang char) (E : word -> X) := 125 | forall u v, E u = E v <-> forall w, (u++w \in L) = (v++w \in L). 126 | 127 | Record mgClassifier L := { 128 | mg_classifier :> classifier; 129 | nerodeP : nerode L mg_classifier }. 130 | 131 | Lemma mg_right_congruent L (N : mgClassifier L) : right_congruent N. 132 | Proof. move => u v a /nerodeP H. apply/nerodeP => w. by rewrite -!catA. Qed. 133 | 134 | Lemma mg_refines L (N : mgClassifier L) : refines L N. 135 | Proof. move => u v /nerodeP H. by rewrite -[u]cats0 -[v]cats0. Qed. 136 | 137 | Definition mg_to_classifier L (N : mgClassifier L) := {| 138 | cf_congruent := @mg_right_congruent L N; 139 | cf_refines := @mg_refines L N |}. 140 | 141 | Coercion mg_to_classifier : mgClassifier >-> classifier_for. 142 | 143 | Arguments cf_congruent [L M u v a] H: rename. 144 | Arguments cf_refines [L M u v] H: rename. 145 | Arguments nerodeP [L] N u v: rename. 146 | 147 | (** Most general classifiers coerce to classifiers and can be converted to DFAs *) 148 | 149 | Definition mg_to_dfa L (N : mgClassifier L) := classifier_to_dfa N. 150 | 151 | Lemma mg_to_dfa_correct L (N : mgClassifier L) : dfa_lang (mg_to_dfa N) =i L. 152 | Proof. exact: classifier_to_dfa_correct. Qed. 153 | 154 | Lemma mg_to_connected L (N : mgClassifier L) : connected (mg_to_dfa N). 155 | Proof. exact: classifier_to_dfa_connected. Qed. 156 | 157 | (** Most general classifier yield minimal automata *) 158 | 159 | Lemma mg_minimal (L : dlang char) (M : mgClassifier L) : minimal (mg_to_dfa M). 160 | Proof. 161 | apply/minimalP. split; first exact: mg_to_connected. 162 | move => p q. split => [coll_pq|->//]. 163 | rewrite -[p](crK (Sf := (@imfun_of_surj _ M))). 164 | rewrite -[q](crK (Sf := (@imfun_of_surj _ M))). 165 | apply: val_inj. apply/nerodeP => w. 166 | rewrite -!(@classifier_to_dfa_correct _ M) !inE /dfa_accept !delta_cat. 167 | rewrite -!/(delta_s _ _) !classifier_to_dfa_delta !crK. exact: coll_pq. 168 | Qed. 169 | 170 | (** We can cast mgClassifiers to equivalent languages *) 171 | 172 | Lemma mg_eq_proof L1 L2 (N1 : mgClassifier L1) : L1 =i L2 -> nerode L2 N1. 173 | Proof. move => H0 u v. split => [/nerodeP H1 w|H1]. 174 | - by rewrite -!H0. 175 | - apply/nerodeP => w. by rewrite !H0. 176 | Qed. 177 | 178 | Definition mg_eq L1 L2 N1 (H : L1 =i L2) := {| nerodeP := mg_eq_proof N1 H |}. 179 | 180 | (** Minimal DFAs immediately give rise to most general classifiers. *) 181 | 182 | Section mDFAtoMG. 183 | Variable A : dfa char. 184 | Variable MA : minimal A. 185 | 186 | Lemma minimal_nerode : nerode (dfa_lang A) (delta_s A). 187 | Proof using MA. 188 | move => u v. apply: iff_trans (iff_sym (minimal_collapsed MA _ _)) _. 189 | by split => H w; move: (H w); rewrite -!delta_cat !delta_lang. 190 | Qed. 191 | 192 | Definition minimal_classifier := {| classifier_fun := delta_s A |}. 193 | 194 | Definition dfa_to_mg := {| 195 | mg_classifier := minimal_classifier; 196 | nerodeP := minimal_nerode |}. 197 | End mDFAtoMG. 198 | 199 | End Clasifiers. 200 | -------------------------------------------------------------------------------- /theories/nfa.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import all_ssreflect. 4 | From RegLang Require Import misc languages dfa. 5 | 6 | Set Default Proof Using "Type". 7 | 8 | Set Implicit Arguments. 9 | Unset Printing Implicit Defensive. 10 | Unset Strict Implicit. 11 | 12 | Section NFA. 13 | Variable char : finType. 14 | #[local] Notation word := (word char). 15 | 16 | (** * Nondeterministic Finite Automata. 17 | 18 | We define both normal NFAs and NFAs with epsilon transitions 19 | (eNFAs). For NFAs acceptance can still be defined by structural 20 | recursion on the word. In particular, the length of an NFA run is 21 | determined by the input word, a property that we exploit repeatedly. *) 22 | 23 | Record nfa : Type := { 24 | nfa_state :> finType; 25 | nfa_s : { set nfa_state }; 26 | nfa_fin : { set nfa_state }; 27 | nfa_trans : nfa_state -> char -> nfa_state -> bool }. 28 | 29 | Fixpoint nfa_accept (A : nfa) (x : A) w := 30 | if w is a :: w' then [exists (y | nfa_trans x a y), nfa_accept y w'] 31 | else x \in nfa_fin A. 32 | 33 | Definition nfa_lang (A : nfa) := [pred w | [exists s, (s \in nfa_s A) && nfa_accept s w]]. 34 | 35 | (** ** Epsilon NFAs *) 36 | 37 | Record enfa : Type := { 38 | enfa_state :> finType; 39 | enfa_s : {set enfa_state}; 40 | enfa_f : {set enfa_state}; 41 | enfa_trans : option char -> enfa_state -> enfa_state -> bool }. 42 | 43 | Section EpsilonNFA. 44 | Variables (N : enfa). 45 | 46 | (** For eNFAs, acceptance is defined relationally since structural 47 | recursion over the word is no longer possible. *) 48 | 49 | Inductive enfa_accept : N -> word -> Prop := 50 | | EnfaFin q : q \in enfa_f N -> enfa_accept q [::] 51 | | EnfaSome p a q x : enfa_trans (Some a) p q -> enfa_accept q x -> enfa_accept p (a::x) 52 | | EnfaNone p q x : enfa_trans None p q -> enfa_accept q x -> enfa_accept p (x). 53 | 54 | Definition enfa_lang x := exists2 s, s \in enfa_s N & enfa_accept s x. 55 | 56 | (** We convert eNFAs to NFAs by extending the set of starting states and all 57 | transitions by epsilon-reachable states - also known as epsilon closure *) 58 | 59 | Definition eps_reach (p : N) := [set q | connect (enfa_trans None) p q]. 60 | 61 | Lemma lift_accept p q x : q \in eps_reach p -> enfa_accept q x -> enfa_accept p x. 62 | Proof. 63 | rewrite inE => /connectP [s]. elim: s p x q => //= [p x q _ -> //| q s IHs p x q']. 64 | case/andP => pq ? ? H. apply: EnfaNone pq _. exact: IHs H. 65 | Qed. 66 | 67 | Definition nfa_of := 68 | {| nfa_s := \bigcup_(p in enfa_s N) (eps_reach p); 69 | nfa_fin := enfa_f N; 70 | nfa_trans p a q := [exists p', enfa_trans (Some a) p p' && (q \in eps_reach p') ] |}. 71 | 72 | Lemma enfaE x p : 73 | (enfa_accept p x) <-> (exists2 q : nfa_of, q \in eps_reach p & nfa_accept q x). 74 | Proof. split. 75 | - elim => {p x} [q H|p a q x H _ [q' Hq1 Hq2]|p p' x]. 76 | + exists q => //. by rewrite inE connect0. 77 | + exists p => /=; first by rewrite inE connect0. 78 | apply/exists_inP. exists q' => //. apply/exists_inP. by exists q. 79 | + move => H1 H2 [q Hq1 Hq2]. exists q => //. rewrite !inE in Hq1 *. 80 | exact: connect_trans (connect1 _) Hq1. 81 | - elim: x p => [|a x IH] p [p'] R /= H. apply: lift_accept R _. exact: EnfaFin. 82 | case/exists_inP : H => q /exists_inP [q' pq' qq'] H. apply: lift_accept R _. 83 | apply: EnfaSome pq' _. apply: IH. by exists q. 84 | Qed. 85 | 86 | Lemma nfa_ofP x : reflect (enfa_lang x) (x \in nfa_lang nfa_of). 87 | Proof. 88 | apply: (iffP exists_inP) => [[p Hp1 Hp2]|[s Hs1 /enfaE [p Hp1 Hp2]]]. 89 | - case/bigcupP : Hp1 => s Hs H. exists s => //. by apply/enfaE; exists p. 90 | - exists p => //. by apply/bigcupP; exists s. 91 | Qed. 92 | End EpsilonNFA. 93 | 94 | (** ** Equivalence of DFAs and NFAs *) 95 | (** We use the powerset construction to obtain 96 | a deterministic automaton from a non-deterministic one. **) 97 | Section PowersetConstruction. 98 | 99 | Variable A : nfa. 100 | 101 | Definition nfa_to_dfa := {| 102 | dfa_s := nfa_s A; 103 | dfa_fin := [set X | X :&: nfa_fin A != set0]; 104 | dfa_trans X a := [set q | [exists (p | p \in X), nfa_trans p a q]] 105 | |}. 106 | 107 | Lemma nfa_to_dfa_correct : nfa_lang A =i dfa_lang nfa_to_dfa. 108 | Proof. 109 | move => w. rewrite !inE {2}/nfa_to_dfa /=. 110 | elim: w (nfa_s _) => [|a x IH] X; rewrite /= accE ?inE. 111 | - apply/existsP/set0Pn => [] [p] H; exists p; by rewrite inE in H *. 112 | - rewrite -IH /dfa_trans /=. apply/exists_inP/exists_inP. 113 | + case => p inX /exists_inP [q ? ?]. exists q => //. rewrite inE. 114 | apply/exists_inP. by exists p. 115 | + case => p. rewrite inE => /exists_inP [q] ? ? ?. 116 | exists q => //. apply/exists_inP. by exists p. 117 | Qed. 118 | 119 | End PowersetConstruction. 120 | 121 | (** We also embed NFAs into DFAs. **) 122 | 123 | Section Embed. 124 | 125 | Variable A : dfa char. 126 | 127 | Definition dfa_to_nfa : nfa := {| 128 | nfa_s := [set dfa_s A]; 129 | nfa_fin := dfa_fin A; 130 | nfa_trans x a y := dfa_trans x a == y |}. 131 | 132 | Lemma dfa_to_nfa_correct : dfa_lang A =i nfa_lang dfa_to_nfa. 133 | Proof. 134 | move => w. rewrite !inE /nfa_s /=. 135 | elim: w (dfa_s A) => [|b w IHw] x; rewrite accE /=. 136 | - apply/idP/existsP => [Fx|[y /andP [/set1P ->]]//]. 137 | exists x. by rewrite !inE eqxx. 138 | - rewrite IHw. apply/exists_inP/exists_inP. 139 | + case => y /set1P -> H. exists x; first exact: set11. 140 | apply/existsP. exists (dfa_trans x b). by rewrite H eqxx. 141 | + case => y /set1P -> {y} /existsP [z] /andP [] /eqP-> H. 142 | exists z; by rewrite ?set11. 143 | Qed. 144 | 145 | End Embed. 146 | 147 | (** ** Operations on NFAs 148 | 149 | To prepare the translation from regular expresstions to DFAs, we show 150 | that finite automata are closed under all regular operations. We build 151 | the primitive automata, complement and boolean combinations using 152 | DFAs. *) 153 | 154 | Definition nfa_char (a:char) := 155 | {| nfa_s := [set false]; 156 | nfa_fin := [set true]; 157 | nfa_trans p b q := if (p,q) is (false,true) then (b == a) else false |}. 158 | 159 | Lemma nfa_char_correct (a : char) : nfa_lang (nfa_char a) =1 pred1 [:: a]. 160 | Proof. 161 | move => w /=. apply/exists_inP/eqP => [[p]|]. 162 | - rewrite inE => /eqP->. case: w => [|b [|c w]] /=; first by rewrite inE. 163 | + by case/exists_inP => [[/eqP->|//]]. 164 | + case/exists_inP => [[_|//]]. by case/exists_inP. 165 | - move->. exists false; first by rewrite inE. apply/exists_inP. 166 | exists true; by rewrite ?inE //=. 167 | Qed. 168 | 169 | Definition nfa_plus (N M : nfa) := 170 | {| nfa_s := [set q | match q with inl q => q \in nfa_s N | inr q => q \in nfa_s M end ]; 171 | nfa_fin := [set q | match q with inl q => q \in nfa_fin N | inr q => q \in nfa_fin M end ]; 172 | nfa_trans p a q := match p,a,q with 173 | | inl p,a,inl q => nfa_trans p a q 174 | | inr p,a,inr q => nfa_trans p a q 175 | | _,_,_ => false 176 | end |}. 177 | 178 | Lemma nfa_plus_correct (N M : nfa) : 179 | nfa_lang (nfa_plus N M) =i plus (nfa_lang N) (nfa_lang M). 180 | Proof. 181 | move => w. apply/idP/idP. 182 | - case/exists_inP => [[s|s]]; rewrite !inE => A B; 183 | apply/orP;[left|right];apply/exists_inP; exists s => //. 184 | + elim: w s {A} B => /= [|a w IH] s; first by rewrite inE. 185 | case/exists_inP => [[|]// p A /IH B]. apply/exists_inP. by exists p. 186 | + elim: w s {A} B => /= [|a w IH] s; first by rewrite inE. 187 | case/exists_inP => [[|]// p A /IH B]. apply/exists_inP. by exists p. 188 | - rewrite !inE. case/orP => /exists_inP [s A B]; 189 | apply/exists_inP; [exists(inl s)|exists(inr s)]; rewrite ?inE //. 190 | + elim: w s {A} B => /= [|a w IH] s; first by rewrite inE. 191 | case/exists_inP => [p A /IH B]. apply/exists_inP. by exists (inl p). 192 | + elim: w s {A} B => /= [|a w IH] s; first by rewrite inE. 193 | case/exists_inP => [p A /IH B]. apply/exists_inP. by exists (inr p). 194 | Qed. 195 | 196 | Definition nfa_eps : nfa := 197 | {| nfa_s := [set tt]; nfa_fin := [set tt]; nfa_trans p a q := false |}. 198 | 199 | Lemma nfa_eps_correct: nfa_lang (nfa_eps) =i pred1 [::]. 200 | Proof. 201 | move => w. apply/exists_inP/idP. 202 | + move => [[]]. case: w => [|a w] //= _. by case/exists_inP. 203 | + move => /=. rewrite inE=>/eqP->. exists tt; by rewrite /= inE. 204 | Qed. 205 | 206 | (** The automata for concatenation and Kleene star are constructed by 207 | taking NFAs as input and first building eNFAs which are then converted 208 | to NFAs. *) 209 | 210 | Section eNFAOps. 211 | 212 | Variables A1 A2 : nfa. 213 | 214 | Definition enfa_conc : enfa := 215 | {| enfa_s := inl @: nfa_s A1; 216 | enfa_f := inr @: nfa_fin A2; 217 | enfa_trans c p q := 218 | match c,p,q with 219 | | Some a,inl p',inl q' => nfa_trans p' a q' 220 | | Some a,inr p',inr q' => nfa_trans p' a q' 221 | | None,inl p', inr q' => (p' \in nfa_fin A1) && (q' \in nfa_s A2) 222 | | _,_,_ => false 223 | end |}. 224 | 225 | Lemma enfa_concE (p : enfa_conc) x : enfa_accept p x -> 226 | match p with 227 | | inr p' => nfa_accept p' x 228 | | inl p' => exists x1 x2, [/\ x = x1 ++ x2, nfa_accept p' x1 & x2 \in nfa_lang A2] 229 | end. 230 | Proof. 231 | elim => {p x} [[?|?] /imsetP [q] // ? [->] //||]. 232 | - move => [p|p] a [q|q] x //. 233 | + move => pq _ [x1] [x2] [X1 X2 X3]. exists (a::x1); exists x2; subst; split => //. 234 | by apply/exists_inP; exists q. 235 | + move => pq _ Hq. by apply/exists_inP; exists q. 236 | - move => [p|p] [q|q] //= x /andP[Hp Hq] _ ?. exists [::]; exists x; split => //. 237 | by apply/exists_inP; exists q. 238 | Qed. 239 | 240 | Lemma enfa_concIr (p : A2) x : nfa_accept p x -> @enfa_accept enfa_conc (inr p) x. 241 | Proof. 242 | elim: x p => [p Hp|a x IH p /= /exists_inP [q q1 q2]]. 243 | - (* compat: //. exact: IH. 246 | Qed. 247 | 248 | Lemma enfa_concIl (p : A1) x1 x2 : 249 | nfa_accept p x1 -> x2 \in nfa_lang A2 -> @enfa_accept enfa_conc (inl p) (x1++x2). 250 | Proof. 251 | elim: x1 p => /= [p Hp /exists_inP [q q1 q2]|a x1 IH p /exists_inP [q q1 q2] H]. 252 | - apply: (@EnfaNone enfa_conc _ (inr q)). by rewrite /= Hp. exact: enfa_concIr. 253 | - apply: (@EnfaSome enfa_conc _ _ (inl q)). by rewrite /= q1. exact: IH. 254 | Qed. 255 | 256 | Lemma enfa_concP x : reflect (enfa_lang enfa_conc x) (conc (nfa_lang A1) (nfa_lang A2) x). 257 | Proof. 258 | apply: (iffP (@concP _ _ _ _)) => [[x1] [x2] [X1 [X2 X3]] |]. 259 | - (* compat: s ? ?. exists (inl s); first solve [exact: imset_f|exact:mem_imset]. 261 | subst. exact: enfa_concIl. 262 | - move => [[s /imsetP [? ? [?]] /enfa_concE [x1] [x2] [? ? ?] |s]]; last by case/imsetP. 263 | exists x1; exists x2. repeat (split => //). apply/exists_inP. by exists s;subst. 264 | Qed. 265 | 266 | Definition enfa_star : enfa := 267 | {| enfa_s := [set None]; 268 | enfa_f := [set None]; 269 | enfa_trans c p q := 270 | match c,p,q with 271 | Some a,Some p', Some q' => q' \in nfa_trans p' a 272 | | None, Some p', None => p' \in nfa_fin A1 273 | | None, None, Some s => s \in nfa_s A1 274 | | _,_,_ => false 275 | end |}. 276 | 277 | Lemma enfa_s_None : None \in enfa_s enfa_star. 278 | Proof. by rewrite inE. Qed. 279 | 280 | Lemma enfa_f_None : None \in enfa_f enfa_star. 281 | Proof. by rewrite inE. Qed. 282 | 283 | #[local] Hint Resolve enfa_s_None enfa_f_None : core. 284 | 285 | Lemma enfa_star_cat x1 x2 (p : enfa_star) : 286 | enfa_accept p x1 -> enfa_lang enfa_star x2 -> enfa_accept p (x1 ++ x2). 287 | Proof. 288 | elim => {p x1}. 289 | - move => p. rewrite inE => /eqP->. case => q. by rewrite inE => /eqP->. 290 | - move => p a q x /=. case: p => // p. case: q => // q pq ? IH H. exact: EnfaSome (IH H). 291 | - move => [p|] [q|] x //= p1 p2 IH H; exact: EnfaNone (IH H). 292 | Qed. 293 | 294 | Lemma enfa_starI x (p : A1) : nfa_accept p x -> @enfa_accept enfa_star (Some p) x. 295 | Proof. 296 | elim: x p => /= [p H|a x IH p]. 297 | - apply: (@EnfaNone enfa_star _ None) => //. exact: EnfaFin. 298 | - case/exists_inP => q q1 /IH. exact: EnfaSome. 299 | Qed. 300 | 301 | Lemma enfa_star_langI x : x \in nfa_lang A1 -> @enfa_accept enfa_star None x. 302 | Proof. 303 | case/exists_inP => s s1 s2. 304 | apply: (@EnfaNone enfa_star _ (Some s)) => //. exact: enfa_starI. 305 | Qed. 306 | 307 | Lemma enfa_starE (o : enfa_star) x : enfa_accept o x -> 308 | if o is Some p 309 | then exists x1 x2, [/\ x = x1 ++ x2, nfa_accept p x1 & star (nfa_lang A1) x2] 310 | else star (nfa_lang A1) x. 311 | Proof. 312 | elim => {x o}. 313 | - move => [q|//]. by rewrite inE; move/eqP. 314 | - move => [p|] a [q|] x // H acc [x1] [x2] [H1 H2 H3]. exists (a::x1); exists x2. 315 | rewrite H1. split => //. by apply/exists_inP; exists q. 316 | - move => [p|] [q|] x //=. 317 | + move => *. by exists [::]; exists x. 318 | + move => H acc [x1] [x2] [H1 H2]. rewrite H1. apply: star_cat. 319 | by apply/exists_inP; exists q. 320 | Qed. 321 | 322 | Lemma enfa_starP x : reflect (enfa_lang enfa_star x) (star (nfa_lang A1) x). 323 | Proof. apply: (iffP idP). 324 | - case/starP => vv H ->. elim: vv H => /= [_|v vv]. 325 | + exists None => //. exact: EnfaFin. 326 | + move => IH /andP[/andP [H1 H2] H3]. exists None => //. 327 | apply: enfa_star_cat (IH _) => //. exact: enfa_star_langI. 328 | - case => q. rewrite inE => /eqP-> {q}. exact: enfa_starE. 329 | Qed. 330 | 331 | 332 | Definition nfa_conc := nfa_of (enfa_conc). 333 | 334 | Lemma nfa_conc_correct : nfa_lang nfa_conc =i conc (nfa_lang A1) (nfa_lang A2). 335 | Proof. move => x. apply/nfa_ofP/idP => ?;exact/enfa_concP. Qed. 336 | 337 | Definition nfa_star := nfa_of (enfa_star). 338 | Lemma nfa_star_correct : nfa_lang nfa_star =i star (nfa_lang A1). 339 | Proof. move => x. apply/nfa_ofP/idP => ?;exact/enfa_starP. Qed. 340 | 341 | End eNFAOps. 342 | 343 | (** ** Runs on NFAs *) 344 | 345 | Section NFARun. 346 | Variable (M : nfa). 347 | 348 | Inductive nfa_run : word -> M -> seq M -> Prop := 349 | | run0 p of p \in nfa_fin M : nfa_run [::] p [::] 350 | | runS a p q x r & q \in nfa_trans p a : nfa_run x q r -> nfa_run (a::x) p (q::r). 351 | 352 | Lemma nfa_acceptP x p : reflect (exists r, nfa_run x p r) (nfa_accept p x). 353 | Proof. 354 | apply: (iffP idP) => [|[r]]. 355 | - elim: x p => [|a x IHx] p /=; first by exists [::]; constructor. 356 | case/exists_inP => q p1 p2. case (IHx q p2) => r ?. by exists (q::r); constructor. 357 | - elim: x r p => [|a x IHx] r p; first by inversion 1; subst. 358 | inversion 1; subst. apply/exists_inP. exists q => //. exact: IHx H4. 359 | Qed. 360 | 361 | Lemma run_size x r p : nfa_run x p r -> size x = size r. 362 | Proof. by elim => // {r p x} a p q r x _ _ /= ->. Qed. 363 | 364 | Lemma nfaP x : reflect (exists s r, s \in nfa_s M /\ nfa_run x s r) (x \in nfa_lang M). 365 | Proof. 366 | apply: (iffP exists_inP). 367 | - case => s ? /nfa_acceptP [r] ?. by exists s; exists r. 368 | - case => s [r] [? ?]. exists s => //. apply/nfa_acceptP. by exists r. 369 | Qed. 370 | 371 | Lemma run_last x p r : nfa_run x p r -> last p r \in nfa_fin M. 372 | Proof. by elim. Qed. 373 | 374 | Lemma run_trans x p r i (Hi : i < size x) : nfa_run x p r -> 375 | nth p (p::r) i.+1 \in nfa_trans (nth p (p::r) i) (tnth (in_tuple x) (Ordinal Hi)). 376 | Proof. 377 | move => H. elim: H i Hi => {x p r} // a p q x r tr run IH /= [|i] Hi //. 378 | rewrite !(set_nth_default q); try by rewrite /= -(run_size run) // ltnW. 379 | rewrite {1}[nth]lock (tnth_nth a) /=. rewrite ltnS in Hi. 380 | rewrite -{3}[i]/(nat_of_ord (Ordinal Hi)). 381 | by rewrite -[x]/(tval (in_tuple x)) -tnth_nth -lock IH. 382 | Qed. 383 | 384 | (** The following lemma uses [in_tuple] and [tnth] in order to avoid 385 | having to assume the existence of a default symbol *) 386 | 387 | Lemma runI x s r : 388 | size r = size x -> last s r \in nfa_fin M -> 389 | (forall i : 'I_(size x), 390 | nth s (s::r) i.+1 \in nfa_trans (nth s (s::r) i) (tnth (in_tuple x) i)) -> 391 | nfa_run x s r. 392 | Proof. 393 | elim: x s r => [|a x IHx ] s r /=. 394 | - move/eqP => e inF _. rewrite size_eq0 in e. rewrite (eqP e) in inF *. exact: run0. 395 | - case: r => // p r /eqP /=. rewrite eqSS => /eqP R1 R2 I. 396 | apply: runS (I ord0) _ => /=. apply: IHx => // i. 397 | move: (I (inord i.+1)). rewrite /tnth /= !inordK /= ?ltnS //. 398 | rewrite !(set_nth_default p) /= ?R1 // 1?ltnW ?ltnS //. 399 | by rewrite -[x]/(val (in_tuple x)) -!tnth_nth. 400 | Qed. 401 | 402 | End NFARun. 403 | 404 | (** Decidability of Language Emptiness *) 405 | 406 | Definition nfa_inhab (N : nfa) := dfa_inhab (nfa_to_dfa N). 407 | 408 | Lemma nfa_inhabP N : reflect (exists w, w \in nfa_lang N) (nfa_inhab N). 409 | Proof. 410 | apply: (iffP (dfa_inhabP _)). 411 | - move => [x]. rewrite -nfa_to_dfa_correct. by exists x. 412 | - move => [x ?]. exists x. by rewrite -nfa_to_dfa_correct. 413 | Qed. 414 | 415 | Lemma nfa_regular L : 416 | regular L <-T-> { N : nfa | forall x, L x <-> x \in nfa_lang N }. 417 | Proof. 418 | split => [[A]|[N]] H. 419 | exists (dfa_to_nfa A) => x. by rewrite -dfa_to_nfa_correct. 420 | exists (nfa_to_dfa N) => x. by rewrite -nfa_to_dfa_correct. 421 | Qed. 422 | 423 | End NFA. 424 | 425 | Arguments nfaP {char M x}. 426 | -------------------------------------------------------------------------------- /theories/regexp.v: -------------------------------------------------------------------------------- 1 | (* Authors: Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From HB Require Import structures. 4 | From mathcomp Require Import all_ssreflect. 5 | From RegLang Require Import setoid_leq misc languages dfa nfa. 6 | 7 | Set Default Proof Using "Type". 8 | 9 | Set Implicit Arguments. 10 | Unset Strict Implicit. 11 | Unset Printing Implicit Defensive. 12 | 13 | (** * Regular Expressions 14 | 15 | This file contains the definition of regular expressions and the proof 16 | that regular expressions have the same expressive power as finite 17 | automata. *) 18 | 19 | Section RegExp. 20 | Variable char : eqType. 21 | 22 | Inductive regexp := 23 | | Void 24 | | Eps 25 | | Atom of char 26 | | Star of regexp 27 | | Plus of regexp & regexp 28 | | Conc of regexp & regexp. 29 | 30 | Lemma eq_regexp_dec (e1 e2 : regexp) : {e1 = e2} + {e1 <> e2}. 31 | Proof. decide equality; apply: eq_comparable. Qed. 32 | 33 | HB.instance Definition _ := hasDecEq.Build regexp (compareP eq_regexp_dec). 34 | End RegExp. 35 | 36 | Arguments void : clear implicits. 37 | Arguments eps : clear implicits. 38 | Prenex Implicits Plus. 39 | Arguments plusP {char r s w}. 40 | 41 | Notation "'Void'" := (@Void _). 42 | Notation "'Eps'" := (@Eps _). 43 | 44 | (** We assign a decidable language to every regular expression *) 45 | 46 | Fixpoint re_lang (char: eqType) (e : regexp char) : dlang char := 47 | match e with 48 | | Void => void char 49 | | Eps => eps char 50 | | Atom x => atom x 51 | | Star e1 => star (re_lang e1) 52 | | Plus e1 e2 => plus (re_lang e1) (re_lang e2) 53 | | Conc e1 e2 => conc (re_lang e1) (re_lang e2) 54 | end. 55 | 56 | Canonical Structure regexp_predType (char: eqType) := PredType (@re_lang char). 57 | 58 | (** We instantiate Ssreflects Canonical Big Operators *) 59 | Notation "\sigma_( i <- r ) F" := (\big[Plus/Void]_(i <- r) F) (at level 50). 60 | Notation "\sigma_( i | P ) F" := (\big[Plus/Void]_(i | P) F) (at level 50). 61 | 62 | Lemma big_plus_seqP (T char : eqType) (r : seq T) w (F : T -> regexp char) : 63 | reflect (exists2 x, x \in r & w \in F x) (w \in \sigma_(i <- r) F i). 64 | Proof. 65 | elim: r w => [|r rs IHrs] w. rewrite big_nil; by constructor => [[x]]. 66 | rewrite big_cons; apply: (iffP plusP) => [[H|H]|[x]]. 67 | - exists r => //; by rewrite mem_head. 68 | - case/IHrs : H => x Hx ?. exists x => //. by rewrite in_cons Hx orbT. 69 | - rewrite in_cons; case/orP => [/eqP -> |]; auto => ? ?. 70 | right. apply/IHrs. by exists x. 71 | Qed. 72 | 73 | Lemma big_plusP (T char: finType) (P:pred T) w (F : T -> regexp char) : 74 | reflect (exists2 i, P i & w \in F i) (w \in \sigma_(i | P i) F i). 75 | Proof. 76 | rewrite -big_filter. apply: (iffP (big_plus_seqP _ _ _)) => [[x]|[x] H1 H2]. 77 | - rewrite mem_filter => /andP [? ?]; by exists x. 78 | - by exists x; rewrite // mem_filter H1 mem_index_enum. 79 | Qed. 80 | 81 | Fixpoint re_size (char: eqType) (e : regexp char) := 82 | match e with 83 | | Star s => (re_size s).+1 84 | | Plus s t => ((re_size s)+(re_size t)).+1 85 | | Conc s t => ((re_size s)+(re_size t)).+1 86 | | _ => 1 87 | end. 88 | 89 | Lemma big_plus_size (T char : eqType) (r : seq T) (F : T -> regexp char) m : 90 | (forall i, i \in r -> re_size (F i) <= m) -> re_size (\sigma_(i <- r) F i) <= (size r * m.+1).+1. 91 | Proof. 92 | elim: r => [|e r IH /forall_cons [A B]]; first by rewrite big_nil. 93 | rewrite big_cons /= ltnS mulSn addSn -addnS leq_add //. exact: IH. 94 | Qed. 95 | 96 | (** ** Regular Expressions to Finite Automata *) 97 | Section DFAofRE. 98 | Variable (char : finType). 99 | 100 | Fixpoint re_to_nfa (r : regexp char): nfa char := 101 | match r with 102 | | Void => dfa_to_nfa (dfa_void _) 103 | | Eps => nfa_eps _ 104 | | Atom a => nfa_char a 105 | | Star s => nfa_star (re_to_nfa s) 106 | | Plus s t => nfa_plus (re_to_nfa s) (re_to_nfa t) 107 | | Conc s t => nfa_conc (re_to_nfa s) (re_to_nfa t) 108 | end. 109 | 110 | Lemma re_to_nfa_correct (r : regexp char) : nfa_lang (re_to_nfa r) =i r. 111 | Proof. 112 | elim: r => [||a|s IHs |s IHs t IHt |s IHs t IHt] w //=. 113 | - by rewrite -dfa_to_nfa_correct inE /dfa_accept inE. 114 | - exact: nfa_eps_correct. 115 | - exact: nfa_char_correct. 116 | - rewrite nfa_star_correct. exact: star_eq. 117 | - by rewrite nfa_plus_correct /plus inE IHs IHt. 118 | - rewrite nfa_conc_correct. exact: conc_eq. 119 | Qed. 120 | 121 | Lemma re_to_nfa_size e : #|re_to_nfa e| <= 2 * re_size e. 122 | Proof. 123 | elim: e; rewrite /= ?card_unit ?card_bool => //. 124 | - move => e IH. by rewrite card_option (leqRW IH) mulnS add2n. 125 | - move => e1 IH1 e2 IH2. 126 | by rewrite card_sum (leqRW IH1) (leqRW IH2) mulnS mulnDr add2n ltnW. 127 | - move => e1 IH1 e2 IH2. 128 | by rewrite card_sum (leqRW IH1) (leqRW IH2) mulnS mulnDr add2n ltnW. 129 | Qed. 130 | 131 | Definition re_to_dfa := @nfa_to_dfa _ \o re_to_nfa. 132 | 133 | Lemma re_to_dfa_correct (r : regexp char) : dfa_lang (re_to_dfa r) =i r. 134 | Proof. move => w. by rewrite -nfa_to_dfa_correct re_to_nfa_correct. Qed. 135 | 136 | Lemma re_to_dfa_size e : #|re_to_dfa e| <= 2^(2 * re_size e). 137 | Proof. by rewrite card_set leq_pexp2l // re_to_nfa_size. Qed. 138 | 139 | (** Decidability of regular expression equivalence *) 140 | 141 | Definition re_equiv r s := dfa_equiv (re_to_dfa r) (re_to_dfa s). 142 | 143 | Lemma re_equiv_correct r s : reflect (r =i s) (re_equiv r s). 144 | Proof. 145 | apply: (iffP (dfa_equiv_correct _ _)) => H w; 146 | move/(_ w) : H; by rewrite !re_to_dfa_correct. 147 | Qed. 148 | 149 | End DFAofRE. 150 | 151 | (** ** Finite Automata to Regular Expressions (Kleene Construction) *) 152 | 153 | Section KleeneAlgorithm. 154 | Variable char : finType. 155 | Variable A : dfa char. 156 | 157 | (** We first define the transition languages between states. The 158 | trasition languages are defined such that [w \in L^X q p] iff for 159 | all nonempty strict prefixes [v] of [w], [delta q v \in X]. *) 160 | 161 | Definition L (X : {set A}) (p q : A) x := 162 | (delta p x == q) && [forall (i : 'I_(size x) | 0 < i), delta p (take i x) \in X]. 163 | Notation "'L^' X" := (L X) (at level 8,format "'L^' X"). 164 | 165 | Lemma dfa_L x y w : w \in L^setT x y = (delta x w == y). 166 | Proof. 167 | rewrite unfold_in. case: (_ == _) => //=. 168 | apply/forall_inP => ? ?. by rewrite inE. 169 | Qed. 170 | 171 | Lemma LP {X : {set A}} {p q : A} {x} : 172 | reflect (delta p x = q /\ forall i, (0 < i) -> (i < size x) -> delta p (take i x) \in X) 173 | (x \in L^X p q). 174 | Proof. 175 | apply: (iffP andP); case => /eqP ? H; split => //. 176 | - move => i I1 I2. exact: (forall_inP H (Ordinal I2)). 177 | - apply/forall_inP => [[i I1 /= I2]]; auto. 178 | Qed. 179 | 180 | Lemma L_monotone (X : {set A}) (x y z : A): {subset L^X x y <= L^(z |: X) x y}. 181 | Proof. 182 | move => w. rewrite !unfold_in. case: (_ == _) => //. apply: sub_forall => i /=. 183 | case: (_ < _) => //= H. by rewrite inE H orbT. 184 | Qed. 185 | 186 | Lemma L_nil X x y : reflect (x = y) ([::] \in L^X x y). 187 | Proof. apply: (iffP LP) => //=. by case. Qed. 188 | 189 | Lemma L_set0 p q w : 190 | L^set0 q p w -> p = q /\ w = [::] \/ exists2 a, w = [::a] & p = dfa_trans q a. 191 | Proof. 192 | case/LP => <-. case: w => [|a [|b w]] H ; [by left|by right;exists a|]. 193 | move: (H 1). do 2 case/(_ _)/Wrap => //. by rewrite inE. 194 | Qed. 195 | 196 | Lemma L_split X p q z w : w \in L (z |: X) p q -> 197 | w \in L^X p q \/ 198 | exists w1 w2, [/\ w = w1 ++ w2, size w2 < size w, w1 \in L^X p z & w2 \in L^(z |: X) z q]. 199 | Proof. 200 | case/LP => H1 H2. 201 | case: (find_minn_bound (fun i => (0 < i) && (delta p (take i w) == z)) (size w)). 202 | - case => i [lt_w /andP [i_gt0 /eqP delta_z] min_i]; right. 203 | exists (take i w); exists (drop i w). 204 | have ? : 0 < size w by exact: ltn_trans lt_w. 205 | rewrite cat_take_drop size_drop -{2}[size w]subn0 ltn_sub2l //; split => //. 206 | + apply/LP. split => // j J1 J2. 207 | have lt_i_j : j < i. apply: leq_trans J2 _. by rewrite size_take lt_w. 208 | have/(H2 _ J1) : j < size w. exact: ltn_trans lt_w. 209 | case/setU1P => [H|]; last by rewrite take_takel 1?ltnW. 210 | move: (min_i _ lt_i_j). by rewrite negb_and J1 H eqxx. 211 | + apply/LP. rewrite -H1 -{2}[w](cat_take_drop i) delta_cat delta_z. 212 | split => // j J1 J2. rewrite -{1}delta_z -delta_cat -takeD. 213 | apply: H2; first by rewrite addn_gt0 J1 orbT. 214 | by rewrite -[w](cat_take_drop i) size_cat size_take lt_w ltn_add2l. 215 | - move => H; left. apply/LP. split => // i I1 I2. apply: contraTT (H2 _ I1 I2) => C. 216 | rewrite inE negb_or C inE andbT. apply: contraNN (H _ I2) => ->. by rewrite I1. 217 | Qed. 218 | 219 | Lemma L_cat (X : {set A}) x y z w1 w2 : 220 | z \in X -> w1 \in L^X x z -> w2 \in L^X z y -> w1++w2 \in L^X x y. 221 | Proof. 222 | move => Hz /LP [H11 H12] /LP [H21 H22]. apply/LP. 223 | split; first by rewrite delta_cat H11 H21. 224 | move => i i_gt0 H. rewrite take_cat. case: (boolP (i < _)); first exact: H12. 225 | rewrite delta_cat H11 -leqNgt => le_w1. 226 | case: (posnP (i - size w1)) => [->|Hi]; first by rewrite take0. 227 | apply: H22 => //. by rewrite -(ltn_add2l (size w1)) subnKC // -size_cat. 228 | Qed. 229 | 230 | Lemma L_catL X x y z w1 w2 : 231 | w1 \in L^X x z -> w2 \in L^(z |: X) z y -> w1++w2 \in L^(z |: X) x y. 232 | Proof. move/(L_monotone z). apply: L_cat. exact: setU11. Qed. 233 | 234 | Lemma L_catR X x y z w1 w2 : 235 | w1 \in L^(z |: X) x z -> w2 \in L^X z y -> w1++w2 \in L^(z |: X) x y. 236 | Proof. move => H /(L_monotone z). apply: L_cat H. exact: setU11. Qed. 237 | 238 | Lemma L_star (X : {set A}) z w : w \in star (L^X z z) -> w \in L^(z |: X) z z. 239 | Proof. 240 | move/starP => [vv Hvv ->]. elim: vv Hvv => [_|r vv IHvv]; first exact/L_nil. 241 | move => /= /andP [/andP [_ H1] H2]. exact: L_catL H1 (IHvv H2). 242 | Qed. 243 | 244 | (** Main Lemma - L satisfies a recursive equation that can be used 245 | to construct a regular expression *) 246 | 247 | Lemma L_rec (X : {set A}) x y z : 248 | L^(z |: X) x y =i plus (conc (L^X x z) (conc (star (L^X z z)) (L^X z y))) (L^X x y). 249 | Proof. 250 | move => w. apply/idP/idP. 251 | - move: w x y. apply: (size_induction (measure := size)) => w IHw x y. 252 | move/L_split => [|[w1 [w2 [Hw' H1 Hw1 Hw2]]]]. 253 | + rewrite inE => ->. by rewrite orbT. 254 | + move: (IHw w2 H1 z y Hw2) Hw' => H4 -> {IHw H1}. 255 | rewrite inE (conc_cat Hw1 _) //. 256 | case/plusP : H4 => H; last by rewrite -[w2]cat0s conc_cat //. 257 | move/concP : H => [w21] [w22] [W1 [W2]] /concP [w221] [w222] [W3 [W4 W5]]; subst. 258 | by rewrite catA conc_cat // star_cat. 259 | - case/plusP ; last exact: L_monotone. 260 | move/concP => [w1] [w2] [-> [Hw1]] /concP [w3] [w4] [-> [Hw3 Hw4]]. 261 | by rewrite (L_catL Hw1) // (L_catR _ Hw4) // L_star. 262 | Qed. 263 | 264 | (** Construction of the regular expression *) 265 | 266 | Definition edges (x y : A) := \big[Plus/Void]_(a | dfa_trans x a == y) Atom a. 267 | 268 | Definition edgesP x y w : 269 | reflect (exists2 a, w = [::a] & dfa_trans x a = y) (w \in edges x y). 270 | Proof. apply: (iffP (big_plusP _ _ _)) => [|] [a] /eqP ? /eqP ?; by exists a. Qed. 271 | 272 | Definition R0 x y := Plus (if x == y then Eps else Void) (edges x y). 273 | 274 | Lemma mem_R0 w x y : 275 | reflect (w = [::] /\ x=y \/ exists2 a, w = [::a] & dfa_trans x a = y) 276 | (w \in R0 x y). 277 | Proof. 278 | apply: (iffP plusP). 279 | - case => [| /edgesP]; auto. case e : (x == y) => // /eqP. 280 | by rewrite (eqP e); auto. 281 | - case => [[-> ->]|/edgesP];auto. by rewrite eqxx; auto. 282 | Qed. 283 | 284 | Fixpoint R (X : seq A) (x y : A) := 285 | if X isn't z :: X' then R0 x y else 286 | Plus (Conc (R X' x z) (Conc (Star (R X' z z)) (R X' z y))) (R X' x y). 287 | 288 | Notation "'R^' X" := (R X) (at level 8, format "'R^' X"). 289 | 290 | Lemma L_R (X : seq A) x y : L^[set z in X] x y =i R^X x y. 291 | Proof. 292 | elim: X x y => [|z X' IH] x y w. 293 | - rewrite (_ : [set z in [::]] = set0) //=. 294 | apply/idP/mem_R0. 295 | + move/L_set0 => [[-> ->]|[a -> ->]]; by eauto. 296 | + move => [[-> ->]|[a -> <-]]; apply/LP => /=; split => // [[|i]] //. 297 | - rewrite set_cons /= (L_rec _ _) -2!topredE /= /plus /= IH. 298 | f_equal. 299 | apply: conc_eq; first exact: IH. 300 | apply: conc_eq; last exact: IH. 301 | apply: star_eq. exact: IH. 302 | Qed. 303 | 304 | Definition dfa_to_re : regexp char := \sigma_(x | x \in dfa_fin A) R^(enum A) (dfa_s A) x. 305 | 306 | Lemma dfa_to_re_correct : dfa_lang A =i dfa_to_re. 307 | Proof. 308 | move => w. apply/idP/big_plusP => [H|[x Hx]]. 309 | - exists (delta_s A w) => //. by rewrite -L_R set_enum dfa_L. 310 | - by rewrite -L_R set_enum dfa_L inE /dfa_accept => /eqP ->. 311 | Qed. 312 | 313 | (** ** Size Bound for Kleene Theorem *) 314 | 315 | Let c := (2 * #|char|).+3. 316 | 317 | Lemma R0_size x y : re_size (R0 x y) <= c. 318 | Proof. 319 | rewrite /= [X in X + _](_ : _ = 1); last by case (_ == _). 320 | rewrite add1n !ltnS. rewrite /edges -big_filter. 321 | apply: leq_trans (big_plus_size (m := 1) _) _ => [//|]. 322 | rewrite size_filter ltnS mulnC leq_mul2l /=. 323 | apply: leq_trans (count_size _ _) _. by rewrite /index_enum -enumT cardE. 324 | Qed. 325 | 326 | Fixpoint R_size_rec (n : nat) := if n is n'.+1 then 4 * R_size_rec n' + 4 else c. 327 | 328 | Lemma R_size x : re_size (R^(enum A) (dfa_s A) x) <= R_size_rec #|A| . 329 | Proof. 330 | rewrite cardE. elim: (enum A) (dfa_s A) x => [|r s IH] p q. 331 | - exact: R0_size. 332 | - rewrite /= 6!(addSn,addnS) addn4 !ltnS !(leqRW (IH _ _)). 333 | by rewrite !mulSn mul0n addn0 !addnA. 334 | Qed. 335 | 336 | Lemma R_size_low (n : nat) : 3 <= R_size_rec n. 337 | Proof. elim: n => // n IH. by rewrite (leqRW IH) /= -(leqRW (leq_addr _ _)) leq_pmull. Qed. 338 | 339 | Lemma R_size_high n : R_size_rec n <= c * 4^(2 * n). 340 | Proof. 341 | elim: n => //= [|n IH]. 342 | - by rewrite mulnS muln0 addn0. 343 | - rewrite [in X in _^X]mulnS expnD mulnA [c * _]mulnC -mulnA. 344 | rewrite -(leqRW IH) -[4^2]/((1+3) * 4) -mulnA mulnDl mul1n leq_add //. 345 | by rewrite -(leqRW (R_size_low _)). 346 | Qed. 347 | 348 | Lemma dfa_to_re_size : re_size dfa_to_re <= (#|A| * (c * 4 ^ (2 * #|A|)).+1).+1. 349 | Proof. 350 | rewrite /dfa_to_re -big_filter (leqRW (big_plus_size (m := R_size_rec #|A|)_)). 351 | - rewrite -(leqRW (R_size_high _)) size_filter (leqRW (count_size _ _)). 352 | by rewrite ltnS /index_enum -enumT cardE. 353 | - move => q _. exact: R_size. 354 | Qed. 355 | 356 | End KleeneAlgorithm. 357 | 358 | Lemma regularP (char : finType) (L : lang char) : 359 | regular L <-T-> { e : regexp char | forall x, L x <-> x \in e}. 360 | Proof. 361 | split => [[A HA]|[e He]]. 362 | - exists (dfa_to_re A) => x. by rewrite -dfa_to_re_correct. 363 | - exists (re_to_dfa e) => x. by rewrite re_to_dfa_correct. 364 | Qed. 365 | 366 | (** Closure of Regular Expressions under intersection and complement *) 367 | 368 | Definition Inter (char : finType) (r s : regexp char) := 369 | dfa_to_re (dfa_op andb (re_to_dfa r) (re_to_dfa s)). 370 | 371 | Lemma Inter_correct (char : finType) (r s : regexp char) w : 372 | w \in Inter r s = (w \in r) && (w \in s). 373 | Proof. by rewrite /Inter -dfa_to_re_correct dfa_op_correct !re_to_dfa_correct. Qed. 374 | 375 | Definition Neg (char : finType) (r : regexp char) := 376 | dfa_to_re (dfa_compl (re_to_dfa r)). 377 | 378 | Lemma Neg_correct (char : finType) (r : regexp char) w : 379 | w \in Neg r = (w \notin r). 380 | Proof. by rewrite /Neg -dfa_to_re_correct dfa_compl_correct !re_to_dfa_correct. Qed. 381 | 382 | (** ** Regular expression for images of homomorphimsms *) 383 | 384 | Prenex Implicits Conc. 385 | Definition String (char : finType) (w : word char) := 386 | foldr Conc Eps [seq Atom a | a <- w]. 387 | 388 | Lemma StringE (char : finType) (w : word char) : String w =i pred1 w. 389 | Proof. 390 | elim: w => [|a v IHv] w //=. rewrite inE /String /=. apply/concP/eqP. 391 | - move => [w1] [w2] [e []]. set r := foldr _ _ _. 392 | rewrite -/(re_lang r) inE e => /eqP -> H /=. 393 | rewrite IHv inE in H. by rewrite (eqP H). 394 | - move => e. exists [:: a]; exists v; split => //; split. 395 | by rewrite inE. by rewrite IHv inE eqxx. 396 | Qed. 397 | 398 | Section Image. 399 | Variables (char char' : finType) (h : seq char -> seq char'). 400 | Hypothesis h_hom : homomorphism h. 401 | 402 | Fixpoint re_image (e : regexp char) : regexp char' := 403 | match e with 404 | | Void => Void 405 | | Eps => Eps 406 | | Atom a => String (h [:: a]) 407 | | Star e => Star (re_image e) 408 | | Plus e1 e2 => Plus (re_image e1) (re_image e2) 409 | | Conc e1 e2 => Conc (re_image e1) (re_image e2) 410 | end. 411 | 412 | Lemma re_imageP e v : reflect (image h (re_lang e) v) (v \in re_image e). 413 | Proof using h_hom. 414 | elim: e v => [||a|e IHe|e1 IHe1 e2 IHe2|e1 IHe1 e2 IHe2] v /=. 415 | - rewrite inE; constructor. move => [u]. by case. 416 | - rewrite inE; apply: (iffP eqP) => [-> |[w] [] /eqP -> <-]; last exact: h0. 417 | exists [::]; by rewrite ?h0. 418 | - rewrite StringE. apply: (iffP eqP) => [->|[w /=]]. 419 | + exists [::a] => //. by rewrite /atom inE. 420 | + by rewrite /atom inE => [[]] /eqP -> <-. 421 | - apply: (iffP idP) => [/starP [vv] /allP Hvv dev_v|]. 422 | have {IHe} Hvv v' : v' \in vv -> image h (re_lang e) v'. 423 | by move => /Hvv /= /andP [_ /IHe]. 424 | subst v. elim: vv Hvv => [|v vv IHvv] Hvv /=; first by exists [::]; rewrite ?h0. 425 | case: (Hvv v (mem_head _ _)) => w [Hw1 Hw2]. 426 | case/forall_cons: Hvv => Hv /IHvv [ww [Hww1 Hww2]]. 427 | exists (w++ww); split; by [exact: star_cat | rewrite h_hom Hw2 Hww2]. 428 | + case => w [] /starP [ww] /allP Hww1 -> <-. rewrite h_flatten //. 429 | apply: starI => v' /mapP [w' /Hww1 /= /andP [_ Hw' ->]]. 430 | apply/IHe. by exists w'. 431 | - apply: (iffP orP). 432 | + case => [/IHe1 | /IHe2] [w] [] H <-. 433 | exists w => //. by rewrite /plus inE (_ : w \in re_lang e1). 434 | exists w => //. by rewrite /plus inE (_ : w \in re_lang e2) ?orbT. 435 | + case => w []. case/orP => H <-; [left; apply/IHe1 |right; apply/IHe2]; by exists w. 436 | - apply: (iffP idP). 437 | + case/concP => v1 [v2] [e] [/IHe1 [w [Hw1 Hw2]] /IHe2 [w' [Hw1' Hw2']]]. 438 | exists (w++w'); split; first exact: conc_cat. 439 | by rewrite h_hom e Hw2 Hw2'. 440 | + case => w [] /concP [w1] [w2] [-> [H1 H2 <-]]. rewrite h_hom. 441 | apply: conc_cat; [apply/IHe1|apply/IHe2]. by exists w1. by exists w2. 442 | Qed. 443 | 444 | End Image. 445 | 446 | Lemma im_regular (char char' : finType) (h : word char -> word char') L : 447 | homomorphism h -> regular L -> regular (image h L). 448 | Proof. 449 | move => hom_h /regularP [e He]. apply/regularP. exists (@re_image _ _ h e) => w. 450 | transitivity (image h (re_lang e) w); first exact: image_ext. 451 | exact: rwP (re_imageP _ _ _). 452 | Qed. 453 | 454 | 455 | (** ** Regular Expression for word reversal *) 456 | 457 | Fixpoint Rev (char : finType) (e : regexp char) := 458 | match e with 459 | | Star e => Star (Rev e) 460 | | Plus e1 e2 => Plus (Rev e1) (Rev e2) 461 | | Conc e1 e2 => Conc (Rev e2) (Rev e1) 462 | | _ => e 463 | end. 464 | 465 | Lemma Rev_correct (char : finType) (e : regexp char) w : 466 | w \in Rev e = (rev w \in e). 467 | Proof. 468 | elim: e w => [||a|e IH|e1 IH1 e2 IH2|e1 IH1 e2 IH2] w //. 469 | - rewrite !inE. apply/eqP/idP; first by move->. 470 | elim/last_ind: w => //= s a _. by rewrite rev_rcons. 471 | - rewrite !inE. apply/eqP/eqP; first by move->. 472 | do 2 elim/last_ind: w => //= w ? _. by rewrite !rev_rcons. 473 | - rewrite /=; apply/idP/idP; case/starP => vv /allP /= H. 474 | + move->. rewrite rev_flatten. apply: starI => v'. 475 | rewrite mem_rev => /mapP [v V1 ->]. rewrite -IH. by case/andP: (H _ V1). 476 | + rewrite -{2}[w]revK => ->. rewrite rev_flatten. apply: starI => v'. 477 | rewrite mem_rev => /mapP [v V1 ->]. rewrite IH revK. by case/andP: (H _ V1). 478 | - by rewrite /= !inE -!/(re_lang _) IH1 IH2. 479 | - rewrite /=. apply/concP/concP => [] [w1] [w2]; rewrite -!/(re_lang _). 480 | + move => [-> [A B]]. exists (rev w2), (rev w1). by rewrite rev_cat -IH1 -IH2. 481 | + rewrite -{2}[w]revK. move => [-> [A B]]. exists (rev w2), (rev w1). 482 | by rewrite rev_cat IH1 IH2 !revK. 483 | Qed. 484 | 485 | Lemma regular_rev (char : finType) (L : lang char) : 486 | regular L -> regular (fun x => L (rev x)). 487 | Proof. case/regularP => e H. apply/regularP. exists (Rev e) => x. by rewrite Rev_correct. Qed. 488 | 489 | (** ** Derivative of a regular expression *) 490 | 491 | Fixpoint has_eps (char : eqType) (e : regexp char) := 492 | match e with 493 | | Void => false 494 | | Eps => true 495 | | Atom x => false 496 | | Star e1 => true 497 | | Plus e1 e2 => has_eps e1 || has_eps e2 498 | | Conc e1 e2 => has_eps e1 && has_eps e2 499 | end. 500 | 501 | Lemma has_epsE (char : eqType) (e : regexp char) : 502 | has_eps e = ([::] \in e). 503 | Proof. 504 | elim: e => //= [r hc1 c2 hc2|r hc1 c2 hc2]; first by rewrite hc1 hc2. 505 | rewrite hc1 hc2 => //. rewrite -[xx in _ = xx] topredE /=. 506 | by apply/idP/existsP; [exists ord0| case]. 507 | Qed. 508 | 509 | Fixpoint der (char: eqType) x (e : regexp char) := 510 | match e with 511 | | Void => Void 512 | | Eps => Void 513 | | Atom y => if x == y then Eps else Void 514 | | Star e1 => Conc (der x e1) (Star e1) 515 | | Plus e1 e2 => Plus (der x e1) (der x e2) 516 | | Conc e1 e2 => if has_eps e1 517 | then Plus (Conc (der x e1) e2) (der x e2) 518 | else Conc (der x e1) e2 519 | end. 520 | 521 | Lemma derE (char : eqType) (x : char) (e : regexp char) : 522 | der x e =i residual x (mem e). 523 | Proof. 524 | elim: e => //= [y|e IHe|e1 IHe1 e2 IHe2|e1 IHe1 e2 IHe2] u. 525 | - by rewrite 2!fun_if /=. 526 | - by apply/concP/concP=> [] [v e_v]; exists v; rewrite // IHe in e_v *. 527 | - by rewrite !inE IHe1 IHe2. 528 | - case he: (has_eps e1). 529 | + apply/orP/concP=> [[] | [[|y v]]] /=; rewrite -/re_lang. 530 | * move/concP=> [w1 [w2 uw]]. 531 | move: uw; rewrite IHe1 in_residual; move => [uw [w1e w2e]]. 532 | by exists (x :: w1), w2; rewrite uw. 533 | * move => hu. exists [::]. rewrite -has_epsE. 534 | exists (x::u) => //. by rewrite -in_residual -IHe2. 535 | * case=> w [def_w [_ e2w]]; right. 536 | by rewrite IHe2 !inE def_w. 537 | * case=> w [[xy uvw] [e1w e2w]]; left; apply/concP. 538 | by exists v, w; rewrite IHe1 xy in_residual. 539 | + apply/concP/concP => [[v] | ] /=; rewrite -/re_lang. 540 | case=> w [uw [e1w e2w]]. 541 | by exists (x :: v), w; rewrite uw -in_residual -IHe1. 542 | + case; case => [|y v]; case => /= w [hv [he1 he2]]. 543 | by move: he; rewrite has_epsE he1. 544 | move/eqP: hv. 545 | rewrite eqseq_cons. case/andP. 546 | move/eqP => hx. move/eqP => hu. exists v. 547 | by rewrite IHe1 in_residual hx; exists w. 548 | Qed. 549 | 550 | Fixpoint mem_der (char : eqType) (e : regexp char) w := 551 | if w is x :: v then mem_der (der x e) v else has_eps e. 552 | 553 | Lemma mem_derE (char : eqType) w (e : regexp char) : 554 | mem_der e w = (w \in e). 555 | Proof. by elim: w e => [|x w IHu] e /=; rewrite ?has_epsE // IHu derE. Qed. 556 | -------------------------------------------------------------------------------- /theories/setoid_leq.v: -------------------------------------------------------------------------------- 1 | (* Author: Christian Doczkal *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | 4 | From Coq Require Import Basics Setoid Morphisms BinPos. 5 | From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat. 6 | 7 | Set Implicit Arguments. 8 | Unset Strict Implicit. 9 | Unset Printing Implicit Defensive. 10 | 11 | (** ** Setoid Rewriting with Ssreflect's boolean inequalities. *) 12 | (** Solution suggested by Georges Gonthier (ssreflect mailinglist @ 18.12.2016) *) 13 | 14 | (** Preorder and Instances for bool *) 15 | 16 | Inductive leb a b := Leb of (a ==> b). 17 | 18 | Lemma leb_eq a b : leb a b <-> (a -> b). 19 | Proof. move: a b => [|] [|]; firstorder. Qed. 20 | 21 | #[export] Instance: PreOrder leb. 22 | Proof. split => [[|]|[|][|][|][?][?]]; try exact: Leb. Qed. 23 | 24 | #[export] Instance: Proper (leb ==> leb ==> leb) andb. 25 | Proof. move => [|] [|] [A] c d [B]; exact: Leb. Qed. 26 | 27 | #[export] Instance: Proper (leb ==> leb ==> leb) orb. 28 | Proof. move => [|] [|] [A] [|] d [B]; exact: Leb. Qed. 29 | 30 | #[export] Instance: Proper (leb ==> impl) is_true. 31 | Proof. move => a b []. exact: implyP. Qed. 32 | 33 | (** Instances for le *) 34 | 35 | #[export] Instance: Proper (le --> le ++> leb) leq. 36 | Proof. move => n m /leP ? n' m' /leP ?. apply/leb_eq => ?. eauto using leq_trans. Qed. 37 | 38 | #[export] Instance: Proper (le ==> le ==> le) addn. 39 | Proof. move => n m /leP ? n' m' /leP ?. apply/leP. exact: leq_add. Qed. 40 | 41 | #[export] Instance: Proper (le ==> le ==> le) muln. 42 | Proof. move => n m /leP ? n' m' /leP ?. apply/leP. exact: leq_mul. Qed. 43 | 44 | #[export] Instance: Proper (le ++> le --> le) subn. 45 | Proof. move => n m /leP ? n' m' /leP ?. apply/leP. exact: leq_sub. Qed. 46 | 47 | #[export] Instance: Proper (le ==> le) S. 48 | Proof. move => n m /leP ?. apply/leP. by rewrite ltnS. Qed. 49 | 50 | #[export] Instance: RewriteRelation le := Build_RewriteRelation _. 51 | 52 | (** Wrapper Lemma to trigger setoid rewrite *) 53 | Definition leqRW m n : m <= n -> le m n := leP. 54 | 55 | (** Testing *) 56 | 57 | Lemma T1 : forall x y, x <= y -> x + 1 <= y + 1. 58 | Proof. move => x y h. by rewrite (leqRW h). Qed. 59 | 60 | Lemma T2 : forall x y, x <= y -> (x + 1 <= y + 1) && true. 61 | Proof. move => x y h. by rewrite (leqRW h) andbT. Qed. 62 | -------------------------------------------------------------------------------- /theories/shepherdson.v: -------------------------------------------------------------------------------- 1 | (* Author: Christian Doczkal *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From Coq Require Import Lia. 4 | From mathcomp Require Import all_ssreflect. 5 | From RegLang Require Import misc setoid_leq languages dfa myhill_nerode two_way. 6 | 7 | Set Default Proof Using "Type". 8 | 9 | Set Implicit Arguments. 10 | Unset Strict Implicit. 11 | Unset Printing Implicit Defensive. 12 | 13 | (** ** Shepherdson Construction for 2NFAs *) 14 | 15 | (** Preliminaries *) 16 | 17 | Lemma contraN (b : bool) (P : Prop) : b -> ~~ b -> P. Proof. by case b. Qed. 18 | 19 | Lemma inord_inj n m : n <= m -> injective (@inord m \o @nat_of_ord n.+1). 20 | Proof. 21 | move => Hnm k k' /= /(f_equal (@nat_of_ord _)) E. apply/ord_inj. 22 | rewrite !inordK // in E; exact: leq_trans (ltn_ord _) _. 23 | Qed. 24 | 25 | (** Lemmas for character lookups on composite words *) 26 | 27 | Lemma tnthL (T:eqType) (x z : seq T) (i : 'I_(size x)) (j : 'I_(size (x++z))) : 28 | i = j :> nat -> tnth (in_tuple x) i = tnth (in_tuple (x++z)) j. 29 | Proof. 30 | move => e. pose a := tnth (in_tuple x) i. 31 | by rewrite !(tnth_nth a) /= -e nth_cat ltn_ord. 32 | Qed. 33 | 34 | Lemma tnthR (T:eqType) (x z : seq T) (i : 'I_(size z)) (j : 'I_(size (x++z))) : 35 | size x + i = j -> tnth (in_tuple z) i = tnth (in_tuple (x++z)) j. 36 | Proof. 37 | move => e. pose a := tnth (in_tuple z) i. 38 | by rewrite !(tnth_nth a) /= -e nth_cat ltnNge leq_addr /= addKn. 39 | Qed. 40 | 41 | (** Wrapper for [lia] that uses ssreflects operators on [nat] *) 42 | 43 | Ltac norm := rewrite ?(size_cat,cats0); simpl in *. 44 | Ltac normH := match goal with [ H : is_true (_ <= _) |- _] => move/leP : H end. 45 | Ltac ssrlia := 46 | try (try (apply/andP; split); apply/leP; repeat normH; norm ; rewrite ?addnE /addn_rec ; intros; lia). 47 | 48 | Section NFA2toAFA. 49 | 50 | Variables (char : finType) (M : nfa2 char). 51 | Implicit Types (x y z w v : word char). 52 | 53 | (** We fix some 2NFA [M]. Instead of directly defining a DFA for [M], we 54 | instantiate the construction of DFAs from classifiers. This means that we have 55 | to give a finite type [Q] and define a function [T : word char -> Q] which is 56 | right congruent and refines the language of [M]. We take [Q] to be the type of 57 | tables or black-box results for [M]. *) 58 | 59 | Definition table := ({set M} * {set M * M})%type. 60 | 61 | (** We define the mapping from [word char] to [table] using a restriction of the 62 | step relation. The stop relation [srel k x] behaves like [step x] except that 63 | it does not continue if the head is at position [k]. *) 64 | 65 | Definition srel (k:nat) x (c d : nfa2_config M x) := (step M x c d) && (k != c.2). 66 | Arguments srel : clear implicits. 67 | 68 | Lemma srel_step k w : subrel (srel k w) (step M w). 69 | Proof. by move => c d /= => /andP[->]. Qed. 70 | 71 | Lemma srel_step_max x : srel (size x).+2 x =2 step M x. 72 | Proof. move => c d /=. by rewrite /srel neq_ltn ltn_ord orbT andbT. Qed. 73 | 74 | Definition Tab x : table := 75 | ([set q | connect (srel (size x).+1 x) (nfa2_s M, ord1) (q,ord_max)], 76 | [set pq | connect (srel (size x).+1 x) (pq.1,inord (size x)) (pq.2,ord_max)]). 77 | 78 | (** To show that [Tab] is right-congruent and refines the language of [M], we 79 | need to make use of the fact that [M] moves its head only one step at a 80 | time. In particular, this allows us to split runs starting with head position 81 | [i] and ending at head position [j] at any position [k] in beteen. *) 82 | 83 | Lemma srelLR k x p i q j : srel k x (p,i) (q,j) -> 84 | j.+1 = i :> nat \/ j = i.+1 :> nat. 85 | Proof. case/srel_step/orP => /andP [_ /eqP ->]; tauto. Qed. 86 | 87 | Lemma srel1 k x c d : srel k x c d -> d.2 <= c.2.+1. 88 | Proof. move: c d => [p i] [q j] /srelLR [<-|->] //=. by ssrlia. Qed. 89 | 90 | Lemma srelSr k' k x (c d : nfa2_config M x) : c.2 < k -> 91 | srel k x c d = srel (k+k') x c d. 92 | Proof. move => lt_k. by rewrite /srel !neq_ltn ltn_addr lt_k ?orbT. Qed. 93 | 94 | Lemma srelS k x p q (i j : pos x) m : i <= k -> 95 | connect (srel k x) (p,i) (q,j) -> connect (srel (k+m) x) (p,i) (q,j). 96 | Proof. 97 | move => H /connectP [cs]. 98 | elim: cs p i H => [/= p i H _ [-> ->] //|[p' i'] cs IH p i H /= /andP [s pth] l]. 99 | have Hk: i < k. case/andP : s => _ /= s. by rewrite ltn_neqAle H eq_sym s. 100 | apply: (connect_trans (y := (p',i'))) (connect1 _) _; first by rewrite -srelSr. 101 | apply: IH => //. move/srel1 : s Hk => /= s. exact: leq_trans. 102 | Qed. 103 | 104 | Lemma srel_mid_path (k k' : nat) x (i j : pos x) (p q : M) cs : 105 | i <= k <= j -> path (srel k' x) (p,i) cs -> (q,j) = last (p,i) cs -> 106 | exists p' cl cr, [/\ cs = cl ++ cr, (p',inord k) = last (p,i) cl & path (srel k x) (p,i) cl]. 107 | Proof. 108 | move: cs p i. apply: (size_induction (measure := size)) => cs IH p i /andP [H1 H2]. 109 | case: (boolP (i == k :> nat)) => Ei. 110 | - exists p, [::], cs. by rewrite -[i]inord_val (eqP Ei). 111 | - destruct cs as [|c cs] => [_ /= [_ E]|/= /andP [s p1] p2]; subst. 112 | + by rewrite eqn_leq H1 H2 in Ei. 113 | + have Hi: i < k by rewrite ltn_neqAle Ei H1. 114 | have mid: c.2 <= k <= j by rewrite (leq_trans (srel1 s)). 115 | case: (IH cs _ c.1 _ mid) ; rewrite -?surjective_pairing //. 116 | move => p' [cl] [cr] [C1 C2 C3]. exists p', (c::cl), cr. 117 | rewrite /= -C1 C3 andbT. split => //. rewrite /srel /= eq_sym Ei andbT. 118 | exact: srel_step s. 119 | Qed. 120 | 121 | Lemma srel_mid (k k' : nat) x (i j : pos x) (p q : M) : i <= k <= j -> k <= k' -> 122 | reflect (exists2 p', connect (srel k x) (p,i) (p',inord k) & connect (srel k' x) (p',inord k) (q,j)) 123 | (connect (srel k' x) (p,i) (q,j)). 124 | Proof. 125 | move => H X. apply: (iffP idP). 126 | - case/connectP => cs c1 c2. case: (srel_mid_path H c1 c2) => [p'] [cl] [cr] [Ecs L C]. 127 | subst cs. rewrite cat_path last_cat -L in c1 c2. case/andP : c1 => ? c1. exists p'. 128 | + apply/connectP. by exists cl. 129 | + apply/connectP. by exists cr. 130 | - case/andP: H => H1 H2 [p']. move/(srelS (k'-k) H1). rewrite subnKC //. exact: connect_trans. 131 | Qed. 132 | 133 | Lemma readL x z (p:M) (k : pos x) : k != (size x).+1 :> nat -> 134 | read p (inord k : pos (x++z)) = read p k. 135 | Proof. 136 | move => Hk. rewrite /read. case: (ord2P k) => [/eqP->|E|i Hi]. 137 | - by rewrite /= -inord0 ord2P0. 138 | - apply: contraN Hk. by rewrite (eqP E). 139 | - have oi : i < size (x++z) by rewrite size_cat ltn_addr. 140 | have H_eq: (Ordinal oi).+1 = (inord k : pos (x++z)). by rewrite -Hi inordK // ; ssrlia. 141 | by rewrite (ord2PC H_eq) -(tnthL (i := i)). 142 | Qed. 143 | 144 | Section CompositeWord. 145 | Variables (x z : word char). 146 | 147 | (** We first show that runs on [x] that do not cross the boundary between 148 | [x] and [z] do not depend on [z]. *) 149 | 150 | Lemma srelL (i j : pos x) p q : 151 | srel (size x).+1 x (p,i) (q,j) = srel (size x).+1 (x++z) (p,inord i) (q,inord j). 152 | Proof. 153 | case: (boolP (i == (size x).+1 :> nat)) => Hi. 154 | - rewrite /srel (eqP Hi) /= inordK ?eqxx //= ?andbF //; ssrlia. 155 | - have Hi' : i < (size x).+1. by rewrite ltn_neqAle Hi -ltnS ltn_ord. 156 | rewrite /srel /step readL // !inordK //; ssrlia. 157 | move: (ltn_ord j) => ?. ssrlia. 158 | Qed. 159 | 160 | Lemma runL (i j : pos x) p q : 161 | connect (srel (size x).+1 x) (p,i) (q,j) = 162 | connect (srel (size x).+1 (x++z)) (p,inord i) (q,inord j). 163 | Proof. 164 | pose f (c : nfa2_config M x) : nfa2_config M (x ++ z) := (c.1, inord c.2). 165 | rewrite -[(p,inord i)]/(f (p,i)) -[(q,inord j)]/(f (q,j)). 166 | apply: connect_transfer => //. 167 | - move => {p q i j} [p i] [q j] /= [->] /inord_inj. 168 | case/(_ _)/Wrap => [|->//]. ssrlia. 169 | - move => [? ?] [? ?]. rewrite /f /=. exact: srelL. 170 | - move => {p q i j} [p i] [q j] step. exists (q,inord j). 171 | rewrite /f /= inordK ?inord_val //. move: (srel1 step) => /= Hs. 172 | case/andP : step => /= _ Hi. rewrite (leqRW Hs) ltn_neqAle eq_sym Hi /=. 173 | by rewrite inordK ltnS ?leq_ord // (leqRW (leq_ord i)) ltnS size_cat leq_addr. 174 | Qed. 175 | 176 | (** This entails, that the behaviour of [M] starting from the endpoints of 177 | [x] is also independent of [z]. Note that the direction from right to left 178 | makes use of lemma [term_uniq] *) 179 | 180 | Lemma Tab1P q : q \in (Tab x).1 181 | <-> connect (srel (size x).+1 (x++z)) (nfa2_s M,ord1) (q,inord (size x).+1). 182 | Proof. by rewrite /Tab inE runL /= -[ord1]inord_val. Qed. 183 | 184 | Lemma Tab2P p q : (p,q) \in (Tab x).2 185 | <-> connect (srel (size x).+1 (x++z)) (p,inord (size x)) (q,inord (size x).+1). 186 | Proof. by rewrite inE runL /= inordK. Qed. 187 | 188 | (** Dually, steps on the right of [x++z] do not depend on [x], if they do not 189 | cross the boundary between [x] and [z]. *) 190 | 191 | Lemma readR (q:M) k : k != 0 -> k < (size z).+2 -> 192 | read q (inord k : pos z) = read q (inord (size x + k) : pos (x++z)). 193 | Proof. 194 | move => Hk0 Hk. rewrite /read. case: (ord2P _) => [H|H|i Hi]. 195 | - apply: contraN Hk0. 196 | move/eqP/(f_equal (@nat_of_ord _)) : H => /=. by rewrite inordK // => ->. 197 | - by rewrite -[k](@inordK (size z).+1) ?(eqP H) //= addnS -size_cat -inord_max ord2PM. 198 | - have Hi' : size x + i < size (x ++ z) by rewrite size_cat ltn_add2l. 199 | have X: (Ordinal Hi').+1 = (inord (size x + k) : pos (x ++ z)). 200 | by rewrite /= -addnS Hi !inordK //; ssrlia. 201 | by rewrite (ord2PC X) -(tnthR (i := i)). 202 | Qed. 203 | 204 | Lemma srelR (m k k' : nat) p p' : k != 0 -> k < (size z).+2 -> k' < (size z).+2 -> 205 | srel ((size x).+1 + m) (x++z) (p,inord (size x + k)) (p',inord (size x + k')) 206 | = srel m.+1 z (p,inord k) (p',inord k'). 207 | Proof. 208 | move => Hk0 Hk Hk'. rewrite /srel /= !inordK ?addSnnS ?eqn_add2l //; ssrlia. 209 | case: (_ != _); rewrite ?andbT ?andbF // /step -?readR //. 210 | rewrite !inordK //; ssrlia. by rewrite -!addnS !eqn_add2l. 211 | Qed. 212 | 213 | Lemma srelRE m k p c : k < (size z).+2 -> k != 0 -> 214 | srel m (x++z) (p,inord (size x + k)) c -> 215 | exists q k', k' < (size z).+2 /\ c = (q,inord (size x + k')). 216 | Proof. 217 | move: k c => [//|k] [q j] Hk _ /srelLR [/eqP C|/eqP C]; 218 | exists q; rewrite inordK addnS ?eqSS in C; ssrlia. 219 | - exists k. by rewrite ltnW // -[j]inord_val (eqP C). 220 | - exists k.+2. rewrite !addnS -[j]inord_val (eqP C). split => //. 221 | rewrite eqn_leq in C. case/andP : C => _ C. 222 | move: (leq_ltn_trans C (ltn_ord j)). 223 | by rewrite size_cat -!addnS leq_add2l. 224 | Qed. 225 | 226 | End CompositeWord. 227 | 228 | (** The main lemma used both in the proof of right-congruence and language 229 | refinement states that as long as the black-box results for [x] and [y] 230 | agreee, runs starting and ending on the right of composite words [x++z] and 231 | [y++z] behave the same even if they cross the boundaries. *) 232 | 233 | Lemma runR x y z p q (i j: nat) k : 234 | Tab x = Tab y -> i <= (size z).+1 -> 0 < j <= (size z).+1 -> 235 | connect (srel ((size x).+1 + k) (x++z)) (p,inord (size x + i)) (q,inord (size x + j)) -> 236 | connect (srel ((size y).+1 + k) (y++z)) (p,inord (size y + i)) (q,inord (size y + j)). 237 | Proof. 238 | move => Tab_eq Hi /andP [Hj0 Hj]. case/connectP => cs. move: cs i Hi p. 239 | apply: (size_induction (measure := size)) => /= cs IH i Hi p. 240 | case: (boolP (i == 0)) => Hi0. 241 | - rewrite (eqP Hi0) !addn0 => p1 p2. 242 | case: (srel_mid_path (k := (size x).+1) _ p1 p2); try solve [rewrite inordI; ssrlia]. 243 | apply/andP; split; rewrite !inordK; ssrlia. move => p' [cl] [cr] [Ecs Lcl Pcl]. 244 | apply/(@srel_mid (size y).+1) ; try solve [rewrite !inordK; ssrlia|rewrite -addn1; ssrlia]. 245 | + exists p'. apply/Tab2P. rewrite -Tab_eq. apply/Tab2P. by apply/connectP; exists cl. 246 | + subst cs. rewrite -[_.+1 as X in inord X]addn1. 247 | apply: (IH cr) => {IH} //; ssrlia. 248 | * destruct cl as [|c cs]; simpl in *. case: Lcl => _. 249 | -- move/(f_equal (@nat_of_ord _)); rewrite ?inordK; intros; ssrlia. 250 | -- by rewrite[size (cs ++ cr)]size_cat -addnS leq_addl. 251 | * rewrite cat_path -Lcl addn1 in p1 *. by case/andP : p1. 252 | * by rewrite p2 last_cat -Lcl addn1. 253 | - destruct cs as [|c cs]; simpl in *. 254 | + move => _ [-> /(f_equal (@nat_of_ord _))/eqP]. 255 | rewrite !inordK ?eqn_add2l ?size_cat -?addnS ?leq_add2l // => /eqP ->. 256 | exact: connect0. 257 | + case/andP => P1 P2 L. case/srelRE: (P1) => // p' [ip] [Hip ?]; subst. 258 | rewrite srelR // -(@srelR y z) // in P1. apply: connect_trans (connect1 P1) _. 259 | exact: (IH cs). 260 | Qed. 261 | 262 | (** Variant of the lemma above, that generales equality subgoals *) 263 | Lemma runR_eq x y z p q (i j: nat) k xk xi xj yk yi yj : 264 | Tab x = Tab y -> i <= (size z).+1 -> 0 < j <= (size z).+1 -> 265 | xk = (size x).+1 + k -> xi = size x + i -> xj = size x + j -> 266 | yk = (size y).+1 + k -> yi = size y + i -> yj = size y + j -> 267 | connect (srel xk (x++z)) (p,inord xi) (q,inord xj) -> 268 | connect (srel yk (y++z)) (p,inord yi) (q,inord yj). 269 | Proof. move => ? ? ? ? ? ? ? ? ?. subst. exact: runR. Qed. 270 | 271 | Lemma Tab_refines : refines (nfa2_lang M) Tab. 272 | Proof. 273 | move => x y E. 274 | wlog suff W: x y E / (x \in nfa2_lang M) -> (y \in nfa2_lang M). 275 | { by apply/idP/idP; exact: W. } 276 | case/exists_inP => f Hq1 Hq2. apply/exists_inP; exists f => //. move: Hq2. 277 | rewrite -[x]cats0 -[y]cats0 -!(eq_connect (@srel_step_max _)). 278 | case/(@srel_mid (size x).+1); ssrlia => q /Tab1P q1 q2. 279 | apply/(@srel_mid (size y).+1); ssrlia. 280 | - exists q. apply/Tab1P. by rewrite -E. 281 | - move: q2 => {q1}. rewrite !inord_max. 282 | apply: (runR_eq (i := 1) (j := 1) (k := 1)); rewrite ?addn1 ?cats0 //=. 283 | Qed. 284 | 285 | Lemma Tab_rc : right_congruent Tab. 286 | Proof. 287 | move => x y a E. 288 | have Tab2 : (Tab (x ++ [:: a])).2 = (Tab (y ++ [:: a])).2. 289 | { apply/setP => [[p q]]. rewrite /Tab !inE /= !inord_max. 290 | apply/idP/idP; apply: (runR_eq (i := 1) (j := 2) (k := 1)); by rewrite ?size_cat ?addn1 ?addn2. } 291 | suff ?: (Tab (x ++ [:: a])).1 = (Tab (y ++ [:: a])).1 by congr pair. 292 | apply/setP => q /=. rewrite !inE. 293 | pose C x := connect (srel (size (x ++ [:: a])).+1 (x ++ [:: a])) (nfa2_s M, ord1) (q, ord_max). 294 | wlog suff W: x y E Tab2 / C x -> C y; [by apply/idP/idP; exact: W|]. 295 | case/(@srel_mid (size x).+1); ssrlia => p /Tab1P p1 p2. 296 | apply/(@srel_mid (size y).+1); ssrlia. 297 | exists p; first by apply/Tab1P; rewrite -E. move: p2. 298 | rewrite -![_.+1 as X in inord X]addn1 -[1]/(size [:: a]) -!size_cat. 299 | rewrite !(@runL _ [::]) !inordK; ssrlia. move/Tab2P => p2. by apply/Tab2P; rewrite -Tab2. 300 | Qed. 301 | 302 | Definition nfa2_to_classifier : classifier_for (nfa2_lang M) := 303 | {| cf_classifier := Classifier Tab; cf_congruent := Tab_rc; cf_refines := Tab_refines |}. 304 | 305 | Theorem nfa2_to_dfa : 306 | { A : dfa char | dfa_lang A =i nfa2_lang M & #|A| <= 2 ^ (#|M| ^ 2 + #|M|) }. 307 | Proof. 308 | exists (classifier_to_dfa (nfa2_to_classifier)); first exact: classifier_to_dfa_correct. 309 | rewrite card_sub (leqRW (max_card _)) [#|_|]/=. 310 | by rewrite card_prod expnD mulnC leq_mul //= card_set // card_prod -mulnn. 311 | Qed. 312 | 313 | End NFA2toAFA. 314 | 315 | (** If M is deterministic, the size bound on the constructed 2DFA improves 316 | to [(#|M|.+1)^(#|M|.+1)] *) 317 | 318 | Arguments srel [char] M k x c d. 319 | 320 | (** ** Improved Bound for Translation of 2DFAs to DFAs *) 321 | 322 | Section DFA2toAFA. 323 | Variables (char : finType) (M : dfa2 char). 324 | 325 | Lemma functional_srel k w : functional (srel M k w). 326 | Proof. apply: functional_sub (@srel_step _ _ k w). exact: step_fun. Qed. 327 | 328 | Lemma term_srel k x q (H: k < (size x).+2) : terminal (srel M k x) (q,inord k). 329 | Proof. move => c /=. by rewrite /srel inordK // ?eqxx /= andbF. Qed. 330 | 331 | Lemma Tab1_uniq x p q : p \in (Tab M x).1 -> q \in (Tab M x).1 -> p = q. 332 | Proof. 333 | rewrite !inE => H1 H2. suff: (p,@ord_max (size x).+1) = (q,ord_max) by case. 334 | apply: term_uniq H1 H2; rewrite ?inord_max; auto using term_srel, functional_srel. 335 | Qed. 336 | 337 | Lemma Tab2_functional x p q r : (p,q) \in (Tab M x).2 -> (p,r) \in (Tab M x).2 -> q = r. 338 | Proof. 339 | rewrite !inE => /= H1 H2. suff: (q,@ord_max (size x).+1) = (r,ord_max) by case. 340 | apply: term_uniq H1 H2; rewrite ?inord_max; auto using term_srel, functional_srel. 341 | Qed. 342 | 343 | Definition Tab' := image_fun (@Tab_rc _ M). 344 | 345 | Lemma image_rc : right_congruent Tab'. 346 | Proof. move => x y a /(congr1 val) /= E. apply: val_inj. exact: Tab_rc. Qed. 347 | 348 | Lemma image_refines : refines (nfa2_lang M) Tab'. 349 | Proof. move => x y /(congr1 val) E. exact: Tab_refines. Qed. 350 | 351 | Definition dfa2_to_myhill := 352 | {| cf_classifier := Classifier Tab'; 353 | cf_congruent := image_rc; 354 | cf_refines := image_refines |}. 355 | 356 | Lemma det_range : #|{:image_type (@Tab_rc _ M)}| <= (#|M|.+1)^(#|M|.+1). 357 | Proof. 358 | pose table' := (option M * {ffun M -> option M})%type. 359 | apply: (@leq_trans #|{: table'}|); last by rewrite card_prod card_ffun !card_option expnS. 360 | pose f (x : image_type (@Tab_rc _ M)) : table' := 361 | let (b,_) := x in ([pick q | q \in b.1],[ffun p => [pick q | (p,q) \in b.2]]). 362 | suff : injective f by apply: leq_card. 363 | move => [[a1 a2] Ha] [[b1 b2] Hb] [E1 /ffunP E2]. apply: val_inj => /=. 364 | move: Ha Hb => /dec_eq /= [x Hx] /dec_eq [y Hy]. 365 | rewrite [Tab M x]surjective_pairing [Tab M y]surjective_pairing !xpair_eqE in Hx Hy. 366 | case/andP : Hx => /eqP ? /eqP ?. case/andP : Hy => /eqP ? /eqP ?. subst. f_equal. 367 | - apply/setP => p. case: (pickP _) E1 => q1; case: (pickP _) => q2 //; last by rewrite q1 q2. 368 | move => {E2} H1 H2 [?]; subst. 369 | wlog suff S : p x y H1 H2 / (p \in (Tab M x).1) -> (p \in (Tab M y).1). 370 | { apply/idP/idP; exact: S. } 371 | move => H. by rewrite (@Tab1_uniq x p q2). 372 | - apply/setP => [[p q]]. move: E2 {E1} => /(_ p). rewrite !ffunE. 373 | case: (pickP _) => r1; case: (pickP _) => r2 //; last by rewrite r1 r2. 374 | move => H1 H2 [?]; subst. apply/idP/idP => ?. 375 | + by rewrite (@Tab2_functional x p q r2). 376 | + by rewrite (@Tab2_functional y p q r2). 377 | Qed. 378 | 379 | Theorem dfa2_to_dfa : 380 | { A : dfa char | dfa_lang A =i dfa2_lang M & #|A| <= (#|M|.+1)^(#|M|.+1) }. 381 | Proof. 382 | exists (classifier_to_dfa (dfa2_to_myhill)); first exact: classifier_to_dfa_correct. 383 | rewrite card_sub (leqRW (max_card _)). exact: det_range. 384 | Qed. 385 | 386 | End DFA2toAFA. 387 | -------------------------------------------------------------------------------- /theories/two_way.v: -------------------------------------------------------------------------------- 1 | (* Authors Christian Doczkal and Jan-Oliver Kaiser *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import all_ssreflect. 4 | From RegLang Require Import misc languages dfa regexp myhill_nerode. 5 | 6 | Set Default Proof Using "Type". 7 | 8 | Set Implicit Arguments. 9 | Unset Strict Implicit. 10 | Unset Printing Implicit Defensive. 11 | 12 | (** * Two Way Automata *) 13 | 14 | (** ** Preliminaries 15 | 16 | We want to represent configurations of two-way automata as pairs of states and 17 | positions on the input word extended with left and right markers. That is 18 | positions will be of type ['I_n.+2] with [n] being the length of the input 19 | word. We need some facts about finite ordinals of this form. 20 | 21 | We define a three-way case analysis on ['I_n.+2]. If [i:'I_n.+2] is 22 | neither [ord0] nor [ord_max], then we can cast it (with offset 1) to 23 | ['I_n]. This is used for looking up charaters of an input word *) 24 | 25 | Variant ord2_spec n (m : 'I_n.+2) := 26 | | Ord20 of m == ord0 27 | | Ord2M of m == ord_max 28 | | Ord2C (i : 'I_n) of i.+1 = m. 29 | 30 | Arguments Ord20 [n m] _. 31 | Arguments Ord2M [n m] _. 32 | Arguments Ord2C [n m i] _. 33 | 34 | Lemma ord2P n (m : 'I_n.+2) : ord2_spec m. 35 | Proof. 36 | case: (unliftP ord0 m) => [j Hj|/eqP]; last exact: Ord20. 37 | case: (unliftP ord_max j) => [i Hi|Hj2]; last apply: Ord2M. 38 | * apply: (@Ord2C _ m i). by rewrite Hj Hi lift0 lift_max. 39 | * rewrite Hj Hj2. apply/eqP. apply/ord_inj. by rewrite lift0. 40 | Qed. 41 | 42 | Lemma ord2P0 n : ord2P (@ord0 n.+1) = Ord20 (eqxx _). 43 | Proof. case: (ord2P (@ord0 n.+1)) => //= H. congr Ord20. exact: eq_irrelevance. Qed. 44 | 45 | Lemma ord2PM n : ord2P (@ord_max n.+1) = Ord2M (eqxx _). 46 | Proof. 47 | case: (ord2P (@ord_max n.+1)) => //= [H|i Hi]. 48 | - apply: f_equal. exact: eq_irrelevance. 49 | - move: (ltn_ord i). move: (Hi) => Hi2. move: Hi => [] ->. by rewrite ltnn. 50 | Qed. 51 | 52 | Lemma ord2PC n {i : 'I_n.+2} {i' : 'I_n} (p : i'.+1 = i) : ord2P i = Ord2C p. 53 | Proof. 54 | case: (ord2P i) => [Hi|Hi|j' p']. 55 | - exfalso. move/eqP: Hi => Hi. by rewrite Hi in p. 56 | - exfalso. move:Hi. apply/negP. apply: contra_eqN p => /eqP->. 57 | rewrite eqn_leq negb_and -[~~ (ord_max <= _)]ltnNge [_.+1 < _](_ : _ = true) ?orbT //. 58 | exact: leq_ltn_trans (ltn_ord _) _. 59 | - have ?: i' = j'. apply: ord_inj. apply/eqP. by rewrite -eqSS p p'. subst. 60 | by rewrite (eq_irrelevance p p'). 61 | Qed. 62 | 63 | (** ** Definition of 2NFAs and their languages. 64 | 65 | We need to call 2NFAs [nfa2] since names may not begin with numbers. *) 66 | 67 | Section NFA2. 68 | Variable char : finType. 69 | 70 | Definition dir := bool. 71 | Definition L := true. 72 | Definition R := false. 73 | 74 | Record nfa2 := Nfa2 { 75 | nfa2_state :> finType; 76 | nfa2_s : nfa2_state; 77 | nfa2_f : {set nfa2_state}; 78 | nfa2_trans : nfa2_state -> char -> {set nfa2_state * dir}; 79 | nfa2_transL : nfa2_state -> {set nfa2_state}; 80 | nfa2_transR : nfa2_state -> {set nfa2_state}}. 81 | 82 | Variables (A : nfa2) (x : word char). 83 | 84 | Definition tape := in_tuple x. 85 | Definition pos := ('I_(size x).+2)%type. 86 | Definition nfa2_config := (A * pos)%type. 87 | 88 | Definition read (q:A) (n : pos) : {set (A * dir)} := 89 | match ord2P n with 90 | | Ord20 _ => setX (nfa2_transL q) [set R] 91 | | Ord2M _ => setX (nfa2_transR q) [set L] 92 | | Ord2C m' _ => nfa2_trans q (tnth tape m') 93 | end. 94 | 95 | Definition step (c d : nfa2_config) := 96 | let: ((p,i),(q,j)) := (c,d) in 97 | ((q,R) \in read p i) && (j == i.+1 :> nat) 98 | || ((q,L) \in read p i) && (j.+1 == i :> nat). 99 | 100 | Definition nfa2_lang := [exists (q | q \in nfa2_f A), connect step (nfa2_s A,ord1) (q,ord_max)]. 101 | End NFA2. 102 | 103 | Arguments step [char] A x c d. 104 | Prenex Implicits step. 105 | 106 | 107 | (** ** Definition of 2DFAs as deterministic 2NFAs *) 108 | 109 | Section DFA2. 110 | Variable char : finType. 111 | 112 | Record deterministic (M : nfa2 char) : Prop := 113 | { detC : forall (p:M) a, #|nfa2_trans p a| <= 1; 114 | detL : forall (p:M), #|nfa2_transL p| <= 1; 115 | detR : forall (p:M), #|nfa2_transR p| <= 1}. 116 | 117 | Record dfa2 := DFA2 { nfa2_of :> nfa2 char ; dfa2_det : deterministic nfa2_of }. 118 | Definition dfa2_lang := nfa2_lang. 119 | 120 | Variable M : dfa2. 121 | 122 | Lemma cards_lt1 (T : finType) (A : {set T}) : #|A| <= 1 -> A = set0 \/ exists x, A = [set x]. 123 | Proof. 124 | move => H. case (posnP #|A|) => H'. 125 | - left. exact:cards0_eq. 126 | - right. apply/cards1P. by rewrite eqn_leq H H'. 127 | Qed. 128 | 129 | Lemma read1 x (p:M) (j:pos x) : read p j = set0 \/ exists s : M * dir, read p j = [set s]. 130 | Proof. 131 | rewrite /read. 132 | case: (ord2P _) => [||i] _;apply cards_lt1; rewrite ?cardsX ?cards1 ?muln1; 133 | [auto using detL, detC, detR, dfa2_det..|]. 134 | exact/detC/dfa2_det. 135 | Qed. 136 | 137 | Lemma step_fun x : functional (step M x). 138 | Proof. 139 | have lr: ((R == L = false)*(L == R = false))%type by done. 140 | move => [p i] [q j] [r k]. rewrite /step. 141 | case: (read1 p i) => [ -> |[[q' [|]] -> ]]; first by rewrite !inE. 142 | - rewrite !inE !xpair_eqE -/L -/R !lr !eqxx !andbT !andbF /=. 143 | move => /andP [/eqP -> /eqP A] /andP [/eqP -> /eqP B]. 144 | f_equal. apply ord_inj. apply/eqP. by rewrite -eqSS A B. 145 | - rewrite !inE !xpair_eqE -/L -/R !lr !eqxx !andbT !andbF !orbF /=. 146 | move => /andP [/eqP -> /eqP A] /andP [/eqP -> /eqP B]. 147 | f_equal. apply ord_inj. apply/eqP. by rewrite -eqSS A B. 148 | Qed. 149 | 150 | End DFA2. 151 | 152 | (** ** Simulation of DFAs *) 153 | 154 | 155 | 156 | Section DFAtoDFA2. 157 | Variables (char : finType) (A : dfa char). 158 | 159 | Definition nfa2_of_dfa : nfa2 char := 160 | {| nfa2_s := dfa_s A; 161 | nfa2_f := [set q in dfa_fin A]; 162 | nfa2_trans q a := [set (dfa_trans q a,R)]; 163 | nfa2_transL q := [set dfa_s A]; (* Never reached *) 164 | nfa2_transR q := set0 165 | |}. 166 | 167 | Lemma drop_accept (w : word char) (i : 'I_(size w)) (q : A) : 168 | drop i w \in dfa_accept q = (drop i.+1 w \in dfa_accept (dfa_trans q (tnth (tape w) i))). 169 | Proof. 170 | case: w i q => [[//]|a w [m Hm] q]. rewrite [drop]lock (tnth_nth a) /= -lock. 171 | elim: {w} (a :: w) m Hm q => [|b w IHw [|m] Hm q]; first by case. 172 | by rewrite drop0 drop1. exact: IHw. 173 | Qed. 174 | 175 | Variable (w : word char). 176 | Let n := size w. 177 | 178 | Lemma nfa2_of_aux (q:A) i : i < (size w).+1 -> 179 | ((drop i w) \in dfa_accept q) -> 180 | [exists f in nfa2_f nfa2_of_dfa, connect (step nfa2_of_dfa w) (q,inord i.+1) (f,ord_max)]. 181 | Proof. 182 | move eq_m : (n - i) => m. elim: m q i eq_m => [|m IHm] q i /eqP H1 H2. 183 | - have/eqP -> : i == (size w). by rewrite eqn_leq -ltnS H2 -subn_eq0 H1. 184 | rewrite drop_size unfold_in -inord_max /= => F. apply/existsP;exists q. rewrite inE F. exact: connect0. 185 | - move => H. have Hi : i < size w. 186 | { rewrite ltn_neqAle -ltnS H2 andbT. apply: contraTN H1 => /eqP->. by rewrite subnn. } 187 | have Hm : n - i.+1 = m by apply/eqP;rewrite subnS (eqP H1). 188 | move/(_ (dfa_trans q (tnth (tape w) (Ordinal Hi))) _ Hm Hi) : IHm. 189 | rewrite -[i.+1]/(Ordinal Hi).+1 -drop_accept. move => /(_ H). 190 | case/exists_inP => f f1 f2. apply/exists_inP;exists f => //. apply: connect_trans (connect1 _) f2. 191 | rewrite /step /read (ord2PC (i' := (Ordinal Hi))) ?inordK //= => _. 192 | by rewrite inE ?eqxx. 193 | Qed. 194 | 195 | Lemma nfa2_of_aux2 (q f:A) (i : pos w) : i != ord0 -> 196 | f \in nfa2_f nfa2_of_dfa -> connect (step nfa2_of_dfa w) (q,i) (f,ord_max) -> 197 | ((drop i.-1 w) \in dfa_accept q). 198 | Proof. 199 | move => H fin_f. case/connectP => p. elim: p i H q => //= [|[q' j] p IHp i Hi q]. 200 | - move => i Hi q _ [<- <-]. rewrite drop_size -topredE /= accept_nil. by rewrite inE in fin_f. 201 | - rewrite {1}/step /read. case: (ord2P i) => /= [|/eqP->|i' Hi']; try by rewrite ?inE ?(negbTE Hi). 202 | rewrite !inE !xpair_eqE (_ : L == R = false) ?eqxx ?andbT ?andbF ?orbF -?andbA //=. 203 | case/and3P => /eqP -> /eqP E. rewrite -Hi' drop_accept. 204 | have -> : i'.+1 = j.-1 by rewrite E. apply IHp. 205 | by apply: contra_eq_neq E =>->. 206 | Qed. 207 | 208 | Lemma nfa2_of_correct : (w \in dfa_lang A) = (w \in nfa2_lang nfa2_of_dfa). 209 | Proof. 210 | apply/idP/idP; rewrite -![_ \in _ A]topredE /=. 211 | - rewrite -{1}[w]drop0 /nfa2_lang -topredE /= inord1 => H. exact: nfa2_of_aux. 212 | - rewrite -{2}[w]drop0 -[0]/((@ord1 n).-1). case/exists_inP => p. exact: nfa2_of_aux2. 213 | Qed. 214 | 215 | Lemma nfa2_of_dfa_det : deterministic (nfa2_of_dfa). 216 | Proof. split => [p a|p|p]; by rewrite ?cards1 ?cards0. Qed. 217 | 218 | Definition dfa2_of_dfa := DFA2 nfa2_of_dfa_det. 219 | 220 | Lemma dfa2_of_correct : (w \in dfa_lang A) = (w \in dfa2_lang dfa2_of_dfa). 221 | Proof. exact: nfa2_of_correct. Qed. 222 | 223 | End DFAtoDFA2. 224 | -------------------------------------------------------------------------------- /theories/vardi.v: -------------------------------------------------------------------------------- 1 | (* Author: Christian Doczkal *) 2 | (* Distributed under the terms of CeCILL-B. *) 3 | From mathcomp Require Import all_ssreflect. 4 | From RegLang Require Import misc languages nfa two_way. 5 | 6 | Set Default Proof Using "Type". 7 | 8 | Set Implicit Arguments. 9 | Unset Strict Implicit. 10 | Unset Printing Implicit Defensive. 11 | 12 | (** ** Vardi Construction *) 13 | 14 | Definition bsimp := (andbT,andbF,andTb,andFb,orbT,orbF,orTb,orFb). 15 | 16 | (** Translation from 2NFAs to NFAs for the complement language *) 17 | 18 | Section Vardi. 19 | Variables (char : finType) (M : nfa2 char). 20 | Implicit Types (x y z w v : word char) (U V W : {set M}) (X Y : {set M} * {set M}). 21 | 22 | Definition reject_cert x (T : pos x -> {set M}) := 23 | [/\ nfa2_s M \in T ord1, 24 | [disjoint (nfa2_f M) & (T ord_max)] & 25 | forall i p j q, p \in T i -> step M x (p,i) (q,j) -> q \in T j ]. 26 | 27 | Definition run_table x (i : pos x) := [set q | connect (step M x) (nfa2_s M, ord1) (q,i)]. 28 | Arguments run_table x i : clear implicits. 29 | 30 | Lemma sub_run x C (i : pos x) : reject_cert C -> {subset run_table x i <= C i}. 31 | Proof. 32 | case => T1 T2 T3 p. rewrite inE. case/connectP => cs. 33 | elim/last_ind: cs p i => /= [p i _|cs c IH p i]; first by case => -> ->. 34 | rewrite rcons_path last_rcons [last _ _]surjective_pairing => /andP [pth stp] E. subst. 35 | apply: T3 stp. by apply: IH; rewrite -?surjective_pairing. 36 | Qed. 37 | 38 | Lemma dfa2Pn x : reflect (exists T, @reject_cert x T) (x \notin nfa2_lang M). 39 | Proof. apply: introP => [H|]. 40 | - exists (run_table x) ; split; first by rewrite inE ?connect0. 41 | + apply/pred0P => q. rewrite !inE. apply: contraNF H => C. 42 | by apply/existsP; exists q. 43 | + move => i p j q. rewrite !inE => ? S. exact: connect_trans (connect1 S). 44 | - move/negPn => /exists_inP [q Hq1 Hq2] [c C]. 45 | have/(sub_run C) H : q \in run_table x ord_max by rewrite inE. 46 | case: C => _ /disjoint_setI0 C _. move: C. move/setP/(_ q). by rewrite !inE Hq1 H. 47 | Qed. 48 | 49 | Section Completeness. 50 | Variables (a : char) (U V W : {set M}). 51 | 52 | Definition compL := [forall p in U, forall q, (q \in nfa2_transL p) ==> (q \in V)]. 53 | 54 | Definition compR := [forall p in V, forall q, (q \in nfa2_transR p) ==> (q \in U)]. 55 | 56 | Definition comp := [forall p in V, forall q, 57 | (((q,L) \in nfa2_trans p a) ==> (q \in U)) && (((q,R) \in nfa2_trans p a) ==> (q \in W))]. 58 | 59 | End Completeness. 60 | 61 | Definition nfa_of := 62 | {| nfa_s := [set X : {set M} * {set M} | (nfa2_s M \in X.2) & compL X.1 X.2]; 63 | nfa_fin := [set X : {set M} * {set M} | [disjoint (nfa2_f M) & X.2] & compR X.1 X.2]; 64 | nfa_trans X a Y := (X.2 == Y.1) && comp a X.1 X.2 Y.2 |}. 65 | 66 | Lemma nfa_ofP x : reflect (exists T, @reject_cert x T) (x \in nfa_lang nfa_of). 67 | Proof. apply: (iffP nfaP). 68 | - move => [s] [r] [Hp Hr]. 69 | pose T (i : pos x) := if i:nat is i'.+1 then (nth s (s::r) i').2 else (nth s (s::r) 0).1. 70 | have T_comp (j : 'I_(size x)) : 71 | comp (tnth (tape x) j) (T (inord j)) (T (inord j.+1)) (T (inord j.+2)). 72 | case: j => /= m Hm. move: (run_trans Hm Hr) => /andP [_]. 73 | have -> : (nth s (s :: r) m).1 = T (inord m). 74 | case: m Hm => [|m] Hm; first by rewrite -inord0. 75 | rewrite /T inordK ?ltnS // 2?ltnW //. 76 | move/ltnW : Hm => Hm. by case/andP : (run_trans Hm Hr) => /eqP-> ?. 77 | have -> : (nth s (s :: r) m).2 = T (inord m.+1) by rewrite /T inordK // ltnS ltnW. 78 | have -> // : (nth s r m).2 = T (inord m.+2). by rewrite /T inordK // ltnS. 79 | exists T. split => //. 80 | + rewrite /T /=. move: Hp. rewrite inE. by case/andP. 81 | + rewrite /T /= (run_size Hr) -last_nth. 82 | move/run_last : (Hr). rewrite inE. by case/andP. 83 | + move => i p j q H. rewrite /step /read. 84 | case: (ord2P _) => [/eqP ?|/eqP ?|i' Hi']; subst => //=. 85 | * rewrite [_ == 0]eqn_leq ltn0 !bsimp => /andP [q1 q2]. 86 | rewrite /T (eqP q2) /= in H *. 87 | move: Hp. rewrite !inE => /andP [_ /forall_inP /(_ _ H) /forall_inP]. 88 | apply. by rewrite !inE eqxx andbT /= in q1. 89 | * rewrite [_ == _.+2](ltn_eqF) // !bsimp eqSS => /andP [q1 q2]. 90 | rewrite /T /= (run_size Hr) -[size r]/((size (s :: r)).-1) nth_last in H. 91 | move: (run_last Hr). rewrite inE. rewrite !inE eqxx andbT /= in q1. 92 | move => /andP [_ /forall_inP /(_ p H) /forall_inP /(_ q q1)]. 93 | rewrite /T (eqP q2) (run_size Hr). case e : (size r) => [|m] ; first by rewrite (size0nil e). 94 | have Hm : m < size x by rewrite -e (run_size Hr). 95 | rewrite -nth_last e /=. by case/andP: (run_trans Hm Hr) => /eqP ->. 96 | - move: (T_comp i') => /= /forall_inP /(_ p). rewrite Hi' inord_val => /(_ H) /forallP /(_ q). 97 | case/andP => q1 q2. 98 | case/orP; case/andP => Ht e; rewrite ?Ht /= in q1 q2. 99 | -- move: q2. by rewrite /T (eqP e) inordK // -Hi' ?ltnS. 100 | -- move: q1. rewrite -Hi' eqSS in e. by rewrite -(eqP e) -{2}[j]inord_val. 101 | - move => [T] [T1 T2 T3]. 102 | set s := (T ord0, T ord1). exists s. 103 | set r := [tuple (T (inord i.+1), T (inord i.+2)) | i < (size x)]. exists r. 104 | have E m : m <= size x -> nth s (s :: r) m = (T (inord m), T (inord m.+1)). 105 | case: m => m; first by rewrite nth0 /= -inord0 -inord1. 106 | move => H. by rewrite [r]lock /= -lock -[m]/(val (Ordinal H)) -tnth_nth tnth_mktuple. 107 | split. 108 | + rewrite inE /= T1 /=. apply/forall_inP => p /T3 H. apply/forall_inP => q Hq. 109 | apply: H. by rewrite /step /read ord2P0 !inE Hq eqxx. 110 | + apply: runI. 111 | * by rewrite size_map size_enum_ord. 112 | * rewrite -nth_last [nth _ _ _](_ : _ = nth s (s::r) (size r)); last by case: (tval r). 113 | rewrite size_tuple E // -inord_max inE /= T2 /=. 114 | apply/forall_inP => p /T3 H. apply/forall_inP => q Hq. 115 | apply H. by rewrite /step /read ord2PM !inE Hq inordK // eqxx !bsimp. 116 | * move => i. rewrite unfold_in. rewrite !E //= 1?ltnW // eqxx /=. 117 | apply/forall_inP => p /T3 H. apply/forallP => q. 118 | have Hi : i.+1 = (inord i.+1 : pos x). by rewrite inordK // !ltnS 1?ltnW //. 119 | apply/andP ; split; apply/implyP => Ht; apply H; rewrite /step /read /= (ord2PC Hi) Ht. 120 | - by rewrite !inordK ?eqxx ?bsimp // !(ltn_ord,ltnS,ltnW). 121 | - by rewrite !inordK ?eqxx ?bsimp // !(ltn_ord,ltnS,ltnW). 122 | Qed. 123 | 124 | Lemma nfa_of_correct : nfa_lang nfa_of =i [predC (nfa2_lang M) ]. 125 | Proof. move => w. rewrite !inE. apply/idP/dfa2Pn; by move/nfa_ofP. Qed. 126 | End Vardi. 127 | 128 | --------------------------------------------------------------------------------