pax_global_header00006660000000000000000000000064140273234770014523gustar00rootroot0000000000000052 comment=566258fe017820820d5f45c48fa5c6dbdbeeb2ba psmt2-frontend-0.4.0/000077500000000000000000000000001402732347700144065ustar00rootroot00000000000000psmt2-frontend-0.4.0/.drom000066400000000000000000000014041402732347700153470ustar00rootroot00000000000000# Keep this file in your GIT repo to help drom track generated files # hash of toml configuration files # used for generation of all files e78e3df6990ea287e1d3860125a9824f:. # end context for . # begin context for drom.toml # file drom.toml ebed3a9019eec353445cdf96689b6b23:drom.toml # end context for drom.toml # begin context for dune-project # file dune-project 74ac144e5bce61e5d2dda30ccef9e046:dune-project # end context for dune-project # begin context for src/bin/package.toml # file src/bin/package.toml dea23aaee88271953b1dd68f9b719637:src/bin/package.toml # end context for src/bin/package.toml # begin context for src/lib/package.toml # file src/lib/package.toml d6254e79340933b17bf8900214091eb5:src/lib/package.toml # end context for src/lib/package.toml psmt2-frontend-0.4.0/.github/000077500000000000000000000000001402732347700157465ustar00rootroot00000000000000psmt2-frontend-0.4.0/.github/workflows/000077500000000000000000000000001402732347700200035ustar00rootroot00000000000000psmt2-frontend-0.4.0/.github/workflows/doc-deploy.yml000066400000000000000000000033001402732347700225610ustar00rootroot00000000000000 name: doc-deploy on: push: branches: - master jobs: doc-deploy: runs-on: ubuntu-latest steps: - name: checkout uses: actions/checkout@v2 with: submodules: recursive persist-credentials: false - name: retrieve-opam-cache uses: actions/cache@v2 id: cache-opam with: path: ~/.opam key: v1-Linux-psmt2-frontend-4.10.0-${{ hashFiles('*.opam') }} - name: setup-ocaml uses: avsm/setup-ocaml@v1 with: ocaml-version: 4.10.0 - name: setup-doc run: | sudo apt install -yqq python3-sphinx python3-sphinx-rtd-theme opam install -y dune odoc - run: opam pin add . -y --no-action - run: opam depext -y psmt2-frontend_bin psmt2-frontend if: steps.cache-opam.outputs.cache-hit != 'true' - run: opam install -y ./*.opam --deps-only --with-test if: steps.cache-opam.outputs.cache-hit != 'true' - run: opam upgrade --fixup if: steps.cache-opam.outputs.cache-hit == 'true' - name: build-doc run: | mkdir -p _drom/docs rsync -auv docs/. _drom/docs/. opam exec -- dune build @doc mkdir -p _drom/docs/doc rsync -auv _build/default/_doc/_html/. _drom/docs/doc/. sphinx-build sphinx _drom/docs/sphinx touch _drom/docs/.nojekyll touch _drom/docs/sphinx/.nojekyll touch _drom/docs/doc/.nojekyll - name: deploy-doc uses: JamesIves/github-pages-deploy-action@3.6.2 with: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} BRANCH: gh-pages FOLDER: _drom/docs/ CLEAN: true psmt2-frontend-0.4.0/.github/workflows/workflow.yml000066400000000000000000000043311402732347700224010ustar00rootroot00000000000000 name: Main Workflow env: OPAMYES: true OPAMSOLVERTIMEOUT: 300 on: pull_request: branches: - main - next push: branches: - main - next jobs: build_dune_ocaml_versions: name: Build with dune on different ocaml versions strategy: matrix: os: - ubuntu-latest ocaml-version: - 4.04.2 - 4.05.0 - 4.10.0 runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v2 - name: Retrieve opam cache uses: actions/cache@v2 id: cache-opam with: path: ~/.opam key: v1-${{ runner.os }}-psmt2-frontend-dune-${{ matrix.ocaml-version }}-${{ hashFiles('*.opam') }} - name: Use OCaml ${{ matrix.ocaml-version }} uses: avsm/setup-ocaml@v1 with: ocaml-version: ${{ matrix.ocaml-version }} - run: opam pin add . --no-action - run: opam depext psmt2-frontend_bin psmt2-frontend - run: opam install ./*.opam --deps-only --with-test - run: opam exec -- dune build @install - name: run test suite run: opam exec -- dune build @runtest - name: test source is well formatted run: opam exec -- dune build @fmt continue-on-error: true if: matrix.ocaml-version == '4.10.0' build_opam_os: name: Build with opam on different OS strategy: matrix: os: - macos-latest - ubuntu-latest - windows-latest ocaml-version: - 4.10.0 runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v2 - name: Retrieve opam cache uses: actions/cache@v2 id: cache-opam with: path: ~/.opam key: v1-${{ runner.os }}-psmt2-frontend-opam-${{ matrix.ocaml-version }}-${{ hashFiles('*.opam') }} - name: Use OCaml ${{ matrix.ocaml-version }} uses: avsm/setup-ocaml@v1 with: ocaml-version: ${{ matrix.ocaml-version }} - run: opam pin add . --no-action - run: opam depext psmt2-frontend_bin psmt2-frontend - run: opam install ./*.opam --deps-only --with-test - run: opam install . psmt2-frontend-0.4.0/.gitignore000066400000000000000000000001051402732347700163720ustar00rootroot00000000000000/psmt2-frontend_bin *~ _build .merlin .vscode /_drom /_opam /_build psmt2-frontend-0.4.0/.ocamlformat000066400000000000000000000026761402732347700167260ustar00rootroot00000000000000 version=0.15.0 align-cases=false align-constructors-decl=false align-variants-decl=false assignment-operator=end-line break-before-in=fit-or-vertical break-cases=all break-collection-expressions=fit-or-vertical break-fun-decl=wrap break-fun-sig=wrap break-infix=wrap break-infix-before-func=false break-separators=after break-sequences=true break-string-literals=auto break-struct=force cases-exp-indent=2 cases-matching-exp-indent=normal disambiguate-non-breaking-match=false doc-comments=before doc-comments-padding=2 doc-comments-tag-only=default dock-collection-brackets=false exp-grouping=preserve extension-indent=2 field-space=loose function-indent=2 function-indent-nested=never if-then-else=k-r indent-after-in=0 indicate-multiline-delimiters=space indicate-nested-or-patterns=unsafe-no infix-precedence=indent leading-nested-match-parens=false let-and=sparse let-binding-indent=2 let-binding-spacing=compact let-module=compact let-open=preserve margin=80 match-indent=0 match-indent-nested=never max-indent=68 module-item-spacing=sparse nested-match=wrap ocp-indent-compat=false parens-ite=false parens-tuple=always parens-tuple-patterns=multi-line-only parse-docstrings=true sequence-blank-line=preserve-one sequence-style=terminator single-case=compact space-around-arrays=true space-around-lists=true space-around-records=true space-around-variants=true stritem-extension-indent=0 type-decl=sparse type-decl-indent=2 wrap-comments=false wrap-fun-args=true psmt2-frontend-0.4.0/.ocamlformat-ignore000066400000000000000000000000501402732347700201670ustar00rootroot00000000000000 vendor/*/* vendor/*/*/* vendor/*/*/*/* psmt2-frontend-0.4.0/.ocp-indent000066400000000000000000000077511402732347700164610ustar00rootroot00000000000000 # -*- conf -*- # This is an example configuration file for ocp-indent # # Copy to the root of your project with name ".ocp-indent", customise, and # transparently get consistent indentation on all your ocaml source files. # Starting the configuration file with a preset ensures you won't fallback to # definitions from "~/.ocp/ocp-indent.conf". # These are `normal`, `apprentice` and `JaneStreet` and set different defaults. normal # # INDENTATION VALUES # # Number of spaces used in all base cases, for example: # let foo = # ^^bar base = 2 # Indent for type definitions: # type t = # ^^int type = 2 # Indent after `let in` (unless followed by another `let`): # let foo = () in # ^^bar in = 0 # Indent after `match/try with` or `function`: # match foo with # ^^| _ -> bar with = 0 # Indent for clauses inside a pattern-match (after the arrow): # match foo with # | _ -> # ^^^^bar # the default is 2, which aligns the pattern and the expression match_clause = 4 # this is non-default # Indentation for items inside extension nodes: # [%% id.id # ^^^^contents ] # [@@id # ^^^^foo # ] ppx_stritem_ext = 2 # When nesting expressions on the same line, their indentation are in # some cases stacked, so that it remains correct if you close them one # at a line. This may lead to large indents in complex code though, so # this parameter can be used to set a maximum value. Note that it only # affects indentation after function arrows and opening parens at end # of line. # # for example (left: `none`; right: `4`) # let f = g (h (i (fun x -> # let f = g (h (i (fun x -> # x) # x) # ) # ) # ) # ) max_indent = 4 # # INDENTATION TOGGLES # # Wether the `with` parameter should be applied even when in a sub-block. # Can be `always`, `never` or `auto`. # if `always`, there are no exceptions # if `auto`, the `with` parameter is superseded when seen fit (most of the time, # but not after `begin match` for example) # if `never`, `with` is only applied if the match block starts a line. # # For example, the following is not indented if set to `always`: # let f = function # ^^| Foo -> bar strict_with = never # Controls indentation after the `else` keyword. `always` indents after the # `else` keyword normally, like after `then`. # If set to `never', the `else` keyword won't indent when followed by a newline. # `auto` indents after `else` unless in a few "unclosable" cases (`let in`, # `match`...). # # For example, with `strict_else=never`: # if cond then # foo # else # bar; # baz # `never` is discouraged if you may encounter code like this example, # because it hides the scoping error (`baz` is always executed) strict_else = always # Ocp-indent will normally try to preserve your in-comment indentation, as long # as it respects the left-margin or starts with `(*\n`. Setting this to `true` # forces alignment within comments. strict_comments = false # Toggles preference of column-alignment over line indentation for most # of the common operators and after mid-line opening parentheses. # # for example (left: `false'; right: `true') # let f x = x # let f x = x # + y # + y align_ops = true # Function parameters are normally indented one level from the line containing # the function. This option can be used to have them align relative to the # column of the function body instead. # if set to `always`, always align below the function # if `auto`, only do that when seen fit (mainly, after arrows) # if `never`, no alignment whatsoever # # for example (left: `never`; right: `always or `auto) # match foo with # match foo with # | _ -> some_fun # | _ -> some_fun # ^^parameter # ^^parameter align_params = auto # # SYNTAX EXTENSIONS # # You can also add syntax extensions (as per the --syntax command-line option): # syntax = mll lwt psmt2-frontend-0.4.0/.vscode/000077500000000000000000000000001402732347700157475ustar00rootroot00000000000000psmt2-frontend-0.4.0/.vscode/settings.json000066400000000000000000000001551402732347700205030ustar00rootroot00000000000000 { "ocaml.sandbox": { "kind": "opam" "switch": "/home/hal/OCP/AE/psmt2-frontend" } } psmt2-frontend-0.4.0/CHANGES.md000066400000000000000000000010751402732347700160030ustar00rootroot00000000000000second public release 0.2, January 18, 2019 ================================ - Add some small examples and a standalone binary for parsing and typing smt2 language. - Improve ReadMe - Add more options for logic and verbose - Correct bug in lexing for hexadecimal and binary number - Add support for "_" in pattern matching in parsing/syntax - Correct typing for DataTypes - Improve typing of logic for futur support of BV and FP - Add option for keeping location in parsed tree first public release 0.1, April 20, 2018 ================================ - First release psmt2-frontend-0.4.0/LICENSE000066400000000000000000000261351402732347700154220ustar00rootroot00000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. psmt2-frontend-0.4.0/LICENSE.md000066400000000000000000000001361402732347700160120ustar00rootroot00000000000000Copyright (c) 2020 Albin Coquereau This software is distributed under license "Apache-2.0". psmt2-frontend-0.4.0/Makefile000066400000000000000000000016021402732347700160450ustar00rootroot00000000000000.PHONY: all build-deps doc sphinx odoc view fmt fmt-check install dev-deps test DEV_DEPS := merlin ocamlformat odoc ppx_expect ppx_inline_test all: build build: opam exec -- dune build @install cp -f _build/default/src/bin/main.exe psmt2-frontend_bin build-deps: if ! [ -e _opam ]; then \ opam switch create . --empty && \ opam install ocaml.4.10.0 ; \ fi opam install ./*.opam --deps-only sphinx: sphinx-build sphinx docs/sphinx doc: opam exec -- dune build @doc rsync -auv --delete _build/default/_doc/_html/. docs/doc view: xdg-open file://$$(pwd)/docs/index.html fmt: opam exec -- dune build @fmt --auto-promote fmt-check: opam exec -- dune build @fmt install: opam exec -- dune install opam: opam pin -k path . uninstall: opam exec -- dune uninstall dev-deps: opam install ./*.opam --deps-only --with-doc --with-test test: opam exec -- dune build @runtest psmt2-frontend-0.4.0/README.md000066400000000000000000000022041402732347700156630ustar00rootroot00000000000000# psmt2-frontend A library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. ## Dependencies `psmt2-frontend` requieres `4.0.4.0` or higher `menhir` and `ocamlfind` You can use `make opam-deps` to install dependencies in the current switch ## Build and Install Instructions The easiest way to install psmt2-frontend is to use OPAM: $ opam install psmt2-frontend If you want to install psmt2-frontend from sources, use the following instructions: $ drom build to compile and install `psmt2-frontend` on your system. You can uninstall the library with `make uninstall`. ## Minimal Examples See the file `test/example.ml` for a small example of the usage of the library. ## Contributing Don't hesitate to report encountered bugs on this Git repo's issues tracker. ## TODO - Dev is in early stage. This is a first prototype that needs reimplementation - Needs some documentation. - Some features of SMT-LIB are not yet supported (Floating point, Bit-vectors, etc) ## Licensing The library is distributed under the terms of the Apache License version 2.0 (see LICENSE file). psmt2-frontend-0.4.0/docs/000077500000000000000000000000001402732347700153365ustar00rootroot00000000000000psmt2-frontend-0.4.0/docs/.nojekyll000066400000000000000000000000011402732347700171550ustar00rootroot00000000000000 psmt2-frontend-0.4.0/docs/README.txt000066400000000000000000000002671402732347700170410ustar00rootroot00000000000000To build the documentation: ~~~~~~~~~~~~~~~~~~~~~~~~~~~ * Run `make doc` or `drom doc` * Then, check the documentation in _drom/docs/ xdg-open file:///$(pwd)/_drom/docs/index.html psmt2-frontend-0.4.0/docs/favicon.png000066400000000000000000001115351402732347700174770ustar00rootroot00000000000000PNG  IHDR$$I  pHYs  sRGBgAMA aIDATxp}.ҔE4iCnܒSOJv#N؉4ѴK*N/yQə[3@Ò4n,8d8TRDucI &eڢ]y~ . >,}G#hoX)zkӓȧ=+:l<)^Sz M{C5W~8ܙb cge6d2ޯx7db:湵;#H"H#NF~G| \DA8#d> DA>RqwXgqVLL p e1 9UO^ N 8 ix'L|op|ErhSNOdoBo0<4!H [Jζ9@¤&WӁaCCU2o H1bDZUhlUדR=L"=0<$#H ^L.{恇[VO1_7Ǻ.M1 "H 7vyfhܒdXo'*f$& HR]{sL,ZӕK$$"cDZYAa_8ѹ2XneMA)qxs'{=M}'#V&Qơ0  Hb?88:yq78rL BH8b$8S\'Rr& #L}f0|i&U!)SoA uxS 2xX-'b[ߠi\0Aǩ`@T:xM,uIN h p=hoX.׎Gb'jԇO86B@BhT*)sA,Y&:1  HŞL}? A118)cXBDIMd7,bI$A1G#4N.0yaxs7Nbj̛Dy^Λ0 `> ̋/ݐeO7Xs] t +@!=z< #F}]:2d^Dϛ2o 8@#Y)#I46%÷gOl(@$#K4Fte%FBXŬDz\xO0< DܡM;ͷb 1D Avxs'{b1  l Dei# B@#2𶏛c@d9OdXҕw"FЌ)W.OEz; O|:@}\]mKu=1 _I,MDT}6|ꍱ3 b@ .4LLVs'6rq*'7 iT*)syXMVu[c$y!H DDD4^0s9&BG@H7{=e~KD #HA#Ftx]؁cl 1  x \y-9Ǒ ҕ g'M?Q0}GNk1і I&Q& v$t=[1RȚ"1kĉ~Eؐ>z<4 ixsL,ѕBAzT]>ypyưCOmiKaKcS2^0|{{RI̋ +#4N.UIMՖw s#H21ґw"F1 A#2v ,Ti*W5ၘ,9OdXҕw"F0 r`Gœmb'ax h1ċJMjkq̛ hbRqOĒm3/0<>@ɣ0qs'68ru+/3o H`7{=e~K :&Qơ0 #H` ]4Ntx5ڇ/wɷG 3 ,1+/+I\O~6^߅rjіb{VrDɸy^b #Ft'-Q+M4D.Mշ^B֑|VG;%adZPGP}6|ꍱ3DA7K7dsWRGzԭJR;'BVn7IlF(02axוS9 䲧̛eQ,YcIi1&IǺ1|8A0 4 yo'ѻk鋑aswWʾ<֢tcoI6Gax`x9~qu%#2RH}}܇e< <&8 /"D BT0q] &AW#vD%Ffk̛0 i v÷gOl( #H.eQي\}$m 4N.UIMw8=rB$R#.12Ƽ H:@}T<&]ʂN_0mm4e[3#t +@!w*7b$Rˏ󖂤EcQ0< :G{ry KVtdMwbf.}X1wm#1 bIAHJ=e>7%+;dUg^DcLF">U #ѿؓɸ#Ikወ27 TqG,IcTj1;cQГ5!Ǒc[yyt"H$1+/+I#7[>yDMc$yӅ h~Ĉbd YɦlhDƉ\Fw;a}#;$zb)Fyb=qYaxDkd*&HqL0oX D䲧̛\Q,;R6#0a.V4F6%Z0<1 _Ew> _r>A"$cg8W#8)r6M9&W&? rq*'77@~qu%zѨ1RH^dBaxDA 1;4F}XaxD tg^$1ri*G`Q0$˼ "z!ϛ8q] &A-bb$& #jb$b<]b>sK>u1r~"ƦW4e܉8lZɷqz P 9xM, ;o)HNZ7EAxMEy(yCb\;j޺KVtdMwbzb$uҔ-kQ/2'\rGCJ=yA,Y&:&#zx5t'+Lc]̛ JA ;40 j l[߫۳'J$"cqS$1RMHOWFGTi\ՓHϛ0 oA ;,2ᓍ I~Ĉ0y\r&zubD_[L_\)WeT!FƼ 0|i0|m=cg$\XH2RH#%{òa߽b!+/m.DG^a!וS9y@miK#ƪr~At0 b>z9YfW,Ik\ 1 ̬d3\z :4NtKՈH09& ĻP؎i#@i #jA p~ĈRvA1 (c>X @yk%t3ݴ G1 ?@`m>j֛%臞6~@I0_iX@CwmbU\ݕOe7~6&axDYc4YżU #wR4_Lp;p'BVn7w7A4_YV?l͒tX'wgsdEGNzR# ;UK1}G:8Ot1okQ.&0xM~Wʐ pƈ㸧̏K }"q04ҁ& 1#Ȃɻy)@>juyO.ECXT4qO_i?J r IK\%Lɻ§яM8AйffIL6iW @ʽx &F^K13KĈ%Q"ezyH o\  /]Mc(-U H&ՕLƈϢ.~/̈&Lޟq r9|r="$տW̫1;'+;룓wuՄ8OO؞~zd:d)hQ of R]{sL,Ev ޵y4Y+Z;]--ψ&L.MЌ0wx$H!FKOկ]9̛qr~bGsƧ$@^&=d0ax4 E:LjGaKcz¼  c.7'·"H1ґeb$f4Ntd0  }]4Y`^A"H8?bDWFr k 5s^W,mc$*8Y瞑qE$M/x"Ēeܒ'Ftk YSAcLR>;E uhsQ2M,;o)k @4{Μ($1KހX Hb cdEG>{'ʥ)MhޤR_9a>YĈQ XDcRqO b6Yՙ@5K,BVn_ƼIMLgKe 7'Ol X!A 2}d~#o>^1 O#2b㆒yω% п8)cXB`ҍax6wliu;aVG%j#F%'AeHIW}X[1bo> $@L#8YM>$˼I o@1K7drS(G.+\;v̛iԘ7ac\*ßp+?bd'ڥY/'@z4_T Ǐ3V/b]sV2"1i\6aDy eƘ3ob_1}T$@LhxsL,ѕK战Ƽ @4oh,[4^O[t뒶\y2岅0(gHgϯ4F~LsY-"H#Fteeo].3'Ɖ4+(惙MDәKY%iЛ2?2)U{Wcd "̥]r@kB~؝|F'@μ`:FtedQCD̡G͛6Dx؁ӝy{2 $)'$FKb3\K3b78rLBDpXTSdegK 846ek3͟wӚl!#F`swUﰎOri|3Md¼giT-Ǚ.Ac\vO{޸]36N/M֬h i#QB!qb۵a[&W&C~Op%7K ~Ț<-#] 9]Vk^Zi,i@#F5sDD4^eƈ⫏U٥IG(`x &F^K1o=ż,+ EDWax?H\ IbhdrY])E0<L+dň"Ho'C1{y9ȴƈ"H~qu%q0<>ӦmM+1a&Lޟ1o̡#秊4IKWYӌ |rxs+{b]ٙ7_͛0 Lϴ\Ƒ^}e$1Ӯ͛rVW>SM+1WA21]$ Y|DxM&8cc#FX##"H ׳u;H9YӝԦc棛=Gu| 7Dl#F|{-q `ƈ9M,aIH/p[# #4FVu%geCJ$@ rU#b KG#B$@4F*A,|0/"Lrll-F ]ȯ;.+yP пcbUb@f0W_i{>,-#2ߓ ȏ.?\ed~#bd1#ƽ;OmHι8:%F+bKZbDq5ċ/ 1R  uKUMbd1L.{!F$^D~1 f#lLjkZiA8@KxE ã|M#F H9#h0<&KG.#kR{b˺M;.FArhSNϕb 1 \4F3-q$g^"Ho~dXBM?Qc$5+-nͻI$Uc%mIq3o>7a>4FFi1&ej~{'vK$#,iHk&n!|\ cEGNt;F*fub/ RLKfeHHb{̛$6YeVLcDWFl#G m>jbdX’641/MY#e!HJG{r}AaKcz¼I\#H3GG u4F* b o0?AX# X&if;FlMfeATiĈG@(6]U4r1R5 6hz ;F 57{e2"##м0n%9#H(ƈ#EMƈnUіstNO`51G 'n)M|DL#Fҋad4i1RȦ;F.NɅъB,WUH_Ac(] ׆16 +!h121eO9c%mه/2 841_iA9@#ƽH@m/W7bd1+# Ahxs;xxk=O[G.SLel}JJ}7[zn?1qhSNϕb 10i̓8=>5 g^d= y}muW>1Rs1M b,Doc(4Fum;ĚaIo0e&O7o#'kb$1hμh$ +;dߕftgI A,}6%myCRY9 1B Abb{r|Mb~YУ$b\{HX7F1z͙[֘xsXҌ'1RD b 1X*f$&үlbʭLjf_w\V_ "cȫDƉ`F9#>W,k "McqSG,!F65 1Ci2\#]w/?N Ad5b#|-OaxJi#>,-#2G|- (Ml_[cMw\b$ :Cx &F^K10͌)W.O5=oBL8:%F+b 1.)#\VWFbK(ϣWadybiNnhoEfcDgEtf A+NUa[g!LVh4ϱ%mt?Gʈ$t=1%m@4_j #FNZ6cdC :YbGc.#ϼ$zxW,!FHR>o}O{-#L=F 4F~s["H8bGw;{I:#ݑduW 4FteC#CDA}6Dcq7?bd}h#H໣b\;*<"ɚnb$#Fzu=*>TS"deg )ѳE6b$>#'ƈTł #zŽ HŞrYWFG,!FHJMJA4Fsӓv[XS!H`1;iZ U!F\ I`ŋ/ 1R r#k+Ce#\c1F}]:2vƈ#CK?)dpՇixss9?R#zI BSmr@,iH!KeH3/ ?,ϚoNo؍_A$+$XϓbIG.SM 4F~W]'ȽO$A#Fte$q1f$XÛ_01K,ʛ"1@Tj1R#X<7uhsQ#=y]O`GU uX,Ws#Fzu=*HsTS&F6%+;dUg^@# u1#`Sn=Fb=W<(HӿS. 9=}}]Fcq07=ftݱ+$G9aYliĈ~GqbХ!FJ_fG.#FHS|UcidrYX1F#F+bΊ|yqbCT^q2:b5+#Eb#FteDwB4olqkb&CG?ּSo$)t=9&hH!KG*rilJl#8?8Yz=q6_c6u?_x\XR7;iZ{1}%[2WKL8?bDWFrƏJͬ\&F`UԽk$m>j3FCbdѕr} zc|!.AP#数M,1@##1(!Hho;،1ϯYУVM]!HDcRqONb6YMSуuqb7p-$!7{4FL6l#:Ϗ7_;7|>A#C WjXSww}_o-&c#dMW^V,mzءnK#F;W=RPG)_ܹ}TY!1?bD׉I.wXϝ[$']Lg[ѭIUVHbvouw/Sra"#η^4>q|\dRZAUo^6!n^L.{+#zaG f$1\o'o/N Bd.y}-}h#FlLj#`;Fq,\hf霌Uh~l."[ѕ+F _# RA\Ƅƈ:f_ ztxf{1b$"^?j輈^2Oo&HYYI_x FcЦƈeH3/#0|Ս|bIK1ҰY3A7w?kKzm¥j{آ1LB*8ׂ=^#LcdX ]V FHFW[ۆu#>[.?맰۲Ҭf趾u3--$G J͓W$SN>:K Û_01K,Eb$ѕVcDgK$bm>jbdXbYA?bd}p1Fl!H"hoX/1G>/zT.?bDZo:*$4F* bI\ܜ|7b$|q5'· 5b#F&zTD+=POaGtp]cDm9N}GfmFi Gd3AŞr٬G  9#FtGՎw~ͭy h81榇db-FXSp{9}pуuG cD7fy^v3A?b$g4F}X[x~آ1+#A|}qtspzt/ 1nXUΏ#Iη^[Œ ͯZx 2#E %/f!F##Ŗƈ35GwDc$˞r,HЃK?cD׿81c#ߔcCOsj6zf4 VFʈ<ixsL, kyHE.M-w|ygi2^[|^:!ѡM;=W%ɢ;iZ{1}%AwO[t#(h6_s(VH|rxs'{b䨹^31LIQēGB1O/p}O{-t)춄q!ϛzz ̏ѕ#E}CEO6}W#I3zw[ˆ?^*'Gn$}6$%`1\̵sOt'n[1"z˺ˏYӕK$HĈopB\G{r+QHr#zCZoL)Q<$J=ebdXBS-]A︬AAtp#9ǑcD_#U_$&3#B҄ŞL}#Ful_i| ¥1+# #QG[;#n7"q"i8{sRZc 1~"bD;5#[ЈcX^,4bD#\|E!1׶_R?bbdsFnGȏ cp XUΏ#I1rCxL*b$%Sra"#}֑bKX1b5*bDqE|#\VWFbAX #E\ΞqV1+NUs}#e;F:ru`.Ą1gl,%\];N攭"[IǴ)Y 4F<9&<nE{1}%AwO[tfxuW>xM,i .Bo}p#k K$H~FM<$@hoX.4FK\B~YУp#zCZoLɟo#$` J=eoXĔ[Mօtɬ#Y~ZGVwۯQOz*H1yB腞u4Fu=ѕUĨ-=lF5FjmKcg$$YIŞZ=m~XBÕR&FHϿ뱏ۯF<bTh8>%=b 1@rz-]wLj~G= y~%ňJ/ 1R zVI.bd^ 䲧bk ;e;F:rY1g̖%]a~q1(bbd FˏIG1R\Dhxs`LXsG*rilJlH~pb˲BNznK.ȵ-'/ ]QCwobd}ǤxO=y\l t##}$$7w?kKzz뿶C6'tgO}5eEGNt#=[*H&|. kp اz?`Rƫr{'v ¥1ǿ\>~F͵sfedDďѕ#ɕȕtLjM/x"֖feHz1R#I3zw[Šۯ8ƈGœmbIXK>b$qzOAݶz˺ˏk@ ?+#'GILfhoXR$" FH_cD"Hp#SnBj.lЃuqYyσpƈېs]kUJn7HE>H7{=e~KÏ7_wˏU;ڂ=ށHAm^uݱwOb5F_#_Ɛx'%FTdWH0 sŖFwKcdbK#F>kʖ!IH 1nXUΏ#Iη^[ŠۯQIh]x &F^K1 @GhEl!F##ŖbkT#*R3$#\Hcp l_1 c#ID3I+d^uDbbK~ňp#L ~H>ٲ}`$ t=8S6c$]?l_qσHD~pʇ#G*cQhxsL, YAݥHw+eCI3/ 7|{آFFAևm#$)0Z[x>y~%bdA^b'FHb$y# dY0N/tp]cD.1ґc$ :ۯQǑ3|fɒবgƮmHIt "FQOl @r`۲d}H <'<.h}B&h_'/gv#ce)ƣZ+:r G> |4F j>! jg.*ClYy>A?\|bސ^lkl,#XtûMiyHKj5vRzzx[{bnA4Fg[xTߏרYyά4 {jR#Fj?^ĈM?uX,]}TGyaNe_^ߑlƩGRެt׸S[hhĈ~%%FiJ)-Ĉ>2/])dbʕ-?edY|gM@zw_ˏV,m 5~rpVHllO. Q- WcS hn qH5?.zu=*1xG iUɸi.#ƪrqr4 ]\}ՄiC$Ί|wb$8ᠯiMk\IL |~ȝ$h_'/ l9{ds?OeLwnWy )}k0<6ѧw=P>eEGNt#~Fcdx T ^&ٗte#F4DnuC{7~˗'d74A>2l}O{-lNϖ͏רLqhS)JRb(G;_kWN1o0<`bzH0H^-+f'm:WVFوU8u &q1 z+#6Uˆ?^Hp~qG h^lm{YCȭw_Q;V&2a+JTǪ2i~u&#Ftb> ɡG͟MZȯ/6a:diqiDž^3G#Ft''F}#s ԭk" 9kZy tXRo{߉0L'%v M"FGDۼAҿq2 ~xޟ܉(w7- 3H dbʕ =}W<(kzJ#8;~B_#U>UJ[G5o5x^f䡛:npt誈>4wi kaJWtՄaxHz#_kp#sq-O1vFiuM~Y@E}'}\km/>,a7?:0<$;{lBOo=o=/*eAeI.~}$F!#y@mn+oMl7 };8A̎4axBOo4x~آ2HۯQc*['0s9:?"M4KWFֿGqd+;̛@ #η^{=4V#H$Ώd;鶍TZ;w$.t֤1oaxƇ]GhEl!F##ŖbkTؚ3HW kGV#e;F:rY1ϸne+1OsVG+("1?x׌jA4Fu7WvɪNW߈Q#ϙ+H릎}v,K۬yatJjMة2ii+'k6~~2{PcQ<^WN>esDdxX26; •%Fc+$/KiVNgOZ61 3Ass݂pS #6n#Fx# 'sJpKŦVN ݄}0L 酞un#ѐ%Fc{Slfĸ#gBqܳ+? 1 @q5z \~ĈfxO> HJaˏ;SQg:g$: 'q M}ޏp#j [Gsp *&NE.t|Y!F§75Fl}M ~%S#O#GDۏlg}mտS=|<#NV0YfVO7zw^sO̦1DAuh77 q-O1vF j}i"J>c^6K4YWbq&Qơ0  Έz+rk17=ﮔ3$Y!kr5sDDwaΛb!W_5 YZhE+ME߿5F;¥12EcDWF>kbbdrH*ז57{%5˃n'wilJ&k/~靶~DYLFɚ+rM~>VIwؒL #i4qGd/fE߭w}NSra"#}֑bKX1b5*H] f w١B'Db$lLj>.i#HVH\_.jMF}!ș}b5NΏTcBOW81~Ĉ>$kqL>ٲ}`$HkAgIl?HެpB{tו|%vdeYax#Fte~pbKai%'FJ>j#FY$ll:hk٧_[ȕ! Imq<#4s$M`^5sn>zLzyI>};o)HlF5F 0ÌGO:'qA+[<#{8M:o҈}w6M,|ӕb$y3LO_SmY&:p3=aEF&F}m?I %>f0{^_n>؃1 ? ==}}Cr{'v •5wϙ+>Z!V5i0_0G: NՋ 1\1b)<9{AMS*ɚL4KG91td/E~^0^0b$#?%FP;e0x{ߑYa0|ۗ1oPBL$1+_Q Qb 5vsڛi?-H'R6aK@qLQVˏѝ #c,FdQ0$˼ ኵ =ljόw-+#Ah5j JY R1 ߘ70ъhބax B1#fƈpo#6_ƐUM"HzMt.꼉*r=N,wi*G$z>y~%17H5\3տthQ8oR*W_䮃̛8:%j-Ht$%FlFE 0}^{3tN]mߟ1ou&Kx  =}љb$|cDϡͻר׭l%F`G#͜EVx 7sݓe{߉0 &X&]].bdn#|fɒ|t0ipDMr7;7Ũß/ؾл#0|_-+x)[XG8q0<^KFڲǤ#F Ahꀖ> A$ꁇ-xɚ`cNۏm q!zd\{|fU`VHzeE>&vYĉkw=_(;Lԟuńt~\m޹_6#Ft'- ?1m9 @f<%f٪}bGC!A<|Q]<ȏ,n=in2oB(¥̈}]ݝ|;uchdu3<"wI[%Cf։($(~n__!ŞC?VtBrxUJf$c>su+ekzy]sAcDO_%lFy)#o>98D!1QaFN3dFI0<,ӻUKWZ};pK?[[7b#mF5FjmKcgɌ ,>l+K)79ђI0%V1/M,V/ߣaxD^59AcDWFx8|o'o/#6_r5F'=GY)/7r ҭ׿&Q=^1onrat7CDGRbkTDЬiI[sUEnIT&axI.1ґc${1ؕWVo26">Q/U0>~]嗶V}+je2&~\_& =\י+"F8rPl yhU3e2v"QLVe]|Š__\O/Mj&D6u^8W>˪ #Fte~p.+$"F̖%#E$}"29dI[~!XG f 2Dn~+:dY{y4M7LэSly7GD}2[;o)Htx]l,9]uYՅ0nEje3Xsɘxs^/9<}egϛDy^uc zz&edޅ}Oc \zz"bD_cS<4+#ϙEv 庂xSMHlﴥ'&wR`ƅ^3 ¦1+#[ˆѫ1W ieF*~:ib$Ͼq0<@/4F5b$i1bQҰbkA\]B&#o"w_h/|0ev}D dxJ;}wNSC\~6=d~՟֕(EV]mՓ7NrK8|1#Ft'ۗڽ~?^'Oz%e4`{_^fl޹x =owٜBdWYs ]9W"? kG~Ï gMt?*_1xG Ss"v:D+&~E~k /jRۚeM:4P'mZ5L G =];zI^?Gl!FhMN~uuAgH}b=\nZ Ƕ:&+~~I+[ 6+ҴZߡߦg疕,].Lz`/}( lv9>:[ab$ʇ/ 9Y>(iD$i#FtCڗDzHÛEK#?;/>m飼#$it~4obVLtIW|#]hW2'kn}U?iD\n[hHJ%Fv7 /ݵnutlJ6KsiaxkMpGM #*ǹt$}]:#Ftxv1ߌQbX#[Ƕ'X YI%:"sn[&/tǟ}|ENcEG[̛qL{QAi'F}#Hm4m+n[sp{VIk771v?'6"|~:+'Q zPsm6;u#ɥ'ŗdLL?nbdAAO-ro4l~:Kr]KĹ$\T_syRnf*%78zB-vZm{n~-u׏}?VkGAk8 5s ԥt6Q?^/sճs_k܄$W=bD_kǶרƈ[myꍱ3R5ؖm(z/b]\pm5jKa5 ~2.Y?v sIp[ n>^Vr+׳ߣ=1I`Ҹ`6!/?yz|{h;@4T?ޕ ?WIllz\ <*q I4{ƬdMvB4J^ՓΛb!'mεc]d u#ϼ$6wqpEcopxXv?|l OB0 _!w+)1 ̝fb9#{@S^ؽ,v<+MsD鿥rkw=?}G AAt^Oiq{'v ¥1ݏ&"Fttݳ#@.VNnW~ztKDWJ$AbD+$˗HGO],[$ :O#+$>/Hkqj='fe֪Z#Fƈ~:Gcĭֶ<`I2Γ⇖Su4o>Dos&VHA NZijPM#R݂p #y,#^'F$2^J#Mg<5ҙ֗F*vn\5w(0$e ?H( 끇_{XB.Hjʈ~IO^RYMȐxM;oMou)iR'#eXk&'v˽O쑠Ȗ]ݴ;R+a;yP=|GkBء":4N*f}9w|Z:o_S1|n~9gl(@`s[,s薺h.7 >ҥaĎCJvWn>yqEw\m>ݣc6qJ ؉AFIEԕV i#렝ȥ1{۞'/gv#@8|a/.M qW߭,ku_=SyIxx⁘+:r;H6߂D='-gR?{ JɻLw0_ƼB 8kH"?wĖm3GjWqhyw Pk?,=c:zIS4R-Ͽs0 )JF~v~;dӒ+s0b ]r@tӁ뉈VjbYyάJKkiy!- Mu2ҙ-KrVOuoV#N^J?:׭$ɬ\0;Dѕҏϊ-axg+"-1Z=]goLt4#ԕ>nMZ閿c$8 o;1DS WOJjRQ>!:jMq ]IA1''FF H ʺo4d{NZCmyy&Kꏏ4qƈ64b$͉)W~n!Fh "݃{t``[G-aȥz N  Yt?p@ k}!~Mwax@lLj#G Eb@At?p%/;sT"t\4+I1ra #g BM?ٞꡉ %E=J,w[e\=Ft1H~H>!F qhXyK5OG(72|b~]V~970<G#F.}GlYՙ AprW#\s9 Hn{01Rڻ!x5F D?~DG_-iz/]ﶄ#,'1`a";W$m ~Ĉ#2R#&%e>/vߚZbVW=oG8"O#@E~&[Ϥ%~%1.@謈Ό؊\ۙ1HxۿqzHX!ۈ['Ϧ$aƈZ6h3c&\1k;m9&/6Zh2[tq aʻ'_#zvHG[~Ĉΐ~  :Xo27h.wl<,x~҈ﮔ9#R+mnsRfk6#|#^>Cr}ځksH]``VF~zo~ }UBX-aUDw_ 5v[VvɪμMc#}fH|4oc\ѡKۤ;iE53dP~Q$%Fj'gKk [rP7%lec\:JL7Rf«Mz^WP2;GZet#?;/C{MV\;+Kw gr_|IJ?>+#AؔYsfedRB2Sb\?. 6 Ik[!ɺ;yPAcDWF-aHfVFLm#{ iz4M@ϽEf1A2S#N}G}@z#kGz1+#1 X sdꧽHi Y|@͜7!HZl0<^~Ĉ+A#F8=|@&Yu镈9 ͫͳ$35{)t"K׿Qk13>=|gW2m njǹ~E"j֭$3{Ȅbɢ1+# #zzGݳnol3~ +J$3H#wX}$wm1r1R ϼ ?|E!hH!KH/IӏtzÞ7!HZt0</I=y'k1b y^eK@ Λ\vބ iMA2@ydudf,#ZFX֘7 j iMTd&hIJ\b@$>ziS#1gl(,!HBdc.53d&Y54^z`m #wRȥ)([$qy#E̛$/HfrMLD9NZG[VtdMw1;iZx78MIx lvB ,$Hf~jVOj6ax`4Fg[Vvɪμzb@$wax5 ax F;/5+#I=}}jo%s&F ִ$ 1+#b ~m]i6d&#Fte6 R6#6sA"Hbnr}d A2@t#$b@$1G ax :tVDgFlH,W'$F}#DAҚd&hʈeƈі # 95aI@|=g$121RZx־$1G& ax_|E!1R#2bOZcgBBAҚL v%%F2T؜CUk[a#Hb iMd&ּydudVW y^eK@#HZ ax`qy#" 95q ၛ#L=Fr`?6/NɅъXD$1Hfb12/b@$$1G&A2S5F.Mݓ=puW>18r&l>P* D AsIk$31 4#F A#F AsIk$3iD}DD &X,=ukbˊ>Ftx]gm1#^no"FDAsIk\X}F;2 ߘ7a 1ǿ\>زMVu%h~H6#Hb iJь|Fo&Lޟ1 y|wR~O%I$ k+ɲBVtz4MGhʈ~%2^gVF3+#{b 95!8RlIV҂axARbbV*^!F 95Lz:)N殭0<Əѝte4H#2bsUWI$YH̤qMՓ4͛0 ( Fg>̟1DAҚLyGMz~ezɠ# X?+#c1EAҚVdb!W_5 NkGP#Sn}7-[/Ϳdjib@$1GV4u4Y+3lk ïY~zA<{9}p.É]Yƈ[myꍱ31GAA2Sc6YږG4 }M7.w-;+#,1QBA?d4_m G;zI^?Gl +FtPO`h*[' 95ALi4V1'ѝ7Q GÛG[G-DAsIkgg;F:rYx\ XI$ ;HgĈ2~#8I$J0P* $AsIk.NAsIkᣋax{9}pb121cy5x־$1G& abw-#2R?FjmSo5I$ #Hfb>o;zI^?Gl +FO+bUk[AsIk.##Ŗ0c܇eh*['p$D)Hfb>ei#ƪr~ $1G&A0|t1 ?bDWFr`?.NɅъXD$1G&A2au?&=_|Xl!Ffn"qVbn 95q 8 7MZxO=y\l׉4?b$l>P* #HZ aJ0<12oPn%F`#HZ ahj̛D}^Do4oz -+;dUg^;iٌE~r6, AsQ%d^JZ4e^V,mKݼI\ቑ#<$$l_c{d) arTM+_w^l #Fj'gKzڢ7_L@S\8^ɩ։xr}oW[.$3i֎,+0 Ta?2E@i:-˙3-O['(M`i| aRZ*d+4 ήu!I+_T/HYB@BsY!#yG$Oƪ6#2bs{F + ;HO-3 swU^d~ GW\4FWY 5̐&F.&Fdu&gzuu~x lvWMtՠcRZ¾q`c4YMŠ m1gKF&F>VHb.s%{&M7\m +$&i;^dtH!|ʈ@q-O1vF$1F0+-7 D5q/rҶ͛9 V wL@$1t؊}sq Abѥq_6oV nѐU N 7I$dx\"Fu<ss=1dϛ{%&ݷ~V#[X,[1ra"3[J@<$17;HrM)W@ /1gl(%jN҄p:[M HLLV.iϾ͡]QڼI%a#46%x|v+1 IMxCLN_iߐseX!: ?S𺓖F-wm=co4Ljo}Z`#5#F7 IMmw1q_ ax=}}j/tt#{  ̓$C+fbps GWM$H$ ?\Ї)׈$H}lsћy $N,euYfEdԄȕrMFwH65qv!HE:o"R5qyMt$ADwUa Ae";ku[$<#Vbҁ$ľїSs{ 0 Zc>[ ҄$ }z8`{!/6aa1>]%X!A|~*['*? čΛok:NmqaxbRݿ!y&B4h̛DdxbR AL{vI&L m5  ٭J%ATjH GB79]H=teΓx A; x&Aط; kθw$9: _?qNx2+"$zL74NWi0_'gsgXv@@ x8.ƇIENDB`psmt2-frontend-0.4.0/docs/index.html000066400000000000000000000016311402732347700173340ustar00rootroot00000000000000 psmt2-frontend

psmt2-frontend

An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism.

Authors:

  • Albin Coquereau

Copyright © Albin Coquereau

psmt2-frontend-0.4.0/docs/style.css000066400000000000000000000003571402732347700172150ustar00rootroot00000000000000 body { color: #444; background-color: #EEEEEE; line-height:1.6; font-size:18px; } .content { width: 80%; margin-left: 100px; margin-top: 100px; font-family: sans-serif; } a:link{ color:#5bf } a:visited{ color:#55f } psmt2-frontend-0.4.0/drom.toml000066400000000000000000000025161402732347700162500ustar00rootroot00000000000000[project] drom-version = "0.1.0" [project] archive = "https://github.com/OCamlPro-Coquera/psmt2-frontend/archive/0.4.0.tar.gz" authors = ["Albin Coquereau"] bug-reports = "https://github.com/OCamlPro-Coquera/psmt2-frontend/issues" copyright = "Albin Coquereau" dev-repo = "https://github.com/OCamlPro-Coquera/psmt2-frontend/tree/next" edition = "4.10.0" homepage = "https://github.com/OCamlPro-Coquera/psmt2-frontend/" license = "Apache-2.0" min-edition = "4.04.2" mode = "binary" name = "psmt2-frontend" synopsis = "The psmt2-frontend project" version = "0.4.0" windows-ci = true # keys that you could also define: # build-profile = "...build-profile..." # odoc-target = "...odoc-target..." # sphinx-target = "...sphinx-target..." # doc-api = "...doc-api..." # doc-gen = "...doc-gen..." # github-organization = "...github-organization..." [project] description = """ An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. """ [drom] skip = "license" [dependencies] [tools] menhir = "" [tools.ocamlformat] for-test = true [tools.odoc] for-doc = true [tools.ppx_expect] for-test = true [tools.ppx_inline_test] for-test = true [project] generators = ["ocamllex", "menhir"] pack = "Psmt2Frontend" pack-modules = true skip-dirs = [] [[package]] dir = "src/bin" [[package]] dir = "src/lib" psmt2-frontend-0.4.0/dune000066400000000000000000000001251402732347700152620ustar00rootroot00000000000000; This file was generated by drom, using drom.toml (env ) (dirs src test vendors ) psmt2-frontend-0.4.0/dune-project000066400000000000000000000015651402732347700167370ustar00rootroot00000000000000(lang dune 2.0) ; This file was generated by drom, using drom.toml (name psmt2-frontend) (allow_approximate_merlin) (generate_opam_files false) (version 0.4.0) (formatting (enabled_for ocaml reason)) (package (name psmt2-frontend_bin) (synopsis "The psmt2-frontend project") (description "An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2\nstandard with prenex polymorphism.\n") (depends (ocaml (>= 4.04.2)) (psmt2-frontend (= version)) ppx_inline_test ppx_expect odoc ocamlformat menhir )) (package (name psmt2-frontend) (synopsis "The psmt2-frontend project") (description "An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2\nstandard with prenex polymorphism.\n") (depends (ocaml (>= 4.04.2)) ppx_inline_test ppx_expect odoc ocamlformat menhir )) (using menhir 2.0) psmt2-frontend-0.4.0/psmt2-frontend.opam000066400000000000000000000017551402732347700201560ustar00rootroot00000000000000# This file was generated by `drom` from `drom.toml`. # Do not modify or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "psmt2-frontend" version: "0.4.0" license: "Apache-2.0" synopsis: "The psmt2-frontend project" description: """\ An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. """ authors: ["Albin Coquereau"] maintainer: ["Albin Coquereau"] homepage: "https://github.com/OCamlPro-Coquera/psmt2-frontend/" bug-reports: "https://github.com/OCamlPro-Coquera/psmt2-frontend/issues" dev-repo: "git+https://github.com/OCamlPro-Coquera/psmt2-frontend/tree/next.git" build: [ ["dune" "subst"] {pinned} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] depends: [ "ocaml" {>= "4.04.2"} "dune" {>= "2.6.0"} "ppx_inline_test" {with-test} "ppx_expect" {with-test} "odoc" {with-doc} "ocamlformat" {with-test} "menhir" {} ] psmt2-frontend-0.4.0/psmt2-frontend_bin.opam000066400000000000000000000020201402732347700207700ustar00rootroot00000000000000# This file was generated by `drom` from `drom.toml`. # Do not modify or add to the `skip` field of `drom.toml`. opam-version: "2.0" name: "psmt2-frontend_bin" version: "0.4.0" license: "Apache-2.0" synopsis: "The psmt2-frontend project" description: """\ An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. """ authors: ["Albin Coquereau"] maintainer: ["Albin Coquereau"] homepage: "https://github.com/OCamlPro-Coquera/psmt2-frontend/" bug-reports: "https://github.com/OCamlPro-Coquera/psmt2-frontend/issues" dev-repo: "git+https://github.com/OCamlPro-Coquera/psmt2-frontend/tree/next.git" build: [ ["dune" "subst"] {pinned} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] depends: [ "ocaml" {>= "4.04.2"} "dune" {>= "2.6.0"} "psmt2-frontend" {= version} "ppx_inline_test" {with-test} "ppx_expect" {with-test} "odoc" {with-doc} "ocamlformat" {with-test} "menhir" {} ] psmt2-frontend-0.4.0/sphinx/000077500000000000000000000000001402732347700157175ustar00rootroot00000000000000psmt2-frontend-0.4.0/sphinx/_static/000077500000000000000000000000001402732347700173455ustar00rootroot00000000000000psmt2-frontend-0.4.0/sphinx/_static/css/000077500000000000000000000000001402732347700201355ustar00rootroot00000000000000psmt2-frontend-0.4.0/sphinx/_static/css/fixes.css000066400000000000000000000000011402732347700217540ustar00rootroot00000000000000 psmt2-frontend-0.4.0/sphinx/about.rst000066400000000000000000000002511402732347700175610ustar00rootroot00000000000000 About ===== An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. Authors ------- * Albin Coquereau psmt2-frontend-0.4.0/sphinx/conf.py000066400000000000000000000156111402732347700172220ustar00rootroot00000000000000 #!/usr/bin/env python3 # -*- coding: utf-8 -*- # # psmt2-frontend documentation build configuration file, created by # sphinx-quickstart. # # This file is execfile()d with the current directory set to its # containing dir. # # Note that not all possible configuration values are present in this # autogenerated file. # # All configuration values have a default; values that are commented out # serve to show the default. # If extensions (or modules to document with autodoc) are in another directory, # add these directories to sys.path here. If the directory is relative to the # documentation root, use os.path.abspath to make it absolute, like shown here. # # sys.path.insert(0, os.path.abspath('.')) import os import sys import datetime import subprocess from os import environ sys.path.insert(0, os.path.abspath('.') + '/_extensions') # -- General configuration ------------------------------------------------ # If your documentation needs a minimal Sphinx version, state it here. # # needs_sphinx = '1.0' # Add any Sphinx extension module names here, as strings. They can be # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom # ones. #extensions = ['sphinx.ext.extlinks'] # Add any paths that contain templates here, relative to this directory. templates_path = ['_templates'] # The suffix(es) of source filenames. # You can specify multiple suffix as a list of string: # source_suffix = ['.rst', '.md'] # source_suffix = '.rst' # The master toctree document. master_doc = 'index' # General information about the project. project = 'psmt2-frontend' copyright = 'Albin Coquereau' author = 'Albin Coquereau' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the # built documents. # # The short X.Y version. git = subprocess.check_output("git describe --always", shell=True).decode("utf-8") branch= subprocess.check_output("git rev-parse --abbrev-ref HEAD", shell=True).decode("utf-8") version = branch + " (" + git + ")" # version = os.environ.get('CI_COMMIT_REF_NAME', 'v1.0') # The full version, including alpha/beta/rc tags. release = version + datetime.datetime.now().strftime(" (%Y/%m/%d %H:%M)") # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. # # This is also used if you do content translation via gettext catalogs. # Usually you set "language" from the command line for these cases. language = None # List of patterns, relative to source directory, that match files and # directories to ignore when looking for source files. # This patterns also effect to html_static_path and html_extra_path exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store', 'doc_gen'] # The name of the Pygments (syntax highlighting) style to use. pygments_style = 'lovelace' # Deactivate syntax highlighting # - http://www.sphinx-doc.org/en/stable/markup/code.html#code-examples # - http://www.sphinx-doc.org/en/stable/config.html#confval-highlight_language highlight_language = 'ocaml' # TODO write a Pygments lexer for Michelson # cf. http://pygments.org/docs/lexerdevelopment/ and http://pygments.org/docs/lexers/ # If true, `todo` and `todoList` produce output, else they produce nothing. todo_include_todos = False # -- Options for HTML output ---------------------------------------------- # The theme to use for HTML and HTML Help pages. See the documentation for # a list of builtin themes. # html_theme = "sphinx_rtd_theme" # Theme options are theme-specific and customize the look and feel of a theme # further. For a list of options available for each theme, see the # documentation. # html_theme_options = {'logo_only': True} # html_logo = "logo.svg" # Add any paths that contain custom static files (such as style sheets) here, # relative to this directory. They are copied after the builtin static files, # so a file named "default.css" will overwrite the builtin "default.css". html_static_path = ['_static'] # Custom sidebar templates, must be a dictionary that maps document names # to template names. # # This is required for the alabaster theme # refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars # html_sidebars = { # '**': [ # 'relations.html', # needs 'show_related': True theme option to display # 'searchbox.html', # ] # } # -- Options for HTMLHelp output ------------------------------------------ # Output file base name for HTML help builder. htmlhelp_basename = 'Liqdoc' # -- Options for LaTeX output --------------------------------------------- latex_elements = { 'inputenc':'', 'utf8extra': '', 'preamble': r''' \usepackage{fontspec} \IfFontExistsTF{Lato}{\setsansfont{Lato}}{\setsansfont{Arial}} \IfFontExistsTF{Linux Libertine O}{ \setromanfont[Scale=1.1]{Linux Libertine O} }{\setromanfont{Times New Roman}} \IfFontExistsTF{DejaVu Sans Mono}{ \setmonofont[Scale=MatchLowercase]{DejaVu Sans Mono} }{\setmonofont[Scale=MatchLowercase]{Courier}} ''', # The paper size ('letterpaper' or 'a4paper'). # # 'papersize': 'letterpaper', # The font size ('10pt', '11pt' or '12pt'). # # 'pointsize': '10pt', # Additional stuff for the LaTeX preamble. # # 'preamble': '', # Latex figure (float) alignment # # 'figure_align': 'htbp', } # Grouping the document tree into LaTeX files. List of tuples # (source start file, target name, title, # author, documentclass [howto, manual, or own class]). latex_documents = [ (master_doc, 'psmt2-frontend.tex', 'psmt2-frontend Documentation', 'author', 'manual'), ] # -- Options for manual page output --------------------------------------- # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). man_pages = [ (master_doc, 'psmt2-frontend', 'psmt2-frontend Documentation', [author], 1) ] # -- Options for Texinfo output ------------------------------------------- # Grouping the document tree into Texinfo files. List of tuples # (source start file, target name, title, author, # dir menu entry, description, category) texinfo_documents = [ (master_doc, 'psmt2-frontend', 'psmt2-frontend Documentation', author, 'psmt2-frontend', 'One line description of project.', 'Miscellaneous'), ] # -- Ignore fragments in linkcheck linkcheck_anchors = False # -- Options for Epub output ------------------------------------------------- # Bibliographic Dublin Core info. epub_title = project epub_author = author epub_publisher = author epub_copyright = copyright # The unique identifier of the text. This can be a ISBN number # or the project homepage. # # epub_identifier = '' # A unique identification for the text. # # epub_uid = '' # A list of files that should not be packed into the epub file. epub_exclude_files = ['search.html'] # entry point for setup def setup(app): app.add_stylesheet('css/fixes.css') psmt2-frontend-0.4.0/sphinx/index.rst000066400000000000000000000007331402732347700175630ustar00rootroot00000000000000 .. psmt2-frontend documentation master file, created by drom new You can adapt this file completely to your liking, but it should at least contain the root `toctree` directive. Welcome to psmt2-frontend ================ .. toctree:: :maxdepth: 2 :caption: Documentation Home about install license Indices and tables ================== * :ref:`genindex` * :ref:`modindex` * :ref:`search` psmt2-frontend-0.4.0/sphinx/install.rst000066400000000000000000000022531402732347700201210ustar00rootroot00000000000000 How to install ============== Install with :code:`opam` ------------------------- If :code:`psmt2-frontend` is available in your opam repository, you can just call:: opam install psmt2-frontend Build and install with :code:`dune` ----------------------------------- Checkout the sources of :code:`psmt2-frontend` in a directory. You need a switch with at least version :code:`4.04.2` of OCaml, you can for example create it with:: opam switch create 4.10.0 Then, you need to install all the dependencies:: opam install --deps-only . Finally, you can build the package and install it:: eval $(opam env) dune build dune install Note that a :code:`Makefile` is provided, it contains the following targets: * :code:`build`: build the code * :code:`install`: install the generated files * :code:`build-deps`: install opam dependencies * :code:`sphinx`: build sphinx documentation (from the :code:`sphinx/` directory) * :code:`dev-deps`: build development dependencies, in particular :code:`ocamlformat`, :code:`odoc` and :code:`merlin` * :code:`doc`: build documentation with :code:`odoc` * :code:`fmt`: format the code using :code:`ocamlformat` * :code:`test`: run tests psmt2-frontend-0.4.0/sphinx/license.rst000066400000000000000000000002141402732347700200700ustar00rootroot00000000000000 Copyright and License ===================== Copyright (c) 2020 Albin Coquereau This software is distributed under license "Apache-2.0". psmt2-frontend-0.4.0/src/000077500000000000000000000000001402732347700151755ustar00rootroot00000000000000psmt2-frontend-0.4.0/src/bin/000077500000000000000000000000001402732347700157455ustar00rootroot00000000000000psmt2-frontend-0.4.0/src/bin/.merlin000066400000000000000000000003651402732347700172400ustar00rootroot00000000000000EXCLUDE_QUERY_DIR B ../../_build/default/src/bin/.main.eobjs/byte B ../../_build/default/src/lib/.psmt2Frontend.objs/byte S . S ../lib FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs psmt2-frontend-0.4.0/src/bin/dune000066400000000000000000000003531402732347700166240ustar00rootroot00000000000000; generated by drom from package skeleton 'driver' (executable (name main) (public_name psmt2-frontend_bin) (package psmt2-frontend_bin) (libraries psmt2-frontend ) ) (documentation (package psmt2-frontend_bin)) psmt2-frontend-0.4.0/src/bin/index.mld000066400000000000000000000002301402732347700175450ustar00rootroot00000000000000 {1 Program psmt2-frontend_bin} An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. psmt2-frontend-0.4.0/src/bin/main.ml000066400000000000000000000053101402732347700172220ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright (c) 2020 Albin Coquereau *) (* *) (* All rights reserved. *) (* This file is distributed under the terms of the GNU Lesser General *) (* Public License version 2.1, with the special exception on linking *) (* described in the LICENSE.md file in the root directory. *) (* *) (**************************************************************************) open Format module Smtlib_error = Psmt2Frontend.Smtlib_error module Options = Psmt2Frontend.Options module Smtlib_parser = Psmt2Frontend.Smtlib_parser module Smtlib_lexer = Psmt2Frontend.Smtlib_lexer module Smtlib_typing = Psmt2Frontend.Smtlib_typing let fmt = err_formatter let verbose = ref 0 let parse_only = ref false let quiet = ref false let keep_loc = ref false let smt2 = ".smt2" let psmt2 = ".psmt2" let usage = sprintf "usage: %s [options] file%s" Sys.argv.(1) smt2 let spec = [ "-parse-only", Arg.Set parse_only, " stops after parsing"; "-quiet", Arg.Set quiet, " don't print warning"; "-verbose", Arg.Set_int verbose, " 1 : print typed ast, 2 : print typing env"; "-keep_loc", Arg.Set keep_loc, "keep location in AST" ] let file = let file = ref None in let set_file s = if (not (Filename.check_suffix s psmt2)) && (not (Filename.check_suffix s smt2)) then raise (Arg.Bad "invalid extension"); file := Some s in Arg.parse spec set_file usage; Options.set_quiet !quiet; Options.set_verbose !verbose; Options.set_keep_loc !keep_loc; match !file with Some f -> f | None -> Arg.usage spec usage; exit 1 let () = try let in_chan = open_in file in let lexbuf = Lexing.from_channel in_chan in try let parsed = ref (Smtlib_parser.commands Smtlib_lexer.token lexbuf) in if not !parse_only then Smtlib_typing.typing !parsed; if not (Options.quiet ()) then printf "%s@." (Options.status ()); exit 0 with | Smtlib_parser.Error -> let loc = Smtlib_lexer.current_pos lexbuf in Smtlib_error.print fmt file (Syntax_error (Lexing.lexeme lexbuf)) loc; exit 1 |Smtlib_error.Error (e,p) -> let p = match p with | None -> Lexing.dummy_pos,Lexing.dummy_pos | Some p -> p in Smtlib_error.print fmt file e p; exit 1 with |Invalid_argument _ -> fprintf fmt "No input file given@."; exit 1 psmt2-frontend-0.4.0/src/bin/package.toml000066400000000000000000000001531402732347700202340ustar00rootroot00000000000000kind = "program" name = "psmt2-frontend_bin" skeleton = "driver" [dependencies] psmt2-frontend = "version" psmt2-frontend-0.4.0/src/lib/000077500000000000000000000000001402732347700157435ustar00rootroot00000000000000psmt2-frontend-0.4.0/src/lib/.merlin000066400000000000000000000003201402732347700172250ustar00rootroot00000000000000EXCLUDE_QUERY_DIR B ../../_build/default/src/lib/.psmt2Frontend.objs/byte S . FLG -open Psmt2Frontend -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs psmt2-frontend-0.4.0/src/lib/dune000066400000000000000000000004061402732347700166210ustar00rootroot00000000000000; generated by drom from package skeleton 'library' (library (name psmt2Frontend) (public_name psmt2-frontend) (wrapped true) (libraries ) ) (ocamllex smtlib_lexer) (menhir (modules smtlib_parser)) (documentation (package psmt2-frontend)) psmt2-frontend-0.4.0/src/lib/index.mld000066400000000000000000000003261402732347700175510ustar00rootroot00000000000000 {1 Library psmt2-frontend} An OCaml library to parse and type-check a conservative extension of the SMT-LIB 2 standard with prenex polymorphism. The entry point of this library is the module: {!Psmt2Frontend}. psmt2-frontend-0.4.0/src/lib/main.ml000066400000000000000000000015401402732347700172210ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright (c) 2020 Albin Coquereau *) (* *) (* All rights reserved. *) (* This file is distributed under the terms of the *) (* Apache-2.0 license. *) (* *) (**************************************************************************) (* If you delete or rename this file, you should add 'src/psmt2-frontend/main.ml' to the 'skip' field in "drom.toml" *) let main () = Printf.printf "Hello world!\n" psmt2-frontend-0.4.0/src/lib/options.ml000066400000000000000000000032241402732347700177710ustar00rootroot00000000000000let assert_mode = ref false let quiet = ref false let verbose = ref 0 let status = ref "undef" let keep_loc = ref false let warning_as_error = ref false let filename = ref "" let set_assert_mode b = assert_mode := b let set_verbose n = verbose := n let set_quiet b = quiet := b let set_status s = status := s let set_keep_loc b = keep_loc := b let set_warning_as_error b = warning_as_error := b let set_filename f = filename := f let assert_mode () = !assert_mode let status () = !status let quiet () = !quiet let verbose () = !verbose let keep_loc () = !keep_loc let warning_as_error () = !warning_as_error let filename () = !filename let logic = ref false let is_qf = ref false let is_uf = ref false let is_fp = ref false let is_real = ref false let is_int_real = ref false let is_dt = ref false let is_linear = ref false let is_non_linear = ref false let set_logic t = logic := t let set_is_qf t = is_qf := t let set_is_uf t = is_uf := t let set_is_fp t = is_fp := t let set_is_real t = is_real := t let set_is_int_real t = is_int_real := t let set_is_dt t = is_dt := t let set_is_linear t = is_linear := t let set_is_non_linear t = is_non_linear := t let get_logic () = !logic let get_is_qf () = !is_qf let get_is_uf () = !is_uf let get_is_fp () = !is_fp let get_is_real () = !is_real let get_is_int_real () = !is_int_real let get_is_dt () = !is_dt let get_is_linear () = !is_linear let get_is_non_linear () = !is_non_linear let err_fmt = ref Format.err_formatter let get_err_fmt () = !err_fmt let set_err_fmt f = err_fmt := f let check_command c = if assert_mode () then assert false; if not (quiet ()) then Printf.eprintf ";[Warning] (%s not yet supported)\n%!" c psmt2-frontend-0.4.0/src/lib/options.mli000066400000000000000000000021511402732347700201400ustar00rootroot00000000000000val set_verbose : int -> unit val verbose : unit -> int val status : unit -> string val set_status : string -> unit val quiet : unit -> bool val set_quiet : bool -> unit val assert_mode : unit -> bool val set_assert_mode : bool -> unit val keep_loc : unit -> bool val set_keep_loc : bool -> unit val warning_as_error : unit -> bool val set_warning_as_error : bool -> unit val filename : unit -> string val set_filename : string -> unit val set_logic : bool -> unit val set_is_qf : bool -> unit val set_is_uf : bool -> unit val set_is_fp : bool -> unit val set_is_real : bool -> unit val set_is_int_real : bool -> unit val set_is_dt : bool -> unit val set_is_linear : bool -> unit val set_is_non_linear : bool -> unit val get_logic : unit -> bool val get_is_qf : unit -> bool val get_is_uf : unit -> bool val get_is_fp : unit -> bool val get_is_real : unit -> bool val get_is_int_real : unit -> bool val get_is_dt : unit -> bool val get_is_linear : unit -> bool val get_is_non_linear : unit -> bool val set_err_fmt : Format.formatter -> unit val get_err_fmt : unit -> Format.formatter val check_command : string -> unit psmt2-frontend-0.4.0/src/lib/package.toml000066400000000000000000000001601402732347700202300ustar00rootroot00000000000000gen-version = "version.ml" kind = "library" name = "psmt2-frontend" pack = "Psmt2Frontend" skeleton = "library" psmt2-frontend-0.4.0/src/lib/smtlib_error.ml000066400000000000000000000053011402732347700207770ustar00rootroot00000000000000(******************************************************************************) (* *) (* An SMT-LIB 2 for the Alt-Ergo Theorem Prover *) (* *) (******************************************************************************) open Lexing open Format type error = | Lexical_error of string | Syntax_error of string | Typing_error of string | Incremental_error of string | Unknow_Type_error of string | Missing_parameter_error of string | Logic_declaration_error of string | Sort_declaration_error of string | Datatype_declaration_error of string | Quantifier_error of string | Fun_declaration_error of string | Ambiguity_error of string | No_match_error of string | Type_clash_error of string * string exception Error of error * ((Lexing.position * Lexing.position) option) let report_loc fmt file (b,e) = let sfile = match file with | "" -> "; " | s -> sprintf "; File \"%s\"" s in if b = dummy_pos || e = dummy_pos then fprintf fmt "%s : " sfile else let l = b.pos_lnum in let fc = b.pos_cnum - b.pos_bol + 1 in let lc = e.pos_cnum - b.pos_bol + 1 in fprintf fmt "%s, line %d, characters %d-%d : " sfile l fc lc let print fmt f e p = report_loc fmt f p; begin match e with | Lexical_error s -> fprintf fmt "Lexical error : %s" s | Syntax_error s -> fprintf fmt "Syntax error : %s" s | Typing_error s -> fprintf fmt "Typing error : %s" s | Incremental_error s -> fprintf fmt "Incremental error : %s" s | Unknow_Type_error s -> fprintf fmt "Unknown sort/type : %s" s | Missing_parameter_error s -> fprintf fmt "Missing parameter : %s" s | Logic_declaration_error s -> fprintf fmt "Logic declaration error : %s" s | Sort_declaration_error s -> fprintf fmt "Sort declaration error : %s" s | Fun_declaration_error s -> fprintf fmt "Fun declaration error : %s" s | Datatype_declaration_error s -> fprintf fmt "Datatypes declaration error : %s" s | Quantifier_error s -> fprintf fmt "Quantifier error : %s" s | Ambiguity_error s -> fprintf fmt "Ambiguity error : %s" s | No_match_error s -> fprintf fmt "No match for : %s" s | Type_clash_error(t1,t2) -> fprintf fmt "Clash type between : %s / %s" t1 t2 end; fprintf fmt "@." let error e p = (* print err_formatter "" e p; *) raise (Error (e,p)) let warning fmt e p = if Options.warning_as_error () then error e p else let p = match p with | None -> Lexing.dummy_pos,Lexing.dummy_pos | Some p -> p in print fmt (Options.filename ()) e p psmt2-frontend-0.4.0/src/lib/smtlib_lexer.mll000066400000000000000000000112211402732347700211370ustar00rootroot00000000000000(******************************************************************************) (* *) (* An SMT-LIB 2 for the Alt-Ergo Theorem Prover *) (* *) (******************************************************************************) { open Lexing open Smtlib_parser open Smtlib_error let newline lexbuf = let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum } let current_pos b = lexeme_start_p b, lexeme_end_p b let keyword = Hashtbl.create 50 let () = List.iter (fun (x,y) -> Hashtbl.add keyword x y) [ ":all-statistics", ALLSTATS; ":assertion-stack-levels", ASSERTIONSTACKLVL; ":authors", AUTHORS; ":author", AUTHORS; ":axioms", AXIOMS; ":category",CATEGORY; ":definition", DEFINITIO; ":diagnostic-output-channel", DIAGNOOUTPUTCHAN; ":difficulty", DIFFICULTY; ":error-behavior", ERRORBEHAV; ":extensions",EXTENSIONS; ":funs",FUNS; ":funs-description",FUNSDESCRIPT; ":global-declarations", GLOBALDECLARATIONS; ":incremental", INCREMENTAL; ":instance", INSTANCE; ":interactive-mode", INTERACTIVE; ":language",LANGUAGE; ":license", LICENSE; ":name",NAME; ":named",NAMED; ":notes",NOTES; ":pattern", PATTERN; ":print-success",PRINTSUCCESS; ":produce-assertions", PRODUCEASSERTIONS; ":produce-assignments",PRODUCEASSIGNEMENT; ":produce-unsat-assumptions", PRODUCEUNSATASSUMPTIONS; ":produce-models",PRODUCEMODELS; ":produce-proofs",PRODUCEPROOFS; ":produce-unsat-cores",PRODUCEUNSATCORES; ":random-seed",RANDOMSEED; ":reason-unknown",REASONUNKNOWN; ":reproducible-ressource-limit",RESSOURCELIMIT; ":regular-output-channel",REGULAROUTPUTCHAN; ":series",SERIES; ":smt-lib-version",SMTLIBVERSION; ":sorts",SORTS; ":sorts-description",SORTSDESCRIPTION; ":source",SOURCE; ":status",STATUTS; ":theories",THEORIES; ":values",VALUES; ":verbosity",VERBOSITY; ":version",VERSION; ] } rule token = parse | ['\t' ' ' ]+ { token lexbuf } | ';' (_ # '\n')* { token lexbuf } | '\n' { new_line lexbuf; token lexbuf } | "_" { UNDERSCORE } | "(" { LP } | ")" { RP } | "par" { PAR } | "as" { AS } | "let" { LET } | "forall" { FORALL } | "exists" { EXISTS } | "match" { MATCH } | "!" { EXCLIMATIONPT } | "set-logic" { SETLOGIC } | "set-option" { SETOPTION } | "set-info" { SETINFO } | "declare-sort" { DECLARESORT } | "define-sort" { DEFINESORT } | "declare-const" { DECLARECONST } | "declare-fun" { DECLAREFUN } | "define-fun" { DEFINEFUN } | "define-fun-rec" { DEFINEFUNREC } | "define-funs-rec" { DEFINEFUNSREC } | "declare-datatypes" {DECLAREDATATYPES} | "declare-datatype" {DECLAREDATATYPE} | "push" { PUSH } | "pop" { POP } | "echo" { ECHO } | "assert" { ASSERT } | "check-sat" { CHECKSAT } | "check-all-sat" { CHECKALLSAT } | "check-sat-assuming" { CHECKSATASSUMING } | "check-entailment" { CHECKENTAILMENT } | "get-assertions" { GETASSERT } | "get-proof" { GETPROOF } | "get-unsat-core" { GETUNSATCORE } | "get-value" { GETVALUE } | "get-assignment" { GETASSIGN } | "get-unsat-assumptions" { GETUNSATASSUMPTIONS } | "get-option" { GETOPTION } | "get-info" { GETINFO } | "get-model" { GETMODEL } | "reset" { RESET } | "reset-assertions" { RESETASSERTIONS } | "exit" { EXIT } | '#' ('x' ['0'-'9' 'A'-'F' 'a'-'f']+ as str) { HEXADECIMAL("0" ^ str) } | '#' ('b' ['0'-'1']+ as str) { BINARY("0" ^ str) } | '|' (['!'-'~' '\128'-'\255' ' ' '\n' '\t' '\r'] # ['|'])* '|' as str { ASCIIWOR(str) } | ':' ['a'-'z' 'A'-'Z' '0'-'9' '+' '-' '/' '*' '=' '%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@']+ as str { try Hashtbl.find keyword str with Not_found -> error (Lexical_error ("unknown Keyword : " ^ lexeme lexbuf)) (Some (current_pos lexbuf)) } | ['a'-'z' 'A'-'Z' '+' '-' '/' '*' '=''%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@'] ['a'-'z' 'A'-'Z' '0'-'9' '+' '-' '/' '*' '=''%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@']* as str { SYMBOL(str) } | '"' { comment "" lexbuf } | '0'* ( '0' | ['1'-'9'] ['0'-'9']* ) '.' ['0'-'9']+ as str { DECIMAL(str) } | '0'* ( '0' | ['1'-'9'] ['0'-'9']* ) as str { NUMERAL(str) } | eof { EOF } | _ {error (Lexical_error ("empty token " ^ lexeme lexbuf)) (Some (current_pos lexbuf)) } and comment acc = parse | "\"\"" { comment (Printf.sprintf "%s\"" acc) lexbuf } | '"' { STRINGLIT(acc)} | _ as c { comment (Printf.sprintf "%s%c" acc c) lexbuf } {} psmt2-frontend-0.4.0/src/lib/smtlib_parser.mly000066400000000000000000000325151402732347700213420ustar00rootroot00000000000000/******************************************************************************/ /* */ /* An SMT-LIB 2 for the Alt-Ergo Theorem Prover */ /* */ /******************************************************************************/ %{ open Smtlib_syntax let mk_data p c = let p = if Options.keep_loc () then Some p else None in {p;c;ty= Smtlib_ty.new_type Smtlib_ty.TDummy;is_quantif=false} %} %start commands %start term %start term_list %token EOF AS EXISTS FORALL LET LP POP PUSH ECHO RP UNDERSCORE PAR PATTERN MATCH EXCLIMATIONPT %token ASSERT CHECKSAT CHECKALLSAT EXIT RESET RESETASSERTIONS CHECKSATASSUMING CHECKENTAILMENT DECLAREFUN DECLARESORT DECLARECONST DECLAREDATATYPES DECLAREDATATYPE DEFINEFUN DEFINEFUNREC DEFINEFUNSREC DEFINESORT GETASSERT GETASSIGN GETINFO GETOPTION GETPROOF GETUNSATCORE GETVALUE GETMODEL GETUNSATASSUMPTIONS SETINFO SETLOGIC SETOPTION %token ALLSTATS AUTHORS AUTHOR AXIOMS CATEGORY DEFINITIO DIFFICULTY INCREMENTAL INSTANCE DIAGNOOUTPUTCHAN ERRORBEHAV EXTENSIONS FUNS FUNSDESCRIPT GLOBALDECLARATIONS INTERACTIVE LANGUAGE LICENSE NAME NAMED NOTES SERIES PRODUCEASSERTIONS PRINTSUCCESS PRODUCEUNSATASSUMPTIONS PRODUCEASSIGNEMENT PRODUCEMODELS PRODUCEPROOFS PRODUCEUNSATCORES RANDOMSEED REASONUNKNOWN REGULAROUTPUTCHAN SOURCE SMTLIBVERSION SORTS SORTSDESCRIPTION STATUTS THEORIES VALUES VERBOSITY VERSION RESSOURCELIMIT ASSERTIONSTACKLVL %token ASCIIWOR BINARY DECIMAL HEXADECIMAL NUMERAL STRINGLIT SYMBOL %type commands %type command %type term %type term_list %type varbinding %type qualidentifier %type sorted_var %type sort %type identifier %type attribute_value %type sexpr %type symbol %type key_option %type key_info %type key_term %type keyword %% /*************************************************************************/ term_list: | list(term) { $1,true} constant: | DECIMAL { Const_Dec $1 } | NUMERAL { Const_Num $1 } | STRINGLIT { Const_Str $1 } | HEXADECIMAL { Const_Hex $1 } | BINARY { Const_Bin $1 } symbol: | SYMBOL { mk_data ($startpos,$endpos) ($1) } | ASCIIWOR { mk_data ($startpos,$endpos) ($1) } index: | symbol { mk_data ($startpos,$endpos) (IndexSymbol $1) } | NUMERAL { mk_data ($startpos,$endpos) (IndexNumeral $1) } identifier: | symbol { mk_data ($startpos,$endpos) (IdSymbol $1) } | LP UNDERSCORE symbol nonempty_list(index) RP { mk_data ($startpos,$endpos) (IdUnderscoreSymNum($3, $4)) } prop_literal: | symbol { mk_data ($startpos,$endpos) (PropLit $1) } | LP symbol symbol RP { mk_data ($startpos,$endpos) (if $2.c <> "not" then failwith "Prop literal can only be literal and negated literal" ; PropLitNot $3) } sort: | identifier { mk_data ($startpos,$endpos) (SortIdentifier $1) } | LP identifier nonempty_list(sort) RP { mk_data ($startpos,$endpos) (SortIdMulti($2, $3)) } /*************************************************************************/ attribute_value: | constant { mk_data ($startpos,$endpos) (AttributeValSpecConst $1) } | symbol { mk_data ($startpos,$endpos) (AttributeValSymbol $1) } | LP list(sexpr) RP { mk_data ($startpos,$endpos) (AttributeValSexpr $2) } attribute: | key_info { mk_data ($startpos,$endpos) (AttributeKey $1) } | key_info attribute_value { mk_data ($startpos,$endpos) (AttributeKeyValue($1,$2)) } sexpr: | constant { mk_data ($startpos,$endpos) (SexprSpecConst $1) } | symbol { mk_data ($startpos,$endpos) (SexprSymbol $1) } | keyword { mk_data ($startpos,$endpos) (SexprKeyword $1) } | LP list(sexpr) RP { mk_data ($startpos,$endpos) (SexprInParen $2) } /*************************************************************************/ varbinding: | LP symbol term RP { $2,$3 } sorted_var: | LP symbol sort RP { $2,$3 } qualidentifier: | identifier { mk_data ($startpos,$endpos) (QualIdentifierId $1) } | LP AS identifier sort RP { mk_data ($startpos,$endpos) (QualIdentifierAs($3, $4)) } pattern: | symbol { mk_data ($startpos,$endpos) (MatchPattern ($1, [])) } | UNDERSCORE { mk_data ($startpos,$endpos) MatchUnderscore } | LP symbol nonempty_list(symbol) RP { mk_data ($startpos,$endpos) (MatchPattern ($2, $3)) } match_case: | LP pattern term RP { ($2,$3) } term: | constant { mk_data ($startpos,$endpos) (TermSpecConst $1) } | qualidentifier { mk_data ($startpos,$endpos) (TermQualIdentifier $1) } | LP qualidentifier nonempty_list(term) RP { mk_data ($startpos,$endpos) (TermQualIdTerm ($2, $3)) } | LP LET LP nonempty_list(varbinding) RP term RP { mk_data ($startpos,$endpos) (TermLetTerm ($4, $6)) } | LP LET LP RP term RP { $5 } | LP FORALL LP nonempty_list(sorted_var) RP term RP { mk_data ($startpos,$endpos) (TermForAllTerm ($4, $6)) } | LP EXISTS LP nonempty_list(sorted_var) RP term RP { mk_data ($startpos,$endpos) (TermExistsTerm ($4, $6)) } | LP MATCH term LP nonempty_list(match_case) RP RP { mk_data ($startpos,$endpos) (TermMatch ($3, $5)) } | LP EXCLIMATIONPT term list(key_term) RP { mk_data ($startpos,$endpos) (TermExclimationPt ($3, $4)) } /** keyword *******************************************/ keyword : | CATEGORY {mk_data ($startpos,$endpos) Category } | SMTLIBVERSION {mk_data ($startpos,$endpos) Smtlibversion } | SOURCE {mk_data ($startpos,$endpos) Source } | STATUTS symbol {Options.set_status $2.c;mk_data ($startpos,$endpos) (Statuts $2) } | LICENSE {mk_data ($startpos,$endpos) License } | NOTES {mk_data ($startpos,$endpos) Notes } | AXIOMS {mk_data ($startpos,$endpos) Axioms } | DEFINITIO {mk_data ($startpos,$endpos) Definitio } | EXTENSIONS {mk_data ($startpos,$endpos) Extensions } | FUNS {mk_data ($startpos,$endpos) Funs } | FUNSDESCRIPT {mk_data ($startpos,$endpos) FunsDescript } | LANGUAGE {mk_data ($startpos,$endpos) Language } | SORTS {mk_data ($startpos,$endpos) Sorts } | SORTSDESCRIPTION {mk_data ($startpos,$endpos) SortsDescr } | THEORIES {mk_data ($startpos,$endpos) Theories } | VALUES {mk_data ($startpos,$endpos) Values } key_option: | DIAGNOOUTPUTCHAN {mk_data ($startpos,$endpos) Diagnooutputchan } | GLOBALDECLARATIONS {mk_data ($startpos,$endpos) Globaldeclarations } | INTERACTIVE {mk_data ($startpos,$endpos) Interactive } | PRINTSUCCESS {mk_data ($startpos,$endpos) Printsucces } | PRODUCEASSERTIONS {mk_data ($startpos,$endpos) Produceassertions } | PRODUCEASSIGNEMENT {mk_data ($startpos,$endpos) Produceassignement } | PRODUCEMODELS {mk_data ($startpos,$endpos) Producemodels } | PRODUCEPROOFS {mk_data ($startpos,$endpos) Produceproofs } | PRODUCEUNSATASSUMPTIONS {mk_data ($startpos,$endpos) Produceunsatassumptions } | PRODUCEUNSATCORES {mk_data ($startpos,$endpos) Produceunsatcores } | RANDOMSEED {mk_data ($startpos,$endpos) Randomseed } | REGULAROUTPUTCHAN {mk_data ($startpos,$endpos) Regularoutputchan } | VERBOSITY {mk_data ($startpos,$endpos) Verbosity } | RESSOURCELIMIT {mk_data ($startpos,$endpos) Ressourcelimit } option: | key_option index {mk_data ($startpos,$endpos) (Option_key ($1,$2)) } | attribute {mk_data ($startpos,$endpos) (Option_attribute $1) } key_info: | ALLSTATS {mk_data ($startpos,$endpos) Allstats } | ASSERTIONSTACKLVL {mk_data ($startpos,$endpos) Assertionstacklvl } | AUTHORS {mk_data ($startpos,$endpos) Authors } | AUTHOR {mk_data ($startpos,$endpos) Authors } | DIFFICULTY {mk_data ($startpos,$endpos) Difficulty } | ERRORBEHAV {mk_data ($startpos,$endpos) Errorbehav } | INCREMENTAL {mk_data ($startpos,$endpos) Incremental } | INSTANCE {mk_data ($startpos,$endpos) Instance } | NAME {mk_data ($startpos,$endpos) Name } | REASONUNKNOWN {mk_data ($startpos,$endpos) Reasonunknown } | SERIES {mk_data ($startpos,$endpos) Series } | VERSION {mk_data ($startpos,$endpos) Version } | keyword {mk_data ($startpos,$endpos) (Key_info $1) } key_term: | PATTERN LP nonempty_list(term) RP { mk_data ($startpos,$endpos) (Pattern $3) } | NAMED symbol { mk_data ($startpos,$endpos) (Named $2) } /*** Datatypes ************************************************************/ selector_dec: | LP symbol sort RP { ($2,$3) } constructor_dec: | LP symbol list(selector_dec) RP { $2,$3 } datatype_dec: | LP nonempty_list(constructor_dec) RP { [],$2 } | LP PAR LP nonempty_list(symbol) RP LP nonempty_list(constructor_dec) RP RP { $4,$7 } sort_dec: | LP symbol NUMERAL RP { ($2,$3) } /*** Functions *************************************************************/ const_dec: | sort { [],$1 } | LP PAR LP nonempty_list(symbol) RP sort RP { $4,$6 } fun_dec: | LP list(sort) RP sort { [],$2,$4 } | LP PAR LP nonempty_list(symbol) RP LP list(sort) RP sort RP { ($4,$7,$9) } fun_def: | symbol LP list(sorted_var) RP sort { $1,[],$3,$5 } | symbol LP PAR LP nonempty_list(symbol) RP LP list(sorted_var) RP sort RP { $1,$5,$8,$10 } fun_defs: | LP fun_def RP { $2 } /*** Asserts ***************************************************************/ assert_dec: | term { [],$1 } | LP PAR LP nonempty_list(symbol) RP term RP { $4,$6 } /*** Commands **************************************************************/ command: | LP ASSERT assert_dec RP {mk_data ($startpos,$endpos) (Cmd_Assert ($3)) } | LP CHECKSAT RP {mk_data ($startpos,$endpos) (Cmd_CheckSat) } | LP CHECKSATASSUMING LP list(prop_literal) RP RP {mk_data ($startpos,$endpos) (Cmd_CheckSatAssum $4) } | LP CHECKENTAILMENT assert_dec RP {mk_data ($startpos,$endpos) (Cmd_CheckEntailment $3) } | LP CHECKALLSAT list(symbol) RP {mk_data ($startpos,$endpos) (Cmd_CheckAllSat $3) } | LP DECLARECONST symbol const_dec RP {mk_data ($startpos,$endpos) (Cmd_DeclareConst ($3,$4)) } | LP DECLAREDATATYPE symbol datatype_dec RP { mk_data ($startpos,$endpos) (Cmd_DeclareDataType ($3,$4)) } | LP DECLAREDATATYPES LP nonempty_list(sort_dec) RP LP nonempty_list(datatype_dec) RP RP { mk_data ($startpos,$endpos) (Cmd_DeclareDataTypes ($4,$7)) } | LP DECLAREFUN symbol fun_dec RP {mk_data ($startpos,$endpos) (Cmd_DeclareFun($3, $4)) } | LP DECLARESORT symbol NUMERAL RP {mk_data ($startpos,$endpos) (Cmd_DeclareSort ($3, $4)) } | LP DEFINEFUN fun_def term RP {mk_data ($startpos,$endpos) (Cmd_DefineFun ($3,$4)) } | LP DEFINEFUNREC fun_def term RP {mk_data ($startpos,$endpos) (Cmd_DefineFunRec ($3,$4)) } | LP DEFINEFUNSREC LP list(fun_defs) RP LP nonempty_list(term) RP RP {mk_data ($startpos,$endpos) (Cmd_DefineFunsRec ($4,$7)) } | LP DEFINESORT symbol LP list(symbol) RP sort RP {mk_data ($startpos,$endpos) (Cmd_DefineSort($3, $5, $7)) } | LP ECHO symbol RP {mk_data ($startpos,$endpos) (Cmd_Echo $3) } | LP EXIT RP {mk_data ($startpos,$endpos) (Cmd_Exit) } | LP GETASSERT RP {mk_data ($startpos,$endpos) (Cmd_GetAssert) } | LP GETASSIGN RP {mk_data ($startpos,$endpos) (Cmd_GetAssign) } | LP GETINFO key_info RP {mk_data ($startpos,$endpos) (Cmd_GetInfo $3) } | LP GETMODEL RP {mk_data ($startpos,$endpos) (Cmd_GetModel) } | LP GETOPTION keyword RP {mk_data ($startpos,$endpos) (Cmd_GetOption $3) } | LP GETPROOF RP {mk_data ($startpos,$endpos) (Cmd_GetProof) } | LP GETUNSATASSUMPTIONS RP {mk_data ($startpos,$endpos) (Cmd_GetUnsatAssumptions) } | LP GETUNSATCORE RP {mk_data ($startpos,$endpos) (Cmd_GetUnsatCore) } | LP GETVALUE LP nonempty_list(term) RP RP {mk_data ($startpos,$endpos) (Cmd_GetValue $4) } | LP PUSH NUMERAL RP {mk_data ($startpos,$endpos) (Cmd_Push $3) } | LP POP NUMERAL RP {mk_data ($startpos,$endpos) (Cmd_Pop $3) } | LP RESET RP {mk_data ($startpos,$endpos) (Cmd_Reset) } | LP RESETASSERTIONS RP {mk_data ($startpos,$endpos) (Cmd_ResetAssert) } | LP SETINFO attribute RP {mk_data ($startpos,$endpos) (Cmd_SetInfo $3) } | LP SETLOGIC symbol RP {Options.set_logic true; mk_data ($startpos,$endpos) (Cmd_SetLogic $3) } | LP SETOPTION option RP {mk_data ($startpos,$endpos) (Cmd_SetOption $3) } | LP symbol term RP { let { c = cmd; p; _ } = $2 in let t = $3 in match cmd with | "minimize" -> mk_data ($startpos,$endpos) (Cmd_Minimize t) | "maximize" -> mk_data ($startpos,$endpos) (Cmd_Maximize t) | _ -> let err = Format.sprintf "Unexpected command %S" cmd in raise Smtlib_error.(Error (Syntax_error err, p)) } commands: | EOF { [] } | command commands { $1::$2 } %% psmt2-frontend-0.4.0/src/lib/smtlib_printer.ml000066400000000000000000000206241402732347700213360ustar00rootroot00000000000000open Smtlib_syntax open Smtlib_typed_env open Smtlib_ty open Printf let print_ty = false let fmt = stderr let print_list f l = (List.fold_left (fun acc a -> sprintf "%s %s" acc (f a) ) "" l) let print_constant cst = match cst with | Const_Dec s | Const_Num s | Const_Str s | Const_Hex s | Const_Bin s -> s let print_identifier id = match id.c with | IdSymbol s -> s.c | IdUnderscoreSymNum _ -> Options.check_command "printer for (_ .."; "" let rec print_sort s = match s.c with | SortIdentifier id -> if true || print_ty then sprintf "%s:%s" (print_identifier id) (to_string s.ty) else (print_identifier id) | SortIdMulti (id,sl) -> let sl = List.map print_sort sl in if print_ty then sprintf "(%s:%s %s)" (print_identifier id) (to_string s.ty) (String.concat " " sl) else sprintf "(%s %s)" (print_identifier id) (String.concat " " sl) let print_sorted_var (symb,sort) = sprintf "(%s %s)" symb.c (print_sort sort) let print_qualid qid = match qid.c with | QualIdentifierId(id) -> if print_ty then sprintf "%s:%s" (print_identifier id) (to_string qid.ty) else print_identifier id | QualIdentifierAs(id,sort) -> sprintf "(as %s %s)" (print_identifier id) (print_sort sort) let rec print_var_binding (var,bind) = sprintf "(%s %s)" var.c (print_term bind) and print_var_bindings varbindings = List.fold_left (fun acc varbinding -> sprintf "%s %s" acc (print_var_binding varbinding)) "" varbindings and print_term t = let s = match t.c with | TermSpecConst cst -> print_constant cst | TermQualIdentifier qid -> print_qualid qid | TermQualIdTerm (qid,tl) -> let tl = List.map print_term tl in sprintf "(%s %s)" (print_qualid qid) (String.concat " " tl) | TermLetTerm (varbinding_list,term) -> sprintf "(let (%s) %s)" (print_var_bindings varbinding_list) (print_term term) | TermForAllTerm (sorted_vars,term) -> sprintf "(forall (%s) %s)" (print_sorted_vars sorted_vars) (print_term term) | TermExistsTerm (sorted_vars,term) -> sprintf "(exists (%s) %s)" (print_sorted_vars sorted_vars) (print_term term) | TermExclimationPt (term,_key_term_list) -> (print_term term) | TermMatch (_term,_pattern_term_list) -> Options.check_command "printer for match terms"; "" in sprintf "%s:%s " s ((to_string t.ty)) and print_pars pars = List.fold_left (fun acc par -> sprintf "%s %s:%s" acc par.c (to_string par.ty)) "" pars and print_sorts sorts = List.fold_left (fun acc sort -> sprintf "%s %s" acc (print_sort sort)) "" sorts and print_sorted_vars sorted_vars = List.fold_left (fun acc sort -> sprintf "%s %s" acc (print_sorted_var sort)) "" sorted_vars let print_assert pars t = if pars = [] then sprintf "%s" (print_term t) else sprintf "(par (%s) %s)" (print_pars pars) (print_term t) let print_const_dec pars sort = match pars with | [] -> print_sort sort | _ -> sprintf "(par (%s) %s)" (print_pars pars) (print_sort sort) let print_fun_dec (pars,sl,s) = match pars with | [] -> sprintf "(%s) %s" (print_sorts sl) (print_sort s) | _ -> sprintf "(par (%s) (%s) %s)" (print_pars pars) (print_sorts sl) (print_sort s) let print_fun_def (symb,pars,svl,s) = match pars with | [] -> sprintf "%s (%s) %s" symb.c (print_sorted_vars svl) (print_sort s) | _ -> sprintf "%s (par (%s) (%s) %s)" symb.c (print_pars pars) (print_sorted_vars svl) (print_sort s) let print_sort_dec (s,n) = sprintf "(%s %s)" s.c n let print_selector (s,sort) = sprintf "(%s %s)" s.c (print_sort sort) let print_cst_dec (s,selector_list) = sprintf "(%s %s)" s.c (print_list print_selector selector_list) let print_dt_dec (pars,cst_dec_list) = match pars with | [] -> sprintf "(%s)" (print_list print_cst_dec cst_dec_list) | _ -> sprintf "(par (%s) (%s))" (print_pars pars) (print_list print_cst_dec cst_dec_list) let print_pro_lit p = match p.c with | PropLit(s) -> sprintf "%s" s.c | PropLitNot(s) -> sprintf "(not %s)" s.c let print_option _o = Options.check_command "printer for get/set-option"; "" let print_info _key_info = Options.check_command "printer for get/set-option"; "" let print_attribute _a = Options.check_command "printer for get/set-option"; "" let print_command c = match c.c with | Cmd_Assert(pars,t) -> printf "(assert %s)\n%!" (print_assert pars t) | Cmd_CheckEntailment(dec) -> let pars,t = dec in printf "(check-entailment %s)\n%!" (print_assert pars t) | Cmd_CheckSat -> printf "(checksat)\n%!" | Cmd_CheckSatAssum prop_lit_list -> printf "(check-sat-assuming %s)\n%!" (print_list print_pro_lit prop_lit_list) | Cmd_CheckAllSat tl -> let tl = List.map (fun symb -> symb.c) tl in let s = String.concat " " tl in printf "(check-all-sat %s)\n%!" s | Cmd_DeclareConst(symbol,(pars,sort)) -> printf "(declare-const %s %s)\n%!" symbol.c (print_const_dec pars sort) | Cmd_DeclareDataType(symbol,(pars,dt_dec)) -> printf "(declare-datatype %s %s)\n%!" symbol.c (print_dt_dec (pars,dt_dec)) | Cmd_DeclareDataTypes(sort_dec_list,dt_dec_list) -> printf "(declare-datatypes %s %s)\n%!" (print_list print_sort_dec sort_dec_list) (print_list print_dt_dec dt_dec_list) | Cmd_DeclareFun(symbol,fun_dec) -> printf "(declare-fun %s %s)\n%!" symbol.c (print_fun_dec fun_dec) | Cmd_DeclareSort(symbol,s) -> printf "(declare-sort %s %s)\n%!" symbol.c s | Cmd_DefineFun(fun_def,term) -> printf "(define-fun %s %s)\n%!" (print_fun_def fun_def) (print_term term) | Cmd_DefineFunRec(fun_def,term) -> printf "(define-fun-rec %s %s)\n%!" (print_fun_def fun_def) (print_term term) | Cmd_DefineFunsRec(fun_def_list,term_list) -> printf "(define-fun-rec %s %s)\n%!" (print_list print_fun_def fun_def_list) (print_list print_term term_list) | Cmd_DefineSort(symbol,symbol_list,sort) -> printf "(define-sort %s (%s) %s)\n" symbol.c (print_pars symbol_list) (print_sort sort) | Cmd_Echo(s) -> printf "(echo %s)\n" s.c | Cmd_GetAssert -> printf "(get-assertions)\n" | Cmd_GetProof -> printf "(get-proof)\n" | Cmd_GetUnsatCore -> printf "(get-unsat-core)\n" | Cmd_GetValue(term_list) -> printf "(get-value %s)\n" (print_list print_term term_list) | Cmd_GetAssign -> printf "(get-assignement)\n" | Cmd_GetOption(o) -> printf "(get-option %s)\n" (print_option o) | Cmd_GetInfo(key_info) -> printf "(get-info %s)\n" (print_info key_info) | Cmd_GetModel -> printf "(get-model)\n" | Cmd_GetUnsatAssumptions -> printf "(get-unsat-assumptions)\n" | Cmd_Reset -> printf "(reset)\n" | Cmd_ResetAssert -> printf "(reset-assertions)\n" | Cmd_SetLogic(s) -> printf "(set-logic %s)\n%!" s.c | Cmd_SetOption(o) -> printf "(set-option %s)\n%!" (print_option o) | Cmd_SetInfo(a) -> printf "(set-info %s)\n%!" (print_attribute a) | Cmd_Push(n) -> printf "(push %s)\n%!" n | Cmd_Pop(n) -> printf "(pop %s)\n%!" n | Cmd_Exit -> printf "(exit)\n" | Cmd_Minimize t -> printf "(minimize %s)\n%!" (print_term t) | Cmd_Maximize t -> printf "(minimize %s)\n%!" (print_term t) let print commands = List.iter print_command commands (****************** Env printer **********************) (******************************************************************************) (*********************************** Printer **********************************) let print_sort s (arit_s, arit_t) = Printf.printf "%s : %d / %d \n%!" s arit_s arit_t let print_fun s fun_def = Printf.printf "%s : %s \n%!" s (Smtlib_ty.to_string fun_def.params) let print_par_fun s _fun_def = Printf.printf "%s : par fun \n%!" s let print_env env = Printf.printf ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n%!"; Printf.printf ";;;;;;;;;;;;;;;;;;;;;;; Sorts;;; ;;;;;;;;;;;;;;;;;\n%!"; SMap.iter (fun s (arit, _) -> print_sort s arit ) env.sorts; Printf.printf ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n%!"; Printf.printf ";;;;;;;;;;;;;;;;;;;;;;; Funs ;;;;;;;;;;;;;;;;;;;;;\n%!"; SMap.iter (fun s fun_defs -> List.iter (fun fun_def -> print_fun s fun_def ) fun_defs ) env.funs; Printf.printf ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n%!"; Printf.printf ";;;;;;;;;;;;;;;;;;;;;;; Par funs ;;;;;;;;;;;;;;;;;\n%!"; SMap.iter (fun s fun_defs -> List.iter (fun fun_def -> print_par_fun s fun_def ) fun_defs ) env.par_funs psmt2-frontend-0.4.0/src/lib/smtlib_syntax.ml000066400000000000000000000120351402732347700211760ustar00rootroot00000000000000(******************************************************************************) (* *) (* An SMT-LIB 2 for the Alt-Ergo Theorem Prover *) (* *) (******************************************************************************) type 'a data = { p : (Lexing.position * Lexing.position) option ; c : 'a ; ty : Smtlib_ty.ty; mutable is_quantif : bool} type constant = | Const_Dec of string | Const_Num of string | Const_Str of string | Const_Hex of string | Const_Bin of string type symbol = string data type keyword_aux = | Category | Smtlibversion | Source | Statuts of symbol | License | Notes | Axioms | Definitio | Extensions | Funs | FunsDescript | Language | Sorts | SortsDescr | Theories | Values and keyword = keyword_aux data and key_option_aux = | Diagnooutputchan | Globaldeclarations | Interactive | Printsucces | Produceassertions | Produceassignement | Producemodels | Produceproofs | Produceunsatassumptions | Produceunsatcores | Randomseed | Regularoutputchan | Verbosity | Ressourcelimit and key_option = key_option_aux data and option_aux = | Option_key of key_option * index | Option_attribute of attribute and option = option_aux data and key_info_aux = | Allstats | Assertionstacklvl | Authors | Difficulty | Errorbehav | Incremental | Instance | Name | Reasonunknown | Series | Version | Key_info of keyword and key_info = key_info_aux data and key_term_aux = | Pattern of term list | Named of symbol and key_term = key_term_aux data (* attributes *) and sexpr_aux = | SexprSpecConst of constant | SexprSymbol of symbol | SexprKeyword of keyword | SexprInParen of sexpr list and sexpr = sexpr_aux data and attribute_value_aux = | AttributeValSpecConst of constant | AttributeValSymbol of symbol | AttributeValSexpr of sexpr list | NoAttributeValue and attribute_value = attribute_value_aux data and attribute_aux = | AttributeKey of key_info | AttributeKeyValue of key_info * attribute_value and attribute = attribute_aux data (* index *) and index_aux = | IndexSymbol of symbol | IndexNumeral of string and index = index_aux data (* identifiers *) and identifier_aux = | IdSymbol of symbol | IdUnderscoreSymNum of symbol * index list and identifier = identifier_aux data and prop_literal_aux = | PropLit of symbol | PropLitNot of symbol and prop_literal = prop_literal_aux data (* sorts and polymorphism *) and sort_aux = | SortIdentifier of identifier | SortIdMulti of identifier * sort list and sort = sort_aux data (* typed variable *) and sorted_var = symbol * sort (* qualidentifiers *) and qualidentifier_aux = | QualIdentifierId of identifier | QualIdentifierAs of identifier * sort and qualidentifier = qualidentifier_aux data (* valued variable *) and varbinding = symbol * term (* pattern *) and pattern_aux = | MatchPattern of (symbol * symbol list) | MatchUnderscore and pattern = pattern_aux data (* terms *) and term_aux = | TermSpecConst of constant | TermQualIdentifier of qualidentifier | TermQualIdTerm of qualidentifier * term list | TermLetTerm of varbinding list * term | TermForAllTerm of sorted_var list * term | TermExistsTerm of sorted_var list * term | TermExclimationPt of term * key_term list | TermMatch of term * (pattern * term) list and term = term_aux data (* datatypes *) and sort_dec = symbol * string and selector_dec = symbol * sort and constructor_dec = symbol * selector_dec list (* script commands *) type command_aux = | Cmd_Assert of (symbol list * term) | Cmd_CheckSat | Cmd_CheckAllSat of symbol list | Cmd_CheckSatAssum of prop_literal list | Cmd_CheckEntailment of (symbol list * term) | Cmd_DeclareConst of symbol * (symbol list * sort) | Cmd_DeclareDataType of symbol * ((symbol list) * (constructor_dec list)) | Cmd_DeclareDataTypes of sort_dec list * ((symbol list) * (constructor_dec list)) list | Cmd_DeclareFun of symbol * (symbol list * sort list * sort) | Cmd_DeclareSort of symbol * string | Cmd_DefineFun of (symbol * symbol list * sorted_var list * sort) * term | Cmd_DefineFunRec of (symbol * symbol list * sorted_var list * sort) * term | Cmd_DefineFunsRec of (symbol * symbol list * sorted_var list * sort) list * term list | Cmd_DefineSort of symbol * symbol list * sort | Cmd_Echo of symbol | Cmd_GetAssert | Cmd_GetProof | Cmd_GetUnsatCore | Cmd_GetValue of term list | Cmd_GetAssign | Cmd_GetOption of keyword | Cmd_GetInfo of key_info | Cmd_GetModel | Cmd_GetUnsatAssumptions | Cmd_Reset | Cmd_ResetAssert | Cmd_SetLogic of symbol | Cmd_SetOption of option | Cmd_SetInfo of attribute | Cmd_Push of string | Cmd_Pop of string | Cmd_Exit | Cmd_Maximize of term | Cmd_Minimize of term type command = command_aux data type commands = command list (*******************************************************************) psmt2-frontend-0.4.0/src/lib/smtlib_ty.ml000066400000000000000000000170011402732347700203020ustar00rootroot00000000000000(******************************************************************************) (* *) (* An SMT-LIB 2 for the Alt-Ergo Theorem Prover *) (* *) (******************************************************************************) open Smtlib_error type ty = { id : int; mutable desc : desc } and desc = | TDummy | TInt | TReal | TBool | TString | TArray of ty * ty | TBitVec of int | TFloatingPoint of int * int | TRoundingMode | TSort of string * (ty list) | TDatatype of string * (ty list) | TVar of string | TFun of ty list * ty | TLink of ty let cpt_ty = ref 0 let new_type desc = incr cpt_ty; { id = !cpt_ty; desc} (* return the string correponding to the type *) let rec to_string t = match t.desc with | TDummy -> Printf.sprintf "Dummy:%d" t.id | TInt -> "Int" | TReal -> "Real" | TBool -> "Bool" | TString -> "String" | TArray(t1,t2) -> Printf.sprintf "Array(%s %s)" (to_string t1) (to_string t2) | TBitVec(n) -> Printf.sprintf "BitVec(%d)" n | TFloatingPoint(n1,n2) -> Printf.sprintf "FloatingPoint(%d,%d)" n1 n2 | TRoundingMode -> Printf.sprintf "RoundingMode" | TSort(s,tl) -> if List.length tl = 0 then Printf.sprintf "%s(S)" s else Printf.sprintf "%s(S) (%s)" s (String.concat " " (List.map to_string tl)) | TDatatype(s,tl) -> if List.length tl = 0 then (Printf.sprintf "%s(Dt)" s) else (Printf.sprintf "%s(Dt)" s)^ "(" ^ (String.trim (List.fold_left (fun acc t -> acc^" "^(to_string t)) "" (List.rev tl))) ^ ")" | TVar(s) -> Printf.sprintf "(%s:%d)" s t.id | TFun(pars,ret) -> Printf.sprintf "Fun : %s %s" (List.fold_left (fun acc par -> Printf.sprintf "%s -> %s" (to_string par) acc) "" (List.rev pars)) (to_string ret) | TLink(t) -> Printf.sprintf "Link(%s)" (to_string t) module IMap = Map.Make(struct type t = int let compare = compare end) module SMap = Map.Make(String) let rec shorten ty = match ty.desc with | TLink(t) -> shorten t | _ -> ty let fun_ret ty = match (shorten ty).desc with | TFun(_,ret) -> ret | _ -> ty let is_bool ty = (shorten ty).desc == TBool let is_dummy ty = (shorten ty).desc == TDummy let get_dt_name ty = match (shorten ty).desc with | TDatatype(s,_) -> s | _ -> assert false let rec inst links m t = try m, IMap.find t.id m with Not_found -> let m, t' = match t.desc with | TDummy | TInt | TReal | TBool | TString -> m, t | TArray (t1,t2) -> let m1, t1' = inst links m t1 in let m2, t2' = inst links m1 t2 in m2, new_type (TArray(t1', t2')) | TBitVec(n) -> m, new_type (TBitVec(n)) | TFloatingPoint(n1,n2) -> m, new_type (TFloatingPoint(n1,n2)) | TRoundingMode -> m, t | TSort (s,tl) -> let m,tl = List.fold_left (fun (m,tl) t -> let m',t' = inst links m t in m', t' :: tl ) (m,[]) (List.rev tl) in m, new_type (TSort(s,tl)) | TDatatype(s,tl) -> let m,tl = List.fold_left (fun (m,tl) t -> let m',t' = inst links m t in m', t' :: tl ) (m,[]) (List.rev tl) in m, new_type (TDatatype(s,tl)) | TVar(s) -> begin try let ty = SMap.find s links in if ty.id < t.id then m, t else m, new_type (TDummy) with Not_found -> m, new_type (TDummy) end | TFun(pars, ret) -> let m,pars = List.fold_left (fun (m,tl) t -> let m',t' = inst links m t in m', t' :: tl ) (m,[]) (List.rev pars) in let m,ret = inst links m ret in m, new_type (TFun(pars,ret)) | TLink(t1) -> inst links m (shorten t1) in let m = IMap.add t.id t' m in m, t' let rec subst m t = try IMap.find t.id m with Not_found -> match t.desc with | TDummy | TInt | TReal | TBool | TString -> t | TArray (t1,t2) -> let t1' = subst m t1 in let t2' = subst m t2 in new_type (TArray(t1', t2')) | TBitVec(_n) -> t | TFloatingPoint(_n1,_n2) -> t | TRoundingMode -> t | TSort (s,tl) -> let tl = List.fold_left (fun tl t -> let t' = subst m t in t' :: tl ) [] (List.rev tl) in new_type (TSort(s,tl)) | TDatatype(s,tl) -> let tl = List.fold_left (fun tl t -> let t' = subst m t in t' :: tl ) [] (List.rev tl) in new_type (TDatatype(s,tl)) | TVar(_s) -> t | TFun(pars, ret) -> let pars = List.fold_left (fun tl t -> let t' = subst m t in t' :: tl ) [] (List.rev pars) in let ret = subst m ret in new_type (TFun(pars,ret)) | TLink(t) -> subst m (shorten t) let rec unify t1 t2 pos = (* Printf.printf "Unification de (%s) et (%s) \n%!" * (to_string t1) (to_string t2); *) if t1.id <> t2.id then begin match t1.desc, t2.desc with | TLink(t), _ -> unify (shorten t) t2 pos | _, TLink(t) -> unify t1 (shorten t) pos | TDummy, TDummy -> t1.desc <- (TLink t2) | TDummy, _ -> t1.desc <- (TLink(shorten t2)) | _, TDummy -> t2.desc <- (TLink(shorten t1)) | TVar(_s1), TVar(_s2) -> if t1.id <> t2.id then (error (Type_clash_error( to_string t1, to_string t2)) pos) | TInt, TInt | TReal, TReal | TBool, TBool | TString, TString | TRoundingMode, TRoundingMode -> () | TInt, TReal | TReal, TInt -> assert false (* if not( get_is_int_real ()) then * (error (Type_clash_error( to_string t1, to_string t2)) pos) *) | TArray(t1a,t1b), TArray(t2a,t2b) -> unify t1a t2a pos; unify t1b t2b pos | TBitVec(n1), TBitVec(n2) -> if n1 = 0 then t1.desc <- (TLink(shorten t2)) else if n2 = 0 then t2.desc <- (TLink(shorten t1)) else if not (n1 = n2) then (error (Type_clash_error( to_string t1, to_string t2)) pos) | TFloatingPoint(n1a,n1b), TFloatingPoint(n2a,n2b) -> if n1a = 0 && n1b = 0 then t1.desc <- (TLink(shorten t2)) else if n2a = 0 && n2b = 0 then t2.desc <- (TLink(shorten t1)) else if not (n1a = n2a && n1b = n2b) then (error (Type_clash_error( to_string t1, to_string t2)) pos); | TSort(s1,tl1), TSort(s2,tl2) -> if s1 <> s2 then (error (Type_clash_error( to_string t1, to_string t2)) pos); begin try List.iter2 (fun l l' -> unify l l' pos) tl1 tl2 with Invalid_argument _ -> (error (Type_clash_error( to_string t1, to_string t2)) pos) end | TDatatype(s1,tl1), TDatatype(s2,tl2) -> if s1 <> s2 then if s1 = "" then t1.desc <- (TLink(shorten t2)) else if s2 = "" then t2.desc <- (TLink(shorten t1)) else (error (Type_clash_error( to_string t1, to_string t2)) pos) else begin try List.iter2 (fun l l' -> unify l l' pos) tl1 tl2 with Invalid_argument _ -> (error (Type_clash_error( to_string t1, to_string t2)) pos) end | TFun(pars1,ret1), TFun(pars2,ret2) -> begin try List.iter2 (fun l l' -> unify l l' pos) pars1 pars2; unify ret1 ret2 pos with Invalid_argument _ -> (error (Type_clash_error( to_string t1, to_string t2)) pos) end | _ , _ -> (error (Type_clash_error( to_string t1, to_string t2)) pos) end psmt2-frontend-0.4.0/src/lib/smtlib_typed_env.ml000066400000000000000000000316021402732347700216460ustar00rootroot00000000000000open Smtlib_error module SMap = Map.Make(String) let init len f = let rec init_aux i n f = if i >= n then [] else let r = f i in r :: init_aux (i+1) n f in init_aux 0 len f type assoc = | Right | Left | Chainable | Pairwise type fun_def = { params : Smtlib_ty.ty; assoc : assoc option; } type env = { sorts : ((int * int) * (string -> (Smtlib_ty.ty list * int list) -> Smtlib_ty.desc)) SMap.t; funs : fun_def list SMap.t; par_funs : (string list -> fun_def) list SMap.t; constructors : int SMap.t SMap.t; } let empty () = { sorts = SMap.empty; funs = SMap.empty; par_funs = SMap.empty; constructors = SMap.empty; } open Smtlib_syntax (******************************************************************************) (*********************************** Utils ************************************) let get_arit symb arit = try int_of_string arit with _ -> error (Typing_error "This expression is not an int") symb.Smtlib_syntax.p let get_index i = match i.c with | IndexSymbol(symb) -> symb.c | IndexNumeral(s) -> s let get_identifier id = match id.c with | IdSymbol(symb) -> symb, [] | IdUnderscoreSymNum(symb,index_list) -> symb, List.map get_index index_list let check_identifier id arit = match id.c with | IdSymbol(_symb) -> assert (arit = 0); | IdUnderscoreSymNum(_symb,index_list) -> assert (List.length index_list = arit) (******************************************************************************) (*********************************** Sorts ************************************) let check_sort_already_exist (env,locals) symb = if SMap.mem symb.c locals then error (Sort_declaration_error ("sort " ^ symb.c ^ " already declared/defined")) symb.p else if SMap.mem symb.c env.sorts then error (Sort_declaration_error ("sort " ^ symb.c ^ " already declared/defined")) symb.p let check_sort_exist (env,locals) symb = if not (SMap.mem symb.c locals) then if not (SMap.mem symb.c env.sorts) then error (Sort_declaration_error ("sort " ^ symb.c ^ " undeclared/undefined")) symb.p let mk_sort_definition arit_s arit_t is_dt = if is_dt then ((arit_s,arit_t),(fun s (l,_) -> assert (List.length l = arit_s); Smtlib_ty.TDatatype(s,l))) else ((arit_s,arit_t),(fun s (l,_) -> assert (List.length l = arit_s); Smtlib_ty.TSort(s,l))) let mk_sort (env,locals) symb sort_def = check_sort_already_exist (env,locals) symb; {env with sorts = SMap.add symb.c sort_def env.sorts} let mk_sort_decl (env,locals) symb arit is_dt = let arit = get_arit symb arit in let sort_def = mk_sort_definition arit 0 is_dt in mk_sort (env,locals) symb sort_def let find_sort_def env symb = try SMap.find symb.c env.sorts with Not_found -> error (Sort_declaration_error ("Undefined sort " ^ symb.c)) symb.p let add_sorts env sorts = List.fold_left (fun env (name,sort) -> {env with sorts = SMap.add name sort env.sorts} ) env sorts let rec find_sort_symb (env,locals) symb pars_s pars_t= try SMap.find symb.c locals with Not_found -> let (arit_s,arit_t),fun_sort = find_sort_def env symb in assert (List.length pars_s = arit_s); assert (List.length pars_t = arit_t); Smtlib_ty.new_type (fun_sort symb.c (pars_s,pars_t)) and find_sort (env,locals) sort = match sort.c with | SortIdentifier(id) -> begin match id.c with | IdSymbol(symb) -> let s_ty = find_sort_symb (env,locals) symb [] [] in Smtlib_ty.unify sort.ty s_ty sort.p; s_ty | IdUnderscoreSymNum(s,l) -> let l = List.map (fun i -> try int_of_string (get_index i) with Not_found -> error (Sort_declaration_error (Printf.sprintf "Args of %s should be integers" s.c) ) id.p ) l in let s_ty = find_sort_symb (env,locals) s [] l in Smtlib_ty.unify sort.ty s_ty sort.p; s_ty end | SortIdMulti (id, sort_list) -> let symb,_ = get_identifier id in let arg_sort = List.map (fun s -> let s_ty = find_sort (env,locals) s in s_ty ) sort_list in let s_ty = find_sort_symb (env,locals) symb arg_sort [] in Smtlib_ty.unify sort.ty s_ty sort.p; s_ty (******************************************************************************) (************************************ Funs ************************************) let extract_arit_ty_assoc ty = match ty.Smtlib_ty.desc with | Smtlib_ty.TFun(params,_) -> List.length params, (try List.hd params with _ -> Smtlib_ty.new_type (Smtlib_ty.TDummy)) | _ -> assert false let rec compare_fun_assoc (_env,locals) symb ty _f assoc = let arit,t_fun = extract_arit_ty_assoc ty in let _,t_fun = Smtlib_ty.inst locals Smtlib_ty.IMap.empty t_fun in let params = init arit (fun _i -> t_fun) in let ret = match assoc with | Right | Left -> t_fun | Chainable | Pairwise -> Smtlib_ty.new_type (Smtlib_ty.TBool) in let def = Smtlib_ty.new_type (Smtlib_ty.TFun (params,ret)) in let _,def = Smtlib_ty.inst SMap.empty Smtlib_ty.IMap.empty def in Smtlib_ty.unify ty def symb.p; Some (Smtlib_ty.fun_ret ty) and compare_fun_def (env,locals) symb ty funs all_type = let rec aux funs = match funs with | [] -> None | def :: funs -> try match def.assoc with | None -> let def = def.params in let _,def = Smtlib_ty.inst locals Smtlib_ty.IMap.empty def in Smtlib_ty.unify ty def symb.p; if all_type then Some ty else Some (Smtlib_ty.fun_ret ty) | Some a -> compare_fun_assoc (env,locals) symb ty def.params a with | _ -> aux funs in aux funs let find_fun (env,locals) symb params args all_type= let defs = if args == [] then SMap.find symb.c env.funs else List.map (fun def -> def args) (SMap.find symb.c env.par_funs) in let ty = Smtlib_ty.new_type (Smtlib_ty.TFun (params,Smtlib_ty.new_type Smtlib_ty.TDummy)) in (* Printf.eprintf "Find fun : %s : %s\n%!" symb.c (Smtlib_ty.to_string ty); *) let res = compare_fun_def (env,locals) symb ty defs all_type in match res with | Some def -> def | None -> error (Typing_error (Printf.sprintf "Undefined fun definition %s : %s" symb.c (Smtlib_ty.to_string ty))) symb.p let check_fun_exists (env,locals) symb params all_type = try let ty = Smtlib_ty.new_type (Smtlib_ty.TFun (params,Smtlib_ty.new_type Smtlib_ty.TDummy)) in let defs = SMap.find symb.c env.funs in let res = compare_fun_def (env,locals) symb ty defs all_type in match res with | Some _ -> error (Fun_declaration_error ("Function already declared/defined : " ^ symb.c)) symb.p | None -> () with Not_found -> () let mk_fun_ty pars ret assoc = let ty = Smtlib_ty.new_type (Smtlib_ty.TFun(pars,ret)) in {params= ty; assoc = assoc} let mk_fun_ty_arg pars ret assoc _args = let ty = Smtlib_ty.new_type (Smtlib_ty.TFun(pars,ret)) in (fun _args -> {params= ty; assoc = assoc}) let add_fun_def (env,locals) name params return assoc = check_fun_exists (env,locals) name params false; let funs = try SMap.find name.c env.funs with Not_found -> [] in {env with funs = SMap.add name.c ((mk_fun_ty params return assoc) :: funs) env.funs} let mk_fun_dec (env,locals) (name,pars,return) = let pars = List.map (fun par -> let s = find_sort (env,locals) par in Smtlib_ty.unify par.ty s par.p; s ) pars in let s_return = find_sort (env,locals) return in Smtlib_ty.unify return.ty s_return return.p; add_fun_def (env,locals) name pars s_return let add_funs env funs = List.fold_left (fun env (name,fun_def) -> let funs = try SMap.find name env.funs with Not_found -> [] in {env with funs = SMap.add name (fun_def :: funs) env.funs} ) env funs let add_par_funs env funs = List.fold_left (fun env (name,fun_def) -> let funs = try SMap.find name env.par_funs with Not_found -> [] in {env with par_funs = SMap.add name (fun_def :: funs) env.par_funs} ) env funs let find_simpl_sort_symb (env,_locals) symb params = let (ar_s,_ar_t),fun_sort = find_sort_def env symb in assert (ar_s = (List.length params)); Smtlib_ty.new_type (fun_sort symb.c (params,[])) (******************************************************************************) (*********************************** Datatypes ********************************) let extract_pars locals pars = let pars = List.fold_left (fun pars par -> let symb = par.c in if SMap.mem symb pars then error (Typing_error ("Type variable already declared : " ^ symb)) par.p; let ty = Smtlib_ty.new_type (Smtlib_ty.TVar(symb)) in Smtlib_ty.unify par.ty ty par.p; SMap.add symb ty pars ) SMap.empty pars; in SMap.union (fun _k _v1 v2 -> Some v2) locals pars let mk_const (env,locals) (name,pars,sort) = let locals = extract_pars locals pars in mk_fun_dec (env,locals) (name,[],sort) None let mk_fun_def (env,locals) (name,params,return) = mk_fun_dec (env,locals) (name,params,return) None let mk_fun_dec (env,locals) (name,(pars,params,return)) = let locals = extract_pars locals pars in mk_fun_dec (env,locals) (name,params,return) None let find_sort_name sort = match sort.c with | SortIdentifier id -> get_identifier id | SortIdMulti (id, _) -> get_identifier id let mk_sort_def (env,locals) symb pars sort = let locals_old = locals in let locals = extract_pars locals pars in let pars = List.map (fun par -> SMap.find par.c locals) pars in let sort = find_sort (env,locals) sort in let arit = List.length pars in let sort_def = (arit,0), (fun _s (l,_) -> assert (List.length l = arit); let links = List.fold_left2 (fun links t1 t2 -> let links, t2 = Smtlib_ty.inst locals_old links t2 in Smtlib_ty.unify t1 t2 symb.p; links ) (Smtlib_ty.IMap.empty) l pars in let sort = Smtlib_ty.subst links sort in sort.Smtlib_ty.desc ) in {env with sorts = SMap.add symb.c sort_def env.sorts} (******************************************************************************) (*********************************** Datatypes ********************************) let find_constr env symb = try let cstrs = SMap.find symb.c env.funs in if (List.length cstrs > 1) then error (Typing_error ("Constructor have mutliple signatures : " ^ symb.c)) symb.p; (try (List.hd cstrs).params with _e -> error (Typing_error ("Undefined Constructor : " ^ symb.c)) symb.p;) with Not_found -> error (Typing_error ("Undefined Constructor : " ^ symb.c)) symb.p let mk_constr_decs (env,locals) dt dt_sort constr_decs = let cstrs = ref [] in let env = List.fold_left (fun env (symb_cstr,selector_dec_list) -> let env,destr_list = (* Add all destructors *) List.fold_left (fun (env,destr_list) (symb_destr,sort_destr) -> let return = find_sort (env,locals) sort_destr in let env, l = add_fun_def (env,locals) symb_destr [dt_sort] return None, return :: destr_list in env, l ) (env,[]) selector_dec_list in let env = add_fun_def (env,locals) symb_cstr (List.rev destr_list) dt_sort None in cstrs := (symb_cstr.c, List.length destr_list) :: !cstrs; (* tester of constructor *) let is_cstr = { symb_cstr with c = Printf.sprintf "is %s" symb_cstr.c } in let env = add_fun_def (env,locals) is_cstr (* [(Smtlib_ty.new_type (Smtlib_ty.TDatatype("",[])))] *) [dt_sort] (Smtlib_ty.new_type Smtlib_ty.TBool) None in env ) env constr_decs in let cstrs = List.fold_left (fun acc (cst,arrit) -> SMap.add cst arrit acc) SMap.empty !cstrs in if not (SMap.is_empty cstrs) then {env with constructors = SMap.add dt.c cstrs env.constructors} else env let mk_dt_dec (env,locals) dt (pars,cst_dec_list) = let locals = ref locals in let dt_pars = List.map (fun s -> let ty = Smtlib_ty.new_type (Smtlib_ty.TVar s.c) in locals := SMap.add s.c ty !locals; ty ) pars in let dt_sort = find_simpl_sort_symb (env,locals) dt dt_pars in mk_constr_decs (env,!locals) dt dt_sort cst_dec_list let mk_datatype (env,locals) dt pars dt_dec = let arit = List.length pars in let sort_def = mk_sort_definition arit 0 true in let env = mk_sort (env,locals) dt sort_def in mk_dt_dec (env,locals) dt (pars,dt_dec) let mk_datatypes (env,locals) sort_decs datatype_decs = let env = List.fold_left (fun env (symb,arit) -> mk_sort_decl (env,locals) symb arit true ) env sort_decs in let env = List.fold_left2 (fun env (symb, _arit) dt_dec -> mk_dt_dec (env,locals) symb dt_dec ) env sort_decs datatype_decs in env psmt2-frontend-0.4.0/src/lib/smtlib_typed_logic.ml000066400000000000000000000355661402732347700221700ustar00rootroot00000000000000open Smtlib_typed_env open Smtlib_ty open Options type th_def = { sorts : (string * ((int * int) * (string -> (ty list * int list) -> desc))) list; funs : (string * fun_def) list; par_funs : (string * ((string list) -> fun_def)) list; } type theory = | Core | Ints | Reals | Reals_Ints | FloatingPoint | Arrays | BitVectors let new_fun params return assoc = {params = Smtlib_ty.new_type (Smtlib_ty.TFun (params,return)); assoc} let core = { sorts = [ "Bool",((0,0),(fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TBool))]; funs = [ "true", new_fun [] (new_type TBool) None; "false", new_fun [] (new_type TBool) None; "not", new_fun [(new_type TBool)] (new_type TBool) None; "=>", new_fun [(new_type TBool); (new_type TBool)] (new_type TBool) (Some Right); "and", new_fun [(new_type TBool); (new_type TBool)] (new_type TBool) (Some Left); "or", new_fun [(new_type TBool); (new_type TBool)] (new_type TBool) (Some Left); "xor", new_fun [(new_type TBool); (new_type TBool)] (new_type TBool) (Some Left); (let a = new_type(TVar("A")) in "=", new_fun [a;a] (new_type TBool) (Some Chainable)); (let a = new_type(TVar("A")) in "distinct", new_fun [a;a] (new_type TBool) (Some Pairwise)); (let a = new_type(TVar("A")) in "ite", new_fun [(new_type TBool); a; a] a None); ]; par_funs = [] } let ints = { sorts = ["Int",((0,0),(fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TInt))]; funs = [ "-", new_fun [(new_type TInt)] (new_type TInt) None; "-", new_fun [(new_type TInt); (new_type TInt)] (new_type TInt) (Some Left); "+", new_fun [(new_type TInt); (new_type TInt)] (new_type TInt) (Some Left); "*", new_fun [(new_type TInt); (new_type TInt)] (new_type TInt) (Some Left); "div", new_fun [(new_type TInt); (new_type TInt)] (new_type TInt) (Some Left); "mod", new_fun [(new_type TInt); (new_type TInt)] (new_type TInt) None; "abs", new_fun [(new_type TInt)] (new_type TInt) None; "<=", new_fun [(new_type TInt); (new_type TInt)] (new_type TBool) (Some Chainable); "<", new_fun [(new_type TInt); (new_type TInt)] (new_type TBool) (Some Chainable); ">=", new_fun [(new_type TInt); (new_type TInt)] (new_type TBool) (Some Chainable); ">", new_fun [(new_type TInt); (new_type TInt)] (new_type TBool) (Some Chainable); ]; par_funs = [] } let reals = { sorts = ["Real",((0,0),(fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TReal))]; funs = [ "-", new_fun [(new_type TReal)] (new_type TReal) None; "-", new_fun [(new_type TReal); (new_type TReal)] (new_type TReal) (Some Left); "+", new_fun [(new_type TReal); (new_type TReal)] (new_type TReal) (Some Left); "*", new_fun [(new_type TReal); (new_type TReal)] (new_type TReal) (Some Left); "/", new_fun [(new_type TReal); (new_type TReal)] (new_type TReal) (Some Left); "<=", new_fun [(new_type TReal); (new_type TReal)] (new_type TBool) (Some Chainable); "<", new_fun [(new_type TReal); (new_type TReal)] (new_type TBool) (Some Chainable); ">=", new_fun [(new_type TReal); (new_type TReal)] (new_type TBool) (Some Chainable); ">", new_fun [(new_type TReal); (new_type TReal)] (new_type TBool) (Some Chainable); ]; par_funs = [] } let reals_ints = { sorts = List.rev_append ints.sorts reals.sorts; funs = List.rev_append (List.rev_append ints.funs reals.funs) [ "to_real", new_fun [(new_type TInt)] (new_type TReal) None; "to_int", new_fun [(new_type TReal)] (new_type TInt) None; "is_int", new_fun [(new_type TReal)] (new_type TBool) None; ]; par_funs = [] } let arrays = { sorts = ["Array",((2,0), (fun _s (l1,l2) -> let t1,t2 = List.hd l1, List.hd (List.tl l1) in assert (List.length l1 = 2 && l2 == []); TArray (t1,t2)))]; funs = [ (let x = new_type(TVar("X")) in let y = new_type(TVar("Y")) in "select", new_fun [new_type (TArray (x,y));x] y None); (let x = new_type(TVar("X")) in let y = new_type(TVar("Y")) in "store", new_fun [new_type (TArray (x,y));x;y] (new_type (TArray (x,y))) None); ]; par_funs = [] } let floating_point = { sorts = [ "RoundingMode",((0,0), (fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TRoundingMode)); "FloatingPoint",((0,2), (fun _s (l1,l2) -> match l1,l2 with | [], [n1;n2] -> TFloatingPoint(n1,n2) | _, _ -> assert false )); "Float16",((0,0), (fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TFloatingPoint(5,11))); "Float32",((0,0), (fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TFloatingPoint(8,24))); "Float64",((0,0), (fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TFloatingPoint(11,53))); "Float128",((0,0), (fun _s (l1,l2) -> assert (l1 == [] && l2 == []); TFloatingPoint(15,113))); ]; funs = [ "roundNearestTiesToEven", new_fun [] (new_type TRoundingMode) None; "RNE", new_fun [] (new_type TRoundingMode) None; "roundNearestTiesToAway", new_fun [] (new_type TRoundingMode) None; "RNA", new_fun [] (new_type TRoundingMode) None; "roundTowardPositive", new_fun [] (new_type TRoundingMode) None; "RTP", new_fun [] (new_type TRoundingMode) None; "roundTowardNegative", new_fun [] (new_type TRoundingMode) None; "RTN", new_fun [] (new_type TRoundingMode) None; "roundTowardZero", new_fun [] (new_type TRoundingMode) None; "RTZ", new_fun [] (new_type TRoundingMode) None; "fp", new_fun [(new_type (TBitVec 0)); (new_type (TBitVec 0)); (new_type (TBitVec 0))] (new_type (TFloatingPoint (0,0))) None; "fp", new_fun [(new_type TInt); (new_type TInt); (new_type TInt)] (new_type (TFloatingPoint (0,0))) None; "fp.to_real", new_fun [new_type (TFloatingPoint (0,0))] (new_type TReal) None; (let x = new_type (TFloatingPoint (0,0)) in "fp.abs", new_fun [x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.neg", new_fun [x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.add", new_fun [(new_type TRoundingMode);x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.sub", new_fun [(new_type TRoundingMode);x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.mul", new_fun [(new_type TRoundingMode);x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.div", new_fun [(new_type TRoundingMode);x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.fma", new_fun [(new_type TRoundingMode);x;x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.sqrt", new_fun [(new_type TRoundingMode);x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.rem", new_fun [x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.roundToIntegral", new_fun [(new_type TRoundingMode);x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.min", new_fun [x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.max", new_fun [x;x] x None); (let x = new_type (TFloatingPoint (0,0)) in "fp.leq", new_fun [x;x] (new_type TBool) (Some Chainable)); (let x = new_type (TFloatingPoint (0,0)) in "fp.lt", new_fun [x;x] (new_type TBool) (Some Chainable)); (let x = new_type (TFloatingPoint (0,0)) in "fp.geq", new_fun [x;x] (new_type TBool) (Some Chainable)); (let x = new_type (TFloatingPoint (0,0)) in "fp.gt", new_fun [x;x] (new_type TBool) (Some Chainable)); (let x = new_type (TFloatingPoint (0,0)) in "fp.eq", new_fun [x;x] (new_type TBool) (Some Chainable)); (let x = new_type (TFloatingPoint (0,0)) in "fp.isNormal", new_fun [x] (new_type TBool) None); (let x = new_type (TFloatingPoint (0,0)) in "fp.isSubnormal", new_fun [x] (new_type TBool) None); (let x = new_type (TFloatingPoint (0,0)) in "fp.isZero", new_fun [x] (new_type TBool) None); (let x = new_type (TFloatingPoint (0,0)) in "fp.isInfinite", new_fun [x] (new_type TBool) None); (let x = new_type (TFloatingPoint (0,0)) in "fp.isNaN", new_fun [x] (new_type TBool) None); (let x = new_type (TFloatingPoint (0,0)) in "fp.isNegative", new_fun [x] (new_type TBool) None); (let x = new_type (TFloatingPoint (0,0)) in "fp.isPositive", new_fun [x] (new_type TBool) None); ]; par_funs = [ ("to_fp", (fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [(new_type (TBitVec (a+b)))] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ) ); ("to_fp", (fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [(new_type TRoundingMode); (new_type (TFloatingPoint (0,0)))] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ) ); ("to_fp", (fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [(new_type TRoundingMode); (new_type TReal)] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ) ); ("to_fp", (fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [(new_type TRoundingMode); (new_type (TBitVec 0))] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ) ); ("to_fp_unsigned", (fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [(new_type TRoundingMode); (new_type (TBitVec 0))] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ) ); ("fp.to_ubv", (fun l -> match l with | [m] -> let m = int_of_string m in new_fun [(new_type TRoundingMode); (new_type (TFloatingPoint (0,0)))] (new_type (TBitVec m)) None; | _ -> assert false ) ); ("fp.to_sbv", (fun l -> match l with | [m] -> let m = int_of_string m in new_fun [(new_type TRoundingMode); (new_type (TFloatingPoint (0,0)))] (new_type (TBitVec m)) None; | _ -> assert false ) ); ("+oo", fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ); ("-oo", fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ); ("+zero", fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ); ("-zero", fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ); ("NaN", fun l -> match l with | [a;b] -> let a = int_of_string a in let b = int_of_string b in new_fun [] (new_type (TFloatingPoint (a,b))) None; | _ -> assert false ); ] } let bit_vectors = { sorts = ["BitVec",((0,1), (fun _s (l1,l2) -> assert (List.length l2 = 1 && l1 == []); TBitVec(List.hd l2) ))]; funs = []; par_funs = [] } let add_theories env ths = let aux env th = let th_def = match th with | Core -> core | Ints -> ints | Reals -> (*let sorts = if get_is_real () then ("Int",((0,0),(fun s (l1,l2) -> assert (l1 == [] && l2 == []); TReal))) :: reals.sorts else reals.sorts in sorts*) reals | Reals_Ints -> reals_ints | FloatingPoint -> floating_point | Arrays -> arrays | BitVectors -> bit_vectors in let env = Smtlib_typed_env.add_sorts env th_def.sorts in let env = Smtlib_typed_env.add_funs env th_def.funs in Smtlib_typed_env.add_par_funs env th_def.par_funs in List.fold_left (fun env th -> aux env th) env ths let contains s1 s2 = try let len = String.length s2 in for i = 0 to String.length s1 - len do if String.sub s1 i len = s2 then raise Exit done; false with Exit -> true let set_logic env s = let logic = s.Smtlib_syntax.c in let theories = ref [Core] in let all = contains logic "ALL" in if contains logic "QF" then set_is_qf true; if all || contains logic "UF" then set_is_uf true; if contains logic "BV" then check_command "Bitvector"; if contains logic "FP" then begin theories := FloatingPoint :: !theories; set_is_fp true; end; if all || contains logic "AX" || contains logic "A" then theories := Arrays :: !theories; if all || contains logic "IRA" then begin set_is_int_real true; theories := Reals_Ints :: !theories end else if contains logic "IA" || contains logic "IDL" then theories := Ints :: !theories else if contains logic "RA" || contains logic "RDL" then begin set_is_real true; theories := Reals :: !theories end; if all || contains logic "LIRA" || contains logic "LIA" || contains logic "LRA" then set_is_linear true; if contains logic "NIRA" || contains logic "NIA" || contains logic "NRA" then set_is_non_linear true; if contains logic "DT" then set_is_dt true; add_theories env !theories psmt2-frontend-0.4.0/src/lib/smtlib_typing.ml000066400000000000000000000320771402732347700211720ustar00rootroot00000000000000open Options open Smtlib_error open Smtlib_syntax open Smtlib_typed_env (******************************************************************************) let inst_and_unify (_env,locals) m a b pos = let _m, a = Smtlib_ty.inst locals m a in Smtlib_ty.unify a b pos let find_par_ty (env,locals) symb pars args = try let res = SMap.find symb.c locals in symb.is_quantif <- true; res with Not_found -> try find_fun (env,locals) symb pars args false with Not_found -> let s_symb = (List.fold_left (fun acc arg -> Printf.sprintf "%s %s" acc arg ) symb.c args) in try find_fun (env,locals) {symb with c = s_symb} pars [] false with Not_found -> error (Typing_error ("Undefined fun : " ^ symb.c)) symb.p let find_pattern (env,locals) symb pars args all_type = try SMap.find symb.c locals, locals with Not_found -> try find_fun (env,locals) symb pars args all_type, locals with Not_found -> let dum = Smtlib_ty.new_type (Smtlib_ty.TDummy) in dum, SMap.add symb.c dum locals let check_if_dummy t l = if Smtlib_ty.is_dummy t.ty then t :: l else l let check_if_escaped l = List.iter (fun d -> if Smtlib_ty.is_dummy d.ty then begin error (Typing_error ("Escaped type variables")) d.p; end; ) l let type_cst c _pos= match c with | Const_Dec (_s) -> Smtlib_ty.new_type Smtlib_ty.TReal | Const_Num (_s) -> Smtlib_ty.new_type (if get_is_real () then Smtlib_ty.TReal else Smtlib_ty.TInt) | Const_Str (_s) -> Smtlib_ty.new_type Smtlib_ty.TString | Const_Hex (_s) -> Smtlib_ty.new_type (if get_is_fp () then Smtlib_ty.TBitVec(0) else if get_is_real () then Smtlib_ty.TReal else Smtlib_ty.TInt) | Const_Bin (_s) -> Smtlib_ty.new_type (if get_is_fp () then Smtlib_ty.TBitVec(0) else if get_is_real () then Smtlib_ty.TReal else Smtlib_ty.TInt) let type_qualidentifier (env,locals) q pars = match q.c with | QualIdentifierId (id) -> let symb,idl = get_identifier id in let ty = find_par_ty (env,locals) symb pars idl in inst_and_unify (env,locals) Smtlib_ty.IMap.empty ty q.ty q.p; ty | QualIdentifierAs (id, sort) -> let symb,idl = get_identifier id in let ty = find_par_ty (env,locals) symb pars idl in let ty_sort = find_sort (env,locals) sort in inst_and_unify (env,locals) Smtlib_ty.IMap.empty ty ty_sort symb.p; Smtlib_ty.unify sort.ty ty_sort sort.p; Smtlib_ty.unify q.ty ty q.p; ty let rec type_match_case (env,locals,dums,constrs) ty_match (pattern,term) cstrs= match pattern.c with | MatchUnderscore -> let ty,dums = type_term (env,locals,dums) term in ty, dums, SMap.empty | MatchPattern (constr,args) -> match args with | [] -> if SMap.mem constr.c cstrs then let ty,dums = type_term (env,locals,dums) term in ty, dums, SMap.remove constr.c constrs else let ty, locals = find_pattern (env,locals) constr [] [] false in if Smtlib_ty.is_dummy ty then let ty,dums = type_term (env,locals,dums) term in ty, dums, SMap.empty else begin inst_and_unify (env,locals) Smtlib_ty.IMap.empty ty_match ty constr.p; assert false; (* ty, dums, SMap.empty *) end | _ -> let locals,args = List.fold_left (fun (locals,pars) par -> let ty = (Smtlib_ty.new_type (Smtlib_ty.TDummy)) in SMap.add par.c ty locals, ty :: pars ) (locals,[]) (List.rev args) in let ty_constr,locals = find_pattern (env,locals) constr args [] true in if Smtlib_ty.is_dummy ty_constr then error (Typing_error (Printf.sprintf "Undefined Constructor %s" constr.c)) term.p; let ty = Smtlib_ty.new_type (Smtlib_ty.TFun (args,ty_match)) in inst_and_unify (env,locals) Smtlib_ty.IMap.empty ty_constr ty constr.p; let ty,dums = type_term (env,locals,dums) term in ty, dums, SMap.remove constr.c constrs and type_key_term (env,locals,dums) key_term = match key_term.c with | Pattern(term_list) -> List.fold_left (fun dums t -> let _,dums = type_term (env,locals,dums) t in dums ) [] term_list | Named(_symb) -> if Options.verbose () > 0 then Printf.eprintf ";[Warning] (! :named not yet supported)\n%!"; dums and type_term (env,locals,dums) t = match t.c with | TermSpecConst (cst) -> Smtlib_ty.unify t.ty (type_cst cst t.p) t.p; t.ty, dums | TermQualIdentifier (qualid) -> let ty_q = type_qualidentifier (env,locals) qualid [] in Smtlib_ty.unify t.ty ty_q t.p; t.ty, check_if_dummy t dums | TermQualIdTerm (qualid,term_list) -> let pars,dums = List.fold_left (fun (pars,dums) t -> let ty, dums = type_term (env,locals,dums) t in ty :: pars, dums ) ([],dums) term_list in let pars = List.rev pars in let q = (type_qualidentifier (env,locals) qualid pars) in Smtlib_ty.unify t.ty q t.p; t.ty, check_if_dummy t dums | TermLetTerm (varbinding_list,term) -> let locals,dums = List.fold_left (fun (locals,dums) (symb,term) -> let ty, dums = type_term (env,locals,dums) term in SMap.add symb.c ty locals, dums ) (locals,dums) varbinding_list in let ty,dums = type_term (env,locals,dums) term in Smtlib_ty.unify t.ty ty t.p; t.ty, dums | TermForAllTerm (sorted_var_list, term) -> let locals = List.fold_left (fun locals (symb,sort) -> SMap.add symb.c (find_sort (env,locals) sort) locals ) locals sorted_var_list in let ty,dums = type_term (env,locals,dums) term in Smtlib_ty.unify t.ty ty t.p; t.ty, dums | TermExistsTerm (sorted_var_list, term) -> let locals = List.fold_left (fun locals (symb,sort) -> SMap.add symb.c (find_sort (env,locals) sort) locals ) locals sorted_var_list in let ty,dums = type_term (env,locals,dums) term in Smtlib_ty.unify t.ty ty t.p; t.ty, dums | TermExclimationPt (term, key_term_list) -> let dums = List.fold_left (fun dums kt -> type_key_term (env,locals,dums) kt ) dums key_term_list in let ty,dums = type_term (env,locals,dums) term in ty, dums | TermMatch (term, match_case_list) -> let ty,dums = type_term (env,locals,dums) term in (* check if term is datatype *) Smtlib_ty.unify (Smtlib_ty.new_type (Smtlib_ty.TDatatype("",[]))) ty term.p; let dt_name = Smtlib_ty.get_dt_name ty in let constrs = try SMap.find dt_name env.constructors with _ -> error (Typing_error (Printf.sprintf "No constructors found for datatype %s\n%!" dt_name)) term.p in let cstrs = constrs in let res,dums,constrs = List.fold_left (fun (res,dums,constrs) mc -> let ty_mc, dums, constrs = type_match_case (env,locals,dums,constrs) ty mc cstrs in Smtlib_ty.unify res ty_mc term.p; res,dums,constrs ) (Smtlib_ty.new_type (Smtlib_ty.TDummy),dums,constrs) match_case_list in if not (SMap.is_empty constrs) then error (Typing_error "non-exhaustive pattern matching") term.p; Smtlib_ty.unify res t.ty term.p; res,dums let get_term (env,locals) pars term = let locals = Smtlib_typed_env.extract_pars locals pars in let ty,dums = type_term (env,locals,[]) term in check_if_escaped dums; ty let get_sorted_locals (env,locals) params = List.fold_left (fun locals (symb,sort) -> SMap.add symb.c (Smtlib_typed_env.find_sort (env,locals) sort) locals ) locals (List.rev params) let get_fun_def_locals (env,locals) (name,pars,params,return) = let locals = Smtlib_typed_env.extract_pars locals pars in let locals = get_sorted_locals (env,locals) params in let ret = (Smtlib_typed_env.find_sort (env,locals) return) in let params = List.map (fun (_,sort) -> sort) params in locals, ret, (name,params,return) let assertion_stack = Stack.create () (******************************************************************************) (************************************ Commands ********************************) let type_command (env,locals) c = match c.c with | Cmd_Assert(dec) | Cmd_CheckEntailment(dec) -> let pars,t = dec in Smtlib_ty.unify (Smtlib_ty.new_type Smtlib_ty.TBool) (get_term (env,locals) pars t) t.p; env | Cmd_CheckAllSat tl -> let pars = [] in let idl = [] in List.iter (fun symb -> let ty = find_par_ty (env,locals) symb pars idl in Smtlib_ty.unify (Smtlib_ty.new_type Smtlib_ty.TBool) ty symb.p ) tl; env | Cmd_Minimize t | Cmd_Maximize t -> let t' = get_term (env,locals) [] t in begin (* try to typecheck it as an Int, then as a real if it fails *) try Smtlib_ty.unify (Smtlib_ty.new_type Smtlib_ty.TInt) t' t.p with _ -> Smtlib_ty.unify (Smtlib_ty.new_type Smtlib_ty.TReal) t' t.p end; env | Cmd_CheckSat -> env | Cmd_CheckSatAssum _prop_lit -> Options.check_command "check-sat-assuming"; env | Cmd_DeclareConst (symbol,(pars,sort)) -> Smtlib_typed_env.mk_const (env,locals) (symbol,pars,sort) | Cmd_DeclareDataType (symbol,(pars,datatype_dec)) -> Smtlib_typed_env.mk_datatype (env,locals) symbol pars datatype_dec | Cmd_DeclareDataTypes (sort_dec_list, datatype_dec_list) -> Smtlib_typed_env.mk_datatypes (env,locals) sort_dec_list datatype_dec_list | Cmd_DeclareFun (name,fun_dec) -> Smtlib_typed_env.mk_fun_dec (env,locals) (name,fun_dec) | Cmd_DeclareSort (symbol,arit) -> Smtlib_typed_env.mk_sort_decl (env,locals) symbol arit false | Cmd_DefineFun (fun_def,term) -> let locals,ret,fun_dec = get_fun_def_locals (env,locals) fun_def in let ty,dums = type_term (env,locals,[]) term in check_if_escaped dums; let env = Smtlib_typed_env.mk_fun_def (env,locals) fun_dec in inst_and_unify (env,locals) Smtlib_ty.IMap.empty ret ty term.p; env | Cmd_DefineFunRec (fun_def,term) -> let locals,ret,fun_dec = get_fun_def_locals (env,locals) fun_def in let env = Smtlib_typed_env.mk_fun_def (env,locals) fun_dec in let ty,dums = type_term (env,locals,[]) term in check_if_escaped dums; inst_and_unify (env,locals) Smtlib_ty.IMap.empty ret ty term.p; env | Cmd_DefineFunsRec (fun_def_list, term_list) -> let env,locals_term_list = List.fold_left (fun (env,locals_term_list) fun_def -> let locals,ret,fun_dec = get_fun_def_locals (env,locals) fun_def in let env = Smtlib_typed_env.mk_fun_def (env,locals) fun_dec in env, (locals,ret) :: locals_term_list ) (env,[]) (List.rev fun_def_list) in List.iter2 (fun (locals,ret) term -> let ty,dums = type_term (env,locals,[]) term in check_if_escaped dums; inst_and_unify (env,locals) Smtlib_ty.IMap.empty ret ty term.p; ) locals_term_list term_list; env | Cmd_DefineSort (symbol, symbol_list, sort) -> Smtlib_typed_env.mk_sort_def (env,locals) symbol symbol_list sort | Cmd_Echo (_attribute_value) -> Options.check_command "echo"; env | Cmd_GetAssert -> Options.check_command "get-assertions"; env | Cmd_GetProof -> Options.check_command "get-proof"; env | Cmd_GetUnsatCore -> Options.check_command "get-unsat-core"; env | Cmd_GetValue (_term_list) -> Options.check_command "get-value"; env | Cmd_GetAssign -> Options.check_command "get-assignement"; env | Cmd_GetOption (_keyword) -> Options.check_command "get-option"; env | Cmd_GetInfo (_key_info) -> Options.check_command "get-info"; env | Cmd_GetModel -> Options.check_command "get-model"; env | Cmd_GetUnsatAssumptions -> Options.check_command "get-unsat-core"; env | Cmd_Reset -> Options.check_command "reset"; env | Cmd_ResetAssert -> Options.check_command "reset-assertions"; env | Cmd_SetLogic(symb) -> Smtlib_typed_logic.set_logic env symb | Cmd_SetOption (_option) -> Options.check_command "set-option"; env | Cmd_SetInfo (_attribute) -> Options.check_command "set-info"; env | Cmd_Push n -> begin try let n = int_of_string n in for _i = 0 to (n - 1 ) do Stack.push env assertion_stack done; env with _ -> error (Incremental_error ("Push argument must be an integer")) c.p end | Cmd_Pop n -> begin let env = ref env in try let n = int_of_string n in for _i = 0 to (n -1) do env := Stack.pop assertion_stack done; !env with | Stack.Empty -> error (Incremental_error ("Too many pop command")) c.p | _ -> error (Incremental_error ("Pop argument must be an integer")) c.p end | Cmd_Exit -> env let typing parsed_ast = let env = if not (get_logic ()) then try let c = List.hd parsed_ast in Smtlib_typed_logic.set_logic (Smtlib_typed_env.empty ()) {c with c="ALL"} with _ -> assert false else Smtlib_typed_env.empty () in let env = List.fold_left (fun env c -> let env = type_command (env,SMap.empty) c in if Options.verbose () > 0 then Smtlib_printer.print_command c; env ) env parsed_ast in if Options.verbose () > 1 then begin Smtlib_printer.print_env env; end psmt2-frontend-0.4.0/src/lib/version.ml000066400000000000000000000000241402732347700177560ustar00rootroot00000000000000let version="0.4.0" psmt2-frontend-0.4.0/src/lib/version.mli000066400000000000000000000000241402732347700201270ustar00rootroot00000000000000val version : stringpsmt2-frontend-0.4.0/test/000077500000000000000000000000001402732347700153655ustar00rootroot00000000000000psmt2-frontend-0.4.0/test/output-tests/000077500000000000000000000000001402732347700200655ustar00rootroot00000000000000psmt2-frontend-0.4.0/test/output-tests/dune000066400000000000000000000013221402732347700207410ustar00rootroot00000000000000; if you modify this file, add 'test' to the 'skip' field in drom.toml ; a first example where we would test the behavior of one of the executables ; that we generate else-where (rule (deps test1.expected) (action (with-stdout-to test1.output (run cat test1.expected)))) (rule (alias runtest) (action (diff test1.expected test1.output))) ; a second example where we generate a file and test its output (executable (name test2) (libraries psmt2-frontend) ; add your own library here ) (alias (name buildtest) (deps test2.exe)) (rule (deps min.smt2) (action (with-stdout-to test2.output (run %{exe:test2.exe} min.smt2)))) (rule (alias runtest) (action (diff test2.expected test2.output))) psmt2-frontend-0.4.0/test/output-tests/min.smt2000066400000000000000000000000141402732347700214520ustar00rootroot00000000000000(check-sat) psmt2-frontend-0.4.0/test/output-tests/test1.expected000066400000000000000000000000141402732347700226430ustar00rootroot00000000000000Hello world psmt2-frontend-0.4.0/test/output-tests/test2.expected000066400000000000000000000000061402732347700226450ustar00rootroot00000000000000undef psmt2-frontend-0.4.0/test/output-tests/test2.ml000066400000000000000000000037541402732347700214710ustar00rootroot00000000000000open Format module Smtlib_error = Psmt2Frontend.Smtlib_error module Options = Psmt2Frontend.Options module Smtlib_parser = Psmt2Frontend.Smtlib_parser module Smtlib_lexer = Psmt2Frontend.Smtlib_lexer module Smtlib_typing = Psmt2Frontend.Smtlib_typing let fmt = Options.get_err_fmt () let verbose = ref 0 let parse_only = ref false let quiet = ref false let keep_loc = ref false let smt2 = ".smt2" let psmt2 = ".psmt2" let usage = sprintf "usage: %s [options] file%s" Sys.argv.(1) smt2 let spec = [ "-parse-only", Arg.Set parse_only, " stops after parsing"; "-quiet", Arg.Set quiet, " don't print warning"; "-verbose", Arg.Set_int verbose, " 1 : print typed ast, 2 : print typing env"; "-keep_loc", Arg.Set keep_loc, "keep location in AST" ] let file = let file = ref None in let set_file s = if (not (Filename.check_suffix s psmt2)) && (not (Filename.check_suffix s smt2)) then raise (Arg.Bad "invalid extension"); file := Some s in Arg.parse spec set_file usage; Options.set_quiet !quiet; Options.set_verbose !verbose; Options.set_keep_loc !keep_loc; match !file with Some f -> Options.set_filename f; f | None -> Arg.usage spec usage; exit 1 let () = try let in_chan = open_in file in let lexbuf = Lexing.from_channel in_chan in try let parsed = ref (Smtlib_parser.commands Smtlib_lexer.token lexbuf) in if not !parse_only then Smtlib_typing.typing !parsed; if not (Options.quiet ()) then printf "%s@." (Options.status ()); exit 0 with | Smtlib_parser.Error -> let loc = Smtlib_lexer.current_pos lexbuf in Smtlib_error.print fmt file (Syntax_error (Lexing.lexeme lexbuf)) loc; exit 1 |Smtlib_error.Error (e,p) -> let p = match p with | None -> Lexing.dummy_pos,Lexing.dummy_pos | Some p -> p in Smtlib_error.print fmt file e p; exit 1 with |Invalid_argument _ -> fprintf fmt "No input file given@."; exit 1 psmt2-frontend-0.4.0/test/output-tests/test_incr.smt2000066400000000000000000000002161402732347700226650ustar00rootroot00000000000000(set-logic ALL) (set-option :incremental) (push 1) (define-fun lh_2 () Bool false) (assert lh_2) (check-sat) (pop 1) (assert lh_2) (check-sat)