diff --git a/CHANGES.md b/CHANGES.md index 0f29fc6015..e98ac2f9db 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +## unreleased + +### SMT-LIB support + + - Remove the legacy frontend and AB-Why3 plugin + ## v2.6.0 ### Command-line interface diff --git a/Makefile b/Makefile index 182b6ff8e6..090115c0af 100644 --- a/Makefile +++ b/Makefile @@ -43,7 +43,7 @@ SPHINXBUILD = sphinx-build # This excludes: # - .ml files generated by menhir or ocamllex # (since they reside in dune specific directory) -GENERATED_LINKS=alt-ergo alt-ergo.js alt-ergo-worker.js AB-Why3-plugin.cma AB-Why3-plugin.cmxs fm-simplex-plugin.cma fm-simplex-plugin.cmxs +GENERATED_LINKS=alt-ergo alt-ergo.js alt-ergo-worker.js fm-simplex-plugin.cma fm-simplex-plugin.cmxs GENERATED=$(GENERATED_LINKS) @@ -62,8 +62,7 @@ clean: generated-clean dune-clean ocamldot-clean distclean: makefile-distclean release-distclean # declare these aliases as phony -.PHONY: world conf clean distclean alt-ergo-lib \ - alt-ergo-parsers alt-ergo +.PHONY: world conf clean distclean alt-ergo-lib alt-ergo # ================= # Build rules (dev) @@ -83,10 +82,6 @@ fm-simplex: $(DUNE) build $(DUNE_FLAGS) @$(PLUGINS_DIR)/fm-simplex/all $(DUNE) build $(DUNE_FLAGS) @install -AB-Why3: - $(DUNE) build $(DUNE_FLAGS) @$(PLUGINS_DIR)/AB-Why3/all - $(DUNE) build $(DUNE_FLAGS) alt-ergo-plugin-ab-why3.install - plugins: $(DUNE) build $(DUNE_FLAGS) @$(PLUGINS_DIR)/all @@ -99,7 +94,7 @@ all: # declare these targets as phony to avoid name clashes with existing directories, # particularly the "plugins" target -.PHONY: lib bin fm-simplex AB-Why3 plugins all +.PHONY: lib bin fm-simplex plugins all # ===================== # Build rules (release) @@ -241,7 +236,7 @@ lock: ./alt-ergo-lib.opam.locked dev-switch: - opam switch create . --deps-only --ignore-constraints-on alt-ergo-lib,alt-ergo-parsers + opam switch create . --deps-only --ignore-constraints-on alt-ergo-lib js-deps: opam install \ @@ -295,7 +290,6 @@ FILES_DEST=public-release/$(PUBLIC_RELEASE) tests \ alt-ergo.opam \ alt-ergo-lib.opam \ - alt-ergo-parsers.opam \ dune-project \ Makefile \ README.md \ diff --git a/alt-ergo-parsers.opam b/alt-ergo-parsers.opam deleted file mode 100644 index d9122c9962..0000000000 --- a/alt-ergo-parsers.opam +++ /dev/null @@ -1,49 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -version: "dev" -synopsis: "The Alt-Ergo SMT prover parser library" -description: """ -This is the parser library used in the Alt-Ergo SMT solver. - -Alt-Ergo is an automatic theorem prover of mathematical formulas. It was developed at LRI, and is now maintained at OCamlPro. - -See more details on http://alt-ergo.ocamlpro.com/""" -maintainer: ["Alt-Ergo developers "] -authors: ["Alt-Ergo developers "] -homepage: "https://alt-ergo.ocamlpro.com/" -doc: "https://ocamlpro.github.io/alt-ergo" -bug-reports: "https://github.com/OCamlPro/alt-ergo/issues" -depends: [ - "ocaml" {>= "4.08.1"} - "dune" {>= "3.14"} - "alt-ergo-lib" {= version} - "psmt2-frontend" {>= "0.4"} - "menhir" - "stdlib-shims" - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "--promote-install-files=false" - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ["dune" "install" "-p" name "--create-install-files" name] -] -dev-repo: "git+https://github.com/OCamlPro/alt-ergo.git" -# This part comes from the template. Please edit alt-ergo-parsers.opam.template -# and not alt-ergo-parsers.opam which is generated by dune -tags: "org:OCamlPro" - -license: [ - "LicenseRef-OCamlpro-Non-Commercial" - "Apache-2.0" -] diff --git a/alt-ergo-parsers.opam.template b/alt-ergo-parsers.opam.template deleted file mode 100644 index 2cc0786535..0000000000 --- a/alt-ergo-parsers.opam.template +++ /dev/null @@ -1,8 +0,0 @@ -# This part comes from the template. Please edit alt-ergo-parsers.opam.template -# and not alt-ergo-parsers.opam which is generated by dune -tags: "org:OCamlPro" - -license: [ - "LicenseRef-OCamlpro-Non-Commercial" - "Apache-2.0" -] diff --git a/alt-ergo-plugin-ab-why3.opam b/alt-ergo-plugin-ab-why3.opam deleted file mode 100644 index c172e83d8f..0000000000 --- a/alt-ergo-plugin-ab-why3.opam +++ /dev/null @@ -1,44 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -version: "dev" -synopsis: "An experimental Why3 frontend for Alt-Ergo" -description: """ -An experimental front-end that parses a subset of Why3's logic. More -precisely, this front-end targets proof obligations generated by the -Atelier-B framework in Why3 format. It should be used with a prelude -defining the B Set theory.""" -maintainer: ["Alt-Ergo developers "] -authors: ["Alt-Ergo developers "] -license: "LGPL-2.1-only" -homepage: "https://alt-ergo.ocamlpro.com/" -doc: "https://ocamlpro.github.io/alt-ergo" -bug-reports: "https://github.com/OCamlPro/alt-ergo/issues" -depends: [ - "dune" {>= "3.14"} - "alt-ergo" {= version} - "alt-ergo-lib" {= version} - "alt-ergo-parsers" {= version} - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "--promote-install-files=false" - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ["dune" "install" "-p" name "--create-install-files" name] -] -dev-repo: "git+https://github.com/OCamlPro/alt-ergo.git" -# This part comes from the template. Please edit -# alt-ergo-plugin-ab-why3.opam.template and not alt-ergo-plugin-ab-why3.opam -# which is generated by dune - -conflicts: [ "ocaml-option-bytecode-only" ] diff --git a/alt-ergo-plugin-ab-why3.opam.template b/alt-ergo-plugin-ab-why3.opam.template deleted file mode 100644 index 21eb7035f2..0000000000 --- a/alt-ergo-plugin-ab-why3.opam.template +++ /dev/null @@ -1,5 +0,0 @@ -# This part comes from the template. Please edit -# alt-ergo-plugin-ab-why3.opam.template and not alt-ergo-plugin-ab-why3.opam -# which is generated by dune - -conflicts: [ "ocaml-option-bytecode-only" ] diff --git a/alt-ergo.opam b/alt-ergo.opam index 2f844fb8f2..2ea5f7f293 100644 --- a/alt-ergo.opam +++ b/alt-ergo.opam @@ -15,7 +15,6 @@ depends: [ "ocaml" {>= "4.08.1"} "dune" {>= "3.14"} "alt-ergo-lib" {= version} - "alt-ergo-parsers" {= version} "menhir" "dune-site" "cmdliner" {>= "1.1.0"} diff --git a/default.nix b/default.nix index b8cc07982c..bf2392693c 100644 --- a/default.nix +++ b/default.nix @@ -27,19 +27,6 @@ let ]; }; - alt-ergo-parsers = ocamlPackages.buildDunePackage rec { - pname = "alt-ergo-parsers"; - inherit version src; - - minimalOCamlVersion = "4.08"; - duneVersion = "3"; - - nativeBuildInputs = [ ocamlPackages.menhir ]; - propagatedBuildInputs = [ alt-ergo-lib ] ++ (with ocamlPackages; [ - psmt2-frontend - ]); - }; - alt-ergo = ocamlPackages.buildDunePackage { pname = "alt-ergo"; inherit version src; @@ -47,7 +34,7 @@ let minimalOCamlVersion = "4.08"; duneVersion = "3"; - buildInputs = [ alt-ergo-parsers ] ++ (with ocamlPackages; [ + buildInputs = (with ocamlPackages; [ cmdliner dune-site ]); diff --git a/docs/sphinx_docs/Install/index.md b/docs/sphinx_docs/Install/index.md index 96b5d173d5..907aa0ee30 100644 --- a/docs/sphinx_docs/Install/index.md +++ b/docs/sphinx_docs/Install/index.md @@ -7,7 +7,7 @@ Alt-ergo is available on [opam], the ocaml package manager with the following co opam install alt-ergo ``` -This command will install the Alt-ergo library `alt-ergo-lib` and the parsers `alt-ergo-parsers`, as well as other librairies detailled in [dependencies](#dependencies). +This command will install the Alt-ergo library `alt-ergo-lib`, as well as other librairies detailled in [dependencies](#dependencies). Since version 2.6.0, Alt-Ergo is compatible with opam 2.2 installations using both Cygwin and MSYS2 on Windows. To setup opam on Windows, please follow the instructions [here](https://ocamlpro.com/blog/2024_07_01_opam_2_2_0_releases/). @@ -83,12 +83,6 @@ Note: these are somewhat obsolete; nowadays you can just use `dune` 2. Install with `make install-lib` -#### Alt-Ergo parsers - - 1. Compile with `make alt-ergo-parsers` - - 2. Install with `make install-parsers` - #### Alt-Ergo binary 1. Compile with `make alt-ergo` diff --git a/docs/sphinx_docs/Plugins/index.md b/docs/sphinx_docs/Plugins/index.md index 04c66dcab0..62e14b031a 100644 --- a/docs/sphinx_docs/Plugins/index.md +++ b/docs/sphinx_docs/Plugins/index.md @@ -24,16 +24,6 @@ be registered in the `(alt-ergo plugins)` site using to be available as an option to `--inequalities-plugin`. ``` -## AB why3 plugin (**deprecated**) - -```{warning} -The AB Why3 plugin requires the use of the `--frontend legacy` option, which is -deprecated and will be removed in the next version of Alt-Ergo. - -If you are using this plugin and would like it to be available in new versions -of Alt-Ergo, please contact [the Alt-Ergo developers](mailto:alt-ergo@ocamlpro.com). -``` - ```{toctree} :maxdepth: 2 diff --git a/docs/sphinx_docs/Usage/index.md b/docs/sphinx_docs/Usage/index.md index 9fe946d88f..b75634a11b 100644 --- a/docs/sphinx_docs/Usage/index.md +++ b/docs/sphinx_docs/Usage/index.md @@ -40,24 +40,6 @@ Alt-Ergo supports file extensions: See the [SMT-LIB language] and [Alt-ergo native language] sections for more information about the format of the input files. -### Frontend option - -The `--frontend` option lets you select the frontend used to parse and type the input file. Since version 2.5.0, -Alt-Ergo integrates two frontends: -- The `dolmen` frontend is the default frontend, powered by the - [Dolmen](https://github.com/Gbury/dolmen) library. The native and SMT-LIB - languages are both supported by this frontend. -- The `legacy` frontend is the historical frontend of Alt-Ergo supporting the - native language. You can select it with the `--frontend legacy` option. The - legacy frontend is deprecated, and will be removed in a future release. - -```{admonition} Note - -The `legacy` frontend has limited support for the SMT-LIB language, but many -SMT-LIB features will not work with the `legacy` frontend. Use the (default) -`dolmen` frontend for SMT-LIB inputs. -``` - ### Preludes Preludes can be passed to Alt-Ergo as follows: diff --git a/dune-project b/dune-project index ee7f674cc2..141f6a1060 100644 --- a/dune-project +++ b/dune-project @@ -28,7 +28,6 @@ See more details on https://alt-ergo.ocamlpro.com/") (ocaml (>= 4.08.1)) dune (alt-ergo-lib (= :version)) - (alt-ergo-parsers (= :version)) menhir dune-site (cmdliner (>= 1.1.0)) @@ -38,29 +37,6 @@ See more details on https://alt-ergo.ocamlpro.com/") (sites (share preludes) (lib plugins)) ) -(package - (name alt-ergo-parsers) - (synopsis "The Alt-Ergo SMT prover parser library") - (description "\ -This is the parser library used in the Alt-Ergo SMT solver. - -Alt-Ergo is an automatic theorem prover of mathematical formulas. It was developed at LRI, and is now maintained at OCamlPro. - -See more details on http://alt-ergo.ocamlpro.com/" - ) - (license "LicenseRef-OcamlPro-Non-Commercial") - - (depends - (ocaml (>= 4.08.1)) - dune - (alt-ergo-lib (= :version)) - (psmt2-frontend (>= 0.4)) - menhir - stdlib-shims - (odoc :with-doc) - ) -) - (package (name alt-ergo-lib) (synopsis "The Alt-Ergo SMT prover library") @@ -97,18 +73,3 @@ See more details on http://alt-ergo.ocamlpro.com/" (result (< 1.5)) ) ) - -(package - (name alt-ergo-plugin-ab-why3) - (synopsis "An experimental Why3 frontend for Alt-Ergo") - (description "\ -An experimental front-end that parses a subset of Why3's logic. More -precisely, this front-end targets proof obligations generated by the -Atelier-B framework in Why3 format. It should be used with a prelude -defining the B Set theory.") - (license "LGPL-2.1-only") - - (depends - (alt-ergo (= :version)) - (alt-ergo-lib (= :version)) - (alt-ergo-parsers (= :version)))) diff --git a/examples/lib_usage.ml b/examples/lib_usage.ml index eaa8ed3291..3142b23b3b 100644 --- a/examples/lib_usage.ml +++ b/examples/lib_usage.ml @@ -25,74 +25,8 @@ (* *) (**************************************************************************) -(**** - Using Alt-Ergo's lib: minimal example +(* This file is intended to contain the documentation of Alt-Ergo library API. + We plan to write a new API with the Dolmen frontend and explain its usage + here. - compile & test with the following command if the lib is not installed: - - ocamlopt -o lib_usage \ - -I `ocamlfind query num` \ - -I `ocamlfind query zarith` \ - -I `ocamlfind query ocplib-simplex` \ - -I `ocamlfind query camlzip` \ - -I .. \ - nums.cmxa zarith.cmxa ocplibSimplex.cmxa \ - unix.cmxa str.cmxa zip.cmxa dynlink.cmxa \ - altErgoLib.cmxa lib_usage.ml && ./lib_usage - - or with the following command if the lib is installed: - - - ocamlopt -o lib_usage \ - -I `ocamlfind query num` \ - -I `ocamlfind query zarith` \ - -I `ocamlfind query ocplib-simplex` \ - -I `ocamlfind query camlzip` \ - -I `ocamlfind query alt-ergo` \ - nums.cmxa zarith.cmxa ocplibSimplex.cmxa \ - unix.cmxa str.cmxa zip.cmxa dynlink.cmxa \ - altErgoLib.cmxa lib_usage.ml && ./lib_usage - - ****) - -Format.eprintf - "\n(* This minimal example shows how to use Alt-Ergo's lib *)\n@." - -open AltErgoLib - -module PA = Parsed_interface - -let _x = PA.mk_var_type Loc.dummy "'a" - -let one = PA.mk_int_const Loc.dummy "1" -let two = PA.mk_int_const Loc.dummy "2" -let three = PA.mk_int_const Loc.dummy "3" -let one_two = PA.mk_add Loc.dummy one two -let eq1 = PA.mk_pred_eq Loc.dummy one_two three -let eq2 = PA.mk_pred_eq Loc.dummy one three - -let goal_1 = PA.mk_goal Loc.dummy "toy_1" eq1 -let goal_2 = PA.mk_goal Loc.dummy "toy_2" eq2 -let goal_3 = PA.mk_goal Loc.dummy "toy_3" (PA.mk_not Loc.dummy eq1) - -let parsed = [goal_1; goal_2; goal_3] - -let typed, _env = Typechecker.type_file parsed - -let pbs = Typechecker.split_goals_and_cnf typed - -module SAT = Fun_sat_frontend.Make(Theory.Main_Default) -module FE = Frontend.Make(SAT) - -let () = - List.iter - (fun (pb, _goal_name) -> - let ctxt = Frontend.init_all_used_context () in - let env = FE.init_env ctxt in - List.iter (FE.process_decl env) pb; - match env.res with - | `Sat | `Unknown -> - Format.printf "unknown@." - | `Unsat -> - Format.printf "unsat@." - ) pbs + See the issue https://github.com/OCamlPro/alt-ergo/issues/1252 *) diff --git a/rsc/extra/subgraphs.dot b/rsc/extra/subgraphs.dot index 8b73671db5..4a5669cbe4 100644 --- a/rsc/extra/subgraphs.dot +++ b/rsc/extra/subgraphs.dot @@ -202,10 +202,7 @@ subgraph cluster_lib { style=filled; color=lightblue; "Frontend"; - "Cnf"; - "Typechecker"; - "Parsed_interface"; - "Input"; + "Translate"; "Parse_command" } diff --git a/src/bin/common/dune b/src/bin/common/dune index 8d7682f244..fd37c5ce62 100644 --- a/src/bin/common/dune +++ b/src/bin/common/dune @@ -8,7 +8,6 @@ (name alt_ergo_common) (libraries alt-ergo-lib - alt-ergo-parsers stdlib-shims cmdliner dune-site @@ -19,7 +18,6 @@ MyDynlink AltErgoSites Parse_command - Input_frontend Signals_profiling Solving_loop) (preprocess diff --git a/src/bin/common/index_common.mld b/src/bin/common/index_common.mld index 69b725175c..1ee6c5d076 100644 --- a/src/bin/common/index_common.mld +++ b/src/bin/common/index_common.mld @@ -10,12 +10,6 @@ The solving loop is done in the {!Alt_ergo_common.Solving_loop} module. This mod The command line parsing is done with {{:https://erratique.ch/software/cmdliner}[cmdliner]} in the module {!module:Alt_ergo_common.Parse_command}. This module initialises options of the Alt-Ergo-Lib library. -{2:input Input Frontend } - -The {!module:Alt_ergo_common.Input_frontend} module register an input method capable of parsing and typechecking the input files - -The legacy frontend is used to parse and typecheck file with the native Alt-Ergo syntaxe and also the smtlib2 and psmt2 syntaxe. - {2:signals Signals and profiling } The {!module:Alt_ergo_common.Signals_profiling} module initialise handlers for system signals and profiling informations and timers. diff --git a/src/bin/common/input_frontend.ml b/src/bin/common/input_frontend.ml deleted file mode 100644 index 16c7ce72b9..0000000000 --- a/src/bin/common/input_frontend.ml +++ /dev/null @@ -1,58 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -open AltErgoLib -open AltErgoParsers - -(* === LEGACY input method === *) - -let register_legacy () = - let module M : Input.S with type parsed = Parsed.decl = struct - - (* Parsing *) - - type parsed = Parsed.decl - - let parse_file ~content ~format = - let l = Parsers.parse_problem_as_string ~content ~format in - List.to_seq l - - let parse_files ~filename ~preludes = - let l = Parsers.parse_problem ~filename ~preludes in - List.to_seq l - - (* Typechecking *) - - include Typechecker - - end in - (* Register the parser for natif format *) - AltErgoParsers.Native_lexer.register_native (); - (* Register the parser for smt2 format *) - AltErgoParsers.Psmt2_to_alt_ergo.register_psmt2 (); - (* Register the legacy frontend *) - Input.register "legacy" (module M) diff --git a/src/bin/common/input_frontend.mli b/src/bin/common/input_frontend.mli deleted file mode 100644 index 3d1d9284bd..0000000000 --- a/src/bin/common/input_frontend.mli +++ /dev/null @@ -1,30 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -(** Register the legacy frontend with parser for natif and smt2/psmt2 format - as Input *) -val register_legacy : unit -> unit diff --git a/src/bin/common/parse_command.ml b/src/bin/common/parse_command.ml index d5fa49d201..a71fd83297 100644 --- a/src/bin/common/parse_command.ml +++ b/src/bin/common/parse_command.ml @@ -976,13 +976,10 @@ let parse_output_opt = let frontend = let doc = "Select the parsing and typing frontend. Support for non-default \ - frontends is deprecated and will be removed in the next release." + frontends is deprecated." in let docv = "FTD" in - let deprecated = - "this option is deprecated and will be ignored in the \ - next version" - in + let deprecated = "this option is deprecated and is ignored." in Arg.(value & opt string "dolmen" & info ["frontend"] ~docv ~docs:s_execution ~doc ~deprecated) in @@ -1189,7 +1186,7 @@ let parse_output_opt = in let set_frontend = - Term.(const set_frontend $ frontend) + Term.(const ignore $ frontend) in Term.(ret (const mk_output_opt $ diff --git a/src/bin/common/solving_loop.ml b/src/bin/common/solving_loop.ml index d8d9624ded..52c465ab2d 100644 --- a/src/bin/common/solving_loop.ml +++ b/src/bin/common/solving_loop.ml @@ -44,15 +44,6 @@ let is_solver_ctx_empty = function type 'a sat_module = (module Sat_solver_sig.S with type t = 'a) -type any_sat_module = (module Sat_solver_sig.S) - -(* Internal state while iterating over input statements *) -type 'a state = { - env : 'a; - solver_ctx: solver_ctx; - sat_solver : any_sat_module; -} - let empty_solver_ctx = { ctx = []; local = []; @@ -208,139 +199,6 @@ let process_source ?selector_inst ~print_status src = Unknown None in - let typed_loop all_context state td = - if O.get_type_only () then state else begin - match td.Typed.c with - | Typed.TGoal (_, kind, name, _) -> - let l = - state.solver_ctx.local @ - state.solver_ctx.global @ - state.solver_ctx.ctx - in - let cnf = List.rev @@ Cnf.make l td in - let _ = solve state.sat_solver all_context (cnf, name) in - begin match kind with - | Ty.Check - | Ty.Cut -> - { state with solver_ctx = - { state.solver_ctx with local = []}} - | Ty.Thm | Ty.Sat -> - { state with solver_ctx = { - state.solver_ctx with global = []; local = []}} - end - | Typed.TAxiom (_, s, _, _) when Ty.is_global_hyp s -> - let cnf = Cnf.make state.solver_ctx.global td in - { state with solver_ctx = { state.solver_ctx with global = cnf; }} - | Typed.TAxiom (_, s, _, _) when Ty.is_local_hyp s -> - let cnf = Cnf.make state.solver_ctx.local td in - { state with solver_ctx = { state.solver_ctx with local = cnf; }} - | Typed.TReset _ -> - { state with solver_ctx = {ctx = []; local = []; global = []}} - | Typed.TExit _ -> raise Exit - | _ -> - let cnf = Cnf.make state.solver_ctx.ctx td in - { state with solver_ctx = { state.solver_ctx with ctx = cnf; }} - end - in - - let ae_fe filename frontend = - let (module I : Input.S) = Input.find frontend in - - let parsed () = - try - Options.Time.start (); - if not (Options.get_timelimit_per_goal()) then - Options.Time.set_timeout (Options.get_timelimit ()); - - Signals_profiling.init_profiling (); - - let with_opt (get, set) v f = - let v' = get () in - set v; - Fun.protect - ~finally:(fun () -> set v') - f - in - let with_infer_output_format = - with_opt Options.(get_infer_output_format, set_infer_output_format) - in - let with_input_format = - with_opt Options.(get_input_format, set_input_format) - in - let theory_preludes = - Options.get_theory_preludes () - |> List.to_seq - |> Seq.flat_map (fun theory -> - let filename = Theories.filename theory in - let content = Theories.content theory in - with_input_format None @@ fun () -> - with_infer_output_format false @@ fun () -> - I.parse_file - ~content - ~format:(Some (Filename.extension filename))) - in - let preludes = Options.get_preludes () in - Compat.Seq.append theory_preludes @@ - I.parse_files ~filename ~preludes - with - | Util.Timeout -> - Frontend.print_status (Timeout None) 0; - exit_as_timeout () - | Parsing.Parse_error -> - (* TODO(Steven): displaying a dummy value is a bad idea. - This should only be executed with the legacy frontend, which should - be deprecated in a near future, so this code will be removed (or at - least, its behavior unspecified). *) - fatal_error - "%a" - Errors.report - (Syntax_error ((Lexing.dummy_pos,Lexing.dummy_pos),"")) - | Errors.Error e -> - fatal_error "%a" Errors.report e - in - - let all_used_context = Frontend.init_all_used_context () in - if Options.get_timelimit_per_goal() then - Frontend.print_status Preprocess 0; - let assertion_stack = Stack.create () in - let typing_loop state p = - if O.get_parse_only () then state else begin - try - let l, env = I.type_parsed state.env assertion_stack p in - List.fold_left (typed_loop all_used_context) { state with env; } l - with - | Errors.Error e -> - let () = - if e != Warning_as_error then - recoverable_error "%a" Errors.report e - else - recoverable_error "" - in - state - | Exit -> exit 0 - end - in - let sat_solver = - let module SatCont = - (val (Sat_solver.get_current ()) : Sat_solver_sig.SatContainer) - in - let module TH = (val Sat_solver.get_theory ~no_th:(O.get_no_theory ())) in - (module SatCont.Make(TH) : Sat_solver_sig.S) - in - let state = { - env = I.empty_env; - solver_ctx = empty_solver_ctx; - sat_solver; - } in - try - let parsed_seq = parsed () in - let _ : _ state = Seq.fold_left typing_loop state parsed_seq in - Options.Time.unset_timeout (); - with Util.Timeout -> - Frontend.print_status (Timeout None) 0; - exit_as_timeout () - in - let solver_ctx_key: solver_ctx State.key = State.create_key ~pipe:"" "solving_state" in @@ -491,7 +349,7 @@ let process_source ?selector_inst ~print_status src = ~size_limit ~response_file |> Parser.init |> Typer.init - ~additional_builtins:D_cnf.builtins + ~additional_builtins:Translate.builtins ~extension_builtins:[Typer.Ext.bv2nat] |> Typer_Pipe.init ~type_check in @@ -654,7 +512,7 @@ let process_source ?selector_inst ~print_status src = { Typer_Pipe.id; contents; loc; attrs = []; implicit = false } in let cnf = - D_cnf.make (State.get State.logic_file st).loc + Translate.make (State.get State.logic_file st).loc (State.get solver_ctx_key st).ctx stmt in State.set solver_ctx_key ( @@ -770,7 +628,7 @@ let process_source ?selector_inst ~print_status src = Expr.mk_term (Sy.name name) [] - (D_cnf.dty_to_ty term.DStd.Expr.term_ty) + (Translate.dty_to_ty term.DStd.Expr.term_ty) in match get_value simple_form with | Some v -> Fmt.to_to_string Expr.print v @@ -847,7 +705,7 @@ let process_source ?selector_inst ~print_status src = in let stmt = { Typer_Pipe.id; contents; loc ; attrs; implicit } in let cnf, is_thm = - match D_cnf.make (State.get State.logic_file st).loc l stmt with + match Translate.make (State.get State.logic_file st).loc l stmt with | { Commands.st_decl = Query (_, _, kind); _ } as cnf :: hyps -> let is_thm = match kind with Ty.Thm | Sat -> true | _ -> false @@ -969,7 +827,7 @@ let process_source ?selector_inst ~print_status src = unsupported statement is encountered. *) let cnf = - D_cnf.make (State.get State.logic_file st).loc + Translate.make (State.get State.logic_file st).loc (State.get solver_ctx_key st).ctx td in State.set solver_ctx_key ( @@ -1030,9 +888,7 @@ let process_source ?selector_inst ~print_status src = let bt = Printexc.get_raw_backtrace () in ignore (handle_exn st bt exn) in - match O.get_frontend () with - | "dolmen" -> d_fe src - | frontend -> ae_fe (O.get_file ()) frontend + d_fe src let main () = let path = Options.get_file () in diff --git a/src/bin/js/main_text_js.ml b/src/bin/js/main_text_js.ml index ec82a032d9..2dba2f3205 100644 --- a/src/bin/js/main_text_js.ml +++ b/src/bin/js/main_text_js.ml @@ -27,10 +27,6 @@ open Alt_ergo_common -(* Register input method and parsers *) -let register_input () = - Input_frontend.register_legacy () - (* done here to initialize options, before the instantiations of functors *) let parse_cmdline () = @@ -43,7 +39,6 @@ let () = turn off this feature as we do not support it correctly. See issue https://github.com/OCamlPro/alt-ergo/issues/1250 *) AltErgoLib.Options.set_exit_on_error false; - register_input (); parse_cmdline (); AltErgoLib.Printer.init_colors (); AltErgoLib.Printer.init_output_format (); diff --git a/src/bin/js/options_interface.ml b/src/bin/js/options_interface.ml index e27c0b044f..464e9c7a29 100644 --- a/src/bin/js/options_interface.ml +++ b/src/bin/js/options_interface.ml @@ -81,12 +81,6 @@ let get_no_decisions_on = function Util.SS.add d acc ) Util.SS.empty l) -let get_frontend = function - None -> None - | Some f -> match f with - | Legacy -> Some "legacy" - | Unknown f -> Some f - let get_numbers = function None -> None | Some i -> Some (Numbers.Q.from_int i) @@ -96,7 +90,6 @@ let set_options_opt f = function | Some v -> f v let set_options r = - set_options_opt Options.set_frontend (get_frontend r.frontend); set_options_opt Options.set_debug r.debug; set_options_opt Options.set_debug_ac r.debug_ac ; set_options_opt Options.set_debug_adt r.debug_adt ; diff --git a/src/bin/js/worker_interface.ml b/src/bin/js/worker_interface.ml index a39bfd7f1f..21870d25e2 100644 --- a/src/bin/js/worker_interface.ml +++ b/src/bin/js/worker_interface.ml @@ -111,24 +111,6 @@ let sat_solver_encoding = (fun () -> CDCL_Tableaux); ] -type frontend = - | Legacy - | Unknown of string - -let frontend_encoding = - union [ - case(Tag 1) - ~title:"Legacy" - (constant "Legacy") - (function Legacy -> Some () | _ -> None) - (fun () -> Legacy); - case(Tag 2) - ~title:"Unknown" - (obj1 (req "Unknown" string)) - (function Unknown s -> Some s | _ -> None) - (fun s -> Unknown(s)); - ] - type instantiation_heuristic = INormal | IAuto | IGreedy type interpretation = INone | IFirst | IEvery | ILast @@ -212,7 +194,6 @@ type options = { save_used_context : bool option; answers_with_loc : bool option; - frontend : frontend option; input_format : input_format option; parse_only : bool option; preludes : (string list) option; @@ -313,7 +294,6 @@ let init_options () = { save_used_context = None; answers_with_loc = None; - frontend = None; input_format = None; parse_only = None; preludes = None; @@ -442,9 +422,8 @@ let opt2_encoding = conv (fun opt2 -> opt2) (fun opt2 -> opt2) - (obj7 + (obj6 (opt "answers_with_loc" bool) - (opt "frontend" frontend_encoding) (opt "input_format" format_encoding) (opt "parse_only" bool) (opt "preludes" (list string)) @@ -587,7 +566,6 @@ let options_to_json opt = in let all_opt2 = (opt.answers_with_loc, - opt.frontend, opt.input_format, opt.parse_only, opt.preludes, @@ -710,7 +688,6 @@ let options_from_json options = replay_used_context, save_used_context) = all_opt1 in let (answers_with_loc, - frontend, input_format, parse_only, preludes, @@ -795,7 +772,6 @@ let options_from_json options = replay_used_context; save_used_context; answers_with_loc; - frontend; input_format; parse_only; preludes; diff --git a/src/bin/js/worker_interface.mli b/src/bin/js/worker_interface.mli index b52303ad1c..c3f1c2bd30 100644 --- a/src/bin/js/worker_interface.mli +++ b/src/bin/js/worker_interface.mli @@ -48,10 +48,6 @@ type sat_solver = | CDCL | CDCL_Tableaux -type frontend = - | Legacy - | Unknown of string - type instantiation_heuristic = INormal | IAuto | IGreedy type interpretation = INone | IFirst | IEvery | ILast @@ -95,7 +91,6 @@ type options = { save_used_context : bool option; answers_with_loc : bool option; - frontend : frontend option; input_format : input_format option; parse_only : bool option; preludes : (string list) option; diff --git a/src/bin/text/main_text.ml b/src/bin/text/main_text.ml index c00e609d23..45f353b8b9 100644 --- a/src/bin/text/main_text.ml +++ b/src/bin/text/main_text.ml @@ -27,10 +27,6 @@ open Alt_ergo_common -(* Register input method and parsers *) -let register_input () = - Input_frontend.register_legacy () - (* done here to initialize options, before the instantiations of functors *) let parse_cmdline () = @@ -38,7 +34,6 @@ let parse_cmdline () = with Parse_command.Exit_parse_command i -> exit i let () = - register_input (); parse_cmdline (); AltErgoLib.Printer.init_colors (); AltErgoLib.Printer.init_output_format (); diff --git a/src/lib/dune b/src/lib/dune index 2750294698..f91c8ecea5 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -46,8 +46,7 @@ ; modules that make up the lib (modules ; frontend - Cnf D_cnf D_loop D_state_option Input Frontend Parsed_interface Typechecker - Models + Translate D_loop D_state_option Frontend Parsed_interface Models ; reasoners Ac Arith Arrays_rel Bitv Ccx Shostak Relation Fun_sat Fun_sat_frontend Inequalities Bitv_rel Th_util Adt Adt_rel diff --git a/src/lib/frontend/cnf.ml b/src/lib/frontend/cnf.ml deleted file mode 100644 index 687f4f600a..0000000000 --- a/src/lib/frontend/cnf.ml +++ /dev/null @@ -1,426 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -module E = Expr -module Sy = Symbols -module SE = E.Set - -let varset_of_list = - List.fold_left - (fun acc (s,ty) -> - let v = - match s with - | Sy.Var v -> v - | _ -> assert false - in - Var.Map.add v (Ty.shorten ty) acc - ) Var.Map.empty - -module ME = - Map.Make - (struct - type t = E.t - let compare a b = - let c = E.depth a - E.depth b in - if c <> 0 then c - else E.compare a b - end) - -let rec make_term quant_basename t = - let rec mk_term ({ c = { tt_ty = ty; tt_desc = tt; _ }; _ } - : (_ Typed.tterm, _) Typed.annoted) = - let ty = Ty.shorten ty in - match tt with - | TTconst Ttrue -> - E.vrai - | TTconst Tfalse -> - E.faux - | TTconst Tvoid -> - E.void - | TTconst (Tint i) -> - E.int i - | TTconst (Treal n) -> - E.real (Numbers.Q.to_string n) - | TTconst (Tbitv bt) -> - E.bitv bt ty - | TTvar s -> E.mk_term s [] ty - | TTapp (s, l) -> - E.mk_term s (List.map mk_term l) ty - - | TTinInterval (e, lb, ub) -> - assert (ty == Ty.Tbool); - E.mk_term (Sy.mk_in lb ub) [mk_term e] ty - - | TTmapsTo (x, e) -> - assert (ty == Ty.Tbool); - E.mk_term (Sy.mk_maps_to x) [mk_term e] ty - - | TTinfix (t1, s, t2) -> - begin - let t2 = mk_term t2 in (*keep old mk_term order -> avoid regression*) - let t1 = mk_term t1 in - E.mk_term s [t1; t2] ty - end - - | TTprefix ((Sy.Op Sy.Minus) as s, n) -> - let t1 = if ty == Ty.Tint then E.int "0" else E.real "0" in - E.mk_term s [t1; mk_term n] ty - | TTprefix _ -> - assert false - - | TTget (t1, t2) -> - E.mk_term (Sy.Op Sy.Get) - [mk_term t1; mk_term t2] ty - - | TTset (t1, t2, t3) -> - let t1 = mk_term t1 in - let t2 = mk_term t2 in - let t3 = mk_term t3 in - E.mk_term (Sy.Op Sy.Set) [t1; t2; t3] ty - - | TTextract (t1, i, j) -> - let t1 = mk_term t1 in - E.mk_term (Sy.Op (Sy.Extract (i, j))) [t1] ty - - | TTconcat (t1, t2) -> - E.mk_term (Sy.Op Sy.Concat) - [mk_term t1; mk_term t2] ty - - | TTdot (t, s) -> - E.mk_term (Sy.Op (Sy.Access (Uid.of_hstring s))) [mk_term t] ty - - | TTrecord lbs -> - let lbs = List.map (fun (_, t) -> mk_term t) lbs in - E.mk_record lbs ty - - | TTlet (binders, t2) -> - let binders = - List.rev_map (fun (s, t1) -> - (* Remark: the parser ensures that binders' symbol are always - variables. We could modify the typechecker module to - produce the appropriate type for binders, that is `Var.t list`, - but this requires a large amount of modifications in the - typechecker, which is a legacy part of our codebase. - - See PR: https://github.com/OCamlPro/alt-ergo/pull/976. *) - match s with Sy.Var v -> v, mk_term t1 | _ -> assert false) - (List.rev binders) - in - List.fold_left - (fun acc (v, e) -> - E.mk_let v e acc - [@ocaml.ppwarning "TODO: should introduce fresh vars"] - )(mk_term t2) binders - - | TTnamed(lbl, t) -> - let t = mk_term t in - E.add_label lbl t; - t - - | TTite(cond, t1, t2) -> - let cond = - make_form - quant_basename cond Loc.dummy - ~decl_kind:E.Daxiom (* not correct, but not a problem *) - ~toplevel:false - in - let t1 = mk_term t1 in - let t2 = mk_term t2 in - E.mk_ite cond t1 t2 - - | TTproject (t, s) -> - E.mk_term (Sy.destruct (Uid.of_hstring s)) [mk_term t] ty - - | TTmatch (e, pats) -> - let e = make_term quant_basename e in - let pats = - List.rev_map (fun (p, t) -> - p, make_term quant_basename t) (List.rev pats) - in - E.mk_match e pats - - | TTform e -> - make_form - quant_basename e Loc.dummy - ~decl_kind:E.Daxiom (* not correct, but not a problem *) - ~toplevel:false - in - mk_term t - - -and make_trigger ~in_theory name quant_basename hyp (e, from_user) = - let content = List.map (make_term quant_basename) e in - (* clean trigger: - remove useless terms in multi-triggers after inlining of lets*) - let trigger = E.mk_trigger ~user:from_user ~hyp content in - E.clean_trigger ~in_theory name trigger - -and make_form name_base ~toplevel f loc ~decl_kind : E.t = - let name_tag = ref 0 in - let rec mk_form ~toplevel (c : _ Typed.tform) = - match c with - | TFatom a -> - begin match a.c with - | TAtrue -> - E.vrai - | TAfalse -> - E.faux - | TAeq [t1;t2] -> - E.mk_eq ~iff:true - (make_term name_base t1) - (make_term name_base t2) - | TApred (t, negated) -> - let res = make_term name_base t in - if negated then E.neg res else res - - | TAneq lt | TAdistinct lt -> - let lt = List.map (make_term name_base) lt in - E.mk_distinct ~iff:true lt - | TAle [t1;t2] -> - E.mk_builtin ~is_pos:true Sy.LE - [make_term name_base t1; - make_term name_base t2] - | TAlt [t1;t2] -> - begin match t1.c.tt_ty with - | Ty.Tint -> - let one : (_ Typed.tterm, _) Typed.annoted = - {c = {tt_ty = Ty.Tint; - tt_desc = TTconst(Tint "1")}; annot = t1.annot} in - let tt2 = - E.mk_term (Sy.Op Sy.Minus) - [make_term name_base t2; - make_term name_base one] - Ty.Tint - in - E.mk_builtin ~is_pos:true Sy.LE - [make_term name_base t1; tt2] - | _ -> - E.mk_builtin ~is_pos:true Sy.LT - [make_term name_base t1; - make_term name_base t2] - end - | TTisConstr (t, lbl) -> - E.mk_builtin ~is_pos:true (Sy.IsConstr (Uid.of_hstring lbl)) - [make_term name_base t] - - | _ -> assert false - end - - | TFop(((OPand | OPor | OPxor) as op),[f1;f2]) -> - let ff1 = mk_form ~toplevel:false f1.c in - let ff2 = mk_form ~toplevel:false f2.c in - begin match op with - | OPand -> E.mk_and ff1 ff2 false - | OPor -> E.mk_or ff1 ff2 false - | OPxor -> E.mk_xor ff1 ff2 - | _ -> assert false - end - | TFop(OPimp,[f1;f2]) -> - let ff1 = mk_form ~toplevel:false f1.c in - let ff2 = mk_form ~toplevel:false f2.c in - E.mk_imp ff1 ff2 - | TFop(OPnot,[f]) -> - E.neg @@ mk_form ~toplevel:false f.c - | TFop(OPif, [cond; f2;f3]) -> - let cond = mk_form ~toplevel:false cond.c in - let ff2 = mk_form ~toplevel:false f2.c in - let ff3 = mk_form ~toplevel:false f3.c in - E.mk_if cond ff2 ff3 - | TFop(OPiff,[f1;f2]) -> - let ff1 = mk_form ~toplevel:false f1.c in - let ff2 = mk_form ~toplevel:false f2.c in - E.mk_iff ff1 ff2 - | (TFforall qf | TFexists qf) as f -> - let name = - if !name_tag = 0 then name_base - else Format.sprintf "#%s#sub-%d" name_base !name_tag - in - incr name_tag; - let binders = varset_of_list qf.qf_bvars in - let ff = mk_form ~toplevel:false qf.qf_form.c in - - (* S : Formulas are purified afterwards. - Purification binds literals & formulas inside terms by - to fresh variables. - This purification may omit some expressions in quantified - formulas, hence a purification step is made here, just before - creating the said quantification. - - TODO : on-the-fly purification - *) - let ff = E.purify_form ff in - - let hyp = - List.map (fun (f : _ Typed.annoted) -> - mk_form ~toplevel:false f.c) qf.qf_hyp - in - let in_theory = decl_kind == E.Dtheory in - let trs = - List.map - (make_trigger ~in_theory name name_base hyp) qf.qf_triggers in - let func = match f with - | TFforall _ -> E.mk_forall - | TFexists _ -> E.mk_exists - | _ -> assert false - in - func name loc binders trs ff ~toplevel ~decl_kind - - | TFlet(binders,lf) -> - let binders = - List.rev_map - (fun (v, (e : _ Typed.tlet_kind)) -> - v, - match e with - | TletTerm t -> make_term name_base t - | TletForm g -> mk_form ~toplevel:false g.c - )(List.rev binders) - in - let res = mk_form ~toplevel:false lf.c in - List.fold_left - (fun acc (v, e) -> - E.mk_let v e acc - [@ocaml.ppwarning "TODO: should introduce fresh vars"] - )res binders - - | TFnamed(lbl, f) -> - let ff = mk_form ~toplevel:false f.c in - E.add_label lbl ff; - ff - - | TFmatch (e, pats) -> - let e = make_term name_base e in - let pats = - List.rev_map (fun (p, (f : _ Typed.annoted)) -> - p, mk_form ~toplevel:false f.c) - (List.rev pats) - in - E.mk_match e pats - - | _ -> assert false - in - mk_form ~toplevel f.c - -(* wrapper of function make_form *) -let make_form name f loc ~decl_kind = - let ff = - make_form name f loc ~decl_kind ~toplevel:true - in - assert (Var.Map.is_empty (E.free_vars ff Var.Map.empty)); - let ff = E.purify_form ff in - if Ty.Svty.is_empty (E.free_type_vars ff) then ff - else - E.mk_forall name loc Var.Map.empty [] ff ~toplevel:true ~decl_kind - -let mk_assume acc f name loc = - let ff = make_form name f loc ~decl_kind:E.Daxiom in - Commands.{st_decl=Assume(name, ff, true) ; st_loc=loc} :: acc - -let mk_optimize acc obj is_max loc = - let e = make_term "" obj in - let fn = Objective.Function.mk ~is_max e in - Commands.{st_decl=Optimize fn; st_loc=loc } :: acc - -(* extract defining term of the function or predicate. From the - transformation of the parsed AST above, the typed AST is either of the - form: - - "forall x. defn <-> typed_e", if defn is a pred defn or returns a - result of type bool - - "forall x. defn = typed_e", if defn is a function defn whose - return type is not bool - - where forall x. is optional (like in 'predicate p = q or r') -*) -let defining_term f = - if Options.get_verbose () then - Format.eprintf "defining term of %a@." Typed.print_formula f; - match f.c with - | TFforall {qf_form={c=TFop(OPiff,[{c=TFatom {c=TApred(d,_);_};_};_]); _}; _} - | TFforall {qf_form={c=TFatom {c=TAeq[d;_];_}; _}; _} - | TFop(OPiff,[{c=TFatom {c=TApred(d,_);_};_};_]) - | TFatom {c=TAeq[d;_];_} -> - d - | _ -> assert false - -let mk_function acc f name loc = - let defn = defining_term f in - let defn = make_term "" defn in - let ff = make_form name f loc ~decl_kind:(E.Dfunction defn) in - Commands.{st_decl=Assume(name, ff, true) ; st_loc=loc} :: acc - -let mk_preddef acc f name loc = - let defn = defining_term f in - let defn = make_term "" defn in - let ff = make_form name f loc ~decl_kind: (E.Dpredicate defn) in - Commands.{st_decl=PredDef (ff, name) ; st_loc=loc} :: acc - -let mk_query acc n f loc sort = - let ff = make_form "" f loc ~decl_kind:E.Dgoal in - Commands.{st_decl=Query(n, ff, sort) ; st_loc=loc} :: acc - -let make_rule (({rwt_left = t1; rwt_right = t2; rwt_vars = _} as r) - : _ Typed.rwt_rule) = - let s1 = make_term "" t1 in - let s2 = make_term "" t2 in - assert (E.is_pure s1); - assert (E.is_pure s2); - { r with rwt_left = s1; rwt_right = s2 } - -let mk_theory acc l th_name extends _loc = - List.fold_left - (fun acc (e : (_ Typed.tdecl ,_) Typed.annoted) -> - let loc, ax_name, f, axiom_kind = - match e.c with - | TAxiom (loc, name, ax_kd, f) -> loc, name, f, ax_kd - | _ -> assert false - in - let ax_form = make_form ax_name f loc ~decl_kind:E.Dtheory in - let th_elt = {Expr.th_name; axiom_kind; extends; ax_form; ax_name} in - Commands.{st_decl=ThAssume th_elt ; st_loc=loc} :: acc - )acc l - -let make acc (d : (_ Typed.tdecl, _) Typed.annoted) = - match d.c with - | TPush (loc,n) -> Commands.{st_decl=Push n; st_loc=loc} :: acc - | TPop (loc,n) -> Commands.{st_decl=Pop n; st_loc=loc} :: acc - | TTheory(loc, name, ext, l) -> mk_theory acc l name ext loc - | TAxiom(loc, name, Util.Default, f) -> mk_assume acc f name loc - | TAxiom(_, _, Util.Propagator, _) -> assert false - | TRewriting(loc, _, lr) -> - {st_decl=RwtDef(List.map make_rule lr); st_loc=loc} :: acc - | TGoal(loc, sort, n, f) -> mk_query acc n f loc sort - | TPredicate_def(loc, n, _args, f) -> mk_preddef acc f n loc - | TFunction_def(loc, n, _args, _rety, f) -> mk_function acc f n loc - | TTypeDecl _ | TLogic _ -> acc - | TReset _ - | TExit _ -> - (* These cases only appear on smt2 files, which are handled by - Solving_loop. *) - Printer.print_wrn "Ignoring instruction %a" Typed.print_atdecl d; - acc - | TOptimize (loc, obj, is_max) -> mk_optimize acc obj is_max loc - -let make_list l = List.fold_left make [] (List.rev l) diff --git a/src/lib/frontend/cnf.mli b/src/lib/frontend/cnf.mli deleted file mode 100644 index 1ad8054bed..0000000000 --- a/src/lib/frontend/cnf.mli +++ /dev/null @@ -1,37 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -(* used in the typechecker for the text-mode *) -val make : - Commands.sat_tdecl list -> - _ Typed.atdecl -> - Commands.sat_tdecl list - -(* used in the GUI *) -val make_list : - _ Typed.atdecl list -> - Commands.sat_tdecl list diff --git a/src/lib/frontend/input.ml b/src/lib/frontend/input.ml deleted file mode 100644 index 09d0f7c62d..0000000000 --- a/src/lib/frontend/input.ml +++ /dev/null @@ -1,59 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -exception Method_not_registered of string - -module type S = sig - - (* Parsing *) - - type parsed - - val parse_file : content:string -> format:string option -> parsed Seq.t - - val parse_files : - filename:string -> preludes:string list -> parsed Seq.t - - (* Typechecking *) - - type env - - val empty_env : env - - val type_parsed : - env -> env Stack.t -> parsed -> int Typed.atdecl list * env - -end - -let input_methods = ref [] - -let register name ((module M : S) as m) = - input_methods := (name, m) :: !input_methods - -let find name = - try List.assoc name !input_methods - with Not_found -> raise (Method_not_registered name) diff --git a/src/lib/frontend/input.mli b/src/lib/frontend/input.mli deleted file mode 100644 index 28a9355e06..0000000000 --- a/src/lib/frontend/input.mli +++ /dev/null @@ -1,78 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -(** Typed input - - This module defines an abstraction layer over the - parsing and typechecking of input formulas. The goal is to - be able to use different parsing and/or typechecking - engines (e.g. the legacy typechecker, psmt2, or dolmen). - To do so, an input method actually generates the typed - representation of the input. *) - -(** {3 Input method} *) - -exception Method_not_registered of string -(** Exceptions raised when trying to lookup an input method - that has not been registered. *) - -(** This modules defines an input method. Input methods are responsible - for two things: parsing and typechceking either an input file (possibly - with some preludes files), or arbitrary terms. This last functionality - is currently only used in the GUI. *) -module type S = sig - - (** {5 Parsing} *) - - type parsed - (** The type of a parsed statement. *) - - val parse_file : content:string -> format:string option -> parsed Seq.t - (** Parse a file as a string with the given format or the input_format set *) - - val parse_files : filename:string -> preludes:string list -> parsed Seq.t - (** Parse a file (and some preludes). *) - - type env - (** Global typing environment *) - - val empty_env : env - (** The empty/initial environment *) - - val type_parsed : - env -> env Stack.t -> parsed -> int Typed.atdecl list * env - (** Parse and typecheck some input file, - together with some prelude files. *) - -end - -val register : string -> (module S) -> unit -(** Register a new input method. *) - -val find : string -> (module S) -(** Find an input method by name. - @raise Method_not_registered if the name is not registered. *) diff --git a/src/lib/frontend/d_cnf.ml b/src/lib/frontend/translate.ml similarity index 100% rename from src/lib/frontend/d_cnf.ml rename to src/lib/frontend/translate.ml diff --git a/src/lib/frontend/d_cnf.mli b/src/lib/frontend/translate.mli similarity index 100% rename from src/lib/frontend/d_cnf.mli rename to src/lib/frontend/translate.mli diff --git a/src/lib/frontend/typechecker.ml b/src/lib/frontend/typechecker.ml deleted file mode 100644 index 7dfc844a97..0000000000 --- a/src/lib/frontend/typechecker.ml +++ /dev/null @@ -1,2669 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -open Parsed -open Typed - -module S = Set.Make(String) -module HSS = Hstring.Set - -module MString = - Map.Make(struct type t = string let compare = String.compare end) - -module Types = struct - - (* environment for user-defined types *) - type t = { - to_ty : Ty.t MString.t; - builtins : Ty.t MString.t; - from_labels : string MString.t; } - - let to_tyvars = ref MString.empty - - let empty = - { to_ty = MString.empty; - builtins = MString.empty; - from_labels = MString.empty } - - let fresh_vars ~recursive vars loc = - List.map - (fun x -> - if recursive then - try MString.find x !to_tyvars - with Not_found -> assert false - else - begin - if MString.mem x !to_tyvars then - Errors.typing_error (TypeDuplicateVar x) loc; - let nv = Ty.Tvar (Ty.fresh_var ()) in - to_tyvars := MString.add x nv !to_tyvars; - nv - end - ) vars - - let check_number_args loc lty ty = - match ty with - | Ty.Text (lty', s) - | Ty.Trecord { Ty.args = lty'; name = s; _ } - | Ty.Tadt (s,lty') -> - if List.length lty <> List.length lty' then - Errors.typing_error (WrongNumberofArgs (Uid.show s)) loc; - lty' - | _ -> assert false - - let equal_pp_vars lpp lvars = - try - List.for_all2 - (fun pp x -> - match pp with - | PPTvarid (y, _) -> String.equal x y - | _ -> false - ) lpp lvars - with Invalid_argument _ -> false - - let rec ty_of_pp loc env rectype = function - | PPTint -> Ty.Tint - | PPTbool -> Ty.Tbool - | PPTunit -> Ty.tunit - | PPTreal -> Ty.Treal - | PPTbitv n -> - if n <= 0 then Errors.typing_error (NonPositiveBitvType n) loc; - Ty.Tbitv n - | PPTvarid (s, _) -> - begin - try MString.find s !to_tyvars - with Not_found -> - let nty = Ty.Tvar (Ty.fresh_var ()) in - to_tyvars := MString.add s nty !to_tyvars; - nty - end - | PPTexternal (l, s, loc) when String.equal s "farray" -> - let t1,t2 = match l with - | [t2] -> PPTint,t2 - | [t1;t2] -> t1,t2 - | _ -> Errors.typing_error (WrongArity(s,2)) loc in - let ty1 = ty_of_pp loc env rectype t1 in - let ty2 = ty_of_pp loc env rectype t2 in - Ty.Tfarray (ty1, ty2) - | PPTexternal (l, s, loc) -> - begin - match rectype with - | Some (id, vars, ty) when String.equal s id && - equal_pp_vars l vars -> ty - | _ -> - try - let lty = List.map (ty_of_pp loc env rectype) l in - let ty = MString.find s env.to_ty in - let vars = check_number_args loc lty ty in - Ty.instantiate vars lty ty - with Not_found -> - try - let lty = List.map (ty_of_pp loc env rectype) l in - let ty = MString.find s env.builtins in - let vars = check_number_args loc lty ty in - Ty.instantiate vars lty ty - with Not_found -> - Errors.typing_error (UnknownType s) loc - end - - let add_decl ~recursive env vars id body loc = - if MString.mem id env.builtins then - Printer.print_wrn "%a type `%s` shadows a builtin type" - Loc.report loc id; - if MString.mem id env.to_ty && not recursive then - Errors.typing_error (ClashType id) loc; - let ty_vars = fresh_vars ~recursive vars loc in - match body with - | Abstract -> - let ty = Ty.text ty_vars (Uid.of_string id) in - ty, { env with to_ty = MString.add id ty env.to_ty } - | Enum l -> - if not (Compat.List.is_empty ty_vars) then - Errors.typing_error (PolymorphicEnum id) loc; - let body = List.map (fun constr -> Uid.of_string constr, []) l in - let ty = Ty.t_adt ~body:(Some body) (Uid.of_string id) [] in - ty, { env with to_ty = MString.add id ty env.to_ty } - | Record (record_constr, lbs) -> - let lbs = - List.map (fun (x, pp) -> x, ty_of_pp loc env None pp) lbs in - let sort_fields = String.equal record_constr "{" in - let record_constr = - if sort_fields then - Uid.of_string @@ Fmt.str "%s___%s" record_constr id - else - Uid.of_string record_constr - in - let ty = - Ty.trecord ~sort_fields ~record_constr ty_vars - (Uid.of_string id) (List.map (fun (s, ty) -> Uid.of_string s, ty) lbs) - in - ty, { to_ty = MString.add id ty env.to_ty; - builtins = env.builtins; - from_labels = - List.fold_left - (fun fl (l,_) -> MString.add l id fl) env.from_labels lbs } - | Algebraic l -> - let l = (* convert ppure_type to Ty.t in l *) - List.map (fun (constr, l) -> - Uid.of_string constr, - List.map (fun (field, pp) -> - Uid.of_string field, ty_of_pp loc env None pp) l - ) l - in - let body = - if l == [] then None (* in initialization step, no body *) - else Some l - in - let ty = Ty.t_adt ~body (Uid.of_string id) ty_vars in - ty, { env with to_ty = MString.add id ty env.to_ty } - - let add_builtin env id ty = - { env with builtins = MString.add id ty env.builtins } - - module SH = Set.Make(Hstring) - - let check_labels lbs ty loc = - let rec check_duplicates s = function - | [] -> () - | (lb, _) :: l -> - if Uid.Term_set.mem lb s then - Errors.typing_error - (DuplicateLabel (Hstring.make @@ Uid.show lb)) loc; - check_duplicates (Uid.Term_set.add lb s) l - in - check_duplicates Uid.Term_set.empty lbs; - match ty with - | Ty.Trecord { Ty.lbs = l; _ } -> - if List.length lbs <> List.length l then - Errors.typing_error WrongNumberOfLabels loc; - List.iter - (fun (lb, _) -> - try ignore (My_list.assoc Uid.equal lb l) - with Not_found -> - Errors.typing_error - (WrongLabel((Hstring.make @@ Uid.show lb), ty)) loc) lbs; - ty - | _ -> assert false - - - let from_labels env lbs loc = - match lbs with - | [] -> assert false - | (l, _) :: _ -> - try - let ty = - MString.find (MString.find (Uid.show l) env.from_labels) env.to_ty - in - check_labels lbs ty loc - with Not_found -> - Errors.typing_error (NoRecordType (Hstring.make @@ Uid.show l)) loc - - let rec monomorphized = function - | PPTvarid (x, _) when not (MString.mem x !to_tyvars) -> - to_tyvars := MString.add x (Ty.fresh_empty_text ()) !to_tyvars; - - | PPTexternal (args, _, _) -> - List.iter monomorphized args - - | _ -> () - -end - -module Env = struct - - type profile = { args : Ty.t list; result : Ty.t } - - type logic_kind = - | RecordConstr - | RecordDestr - | AdtConstr - | EnumConstr - | AdtDestr - | Other - - type builtin = - [ `Term of (Symbols.t * profile * logic_kind) - | `Builtin of (profile * (int atterm list -> int tt_desc)) - ] - - type t = { - var_map : (Symbols.t * Ty.t) MString.t ; (* variables' map*) - types : Types.t ; - logics : (Symbols.t * profile * logic_kind) MString.t; - (* logic symbols' map *) - builtins : builtin MString.t ; - } - - let builtin1 f = - function - | [ e ] -> f e - | _ -> assert false - - let builtin2 f = - function - | [ x; y ] -> f x y - | _ -> assert false - - let add_fpa_enum map = - let ty = Fpa_rounding.fpa_rounding_mode in - match ty with - | Ty.Tadt (name, []) -> - let cases = Ty.type_body name [] in - let constrs = List.map (fun Ty.{ constr; _ } -> constr) cases in - List.fold_left - (fun m c -> - match Fpa_rounding.translate_smt_rounding_mode - (Hstring.make @@ Uid.show c) with - | None -> - (* The constructors of the type are expected to be AE rounding - modes. *) - assert false - | Some hs -> - MString.add (Hstring.view hs) (`Term ( - Symbols.Op (Constr c), - { args = []; result = ty }, - Other - )) - m - ) - map - constrs - | _ -> (* Fpa_rounding.fpa_rounding_mode is a sum type. *) - assert false - - let find_builtin_constr ty n = - match ty with - | Ty.Tadt (name, []) -> - let cases = Ty.type_body name [] in - let constrs = List.map (fun Ty.{ constr; _ } -> constr) cases in - List.find (Uid.equal n) constrs - | _ -> - assert false - - let add_fpa_builtins env = - let (->.) args result = { args; result } in - let int n = { - c = { tt_desc = TTconst (Tint n); tt_ty = Ty.Tint} ; - annot = new_id () ; - } in - let rm = Fpa_rounding.fpa_rounding_mode in - let mode m = - let h = find_builtin_constr rm m in - { - c = { - tt_desc = TTapp (Symbols.(Op (Constr h)), []); - tt_ty = rm - }; - annot = new_id () - } - in - let float prec exp mode x = - TTapp (Symbols.Op Float, [prec; exp; mode; x]) - in - let nte = Fpa_rounding.string_of_rounding_mode NearestTiesToEven in - let tname = Fpa_rounding.fpa_rounding_mode_ae_type_name in - let float32 = float (int "24") (int "149") in - let float32d = float32 (mode (Uid.of_string nte)) in - let float64 = float (int "53") (int "1074") in - let float64d = float64 (mode (Uid.of_string nte)) in - let op n op profile = - MString.add n @@ `Term (Symbols.Op op, profile, Other) - in - let partial n f profile = - MString.add n (`Builtin (profile, f)) - in - let bool = Ty.Tbool and int = Ty.Tint and real = Ty.Treal in - let any = Ty.fresh_tvar in - let env = { - env with - types = Types.add_builtin env.types tname rm ; - builtins = add_fpa_enum env.builtins; - } in - let builtins = - env.builtins - - (* the first argument is mantissas' size (including the implicit bit), - the second one is the exp of the min representable normalized number, - the third one is the rounding mode, and the last one is the real to - be rounded *) - |> op "float" Float ([int; int; rm; real] ->. real) - - (* syntactic sugar for simple precision floats: - mantissas size = 24, min exp = 149 *) - |> partial "float32" (builtin2 float32) ([rm; real] ->. real) - - (* syntactic sugar for simple precision floats with default rounding mode - (i.e. NearestTiesToEven)*) - |> partial "float32d" (builtin1 float32d) ([real] ->. real) - - (* syntactic sugar for double precision floats: - mantissas size = 53, min exp = 1074 *) - |> partial "float64" (builtin2 float64) ([rm; real] ->. real) - - (* syntactic sugar for double precision floats with default rounding mode - (i.e. NearestTiesToEven) *) - |> partial "float64d" (builtin1 float64d) ([real] ->. real) - - (* rounds to nearest integer *) - |> op "integer_round" Integer_round ([rm; real] ->. int) - - (* type cast: from int to real *) - |> op "real_of_int" Real_of_int ([int] ->. real) - - (* type check: integers *) - |> op "real_is_int" Real_is_int ([real] ->. bool) - - (* abs value of a real *) - |> op "abs_real" Abs_real ([real] ->. real) - - (* sqrt value of a real *) - |> op "sqrt_real" Sqrt_real ([real] ->. real) - - (* sqrt value of a real by default *) - |> op "sqrt_real_default" Sqrt_real_default ([real] ->. real) - - (* sqrt value of a real by excess *) - |> op "sqrt_real_excess" Sqrt_real_excess ([real] ->. real) - - (* abs value of an int *) - |> op "abs_int" Abs_int ([int] ->. int) - - (* (integer) floor of a rational *) - |> op "int_floor" Int_floor ([real] ->. int) - - (* (integer) ceiling of a ratoinal *) - |> op "int_ceil" Int_ceil ([real] ->. int) - - (* The functions below are only interpreted when applied on constants. - Aximatization for the general case are not currently imlemented *) - - (* maximum of two reals *) - |> op "max_real" Max_real ([real; real] ->. real) - - (* minimum of two reals *) - |> op "min_real" Min_real ([real; real] ->. real) - - (* maximum of two ints *) - |> op "max_int" Max_int ([int; int] ->. int) - - (* minimum of two ints *) - |> op "min_int" Min_int ([int; int] ->. int) - - (* computes an integer log2 of a real. The function is only - interpreted on (non-zero) positive real constants. When applied on a - real 'm', the result 'res' of the function is such that: 2^res <= m < - 2^(res+1) *) - |> op "integer_log2" Integer_log2 ([real] ->. int) - - (* only used for arithmetic. It should not be used for x in float(x) - to enable computations modulo equality *) - - |> op "not_theory_constant" Not_theory_constant ([real] ->. bool) - |> op "is_theory_constant" Is_theory_constant ([any ()] ->. bool) - |> op "linear_dependency" Linear_dependency ([real; real] ->. bool) - - in - { env with builtins } - - let empty = add_fpa_builtins { - var_map = MString.empty; - types = Types.empty; - logics = MString.empty; - builtins = MString.empty - } - - let add env lv fvar ty = - let vmap = - List.fold_left - (fun vmap x -> MString.add x (fvar x, ty) vmap) env.var_map lv in - { env with var_map = vmap } - - let add_var env lv pp_ty loc = - let ty = Types.ty_of_pp loc env.types None pp_ty in - let fvar s = Symbols.var @@ Var.of_string s in - add env lv fvar ty - - let add_ty_var env lv ty = - let fvar s = Symbols.var @@ Var.of_string s in - add env lv fvar ty - - let add_names env lv pp_ty loc = - Types.monomorphized pp_ty; - let ty = Types.ty_of_pp loc env.types None pp_ty in - add env lv Symbols.name ty - - let add_names_lbl env lv pp_ty loc = - Types.monomorphized pp_ty; - let ty = Types.ty_of_pp loc env.types None pp_ty in - let rlv = - List.fold_left (fun acc (x, lbl) -> - let lbl = Hstring.make lbl in - if not (Hstring.equal lbl Hstring.empty) then - Symbols.add_label lbl (Symbols.name x); - x::acc - ) [] lv in - let lv = List.rev rlv in - add env lv Symbols.name ty - - let add_logics ?(kind=Other) env mk_symb names pp_profile loc = - let decl, profile = - match pp_profile with - | PPredicate args -> - let args = List.map (Types.ty_of_pp loc env.types None) args in - TPredicate args, - { args = args; result = Ty.Tbool } - (*| PFunction ([], PPTvarid (_, loc)) -> - typing_error CannotGeneralize loc*) - | PFunction(args, res) -> - let args = List.map (Types.ty_of_pp loc env.types None) args in - let res = Types.ty_of_pp loc env.types None res in - TFunction (args, res), - { args = args; result = res } - in - let logics = - List.fold_left - (fun logics (n, lbl) -> - if MString.mem n env.builtins then - Printer.print_wrn "%a symbol `%s` shadows a builtin symbol" - Loc.report loc n; - - let sy = mk_symb n in - if MString.mem n logics then - Errors.typing_error (SymbAlreadyDefined n) loc; - let lbl = Hstring.make lbl in - if not (Hstring.equal lbl Hstring.empty) then - Symbols.add_label lbl sy; - - MString.add n (sy, profile, kind) logics) - env.logics names - in - decl, { env with logics } - - let add_constr ~record env constr args_ty ty loc = - let pp_profile = PFunction (args_ty, ty) in - let kind = if record then RecordConstr else AdtConstr in - let mk_constr = fun s -> Symbols.constr @@ Uid.of_string s in - add_logics ~kind env mk_constr [constr, ""] pp_profile loc - - let add_destr ~record env destr pur_ty lbl_ty loc = - let pp_profile = PFunction ([pur_ty], lbl_ty) in - let mk_sy s = - if record then (Symbols.Op (Access (Uid.of_string s))) - else Symbols.destruct (Uid.of_string s) - in - let kind = if record then RecordDestr else AdtDestr in - add_logics ~kind env mk_sy [destr, ""] pp_profile loc - - let find { var_map = m; _ } n = MString.find n m - - let add_type_decl ?(recursive=false) env vars id body loc = - let ty, types = Types.add_decl ~recursive env.types vars id body loc in - ty, { env with types = types; } - - (* returns a type with fresh variables *) - let fresh_type_or_builtin env n = - try - let s, { args = args; result = r}, kind = MString.find n env.logics in - let args, subst = Ty.fresh_list args Ty.esubst in - let res, _ = Ty.fresh r subst in - `Term (s, { args = args; result = res }, kind) - with Not_found -> - match MString.find n env.builtins with - | `Term (s, { args; result }, kind) -> - let args, subst = Ty.fresh_list args Ty.esubst in - let result, _ = Ty.fresh result subst in - `Term (s, { args ; result }, kind) - | `Builtin ({ args; result }, f) -> - let args, subst = Ty.fresh_list args Ty.esubst in - let result, _ = Ty.fresh result subst in - `Builtin ({ args; result }, f) - | exception Not_found -> `Undefined - - let fresh_type env n loc = - match fresh_type_or_builtin env n with - | `Term t -> t - | `Builtin _ | `Undefined -> Errors.typing_error (SymbUndefined n) loc - -end - -let symbol_of = function - PPadd -> Symbols.Op Symbols.Plus - | PPsub -> Symbols.Op Symbols.Minus - | PPmul -> Symbols.Op Symbols.Mult - | PPdiv -> Symbols.Op Symbols.Div - | PPmod -> Symbols.Op Symbols.Modulo - | PPpow_int -> Symbols.Op Symbols.Pow - | PPpow_real -> Symbols.Op Symbols.Pow - | _ -> assert false - -let append_type msg ty = - Format.asprintf "%s %a" msg Ty.print ty - -let type_var_desc env p loc = - try - let s,t = Env.find env p in - Options.tool_req 1 (append_type "TR-Typing-Var$_\\Gamma$ type" t); - TTvar s , t - with Not_found -> - match Env.fresh_type env p loc with - | s, - { Env.args = []; result = ty}, - (Env.Other | Env.AdtConstr | Env.EnumConstr) -> - TTapp (s, []) , ty - | _ -> Errors.typing_error (ShouldBeApply p) loc - -let check_no_duplicates = - let rec aux loc l ss = - match l with - | [] -> () - | e :: l -> - if S.mem e ss then Errors.typing_error (ClashParam e) loc; - aux loc l (S.add e ss) - in - fun loc args -> aux loc args S.empty - -let filter_patterns pats ty_body _loc = - let cases = - List.fold_left - (fun s {Ty.constr=c; _} -> Uid.Term_set.add c s) - Uid.Term_set.empty ty_body - in - let missing, filtered_pats, dead = - List.fold_left - (fun (miss, filtered_pats, dead) ((p, _) as u) -> - match p with - | Constr { name; _ } -> - assert (Uid.Term_set.mem name cases); (* pattern is well typed *) - if Uid.Term_set.mem name miss then (* not encountered yet *) - Uid.Term_set.remove name miss, u :: filtered_pats, dead - else (* case already seen --> dead pattern *) - miss, pats, p :: dead - | Var _ -> - if Uid.Term_set.is_empty miss then - (* match already exhaussive -> dead case *) - miss, filtered_pats, p :: dead - else (* covers all remaining cases, miss becomes empty *) - Uid.Term_set.empty, u :: filtered_pats, dead - )(cases, [], []) pats - in - missing, List.rev filtered_pats, dead - -let check_pattern_matching missing dead loc = - if not (Uid.Term_set.is_empty missing) then begin - let missing = - List.map (fun m -> Hstring.make @@ Uid.show m) - (Uid.Term_set.elements missing) - in - Errors.typing_error (MatchNotExhaustive missing) loc end; - if dead != [] then - let dead = - List.rev_map - (function - | Constr { name; _ } -> Uid.show name |> Hstring.make - | Var v -> Var.to_string v |> Hstring.make - ) dead - in - Printer.print_wrn "%a" - Errors.report (Typing_error(loc,MatchUnusedCases dead)); - Errors.warning_as_error () - -let mk_adequate_app p s te_args ty logic_kind = - let hp = Hstring.make p in - match logic_kind, te_args, ty with - | (Env.AdtConstr | Env.EnumConstr | Env.Other), _, _ -> - (* symbol 's' alreadt contains the information *) - TTapp(s, te_args) - - | Env.RecordConstr, _, Ty.Trecord { Ty.lbs; _ } -> - let lbs = - try - List.map2 (fun (hs, _) e -> Hstring.make @@ Uid.show hs, e) lbs te_args - with Invalid_argument _ -> assert false - in - TTrecord lbs - - | Env.RecordDestr, [te], _ -> TTdot(te, hp) - - | Env.AdtDestr, [te], _ -> TTproject (te, hp) - - | Env.RecordDestr, _, _ -> assert false - | Env.RecordConstr, _, _ -> assert false - | Env.AdtDestr, _, _ -> assert false - -let fresh_type_app env p loc = - match Env.fresh_type_or_builtin env p with - | `Term (s, profile, kind) -> - profile, fun te_args -> mk_adequate_app p s te_args profile.result kind - | `Builtin (profile, f) -> - profile, f - | `Undefined -> Errors.typing_error (SymbUndefined p) loc - -let rec type_term ?(call_from_type_form=false) env f = - let {pp_loc = loc; pp_desc} = f in - let e, ty = match pp_desc with - | PPconst ConstTrue -> - Options.tool_req 1 (append_type "TR-Typing-Const type" Ty.Tbool); - TTconst Ttrue, Ty.Tbool - | PPconst ConstFalse -> - Options.tool_req 1 (append_type "TR-Typing-Const type" Ty.Tbool); - TTconst Tfalse, Ty.Tbool - | PPconst ConstVoid -> - Options.tool_req 1 (append_type "TR-Typing-Const type" Ty.tunit); - TTconst Tvoid, Ty.tunit - | PPconst (ConstInt n) -> - Options.tool_req 1 (append_type "TR-Typing-Const type" Ty.Tint); - TTconst(Tint n), Ty.Tint - | PPconst (ConstReal n) -> - Options.tool_req 1 (append_type "TR-Typing-Const type" Ty.Treal); - TTconst(Treal n), Ty.Treal - | PPconst (ConstBitv n) -> - Options.tool_req 1 - (append_type "TR-Typing-Const type" (Ty.Tbitv (String.length n))); - TTconst(Tbitv n), Ty.Tbitv (String.length n) - | PPvar p -> - type_var_desc env p loc - - | PPapp(p,args) -> - begin - let te_args = List.map (type_term env) args in - let lt_args = List.map ( - fun { c = { tt_ty = t; _ }; _ } -> t - ) te_args in - let Env.{args = lt; result = t}, mk_app = fresh_type_app env p loc in - try - List.iter2 Ty.unify lt lt_args; - Options.tool_req 1 (append_type "TR-Typing-App type" t); - mk_app te_args, t - with - | Ty.TypeClash(t1,t2) -> Errors.typing_error (Unification(t1,t2)) loc - | Invalid_argument _ -> Errors.typing_error (WrongNumberofArgs p) loc - end - - | PPinfix(t1,(PPadd | PPsub | PPmul | PPdiv as op),t2) -> - begin - let s = symbol_of op in - let te1 = type_term env t1 in - let te2 = type_term env t2 in - let ty1 = Ty.shorten te1.c.tt_ty in - let ty2 = Ty.shorten te2.c.tt_ty in - match ty1, ty2 with - | Ty.Tint, Ty.Tint -> - Options.tool_req 1 (append_type "TR-Typing-OpBin type" ty1); - TTinfix(te1,s,te2) , ty1 - | Ty.Treal, Ty.Treal -> - Options.tool_req 1 (append_type "TR-Typing-OpBin type" ty2); - TTinfix(te1,s,te2), ty2 - | Ty.Tint, _ -> - Errors.typing_error (ShouldHaveType(ty2,Ty.Tint)) t2.pp_loc - | Ty.Treal, _ -> - Errors.typing_error (ShouldHaveType(ty2,Ty.Treal)) t2.pp_loc - | _ -> - Errors.typing_error (ShouldHaveTypeIntorReal ty1) t1.pp_loc - end - | PPinfix(t1, PPmod, t2) -> - begin - let s = symbol_of PPmod in - let te1 = type_term env t1 in - let te2 = type_term env t2 in - let ty1 = Ty.shorten te1.c.tt_ty in - let ty2 = Ty.shorten te2.c.tt_ty in - match ty1, ty2 with - | Ty.Tint, Ty.Tint -> - Options.tool_req 1 (append_type "TR-Typing-OpMod type" ty1); - TTinfix(te1,s,te2) , ty1 - | _ -> Errors.typing_error (ShouldHaveTypeInt ty1) t1.pp_loc - end - | PPinfix(t1, (PPpow_int | PPpow_real as op), t2) -> - begin - let s = symbol_of op in - let te1 = type_term env t1 in - let te2 = type_term env t2 in - let ty1 = Ty.shorten te1.c.tt_ty in - let ty2 = Ty.shorten te2.c.tt_ty in - match ty1, ty2, op with - | Ty.Tint, Ty.Tint, PPpow_int -> - Options.tool_req 1 (append_type "TR-Typing-Oppow_int type" ty1); - TTinfix(te1,s,te2) , Ty.Tint - - | (Ty.Tint | Ty.Treal), (Ty.Tint | Ty.Treal), PPpow_real -> - Options.tool_req 1 (append_type "TR-Typing-Oppow_real type" ty1); - TTinfix(te1,s,te2) , Ty.Treal - - | Ty.Treal , _, PPpow_int -> - Errors.typing_error (ShouldHaveTypeInt Ty.Tint) t1.pp_loc - | _, Ty.Treal, PPpow_int -> - Errors.typing_error (ShouldHaveTypeInt Ty.Tint) t2.pp_loc - - | _, _, PPpow_real -> - Errors.typing_error (ShouldHaveTypeInt Ty.Treal) t1.pp_loc - | _, _, PPpow_int -> - Errors.typing_error (ShouldHaveTypeInt Ty.Tint) t1.pp_loc - - | _ -> assert false (* can't happen *) - end - | PPprefix(PPneg, { pp_desc=PPconst (ConstInt n); _ }) -> - Options.tool_req 1 (append_type "TR-Typing-OpUnarith type" Ty.Tint); - TTconst(Tint ("-"^n)), Ty.Tint - | PPprefix(PPneg, { pp_desc=PPconst (ConstReal n); _ }) -> - Options.tool_req 1 (append_type "TR-Typing-OpUnarith type" Ty.Treal); - TTconst(Treal (Numbers.Q.minus n)), Ty.Treal - | PPprefix(PPneg, e) -> - let te = type_term env e in - let ty = Ty.shorten te.c.tt_ty in - if ty!=Ty.Tint && ty!=Ty.Treal then - Errors.typing_error (ShouldHaveTypeIntorReal ty) e.pp_loc; - Options.tool_req 1 (append_type "TR-Typing-OpUnarith type" ty); - TTprefix(Symbols.Op Symbols.Minus, te), ty - | PPconcat(t1, t2) -> - begin - let te1 = type_term env t1 in - let te2 = type_term env t2 in - let ty1 = Ty.shorten te1.c.tt_ty in - let ty2 = Ty.shorten te2.c.tt_ty in - match ty1, ty2 with - | Ty.Tbitv n , Ty.Tbitv m -> - Options.tool_req 1 - (append_type "TR-Typing-OpConcat type" (Ty.Tbitv (n+m))); - TTconcat(te1, te2), Ty.Tbitv (n+m) - | Ty.Tbitv _ , _ -> - Errors.typing_error (ShouldHaveTypeBitv ty2) t2.pp_loc - | _ , Ty.Tbitv _ -> - Errors.typing_error (ShouldHaveTypeBitv ty1) t1.pp_loc - | _ -> - Errors.typing_error (ShouldHaveTypeBitv ty1) t1.pp_loc - end - | PPextract(e, i, j) -> - begin - let te = type_term env e in - let tye = Ty.shorten te.c.tt_ty in - match tye with - | Ty.Tbitv n -> - if i>j then Errors.typing_error (BitvExtract(i,j)) loc; - if j>=n then Errors.typing_error (BitvExtractRange(n,j) ) loc; - Options.tool_req 1 - (append_type "TR-Typing-OpExtract type" (Ty.Tbitv (j-i+1))); - TTextract(te, i, j), Ty.Tbitv (j-i+1) - | _ -> - Errors.typing_error (ShouldHaveType(tye,Ty.Tbitv (j+1))) loc - end - | PPget (t1, t2) -> - begin - let te1 = type_term env t1 in - let te2 = type_term env t2 in - let tyarray = Ty.shorten te1.c.tt_ty in - let tykey2 = Ty.shorten te2.c.tt_ty in - match tyarray with - | Ty.Tfarray (tykey,tyval) -> - begin - try - Ty.unify tykey tykey2; - Options.tool_req 1 (append_type "TR-Typing-OpGet type" tyval); - TTget(te1, te2), tyval - with - | Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) loc - end - | _ -> Errors.typing_error ShouldHaveTypeArray t1.pp_loc - end - | PPset (t1, t2, t3) -> - begin - let te1 = type_term env t1 in - let te2 = type_term env t2 in - let te3 = type_term env t3 in - let ty1 = Ty.shorten te1.c.tt_ty in - let tykey2 = Ty.shorten te2.c.tt_ty in - let tyval2 = Ty.shorten te3.c.tt_ty in - try - match ty1 with - | Ty.Tfarray (tykey,tyval) -> - Ty.unify tykey tykey2;Ty.unify tyval tyval2; - Options.tool_req 1 (append_type "TR-Typing-OpSet type" ty1); - TTset(te1, te2, te3), ty1 - | _ -> Errors.typing_error ShouldHaveTypeArray t1.pp_loc - with - | Ty.TypeClash(t, t') -> Errors.typing_error (Unification(t, t')) loc - end - | PPif(cond,t2,t3) -> - begin - let cond = type_form env cond in - (* TODO : should use _fv somewhere ? *) - let te2 = type_term env t2 in - let te3 = type_term env t3 in - let ty2 = Ty.shorten te2.c.tt_ty in - let ty3 = Ty.shorten te3.c.tt_ty in - begin - try Ty.unify ty2 ty3 - with Ty.TypeClash _ -> - Errors.typing_error (ShouldHaveType(ty3,ty2)) t3.pp_loc; - end; - Options.tool_req 1 (append_type "TR-Typing-Ite type" ty2); - TTite (cond, te2, te3) , ty2 - end - | PPdot(t, a) -> - begin - let te = type_term env t in - let ty = Ty.shorten te.c.tt_ty in - match ty with - | Ty.Trecord { Ty.name = g; lbs; _ } -> - begin - try - TTdot(te, Hstring.make a), - My_list.assoc Uid.equal (Uid.of_string a) lbs - with Not_found -> - let g = Uid.show g in - Errors.typing_error (ShouldHaveLabel(g,a)) t.pp_loc - end - | _ -> Errors.typing_error (ShouldHaveTypeRecord ty) t.pp_loc - end - | PPrecord lbs -> - begin - let lbs = - List.map (fun (lb, t) -> Hstring.make lb, type_term env t) lbs in - let lbs = List.sort - (fun (l1, _) (l2, _) -> Hstring.compare l1 l2) lbs in - let fake_lbs = - List.map (fun (lb, ty) -> Uid.of_hstring lb, ty) lbs - in - let ty = Types.from_labels env.Env.types fake_lbs loc in - let ty, _ = Ty.fresh (Ty.shorten ty) Ty.esubst in - match ty with - | Ty.Trecord { Ty.lbs=ty_lbs; _ } -> - begin - try - let lbs = - List.map2 - (fun (_, te) (lb,ty_lb)-> - Ty.unify te.c.tt_ty ty_lb; - Hstring.make @@ Uid.show lb, te) lbs ty_lbs - in - TTrecord(lbs), ty - with Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) loc - end - | _ -> Errors.typing_error ShouldBeARecord loc - end - | PPwith(e, lbs) -> - begin - let te = type_term env e in - let lbs = - List.map - (fun (lb, t) -> Hstring.make lb, (type_term env t, t.pp_loc)) lbs in - let ty = Ty.shorten te.c.tt_ty in - match ty with - | Ty.Trecord { Ty.lbs = ty_lbs; _ } -> - let ty_lbs = - List.map (fun (uid, ty) -> Hstring.make @@ Uid.show uid, ty) ty_lbs - in - let nlbs = - List.map - (fun (lb, ty_lb) -> - try - let v, _ = Hstring.list_assoc lb lbs in - Ty.unify ty_lb v.c.tt_ty; - lb, v - with - | Not_found -> - lb, {c = { tt_desc = TTdot(te, lb); tt_ty = ty_lb}; - annot = te.annot } - | Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) loc - ) ty_lbs - in - List.iter - (fun (lb, _) -> - try ignore (Hstring.list_assoc lb ty_lbs) - with Not_found -> - Errors.typing_error (NoLabelInType(lb, ty)) loc) lbs; - TTrecord(nlbs), ty - | _ -> Errors.typing_error ShouldBeARecord loc - end - | PPlet(l, t2) -> - let _ = - List.fold_left (fun z (sy,_) -> - if Util.SS.mem sy z then - Errors.typing_error (DuplicatePattern sy) loc; - Util.SS.add sy z - )Util.SS.empty l - in - let rev_l = List.rev_map (fun (sy, t) -> sy, type_term env t) l in - let env = - List.fold_left - (fun env (sy, te1) -> - let ty1 = Ty.shorten te1.c.tt_ty in - let fvar s = Symbols.var @@ Var.of_string s in - Env.add env [sy] fvar ty1 - )env rev_l - in - let te2 = type_term env t2 in - let ty2 = Ty.shorten te2.c.tt_ty in - let l = List.rev_map (fun (sy, t) -> fst (Env.find env sy), t) rev_l in - Options.tool_req 1 (append_type "TR-Typing-Let type" ty2); - TTlet(l, te2), ty2 - - (* | PPnamed(lbl, t) -> *) - (* let te = type_term env t in *) - (* te.c.tt_desc, te.c.tt_ty *) - - | PPnamed (lbl, t) -> - let te = type_term env t in - let ty = Ty.shorten te.c.tt_ty in - let lbl = Hstring.make lbl in - TTnamed (lbl, te), ty - - | PPcast (t,ty) -> - let ty = Types.ty_of_pp loc env.Env.types None ty in - let te = type_term env t in - begin try - Ty.unify te.c.tt_ty ty; - te.c.tt_desc, Ty.shorten te.c.tt_ty - with - | Ty.TypeClash(t1,t2) -> Errors.typing_error (Unification(t1,t2)) loc - end - - | PPproject (t, lbl) -> - let te = type_term env t in - begin - try - match Env.fresh_type env lbl loc with - | _, {Env.args = [arg] ; result}, Env.AdtDestr -> - Ty.unify te.c.tt_ty arg; - TTproject (te, Hstring.make lbl), Ty.shorten result - - | _, {Env.args = [arg] ; result}, Env.RecordDestr -> - Ty.unify te.c.tt_ty arg; - TTdot (te, Hstring.make lbl), Ty.shorten result - | _ -> assert false - with Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) loc - end - - | PPmatch (e, pats) -> - (* we can match on ADTs including records and enumerations *) - let e = type_term env e in - let ty = Ty.shorten e.c.tt_ty in - let ty_body = match ty with - | Ty.Tadt (name, params) -> Ty.type_body name params - | Ty.Trecord { Ty.record_constr; lbs; _ } -> - [{Ty.constr = record_constr; destrs = lbs}] - | _ -> Errors.typing_error (ShouldBeADT ty) loc - in - let pats = - List.rev @@ - List.rev_map - (fun (p, v) -> - let p, env = type_pattern p env ty ty_body in - p, type_term env v - ) pats - in - let missing, filtered_pats, dead = filter_patterns pats ty_body loc in - check_pattern_matching missing dead loc; - let ty = - match filtered_pats with - | [] -> assert false - | (_, e) :: l -> - let ty = e.c.tt_ty in - List.iter - (fun (_, e) -> - Ty.unify ty e.c.tt_ty; - if not (Ty.equal ty e.c.tt_ty) then - Errors.typing_error (ShouldHaveType(e.c.tt_ty, ty)) loc - )l; - ty - in - TTmatch (e, filtered_pats), ty - | _ -> - if call_from_type_form then Errors.typing_error SyntaxError loc; - TTform (type_form env f), Ty.Tbool - in - {c = { tt_desc = e ; tt_ty = Ty.shorten ty }; annot = new_id ()} - - -and join_forall f = match f.pp_desc with - | PPforall(vs_ty, trs1, hyp1, f) -> - let tyvars,trs2,hyp2, f = join_forall f in - vs_ty @ tyvars , trs1@trs2 , hyp1@hyp2, f - | PPforall_named (named_vs_ty, trs1, hyp1, f) -> - let vs_ty = List.map (fun (v, _, ty) -> v, ty) named_vs_ty in - join_forall {f with pp_desc = PPforall (vs_ty, trs1, hyp1, f)} - | PPnamed(_, f) -> - join_forall f - | _ -> [] , [] , [], f - -and join_exists f = match f.pp_desc with - | PPexists (vs_ty, trs1, hyp1, f) -> - let tyvars,trs2, hyp2,f = join_exists f in - vs_ty @ tyvars , trs1@trs2, hyp1@hyp2, f - | PPexists_named (named_vs_ty, trs1, hyp1, f) -> - let vs_ty = List.map (fun (v, _, ty) -> v, ty) named_vs_ty in - join_exists {f with pp_desc = PPexists (vs_ty, trs1, hyp1, f)} - | PPnamed (_, f) -> join_exists f - | _ -> [] , [] , [], f - - -and type_bound env bnd ty ~is_open ~is_lower = - let bk, ty_x = match bnd.pp_desc with - | PPvar s -> - assert (String.length s > 0); - begin match s.[0] with - | '?' -> - let sy = - if String.length s = 1 then - Symbols.Unbounded - else - Symbols.VarBnd (Var.local s) - in - sy, ty - | _ -> - let vx, ty_x = type_var_desc env s bnd.pp_loc in - let var_x = - match vx with TTvar Symbols.Var vx -> vx | _ -> assert false - in - Symbols.VarBnd var_x, ty_x - end - | PPconst num -> - let ty_x, q = - try match num with - | ConstInt s -> - Ty.Tint, Numbers.Q.from_string s - | ConstReal s -> - Ty.Treal, s - | _ -> assert false - with _ -> assert false (*numbers well constructed with regular exprs*) - in - Symbols.ValBnd q, ty_x - | _ -> assert false - in - if not (Ty.equal ty ty_x) then - Errors.typing_error (ShouldHaveType(ty, ty_x)) bnd.pp_loc; - Symbols.mk_bound bk ty ~is_open ~is_lower - -and mk_ta_eq t1 t2 = - let c = - if t1.c.tt_ty != Ty.Tbool then TAeq [t1; t2] - else - match t1.c.tt_desc, t2.c.tt_desc with - | TTconst Ttrue, _ -> TApred (t2, false) - | _, TTconst Ttrue -> TApred (t1, false) - | TTconst Tfalse, _ -> TApred (t2, true) - | _, TTconst Tfalse -> TApred (t1, true) - | _ -> TAeq [t1; t2] - in - {c ; annot=new_id ()} - -and mk_ta_neq t1 t2 = - let c = - if t1.c.tt_ty != Ty.Tbool then TAneq [t1; t2] - else - match t1.c.tt_desc, t2.c.tt_desc with - | TTconst Ttrue, _ -> TApred (t2, true) - | _, TTconst Ttrue -> TApred (t1, true) - | TTconst Tfalse, _ -> TApred (t2, false) - | _, TTconst Tfalse -> TApred (t1, false) - | _ -> TAneq [t1; t2] - in - {c ; annot=new_id ()} - -and type_form ?(in_theory=false) env f = - let rec type_pp_desc pp_desc = match pp_desc with - | PPconst ConstTrue -> - Options.tool_req 1 "TR-Typing-True$_F$"; - TFatom {c=TAtrue; annot=new_id ()} - | PPconst ConstFalse -> - Options.tool_req 1 "TR-Typing-False$_F$"; - TFatom {c=TAfalse; annot=new_id ()} - | PPvar p -> - Options.tool_req 1 "TR-Typing-Var$_F$"; - let res = - try - (* allow type cast bool to predicate in some simple situations *) - let s, ty = Env.find env p in - Options.tool_req 1 (append_type "TR-Typing-Var$_\\Gamma$ type" ty); - s, { Env.args = []; result = ty} - with Not_found -> - let s, p, kd = Env.fresh_type env p f.pp_loc in - assert (kd == Env.Other); - s, p - in - let r = - match res with - | s, { Env.args = []; result = Ty.Tbool} -> - let t2 = {c = {tt_desc=TTconst Ttrue;tt_ty=Ty.Tbool}; - annot = new_id ()} in - let t1 = {c = {tt_desc=TTvar s; tt_ty=Ty.Tbool}; - annot = new_id ()} in - TFatom (mk_ta_eq t1 t2) - | _ -> Errors.typing_error (NotAPropVar p) f.pp_loc - in - r - - | PPapp(p,args ) -> - Options.tool_req 1 "TR-Typing-App$_F$"; - let te_args = List.map (type_term env) args in - let lt_args = List.map (fun { c = { tt_ty = t; _}; _ } -> t) te_args in - let { Env.args = lt; result }, mk_app = fresh_type_app env p f.pp_loc in - begin - try - if result != Ty.Tbool then (* consider polymorphic functions *) - Ty.unify result Ty.Tbool; - try - List.iter2 Ty.unify lt lt_args; - let app = mk_app te_args in - let r = - let t1 = { - c = {tt_desc=app; tt_ty=Ty.Tbool}; - annot=new_id (); } - in - TFatom { c = TApred (t1, false); annot=new_id () } - in - r - with - | Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) f.pp_loc - | Invalid_argument _ -> - Errors.typing_error (WrongNumberofArgs p) f.pp_loc - with Ty.TypeClash _ -> Errors.typing_error (NotAPredicate p) f.pp_loc - end - - | PPdistinct (args) -> - Options.tool_req 1 "TR-Typing-Distinct$_F$"; - let r = - begin - let te_args = List.map (type_term env) args in - let lt_args = List.map ( - fun { c = { tt_ty = t; _ }; _ } -> t - ) te_args in - try - let t = match lt_args with - | t::_ -> t - | [] -> - Errors.typing_error (WrongNumberofArgs "distinct") f.pp_loc - in - List.iter (Ty.unify t) lt_args; - TFatom { c = TAdistinct te_args; annot=new_id () } - with - | Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) f.pp_loc - end - in r - - | PPinfix - ({ pp_desc = PPinfix (_, (PPlt|PPle|PPgt|PPge|PPeq|PPneq), a); _ } as p, - (PPlt | PPle | PPgt | PPge | PPeq | PPneq as r), b) -> - Options.tool_req 1 "TR-Typing-OpComp$_F$"; - let r = - let q = { pp_desc = PPinfix (a, r, b); pp_loc = f.pp_loc } in - let f1 = type_form env p in - let f2 = type_form env q in - TFop(OPand, [f1;f2]) - in r - | PPinfix(t1, (PPeq | PPneq as op), t2) -> - Options.tool_req 1 "TR-Typing-OpBin$_F$"; - let r = - let tt1 = type_term env t1 in - let tt2 = type_term env t2 in - try - Ty.unify tt1.c.tt_ty tt2.c.tt_ty; - match op with - | PPeq -> TFatom (mk_ta_eq tt1 tt2) - | PPneq -> TFatom (mk_ta_neq tt1 tt2) - | _ -> assert false - with Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) f.pp_loc - in r - | PPinfix(t1, (PPlt | PPgt | PPge | PPle as op), t2) -> - Options.tool_req 1 "TR-Typing-OpComp$_F$"; - let r = - let tt1 = type_term env t1 in - let tt2 = type_term env t2 in - try - Ty.unify tt1.c.tt_ty tt2.c.tt_ty; - let ty = Ty.shorten tt1.c.tt_ty in - match ty with - | Ty.Tint | Ty.Treal -> - let top = - match op with - | PPlt -> TAlt [tt1; tt2] - | PPgt -> TAlt [tt2; tt1] - | PPle -> TAle [tt1; tt2] - | PPge -> TAle [tt2; tt1] - | PPeq -> TAeq [tt1; tt2] - | PPneq -> TAneq [tt1; tt2] - | _ -> assert false - in - TFatom {c = top; annot=new_id ()} - | _ -> Errors.typing_error (ShouldHaveTypeIntorReal ty) t1.pp_loc - with Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) f.pp_loc - in r - - | PPisConstr (t,lbl) -> - let tt = type_term env t in - let _s, {Env.args = _lt; result}, kind = - Env.fresh_type env lbl f.pp_loc in - begin - try - Ty.unify tt.c.tt_ty result; - let result = Ty.shorten result in - match kind with - | Env.AdtConstr -> - let top = TTisConstr (tt, Hstring.make lbl) in - let r = TFatom { c = top; annot = new_id () } in - r - | Env.EnumConstr -> - let tt_desc, tt_ty = type_var_desc env lbl f.pp_loc in - let rhs = { c = { tt_desc; tt_ty }; annot = new_id () } in - TFatom (mk_ta_eq tt rhs) - | _ -> - begin match result with - | Ty.Trecord _ -> - (* The typechecker allows only testers whose the - two arguments have the same type. Thus, we can always - replace the tester of a record by the true literal. *) - TFatom { c = TAtrue; annot = new_id () } - | _ -> - Errors.typing_error (NotAdtConstr (lbl, result)) f.pp_loc - end - with Ty.TypeClash(t1,t2) -> - Errors.typing_error (Unification(t1,t2)) f.pp_loc - end - - | PPinfix(f1,op ,f2) -> - Options.tool_req 1 "TR-Typing-OpConnectors$_F$"; - begin - let f1 = type_form env f1 in - let f2 = type_form env f2 in - (match op with - | PPand -> - TFop(OPand,[f1;f2]) - | PPor -> TFop(OPor,[f1;f2]) - | PPxor -> TFop(OPxor,[f1;f2]) - | PPimplies -> TFop(OPimp,[f1;f2]) - | PPiff -> TFop(OPiff,[f1;f2]) - | _ -> assert false) - end - | PPprefix(PPnot,f) -> - Options.tool_req 1 "TR-Typing-OpNot$_F$"; - let f = type_form env f in - TFop(OPnot,[f]) - | PPif(f1,f2,f3) -> - Options.tool_req 1 "TR-Typing-Ite$_F$"; - let f1 = type_form env f1 in - let f2 = type_form env f2 in - let f3 = type_form env f3 in - TFop(OPif, [f1; f2;f3]) - | PPnamed(lbl,f) -> - let f = type_form env f in - let lbl = Hstring.make lbl in - TFnamed(lbl, f) - | PPforall _ | PPexists _ -> - let ty_vars, triggers, hyp, f' = - match pp_desc with - | PPforall(vs_ty,triggers,hyp,f') -> - let ty_vars, triggers', hyp', f' = join_forall f' in - vs_ty @ ty_vars, triggers@triggers', hyp @ hyp', f' - | PPexists(vs_ty,triggers,hyp,f') -> - let ty_vars, triggers', hyp', f' = join_exists f' in - vs_ty @ ty_vars, triggers@triggers', hyp @ hyp', f' - | _ -> assert false - in - let env' = - List.fold_left - (fun env (v, pp_ty) -> - Env.add_var env [v] pp_ty f.pp_loc) env ty_vars in - let f' = type_form env' f' in - let ty_triggers = - List.map (fun (tr, b) -> type_trigger in_theory env' tr, b) triggers in - let qf_hyp = List.map (fun h -> type_form env' h) hyp in - let bvars = - List.fold_left - (fun acc (v,_) -> - let ty = Env.find env' v in - ty :: acc) [] ty_vars - in - let qf_form = { - qf_bvars = bvars ; - qf_triggers = ty_triggers ; - qf_hyp = qf_hyp; - qf_form = f'} - in - (match pp_desc with - | PPforall _ -> - Options.tool_req 1 "TR-Typing-Forall$_F$"; - TFforall qf_form - | PPexists _ -> - Options.tool_req 1 "TR-Typing-Exists$_F$"; - TFexists qf_form - | _ -> assert false) - | PPlet (binders,f) -> - Options.tool_req 1 "TR-Typing-Let$_F$"; - let _ = - List.fold_left (fun z (sy,_) -> - if Util.SS.mem sy z then - Errors.typing_error (DuplicatePattern sy) f.pp_loc; - Util.SS.add sy z - )Util.SS.empty binders - in - let binders = - List.fold_left - (fun (binders) (sy, e) -> - let xx, tty = - try - (* try to type e as a term *) - let { c = { tt_ty = ttype; _ }; _} as tt = type_term env e in - TletTerm tt, ttype - with _ -> - (* try to type e as a form *) - let fzz = type_form env e in - TletForm fzz, Ty.Tbool - in - (sy, Var.of_string sy, xx, tty):: binders - )[] binders - in - let env = - List.fold_left - (fun env (v, sv, _, ty) -> - {env with Env.var_map = - MString.add v (Symbols.var sv, ty) env.Env.var_map} - ) env binders - in - let f = type_form env f in - let binders = - List.fold_left - (fun binders (_,sv,e,_) -> (sv, e) :: binders) - [] binders - in - TFlet (binders, f) - - (* Remove labels : *) - | PPforall_named (vs_tys, trs, hyp, f) -> - let vs_tys = List.map (fun (v, _, ty) -> v, ty) vs_tys in - type_pp_desc (PPforall (vs_tys, trs, hyp, f)) - | PPexists_named (vs_tys, trs, hyp, f) -> - let vs_tys = List.map (fun (v, _, ty) -> v, ty) vs_tys in - type_pp_desc (PPexists (vs_tys, trs, hyp, f)) - - | PPcheck _ | PPcut _ -> assert false - - | PPmatch (e, pats) -> - let e = type_term env e in - let ty = e.c.tt_ty in - let ty_body = match ty with - | Ty.Tadt (name, params) -> Ty.type_body name params - | Ty.Trecord { Ty.record_constr; lbs; _ } -> - [{Ty.constr = record_constr ; destrs = lbs}] - - | _ -> - Errors.typing_error (ShouldBeADT ty) f.pp_loc - in - let pats = - List.rev @@ - List.rev_map - (fun (p, v) -> - let p, env = type_pattern p env ty ty_body in - p, type_form env v - ) pats - in - let missing, filtered_pats, dead = - filter_patterns pats ty_body f.pp_loc - in - check_pattern_matching missing dead f.pp_loc; - TFmatch (e, filtered_pats) - - | _ -> - let te1 = type_term env f in - let ty = te1.c.tt_ty in - match ty with - | Ty.Tbool -> - let te2 = {c = {tt_desc=TTconst Ttrue;tt_ty=Ty.Tbool}; - annot = new_id ()} - in - TFatom (mk_ta_eq te1 te2) - | _ -> Errors.typing_error ShouldHaveTypeProp f.pp_loc - in - let form = type_pp_desc f.pp_desc in - {c = form; annot = new_id ()} - -and type_pattern p env ty ty_body = - let {pat_loc ; pat_desc = (f, args) } = p in - check_no_duplicates pat_loc args; - let hf = Hstring.make f in - try - let prof = Ty.assoc_destrs (Uid.of_hstring hf) ty_body in - let env = - try - List.fold_left2 - (fun env v (_, ty) -> Env.add_ty_var env [v] ty) env args prof - with - Invalid_argument _ -> - Errors.typing_error (WrongNumberofArgs f) pat_loc - in - let args = - List.map2 - (fun v (destr, _) -> - let tv, ty = type_var_desc env v pat_loc in - let var_v = - match tv with TTvar Symbols.Var vx -> vx | _ -> assert false - in - var_v, destr, ty - )args prof - in - Constr { name = Uid.of_hstring hf ; args = args }, env - with Not_found -> - if args != [] then Errors.typing_error (NotAdtConstr (f, ty)) pat_loc; - let env = Env.add_ty_var env [f] ty in - let tv, _ = type_var_desc env f pat_loc in - let var_f = - match tv with TTvar Symbols.Var vx -> vx | _ -> assert false - in - Var var_f, env - -and type_trigger in_theory env l = - List.map - (fun t -> - match in_theory, t.pp_desc with - | false, PPinInterval _ -> - Errors.typing_error ThSemTriggerError t.pp_loc - | false, PPmapsTo _ -> - Errors.typing_error ThSemTriggerError t.pp_loc - | true, PPinInterval (e, a,b, c, d) -> - let te = type_term env e in - let tt_ty = te.c.tt_ty in - let tb = type_bound env b tt_ty ~is_open:a ~is_lower:true in - let tc = type_bound env c tt_ty ~is_open:d ~is_lower:false in - { c = { tt_desc = TTinInterval(te, tb , tc) ; tt_ty = Ty.Tbool}; - annot = new_id ()} - - | true, PPmapsTo (x, e) -> - let vx, ty_x = type_var_desc env x t.pp_loc in - let hs_x = - match vx with TTvar Symbols.Var hs -> hs | _ -> assert false - in - let te = type_term env e in - let tt_ty = te.c.tt_ty in - if not (Ty.equal tt_ty ty_x) then - Errors.typing_error (ShouldHaveType(ty_x,tt_ty)) t.pp_loc; - { c = { tt_desc = TTmapsTo(hs_x, te) ; tt_ty = Ty.Tbool}; - annot = new_id ()} - - | _ -> - try type_term env t - with Errors.Error _ -> - ignore (type_form env t); - if Options.get_verbose () then - Printer.print_dbg - ~module_name:"Typechecker" ~function_name:"type_trigger" - "%a The given trigger is not a term and is ignored" - Loc.report t.pp_loc; - (* hack to typecheck *) - type_term env {t with pp_desc = PPconst ConstVoid} - )l - -let make_rules loc f = match f.c with - | TFforall { qf_bvars = vars; - qf_form = { c = TFatom { c = TAeq [t1; t2]; _ }; _ }; _ } -> - {rwt_vars = vars; rwt_left = t1; rwt_right = t2} - | TFatom { c = TAeq [t1; t2]; _} -> - {rwt_vars = []; rwt_left = t1; rwt_right = t2} - | _ -> Errors.typing_error SyntaxError loc - - -let fresh_var = - let cpt = ref 0 in - fun x -> incr cpt; ("_"^x^(string_of_int !cpt)) - -let rec no_alpha_renaming_b ((up, m) as s) f = - match f.pp_desc with - | PPvar x -> - (try - let y = MString.find x m in - assert (String.compare x y <> 0); - raise Exit - with Not_found -> ()) - - | PPmapsTo(x, e) -> - (try - let y = MString.find x m in - assert (String.compare x y <> 0); - raise Exit - with Not_found -> ()); - no_alpha_renaming_b s e - - | PPapp(_, l) -> - List.iter (no_alpha_renaming_b s) l - - | PPinInterval(e, _,_,_,_) -> - no_alpha_renaming_b s e - - | PPdistinct l -> - List.iter (no_alpha_renaming_b s) l - - | PPconst _ -> () - - | PPinfix(f1, _, f2) -> - no_alpha_renaming_b s f1; no_alpha_renaming_b s f2 - - | PPprefix(_, f1) -> - no_alpha_renaming_b s f1 - - | PPget(f1,f2) -> - no_alpha_renaming_b s f1; no_alpha_renaming_b s f2 - - - | PPset(f1, f2, f3) -> - no_alpha_renaming_b s f1; - no_alpha_renaming_b s f2; - no_alpha_renaming_b s f3 - - - | PPextract(f1, _, _) -> - no_alpha_renaming_b s f1 - - | PPconcat(f1, f2) -> - no_alpha_renaming_b s f1; no_alpha_renaming_b s f2 - - | PPif(f1, f2, f3) -> - no_alpha_renaming_b s f1; - no_alpha_renaming_b s f2; - no_alpha_renaming_b s f3 - - | PPnamed(_, f1) -> - no_alpha_renaming_b s f1 - - | PPdot(f1, _) -> - no_alpha_renaming_b s f1 - - | PPrecord l -> - List.iter (fun (_,e) -> no_alpha_renaming_b s e) l - - | PPwith(e, l) -> - List.iter (fun (_,e) -> no_alpha_renaming_b s e) l; - no_alpha_renaming_b s e - - | PPlet(l, f2) -> - let _ = - List.fold_left (fun z (sy,_) -> - if Util.SS.mem sy z then - Errors.typing_error (DuplicatePattern sy) f.pp_loc; - Util.SS.add sy z - )Util.SS.empty l - in - List.iter (fun (_, f) -> no_alpha_renaming_b s f) l; - let s = - List.fold_left - (fun (up, m) (x, _) -> - if S.mem x up then - let nx = fresh_var x in - let m = MString.add x nx m in - (S.add nx up, m) - else (S.add x up, m) - )(up, m) l - in - no_alpha_renaming_b s f2 - - | PPcheck f' -> - no_alpha_renaming_b s f' - - | PPcut f' -> - no_alpha_renaming_b s f' - - | PPcast (f',_) -> - no_alpha_renaming_b s f' - - | PPforall(xs, trs, hyp, f1) -> - let xs1, xs2 = List.partition (fun (x, _) -> S.mem x up) xs in - let nv = List.map (fun (x, ty) -> fresh_var x, ty) xs1 in - let m = List.fold_left2 - (fun m (x, _) (nx, _) -> MString.add x nx m) m xs1 nv in - let xs = nv @ xs2 in - let up = List.fold_left (fun up (x, _) -> S.add x up) up xs in - let s = (up, m) in - List.iter (no_alpha_renaming_b s) hyp; - no_alpha_renaming_b s f1; - List.iter (fun (l, _) -> List.iter (no_alpha_renaming_b s) l) trs - - | PPforall_named (xs, trs, hyp, f1) -> - let xs1, xs2 = List.partition (fun (x, _, _) -> S.mem x up) xs in - let nv = List.map (fun (x, lbl, ty) -> fresh_var x, lbl, ty) xs1 in - let m = List.fold_left2 - (fun m (x, _, _) (nx, _, _) -> MString.add x nx m) m xs1 nv in - let xs = nv @ xs2 in - let up = List.fold_left (fun up (x, _, _) -> S.add x up) up xs in - let s = (up, m) in - List.iter (no_alpha_renaming_b s) hyp; - no_alpha_renaming_b s f1; - List.iter (fun (l, _) -> List.iter (no_alpha_renaming_b s) l) trs - - | PPexists(lx, trs, hyp, f1) -> - let s, _ = - List.fold_left - (fun (_, lx) (x, _) -> - if S.mem x up then - let nx = fresh_var x in - let m = MString.add x nx m in - let up = S.add nx up in - (up, m), nx :: lx - else - (S.add x up, m), x :: lx) - (s, []) lx - in - no_alpha_renaming_b s f1; - List.iter (no_alpha_renaming_b s) hyp; - List.iter (fun (l, _) -> List.iter (no_alpha_renaming_b s) l) trs - - | PPexists_named (lx, trs, hyp, f1) -> - let s, _ = - List.fold_left - (fun (_, lx) (x, _, _) -> - if S.mem x up then - let nx = fresh_var x in - let m = MString.add x nx m in - let up = S.add nx up in - (up, m), nx :: lx - else - (S.add x up, m), x :: lx) - (s, []) lx - in - no_alpha_renaming_b s f1; - List.iter (no_alpha_renaming_b s) hyp; - List.iter (fun (l, _) -> List.iter (no_alpha_renaming_b s) l) trs - - | PPmatch(e, cases) -> - no_alpha_renaming_b s e; - List.iter (fun (_, e) -> no_alpha_renaming_b s e) cases - - | PPisConstr (e, _) -> - no_alpha_renaming_b s e - - | PPproject (e, _) -> - no_alpha_renaming_b s e - -let rec alpha_renaming_b ((up, m) as s) f = - match f.pp_desc with - | PPvar x -> - (try - let y = MString.find x m in - assert (String.compare x y <> 0); - {f with pp_desc = PPvar y} - with Not_found -> f) - - | PPmapsTo (x, e) -> - let x' = - try - let y = MString.find x m in - assert (String.compare x y <> 0); - y - with Not_found -> x - in - let e' = alpha_renaming_b s e in - if x == x' && e == e' then f - else {f with pp_desc = PPmapsTo(x', e')} - - | PPapp(k, l) -> - let l2 = List.rev (List.rev_map (alpha_renaming_b s) l) in - if List.for_all2 (fun a b -> a == b) l l2 then f - else {f with pp_desc = PPapp(k, l2)} - - | PPinInterval (e,a,b,c,d) -> - let e' = alpha_renaming_b s e in - if e == e' then e - else {f with pp_desc = PPinInterval(e', a,b,c,d)} - - | PPdistinct l -> - let l2 = List.rev (List.rev_map (alpha_renaming_b s) l) in - if List.for_all2 (fun a b -> a == b) l l2 then f - else {f with pp_desc = PPdistinct l2} - - | PPconst _ -> f - - | PPinfix(f1, op, f2) -> - let ff1 = alpha_renaming_b s f1 in - let ff2 = alpha_renaming_b s f2 in - if f1 == ff1 && f2 == ff2 then f - else {f with pp_desc = PPinfix(ff1, op, ff2)} - - | PPprefix(op, f1) -> - let ff1 = alpha_renaming_b s f1 in - if f1 == ff1 then f - else {f with pp_desc = PPprefix(op, ff1)} - - | PPget(f1,f2) -> - let ff1 = alpha_renaming_b s f1 in - let ff2 = alpha_renaming_b s f2 in - if f1 == ff1 && f2 == ff2 then f - else {f with pp_desc = PPget(ff1, ff2)} - - | PPset(f1, f2, f3) -> - let ff1 = alpha_renaming_b s f1 in - let ff2 = alpha_renaming_b s f2 in - let ff3 = alpha_renaming_b s f3 in - if f1 == ff1 && f2 == ff2 && f3 == ff3 then f - else {f with pp_desc = PPset(ff1, ff2, ff3)} - - | PPextract(f1, i, j) -> - let ff1 = alpha_renaming_b s f1 in - if f1 == ff1 then f - else {f with pp_desc = PPextract(ff1, i, j)} - - | PPconcat(f1, f2) -> - let ff1 = alpha_renaming_b s f1 in - let ff2 = alpha_renaming_b s f2 in - if ff1 == f1 && ff2 == f2 then f - else {f with pp_desc = PPconcat(ff1, ff2)} - - | PPif(f1, f2, f3) -> - let ff1 = alpha_renaming_b s f1 in - let ff2 = alpha_renaming_b s f2 in - let ff3 = alpha_renaming_b s f3 in - if f1 == ff1 && f2 == ff2 && f3 == ff3 then f - else {f with pp_desc = PPif(ff1, ff2, ff3)} - - | PPnamed(n, f1) -> - let ff1 = alpha_renaming_b s f1 in - if f1 == ff1 then f - else {f with pp_desc = PPnamed(n, ff1)} - - | PPdot(f1, a) -> - let ff1 = alpha_renaming_b s f1 in - if f1 == ff1 then f - else {f with pp_desc = PPdot(ff1, a)} - - | PPrecord l -> - let l2 = - List.rev (List.rev_map (fun (a,e) -> a, alpha_renaming_b s e) l) in - if List.for_all2 (fun a b -> a == b) l l2 then f - else {f with pp_desc = PPrecord l2} - - | PPwith(e, l) -> - let l2 = - List.rev (List.rev_map (fun (a,e) -> a, alpha_renaming_b s e) l) in - let ee = alpha_renaming_b s e in - if List.for_all2 (fun a b -> a == b) l l2 && e == ee then f - else {f with pp_desc = PPwith(ee, l2)} - - | PPlet(l, f2) -> - let _ = - List.fold_left (fun z (sy,_) -> - if Util.SS.mem sy z then - Errors.typing_error (DuplicatePattern sy) f.pp_loc; - Util.SS.add sy z - )Util.SS.empty l - in - let same_fi = ref true in - let rev_l = - List.rev_map (fun (x, f1) -> - let ff1 = alpha_renaming_b s f1 in - same_fi := !same_fi && f1 == ff1; - x, ff1 - ) l - in - let s, l = - List.fold_left - (fun ((up,m), l) (x, f1) -> - if S.mem x up then - let nx = fresh_var x in - let m = MString.add x nx m in - (S.add nx up, m), (nx, f1) :: l - else - (S.add x up, m), (x, f1) :: l - )((up,m), []) rev_l - in - let ff2 = alpha_renaming_b s f2 in - if !same_fi && f2 == ff2 then f - else {f with pp_desc = PPlet(l, ff2)} - - | PPcheck f' -> - let ff = alpha_renaming_b s f' in - if f' == ff then f - else {f with pp_desc = PPcheck ff} - - | PPcut f' -> - let ff = alpha_renaming_b s f' in - if f' == ff then f - else {f with pp_desc = PPcut ff} - - | PPcast (f',ty) -> - let ff = alpha_renaming_b s f' in - if f' == ff then f - else {f with pp_desc = PPcast (ff,ty)} - - | PPforall(xs, trs, hyp, f1) -> - let xs1, xs2 = List.partition (fun (x, _) -> S.mem x up) xs in - let nv = List.map (fun (x, ty) -> fresh_var x, ty) xs1 in - let m = List.fold_left2 - (fun m (x, _) (nx, _) -> MString.add x nx m) m xs1 nv in - let xs = nv @ xs2 in - let up = List.fold_left (fun up (x, _) -> S.add x up) up xs in - let s = (up, m) in - let ff1 = alpha_renaming_b s f1 in - let trs2 = - List.map (fun (l, tuser) -> - List.map (alpha_renaming_b s) l, tuser) trs - in - let hyp2 = List.map (alpha_renaming_b s) hyp in - if f1==ff1 && List.for_all2 (fun a b -> a==b) trs trs2 - && List.for_all2 (fun a b -> a==b) hyp hyp2 then f - else {f with pp_desc = PPforall(xs, trs2, hyp2, ff1)} - - | PPforall_named (xs, trs, hyp, f1) -> - let xs1, xs2 = List.partition (fun (x, _, _) -> S.mem x up) xs in - let nv = List.map (fun (x, lbl, ty) -> fresh_var x, lbl, ty) xs1 in - let m = List.fold_left2 - (fun m (x, _, _) (nx, _, _) -> MString.add x nx m) m xs1 nv in - let xs = nv @ xs2 in - let up = List.fold_left (fun up (x, _, _) -> S.add x up) up xs in - let s = (up, m) in - let ff1 = alpha_renaming_b s f1 in - let trs2 = - List.map (fun (l, tuser) -> - List.map (alpha_renaming_b s) l, tuser) trs - in - let hyp2 = List.map (alpha_renaming_b s) hyp in - if f1==ff1 && List.for_all2 (fun a b -> a==b) trs trs2 - && List.for_all2 (fun a b -> a==b) hyp hyp2 then f - else {f with pp_desc = PPforall_named (xs, trs2, hyp2, ff1)} - - | PPexists(lx, trs, hyp, f1) -> - let s, lx = - List.fold_left - (fun (_, lx) (x, ty) -> - if S.mem x up then - let nx = fresh_var x in - let m = MString.add x nx m in - let up = S.add nx up in - (up, m), (nx, ty) :: lx - else - (S.add x up, m), (x, ty) :: lx) - (s, []) lx - in - let trs2 = - List.map - (fun (l, tuser) -> List.map (alpha_renaming_b s) l, tuser) trs - in - let ff1 = alpha_renaming_b s f1 in - let hyp2 = List.map (alpha_renaming_b s) hyp in - if f1==ff1 && List.for_all2 (fun a b -> a==b) trs trs2 - && List.for_all2 (fun a b -> a==b) hyp hyp2 then f - else {f with pp_desc = PPexists(lx, trs2, hyp2, ff1)} - - | PPexists_named (lx, trs, hyp, f1) -> - let s, lx = - List.fold_left - (fun (_, lx) (x, lbl, ty) -> - if S.mem x up then - let nx = fresh_var x in - let m = MString.add x nx m in - let up = S.add nx up in - (up, m), (nx, lbl, ty) :: lx - else - (S.add x up, m), (x, lbl, ty) :: lx) - (s, []) lx - in - let ff1 = alpha_renaming_b s f1 in - let trs2 = - List.map - (fun (l, tuser) -> List.map (alpha_renaming_b s) l, tuser) trs - in - let hyp2 = List.map (alpha_renaming_b s) hyp in - if f1==ff1 && List.for_all2 (fun a b -> a==b) trs trs2 - && List.for_all2 (fun a b -> a==b) hyp hyp2 then f - else {f with pp_desc = PPexists_named (lx, trs2, hyp2, ff1)} - - | PPmatch(e, cases) -> - let e' = alpha_renaming_b s e in - let same_cases = ref true in - let cases' = - List.map - (fun (p, e) -> - let e' = alpha_renaming_b s e in - same_cases := !same_cases && e == e'; - p, e' - ) cases - in - if !same_cases && e == e' then f - else - let cases' = if !same_cases then cases else cases' in - { f with pp_desc = PPmatch(e', cases') } - - | PPproject(f1, a) -> - let ff1 = alpha_renaming_b s f1 in - if f1 == ff1 then f - else {f with pp_desc = PPproject(ff1, a)} - - | PPisConstr(f1, a) -> - let ff1 = alpha_renaming_b s f1 in - if f1 == ff1 then f - else {f with pp_desc = PPisConstr(ff1, a)} - -let alpha_renaming_b s f = - try no_alpha_renaming_b s f; f - with Exit -> alpha_renaming_b s f - -let alpha_renaming_env env = - let up = MString.fold (fun s _ up -> S.add s up) - env.Env.logics S.empty in - let up = MString.fold (fun s _ up -> S.add s up) env.Env.var_map up in - alpha_renaming_b (up, MString.empty) - - -let rec elim_toplevel_forall env bnot f = - (* bnot = true : nombre impaire de not *) - match f.pp_desc with - | PPforall (lv, _, _, f) when bnot -> - let env = List.fold_left (fun env (v, ty) -> - Env.add_names env [v] ty f.pp_loc - ) env lv in - elim_toplevel_forall env bnot f - - | PPforall_named (lvb, _, _, f) when bnot-> - let env = List.fold_left (fun env (v, lbl, ty) -> - Env.add_names_lbl env [v, lbl] ty f.pp_loc - ) env lvb in - elim_toplevel_forall env bnot f - - | PPinfix (f1, PPand, f2) when not bnot -> - let f1 , env = elim_toplevel_forall env false f1 in - let f2 , env = elim_toplevel_forall env false - (alpha_renaming_env env f2) in - { f with pp_desc = PPinfix(f1, PPand , f2)}, env - - | PPinfix (f1, PPor, f2) when bnot -> - let f1 , env = elim_toplevel_forall env true f1 in - let f2 , env = elim_toplevel_forall env true - (alpha_renaming_env env f2) in - { f with pp_desc = PPinfix(f1, PPand , f2)}, env - - | PPinfix (f1, PPimplies, f2) when bnot -> - let f1 , env = elim_toplevel_forall env false f1 in - let f2 , env = elim_toplevel_forall env true - (alpha_renaming_env env f2) in - { f with pp_desc = PPinfix(f1,PPand,f2)}, env - - | PPprefix (PPnot, f) -> elim_toplevel_forall env (not bnot) f - - - | _ when bnot -> - { f with pp_desc = PPprefix (PPnot, f) }, env - - | _ -> f , env - - -let rec intro_hypothesis env valid_mode f = - match f.pp_desc with - | PPinfix(f1,PPimplies,f2) when valid_mode -> - let ((_, env) as f1_env) = - elim_toplevel_forall env (not valid_mode) f1 in - let axioms, goal = intro_hypothesis env valid_mode - (alpha_renaming_env env f2) in - f1_env::axioms, goal - (* | PPlet(var,{pp_desc=PPcast(t1,ty); pp_loc = ty_loc},f2) -> - let env = Env.add_names env [var] ty ty_loc in - let var = {pp_desc = PPvar var; pp_loc = f.pp_loc} in - let feq = {pp_desc = PPinfix(var,PPeq,t1); pp_loc = f.pp_loc} in - let axioms, goal = intro_hypothesis env valid_mode - (alpha_renaming_env env f2) in - (feq,env)::axioms, goal - *) - | PPforall (lv, _, _, f) when valid_mode -> - let env = List.fold_left (fun env (v, ty) -> - Env.add_names env [v] ty f.pp_loc - ) env lv in - intro_hypothesis env valid_mode f - | PPexists (lv, _, _, f) when not valid_mode-> - let env = List.fold_left (fun env (v, ty) -> - Env.add_names env [v] ty f.pp_loc - ) env lv in - intro_hypothesis env valid_mode f - | PPforall_named (lvb, _, _, f) when valid_mode -> - let env = List.fold_left (fun env (v, lbl, ty) -> - Env.add_names_lbl env [v, lbl] ty f.pp_loc - ) env lvb in - intro_hypothesis env valid_mode f - | PPexists_named (lvb, _, _, f) when not valid_mode-> - let env = List.fold_left (fun env (v, lbl, ty) -> - Env.add_names_lbl env [v, lbl] ty f.pp_loc - ) env lvb in - intro_hypothesis env valid_mode f - | _ -> - let f_env = elim_toplevel_forall env valid_mode f in - [] , f_env - -let fresh_check_name = - let cpt = ref 0 in fun () -> incr cpt; "check_"^(string_of_int !cpt) - -let fresh_cut_name = - let cpt = ref 0 in fun () -> incr cpt; "cut_"^(string_of_int !cpt) - -let check_duplicate_params l = - let rec loop l acc = - match l with - | [] -> () - | (loc,x,_)::rem -> - if List.mem x acc then - Errors.typing_error (ClashParam x) loc - else loop rem (x::acc) - in - loop l [] - -let rec make_pred loc trs f = function - [] -> f - | [x,t] -> - { pp_desc = PPforall([x,t],trs,[],f) ; pp_loc = loc } - | (x,t)::l -> - { pp_desc = PPforall([x,t],[],[],(make_pred loc trs f l)) ; - pp_loc = loc } - -let monomorphize_var (s,ty) = s, Ty.monomorphize ty - -let rec mono_term {c = {tt_ty=tt_ty; tt_desc=tt_desc}; annot = id} = - let tt_desc = match tt_desc with - | TTconst _ | TTvar _ -> - tt_desc - | TTinfix (t1, sy, t2) -> - TTinfix(mono_term t1, sy, mono_term t2) - | TTprefix (sy,t) -> - TTprefix(sy, mono_term t) - | TTapp (sy,tl) -> - TTapp (sy, List.map mono_term tl) - | TTinInterval (e, lb, ub) -> - TTinInterval(mono_term e, lb, ub) - | TTmapsTo (x, e) -> - TTmapsTo(x, mono_term e) - | TTget (t1,t2) -> - TTget (mono_term t1, mono_term t2) - | TTset (t1,t2,t3) -> - TTset(mono_term t1, mono_term t2, mono_term t3) - | TTextract (t1,i,j) -> - TTextract(mono_term t1, i, j) - | TTconcat (t1,t2)-> - TTconcat (mono_term t1, mono_term t2) - | TTdot (t1, a) -> - TTdot (mono_term t1, a) - | TTrecord lbs -> - TTrecord (List.map (fun (x, t) -> x, mono_term t) lbs) - | TTlet (l,t2)-> - let l = List.rev_map (fun (x, t1) -> x, mono_term t1) (List.rev l) in - TTlet (l, mono_term t2) - | TTnamed (lbl, t)-> - TTnamed (lbl, mono_term t) - | TTite (cond, t1, t2) -> - TTite (monomorphize_form cond, mono_term t1, mono_term t2) - - | TTproject (t, lbl) -> - TTproject (mono_term t, lbl) - | TTmatch (e, pats) -> - let e = mono_term e in - let pats = List.rev_map (fun (p, f) -> p, mono_term f) (List.rev pats) in - TTmatch (e, pats) - - | TTform f -> TTform (monomorphize_form f) - - in - { c = {tt_ty = Ty.monomorphize tt_ty; tt_desc=tt_desc}; annot = id} - - -and monomorphize_atom tat = - let c = match tat.c with - | TAtrue | TAfalse -> tat.c - | TAeq tl -> TAeq (List.map mono_term tl) - | TAneq tl -> TAneq (List.map mono_term tl) - | TAle tl -> TAle (List.map mono_term tl) - | TAlt tl -> TAlt (List.map mono_term tl) - | TAdistinct tl -> TAdistinct (List.map mono_term tl) - | TApred (t, negated) -> TApred (mono_term t, negated) - | TTisConstr (t, lbl) -> TTisConstr (mono_term t, lbl) - in - { tat with c = c } - -and monomorphize_form tf = - let c = match tf.c with - | TFatom tat -> TFatom (monomorphize_atom tat) - | TFop (oplogic , tfl) -> - TFop(oplogic, List.map monomorphize_form tfl) - | TFforall qf -> - TFforall - { qf_bvars = List.map monomorphize_var qf.qf_bvars; - qf_hyp = List.map monomorphize_form qf.qf_hyp; - qf_form = monomorphize_form qf.qf_form; - qf_triggers = - List.map (fun (l, b) -> List.map mono_term l, b) qf.qf_triggers} - | TFexists qf -> - TFexists - { qf_bvars = List.map monomorphize_var qf.qf_bvars; - qf_hyp = List.map monomorphize_form qf.qf_hyp; - qf_form = monomorphize_form qf.qf_form; - qf_triggers = - List.map (fun (l, b) -> List.map mono_term l, b) qf.qf_triggers} - - | TFlet (binders, tf) -> - let binders = - List.rev_map - (fun (sy, e) -> - match e with - | TletTerm tt -> sy, TletTerm (mono_term tt) - | TletForm ff -> sy, TletForm (monomorphize_form ff) - )(List.rev binders) - in - TFlet(binders, monomorphize_form tf) - - | TFnamed (hs,tf) -> - TFnamed(hs, monomorphize_form tf) - - | TFmatch(e, pats) -> - let e = mono_term e in - let pats = - List.rev_map - (fun (p, f) -> p, monomorphize_form f) (List.rev pats) - in - TFmatch (e, pats) - in - { tf with c = c } - -let axioms_of_rules loc name lf acc env = - let acc = - List.fold_left - (fun acc f -> - let name = - Fmt.str "%s_%s" - (Id.Namespace.Internal.fresh ()) - name - in - let td = {c = TAxiom(loc,name,Util.Default, f); annot = new_id () } in - (td, env)::acc - ) acc lf - in - acc, env - - - -let type_hypothesis acc env_f loc sort f = - let f = type_form env_f f in - let f = monomorphize_form f in - let td = - {c = TAxiom(loc, Ty.fresh_hypothesis_name sort,Util.Default, f); - annot = new_id () } in - (td, env_f)::acc - - -let type_goal acc env_g loc sort n goal = - let goal = type_form env_g goal in - let goal = monomorphize_form goal in - let td = {c = TGoal(loc, sort, n, goal); annot = new_id () } in - (td, env_g)::acc - - -let rec type_and_intro_goal acc env sort n f = - let axioms, (goal, env_g) = - intro_hypothesis env (match sort with Ty.Sat -> false | _ -> true) f in - let loc = f.pp_loc in - let acc = - List.fold_left - (fun acc (f, env_f) -> match f.pp_desc with - | PPcut f -> - let acc = type_and_intro_goal - acc env_f Ty.Cut (fresh_cut_name ()) f in - type_hypothesis acc env_f loc sort f - - | PPcheck f -> - type_and_intro_goal - acc env_f Check (fresh_check_name ()) f - - | _ -> - type_hypothesis acc env_f loc sort f - ) acc axioms - in - type_goal acc env_g loc sort n goal - - - -let type_one_th_decl env e = - (* NB: we always keep triggers for axioms of theories *) - match e with - | Axiom(loc,name,ax_kd,f) -> - let f = type_form ~in_theory:true env f in - {c = TAxiom (loc,name,ax_kd,f); annot = new_id ()} - - | Optimize (loc, _, _) - | Theory (loc, _, _, _) - | Logic (loc, _, _, _) - | Rewriting(loc, _, _) - | Goal(loc, _, _) - | Check_sat(loc, _, _) - | Predicate_def(loc,_,_,_) - | Function_def(loc,_,_,_,_) - | MutRecDefs ((loc,_,_,_,_) :: _) - | TypeDecl ((loc, _, _, _)::_) - | Push (loc,_) | Pop (loc,_) | Reset loc | Exit loc -> - Errors.typing_error WrongDeclInTheory loc - | MutRecDefs [] - | TypeDecl [] -> assert false - -let is_recursive_type = - let rec exit_if_has_type s ppty = - match ppty with - | PPTint | PPTbool | PPTreal | PPTunit | PPTbitv _ | PPTvarid _ -> () - | PPTexternal (args, n, _loc) -> - if String.equal s n then raise Exit; - List.iter (exit_if_has_type s) args - in - fun s body -> - match body with - | Abstract | Enum _ | Record _ -> false - | Algebraic cases -> - try - List.iter - (fun (_c, args_ty) -> - List.iter (fun (_lbl, ppty) -> exit_if_has_type s ppty) args_ty - )cases; - false - with Exit -> - true - -let user_types_of_body = - let rec aux acc ppty = - match ppty with - | PPTint | PPTbool | PPTreal | PPTunit | PPTbitv _ | PPTvarid _ -> acc - | PPTexternal (args, n, _loc) -> List.fold_left aux (S.add n acc) args - in - fun body -> - match body with - | Abstract - | Enum _ -> S.empty - | Record (_, args_ty) -> - List.fold_left (fun acc (_lbl, ppty) -> aux acc ppty) S.empty args_ty - - | Algebraic cases -> - List.fold_left - (fun acc (_c, args_ty) -> - List.fold_left (fun acc (_lbl, ppty) -> aux acc ppty) acc args_ty - )S.empty cases - - -(* Could do better with topological ordering and cycles detection *) -let partition_non_rec = - let detect_non_rec non_rec pending = - let tys = - List.fold_left (fun acc (_,s, _) -> S.add s acc) S.empty pending - in - List.fold_left - (fun (non_rec, pending) ((e, _, body_deps) as ee) -> - let new_deps = S.inter body_deps tys in - if S.is_empty new_deps then e :: non_rec, pending - else non_rec, ee :: pending - )(non_rec, []) (List.rev pending) - in - let rec aux non_rec pending = - let non_rec', pending' = detect_non_rec non_rec pending in - if non_rec' != non_rec then aux non_rec' pending' - else List.rev non_rec', List.map (fun (e,_,_) -> e) pending' - in - fun l -> - aux [] @@ - List.rev_map - (fun ((_loc, _, s, body) as e) -> (e, s, user_types_of_body body)) - (List.rev l) - -let refine_body_of_non_recursive_adt body = - match body with - | Algebraic [c, []] -> - (* enum with one constructor *) - Enum [c] - - | Algebraic [c, l] -> - (* record *) - Record (c,l) - - | Algebraic l -> - begin - try Enum (List.map (fun (c, l) -> if l != [] then raise Exit; c) l) - with Exit -> body - end - - | _ -> body - - -let type_user_defined_type_body ~is_recursive env acc (loc, ls, s, body) = - let tls = List.map (fun s -> PPTvarid (s,loc)) ls in - let pur_ty = PPTexternal(tls, s, loc) in - match body with - | Enum lc -> - assert (not is_recursive); (* Enum types are not recursive *) - let lcl = List.map (fun c -> c, "") lc in (* empty labels *) - let ty = PFunction([], pur_ty) in - let tlogic, env = - (* can also use List.fold Env.add_constr *) - let constr = fun s -> Symbols.constr @@ Uid.of_string s in - Env.add_logics ~kind:Env.EnumConstr env constr lcl ty loc - in - let td2_a = { c = TLogic(loc, lc, tlogic); annot=new_id () } in - (td2_a,env)::acc, env - - | Record (constr, lrec) -> - (* Records types are not recursive. They remain Algebraic in this - case *) - assert (not is_recursive); - let acc, env = - if String.equal constr "{" then - (* do not register default "{ . }" constructor *) - acc, env - else - let args_ty = List.map snd lrec in - let tlogic, env = - Env.add_constr ~record:true env constr args_ty pur_ty loc - in - ({c = TLogic(loc, [constr], tlogic); annot=new_id ()}, env)::acc, env - in - List.fold_left (* register fields *) - (fun (acc, env) (lbl, ty_lbl) -> - let tlogic, env = - Env.add_destr ~record:true env lbl pur_ty ty_lbl loc - in - ({c = TLogic(loc, [lbl], tlogic); annot=new_id ()}, env) :: acc, env - )(acc, env) lrec - - | Algebraic lc -> - List.fold_left - (fun (acc, env) (constr, lbl_args_ty) -> - let args_ty = List.map snd lbl_args_ty in - let tty, env = - Env.add_constr ~record:false env constr args_ty pur_ty loc - in - let acc = - ({c = TLogic(loc, [constr], tty); annot=new_id ()}, env) :: acc - in - List.fold_left (* register destructors *) - (fun (acc, env) (lbl, ty_lbl) -> - let tty, env = - Env.add_destr ~record:false env lbl pur_ty ty_lbl loc - in - ({c = TLogic(loc, [lbl], tty); annot=new_id ()}, env) :: acc, env - )(acc, env) lbl_args_ty - )(acc, env) lc - - | Abstract -> - assert (not is_recursive); (* Abstract types are not recursive *) - acc, env - -let declare_fun env loc n ?(defined=false) ?ret_ty l = - check_duplicate_params l; - let infix, ty = - let l = List.map (fun (_,_,x) -> x) l in - match ret_ty with - | None | Some PPTbool -> - PPiff, PPredicate l - | Some ty -> - PPeq, PFunction(l,ty) - in - let mk_symb hs = Symbols.name hs ~defined ~kind:Symbols.Other in - let tlogic, env = Env.add_logics env mk_symb [n] ty loc in (* TODO *) - env, infix, tlogic - -let define_fun (acc, env) loc n l tlogic ?ret_ty infix e = - let l = List.map (fun (_,x,t) -> (x,t)) l in - let n = fst n in - let lvar = List.map (fun (x,_) -> {pp_desc=PPvar x;pp_loc=loc}) l in - let p = { pp_desc=PPapp(n,lvar) ; pp_loc=loc } in - let f = { pp_desc = PPinfix(p,infix,e) ; pp_loc = loc } in - let f = make_pred loc [] f l in - let f = type_form env f in - let t_typed, l_typed = - match tlogic with - | TPredicate args -> - Ty.Tbool, List.map2 (fun (x, _) ty -> x, Ty.shorten ty) l args - | TFunction (args, ret) -> - Ty.shorten ret, List.map2 (fun (x, _) ty -> x, Ty.shorten ty) l args - in - let td = - match ret_ty with - | None -> - Options.tool_req 1 "TR-Typing-LogicPred$_F$"; - TPredicate_def(loc,n,l_typed,f) - | Some _ -> - Options.tool_req 1 "TR-Typing-LogicFun$_F$"; - TFunction_def(loc,n,l_typed,t_typed,f) - in - let td_a = { c = td; annot=new_id () } in - (td_a, env)::acc, env - -let type_fun (acc, env) loc n l ?ret_ty e = - let env, infix, tlogic = - declare_fun env loc n ~defined:true ?ret_ty l - in - define_fun (acc, env) loc n l tlogic ?ret_ty infix e - -let rec type_decl (acc, env) d assertion_stack = - Types.to_tyvars := MString.empty; - match d with - | Push (loc,n) -> - if n < 0 then - Errors.typing_error (ShouldBePositive n) loc; - Util.loop ~f:(fun _n env () -> Stack.push env assertion_stack) - ~max:n ~elt:env ~init:(); - let td = {c = TPush(loc,n); annot = new_id () } in - (td,env) :: acc, env - | Pop (loc,n) -> - if n < 0 then - Errors.typing_error (ShouldBePositive n) loc; - let assertion_context_number = Stack.length assertion_stack in - if n > assertion_context_number then - Errors.typing_error - (BadPopCommand {pushed = assertion_context_number; to_pop = n}) loc - else - let old_env = env in - let env = Util.loop ~f:(fun _n () _env -> Stack.pop assertion_stack) - ~max:n ~elt:() ~init:env in - let td = {c = TPop(loc,n); annot = new_id () } in - (td,old_env) :: acc, env - - | Theory (loc, name, ext, l) -> - Options.tool_req 1 "TR-Typing-TheoryDecl$_F$"; - let tl = List.map (type_one_th_decl env) l in - let ext = match Util.th_ext_of_string ext with - | Some res -> res - | None -> - Errors.typing_error (ThExtError ext) loc - in - let td = {c = TTheory(loc, name, ext, tl); annot = new_id () } in - (td, env)::acc, env - - | Logic (loc, ac, lp, pp_ty) -> - Options.tool_req 1 "TR-Typing-LogicFun$_F$"; - let mk_symb hs = Symbols.name hs ~kind:ac in - let tlogic, env' = Env.add_logics env mk_symb lp pp_ty loc in - let lp = List.map fst lp in - let td = {c = TLogic(loc,lp,tlogic); annot = new_id () } in - (td, env)::acc, env' - - | Axiom(loc,name,ax_kd,f) -> - Options.tool_req 1 "TR-Typing-AxiomDecl$_F$"; - let f = type_form env f in - let td = {c = TAxiom(loc,name,ax_kd,f); annot = new_id () } in - (td, env)::acc, env - - | Rewriting(loc, name, lr) -> - let lf = List.map (type_form env) lr in - if Options.get_rewriting () then - let rules = List.map (fun f -> make_rules loc f) lf in - let td = {c = TRewriting(loc, name, rules); annot = new_id () } in - (td, env)::acc, env - else - axioms_of_rules loc name lf acc env - - | Goal (_loc, n, f) -> - Options.tool_req 1 "TR-Typing-GoalDecl$_F$"; - (*let f = move_up f in*) - let f = alpha_renaming_env env f in - type_and_intro_goal acc env Thm n f, env - - | Optimize (loc, expr, is_max) -> - Options.tool_req 1 "TR-Typing-Optimize$_F$"; - let expr = type_term env expr in - let td = { c = TOptimize (loc, expr, is_max); annot = new_id () } in - (td, env) :: acc, env - - | Check_sat(_loc, n, f) -> - Options.tool_req 1 "TR-Typing-CheckSatDecl$_F$"; - (*let f = move_up f in*) - let f = alpha_renaming_env env f in - type_and_intro_goal acc env Sat n f, env - - | MutRecDefs l -> - let rev_l, env = - List.fold_left ( - fun (acc, env) (loc,n,l,ret_ty,e) -> - let env, infix, tlogic = declare_fun env loc n ?ret_ty l in - (loc, n, l, tlogic, ret_ty, infix, e) :: acc, env - ) ([], env) l - in - List.fold_left ( - fun (acc, env) (loc, n, l, tlogic, ret_ty, infix, e) -> - define_fun (acc, env) loc n l tlogic ?ret_ty infix e - ) (acc, env) (List.rev rev_l) - - | Predicate_def(loc,n,l,e) -> - type_fun (acc, env) loc n l e - - | Function_def(loc,n,l,ret_ty,e) -> - type_fun (acc, env) loc n l ~ret_ty e - - | TypeDecl [] -> - assert false - - | TypeDecl [loc, ls, s, body] when not (is_recursive_type s body) -> - let body = refine_body_of_non_recursive_adt body in - Options.tool_req 1 "TR-Typing-TypeDecl$_F$"; - let ty1, env = Env.add_type_decl env ls s body loc in - let acc = ({c = TTypeDecl(loc, ty1); annot=new_id ()}, env) :: acc in - type_user_defined_type_body ~is_recursive:false env acc (loc, ls, s, body) - - | TypeDecl l -> - let not_rec, are_rec = partition_non_rec l in - - (* A. Typing types that are not recursive *) - let acc, env = - List.fold_left - (fun accu x -> - type_decl accu (TypeDecl [x]) assertion_stack) (acc, env) not_rec - in - - (* B. Typing types that are recursive *) - - (* step 1: with body == (Algebraic []) *) - let env, tyvars_of_ty = - List.fold_left - (fun (env, tyvars_of_ty) (loc, ls, s, _) -> - Types.to_tyvars := MString.empty; - let _, env = Env.add_type_decl env ls s (Parsed.Algebraic []) loc in - env, MString.add s !(Types.to_tyvars) tyvars_of_ty - )(env, MString.empty) are_rec - in - - (* step 2: right body, but without adding constrs and destrs *) - let acc, env = - List.fold_left - (fun (acc, env) (loc, ls, s, body) -> - Types.to_tyvars := - (try MString.find s tyvars_of_ty with Not_found -> assert false); - let tty, env = - Env.add_type_decl ~recursive:true env ls s body loc in - ({c = TTypeDecl(loc, tty); annot=new_id ()}, env)::acc, env - )(acc, env) are_rec - in - (* step 3: register constrs and destrs as function symbols *) - List.fold_left - (fun (acc, env) ty_d -> - type_user_defined_type_body ~is_recursive:true env acc ty_d) - (acc, env) are_rec - - | Reset l -> - let td = {c = TReset l; annot = new_id () } in - (td,Env.empty) :: acc, Env.empty - - | Exit l -> - let td = {c = TExit l; annot = new_id () } in - (td,env) :: acc, env - -let type_parsed env s d = - let l, env' = type_decl ([], env) d s in - List.rev_map fst l, env' - -let type_file ld = - let env = Env.empty in - let assertion_stack = Stack.create () in - let ltd, env = - List.fold_left - (fun acc d -> type_decl acc d assertion_stack) ([], env) ld - in - List.rev ltd, env - -let split_goals_aux f l = - let _, _, _, ret = - List.fold_left - (fun (ctx, global_hyp, local_hyp, ret) (td, env) -> - match td.c with - | TGoal (_, (Check | Cut), name, _) -> - ctx, global_hyp, [], - (f td env (local_hyp@global_hyp@ctx), name) :: ret - - | TGoal (_, _, name, _) -> - ctx, [], [], - (f td env (local_hyp@global_hyp@ctx), name) :: ret - - | TAxiom (_, s, _, _) when Ty.is_global_hyp s -> - ctx, (f td env global_hyp), local_hyp, - ret - - | TAxiom (_, s, _, _) when Ty.is_local_hyp s -> - ctx, global_hyp, (f td env local_hyp), - ret - - | _ -> - (f td env ctx), global_hyp, local_hyp, - ret - - ) ([],[],[],[]) l - in - List.rev_map (fun (l, goal_name) -> List.rev l, goal_name) ret - -let split_goals l = - split_goals_aux (fun e env acc -> (e, env) :: acc) l - -let split_goals_and_cnf l = - split_goals_aux (fun td _env acc -> Cnf.make acc td) l - -let type_expr env vars t = - let vmap = - List.fold_left - (fun m (s,ty)-> - let str = Symbols.to_string_clean s in - MString.add str (s,ty) m - ) env.Env.var_map vars in - let env = { env with Env.var_map = vmap } in - type_term env t - -type env = Env.t - -let empty_env = Env.empty diff --git a/src/lib/frontend/typechecker.mli b/src/lib/frontend/typechecker.mli deleted file mode 100644 index d5337fa958..0000000000 --- a/src/lib/frontend/typechecker.mli +++ /dev/null @@ -1,64 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -type env -(** The type of global environment of the typechecker. *) - -val empty_env : env -(** The empty/initial environment *) - -val type_expr : - env -> (Symbols.t * Ty.t) list -> Parsed.lexpr -> int Typed.atterm -(** Typecheck an input expression (i.e. term (or formula ?)), given - a local environment and a list of local types used to extend the - initial environment. - @raise Typing_error {!Errors.Typing_error} *) -(* TODO: give the env a proper module with binding functions, - so that the list argument can be ommitted ? *) - -val type_parsed : - env -> env Stack.t -> Parsed.decl -> int Typed.atdecl list * env -(** Type a single declaration. - @raise Typing_error {!Errors.Typing_error} *) - -val type_file : Parsed.file -> (int Typed.atdecl * env) list * env -(** Type an input file. Returns the successive global environments - obtained after typing each declaration. - @raise Typing_error {!Errors.Typing_error} *) - - -(* TODO: move these functions out of the typechecker *) -(* used by main_gui *) -val split_goals : - (int Typed.atdecl * 'a) list -> - ((int Typed.atdecl * 'a) list * string) list - -(* exported for compat with lib_usage.ml *) -val split_goals_and_cnf : - (int Typed.atdecl * 'a) list -> - (Commands.sat_tdecl list * string) list - diff --git a/src/lib/index.mld b/src/lib/index.mld index 12642cf8a7..fd456523f8 100644 --- a/src/lib/index.mld +++ b/src/lib/index.mld @@ -78,11 +78,8 @@ Finally, the native input method is defined in the {!module:AltErgoLib.Parsed_in and {!module:AltErgoLib.Typechecker} modules. {!modules: -AltErgoLib.Cnf +AltErgoLib.Translate AltErgoLib.Frontend -AltErgoLib.Input -AltErgoLib.Parsed_interface -AltErgoLib.Typechecker } @@ -117,10 +114,7 @@ AltErgoLib.Matching_types AltErgoLib.Shostak AltErgoLib.Ac AltErgoLib.Arith -AltErgoLib.Arrays AltErgoLib.Bitv -AltErgoLib.Enum -AltErgoLib.Ite AltErgoLib.Polynome AltErgoLib.Records AltErgoLib.Sig diff --git a/src/lib/reasoners/sig_rel.mli b/src/lib/reasoners/sig_rel.mli index c82f9fc800..1ae540b8c2 100644 --- a/src/lib/reasoners/sig_rel.mli +++ b/src/lib/reasoners/sig_rel.mli @@ -86,7 +86,20 @@ module type RELATION = sig val optimizing_objective : t -> Uf.t -> Objective.Function.t -> Th_util.optimized_split option (** [optimizing_split env uf o] tries to optimize objective [o]. - Returns [None] if the theory cannot optimize the objective. *) + Returns [None] if no theory knows how to optimize the objective. + + If the function returns [Some o] then the value of the optimized split + [o] is never [Unknown] because all the theories that support + optimization will always produce an answer even if this answer is not + the best value. + + For instance, if the objective is a nonlinear arithmetical + expressions of the form: + 5 * x * x + 2 * y + 3, + the arithmetic theory will translate this function into the linear + objective function: + 5 * U + 2 * y + 3 where U = x * x + and send it to Ocplib-simplex. *) val add : t -> Uf.t -> Shostak.Combine.r -> Expr.t -> t * Uf.GlobalDomains.t * diff --git a/src/lib/reasoners/theory.ml b/src/lib/reasoners/theory.ml index a0de55cdef..1693c209c2 100644 --- a/src/lib/reasoners/theory.ml +++ b/src/lib/reasoners/theory.ml @@ -617,25 +617,8 @@ module Main_Default : S = struct in match opt_split.value with | Unknown -> - (* In the current implementation of optimization, the function - [CC_X.optimizing_objective] cannot fail to optimize the objective - function [obj]. First of all, the legacy parser only accepts - optimization clauses on expressions of type [Real] or [Int]. - For the [Real] or [Int] expressions, we have two cases: - - If the objective function is a linear functions of variables, the - decision procedure implemented in Ocplib-simplex cannot fail to - optimize the split. For instance, if we try to maximize the - expression: - 5 * x + 2 * y + 3 where x and y are real variables, - the procedure will success to produce the upper bound of [x] and - [y] modulo the other constraints on it. - - If the objective function isn't linear, the nonlinear part of the - expression is seen as uninterpreted term of the arithmetic theory. - Let's imagine we try to maximize the expression: - 5 * x * x + 2 * y + 3, - The objective function given to Ocplib-simplex looks like: - 5 * U + 2 * y + 3 where U = x * x - and the procedure will optimize the problem in terms of U and y. *) + (* Cannot happen as [Rel.optimizing_objective] never returns an + unknown value. *) assert false | Pinfinity | Minfinity | Limit _ when not for_model -> diff --git a/src/lib/structures/expr.ml b/src/lib/structures/expr.ml index 7c726bafc4..2cd2be58eb 100644 --- a/src/lib/structures/expr.ml +++ b/src/lib/structures/expr.ml @@ -2346,7 +2346,7 @@ module Triggers = struct let content = TMap.fold (fun t _ acc -> t :: acc) res [] in let content = List.stable_sort pat_weight content in if Options.get_verbose () then - Printer.print_dbg ~module_name:"Cnf" + Printer.print_dbg ~module_name:"Translate" ~function_name:"clean_trigger" "AXIOM: %s@ \ from multi-trig of sz %d : %a@ \ diff --git a/src/lib/util/options.ml b/src/lib/util/options.ml index 95916e9cb4..cf9cdb0e4d 100644 --- a/src/lib/util/options.ml +++ b/src/lib/util/options.ml @@ -283,7 +283,6 @@ let output_with_colors = ref false let output_with_headers = ref true let output_with_formatting = ref true let output_with_forced_flush = ref true -let frontend = ref "dolmen" let input_format = ref None let parse_only = ref false let preludes = ref [] @@ -296,7 +295,6 @@ let set_output_with_colors b = output_with_colors := b let set_output_with_headers b = output_with_headers := b let set_output_with_formatting b = output_with_formatting := b let set_output_with_forced_flush b = output_with_forced_flush := b -let set_frontend f = frontend := f let set_input_format f = input_format := f let set_parse_only b = parse_only := b let set_preludes p = preludes := p @@ -310,7 +308,6 @@ let get_output_with_colors () = !output_with_colors let get_output_with_headers () = !output_with_headers let get_output_with_formatting () = !output_with_formatting let get_output_with_forced_flush () = !output_with_forced_flush -let get_frontend () = !frontend let get_input_format () = !input_format let get_parse_only () = !parse_only let get_preludes () = !preludes diff --git a/src/lib/util/options.mli b/src/lib/util/options.mli index e33dd5bf10..fdf8de25c8 100644 --- a/src/lib/util/options.mli +++ b/src/lib/util/options.mli @@ -202,9 +202,6 @@ val set_bottom_classes : bool -> unit (** Set [fm_cross_limit] accessible with {!val:get_fm_cross_limit} *) val set_fm_cross_limit : Numbers.Q.t -> unit -(** Set [frontend] accessible with {!val:get_frontend} *) -val set_frontend : string -> unit - (** Set [instantiation_heuristic ] accessible with {!val:get_instantiation_heuristic} *) val set_instantiation_heuristic : instantiation_heuristic -> unit @@ -627,10 +624,6 @@ val get_output_with_formatting : unit -> bool val get_output_with_forced_flush : unit -> bool (** Default to [true] *) -(** Valuget_e of the currently selected parsing and typing frontend. *) -val get_frontend : unit -> string -(** Default to [legacy] *) - (** Value specifying the default input format. Useful when the extension does not allow to automatically select a parser (eg. JS mode, GUI mode, ...). possible values are diff --git a/src/parsers/dune b/src/parsers/dune deleted file mode 100644 index 49f11a9747..0000000000 --- a/src/parsers/dune +++ /dev/null @@ -1,27 +0,0 @@ -(documentation - (package alt-ergo-parsers)) - -(ocamllex (modules native_lexer)) - -(menhir - (infer true) - (flags --fixed-exception) - (modules native_parser) -) - -(library - (name AltErgoParsers) - (public_name alt-ergo-parsers) - (libraries - dynlink - psmt2-frontend - alt-ergo-lib - stdlib-shims) - (modules - ; common - Parsers - ; psmt2 - Psmt2_to_alt_ergo - ; AE format - Native_lexer Native_parser) -) diff --git a/src/parsers/index.mld b/src/parsers/index.mld deleted file mode 100644 index ae57fc2e1d..0000000000 --- a/src/parsers/index.mld +++ /dev/null @@ -1,29 +0,0 @@ -{1 Alt-ergo-parsers} - -Since version 2.2.0, a specific package containing the code for the -alt-ergo native language parser is installed separately. This package also contains an interface with the library {{:https://github.com/OCamlPro-Coquera/psmt2-frontend}[psmt2-frontend]} and a way to dynamicaly load parsers into Alt-Ergo - -{2 Parsers loader} -{!modules:AltErgoParsers.Parsers} -offer an interface to register a parser - -{3 Native input parser} -The native input language of Alt-Ergo is defined by these two following modules : -{!modules: -AltErgoParsers.Native_parser -AltErgoParsers.Native_lexer -} - -{3 SMT-LIB2 input parser} -{!modules: -AltErgoParsers.Psmt2_to_alt_ergo -} -Offer an interface with the library {{:https://github.com/OCamlPro-Coquera/psmt2-frontend}[psmt2-frontend]} and register a parser for smt2 and psmt2 extensions. This interface allows Alt-Ergo to partially support the SMT-LIB2 standard and a polymorphic extension. - -{3 Dynamicly link parser} -Users can add new parsers to Alt-Ergo with the option [--add-parser]. -This parser should have the same interface as {!module-type:AltErgoParsers.Parsers.PARSER_INTERFACE} and should be registered using {!val:AltErgoParsers.Parsers.register_parser} - -{4 Why3 parser plugin} - -See {{:../alt-ergo-plugin-ab-why3/index.html}[the ABWhy3 plugin]}. diff --git a/src/parsers/native_lexer.mll b/src/parsers/native_lexer.mll deleted file mode 100644 index a66bab2621..0000000000 --- a/src/parsers/native_lexer.mll +++ /dev/null @@ -1,279 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -{ - [@@@ocaml.warning "-33"] - open AltErgoLib - open Options - - open Lexing - open Native_parser - - let assoc_keyword = - let tbl : (string, Native_parser.token) Hashtbl.t = Hashtbl.create 256 in - let kw_list = - [ - "ac" , AC; - "and" , AND; - "axiom" , AXIOM; - "bitv" , BITV; - "bool" , BOOL; - "case_split" , CASESPLIT; - "check" , CHECK; - "check_sat" , CHECK_SAT; - "cut" , CUT; - "distinct" , DISTINCT; - "else" , ELSE; - "end" , END; - "exists" , EXISTS; - "extends" , EXTENDS; - "false" , FALSE; - "forall" , FORALL; - "function" , FUNC; - "goal" , GOAL; - "if" , IF; - "in" , IN; - "int" , INT; - "let" , LET; - "logic" , LOGIC; - "not" , NOT; - "or" , OR; - "xor" , XOR; - "predicate" , PRED; - "prop" , PROP; - "real" , REAL; - "rewriting" , REWRITING; - "then" , THEN; - "theory" , THEORY; - "true" , TRUE; - "type" , TYPE; - "unit" , UNIT; - "void" , VOID; - "match" , MATCH; - "with" , WITH; - "of" , OF; - ] - in - List.iter (fun (s, kw) -> Hashtbl.add tbl s kw) kw_list; - fun tok -> Hashtbl.find tbl tok - - let mk_new_line lexbuf = - let p = lexbuf.lex_curr_p in - let p = { p with pos_lnum = p.pos_lnum + 1; pos_bol = p.pos_cnum } in - lexbuf.lex_curr_p <- p - - let escaped_char = function - | 'n' -> '\n' - | 'r' -> '\r' - | 't' -> '\t' - | c -> c - - let n_zero, n_ten, n_16 = Numbers.Q.(from_int 0, from_int 10, from_int 16) - - let decimal_number s = - let r = ref n_zero in - for i=0 to String.length s - 1 do - let c = Char.(code s.[i] - code '0') in - r := Numbers.Q.(add (mult n_ten !r) (from_int c)) - done; - !r - - let hexa_number s = - let r = ref n_zero in - for i=0 to String.length s - 1 do - let c = s.[i] in - let v = - match c with - | '0'..'9' -> Char.code c - Char.code '0' - | 'a'..'f' -> Char.code c - Char.code 'a' + 10 - | 'A'..'F' -> Char.code c - Char.code 'A' + 10 - | _ -> assert false - in - r := Numbers.Q.(add (mult n_16 !r) (from_int v)) - done; - !r - -} - -let alphabet = ['a'-'z' 'A'-'Z'] -let digit = ['0'-'9'] -let hexadecimal = digit | ['a'-'f''A'-'F'] -let identifier = (alphabet | '_') (alphabet | '_' | digit | '?' | '\'')* - -rule parse_token = parse - | '\n' { mk_new_line lexbuf; parse_token lexbuf } - | [' ' '\t' '\r']+ { parse_token lexbuf } - | '?' { QM } - | '?' identifier as id { QM_ID id } - | identifier as i { try assoc_keyword i with Not_found -> ID i } - | digit+ as s { INTEGER s } - - | (digit+ as i) ("" as f) ['e' 'E'] (['-' '+']? as sign (digit+ as exp)) - | (digit+ as i) '.' (digit* as f) - (['e' 'E'] (['-' '+']? as sign (digit+ as exp)))? - | (digit* as i) '.' (digit+ as f) - (['e' 'E'] (['-' '+']? as sign (digit+ as exp)))? - (* decimal real literals *) - { - let v = - match exp,sign with - | Some exp,Some "-" -> - Numbers.(Q.div (decimal_number (i^f)) - (Q.from_z (Z.power (Z.from_int 10) (int_of_string exp)))) - | Some exp,_ -> - Numbers.(Q.mult (decimal_number (i^f)) - (Q.from_z (Z.power (Z.from_int 10) (int_of_string exp)))) - | None,_ -> decimal_number (i^f) - in - let v = - Numbers.(Q.div v (Q.from_z (Z.power (Z.from_int 10) - (String.length f)))) - in - NUM v - } - - (* hexadecimal real literals a la C99 (0x..p..) *) - | "0x" (hexadecimal+ as e) ('.' (hexadecimal* as f))? - ['p''P'] (['+''-']? as sign) (digit+ as exp) - { - let f = match f with None -> "" | Some f -> f in - let v = - match sign with - | "-" -> - Numbers.(Q.div (hexa_number (e^f)) - (Q.from_z (Z.power (Z.from_int 2) (int_of_string exp)))) - | _ -> - Numbers.(Q.mult (hexa_number (e^f)) - (Q.from_z (Z.power (Z.from_int 2) (int_of_string exp)))) - in - let v = - Numbers.(Q.div v (Q.from_z (Z.power (Z.from_int 16) - (String.length f)))) - in - NUM v - } - | "(*" { parse_comment lexbuf; parse_token lexbuf } - | "'" { QUOTE } - | "," { COMMA } - | ";" { PV } - | "(" { LEFTPAR } - | ")" { RIGHTPAR } - | ":" { COLON } - | "->" { RIGHTARROW } - | "<-" { LEFTARROW } - | "<->" { LRARROW } - | "=" { EQUAL } - | "<" { LT } - | "<=" { LE } - | ">" { GT } - | ">=" { GE } - | "<>" { NOTEQ } - | "+" { PLUS } - | "-" { MINUS } - | "*" { TIMES } - | "**." { POWDOT } - | "**" { POW } - | "/" { SLASH } - | "%" { PERCENT } - | "@" { AT } - | "." { DOT } - | "#" { SHARP } - | "[" { LEFTSQ } - | "]" { RIGHTSQ } - | "{" { LEFTBR } - | "}" { RIGHTBR } - | "|" { BAR } - | "^" { HAT } - | "|->" { MAPS_TO } - | "\"" { parse_string (Buffer.create 1024) lexbuf } - | eof { EOF } - | _ as c { - let loc = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf) in - let s = "illegal character: " ^ String.make 1 c in - Errors.error (Errors.Lexical_error (loc, s)) - } - -and parse_comment = parse - | "*)" { () } - | "(*" { parse_comment lexbuf; parse_comment lexbuf } - | '\n' { mk_new_line lexbuf; parse_comment lexbuf } - | eof { - let loc = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf) in - Errors.error (Errors.Lexical_error (loc, "unterminated comment")) - } - | _ { parse_comment lexbuf } - -and parse_string str_buf = parse - | "\"" { STRING (Buffer.contents str_buf) } - | "\\" (_ as c) { - Buffer.add_char str_buf (escaped_char c); - parse_string str_buf lexbuf - } - - | '\n' { - mk_new_line lexbuf; - Buffer.add_char str_buf '\n'; - parse_string str_buf lexbuf - } - - | eof { - let loc = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf) in - Errors.error (Errors.Lexical_error (loc, "unterminated string")) - } - - | _ as c { - Buffer.add_char str_buf c; parse_string str_buf lexbuf - } - -{ - - module Parser : Parsers.PARSER_INTERFACE = struct - - let aux aux_fun token lexbuf = - try - let res = aux_fun token lexbuf in - Parsing.clear_parser (); - res - with - (* The --fixed-error flag makes menhir alias - the exception Error to Parsing.Parse_error *) - | Parsing.Parse_error -> - let loc = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf) in - let lex = Lexing.lexeme lexbuf in - Parsing.clear_parser (); - Errors.error (Errors.Syntax_error (loc, lex)) - - let file = aux Native_parser.file_parser parse_token - let expr = aux Native_parser.lexpr_parser parse_token - let trigger = aux Native_parser.trigger_parser parse_token - end - - let register_native () = - (*register this parser in Input_lang: 3 different extensions recognized *) - let p = (module Parser : Parsers.PARSER_INTERFACE) in - Parsers.register_parser ~lang:".ae" p -} diff --git a/src/parsers/native_parser.mly b/src/parsers/native_parser.mly deleted file mode 100644 index f595138b74..0000000000 --- a/src/parsers/native_parser.mly +++ /dev/null @@ -1,575 +0,0 @@ -/**************************************************************************/ -/* */ -/* Alt-Ergo: The SMT Solver For Software Verification */ -/* Copyright (C) --- OCamlPro SAS */ -/* */ -/* This file is distributed under the terms of OCamlPro */ -/* Non-Commercial Purpose License, version 1. */ -/* */ -/* As an exception, Alt-Ergo Club members at the Gold level can */ -/* use this file under the terms of the Apache Software License */ -/* version 2.0. */ -/* */ -/* --------------------------------------------------------------- */ -/* */ -/* The Alt-Ergo theorem prover */ -/* */ -/* Sylvain Conchon, Evelyne Contejean, Francois Bobot */ -/* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout */ -/* */ -/* CNRS - INRIA - Universite Paris Sud */ -/* */ -/* --------------------------------------------------------------- */ -/* */ -/* More details can be found in the directory licenses/ */ -/* */ -/**************************************************************************/ - -%{ - [@@@ocaml.warning "-33"] - open AltErgoLib - open Options - open Parsed_interface -%} - -/* Tokens */ - -%token ID -%token QM_ID -%token INTEGER -%token NUM -%token STRING -%token MATCH WITH THEORY EXTENDS END QM -%token AND LEFTARROW RIGHTARROW AC AT AXIOM CASESPLIT REWRITING -%token BAR HAT -%token BOOL COLON COMMA PV DISTINCT DOT SHARP ELSE OF EOF EQUAL -%token EXISTS FALSE VOID FORALL FUNC GE GOAL CHECK_SAT GT CHECK CUT -%token IF IN INT BITV MAPS_TO -%token LE LET LEFTPAR LEFTSQ LEFTBR LOGIC LRARROW XOR LT MINUS -%token NOT NOTEQ OR PERCENT PLUS PRED PROP -%token QUOTE REAL UNIT -%token RIGHTPAR RIGHTSQ RIGHTBR -%token SLASH POW POWDOT -%token THEN TIMES TRUE TYPE - -/* Precedences */ - -%nonassoc IN -%nonassoc prec_forall prec_exists -%right RIGHTARROW LRARROW XOR -%right OR -%right AND -%nonassoc prec_ite -%left prec_relation EQUAL NOTEQ LT LE GT GE -%left PLUS MINUS -%left TIMES SLASH PERCENT POW POWDOT AT -%nonassoc HAT -%nonassoc uminus -%nonassoc NOT -%right prec_named -%nonassoc CHECK CUT - - -/* Entry points */ - -%type trigger_parser -%start trigger_parser - -%type lexpr_parser -%start lexpr_parser - -%type file_parser -%start file_parser -%% - -file_parser: -| decls = list1_decl EOF { decls } -| EOF { [] } - -trigger_parser: -| trigger = trigger EOF { trigger } - -lexpr_parser: -| e = lexpr EOF { e } - -list1_decl: -| decl = decl { [decl] } -| decl = decl decls = list1_decl { decl :: decls } - -decl: -| THEORY th_id = ident EXTENDS th_ext = ident EQUAL th_body = theory_elts END - { mk_theory ($startpos, $endpos) th_id th_ext th_body } - -| TYPE ty_vars = type_vars ty = ident - { mk_abstract_type_decl ($startpos, $endpos) ty_vars ty } - -| TYPE ty_vars = type_vars ty = ident EQUAL enum = list1_constructors_sep_bar - others = and_recursive_ty_opt - { - match others with - | [] -> - mk_algebraic_type_decl ($startpos, $endpos) ty_vars ty enum - | l -> - let l = (($startpos, $endpos), ty_vars, ty, enum) :: l in - let l = - List.map - (fun (a, b, c, d) -> - match mk_algebraic_type_decl a b c d with - | Parsed.TypeDecl [e] -> e - | _ -> assert false - ) l - in - mk_rec_type_decl l - } - -| TYPE ty_vars = type_vars ty = ident EQUAL record = record_type - { mk_record_type_decl ($startpos, $endpos) ty_vars ty record } - -| LOGIC is_ac = ac_modifier ids = list1_named_ident_sep_comma COLON - ty = logic_type - { mk_logic ($startpos, $endpos) is_ac ids ty } - -| FUNC app=named_ident LEFTPAR args=list0_logic_binder_sep_comma RIGHTPAR - COLON ret_ty = primitive_type EQUAL body = lexpr - others = and_recursive_def_opt - { match others with - | [] -> mk_function_def ($startpos, $endpos) app args ret_ty body - | _ -> - mk_mut_rec_def - ((($startpos, $endpos), app, args, Some ret_ty, body) :: others)} - -| PRED app = named_ident EQUAL body = lexpr - { mk_ground_predicate_def ($startpos, $endpos) app body } - -| PRED app = named_ident LEFTPAR args = list0_logic_binder_sep_comma RIGHTPAR - EQUAL body = lexpr others = and_recursive_def_opt - { match others with - | [] -> mk_non_ground_predicate_def ($startpos, $endpos) app args body - | _ -> - mk_mut_rec_def - ((($startpos, $endpos), app, args, None, body) :: others)} - -| AXIOM name = ident COLON body = lexpr - { mk_generic_axiom ($startpos, $endpos) name body } - -| REWRITING name = ident COLON body = list1_lexpr_sep_pv - { mk_rewriting ($startpos, $endpos) name body } - -| GOAL name = ident COLON body = lexpr - { mk_goal ($startpos, $endpos) name body } - -| CHECK_SAT name = ident COLON body = lexpr - { mk_check_sat ($startpos, $endpos) name body } - -theory_elts: -| /* */ { [] } -| th_elt = theory_elt th_rest = theory_elts { th_elt :: th_rest } - -theory_elt: -| AXIOM name = ident COLON body = lexpr - { mk_theory_axiom ($startpos, $endpos) name body } - -| CASESPLIT name = ident COLON body = lexpr - { mk_theory_case_split ($startpos, $endpos) name body } - - -ac_modifier: -| /* */ { Symbols.Other } -| AC { Symbols.Ac } - -primitive_type: -| INT { int_type } -| BOOL { bool_type } -| REAL { real_type } -| UNIT { unit_type } -| BITV LEFTSQ sz = INTEGER RIGHTSQ { mk_bitv_type sz } - -| ext_ty = ident { mk_external_type ($startpos, $endpos) [] ext_ty } - -| alpha = type_var { mk_var_type ($startpos, $endpos) alpha } - -| par = primitive_type ext_ty = ident - { mk_external_type ($startpos(ext_ty), $endpos(ext_ty)) [par] ext_ty } - -| LEFTPAR pars = list1_primitive_type_sep_comma RIGHTPAR ext_ty = ident - { mk_external_type ($startpos(ext_ty), $endpos(ext_ty)) pars ext_ty } - -logic_type: -| ty_list = list0_primitive_type_sep_comma RIGHTARROW PROP - { mk_logic_type ty_list None } - -| PROP { mk_logic_type [] None } - -| ty_list = list0_primitive_type_sep_comma RIGHTARROW ret_ty = primitive_type - { mk_logic_type ty_list (Some ret_ty) } - -| ret_ty = primitive_type - { mk_logic_type [] (Some ret_ty) } - -list1_primitive_type_sep_comma: -| ty = primitive_type { [ty] } -| ty = primitive_type COMMA ty_l = list1_primitive_type_sep_comma { ty::ty_l } - -list0_primitive_type_sep_comma: -| { [] } -| ty_l = list1_primitive_type_sep_comma { ty_l } - -list0_logic_binder_sep_comma: -| { [] } -| binders_l = list1_logic_binder_sep_comma { binders_l } - -list1_logic_binder_sep_comma: -| binder = logic_binder - { [binder] } -| binder = logic_binder COMMA binders_list = list1_logic_binder_sep_comma - { binder :: binders_list } - -logic_binder: -| id = ident COLON ty = primitive_type - { (($startpos(id), $endpos(id)), id, ty) } - -list1_constructors_sep_bar: -| cons = ident algebraic_args { [cons, $2] } -| cons = ident algebraic_args BAR cons_l = list1_constructors_sep_bar - { (cons, $2) :: cons_l } - -algebraic_args: -| { [] } -| OF record_type { $2 } - -and_recursive_ty_opt: - | { [] } - | AND ty_vars = type_vars ty = ident EQUAL enum = list1_constructors_sep_bar - others = and_recursive_ty_opt - { (($startpos, $endpos), ty_vars, ty, enum) :: others} - -and_recursive_def_opt: - | { [] } - | AND PRED app=named_ident LEFTPAR args=list0_logic_binder_sep_comma RIGHTPAR - EQUAL body = lexpr others = and_recursive_def_opt - { (($startpos, $endpos), app, args, None, body) :: others } - | AND FUNC app=named_ident LEFTPAR args=list0_logic_binder_sep_comma RIGHTPAR - COLON ret_ty = primitive_type EQUAL body = lexpr - others = and_recursive_def_opt - { (($startpos, $endpos), app, args, Some ret_ty, body) :: others } - -lexpr: - -| se = simple_expr { se } - -/* binary operators */ - -| se1 = lexpr PLUS se2 = lexpr - { mk_add ($startpos, $endpos) se1 se2 } - -| se1 = lexpr MINUS se2 = lexpr - { mk_sub ($startpos, $endpos) se1 se2 } - -| se1 = lexpr TIMES se2 = lexpr - { mk_mul ($startpos, $endpos) se1 se2 } - -| se1 = lexpr SLASH se2 = lexpr - { mk_div ($startpos, $endpos) se1 se2 } - -| se1 = lexpr PERCENT se2 = lexpr - { mk_mod ($startpos, $endpos) se1 se2 } - -| se1 = lexpr POW se2 = lexpr - { mk_pow_int ($startpos, $endpos) se1 se2 } - -| se1 = lexpr POWDOT se2 = lexpr - { mk_pow_real ($startpos, $endpos) se1 se2 } - -| se1 = lexpr AND se2 = lexpr - { mk_and ($startpos, $endpos) se1 se2 } - -| se1 = lexpr OR se2 = lexpr - { mk_or ($startpos, $endpos) se1 se2 } - -| se1 = lexpr XOR se2 = lexpr - { mk_xor ($startpos, $endpos) se1 se2 } - -| se1 = lexpr LRARROW se2 = lexpr - { mk_iff ($startpos, $endpos) se1 se2 } - -| se1 = lexpr RIGHTARROW se2 = lexpr - { mk_implies ($startpos, $endpos) se1 se2 } - -| se1 = lexpr LT se2 = lexpr %prec prec_relation - { mk_pred_lt ($startpos, $endpos) se1 se2 } - -| se1 = lexpr LE se2 = lexpr %prec prec_relation - { mk_pred_le ($startpos, $endpos) se1 se2 } - -| se1 = lexpr GT se2 = lexpr %prec prec_relation - { mk_pred_gt ($startpos, $endpos) se1 se2 } - -| se1 = lexpr GE se2 = lexpr %prec prec_relation - { mk_pred_ge ($startpos, $endpos) se1 se2 } - -| se1 = lexpr EQUAL se2 = lexpr %prec prec_relation - { mk_pred_eq ($startpos, $endpos) se1 se2 } - -| se1 = lexpr NOTEQ se2 = lexpr %prec prec_relation - { mk_pred_not_eq ($startpos, $endpos) se1 se2 } - -| NOT se = lexpr - { mk_not ($startpos, $endpos) se } - -| MINUS se = lexpr %prec uminus - { mk_minus ($startpos, $endpos) se } - -/* bit vectors */ - -| LEFTSQ BAR bv_cst = INTEGER BAR RIGHTSQ - { mk_bitv_const ($startpos, $endpos) bv_cst } - -| e = lexpr HAT LEFTBR i = INTEGER COMMA j = INTEGER RIGHTBR - { mk_bitv_extract ($startpos, $endpos) e i j } - -| e1 = lexpr AT e2 = lexpr - { mk_bitv_concat ($startpos, $endpos) e1 e2 } - -/* predicate or function calls */ - -| DISTINCT LEFTPAR dist_l = list2_lexpr_sep_comma RIGHTPAR - { mk_distinct ($startpos, $endpos) dist_l } - -| IF cond = lexpr THEN br1 = lexpr ELSE br2 = lexpr %prec prec_ite - { mk_ite ($startpos, $endpos) cond br1 br2 } - -| FORALL quant_vars = list1_multi_logic_binder - triggers = triggers filters = filters DOT body = lexpr %prec prec_forall - { - let vs_ty = - List.map (fun (vs, ty) -> - List.map (fun (v, name) -> v, name, ty) vs) quant_vars - in - let vs_ty = List.flatten vs_ty in - mk_forall ($startpos, $endpos) vs_ty triggers filters body - } - -| EXISTS quant_vars = list1_multi_logic_binder - triggers = triggers filters = filters DOT body = lexpr %prec prec_exists - { - let vs_ty = - List.map (fun (vs, ty) -> - List.map (fun (v, name) -> v, name, ty) vs) quant_vars - in - let vs_ty = List.flatten vs_ty in - mk_exists ($startpos, $endpos) vs_ty triggers filters body - } - -| name = STRING COLON e = lexpr %prec prec_named - { mk_named ($startpos, $endpos) name e } - -| LET binders = let_binders IN e2 = lexpr - { mk_let ($startpos, $endpos) binders e2 } - -| CHECK e = lexpr - { mk_check ($startpos, $endpos) e } - -| CUT e = lexpr - { mk_cut ($startpos, $endpos) e } - -/* match */ -| MATCH e = lexpr WITH cases = list1_match_cases END - { mk_match ($startpos, $endpos) e (List.rev cases) } - -list1_match_cases: -| p = simple_pattern RIGHTARROW e = lexpr { [p, e]} -| BAR p = simple_pattern RIGHTARROW e = lexpr { [p, e]} -| l = list1_match_cases BAR p = simple_pattern RIGHTARROW e = lexpr - { (p,e) :: l } - -simple_pattern: -| id = ident { mk_pattern ($startpos, $endpos) id [] } -| app = ident LEFTPAR args = list1_string_sep_comma RIGHTPAR - { mk_pattern ($startpos, $endpos) app args } - - -let_binders: -| binder = ident EQUAL e = lexpr { [binder, e] } -| binder = ident EQUAL e = lexpr COMMA l = let_binders { (binder, e) :: l } - -simple_expr : -| i = INTEGER { mk_int_const ($startpos, $endpos) i } -| i = NUM { mk_real_const ($startpos, $endpos) i } -| TRUE { mk_true_const ($startpos, $endpos) } -| FALSE { mk_false_const ($startpos, $endpos) } -| VOID { mk_void ($startpos, $endpos) } -| var = ident { mk_var ($startpos, $endpos) var } - -/* records */ - -| LEFTBR labels = list1_label_expr_sep_PV RIGHTBR - { mk_record ($startpos, $endpos) labels } - -| LEFTBR se = simple_expr WITH labels = list1_label_expr_sep_PV RIGHTBR - { mk_with_record ($startpos, $endpos) se labels } - -| se = simple_expr DOT label = ident - { mk_dot_record ($startpos, $endpos) se label } - -/* function or predicat calls */ - -| app = ident LEFTPAR args = list0_lexpr_sep_comma RIGHTPAR - { mk_application ($startpos, $endpos) app args } - -/* arrays */ - -| se = simple_expr LEFTSQ e = lexpr RIGHTSQ - { mk_array_get ($startpos, $endpos) se e } - -| se = simple_expr LEFTSQ assigns = array_assignements RIGHTSQ - { - let acc, l = - match assigns with - | [] -> assert false - | (i, v)::l -> mk_array_set ($startpos, $endpos) se i v, l - in - List.fold_left (fun acc (i,v) -> - mk_array_set ($startpos, $endpos) acc i v) acc l - } - -| LEFTPAR e = lexpr RIGHTPAR - { e } - -| se = simple_expr COLON ty = primitive_type - { mk_type_cast ($startpos, $endpos) se ty } - -| se = simple_expr QM id = ident - { mk_algebraic_test ($startpos, $endpos) se id } - -| se = simple_expr id = QM_ID - { mk_algebraic_test ($startpos, $endpos) se id } - -| se = simple_expr SHARP label = ident - { mk_algebraic_project ($startpos, $endpos) se label } -array_assignements: -| assign = array_assignement - { [assign] } -| assign = array_assignement COMMA assign_l = array_assignements - { assign :: assign_l } - -array_assignement: -| e1 = lexpr LEFTARROW e2 = lexpr { e1, e2 } - -triggers: -| { [] } -| LEFTSQ trigs = list1_trigger_sep_bar RIGHTSQ { trigs } - - -filters: -| - { [] } -| LEFTBR filt = lexpr RIGHTBR - { [filt] } -| LEFTBR filt = lexpr COMMA filt_l = list0_lexpr_sep_comma RIGHTBR - { filt :: filt_l } - -list1_trigger_sep_bar: -| trig = trigger { [trig] } -| trig = trigger BAR trigs = list1_trigger_sep_bar { trig :: trigs } - -trigger: -| terms = list1_lexpr_or_dom_sep_comma - { terms, true (* true <-> user-given trigger *) } - -list1_lexpr_sep_pv: -| e = lexpr { [e] } -| e = lexpr PV { [e] } -| e = lexpr PV e_l = list1_lexpr_sep_pv { e :: e_l } - -list0_lexpr_sep_comma: -| { [] } -| l = list1_lexpr_sep_comma { l } - -list1_lexpr_sep_comma: -| e = lexpr { [e] } -| e = lexpr COMMA l = list1_lexpr_sep_comma { e :: l } - -list1_lexpr_or_dom_sep_comma: -| ed = lexpr_or_dom { [ed] } -| ed = lexpr_or_dom COMMA edl = list1_lexpr_or_dom_sep_comma { ed :: edl } - -lexpr_or_dom: -| e = lexpr - { e } -| e = lexpr IN lbr = sq lbnd = bound COMMA rbnd = bound rbr = sq - { mk_in_interval ($startpos, $endpos) e lbr lbnd rbnd rbr } -| id = ident MAPS_TO e = lexpr - { mk_maps_to ($startpos, $endpos) id e } - - -sq: -| LEFTSQ {true} -| RIGHTSQ {false} - -bound: -| QM { mk_var ($startpos, $endpos) "?" } -| id = QM_ID { mk_var ($startpos, $endpos) id } -| id = ID { mk_var ($startpos, $endpos) id } -| i = INTEGER { mk_int_const ($startpos, $endpos) i } -| i = NUM { mk_real_const ($startpos, $endpos) i } -| MINUS i = INTEGER { mk_int_const ($startpos, $endpos) i } -| MINUS i = NUM { mk_real_const ($startpos, $endpos) i } - -list2_lexpr_sep_comma: -| e1 = lexpr COMMA e2 = lexpr { [e1; e2] } -| e = lexpr COMMA el = list2_lexpr_sep_comma { e :: el } - -record_type: -| LEFTBR labels = list1_label_sep_PV RIGHTBR { labels } - -list1_label_sep_PV: -| label_typed = label_with_type { [label_typed] } -| lt = label_with_type PV list_lt = list1_label_sep_PV { lt :: list_lt } - -label_with_type: -| id = ident COLON ty = primitive_type { id, ty } - - -list1_label_expr_sep_PV: -| id = ident EQUAL e = lexpr - { [id, e] } -| id = ident EQUAL e = lexpr PV l = list1_label_expr_sep_PV - { (id, e) :: l } - -type_var: -| QUOTE alpha = ident { alpha } - -type_vars: -| { [] } -| alpha = type_var { [alpha] } -| LEFTPAR l = list1_type_var_sep_comma RIGHTPAR { l } - -list1_type_var_sep_comma: -| alpha = type_var { [alpha] } - | alpha = type_var COMMA l = list1_type_var_sep_comma { alpha :: l } - -ident: -| id = ID { id } - -multi_logic_binder: -| binders = list1_named_ident_sep_comma COLON ty = primitive_type - { binders, ty } - -list1_multi_logic_binder: -| binders = multi_logic_binder - { [binders] } -| binders = multi_logic_binder COMMA l = list1_multi_logic_binder - { binders :: l } - -list1_named_ident_sep_comma: -| id = named_ident { [id] } - | id = named_ident COMMA l = list1_named_ident_sep_comma { id :: l } - -list1_string_sep_comma: -| id = ident - { [ id ] } -| id = ident COMMA l = list1_string_sep_comma { id :: l } - -named_ident: -| id = ID { id, "" } -| id = ID str = STRING { id, str } diff --git a/src/parsers/parsers.ml b/src/parsers/parsers.ml deleted file mode 100644 index 51bd7286c8..0000000000 --- a/src/parsers/parsers.ml +++ /dev/null @@ -1,153 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -open AltErgoLib -open Options -open Errors - -module type PARSER_INTERFACE = sig - val file : Lexing.lexbuf -> Parsed.file - val expr : Lexing.lexbuf -> Parsed.lexpr - val trigger : Lexing.lexbuf -> Parsed.lexpr list * bool -end - -let parsers = ref ([] : (string * (module PARSER_INTERFACE)) list) - -let register_parser ~lang new_parser = - if List.mem_assoc lang !parsers then - begin - Printer.print_wrn - "A parser for extension %S is already registered. \ - It will be hidden !" lang; - end; - parsers := (lang, new_parser) :: !parsers - -let find_parser ext_opt format = - try List.assoc ext_opt !parsers - with Not_found -> - if String.equal ext_opt ".why" then begin - Printer.print_wrn - "please use the AB-Why3 plugin for file in Why3 format. \ - .why and .mlw extensions are depreciated and used for Why3 files. \ - Continue with native Alt-Ergo parsers!"; - try List.assoc ".ae" !parsers - with Not_found -> - error (Parser_error ("Error: no parser registered for the provided \ - input format %S ?@."^format)) - end else - error (Parser_error ("Error: no parser registered for the provided \ - input format %S ?@."^format)) - -let set_output_format fmt = - if Options.get_infer_output_format () then - match fmt with - | Options.Unknown s -> - Printer.print_wrn - "The output format %s is not supported" s - | fmt -> Options.set_output_format fmt - -let get_input_parser fmt = - set_output_format fmt; - match fmt with - | Options.Native -> find_parser ".ae" "native" - | Options.Smtlib2 _ -> - (* NB: the legacy frontend is always using psmt2 *) - find_parser ".smt2" "smtlib2" - | Options.Why3 -> find_parser ".why" "why3" - | Options.Unknown s -> find_parser s s - -let get_parser ext_opt = - match Options.get_input_format () with - | Some input_format -> get_input_parser input_format - | None -> - match ext_opt with - | Some ext -> - get_input_parser (Options.match_extension ext) - | None -> - error - (Parser_error "Error: no extension found, can't infer input format@.") - -let parse_file ?lang lexbuf = - let module Parser = (val get_parser lang : PARSER_INTERFACE) in - Parser.file lexbuf - -let parse_expr ?lang lexbuf = - let module Parser = (val get_parser lang : PARSER_INTERFACE) in - Parser.expr lexbuf - -let parse_trigger ?lang lexbuf = - let module Parser = (val get_parser lang : PARSER_INTERFACE) in - Parser.trigger lexbuf - -let parse_input_file file = - if get_verbose () then - Printer.print_dbg - ~module_name:"Parsers" ~function_name:"parse_input_file" - "parsing file \"%s\"" file; - let cin, lb, opened_cin, ext = - if Filename.check_suffix file ".zip" then - let ext = Filename.extension (Filename.chop_extension file) in - let file_content = My_zip.extract_zip_file file in - stdin, Lexing.from_string file_content, false, ext - else - let ext = Filename.extension file in - if not (String.equal file "") then - let cin = open_in file in - cin, Lexing.from_channel cin, true, ext - else - stdin, Lexing.from_channel stdin, false, ext - in - try - let ext = if String.equal ext "" then None else Some ext in - let a = parse_file ?lang:ext lb in - if opened_cin then close_in cin; - a - with - | Errors.Error e -> - if opened_cin then close_in cin; - raise (Error e) - - | Parsing.Parse_error as e -> - if opened_cin then close_in cin; - raise e - -let parse_problem ~filename ~preludes = - let acc = parse_input_file filename in - List.fold_left - (fun acc prelude -> - List.rev_append (List.rev (parse_input_file prelude)) acc) - acc (List.rev preludes) - -let parse_problem_as_string ~content ~format = - try - let lb = Lexing.from_string content in - parse_file ?lang:format lb - with - | Errors.Error e -> - Format.printf "%a" Errors.report e; - raise (Error e) - | Parsing.Parse_error as e -> raise e diff --git a/src/parsers/parsers.mli b/src/parsers/parsers.mli deleted file mode 100644 index 0784de5bc0..0000000000 --- a/src/parsers/parsers.mli +++ /dev/null @@ -1,73 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -open AltErgoLib - -module type PARSER_INTERFACE = sig - val file : Lexing.lexbuf -> Parsed.file - val expr : Lexing.lexbuf -> Parsed.lexpr - val trigger : Lexing.lexbuf -> Parsed.lexpr list * bool -end -(** The interface that should be provided by every lexer/parser of an - input language *) - -val register_parser : lang:string -> (module PARSER_INTERFACE) -> unit -(** Registers a new 'parser' for the given extension/language *) - -val parse_file : ?lang:string -> Lexing.lexbuf -> Parsed.file -(** Parses the given file (lexbuf) using the appropriate 'parser' - depending on the given language (set from extension) or - the format set with the --input option. - If no output format is set with the --output option, we set it depending - on the extension / input format. by default if an input format is set - results will be printed according this input format. - @raise Errors.Parser_error *) - -val parse_expr : ?lang:string -> Lexing.lexbuf -> Parsed.lexpr -(** Parses the given expression (lexbuf) using the appropriate 'parser' - depending on the given language. If no language is given, the - default one is used. - @raise Errors.Parser_error *) - -val parse_trigger : ?lang:string -> Lexing.lexbuf -> Parsed.lexpr list * bool -(** Parses the given trigger (lexbuf) using the appropriate 'parser' - depending on the given language. If no language is given, the - default one is used. - @raise Errors.Parser_error *) - -val parse_problem : filename:string -> preludes:string list -> Parsed.file -(** Parses the given input file and eventual preludes. Parsers are - chosen depending on the extension of different files. - @raise Errors.Error - @raise Parsing.Parse_Error *) - -val parse_problem_as_string : - content:string -> format:string option -> Parsed.file -(** Parses the given input file as a string. - Parser is chosen depending on the given format or the input_format set. - @raise Errors.Error - @raise Parsing.Parse_Error *) diff --git a/src/parsers/psmt2_to_alt_ergo.ml b/src/parsers/psmt2_to_alt_ergo.ml deleted file mode 100644 index d642b7bb78..0000000000 --- a/src/parsers/psmt2_to_alt_ergo.ml +++ /dev/null @@ -1,556 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -open AltErgoLib - -module Smtlib_error = Psmt2Frontend.Smtlib_error -module Smtlib_options = Psmt2Frontend.Options -module Smtlib_ty = Psmt2Frontend.Smtlib_ty -module Smtlib_typed_env = Psmt2Frontend.Smtlib_typed_env -module Smtlib_typing = Psmt2Frontend.Smtlib_typing -module Smtlib_syntax = Psmt2Frontend.Smtlib_syntax -module Smtlib_parser = Psmt2Frontend.Smtlib_parser -module Smtlib_lexer = Psmt2Frontend.Smtlib_lexer - -open Smtlib_syntax -open Parsed_interface - - -module Translate = struct - - let pos x = - match x.p with - | None -> Loc.dummy - | Some p -> p - - let must_not_happen loc s = - let s = Format.sprintf - "psmt2-frontend typing should ensure that this case can't happen : %s" s - in - raise (Errors.error (Errors.Syntax_error (loc,s))) - - (**************************************************************************) - let translate_left_assoc f id params = - match params with - | [] | [_] -> assert false - | t :: l -> - List.fold_left (fun acc t -> - f (pos id) acc t - ) t l - - let translate_right_assoc f id params = - match List.rev params with - | [] | [_] -> assert false - | t :: l -> - List.fold_left (fun acc t -> - f (pos id) t acc - ) t l - - let translate_chainable_assoc f id params = - match params with - | [] | [_] -> assert false - | a::b::l -> - let (res,_) = List.fold_left (fun (acc,curr) next -> - mk_and (pos id) acc (f (pos id) curr next), next - ) ((f (pos id) a b),b) l - in res - - (**************************************************************************) - let init n 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 n f - - let translate_sort sort = - let open Smtlib_ty in - let rec aux ty = - match (shorten ty).desc with - | TDummy -> assert false - | TInt -> int_type - | TReal -> real_type - | TBool -> bool_type - | TString -> assert false - | TArray (t1,t2) -> mk_external_type (pos sort) [aux t1;aux t2] "farray" - | TBitVec _ -> assert false - | TSort (s,t_list) -> mk_external_type (pos sort) (List.map aux t_list) s - | TDatatype (d,t_list) -> - mk_external_type (pos sort) (List.map aux t_list) d - | TVar (s) -> mk_var_type (pos sort) s - | TFun _ -> assert false - | TLink _ -> assert false - | TRoundingMode -> assert false - | TFloatingPoint _ -> assert false - in - aux sort.ty - - let translate_constant cst t = - let loc = pos t in - match cst with - | Const_Dec(s) -> mk_real_const loc (Numbers.Q.from_string s) - | Const_Num(s) -> - let open Smtlib_ty in - let ty = shorten t.ty in - begin match ty.desc with (*TODO: do shorten earlier and better*) - | TInt -> mk_int_const loc s - | TReal -> mk_real_const loc (Numbers.Q.from_string s) - | _ -> - Printer.print_err "%s" (to_string ty); - assert false - end - | Const_Str _ -> assert false (* to do *) - | Const_Hex(s) -> mk_int_const loc s - | Const_Bin(s) -> mk_int_const loc s - - let translate_string_identifier name params raw_params = - match name.c with - | "true" -> mk_true_const (pos name) - | "false" -> mk_false_const (pos name) - | "+" -> begin - match params with - | [p] -> p - | _ -> translate_left_assoc mk_add name params - end - | "-" -> begin - match params with - | [t] -> mk_minus (pos name) t - | _ -> translate_left_assoc mk_sub name params - end - | "*" -> translate_left_assoc mk_mul name params - | "/" -> translate_left_assoc mk_div name params - | "div" -> translate_left_assoc mk_div name params - | "mod" -> begin - match params with - | [t1;t2] -> mk_mod (pos name) t1 t2 - | _ -> assert false - end - | "abs" -> begin - match params with - | [x] -> - let cond = mk_pred_ge (pos name) x (mk_int_const (pos name) "0") in - mk_ite (pos name) cond x (mk_minus (pos name) x) - | _ -> assert false - end - | "<" -> translate_chainable_assoc mk_pred_lt name params - | "<=" -> translate_chainable_assoc mk_pred_le name params - | ">" -> translate_chainable_assoc mk_pred_gt name params - | ">=" -> translate_chainable_assoc mk_pred_ge name params - | "=" -> - let f = match raw_params with - | [] -> assert false - | par :: _ -> - if Smtlib_ty.is_bool (Smtlib_ty.shorten par.ty) then mk_iff - else mk_pred_eq - in - translate_chainable_assoc f name params - | "=>" -> translate_right_assoc mk_implies name params - | "and" -> begin - match params with - | [p] -> p - | _ -> translate_left_assoc mk_and name params - end - | "or" -> begin - match params with - | [p] -> p - | _ -> translate_left_assoc mk_or name params - end - | "xor" -> translate_left_assoc mk_xor name params - | "ite" -> - begin - match params with - | [b;e1;e2] -> mk_ite (pos name) b e1 e2 - | _ -> assert false - end - | "not" -> begin - match params with - | [t] -> mk_not (pos name) t - | _ -> assert false - end - | "distinct" -> mk_distinct (pos name) params - | "select" -> begin - match params with - | [t;i] -> mk_array_get (pos name) t i - | _ -> assert false - end - | "store" -> begin - match params with - | [t;i;j] -> mk_array_set (pos name) t i j - | _ -> assert false - end - | _ -> - if name.is_quantif then - mk_var (pos name) name.c - else - mk_application (pos name) name.c params - - - - let translate_identifier id params raw_params = - let name, l = Smtlib_typed_env.get_identifier id in - match name.c, l, params with - | _, [], _ -> translate_string_identifier name params raw_params - | "is", [constr], [e] -> - mk_algebraic_test (pos name) e constr - | _ -> - Printer.print_err "[TODO] handle other underscored IDs"; - assert false - - let translate_qual_identifier qid params raw_params= - match qid.c with - | QualIdentifierId(id) -> translate_identifier id params raw_params, None - | QualIdentifierAs(id,sort) -> - translate_identifier id params raw_params, Some sort - - let rec translate_key_term pars acc k = - match k.c with - | Pattern(term_list) -> - let tl = List.map (translate_term pars) term_list in - (tl, true) :: acc - | Named _ -> - Printer.print_wrn - ~warning:(Options.get_verbose () || Options.get_debug_warnings ()) - "(! :named not yet supported)%!"; - acc - - and translate_quantif f svl pars t = - match t.c with - | TermExclimationPt(term,key_term_list) -> - let triggers = List.fold_left (fun acc key_term -> - translate_key_term pars acc key_term - ) [] key_term_list in - f (pos t) svl triggers [] (translate_term pars term) - | _ -> f (pos t) svl [] [] (translate_term pars t) - - and translate_term pars term = - match term.c with - | TermSpecConst(cst) -> translate_constant cst term - | TermQualIdentifier(qid) -> - let q,s = translate_qual_identifier qid [] [] in - begin - match s with - | None -> q - | Some s -> mk_type_cast (pos term) q (translate_sort s) - end - | TermQualIdTerm(qid,term_list) -> - let params = List.map (translate_term pars) term_list in - let q,s = translate_qual_identifier qid params term_list in - begin - match s with - | None -> q - | Some s -> mk_type_cast (pos term) q (translate_sort s) - end - | TermLetTerm(varbinding_list,term) -> - let varbind = List.map (fun (s,term) -> - s.c, (translate_term pars term) - ) varbinding_list in - mk_let (pos term) varbind (translate_term pars term) - | TermForAllTerm(sorted_var_list,t) -> - let svl = List.map (fun (v,s) -> - v.c, v.c, translate_sort s - ) sorted_var_list in - translate_quantif mk_forall svl pars t - | TermExistsTerm(sorted_var_list,t) -> - let svl = List.map (fun (v,s) -> - v.c, "", translate_sort s - ) sorted_var_list in - translate_quantif mk_exists svl pars t - | TermExclimationPt(term,_key_term_list) -> - translate_term pars term - | TermMatch(term,pattern_term_list) -> - let t = translate_term pars term in - let cases = List.map (fun (pat,term) -> - translate_pattern pat, - translate_term pars term - ) pattern_term_list - in - mk_match (pos term) t cases - - and translate_pattern pat = - let p = pos pat in - match pat.c with - | MatchPattern(s,sl) -> mk_pattern p s.c (List.map (fun s -> s.c) sl) - | MatchUnderscore -> mk_pattern p "_" [] - - let translate_assert_term (pars,term) = - translate_term pars term - - let translate_goal pos (pars,term) = - mk_goal pos "g" (translate_assert_term (pars,term)) - - let name_of_assert term = - match term.c with - | TermExclimationPt(_, [{ c = Named s; _ }]) -> Some s.c - | _ -> None - - let translate_assert = - let cpt = ref 0 in - fun pos (pars,term) -> - incr cpt; - let name = - match name_of_assert term with - | Some s -> s - | None -> Format.sprintf "unamed__assert__%d" !cpt - in - mk_generic_axiom pos name (translate_assert_term (pars,term)) - - let translate_const_dec (_,sort) = - translate_sort sort - - let translate_decl_fun f params ret = - let logic_type = mk_logic_type params (Some ret) in - mk_logic (pos f) Symbols.Other [(f.c,f.c)] logic_type - - let translate_fun_dec (_,sl,s) = - List.map translate_sort sl, translate_sort s - - let translate_fun_def_aux (symb,pars,svl,sort) = - let pars = List.map (fun par -> par.c) pars in - let params = List.map (fun (p,s) -> pos p, p.c,translate_sort s) svl in - symb, params, translate_sort sort, pars - - let translate_fun_def fun_def term = - let symb,params,ret,pars = translate_fun_def_aux fun_def in - let t_expr = translate_term pars term in - if Smtlib_ty.is_bool (Smtlib_ty.shorten term.ty) then - mk_non_ground_predicate_def (pos symb) (symb.c,symb.c) params t_expr - else mk_function_def (pos symb) (symb.c,symb.c) params ret t_expr - - let translate_datatype_decl (name, _) (params, cases) = - let params = List.map (fun n -> n.c) params in - let cases = - List.map (fun (constr, d_l) -> - constr.c, - List.map (fun (des, sort) -> des.c, translate_sort sort) d_l - )cases - in - pos name, params, name.c, (Parsed.Algebraic cases) - - let translate_datatypes sort_dec datatype_dec = - try - mk_rec_type_decl @@ - List.map2 translate_datatype_decl sort_dec datatype_dec - with Invalid_argument _ -> assert false - - let translate_push_pop fun_push_pop n pos = - try let n = int_of_string n in - if n < 0 then - must_not_happen pos "negative integer n in push n /pop n command"; - fun_push_pop pos n - with _ -> - must_not_happen pos "int of string conversion error in push/pop command" - - let not_supported s = - Printer.print_wrn - ~warning:(Options.get_verbose () || Options.get_debug_warnings ()) - "%S : Not yet supported" s - - let requires_dolmen s = - Printer.print_wrn - ~warning:(Options.get_verbose () || Options.get_debug_warnings ()) - "%S : Requires --frontend dolmen" s - - let translate_prop_literal x = - match x.c with - | PropLit sy -> - mk_application (pos x) sy.c [] - - | PropLitNot sy -> - let ps = pos x in - mk_not ps (mk_application ps sy.c []) - - let count_goals = ref 0 - - let translate_check_sat command l = - let loc = pos command in - incr count_goals; - let gname = "g_" ^ (string_of_int !count_goals) in - let l = List.rev_map (fun e -> translate_prop_literal e) (List.rev l) in - let e = - match l with - | [] -> mk_false_const loc - | [e] -> mk_not loc e - | _ -> mk_not loc (translate_left_assoc mk_and command l) - in - mk_goal loc gname e - - let translate_optimize = - fun ~is_maximize pos term -> - Printer.print_wrn - "optimize commands only work if the file contains check-sat@."; - assert (name_of_assert term == None); - let e = translate_term [] term in - mk_optimize pos e is_maximize - - let translate_command acc command = - match command.c with - | Cmd_Assert(assert_term) -> - (translate_assert (pos command) assert_term) :: acc - - | Cmd_Maximize t -> - (translate_optimize ~is_maximize:true (pos command) t) :: acc - - - | Cmd_Minimize t -> - (translate_optimize ~is_maximize:false (pos command) t) :: acc - - | Cmd_CheckEntailment(assert_term) -> - (translate_goal (pos command) assert_term) :: acc - | Cmd_CheckSat -> - (translate_check_sat command []) :: acc - | Cmd_CheckSatAssum l -> - (translate_check_sat command l) :: acc - | Cmd_DeclareConst(symbol,const_dec) -> - (translate_decl_fun symbol [] (translate_const_dec const_dec)) :: acc - | Cmd_DeclareDataType(symbol,datatype_dec) -> - (mk_rec_type_decl - [(translate_datatype_decl (symbol,0) datatype_dec)]) :: acc - | Cmd_DeclareDataTypes(sort_dec_list,datatype_dec_list) -> - (translate_datatypes sort_dec_list datatype_dec_list) :: acc - - | Cmd_DeclareFun(symbol,fun_dec) -> - let params,ret = translate_fun_dec fun_dec in - (translate_decl_fun symbol params ret):: acc - | Cmd_DeclareSort(symbol,n) -> - let n = int_of_string n in - let pars = init n (fun i -> Format.sprintf "'a_%d" i) in - (mk_abstract_type_decl (pos command) pars symbol.c) :: acc - | Cmd_DefineFun(fun_def,term) - | Cmd_DefineFunRec(fun_def,term) -> - (translate_fun_def fun_def term) :: acc - | Cmd_DefineFunsRec(fun_def_list,term_list) -> - let l = List.map2 translate_fun_def fun_def_list term_list in - l @ acc - | Cmd_Reset -> Reset (pos command) :: acc - | Cmd_Exit -> Exit (pos command) :: acc - | Cmd_DefineSort _ -> acc - | Cmd_GetModel -> requires_dolmen "get-model"; acc - | Cmd_Echo _ -> not_supported "echo"; acc - | Cmd_GetAssert -> not_supported "get-assertions"; acc - | Cmd_GetProof -> not_supported "get-proof"; acc - | Cmd_GetUnsatCore -> not_supported "get-unsat-core"; acc - | Cmd_GetValue _ -> not_supported "get-value"; acc - | Cmd_GetAssign -> not_supported "get-assign"; acc - | Cmd_GetOption _ -> not_supported "get-option"; acc - | Cmd_GetInfo _ -> not_supported "get-info"; acc - | Cmd_GetUnsatAssumptions -> not_supported "get-unsat-assumptions"; acc - | Cmd_ResetAssert -> not_supported "reset-asserts"; assert false - | Cmd_SetLogic _ -> not_supported "set-logic"; acc - | Cmd_SetOption _ -> not_supported "set-option"; acc - | Cmd_SetInfo _ -> not_supported "set-info"; acc - | Cmd_Push n -> translate_push_pop mk_push n (pos command) :: acc - | Cmd_Pop n -> translate_push_pop mk_pop n (pos command) :: acc - | Cmd_CheckAllSat _ -> not_supported "check-all-sat"; acc - - let init () = - if Psmt2Frontend.Options.get_is_int_real () then - let dummy_pos = Lexing.dummy_pos,Lexing.dummy_pos in - - (* assert false; *) - let logic_type = mk_logic_type [real_type] (Some int_type) in - let to_int = - mk_logic dummy_pos Symbols.Other [("to_int","to_int")] logic_type in - let logic_type = mk_logic_type [int_type] (Some real_type) in - let to_real = - mk_logic dummy_pos Symbols.Other [("to_real","to_real")] logic_type in - let logic_type = mk_logic_type [real_type] (Some bool_type) in - let is_int = - mk_logic dummy_pos Symbols.Other [("is_int","is_int")] logic_type in - [to_int;to_real;is_int] - else [] - - let file commands = - Smtlib_typing.typing commands; - - if Options.get_type_smt2 () then begin - Printer.print_dbg - "%s" (Smtlib_options.status ()); - [] - end - else begin - let l = List.rev @@ List.fold_left translate_command [] commands in - (init ()) @ l - end - - let lexpr l = translate_term [] l - - let trigger (tl,b) = List.map (translate_term []) tl,b - -end - -let aux aux_fun token lexbuf = - try - Smtlib_options.set_filename (Options.get_file ()); - Smtlib_options.set_keep_loc true; - let res = aux_fun token lexbuf in - Options.set_status (Smtlib_options.status ()); - Parsing.clear_parser (); - res - with - | Parsing.Parse_error - | Smtlib_parser.Error -> - (* not fully qualified ! backward incompat. in Menhir !!*) - let loc = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf) in - let lex = Lexing.lexeme lexbuf in - Parsing.clear_parser (); - Smtlib_error.print (Options.Output.get_fmt_diagnostic ()) - (Options.get_file ()) - (Syntax_error (lex)) loc; - Errors.error (Errors.Syntax_error (loc,"")) - | Smtlib_error.Error (e , p) -> - Parsing.clear_parser (); - let loc = - match p with - Some loc -> loc - | None -> Lexing.dummy_pos,Lexing.dummy_pos - in - Smtlib_error.print (Options.Output.get_fmt_diagnostic ()) - (Options.get_file ()) e loc; - Errors.error (Errors.Syntax_error (loc,"")) - -let file_parser token lexbuf = - Translate.file (Smtlib_parser.commands token lexbuf) - -let lexpr_parser token lexbuf = - Translate.lexpr (Smtlib_parser.term token lexbuf) - -let trigger_parser token lexbuf = - Translate.trigger (Smtlib_parser.term_list token lexbuf) - -module Parser : Parsers.PARSER_INTERFACE = struct - let file = aux file_parser Smtlib_lexer.token - let expr = aux lexpr_parser Smtlib_lexer.token - let trigger = aux trigger_parser Smtlib_lexer.token -end - -let register_psmt2 () = - (*register this parser in Input_lang: 2 different extensions recognized *) - let p = (module Parser : Parsers.PARSER_INTERFACE) in - Parsers.register_parser ~lang:".smt2" p; - Parsers.register_parser ~lang:".psmt2" p; diff --git a/src/parsers/psmt2_to_alt_ergo.mli b/src/parsers/psmt2_to_alt_ergo.mli deleted file mode 100644 index 073fd20a26..0000000000 --- a/src/parsers/psmt2_to_alt_ergo.mli +++ /dev/null @@ -1,38 +0,0 @@ -(**************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) --- OCamlPro SAS *) -(* *) -(* This file is distributed under the terms of OCamlPro *) -(* Non-Commercial Purpose License, version 1. *) -(* *) -(* As an exception, Alt-Ergo Club members at the Gold level can *) -(* use this file under the terms of the Apache Software License *) -(* version 2.0. *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* The Alt-Ergo theorem prover *) -(* *) -(* Sylvain Conchon, Evelyne Contejean, Francois Bobot *) -(* Mohamed Iguernelala, Stephane Lescuyer, Alain Mebsout *) -(* *) -(* CNRS - INRIA - Universite Paris Sud *) -(* *) -(* --------------------------------------------------------------- *) -(* *) -(* More details can be found in the directory licenses/ *) -(* *) -(**************************************************************************) - -(** {1 Interface Module with the library psmt2-frontend} *) - -(** Offer an interface with the library - {{:https://github.com/OCamlPro-Coquera/psmt2-frontend}[psmt2-frontend]} - and register a parser for smt2 and psmt2 extensions. This interface allows - Alt-Ergo to partially support the SMT-LIB2 standard and a polymorphic - extension. -*) - -(** Register the psmt2 frontend as a parser for smt2 and psmt2 extension *) -val register_psmt2 : unit -> unit diff --git a/src/plugins/AB-Why3/LICENSE.md b/src/plugins/AB-Why3/LICENSE.md deleted file mode 100644 index c4175327ac..0000000000 --- a/src/plugins/AB-Why3/LICENSE.md +++ /dev/null @@ -1,8 +0,0 @@ -# Licensing - -The OCaml files in this directory come from Why3's source code -(release 0.88.2 to be exact). We have quite modified them for our -needs. They are licensed under the terms of the GNU Lesser General -Public License version 2.1, as stated in `src/plugins/AB-Why3/WHY3-LICENSE`. -The plugin `ABWhy3Plugin.cmxs` resulting from their compilation is thus -licensed under the same terms. diff --git a/src/plugins/AB-Why3/README.md b/src/plugins/AB-Why3/README.md deleted file mode 100644 index 17c8e78428..0000000000 --- a/src/plugins/AB-Why3/README.md +++ /dev/null @@ -1,62 +0,0 @@ -# What is this plugin ? - -An experimental front-end that parses a subset of Why3's logic. More -precisely, this front-end targets proof obligations generated by the -Atelier-B framework in Why3 format. It should be used with a prelude -defining the B Set theory (currently provided in -`src/plugins/AB-Why3/preludes/b-set-theory-prelude-2020-02-28.ae`). - - - -# What this plugin is not ? - -This plugin mainly focuses on the shape of the proof obligations -produced by the Why3 proofs obligations generator of Atelier-B. You -will probably not be able to use it to parse/solve other formulas -written in Why3's logic. - - - -# How to use it ? - -Assuming you are currently in `alt-ergo-git/` directory, you can run the command -`make AB-Why3` to compile Alt-Ergo and the AB-why3 plugin. You can ask Alt-Ergo to -prove the goals given in a file `b-why3-POs.ae` with the following -command: - - -``` - ./alt-ergo b-why3-POs.why --add-parser ABWhy3Plugin.cmxs --prelude b-set-theory-prelude-2020-02-28.ae -``` - -where `--add-parser ABWhy3Plugin.cmxs` allows to load this plugin and -register the parser it contains, and `--prelude -b-set-theory-prelude-2020-02-28.ae ` provides an axiomatization of the B Set -theory for Alt-Ergo. - -For instance, using the following command to prove the goals in the -file `examples/AB-Why3-plugin/p4_34.why.zip`: - -``` -./alt-ergo examples/AB-Why3-plugin/p4_34.why.zip --add-parser ABWhy3Plugin.cmxs --prelude b-set-theory-prelude-2020-02-28.ae --timelimit-per-goal --timelimit 3 --no-locs-in-answers -``` - -Alt-Ergo returns: - -``` -Warning: A parser for extension ".why" is already registered. It will be hidden ! -Preprocessing (0.0315) (0 steps) -Valid (0.0033) (28 steps) (goal g_0) -Valid (0.0369) (163 steps) (goal g_1) -Valid (0.0087) (94 steps) (goal g_2) -Timeout (3.0016) (2191 steps) (goal g_3) -Valid (0.0476) (184 steps) (goal g_4) -Valid (0.0525) (215 steps) (goal g_5) -``` - -If you have already installed this version of Alt-Ergo and this plugin, you should be able to simply use the command: - - -``` - alt-ergo b-why3-POs.why --add-parser ABWhy3Plugin.cmxs --prelude b-set-theory-prelude-2020-02-28.ae -``` diff --git a/src/plugins/AB-Why3/WHY3-LICENSE b/src/plugins/AB-Why3/WHY3-LICENSE deleted file mode 100644 index 3ce6c39c17..0000000000 --- a/src/plugins/AB-Why3/WHY3-LICENSE +++ /dev/null @@ -1,533 +0,0 @@ -The Library is distributed under the terms of the GNU Lesser General -Public License version 2.1 (included below). - -As a special exception to the GNU Lesser General Public License, you -may link, statically or dynamically, a "work that uses the Library" -with a publicly distributed version of the Library to produce an -executable file containing portions of the Library, and distribute that -executable file under terms of your choice, without any of the additional -requirements listed in clause 6 of the GNU Lesser General Public License. -By "a publicly distributed version of the Library", we mean either the -unmodified Library as distributed by the authors, or a modified version -of the Library that is distributed under the conditions defined in clause -3 of the GNU Lesser General Public License. This exception does not -however invalidate any other reasons why the executable file might be -covered by the GNU Lesser General Public License. - -The files src/util/extmap.ml{i} are derived from the sources of -OCaml 3.12 standard library, and are distributed under the GNU -LGPL version 2 (see file OCAML-LICENSE). - -Icon sets for the graphical interface of Why3 are subject to specific -licenses, some of them may forbid commercial usage. These specific -licenses are detailed in files share/images/*/*.txt - -====================================================================== - - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations -below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it -becomes a de-facto standard. To achieve this, non-free programs must -be allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control -compilation and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at least - three years, to give the same user the materials specified in - Subsection 6a, above, for a charge no more than the cost of - performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply, and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License -may add an explicit geographical distribution limitation excluding those -countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms -of the ordinary General Public License). - - To apply these terms, attach the following notices to the library. -It is safest to attach them to the start of each source file to most -effectively convey the exclusion of warranty; and each file should -have at least the "copyright" line and a pointer to where the full -notice is found. - - - - Copyright (C) - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or -your school, if any, to sign a "copyright disclaimer" for the library, -if necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James - Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! diff --git a/src/plugins/AB-Why3/dune b/src/plugins/AB-Why3/dune deleted file mode 100644 index c817909c09..0000000000 --- a/src/plugins/AB-Why3/dune +++ /dev/null @@ -1,21 +0,0 @@ -(documentation - (package alt-ergo-plugin-ab-why3) - (mld_files :standard)) - -(ocamllex (modules why3_lexer)) - -(menhir - (flags --fixed-exception) - (modules why3_parser)) - -(library - (name ABWhy3Plugin) - (libraries alt-ergo-lib alt-ergo-parsers) - (modules Why3_lexer Why3_parser Why3_loc Why3_ptree)) - -(install - (package alt-ergo-plugin-ab-why3) - (section (site (alt-ergo plugins))) - (files - ABWhy3Plugin.cma - ABWhy3Plugin.cmxs)) diff --git a/src/plugins/AB-Why3/index.mld b/src/plugins/AB-Why3/index.mld deleted file mode 100644 index f334810f89..0000000000 --- a/src/plugins/AB-Why3/index.mld +++ /dev/null @@ -1,75 +0,0 @@ -{1 ABWhy3 plugin} - -{2 What is this plugin ?} - -An experimental front-end that parses a subset of Why3's logic. More -precisely, this front-end targets proof obligations generated by the -Atelier-B framework in Why3 format. It should be used with a prelude -defining the B Set theory (currently provided in -[preludes/b-set-theory-prelude-2020-02-28.ae]). - - -{2 What this plugin is not ?} - -This plugin mainly focuses on the shape of the proof obligations -produced by the Why3 proofs obligations generator of Atelier-B. You -will probably not be able to use it to parse/solve other formulas -written in Why3's logic. - - - -{2 How to use it ?} - -Assuming you are currently in [alt-ergo-git/sources] directory, and -[make && make AB-Why3] succeeded, you can ask Alt-Ergo to -prove the goals given in a file [b-why3-POs.why] with the following -command: - - -{v - ./alt-ergo b-why3-POs.why --add-parser ABWhy3Plugin.cmxs --prelude b-set-theory-prelude-2020-02-28.ae -v} - - -where [--add-parser=ABWhy3Plugin.cmxs] allows to load this plugin and -register the parser it contains, and [--prelude -b-set-theory-prelude-2020-02-28.ae] provides an axiomatization of the B Set -theory for Alt-Ergo. - -For instance, using the following command to prove the goals in the -file [examples/AB-Why3-plugin/p4_34.why.zip]: - -{v -./alt-ergo examples/AB-Why3-plugin/p4_34.why.zip --add-parser ABWhy3Plugin.cmxs --prelude b-set-theory-prelude-2020-02-28.ae --timelimit-per-goal --timelimit 3 --no-locs-in-answers -v} - -Alt-Ergo returns: - -{v -Warning: A parser for extension ".why" is already registered. It will be hidden ! -Preprocessing (0.0315) (0 steps) -Valid (0.0033) (28 steps) (goal g_0) -Valid (0.0369) (163 steps) (goal g_1) -Valid (0.0087) (94 steps) (goal g_2) -Timeout (3.0016) (2191 steps) (goal g_3) -Valid (0.0476) (184 steps) (goal g_4) -Valid (0.0525) (215 steps) (goal g_5) -v} - -If you have already installed this version of Alt-Ergo and this plugin, you should be able to simply use the command: - - -[ - alt-ergo b-why3-POs.why --parser ABWhy3Plugin.cmxs --prelude b-set-theory-prelude-2020-02-28.ae -] - - -{2 Licensing} - -The OCaml files in this directory come from Why3's source code -(release 0.88.2 to be exact). We have quite modified them for our -needs. They are licensed under the terms of the GNU Lesser General -Public License version 2.1, as stated in -[sources/plugins/AB-Why3/WHY3-LICENSE]. The plugin [ABWhy3Plugin.cmxs] -resulting from their compilation is thus licensed under the same -terms. diff --git a/src/plugins/AB-Why3/preludes/b-set-theory-prelude-2018-09-28.ae b/src/plugins/AB-Why3/preludes/b-set-theory-prelude-2018-09-28.ae deleted file mode 100644 index 882c86be39..0000000000 --- a/src/plugins/AB-Why3/preludes/b-set-theory-prelude-2018-09-28.ae +++ /dev/null @@ -1,1315 +0,0 @@ -(* this is the prelude for Alt-Ergo, version >= 0.95.2 *) -(* this is a prelude for Alt-Ergo integer arithmetic *) -logic comp_div: int, int -> int -axiom comp_div_def: forall x, y:int. x >= 0 and y > 0 -> comp_div(x,y) = x / y -logic comp_mod: int, int -> int -axiom comp_mod_def: forall x, y:int. x >= 0 and y > 0 -> comp_mod(x,y) = x % y -logic match_bool : bool, 'a, 'a -> 'a - -axiom match_bool_True : - (forall z:'a. forall z1:'a. (match_bool(true, z, z1) = z)) - -axiom match_bool_False : - (forall z:'a. forall z1:'a. (match_bool(false, z, z1) = z1)) - -function andb(x: bool, y: bool) : bool = match_bool(x, y, false) - -function orb(x: bool, y: bool) : bool = match_bool(x, true, y) - -function notb(x: bool) : bool = match_bool(x, false, true) - -function xorb(x: bool, y: bool) : bool = match_bool(x, notb(y), y) - -function implb(x: bool, y: bool) : bool = match_bool(x, y, true) - -axiom CompatOrderMult : - (forall x:int. forall y:int. forall z:int. ((x <= y) -> ((0 <= z) -> - ((x * z) <= (y * z))))) - -logic abs : int -> int - -axiom abs_def : (forall x:int. ((0 <= x) -> (abs(x) = x))) - -axiom abs_def1 : (forall x:int. ((not (0 <= x)) -> (abs(x) = (-x)))) - -axiom Abs_le : (forall x:int. forall y:int. ((abs(x) <= y) -> ((-y) <= x))) - -axiom Abs_le1 : (forall x:int. forall y:int. ((abs(x) <= y) -> (x <= y))) - -axiom Abs_le2 : - (forall x:int. forall y:int. ((((-y) <= x) and (x <= y)) -> (abs(x) <= y))) - -axiom Abs_pos : (forall x:int. (0 <= abs(x))) - -axiom Div_mod : - (forall x:int. forall y:int. ((not (y = 0)) -> - (x = ((y * comp_div(x,y)) + comp_mod(x,y))))) - -axiom Div_bound : - (forall x:int. forall y:int. (((0 <= x) and (0 < y)) -> - (0 <= comp_div(x,y)))) - -axiom Div_bound1 : - (forall x:int. forall y:int. (((0 <= x) and (0 < y)) -> - (comp_div(x,y) <= x))) - -axiom Mod_bound : - (forall x:int. forall y:int. ((not (y = 0)) -> - ((-abs(y)) < comp_mod(x,y)))) - -axiom Mod_bound1 : - (forall x:int. forall y:int. ((not (y = 0)) -> (comp_mod(x,y) < abs(y)))) - -axiom Div_sign_pos : - (forall x:int. forall y:int. (((0 <= x) and (0 < y)) -> - (0 <= comp_div(x,y)))) - -axiom Div_sign_neg : - (forall x:int. forall y:int. (((x <= 0) and (0 < y)) -> - (comp_div(x,y) <= 0))) - -axiom Mod_sign_pos : - (forall x:int. forall y:int. (((0 <= x) and (not (y = 0))) -> - (0 <= comp_mod(x,y)))) - -axiom Mod_sign_neg : - (forall x:int. forall y:int. (((x <= 0) and (not (y = 0))) -> - (comp_mod(x,y) <= 0))) - -axiom Rounds_toward_zero : - (forall x:int. forall y:int. ((not (y = 0)) -> - (abs((comp_div(x,y) * y)) <= abs(x)))) - -axiom Div_1 : (forall x:int. (comp_div(x,1) = x)) - -axiom Mod_1 : (forall x:int. (comp_mod(x,1) = 0)) - -axiom Div_inf : - (forall x:int. forall y:int. (((0 <= x) and (x < y)) -> - (comp_div(x,y) = 0))) - -axiom Mod_inf : - (forall x:int. forall y:int. (((0 <= x) and (x < y)) -> - (comp_mod(x,y) = x))) - -axiom Div_mult : - (forall x:int. forall y:int. forall z:int [comp_div(((x * y) + z),x)]. - (((0 < x) and ((0 <= y) and (0 <= z))) -> - (comp_div(((x * y) + z),x) = (y + comp_div(z,x))))) - -axiom Mod_mult : - (forall x:int. forall y:int. forall z:int [comp_mod(((x * y) + z),x)]. - (((0 < x) and ((0 <= y) and (0 <= z))) -> - (comp_mod(((x * y) + z),x) = comp_mod(z,x)))) - -type 'a set - -logic mem : 'a, 'a set -> prop - -predicate infix_eqeq(s1: 'a set, s2: 'a set) = - (forall x:'a. (mem(x, s1) <-> mem(x, s2))) - -axiom extensionality : - (forall s1:'a set. forall s2:'a set. (infix_eqeq(s1, s2) -> (s1 = s2))) - -predicate subset(s1: 'a set, s2: 'a set) = - (forall x:'a. (mem(x, s1) -> mem(x, s2))) - -axiom subset_refl : (forall s:'a set. subset(s, s)) - -axiom subset_trans : - (forall s1:'a set. forall s2:'a set. forall s3:'a set. (subset(s1, s2) -> - (subset(s2, s3) -> subset(s1, s3)))) - -logic empty : 'a set - -predicate is_empty(s: 'a set) = (forall x:'a. (not mem(x, s))) - -axiom empty_def1 : is_empty((empty : 'a set)) - -axiom mem_empty : (forall x:'a. (not mem(x, (empty : 'a set)))) - -axiom mem_empty1 : true - -logic add : 'a, 'a set -> 'a set - -axiom add_def1 : - (forall x:'a. forall y:'a. - (forall s:'a set. (mem(x, add(y, s)) -> ((x = y) or mem(x, s))))) - -axiom add_def11 : - (forall x:'a. forall y:'a. - (forall s:'a set. (((x = y) or mem(x, s)) -> mem(x, add(y, s))))) - -logic remove : 'a, 'a set -> 'a set - -axiom remove_def1 : - (forall x:'a. forall y:'a. forall s:'a set. (mem(x, remove(y, s)) -> - (not (x = y)))) - -axiom remove_def11 : - (forall x:'a. forall y:'a. forall s:'a set. (mem(x, remove(y, s)) -> mem(x, - s))) - -axiom remove_def12 : - (forall x:'a. forall y:'a. forall s:'a set. (((not (x = y)) and mem(x, - s)) -> mem(x, remove(y, s)))) - -axiom add_remove : - (forall x:'a. forall s:'a set. (mem(x, s) -> (add(x, remove(x, s)) = s))) - -axiom remove_add : - (forall x:'a. forall s:'a set. (remove(x, add(x, s)) = remove(x, s))) - -axiom subset_remove : (forall x:'a. forall s:'a set. subset(remove(x, s), s)) - -logic union : 'a set, 'a set -> 'a set - -axiom union_def1 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, union(s1, s2)) -> - (mem(x, s1) or mem(x, s2)))) - -axiom union_def11 : - (forall s1:'a set. forall s2:'a set. forall x:'a. ((mem(x, s1) or mem(x, - s2)) -> mem(x, union(s1, s2)))) - -logic inter : 'a set, 'a set -> 'a set - -axiom inter_def1 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, inter(s1, s2)) -> - mem(x, s1))) - -axiom inter_def11 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, inter(s1, s2)) -> - mem(x, s2))) - -axiom inter_def12 : - (forall s1:'a set. forall s2:'a set. forall x:'a. ((mem(x, s1) and mem(x, - s2)) -> mem(x, inter(s1, s2)))) - -logic diff : 'a set, 'a set -> 'a set - -axiom diff_def1 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, diff(s1, s2)) -> - mem(x, s1))) - -axiom diff_def11 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, diff(s1, s2)) -> - (not mem(x, s2)))) - -axiom diff_def12 : - (forall s1:'a set. forall s2:'a set. forall x:'a. ((mem(x, s1) and - (not mem(x, s2))) -> mem(x, diff(s1, s2)))) - -axiom subset_diff : - (forall s1:'a set. forall s2:'a set. subset(diff(s1, s2), s1)) - -logic choose : 'a set -> 'a - -axiom choose_def : - (forall s:'a set. ((not is_empty(s)) -> mem(choose(s), s))) - -logic all : 'a set - -axiom all_def : (forall x:'a. mem(x, (all : 'a set))) - -logic b_bool : bool set - -axiom mem_b_bool : (forall x:bool. mem(x, b_bool)) - -type ('a, 'a1) tuple2 = { Tuple2_proj_1 : 'a; Tuple2_proj_2 : 'a1 -} - -logic relation : 'a2 set, 'b set -> ('a2, 'b) tuple2 set set - -axiom mem_relation : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - relation(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(x, s))))) - -axiom mem_relation1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - relation(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(y, t))))) - -axiom mem_relation2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - ((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> (mem(x, s) and mem(y, t)))) -> - mem(f, relation(s, t)))) - -logic image : ('a, 'b) tuple2 set, 'a set -> 'b set - -axiom mem_image : - (forall r:('a, 'b) tuple2 set. forall dom:'a set. forall y:'b [mem(y, - image(r, dom))]. (mem(y, image(r, dom)) -> - (exists x:'a. (mem(x, dom) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r))))) - -axiom mem_image1 : - (forall r:('a, 'b) tuple2 set. forall dom:'a set. forall y:'b [mem(y, - image(r, dom))]. - ((exists x:'a. (mem(x, dom) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r))) -> - mem(y, image(r, dom)))) - -axiom image_union : - (forall r:('a, 'b) tuple2 set. forall s:'a set. forall t:'a set. (image(r, - union(s, t)) = union(image(r, s), image(r, t)))) - -axiom image_add : - (forall r:('a, 'b) tuple2 set. forall dom:'a set. forall x:'a. (image(r, - add(x, dom)) = union(image(r, add(x, (empty : 'a set))), image(r, dom)))) - -logic infix_plmngt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngt(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(x, s))))) - -axiom mem_function1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngt(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(y, t))))) - -axiom mem_function2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngt(s, t)) -> - (forall x:'a. forall y1:'b. forall y2:'b. ((mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y1 }, f) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y2 }, - f)) -> (y1 = y2))))) - -axiom mem_function3 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - (((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> (mem(x, s) and mem(y, t)))) and - (forall x:'a. forall y1:'b. forall y2:'b. ((mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y1 }, f) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y2 }, - f)) -> (y1 = y2)))) -> mem(f, infix_plmngt(s, t)))) - -axiom domain_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall x:'a. forall y:'b. (mem(f, infix_plmngt(s, t)) -> (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, f) -> mem(x, s)))) - -axiom range_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall x:'a. forall y:'b. (mem(f, infix_plmngt(s, t)) -> (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, f) -> mem(y, t)))) - -axiom function_extend_range : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall u:'b set. (subset(t, u) -> (mem(f, infix_plmngt(s, t)) -> mem(f, - infix_plmngt(s, u))))) - -axiom function_reduce_range : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall u:'b set. (subset(u, t) -> (mem(f, infix_plmngt(s, t)) -> - ((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(y, u))) -> - mem(f, infix_plmngt(s, u)))))) - -logic inverse : ('a, 'b) tuple2 set -> ('b, 'a) tuple2 set - -axiom Inverse_def : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = x }, - inverse(r)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r)))) - -axiom Inverse_def1 : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = x }, inverse(r))))) - -logic dom : ('a, 'b) tuple2 set -> 'a set - -axiom dom_def : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. (mem(x, dom(r)) -> - (exists y:'b. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom dom_def1 : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. - ((exists y:'b. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r)) -> mem(x, - dom(r))))) - -logic ran : ('a, 'b) tuple2 set -> 'b set - -axiom ran_def : - (forall r:('a, 'b) tuple2 set. - (forall y:'b. (mem(y, ran(r)) -> - (exists x:'a. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom ran_def1 : - (forall r:('a, 'b) tuple2 set. - (forall y:'b. - ((exists x:'a. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r)) -> mem(y, - ran(r))))) - -axiom dom_empty : (dom((empty : ('a, 'b) tuple2 set)) = (empty : 'a set)) - -axiom dom_add : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b. (dom(add({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, f)) = add(x, dom(f)))) - -axiom dom_singleton : - (forall x:'a. forall y:'b. (dom(add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, (empty : ('a, 'b) tuple2 set))) = add(x, (empty : 'a set)))) - -logic infix_mnmngt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_functions : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngt(s, t)) -> mem(f, infix_plmngt(s, t)))) - -axiom mem_total_functions1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngt(s, t)) -> (dom(f) = s))) - -axiom mem_total_functions2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngt(s, t)) and (dom(f) = s)) -> mem(f, infix_mnmngt(s, t)))) - -axiom total_function_is_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set [mem(f, - infix_mnmngt(s, t))]. (mem(f, infix_mnmngt(s, t)) -> mem(f, infix_plmngt(s, - t)))) - -axiom singleton_is_partial_function : - (forall s:'a set. forall t:'b set. forall x:'a. forall y:'b. ((mem(x, - s) and mem(y, t)) -> mem(add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - (empty : ('a, 'b) tuple2 set)), infix_plmngt(s, t)))) - -axiom singleton_is_function : - (forall x:'a. forall y:'b [add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - (empty : ('a, 'b) tuple2 set))]. mem(add({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, (empty : ('a, 'b) tuple2 set)), infix_mnmngt(add(x, - (empty : 'a set)), add(y, (empty : 'b set))))) - -logic apply : ('a, 'b) tuple2 set, 'a -> 'b - -axiom apply_def0 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall a1:'a. ((mem(f, infix_plmngt(s, t)) and mem(a1, dom(f))) -> mem({ - Tuple2_proj_1 = a1; Tuple2_proj_2 = apply(f, a1) }, f))) - -axiom apply_def1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall a1:'a. ((mem(f, infix_mnmngt(s, t)) and mem(a1, s)) -> mem({ - Tuple2_proj_1 = a1; Tuple2_proj_2 = apply(f, a1) }, f))) - -axiom apply_def2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall a1:'a. forall b1:'b. ((mem(f, infix_plmngt(s, t)) and mem({ - Tuple2_proj_1 = a1; Tuple2_proj_2 = b1 }, f)) -> (apply(f, a1) = b1))) - -axiom apply_singleton : - (forall x:'a. forall y:'b. (apply(add({ Tuple2_proj_1 = x; Tuple2_proj_2 = - y }, (empty : ('a, 'b) tuple2 set)), x) = y)) - -axiom apply_range : - (forall x:'a. forall f:('a, 'b) tuple2 set. forall s:'a set. - forall t:'b set [mem(f, infix_plmngt(s, t)), apply(f, x)]. ((mem(f, - infix_plmngt(s, t)) and mem(x, dom(f))) -> mem(apply(f, x), t))) - -logic semicolon : ('a, 'b) tuple2 set, ('b, 'c) tuple2 set -> ('a, - 'c) tuple2 set - -axiom semicolon_def : - (forall x:'a. forall z:'c. forall p:('a, 'b) tuple2 set. forall q:('b, - 'c) tuple2 set. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = z }, semicolon(p, - q)) -> - (exists y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, p) and mem({ - Tuple2_proj_1 = y; Tuple2_proj_2 = z }, q))))) - -axiom semicolon_def1 : - (forall x:'a. forall z:'c. forall p:('a, 'b) tuple2 set. forall q:('b, - 'c) tuple2 set. - ((exists y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, p) and mem({ - Tuple2_proj_1 = y; Tuple2_proj_2 = z }, q))) -> - mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = z }, semicolon(p, q)))) - -logic direct_product : ('a, 'b) tuple2 set, ('a, 'c) tuple2 set -> ('a, ('b, - 'c) tuple2) tuple2 set - -axiom direct_product_def : - (forall e:('t, ('u, 'v) tuple2) tuple2. forall r1:('t, 'u) tuple2 set. - forall r2:('t, 'v) tuple2 set [mem(e, direct_product(r1, r2))]. (mem(e, - direct_product(r1, r2)) -> - (exists x:'t. exists y:'u. exists z:'v. (({ Tuple2_proj_1 = x; - Tuple2_proj_2 = { Tuple2_proj_1 = y; Tuple2_proj_2 = z } } = e) and (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r1) and mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = z }, r2)))))) - -axiom direct_product_def1 : - (forall e:('t, ('u, 'v) tuple2) tuple2. forall r1:('t, 'u) tuple2 set. - forall r2:('t, 'v) tuple2 set [mem(e, direct_product(r1, r2))]. - ((exists x:'t. exists y:'u. exists z:'v. (({ Tuple2_proj_1 = x; - Tuple2_proj_2 = { Tuple2_proj_1 = y; Tuple2_proj_2 = z } } = e) and (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r1) and mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = z }, r2)))) -> - mem(e, direct_product(r1, r2)))) - -logic parallel_product : ('a, 'b) tuple2 set, ('c, 'd) tuple2 set -> (('a, - 'c) tuple2, ('b, 'd) tuple2) tuple2 set - -axiom parallel_product_def : - (forall e:(('t, 'v) tuple2, ('u, 'w) tuple2) tuple2. forall r1:('t, - 'u) tuple2 set. forall r2:('v, 'w) tuple2 set. (mem(e, parallel_product(r1, - r2)) -> - (exists x:'t. exists y:'v. exists z:'u. exists a:'w. (({ Tuple2_proj_1 = { - Tuple2_proj_1 = x; Tuple2_proj_2 = y }; Tuple2_proj_2 = { Tuple2_proj_1 = - z; Tuple2_proj_2 = a } } = e) and (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = - z }, r1) and mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = a }, r2)))))) - -axiom parallel_product_def1 : - (forall e:(('t, 'v) tuple2, ('u, 'w) tuple2) tuple2. forall r1:('t, - 'u) tuple2 set. forall r2:('v, 'w) tuple2 set. - ((exists x:'t. exists y:'v. exists z:'u. exists a:'w. (({ Tuple2_proj_1 = { - Tuple2_proj_1 = x; Tuple2_proj_2 = y }; Tuple2_proj_2 = { Tuple2_proj_1 = - z; Tuple2_proj_2 = a } } = e) and (mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = z }, r1) and mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = a }, - r2)))) -> - mem(e, parallel_product(r1, r2)))) - -axiom semicolon_dom : - (forall f:('a, 'b) tuple2 set. forall g:('b, 'c) tuple2 set. - subset(dom(semicolon(f, g)), dom(f))) - -axiom semicolon_is_function : - (forall f:('a, 'b) tuple2 set. forall g:('b, 'c) tuple2 set. - forall s:'a set. forall t:'b set. forall u:'c set. ((mem(f, infix_plmngt(s, - t)) and mem(g, infix_plmngt(t, u))) -> mem(semicolon(f, g), infix_plmngt(s, - u)))) - -axiom apply_compose : - (forall x:'a. forall f:('a, 'b) tuple2 set. forall g:('b, 'c) tuple2 set. - forall s:'a set. forall t:'b set. forall u:'c set. ((mem(f, infix_plmngt(s, - t)) and (mem(g, infix_plmngt(t, u)) and (mem(x, dom(f)) and mem(apply(f, - x), dom(g))))) -> (apply(semicolon(f, g), x) = apply(g, apply(f, x))))) - -logic infix_gtplgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_partial_injection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgt(s, t)) -> mem(f, infix_plmngt(s, t)))) - -axiom mem_partial_injection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgt(s, t)) -> mem(inverse(f), infix_plmngt(t, s)))) - -axiom mem_partial_injection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngt(s, t)) and mem(inverse(f), infix_plmngt(t, s))) -> mem(f, - infix_gtplgt(s, t)))) - -logic infix_gtmngt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_injection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(f, infix_gtplgt(s, t)))) - -axiom mem_total_injection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(f, infix_mnmngt(s, t)))) - -axiom mem_total_injection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_gtplgt(s, t)) and mem(f, infix_mnmngt(s, t))) -> mem(f, - infix_gtmngt(s, t)))) - -axiom mem_total_injection_alt : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(f, infix_mnmngt(s, t)))) - -axiom mem_total_injection_alt1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(inverse(f), infix_plmngt(t, s)))) - -axiom mem_total_injection_alt2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_mnmngt(s, t)) and mem(inverse(f), infix_plmngt(t, s))) -> mem(f, - infix_gtmngt(s, t)))) - -axiom injection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - (forall x:'a. forall y:'a. (mem(f, infix_gtmngt(s, t)) -> (mem(x, s) -> - (mem(y, s) -> ((apply(f, x) = apply(f, y)) -> (x = y))))))) - -logic infix_plmngtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_partial_surjection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngtgt(s, t)) -> mem(f, infix_plmngt(s, t)))) - -axiom mem_partial_surjection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngtgt(s, t)) -> (ran(f) = t))) - -axiom mem_partial_surjection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngt(s, t)) and (ran(f) = t)) -> mem(f, infix_plmngtgt(s, t)))) - -logic infix_mnmngtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_surjection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngtgt(s, t)) -> mem(f, infix_plmngtgt(s, t)))) - -axiom mem_total_surjection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngtgt(s, t)) -> mem(f, infix_mnmngt(s, t)))) - -axiom mem_total_surjection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngtgt(s, t)) and mem(f, infix_mnmngt(s, t))) -> mem(f, - infix_mnmngtgt(s, t)))) - -logic infix_gtplgtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_partial_bijection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgtgt(s, t)) -> mem(f, infix_gtplgt(s, t)))) - -axiom mem_partial_bijection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgtgt(s, t)) -> mem(f, infix_plmngtgt(s, t)))) - -axiom mem_partial_bijection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_gtplgt(s, t)) and mem(f, infix_plmngtgt(s, t))) -> mem(f, - infix_gtplgtgt(s, t)))) - -logic infix_gtmngtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_bijection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngtgt(s, t)) -> mem(f, infix_gtmngt(s, t)))) - -axiom mem_total_bijection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngtgt(s, t)) -> mem(f, infix_mnmngtgt(s, t)))) - -axiom mem_total_bijection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_gtmngt(s, t)) and mem(f, infix_mnmngtgt(s, t))) -> mem(f, - infix_gtmngtgt(s, t)))) - -logic to_relation : ('a, 'b set) tuple2 set -> ('a, 'b) tuple2 set - -axiom mem_to_relation : - (forall f:('a, 'b set) tuple2 set. forall x:'a. forall y:'b. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_relation(f)) -> mem(x, dom(f)))) - -axiom mem_to_relation1 : - (forall f:('a, 'b set) tuple2 set. forall x:'a. forall y:'b. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_relation(f)) -> mem(y, apply(f, - x)))) - -axiom mem_to_relation2 : - (forall f:('a, 'b set) tuple2 set. forall x:'a. forall y:'b. ((mem(x, - dom(f)) and mem(y, apply(f, x))) -> mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, to_relation(f)))) - -logic to_function : ('a, 'b) tuple2 set -> ('a, 'b set) tuple2 set - -axiom mem_to_function : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b set. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_function(f)) -> mem(x, dom(f)))) - -axiom mem_to_function1 : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b set. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_function(f)) -> infix_eqeq(y, - image(f, add(x, (empty : 'a set)))))) - -axiom mem_to_function2 : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b set. ((mem(x, - dom(f)) and infix_eqeq(y, image(f, add(x, (empty : 'a set))))) -> mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_function(f)))) - -logic insert_in_front : 'a, (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic insert_at_tail : (int, 'a) tuple2 set, 'a -> (int, 'a) tuple2 set - -logic tail : (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic last : (int, 'a) tuple2 set -> 'a - -logic first : (int, 'a) tuple2 set -> 'a - -logic front : (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic concatenation : (int, 'a) tuple2 set, (int, 'a) tuple2 set -> (int, - 'a) tuple2 set - -logic rev : (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic conc : (int, (int, 'a) tuple2 set) tuple2 set -> (int, 'a) tuple2 set - -logic restriction_tail : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -logic restriction_head : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -logic id : 'a set -> ('a, 'a) tuple2 set - -axiom id_def : - (forall x:'a. forall y:'a. forall s:'a set. (mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, id(s)) -> mem(x, s))) - -axiom id_def1 : - (forall x:'a. forall y:'a. forall s:'a set. (mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, id(s)) -> (x = y))) - -axiom id_def2 : - (forall x:'a. forall y:'a. forall s:'a set. ((mem(x, s) and (x = y)) -> - mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, id(s)))) - -axiom id_dom : (forall s:'a set. (dom(id(s)) = s)) - -axiom id_ran : (forall s:'a set. (ran(id(s)) = s)) - -axiom id_fun : (forall s:'a set. mem(id(s), infix_plmngt(s, s))) - -axiom id_total_fun : (forall s:'a set. mem(id(s), infix_mnmngt(s, s))) - -logic string : (int, int) tuple2 set set - -logic integer : int set - -axiom mem_integer : (forall x:int. mem(x, integer)) - -logic natural : int set - -axiom mem_natural : (forall x:int. (mem(x, natural) -> (0 <= x))) - -axiom mem_natural1 : (forall x:int. ((0 <= x) -> mem(x, natural))) - -logic natural1 : int set - -axiom mem_natural11 : (forall x:int. (mem(x, natural1) -> (0 < x))) - -axiom mem_natural12 : (forall x:int. ((0 < x) -> mem(x, natural1))) - -logic nat : int set - -axiom mem_nat : (forall x:int. (mem(x, nat) -> (0 <= x))) - -axiom mem_nat1 : (forall x:int. (mem(x, nat) -> (x <= 2147483647))) - -axiom mem_nat2 : - (forall x:int. (((0 <= x) and (x <= 2147483647)) -> mem(x, nat))) - -logic nat1 : int set - -axiom mem_nat11 : (forall x:int. (mem(x, nat1) -> (0 < x))) - -axiom mem_nat12 : (forall x:int. (mem(x, nat1) -> (x <= 2147483647))) - -axiom mem_nat13 : - (forall x:int. (((0 < x) and (x <= 2147483647)) -> mem(x, nat1))) - -logic bounded_int : int set - -axiom mem_bounded_int : - (forall x:int. (mem(x, bounded_int) -> ((-2147483647) <= x))) - -axiom mem_bounded_int1 : - (forall x:int. (mem(x, bounded_int) -> (x <= 2147483647))) - -axiom mem_bounded_int2 : - (forall x:int. ((((-2147483647) <= x) and (x <= 2147483647)) -> mem(x, - bounded_int))) - -logic mk : int, int -> int set - -axiom mem_interval : - (forall x:int. forall a:int. forall b:int [mem(x, mk(a, b))]. (mem(x, mk(a, - b)) -> (a <= x))) - -axiom mem_interval1 : - (forall x:int. forall a:int. forall b:int [mem(x, mk(a, b))]. (mem(x, mk(a, - b)) -> (x <= b))) - -axiom mem_interval2 : - (forall x:int. forall a:int. forall b:int [mem(x, mk(a, b))]. - (((a <= x) and (x <= b)) -> mem(x, mk(a, b)))) - -axiom interval_empty : - (forall a:int. forall b:int. ((b < a) -> (mk(a, b) = (empty : int set)))) - -axiom interval_add : - (forall a:int. forall b:int. ((a <= b) -> (mk(a, b) = add(b, mk(a, - (b - 1)))))) - -logic is_finite_subset : 'a set, 'a set, int -> prop - -axiom Empty : (forall s:'a set. is_finite_subset((empty : 'a set), s, 0)) - -axiom Add_mem : - (forall x:'a. forall s1:'a set. forall s2:'a set. forall c:int. - (is_finite_subset(s1, s2, c) -> (mem(x, s2) -> (mem(x, s1) -> - is_finite_subset(add(x, s1), s2, c))))) - -axiom Add_notmem : - (forall x:'a. forall s1:'a set. forall s2:'a set. forall c:int. - (is_finite_subset(s1, s2, c) -> (mem(x, s2) -> ((not mem(x, s1)) -> - is_finite_subset(add(x, s1), s2, (c + 1)))))) - -axiom is_finite_subset_inversion : - (forall z:'a set. forall z1:'a set. forall z2:int. (is_finite_subset(z, z1, - z2) -> ((((z = (empty : 'a set)) and (z2 = 0)) or - (exists x:'a. exists s1:'a set. (is_finite_subset(s1, z1, z2) and (mem(x, - z1) and (mem(x, s1) and (z = add(x, s1))))))) or - (exists x:'a. exists s1:'a set. exists c:int. (is_finite_subset(s1, z1, - c) and (mem(x, z1) and ((not mem(x, s1)) and ((z = add(x, s1)) and - (z2 = (c + 1)))))))))) - -axiom finite_interval : - (forall a:int. forall b:int. ((a <= b) -> is_finite_subset(mk(a, b), - integer, ((b - a) + 1)))) - -axiom finite_interval_empty : - (forall a:int. forall b:int. ((b < a) -> is_finite_subset(mk(a, b), - integer, 0))) - -logic finite_subsets : 'a set -> 'a set set - -axiom finite_subsets_def : - (forall s:'a set. forall x:'a set. (mem(x, finite_subsets(s)) -> - (exists c:int. is_finite_subset(x, s, c)))) - -axiom finite_subsets_def1 : - (forall s:'a set. forall x:'a set. - ((exists c:int. is_finite_subset(x, s, c)) -> mem(x, finite_subsets(s)))) - -axiom finite_Empty : - (forall s:'a set. mem((empty : 'a set), finite_subsets(s))) - -axiom finite_Add : - (forall x:'a. forall s1:'a set. forall s2:'a set. (mem(s1, - finite_subsets(s2)) -> (mem(x, s2) -> mem(add(x, s1), - finite_subsets(s2))))) - -axiom finite_Union : - (forall s1:'a set. forall s2:'a set. forall s3:'a set. (mem(s1, - finite_subsets(s3)) -> (mem(s2, finite_subsets(s3)) -> mem(union(s1, s2), - finite_subsets(s3))))) - -axiom finite_inversion : - (forall s1:'a set. forall s2:'a set. (mem(s1, finite_subsets(s2)) -> - ((s1 = (empty : 'a set)) or - (exists x:'a. exists s3:'a set. ((s1 = add(x, s3)) and mem(s3, - finite_subsets(s2))))))) - -logic non_empty_finite_subsets : 'a set -> 'a set set - -axiom non_empty_finite_subsets_def : - (forall s:'a set. forall x:'a set. (mem(x, non_empty_finite_subsets(s)) -> - (exists c:int. (is_finite_subset(x, s, c) and - (not (x = (empty : 'a set))))))) - -axiom non_empty_finite_subsets_def1 : - (forall s:'a set. forall x:'a set. - ((exists c:int. (is_finite_subset(x, s, c) and - (not (x = (empty : 'a set))))) -> - mem(x, non_empty_finite_subsets(s)))) - -axiom card_non_neg : - (forall s:'a set. forall x:'a set. forall c:int. (is_finite_subset(x, s, - c) -> (0 <= c))) - -axiom card_unique : - (forall s:'a set. forall x:'a set. forall c1:int. forall c2:int. - (is_finite_subset(x, s, c1) -> (is_finite_subset(x, s, c2) -> (c1 = c2)))) - -logic card : 'a set -> int - -axiom card_def : - (forall s:'a set. forall x:'a set. forall c:int. (is_finite_subset(x, s, - c) -> (card(x) = c))) - -axiom card_Empty : (card((empty : 'a set)) = 0) - -axiom card_Add_not_mem : - (forall x:'a. forall s1:'a set. forall s2:'a set [mem(s1, - finite_subsets(s2)), card(add(x, s1))]. (mem(s1, finite_subsets(s2)) -> - ((not mem(x, s1)) -> (card(add(x, s1)) = (card(s1) + 1))))) - -axiom card_Add_mem : - (forall x:'a. forall s1:'a set. forall s2:'a set [mem(s1, - finite_subsets(s2)), card(add(x, s1))]. (mem(s1, finite_subsets(s2)) -> - (mem(x, s1) -> (card(add(x, s1)) = card(s1))))) - -axiom card_Union : - (forall s1:'a set. forall s2:'a set. forall s3:'a set [mem(s1, - finite_subsets(s3)), mem(s2, finite_subsets(s3)), card(union(s1, s2))]. - (mem(s1, finite_subsets(s3)) -> (mem(s2, finite_subsets(s3)) -> - (is_empty(inter(s1, s2)) -> (card(union(s1, - s2)) = (card(s1) + card(s2))))))) - -logic infix_lspl : ('a, 'b) tuple2 set, ('a, 'b) tuple2 set -> ('a, - 'b) tuple2 set - -axiom overriding_def : - (forall x:'a. forall y:'b. forall q:('a, 'b) tuple2 set. forall r:('a, - 'b) tuple2 set. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lspl(q, r)) -> (mem(x, dom(r)) -> mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, r)))) - -axiom overriding_def1 : - (forall x:'a. forall y:'b. forall q:('a, 'b) tuple2 set. forall r:('a, - 'b) tuple2 set. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lspl(q, r)) -> ((not mem(x, dom(r))) -> mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, q)))) - -axiom overriding_def2 : - (forall x:'a. forall y:'b. forall q:('a, 'b) tuple2 set. forall r:('a, - 'b) tuple2 set. (((mem(x, dom(r)) and mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, r)) or ((not mem(x, dom(r))) and mem({ Tuple2_proj_1 = - x; Tuple2_proj_2 = y }, q))) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, infix_lspl(q, r)))) - -axiom function_overriding : - (forall s:'a set. forall t:'b set. forall f:('a, 'b) tuple2 set. - forall g:('a, 'b) tuple2 set. ((mem(f, infix_plmngt(s, t)) and mem(g, - infix_plmngt(s, t))) -> mem(infix_lspl(f, g), infix_plmngt(s, t)))) - -axiom dom_overriding : - (forall f:('a, 'b) tuple2 set. forall g:('a, 'b) tuple2 set - [dom(infix_lspl(f, g))]. (dom(infix_lspl(f, g)) = union(dom(f), dom(g)))) - -axiom apply_overriding_1 : - (forall s:'a set. forall t:'b set. forall f:('a, 'b) tuple2 set. - forall g:('a, 'b) tuple2 set. forall x:'a [mem(f, infix_plmngt(s, t)), - mem(g, infix_plmngt(s, t)), apply(infix_lspl(f, g), x)]. ((mem(f, - infix_plmngt(s, t)) and mem(g, infix_plmngt(s, t))) -> (mem(x, dom(g)) -> - (apply(infix_lspl(f, g), x) = apply(g, x))))) - -axiom apply_overriding_2 : - (forall s:'a set. forall t:'b set. forall f:('a, 'b) tuple2 set. - forall g:('a, 'b) tuple2 set. forall x:'a [mem(f, infix_plmngt(s, t)), - apply(infix_lspl(f, g), x)| mem(g, infix_plmngt(s, t)), apply(infix_lspl(f, - g), x)]. ((mem(f, infix_plmngt(s, t)) and mem(g, infix_plmngt(s, t))) -> - ((not mem(x, dom(g))) -> (mem(x, dom(f)) -> (apply(infix_lspl(f, g), - x) = apply(f, x)))))) - -logic power : 'a set -> 'a set set - -axiom mem_power : - (forall x:'a set. forall y:'a set [mem(x, power(y))]. (mem(x, power(y)) -> - subset(x, y))) - -axiom mem_power1 : - (forall x:'a set. forall y:'a set [mem(x, power(y))]. (subset(x, y) -> - mem(x, power(y)))) - -logic non_empty_power : 'a set -> 'a set set - -axiom mem_non_empty_power : - (forall x:'a set. forall y:'a set [mem(x, non_empty_power(y))]. (mem(x, - non_empty_power(y)) -> subset(x, y))) - -axiom mem_non_empty_power1 : - (forall x:'a set. forall y:'a set [mem(x, non_empty_power(y))]. (mem(x, - non_empty_power(y)) -> (not (x = (empty : 'a set))))) - -axiom mem_non_empty_power2 : - (forall x:'a set. forall y:'a set [mem(x, non_empty_power(y))]. ((subset(x, - y) and (not (x = (empty : 'a set)))) -> mem(x, non_empty_power(y)))) - -logic times : 'a set, 'b set -> ('a, 'b) tuple2 set - -axiom times_def : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1 [mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b))]. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b)) -> mem(x, a))) - -axiom times_def1 : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1 [mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b))]. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b)) -> mem(y, b))) - -axiom times_def2 : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1 [mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b))]. ((mem(x, a) and - mem(y, b)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b)))) - -axiom monotonicity_62a : - (forall u:'a set. forall s:'a set. forall v:'b set. forall t:'b set. - ((subset(u, s) and subset(v, t)) -> subset(times(u, v), times(s, t)))) - -axiom subset_times_function : - (forall x:'b. forall s:'a set. forall t:'b set. (mem(x, t) -> mem(times(s, - add(x, (empty : 'b set))), infix_mnmngt(s, t)))) - -function relations(u: 'a set, v: 'b set) : ('a, 'b) tuple2 set set = - power(times(u, v)) - -axiom break_mem_in_add : - (forall c:('a, 'b) tuple2. forall s:('a, 'b) tuple2 set. forall x:'a. - forall y:'b. (mem(c, add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, s)) -> - ((c = { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) or mem(c, s)))) - -axiom break_mem_in_add1 : - (forall c:('a, 'b) tuple2. forall s:('a, 'b) tuple2 set. forall x:'a. - forall y:'b. (((c = { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) or mem(c, - s)) -> mem(c, add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, s)))) - -axiom break_power_times : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (mem(r, - power(times(u, v))) -> subset(r, times(u, v)))) - -axiom break_power_times1 : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (subset(r, - times(u, v)) -> mem(r, power(times(u, v))))) - -axiom subset_of_times : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (subset(r, - times(u, v)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> mem(x, u))))) - -axiom subset_of_times1 : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (subset(r, - times(u, v)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> mem(y, v))))) - -axiom subset_of_times2 : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. - ((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> (mem(x, u) and mem(y, v)))) -> - subset(r, times(u, v)))) - -axiom apply_times : - (forall s:'a set. forall x:'a. forall y:'b [apply(times(s, add(y, - (empty : 'b set))), x)]. (mem(x, s) -> (apply(times(s, add(y, - (empty : 'b set))), x) = y))) - -logic power1 : int, int -> int - -axiom Power_0 : (forall x:int. (power1(x, 0) = 1)) - -axiom Power_s : - (forall x:int. forall n:int. ((0 <= n) -> (power1(x, - (n + 1)) = (x * power1(x, n))))) - -axiom Power_s_alt : - (forall x:int. forall n:int. ((0 < n) -> (power1(x, n) = (x * power1(x, - (n - 1)))))) - -axiom Power_1 : (forall x:int. (power1(x, 1) = x)) - -axiom Power_sum : - (forall x:int. forall n:int. forall m:int. ((0 <= n) -> ((0 <= m) -> - (power1(x, (n + m)) = (power1(x, n) * power1(x, m)))))) - -axiom Power_mult : - (forall x:int. forall n:int. forall m:int. ((0 <= n) -> ((0 <= m) -> - (power1(x, (n * m)) = power1(power1(x, n), m))))) - -axiom Power_mult2 : - (forall x:int. forall y:int. forall n:int. ((0 <= n) -> (power1((x * y), - n) = (power1(x, n) * power1(y, n))))) - -axiom Power_non_neg : - (forall x:int. forall y:int. (((0 <= x) and (0 <= y)) -> (0 <= power1(x, - y)))) - -axiom Power_monotonic : - (forall x:int. forall n:int. forall m:int. (((0 < x) and ((0 <= n) and - (n <= m))) -> (power1(x, n) <= power1(x, m)))) - -logic infix_brgt : ('a, 'b) tuple2 set, 'b set -> ('a, 'b) tuple2 set - -axiom range_restriction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgt(r, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom range_restriction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgt(r, f)) -> mem(y, f))))) - -axiom range_restriction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and mem(y, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgt(r, f)))))) - -logic infix_brgtgt : ('a, 'b) tuple2 set, 'b set -> ('a, 'b) tuple2 set - -axiom range_substraction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgtgt(r, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom range_substraction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgtgt(r, f)) -> (not mem(y, f)))))) - -axiom range_substraction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and (not mem(y, f))) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgtgt(r, f)))))) - -logic infix_lsbr : 'a set, ('a, 'b) tuple2 set -> ('a, 'b) tuple2 set - -axiom domain_restriction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lsbr(f, r)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom domain_restriction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lsbr(f, r)) -> mem(x, f))))) - -axiom domain_restriction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and mem(x, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lsbr(f, r)))))) - -logic infix_lslsbr : 'a set, ('a, 'b) tuple2 set -> ('a, 'b) tuple2 set - -axiom domain_substraction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lslsbr(f, r)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom domain_substraction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lslsbr(f, r)) -> (not mem(x, f)))))) - -axiom domain_substraction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and (not mem(x, f))) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lslsbr(f, r)))))) - -function seq_length(n: int, s: 'a set) : (int, 'a) tuple2 set set = - infix_mnmngt(mk(1, n), s) - -axiom length_uniq : - (forall n1:int. forall n2:int. forall s1:'a set. forall s2:'a set. - forall r:(int, 'a) tuple2 set. (((0 <= n1) and mem(r, seq_length(n1, - s1))) -> (((0 <= n2) and mem(r, seq_length(n2, s2))) -> (n1 = n2)))) - -logic size : (int, 'a) tuple2 set -> int - -axiom size_def : - (forall n:int. forall s:'a set. forall r:(int, 'a) tuple2 set. - (((0 <= n) and mem(r, seq_length(n, s))) -> (size(r) = n))) - -logic seq : 'a set -> (int, 'a) tuple2 set set - -axiom seq_def : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq(s)) -> - (0 <= size(r)))) - -axiom seq_def1 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq(s)) -> mem(r, - seq_length(size(r), s)))) - -axiom seq_def2 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (((0 <= size(r)) and - mem(r, seq_length(size(r), s))) -> mem(r, seq(s)))) - -axiom seq_as_total_function : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq(s)) -> mem(r, - infix_mnmngt(mk(1, size(r)), s)))) - -logic seq1 : 'a set -> (int, 'a) tuple2 set set - -axiom seq1_def : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq1(s)) -> - (0 < size(r)))) - -axiom seq1_def1 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq1(s)) -> mem(r, - seq(s)))) - -axiom seq1_def2 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (((0 < size(r)) and - mem(r, seq(s))) -> mem(r, seq1(s)))) - -logic iseq : 'a set -> (int, 'a) tuple2 set set - -logic iseq1 : 'a set -> (int, 'a) tuple2 set set - -logic perm : 'a set -> (int, 'a) tuple2 set set - -logic infix_slbr : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -axiom head_restriction_def : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_slbr(s, n)) -> mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_lsbr(mk(1, n), s)))))) - -axiom head_restriction_def1 : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_lsbr(mk(1, n), s)) -> mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_slbr(s, n)))))) - -logic infix_brsl : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -axiom tail_restriction_def : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_brsl(s, n)) -> mem({ Tuple2_proj_1 = (i + n); Tuple2_proj_2 = x }, - s))))) - -axiom tail_restriction_def1 : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = (i + n); Tuple2_proj_2 = - x }, s) -> mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, infix_brsl(s, - n)))))) - -logic min : int set -> int - -axiom min_belongs : - (forall s:int set. (subset(s, natural) -> ((not (s = (empty : int set))) -> - mem(min(s), s)))) - -axiom min_is_min : - (forall s:int set. (subset(s, natural) -> ((not (s = (empty : int set))) -> - (forall x:int. (mem(x, s) -> (min(s) <= x)))))) - -logic max : int set -> int - -axiom max_belongs : - (forall s:int set. (mem(s, non_empty_finite_subsets(natural)) -> - mem(max(s), s))) - -axiom max_is_max : - (forall s:int set. (mem(s, non_empty_finite_subsets(natural)) -> - (forall x:int. (mem(x, s) -> (x <= max(s)))))) - -logic iterate : ('a, 'a) tuple2 set, int -> ('a, 'a) tuple2 set - -axiom iterate_zero : - (forall r:('a, 'a) tuple2 set. (iterate(r, 0) = id(dom(r)))) - -axiom iterate_succ : - (forall r:('a, 'a) tuple2 set. forall n:int. ((0 < n) -> (iterate(r, - n) = semicolon(r, iterate(r, (n - 1)))))) - -logic closure : ('a, 'a) tuple2 set -> ('a, 'a) tuple2 set - -axiom closure_def : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. (mem(u, - closure(r)) -> (exists x:int. ((0 <= x) and mem(u, iterate(r, x)))))) - -axiom closure_def1 : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. - ((exists x:int. ((0 <= x) and mem(u, iterate(r, x)))) -> mem(u, - closure(r)))) - -logic closure1 : ('a, 'a) tuple2 set -> ('a, 'a) tuple2 set - -axiom closure1_def : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. (mem(u, - closure1(r)) -> (exists x:int. ((0 < x) and mem(u, iterate(r, x)))))) - -axiom closure1_def1 : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. - ((exists x:int. ((0 < x) and mem(u, iterate(r, x)))) -> mem(u, - closure1(r)))) - -logic prj1 : ('a set, 'b set) tuple2 -> (('a, 'b) tuple2, 'a) tuple2 set - -axiom prj1_def : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1. ((mem(x, - a) and mem(y, b)) -> (apply(prj1({ Tuple2_proj_1 = a; Tuple2_proj_2 = b }), - { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) = x))) - -logic prj2 : ('a set, 'b set) tuple2 -> (('a, 'b) tuple2, 'b) tuple2 set - -axiom prj2_def : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1. ((mem(x, - a) and mem(y, b)) -> (apply(prj2({ Tuple2_proj_1 = a; Tuple2_proj_2 = b }), - { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) = y))) - -logic generalized_union : 'a set set -> 'a set - -axiom generalized_union_def : - (forall s:'a set set. forall x:'a. (mem(x, generalized_union(s)) -> - (exists y:'a set. (mem(x, y) and mem(y, s))))) - -axiom generalized_union_def1 : - (forall s:'a set set. forall x:'a. - ((exists y:'a set. (mem(x, y) and mem(y, s))) -> mem(x, - generalized_union(s)))) - -type ('a, -'b) func - -logic infix_at : ('a, 'b) func, 'a -> 'b - -logic comprehension : ('a, bool) func -> 'a set - -axiom comprehension_def : - (forall p:('a, bool) func. - (forall x:'a. (mem(x, comprehension(p)) -> (infix_at(p, x) = true)))) - -axiom comprehension_def1 : - (forall p:('a, bool) func. - (forall x:'a. ((infix_at(p, x) = true) -> mem(x, comprehension(p))))) - -logic fc : ('a, bool) func, 'a set -> ('a, bool) func - -axiom fc_def : - (forall p:('a, bool) func. forall u:'a set. forall x:'a. ((infix_at(fc(p, - u), x) = true) -> (infix_at(p, x) = true))) - -axiom fc_def1 : - (forall p:('a, bool) func. forall u:'a set. forall x:'a. ((infix_at(fc(p, - u), x) = true) -> mem(x, u))) - -axiom fc_def2 : - (forall p:('a, bool) func. forall u:'a set. forall x:'a. (((infix_at(p, - x) = true) and mem(x, u)) -> (infix_at(fc(p, u), x) = true))) - -function filter(p: ('a, bool) func, u: 'a set) : 'a set = comprehension(fc(p, - u)) - -logic fc1 : ('a, 'b) func, 'a set -> ('b, bool) func - -axiom fc_def3 : - (forall f:('a, 'b) func. forall u:'a set. forall y:'b. ((infix_at(fc1(f, - u), y) = true) -> (exists x:'a. (mem(x, u) and (y = infix_at(f, x)))))) - -axiom fc_def4 : - (forall f:('a, 'b) func. forall u:'a set. forall y:'b. - ((exists x:'a. (mem(x, u) and (y = infix_at(f, x)))) -> (infix_at(fc1(f, - u), y) = true))) - -function map(f: ('a, 'b) func, u: 'a set) : 'b set = comprehension(fc1(f, u)) - -axiom map_def : - (forall f:('a, 'b) func. forall u:'a set. - (forall x:'a. (mem(x, u) -> mem(infix_at(f, x), map(f, u))))) - -logic sum : int set -> int - -axiom sum_def0 : (sum((empty : int set)) = 0) - -axiom sum_def1 : - (forall s:int set. forall x:int. (mem(x, s) -> (sum(s) = (x + sum(remove(x, - s)))))) - -function sigma(p: ('a, bool) func, f: ('a, int) func) : int = sum(map(f, - comprehension(p))) diff --git a/src/plugins/AB-Why3/preludes/b-set-theory-prelude-2020-02-28.ae b/src/plugins/AB-Why3/preludes/b-set-theory-prelude-2020-02-28.ae deleted file mode 100644 index 8abe87e59b..0000000000 --- a/src/plugins/AB-Why3/preludes/b-set-theory-prelude-2020-02-28.ae +++ /dev/null @@ -1,1315 +0,0 @@ -(* this is the prelude for Alt-Ergo, version >= 0.95.2 *) -(* this is a prelude for Alt-Ergo integer arithmetic *) -logic comp_div: int, int -> int -axiom comp_div_def: forall x, y:int. x >= 0 and y > 0 -> comp_div(x,y) = x / y -logic comp_mod: int, int -> int -axiom comp_mod_def: forall x, y:int. x >= 0 and y > 0 -> comp_mod(x,y) = x % y -logic match_bool : bool, 'a, 'a -> 'a - -axiom match_bool_True : - (forall z:'a. forall z1:'a. (match_bool(true, z, z1) = z)) - -axiom match_bool_False : - (forall z:'a. forall z1:'a. (match_bool(false, z, z1) = z1)) - -function andb(x: bool, y: bool) : bool = match_bool(x, y, false) - -function orb(x: bool, y: bool) : bool = match_bool(x, true, y) - -function notb(x: bool) : bool = match_bool(x, false, true) - -function xorb(x: bool, y: bool) : bool = match_bool(x, notb(y), y) - -function implb(x: bool, y: bool) : bool = match_bool(x, y, true) - -axiom CompatOrderMult : - (forall x:int. forall y:int. forall z:int. ((x <= y) -> ((0 <= z) -> - ((x * z) <= (y * z))))) - -logic abs : int -> int - -axiom abs_def : (forall x:int. ((0 <= x) -> (abs(x) = x))) - -axiom abs_def1 : (forall x:int. ((not (0 <= x)) -> (abs(x) = (-x)))) - -axiom Abs_le : (forall x:int. forall y:int. ((abs(x) <= y) -> ((-y) <= x))) - -axiom Abs_le1 : (forall x:int. forall y:int. ((abs(x) <= y) -> (x <= y))) - -axiom Abs_le2 : - (forall x:int. forall y:int. ((((-y) <= x) and (x <= y)) -> (abs(x) <= y))) - -axiom Abs_pos : (forall x:int. (0 <= abs(x))) - -axiom Div_mod : - (forall x:int. forall y:int. ((not (y = 0)) -> - (x = ((y * comp_div(x,y)) + comp_mod(x,y))))) - -axiom Div_bound : - (forall x:int. forall y:int. (((0 <= x) and (0 < y)) -> - (0 <= comp_div(x,y)))) - -axiom Div_bound1 : - (forall x:int. forall y:int. (((0 <= x) and (0 < y)) -> - (comp_div(x,y) <= x))) - -axiom Mod_bound : - (forall x:int. forall y:int. ((not (y = 0)) -> - ((-abs(y)) < comp_mod(x,y)))) - -axiom Mod_bound1 : - (forall x:int. forall y:int. ((not (y = 0)) -> (comp_mod(x,y) < abs(y)))) - -axiom Div_sign_pos : - (forall x:int. forall y:int. (((0 <= x) and (0 < y)) -> - (0 <= comp_div(x,y)))) - -axiom Div_sign_neg : - (forall x:int. forall y:int. (((x <= 0) and (0 < y)) -> - (comp_div(x,y) <= 0))) - -axiom Mod_sign_pos : - (forall x:int. forall y:int. (((0 <= x) and (not (y = 0))) -> - (0 <= comp_mod(x,y)))) - -axiom Mod_sign_neg : - (forall x:int. forall y:int. (((x <= 0) and (not (y = 0))) -> - (comp_mod(x,y) <= 0))) - -axiom Rounds_toward_zero : - (forall x:int. forall y:int. ((not (y = 0)) -> - (abs((comp_div(x,y) * y)) <= abs(x)))) - -axiom Div_1 : (forall x:int. (comp_div(x,1) = x)) - -axiom Mod_1 : (forall x:int. (comp_mod(x,1) = 0)) - -axiom Div_inf : - (forall x:int. forall y:int. (((0 <= x) and (x < y)) -> - (comp_div(x,y) = 0))) - -axiom Mod_inf : - (forall x:int. forall y:int. (((0 <= x) and (x < y)) -> - (comp_mod(x,y) = x))) - -axiom Div_mult : - (forall x:int. forall y:int. forall z:int [comp_div(((x * y) + z),x)]. - (((0 < x) and ((0 <= y) and (0 <= z))) -> - (comp_div(((x * y) + z),x) = (y + comp_div(z,x))))) - -axiom Mod_mult : - (forall x:int. forall y:int. forall z:int [comp_mod(((x * y) + z),x)]. - (((0 < x) and ((0 <= y) and (0 <= z))) -> - (comp_mod(((x * y) + z),x) = comp_mod(z,x)))) - -type 'a set - -logic mem : 'a, 'a set -> prop - -predicate infix_eqeq(s1: 'a set, s2: 'a set) = - (forall x:'a. (mem(x, s1) <-> mem(x, s2))) - -axiom extensionality : - (forall s1:'a set. forall s2:'a set. (infix_eqeq(s1, s2) -> (s1 = s2))) - -predicate subset(s1: 'a set, s2: 'a set) = - (forall x:'a. (mem(x, s1) -> mem(x, s2))) - -axiom subset_refl : (forall s:'a set. subset(s, s)) - -axiom subset_trans : - (forall s1:'a set. forall s2:'a set. forall s3:'a set. (subset(s1, s2) -> - (subset(s2, s3) -> subset(s1, s3)))) - -logic empty : 'a set - -predicate is_empty(s: 'a set) = (forall x:'a. (not mem(x, s))) - -axiom empty_def1 : is_empty((empty : 'a set)) - -axiom mem_empty : (forall x:'a. (not mem(x, (empty : 'a set)))) - -axiom mem_empty1 : true - -logic add : 'a, 'a set -> 'a set - -axiom add_def1 : - (forall x:'a. forall y:'a. - (forall s:'a set. (mem(x, add(y, s)) -> ((x = y) or mem(x, s))))) - -axiom add_def11 : - (forall x:'a. forall y:'a. - (forall s:'a set. (((x = y) or mem(x, s)) -> mem(x, add(y, s))))) - -logic remove : 'a, 'a set -> 'a set - -axiom remove_def1 : - (forall x:'a. forall y:'a. forall s:'a set. (mem(x, remove(y, s)) -> - (not (x = y)))) - -axiom remove_def11 : - (forall x:'a. forall y:'a. forall s:'a set. (mem(x, remove(y, s)) -> mem(x, - s))) - -axiom remove_def12 : - (forall x:'a. forall y:'a. forall s:'a set. (((not (x = y)) and mem(x, - s)) -> mem(x, remove(y, s)))) - -axiom add_remove : - (forall x:'a. forall s:'a set. (mem(x, s) -> (add(x, remove(x, s)) = s))) - -axiom remove_add : - (forall x:'a. forall s:'a set. (remove(x, add(x, s)) = remove(x, s))) - -axiom subset_remove : (forall x:'a. forall s:'a set. subset(remove(x, s), s)) - -logic union : 'a set, 'a set -> 'a set - -axiom union_def1 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, union(s1, s2)) -> - (mem(x, s1) or mem(x, s2)))) - -axiom union_def11 : - (forall s1:'a set. forall s2:'a set. forall x:'a. ((mem(x, s1) or mem(x, - s2)) -> mem(x, union(s1, s2)))) - -logic inter : 'a set, 'a set -> 'a set - -axiom inter_def1 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, inter(s1, s2)) -> - mem(x, s1))) - -axiom inter_def11 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, inter(s1, s2)) -> - mem(x, s2))) - -axiom inter_def12 : - (forall s1:'a set. forall s2:'a set. forall x:'a. ((mem(x, s1) and mem(x, - s2)) -> mem(x, inter(s1, s2)))) - -logic diff : 'a set, 'a set -> 'a set - -axiom diff_def1 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, diff(s1, s2)) -> - mem(x, s1))) - -axiom diff_def11 : - (forall s1:'a set. forall s2:'a set. forall x:'a. (mem(x, diff(s1, s2)) -> - (not mem(x, s2)))) - -axiom diff_def12 : - (forall s1:'a set. forall s2:'a set. forall x:'a. ((mem(x, s1) and - (not mem(x, s2))) -> mem(x, diff(s1, s2)))) - -axiom subset_diff : - (forall s1:'a set. forall s2:'a set. subset(diff(s1, s2), s1)) - -logic choose : 'a set -> 'a - -axiom choose_def : - (forall s:'a set. ((not is_empty(s)) -> mem(choose(s), s))) - -logic all : 'a set - -axiom all_def : (forall x:'a. mem(x, (all : 'a set))) - -logic b_bool : bool set - -axiom mem_b_bool : (forall x:bool. mem(x, b_bool)) - -type ('a, 'a1) tuple2 = { Tuple2_proj_1 : 'a; Tuple2_proj_2 : 'a1 -} - -logic relation : 'a2 set, 'b set -> ('a2, 'b) tuple2 set set - -axiom mem_relation : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - relation(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(x, s))))) - -axiom mem_relation1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - relation(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(y, t))))) - -axiom mem_relation2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - ((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> (mem(x, s) and mem(y, t)))) -> - mem(f, relation(s, t)))) - -logic image : ('a, 'b) tuple2 set, 'a set -> 'b set - -axiom mem_image : - (forall r:('a, 'b) tuple2 set. forall dom:'a set. forall y:'b [mem(y, - image(r, dom))]. (mem(y, image(r, dom)) -> - (exists x:'a. (mem(x, dom) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r))))) - -axiom mem_image1 : - (forall r:('a, 'b) tuple2 set. forall dom:'a set. forall y:'b [mem(y, - image(r, dom))]. - ((exists x:'a. (mem(x, dom) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r))) -> - mem(y, image(r, dom)))) - -axiom image_union : - (forall r:('a, 'b) tuple2 set. forall s:'a set. forall t:'a set. (image(r, - union(s, t)) = union(image(r, s), image(r, t)))) - -axiom image_add : - (forall r:('a, 'b) tuple2 set. forall dom:'a set. forall x:'a. (image(r, - add(x, dom)) = union(image(r, add(x, (empty : 'a set))), image(r, dom)))) - -logic infix_plmngt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngt(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(x, s))))) - -axiom mem_function1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngt(s, t)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(y, t))))) - -axiom mem_function2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngt(s, t)) -> - (forall x:'a. forall y1:'b. forall y2:'b. ((mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y1 }, f) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y2 }, - f)) -> (y1 = y2))))) - -axiom mem_function3 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - (((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> (mem(x, s) and mem(y, t)))) and - (forall x:'a. forall y1:'b. forall y2:'b. ((mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y1 }, f) and mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y2 }, - f)) -> (y1 = y2)))) -> mem(f, infix_plmngt(s, t)))) - -axiom domain_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall x:'a. forall y:'b. (mem(f, infix_plmngt(s, t)) -> (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, f) -> mem(x, s)))) - -axiom range_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall x:'a. forall y:'b. (mem(f, infix_plmngt(s, t)) -> (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, f) -> mem(y, t)))) - -axiom function_extend_range : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall u:'b set. (subset(t, u) -> (mem(f, infix_plmngt(s, t)) -> mem(f, - infix_plmngt(s, u))))) - -axiom function_reduce_range : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall u:'b set. (subset(u, t) -> (mem(f, infix_plmngt(s, t)) -> - ((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - f) -> mem(y, u))) -> - mem(f, infix_plmngt(s, u)))))) - -logic inverse : ('a, 'b) tuple2 set -> ('b, 'a) tuple2 set - -axiom Inverse_def : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = x }, - inverse(r)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r)))) - -axiom Inverse_def1 : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = x }, inverse(r))))) - -logic dom : ('a, 'b) tuple2 set -> 'a set - -axiom dom_def : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. (mem(x, dom(r)) -> - (exists y:'b. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom dom_def1 : - (forall r:('a, 'b) tuple2 set. - (forall x:'a. - ((exists y:'b. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r)) -> mem(x, - dom(r))))) - -logic ran : ('a, 'b) tuple2 set -> 'b set - -axiom ran_def : - (forall r:('a, 'b) tuple2 set. - (forall y:'b. (mem(y, ran(r)) -> - (exists x:'a. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom ran_def1 : - (forall r:('a, 'b) tuple2 set. - (forall y:'b. - ((exists x:'a. mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r)) -> mem(y, - ran(r))))) - -axiom dom_empty : (dom((empty : ('a, 'b) tuple2 set)) = (empty : 'a set)) - -axiom dom_add : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b. (dom(add({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, f)) = add(x, dom(f)))) - -axiom dom_singleton : - (forall x:'a. forall y:'b. (dom(add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, (empty : ('a, 'b) tuple2 set))) = add(x, (empty : 'a set)))) - -logic infix_mnmngt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_functions : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngt(s, t)) -> mem(f, infix_plmngt(s, t)))) - -axiom mem_total_functions1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngt(s, t)) -> (dom(f) = s))) - -axiom mem_total_functions2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngt(s, t)) and (dom(f) = s)) -> mem(f, infix_mnmngt(s, t)))) - -axiom total_function_is_function : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set [mem(f, - infix_mnmngt(s, t))]. (mem(f, infix_mnmngt(s, t)) -> mem(f, infix_plmngt(s, - t)))) - -axiom singleton_is_partial_function : - (forall s:'a set. forall t:'b set. forall x:'a. forall y:'b. ((mem(x, - s) and mem(y, t)) -> mem(add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - (empty : ('a, 'b) tuple2 set)), infix_plmngt(s, t)))) - -axiom singleton_is_function : - (forall x:'a. forall y:'b [add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - (empty : ('a, 'b) tuple2 set))]. mem(add({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, (empty : ('a, 'b) tuple2 set)), infix_mnmngt(add(x, - (empty : 'a set)), add(y, (empty : 'b set))))) - -logic apply : ('a, 'b) tuple2 set, 'a -> 'b - -axiom apply_def0 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall a1:'a. ((mem(f, infix_plmngt(s, t)) and mem(a1, dom(f))) -> mem({ - Tuple2_proj_1 = a1; Tuple2_proj_2 = apply(f, a1) }, f))) - -axiom apply_def1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall a1:'a. ((mem(f, infix_mnmngt(s, t)) and mem(a1, s)) -> mem({ - Tuple2_proj_1 = a1; Tuple2_proj_2 = apply(f, a1) }, f))) - -axiom apply_def2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - forall a1:'a. forall b1:'b. ((mem(f, infix_plmngt(s, t)) and mem({ - Tuple2_proj_1 = a1; Tuple2_proj_2 = b1 }, f)) -> (apply(f, a1) = b1))) - -axiom apply_singleton : - (forall x:'a. forall y:'b. (apply(add({ Tuple2_proj_1 = x; Tuple2_proj_2 = - y }, (empty : ('a, 'b) tuple2 set)), x) = y)) - -axiom apply_range : - (forall x:'a. forall f:('a, 'b) tuple2 set. forall s:'a set. - forall t:'b set [mem(f, infix_plmngt(s, t)), apply(f, x)]. ((mem(f, - infix_plmngt(s, t)) and mem(x, dom(f))) -> mem(apply(f, x), t))) - -logic semicolon : ('a, 'b) tuple2 set, ('b, 'c) tuple2 set -> ('a, - 'c) tuple2 set - -axiom semicolon_def : - (forall x:'a. forall z:'c. forall p:('a, 'b) tuple2 set. forall q:('b, - 'c) tuple2 set. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = z }, semicolon(p, - q)) -> - (exists y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, p) and mem({ - Tuple2_proj_1 = y; Tuple2_proj_2 = z }, q))))) - -axiom semicolon_def1 : - (forall x:'a. forall z:'c. forall p:('a, 'b) tuple2 set. forall q:('b, - 'c) tuple2 set. - ((exists y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, p) and mem({ - Tuple2_proj_1 = y; Tuple2_proj_2 = z }, q))) -> - mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = z }, semicolon(p, q)))) - -logic direct_product : ('a, 'b) tuple2 set, ('a, 'c) tuple2 set -> ('a, ('b, - 'c) tuple2) tuple2 set - -axiom direct_product_def : - (forall e:('t, ('u, 'v) tuple2) tuple2. forall r1:('t, 'u) tuple2 set. - forall r2:('t, 'v) tuple2 set [mem(e, direct_product(r1, r2))]. (mem(e, - direct_product(r1, r2)) -> - (exists x:'t. exists y:'u. exists z:'v. (({ Tuple2_proj_1 = x; - Tuple2_proj_2 = { Tuple2_proj_1 = y; Tuple2_proj_2 = z } } = e) and (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r1) and mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = z }, r2)))))) - -axiom direct_product_def1 : - (forall e:('t, ('u, 'v) tuple2) tuple2. forall r1:('t, 'u) tuple2 set. - forall r2:('t, 'v) tuple2 set [mem(e, direct_product(r1, r2))]. - ((exists x:'t. exists y:'u. exists z:'v. (({ Tuple2_proj_1 = x; - Tuple2_proj_2 = { Tuple2_proj_1 = y; Tuple2_proj_2 = z } } = e) and (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r1) and mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = z }, r2)))) -> - mem(e, direct_product(r1, r2)))) - -logic parallel_product : ('a, 'b) tuple2 set, ('c, 'd) tuple2 set -> (('a, - 'c) tuple2, ('b, 'd) tuple2) tuple2 set - -axiom parallel_product_def : - (forall e:(('t, 'v) tuple2, ('u, 'w) tuple2) tuple2. forall r1:('t, - 'u) tuple2 set. forall r2:('v, 'w) tuple2 set. (mem(e, parallel_product(r1, - r2)) -> - (exists x:'t. exists y:'v. exists z:'u. exists a:'w. (({ Tuple2_proj_1 = { - Tuple2_proj_1 = x; Tuple2_proj_2 = y }; Tuple2_proj_2 = { Tuple2_proj_1 = - z; Tuple2_proj_2 = a } } = e) and (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = - z }, r1) and mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = a }, r2)))))) - -axiom parallel_product_def1 : - (forall e:(('t, 'v) tuple2, ('u, 'w) tuple2) tuple2. forall r1:('t, - 'u) tuple2 set. forall r2:('v, 'w) tuple2 set. - ((exists x:'t. exists y:'v. exists z:'u. exists a:'w. (({ Tuple2_proj_1 = { - Tuple2_proj_1 = x; Tuple2_proj_2 = y }; Tuple2_proj_2 = { Tuple2_proj_1 = - z; Tuple2_proj_2 = a } } = e) and (mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = z }, r1) and mem({ Tuple2_proj_1 = y; Tuple2_proj_2 = a }, - r2)))) -> - mem(e, parallel_product(r1, r2)))) - -axiom semicolon_dom : - (forall f:('a, 'b) tuple2 set. forall g:('b, 'c) tuple2 set. - subset(dom(semicolon(f, g)), dom(f))) - -axiom semicolon_is_function : - (forall f:('a, 'b) tuple2 set. forall g:('b, 'c) tuple2 set. - forall s:'a set. forall t:'b set. forall u:'c set. ((mem(f, infix_plmngt(s, - t)) and mem(g, infix_plmngt(t, u))) -> mem(semicolon(f, g), infix_plmngt(s, - u)))) - -axiom apply_compose : - (forall x:'a. forall f:('a, 'b) tuple2 set. forall g:('b, 'c) tuple2 set. - forall s:'a set. forall t:'b set. forall u:'c set. ((mem(f, infix_plmngt(s, - t)) and (mem(g, infix_plmngt(t, u)) and (mem(x, dom(f)) and mem(apply(f, - x), dom(g))))) -> (apply(semicolon(f, g), x) = apply(g, apply(f, x))))) - -logic infix_gtplgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_partial_injection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgt(s, t)) -> mem(f, infix_plmngt(s, t)))) - -axiom mem_partial_injection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgt(s, t)) -> mem(inverse(f), infix_plmngt(t, s)))) - -axiom mem_partial_injection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngt(s, t)) and mem(inverse(f), infix_plmngt(t, s))) -> mem(f, - infix_gtplgt(s, t)))) - -logic infix_gtmngt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_injection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(f, infix_gtplgt(s, t)))) - -axiom mem_total_injection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(f, infix_mnmngt(s, t)))) - -axiom mem_total_injection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_gtplgt(s, t)) and mem(f, infix_mnmngt(s, t))) -> mem(f, - infix_gtmngt(s, t)))) - -axiom mem_total_injection_alt : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(f, infix_mnmngt(s, t)))) - -axiom mem_total_injection_alt1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngt(s, t)) -> mem(inverse(f), infix_plmngt(t, s)))) - -axiom mem_total_injection_alt2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_mnmngt(s, t)) and mem(inverse(f), infix_plmngt(t, s))) -> mem(f, - infix_gtmngt(s, t)))) - -axiom injection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. - (forall x:'a. forall y:'a. (mem(f, infix_gtmngt(s, t)) -> (mem(x, s) -> - (mem(y, s) -> ((apply(f, x) = apply(f, y)) -> (x = y))))))) - -logic infix_plmngtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_partial_surjection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngtgt(s, t)) -> mem(f, infix_plmngt(s, t)))) - -axiom mem_partial_surjection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_plmngtgt(s, t)) -> (ran(f) = t))) - -axiom mem_partial_surjection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngt(s, t)) and (ran(f) = t)) -> mem(f, infix_plmngtgt(s, t)))) - -logic infix_mnmngtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_surjection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngtgt(s, t)) -> mem(f, infix_plmngtgt(s, t)))) - -axiom mem_total_surjection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_mnmngtgt(s, t)) -> mem(f, infix_mnmngt(s, t)))) - -axiom mem_total_surjection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_plmngtgt(s, t)) and mem(f, infix_mnmngt(s, t))) -> mem(f, - infix_mnmngtgt(s, t)))) - -logic infix_gtplgtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_partial_bijection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgtgt(s, t)) -> mem(f, infix_gtplgt(s, t)))) - -axiom mem_partial_bijection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtplgtgt(s, t)) -> mem(f, infix_plmngtgt(s, t)))) - -axiom mem_partial_bijection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_gtplgt(s, t)) and mem(f, infix_plmngtgt(s, t))) -> mem(f, - infix_gtplgtgt(s, t)))) - -logic infix_gtmngtgt : 'a set, 'b set -> ('a, 'b) tuple2 set set - -axiom mem_total_bijection : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngtgt(s, t)) -> mem(f, infix_gtmngt(s, t)))) - -axiom mem_total_bijection1 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. (mem(f, - infix_gtmngtgt(s, t)) -> mem(f, infix_mnmngtgt(s, t)))) - -axiom mem_total_bijection2 : - (forall f:('a, 'b) tuple2 set. forall s:'a set. forall t:'b set. ((mem(f, - infix_gtmngt(s, t)) and mem(f, infix_mnmngtgt(s, t))) -> mem(f, - infix_gtmngtgt(s, t)))) - -logic to_relation : ('a, 'b set) tuple2 set -> ('a, 'b) tuple2 set - -axiom mem_to_relation : - (forall f:('a, 'b set) tuple2 set. forall x:'a. forall y:'b. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_relation(f)) -> mem(x, dom(f)))) - -axiom mem_to_relation1 : - (forall f:('a, 'b set) tuple2 set. forall x:'a. forall y:'b. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_relation(f)) -> mem(y, apply(f, - x)))) - -axiom mem_to_relation2 : - (forall f:('a, 'b set) tuple2 set. forall x:'a. forall y:'b. ((mem(x, - dom(f)) and mem(y, apply(f, x))) -> mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, to_relation(f)))) - -logic to_function : ('a, 'b) tuple2 set -> ('a, 'b set) tuple2 set - -axiom mem_to_function : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b set. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_function(f)) -> mem(x, dom(f)))) - -axiom mem_to_function1 : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b set. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_function(f)) -> infix_eqeq(y, - image(f, add(x, (empty : 'a set)))))) - -axiom mem_to_function2 : - (forall f:('a, 'b) tuple2 set. forall x:'a. forall y:'b set. ((mem(x, - dom(f)) and infix_eqeq(y, image(f, add(x, (empty : 'a set))))) -> mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, to_function(f)))) - -logic insert_in_front : 'a, (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic insert_at_tail : (int, 'a) tuple2 set, 'a -> (int, 'a) tuple2 set - -logic tail : (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic last : (int, 'a) tuple2 set -> 'a - -logic first : (int, 'a) tuple2 set -> 'a - -logic front : (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic concatenation : (int, 'a) tuple2 set, (int, 'a) tuple2 set -> (int, - 'a) tuple2 set - -logic rev : (int, 'a) tuple2 set -> (int, 'a) tuple2 set - -logic conc : (int, (int, 'a) tuple2 set) tuple2 set -> (int, 'a) tuple2 set - -logic restriction_tail : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -logic restriction_head : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -logic id : 'a set -> ('a, 'a) tuple2 set - -axiom id_def : - (forall x:'a. forall y:'a. forall s:'a set. (mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, id(s)) -> mem(x, s))) - -axiom id_def1 : - (forall x:'a. forall y:'a. forall s:'a set. (mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, id(s)) -> (x = y))) - -axiom id_def2 : - (forall x:'a. forall y:'a. forall s:'a set. ((mem(x, s) and (x = y)) -> - mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, id(s)))) - -axiom id_dom : (forall s:'a set. (dom(id(s)) = s)) - -axiom id_ran : (forall s:'a set. (ran(id(s)) = s)) - -axiom id_fun : (forall s:'a set. mem(id(s), infix_plmngt(s, s))) - -axiom id_total_fun : (forall s:'a set. mem(id(s), infix_mnmngt(s, s))) - -logic string : (int, int) tuple2 set set - -logic integer : int set - -axiom mem_integer : (forall x:int. mem(x, integer)) - -logic natural : int set - -axiom mem_natural : (forall x:int. (mem(x, natural) -> (0 <= x))) - -axiom mem_natural1 : (forall x:int. ((0 <= x) -> mem(x, natural))) - -logic natural1 : int set - -axiom mem_natural11 : (forall x:int. (mem(x, natural1) -> (0 < x))) - -axiom mem_natural12 : (forall x:int. ((0 < x) -> mem(x, natural1))) - -logic nat : int set - -axiom mem_nat : (forall x:int. (mem(x, nat) -> (0 <= x))) - -axiom mem_nat1 : (forall x:int. (mem(x, nat) -> (x <= 2147483647))) - -axiom mem_nat2 : - (forall x:int. (((0 <= x) and (x <= 2147483647)) -> mem(x, nat))) - -logic nat1 : int set - -axiom mem_nat11 : (forall x:int. (mem(x, nat1) -> (0 < x))) - -axiom mem_nat12 : (forall x:int. (mem(x, nat1) -> (x <= 2147483647))) - -axiom mem_nat13 : - (forall x:int. (((0 < x) and (x <= 2147483647)) -> mem(x, nat1))) - -logic bounded_int : int set - -axiom mem_bounded_int : - (forall x:int. (mem(x, bounded_int) -> ((-2147483647) <= x))) - -axiom mem_bounded_int1 : - (forall x:int. (mem(x, bounded_int) -> (x <= 2147483647))) - -axiom mem_bounded_int2 : - (forall x:int. ((((-2147483647) <= x) and (x <= 2147483647)) -> mem(x, - bounded_int))) - -logic mk : int, int -> int set - -axiom mem_interval : - (forall x:int. forall a:int. forall b:int [mem(x, mk(a, b))]. (mem(x, mk(a, - b)) -> (a <= x))) - -axiom mem_interval1 : - (forall x:int. forall a:int. forall b:int [mem(x, mk(a, b))]. (mem(x, mk(a, - b)) -> (x <= b))) - -axiom mem_interval2 : - (forall x:int. forall a:int. forall b:int [mem(x, mk(a, b))]. - (((a <= x) and (x <= b)) -> mem(x, mk(a, b)))) - -axiom interval_empty : - (forall a:int. forall b:int. ((b < a) -> (mk(a, b) = (empty : int set)))) - -axiom interval_add : - (forall a:int. forall b:int. ((a <= b) -> (mk(a, b) = add(b, mk(a, - (b - 1)))))) - -logic is_finite_subset : 'a set, 'a set, int -> prop - -axiom Empty : (forall s:'a set. is_finite_subset((empty : 'a set), s, 0)) - -axiom Add_mem : - (forall x:'a. forall s1:'a set. forall s2:'a set. forall c:int. - (is_finite_subset(s1, s2, c) -> (mem(x, s2) -> (mem(x, s1) -> - is_finite_subset(add(x, s1), s2, c))))) - -axiom Add_notmem : - (forall x:'a. forall s1:'a set. forall s2:'a set. forall c:int. - (is_finite_subset(s1, s2, c) -> (mem(x, s2) -> ((not mem(x, s1)) -> - is_finite_subset(add(x, s1), s2, (c + 1)))))) - -axiom is_finite_subset_inversion : - (forall z:'a set. forall z1:'a set. forall z2:int. (is_finite_subset(z, z1, - z2) -> ((((z = (empty : 'a set)) and (z2 = 0)) or - (exists x:'a. exists s1:'a set. (is_finite_subset(s1, z1, z2) and (mem(x, - z1) and (mem(x, s1) and (z = add(x, s1))))))) or - (exists x:'a. exists s1:'a set. exists c:int. (is_finite_subset(s1, z1, - c) and (mem(x, z1) and ((not mem(x, s1)) and ((z = add(x, s1)) and - (z2 = (c + 1)))))))))) - -axiom finite_interval : - (forall a:int. forall b:int. ((a <= b) -> is_finite_subset(mk(a, b), - integer, ((b - a) + 1)))) - -axiom finite_interval_empty : - (forall a:int. forall b:int. ((b < a) -> is_finite_subset(mk(a, b), - integer, 0))) - -logic finite_subsets : 'a set -> 'a set set - -axiom finite_subsets_def : - (forall s:'a set. forall x:'a set. (mem(x, finite_subsets(s)) -> - (exists c:int. is_finite_subset(x, s, c)))) - -axiom finite_subsets_def1 : - (forall s:'a set. forall x:'a set. - ((exists c:int. is_finite_subset(x, s, c)) -> mem(x, finite_subsets(s)))) - -axiom finite_Empty : - (forall s:'a set. mem((empty : 'a set), finite_subsets(s))) - -axiom finite_Add : - (forall x:'a. forall s1:'a set. forall s2:'a set. (mem(s1, - finite_subsets(s2)) -> (mem(x, s2) -> mem(add(x, s1), - finite_subsets(s2))))) - -axiom finite_Union : - (forall s1:'a set. forall s2:'a set. forall s3:'a set. (mem(s1, - finite_subsets(s3)) -> (mem(s2, finite_subsets(s3)) -> mem(union(s1, s2), - finite_subsets(s3))))) - -axiom finite_inversion : - (forall s1:'a set. forall s2:'a set. (mem(s1, finite_subsets(s2)) -> - ((s1 = (empty : 'a set)) or - (exists x:'a. exists s3:'a set. ((s1 = add(x, s3)) and mem(s3, - finite_subsets(s2))))))) - -logic non_empty_finite_subsets : 'a set -> 'a set set - -axiom non_empty_finite_subsets_def : - (forall s:'a set. forall x:'a set. (mem(x, non_empty_finite_subsets(s)) -> - (exists c:int. (is_finite_subset(x, s, c) and - (not (x = (empty : 'a set))))))) - -axiom non_empty_finite_subsets_def1 : - (forall s:'a set. forall x:'a set. - ((exists c:int. (is_finite_subset(x, s, c) and - (not (x = (empty : 'a set))))) -> - mem(x, non_empty_finite_subsets(s)))) - -axiom card_non_neg : - (forall s:'a set. forall x:'a set. forall c:int. (is_finite_subset(x, s, - c) -> (0 <= c))) - -axiom card_unique : - (forall s:'a set. forall x:'a set. forall c1:int. forall c2:int. - (is_finite_subset(x, s, c1) -> (is_finite_subset(x, s, c2) -> (c1 = c2)))) - -logic card : 'a set -> int - -axiom card_def : - (forall s:'a set. forall x:'a set. forall c:int. (is_finite_subset(x, s, - c) -> (card(x) = c))) - -axiom card_Empty : (card((empty : 'a set)) = 0) - -axiom card_Add_not_mem : - (forall x:'a. forall s1:'a set. forall s2:'a set [mem(s1, - finite_subsets(s2)), card(add(x, s1))]. (mem(s1, finite_subsets(s2)) -> - ((not mem(x, s1)) -> (card(add(x, s1)) = (card(s1) + 1))))) - -axiom card_Add_mem : - (forall x:'a. forall s1:'a set. forall s2:'a set [mem(s1, - finite_subsets(s2)), card(add(x, s1))]. (mem(s1, finite_subsets(s2)) -> - (mem(x, s1) -> (card(add(x, s1)) = card(s1))))) - -axiom card_Union : - (forall s1:'a set. forall s2:'a set. forall s3:'a set [mem(s1, - finite_subsets(s3)), mem(s2, finite_subsets(s3)), card(union(s1, s2))]. - (mem(s1, finite_subsets(s3)) -> (mem(s2, finite_subsets(s3)) -> - (is_empty(inter(s1, s2)) -> (card(union(s1, - s2)) = (card(s1) + card(s2))))))) - -logic infix_lspl : ('a, 'b) tuple2 set, ('a, 'b) tuple2 set -> ('a, - 'b) tuple2 set - -axiom overriding_def : - (forall x:'a. forall y:'b. forall q:('a, 'b) tuple2 set. forall r:('a, - 'b) tuple2 set. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lspl(q, r)) -> (mem(x, dom(r)) -> mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, r)))) - -axiom overriding_def1 : - (forall x:'a. forall y:'b. forall q:('a, 'b) tuple2 set. forall r:('a, - 'b) tuple2 set. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lspl(q, r)) -> ((not mem(x, dom(r))) -> mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, q)))) - -axiom overriding_def2 : - (forall x:'a. forall y:'b. forall q:('a, 'b) tuple2 set. forall r:('a, - 'b) tuple2 set. (((mem(x, dom(r)) and mem({ Tuple2_proj_1 = x; - Tuple2_proj_2 = y }, r)) or ((not mem(x, dom(r))) and mem({ Tuple2_proj_1 = - x; Tuple2_proj_2 = y }, q))) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, infix_lspl(q, r)))) - -axiom function_overriding : - (forall s:'a set. forall t:'b set. forall f:('a, 'b) tuple2 set. - forall g:('a, 'b) tuple2 set. ((mem(f, infix_plmngt(s, t)) and mem(g, - infix_plmngt(s, t))) -> mem(infix_lspl(f, g), infix_plmngt(s, t)))) - -axiom dom_overriding : - (forall f:('a, 'b) tuple2 set. forall g:('a, 'b) tuple2 set - [dom(infix_lspl(f, g))]. (dom(infix_lspl(f, g)) = union(dom(f), dom(g)))) - -axiom apply_overriding_1 : - (forall s:'a set. forall t:'b set. forall f:('a, 'b) tuple2 set. - forall g:('a, 'b) tuple2 set. forall x:'a [mem(f, infix_plmngt(s, t)), - mem(g, infix_plmngt(s, t)), apply(infix_lspl(f, g), x)]. ((mem(f, - infix_plmngt(s, t)) and mem(g, infix_plmngt(s, t))) -> (mem(x, dom(g)) -> - (apply(infix_lspl(f, g), x) = apply(g, x))))) - -axiom apply_overriding_2 : - (forall s:'a set. forall t:'b set. forall f:('a, 'b) tuple2 set. - forall g:('a, 'b) tuple2 set. forall x:'a [mem(f, infix_plmngt(s, t)), - apply(infix_lspl(f, g), x)| mem(g, infix_plmngt(s, t)), apply(infix_lspl(f, - g), x)]. ((mem(f, infix_plmngt(s, t)) and mem(g, infix_plmngt(s, t))) -> - ((not mem(x, dom(g))) -> (mem(x, dom(f)) -> (apply(infix_lspl(f, g), - x) = apply(f, x)))))) - -logic power : 'a set -> 'a set set - -axiom mem_power : - (forall x:'a set. forall y:'a set [mem(x, power(y))]. (mem(x, power(y)) -> - subset(x, y))) - -axiom mem_power1 : - (forall x:'a set. forall y:'a set [mem(x, power(y))]. (subset(x, y) -> - mem(x, power(y)))) - -logic non_empty_power : 'a set -> 'a set set - -axiom mem_non_empty_power : - (forall x:'a set. forall y:'a set [mem(x, non_empty_power(y))]. (mem(x, - non_empty_power(y)) -> subset(x, y))) - -axiom mem_non_empty_power1 : - (forall x:'a set. forall y:'a set [mem(x, non_empty_power(y))]. (mem(x, - non_empty_power(y)) -> (not (x = (empty : 'a set))))) - -axiom mem_non_empty_power2 : - (forall x:'a set. forall y:'a set [mem(x, non_empty_power(y))]. ((subset(x, - y) and (not (x = (empty : 'a set)))) -> mem(x, non_empty_power(y)))) - -logic times : 'a set, 'b set -> ('a, 'b) tuple2 set - -axiom times_def : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1 [mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b))]. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b)) -> mem(x, a))) - -axiom times_def1 : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1 [mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b))]. (mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b)) -> mem(y, b))) - -axiom times_def2 : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1 [mem({ - Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b))]. ((mem(x, a) and - mem(y, b)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, times(a, b)))) - -axiom monotonicity_62a : - (forall u:'a set. forall s:'a set. forall v:'b set. forall t:'b set. - ((subset(u, s) and subset(v, t)) -> subset(times(u, v), times(s, t)))) - -axiom subset_times_function : - (forall x:'b. forall s:'a set. forall t:'b set. (mem(x, t) -> mem(times(s, - add(x, (empty : 'b set))), infix_mnmngt(s, t)))) - -function relations(u: 'a set, v: 'b set) : ('a, 'b) tuple2 set set = - power(times(u, v)) - -axiom break_mem_in_add : - (forall c:('a, 'b) tuple2. forall s:('a, 'b) tuple2 set. forall x:'a. - forall y:'b. (mem(c, add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, s)) -> - ((c = { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) or mem(c, s)))) - -axiom break_mem_in_add1 : - (forall c:('a, 'b) tuple2. forall s:('a, 'b) tuple2 set. forall x:'a. - forall y:'b. (((c = { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) or mem(c, - s)) -> mem(c, add({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, s)))) - -axiom break_power_times : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (mem(r, - power(times(u, v))) -> subset(r, times(u, v)))) - -axiom break_power_times1 : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (subset(r, - times(u, v)) -> mem(r, power(times(u, v))))) - -axiom subset_of_times : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (subset(r, - times(u, v)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> mem(x, u))))) - -axiom subset_of_times1 : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. (subset(r, - times(u, v)) -> - (forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> mem(y, v))))) - -axiom subset_of_times2 : - (forall r:('a, 'b) tuple2 set. forall u:'a set. forall v:'b set. - ((forall x:'a. forall y:'b. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - r) -> (mem(x, u) and mem(y, v)))) -> - subset(r, times(u, v)))) - -axiom apply_times : - (forall s:'a set. forall x:'a. forall y:'b [apply(times(s, add(y, - (empty : 'b set))), x)]. (mem(x, s) -> (apply(times(s, add(y, - (empty : 'b set))), x) = y))) - -logic power1 : int, int -> int - -axiom Power_0 : (forall x:int. (power1(x, 0) = 1)) - -axiom Power_s : - (forall x:int. forall n:int. ((0 <= n) -> (power1(x, - (n + 1)) = (x * power1(x, n))))) - -axiom Power_s_alt : - (forall x:int. forall n:int. ((0 < n) -> (power1(x, n) = (x * power1(x, - (n - 1)))))) - -axiom Power_1 : (forall x:int. (power1(x, 1) = x)) - -axiom Power_sum : - (forall x:int. forall n:int. forall m:int. ((0 <= n) -> ((0 <= m) -> - (power1(x, (n + m)) = (power1(x, n) * power1(x, m)))))) - -axiom Power_mult : - (forall x:int. forall n:int. forall m:int. ((0 <= n) -> ((0 <= m) -> - (power1(x, (n * m)) = power1(power1(x, n), m))))) - -axiom Power_mult2 : - (forall x:int. forall y:int. forall n:int. ((0 <= n) -> (power1((x * y), - n) = (power1(x, n) * power1(y, n))))) - -axiom Power_non_neg : - (forall x:int. forall y:int. (((0 <= x) and (0 <= y)) -> (0 <= power1(x, - y)))) - -axiom Power_monotonic : - (forall x:int. forall n:int. forall m:int. (((0 < x) and ((0 <= n) and - (n <= m))) -> (power1(x, n) <= power1(x, m)))) - -logic infix_brgt : ('a, 'b) tuple2 set, 'b set -> ('a, 'b) tuple2 set - -axiom range_restriction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgt(r, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom range_restriction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgt(r, f)) -> mem(y, f))))) - -axiom range_restriction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and mem(y, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgt(r, f)))))) - -logic infix_brgtgt : ('a, 'b) tuple2 set, 'b set -> ('a, 'b) tuple2 set - -axiom range_substraction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgtgt(r, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom range_substraction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgtgt(r, f)) -> (not mem(y, f)))))) - -axiom range_substraction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e2 set. (subset(f, ran(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and (not mem(y, f))) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_brgtgt(r, f)))))) - -logic infix_lsbr : 'a set, ('a, 'b) tuple2 set -> ('a, 'b) tuple2 set - -axiom domain_restriction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lsbr(f, r)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom domain_restriction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lsbr(f, r)) -> mem(x, f))))) - -axiom domain_restriction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and mem(x, f)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lsbr(f, r)))))) - -logic infix_lslsbr : 'a set, ('a, 'b) tuple2 set -> ('a, 'b) tuple2 set - -axiom domain_substraction_def : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lslsbr(f, r)) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, r))))) - -axiom domain_substraction_def1 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. (mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lslsbr(f, r)) -> (not mem(x, f)))))) - -axiom domain_substraction_def2 : - (forall r:('e1, 'e2) tuple2 set. forall f:'e1 set. (subset(f, dom(r)) -> - (forall x:'e1. forall y:'e2. ((mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y - }, r) and (not mem(x, f))) -> mem({ Tuple2_proj_1 = x; Tuple2_proj_2 = y }, - infix_lslsbr(f, r)))))) - -function seq_length(n: int, s: 'a set) : (int, 'a) tuple2 set set = - infix_mnmngt(mk(1, n), s) - -axiom length_uniq : - (forall n1:int. forall n2:int. forall s1:'a set. forall s2:'a set. - forall r:(int, 'a) tuple2 set. (((0 <= n1) and mem(r, seq_length(n1, - s1))) -> (((0 <= n2) and mem(r, seq_length(n2, s2))) -> (n1 = n2)))) - -logic size : (int, 'a) tuple2 set -> int - -axiom size_def : - (forall n:int. forall s:'a set. forall r:(int, 'a) tuple2 set. - (((0 <= n) and mem(r, seq_length(n, s))) -> (size(r) = n))) - -logic seq : 'a set -> (int, 'a) tuple2 set set - -axiom seq_def : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq(s)) -> - (0 <= size(r)))) - -axiom seq_def1 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq(s)) -> mem(r, - seq_length(size(r), s)))) - -axiom seq_def2 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (((0 <= size(r)) and - mem(r, seq_length(size(r), s))) -> mem(r, seq(s)))) - -axiom seq_as_total_function : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq(s)) -> mem(r, - infix_mnmngt(mk(1, size(r)), s)))) - -logic seq1 : 'a set -> (int, 'a) tuple2 set set - -axiom seq1_def : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq1(s)) -> - (0 < size(r)))) - -axiom seq1_def1 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (mem(r, seq1(s)) -> mem(r, - seq(s)))) - -axiom seq1_def2 : - (forall s:'a set. forall r:(int, 'a) tuple2 set. (((0 < size(r)) and - mem(r, seq(s))) -> mem(r, seq1(s)))) - -logic iseq : 'a set -> (int, 'a) tuple2 set set - -logic iseq1 : 'a set -> (int, 'a) tuple2 set set - -logic perm : 'a set -> (int, 'a) tuple2 set set - -logic infix_slbr : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -axiom head_restriction_def : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_slbr(s, n)) -> mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_lsbr(mk(1, n), s)))))) - -axiom head_restriction_def1 : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_lsbr(mk(1, n), s)) -> mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_slbr(s, n)))))) - -logic infix_brsl : (int, 'a) tuple2 set, int -> (int, 'a) tuple2 set - -axiom tail_restriction_def : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, - infix_brsl(s, n)) -> mem({ Tuple2_proj_1 = (i + n); Tuple2_proj_2 = x }, - s))))) - -axiom tail_restriction_def1 : - (forall s:(int, 'a) tuple2 set. forall n:int. (mem(n, mk(0, size(s))) -> - (forall i:int. forall x:'a. (mem({ Tuple2_proj_1 = (i + n); Tuple2_proj_2 = - x }, s) -> mem({ Tuple2_proj_1 = i; Tuple2_proj_2 = x }, infix_brsl(s, - n)))))) - -logic min : int set -> int - -axiom min_belongs : - (forall s:int set. (subset(s, natural) -> ((not (s = (empty : int set))) -> - mem(min(s), s)))) - -axiom min_is_min : - (forall s:int set. (subset(s, natural) -> ((not (s = (empty : int set))) -> - (forall x:int. (mem(x, s) -> (min(s) <= x)))))) - -logic max : int set -> int - -axiom max_belongs : - (forall s:int set. (mem(s, non_empty_finite_subsets(natural)) -> - mem(max(s), s))) - -axiom max_is_max : - (forall s:int set. (mem(s, non_empty_finite_subsets(natural)) -> - (forall x:int. (mem(x, s) -> (x <= max(s)))))) - -logic iterate : ('a, 'a) tuple2 set, int -> ('a, 'a) tuple2 set - -axiom iterate_zero : - (forall r:('a, 'a) tuple2 set. (iterate(r, 0) = id(dom(r)))) - -axiom iterate_succ : - (forall r:('a, 'a) tuple2 set. forall n:int. ((0 < n) -> (iterate(r, - n) = semicolon(r, iterate(r, (n - 1)))))) - -logic closure : ('a, 'a) tuple2 set -> ('a, 'a) tuple2 set - -axiom closure_def : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. (mem(u, - closure(r)) -> (exists x:int. ((0 <= x) and mem(u, iterate(r, x)))))) - -axiom closure_def1 : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. - ((exists x:int. ((0 <= x) and mem(u, iterate(r, x)))) -> mem(u, - closure(r)))) - -logic closure1 : ('a, 'a) tuple2 set -> ('a, 'a) tuple2 set - -axiom closure1_def : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. (mem(u, - closure1(r)) -> (exists x:int. ((0 < x) and mem(u, iterate(r, x)))))) - -axiom closure1_def1 : - (forall r:('a, 'a) tuple2 set. forall u:('a, 'a) tuple2. - ((exists x:int. ((0 < x) and mem(u, iterate(r, x)))) -> mem(u, - closure1(r)))) - -logic prj1 : 'a set, 'b set -> (('a, 'b) tuple2, 'a) tuple2 set - -axiom prj1_def : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1. ((mem(x, - a) and mem(y, b)) -> (apply(prj1(a,b), - { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) = x))) - -logic prj2 : 'a set, 'b set -> (('a, 'b) tuple2, 'b) tuple2 set - -axiom prj2_def : - (forall a:'a1 set. forall b:'b1 set. forall x:'a1. forall y:'b1. ((mem(x, - a) and mem(y, b)) -> (apply(prj2(a,b), - { Tuple2_proj_1 = x; Tuple2_proj_2 = y }) = y))) - -logic generalized_union : 'a set set -> 'a set - -axiom generalized_union_def : - (forall s:'a set set. forall x:'a. (mem(x, generalized_union(s)) -> - (exists y:'a set. (mem(x, y) and mem(y, s))))) - -axiom generalized_union_def1 : - (forall s:'a set set. forall x:'a. - ((exists y:'a set. (mem(x, y) and mem(y, s))) -> mem(x, - generalized_union(s)))) - -type ('a, -'b) func - -logic infix_at : ('a, 'b) func, 'a -> 'b - -logic comprehension : ('a, bool) func -> 'a set - -axiom comprehension_def : - (forall p:('a, bool) func. - (forall x:'a. (mem(x, comprehension(p)) -> (infix_at(p, x) = true)))) - -axiom comprehension_def1 : - (forall p:('a, bool) func. - (forall x:'a. ((infix_at(p, x) = true) -> mem(x, comprehension(p))))) - -logic fc : ('a, bool) func, 'a set -> ('a, bool) func - -axiom fc_def : - (forall p:('a, bool) func. forall u:'a set. forall x:'a. ((infix_at(fc(p, - u), x) = true) -> (infix_at(p, x) = true))) - -axiom fc_def1 : - (forall p:('a, bool) func. forall u:'a set. forall x:'a. ((infix_at(fc(p, - u), x) = true) -> mem(x, u))) - -axiom fc_def2 : - (forall p:('a, bool) func. forall u:'a set. forall x:'a. (((infix_at(p, - x) = true) and mem(x, u)) -> (infix_at(fc(p, u), x) = true))) - -function filter(p: ('a, bool) func, u: 'a set) : 'a set = comprehension(fc(p, - u)) - -logic fc1 : ('a, 'b) func, 'a set -> ('b, bool) func - -axiom fc_def3 : - (forall f:('a, 'b) func. forall u:'a set. forall y:'b. ((infix_at(fc1(f, - u), y) = true) -> (exists x:'a. (mem(x, u) and (y = infix_at(f, x)))))) - -axiom fc_def4 : - (forall f:('a, 'b) func. forall u:'a set. forall y:'b. - ((exists x:'a. (mem(x, u) and (y = infix_at(f, x)))) -> (infix_at(fc1(f, - u), y) = true))) - -function map(f: ('a, 'b) func, u: 'a set) : 'b set = comprehension(fc1(f, u)) - -axiom map_def : - (forall f:('a, 'b) func. forall u:'a set. - (forall x:'a. (mem(x, u) -> mem(infix_at(f, x), map(f, u))))) - -logic sum : int set -> int - -axiom sum_def0 : (sum((empty : int set)) = 0) - -axiom sum_def1 : - (forall s:int set. forall x:int. (mem(x, s) -> (sum(s) = (x + sum(remove(x, - s)))))) - -function sigma(p: ('a, bool) func, f: ('a, int) func) : int = sum(map(f, - comprehension(p))) diff --git a/src/plugins/AB-Why3/preludes/cram.t/run.t b/src/plugins/AB-Why3/preludes/cram.t/run.t deleted file mode 100644 index 30966bd950..0000000000 --- a/src/plugins/AB-Why3/preludes/cram.t/run.t +++ /dev/null @@ -1,3 +0,0 @@ - $ alt-ergo ../b-set-theory-prelude-2018-09-28.ae - $ alt-ergo ../b-set-theory-prelude-2020-02-28.ae - diff --git a/src/plugins/AB-Why3/preludes/dune b/src/plugins/AB-Why3/preludes/dune deleted file mode 100644 index 508f1a2194..0000000000 --- a/src/plugins/AB-Why3/preludes/dune +++ /dev/null @@ -1,18 +0,0 @@ -(install - (package alt-ergo-plugin-ab-why3) - (section (site (alt-ergo preludes))) - (files - b-set-theory-prelude-2018-09-28.ae - b-set-theory-prelude-2020-02-28.ae - ) -) - -(cram - (package alt-ergo-plugin-ab-why3) - (alias runtest-ci) - (deps - %{bin:alt-ergo} - b-set-theory-prelude-2018-09-28.ae - b-set-theory-prelude-2020-02-28.ae - ) -) diff --git a/src/plugins/AB-Why3/why3_lexer.mll b/src/plugins/AB-Why3/why3_lexer.mll deleted file mode 100644 index aade2ab248..0000000000 --- a/src/plugins/AB-Why3/why3_lexer.mll +++ /dev/null @@ -1,299 +0,0 @@ -(********************************************************************) -(* *) -(* The Why3 Verification Platform / The Why3 Development Team *) -(* Copyright 2010-2017 -- INRIA - CNRS - Paris-Sud University *) -(* *) -(* This software is distributed under the terms of the GNU Lesser *) -(* General Public License version 2.1, with the special exception *) -(* on linking described in file LICENSE. *) -(* *) -(********************************************************************) - -(******************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) 2018 --- OCamlPro SAS *) -(* *) -(******************************************************************************) - -{ - open AltErgoLib - open AltErgoParsers - open Why3_parser - open Lexing - - exception UnterminatedComment - exception UnterminatedString - exception IllegalCharacter of char - - let optmap f = function None -> None | Some x -> Some (f x) - - (*let () = Why3_exn_printer.register (fun fmt e -> match e with - | IllegalCharacter c -> fprintf fmt "illegal character %c" c - | _ -> raise e)*) - - let keywords = Hashtbl.create 97 - let () = - List.iter - (fun (x,y) -> Hashtbl.add keywords x y) - [ - "as", AS; - "axiom", AXIOM; - "clone", CLONE; - "constant", CONSTANT; - "else", ELSE; - "end", END; - "epsilon", EPSILON; - "exists", EXISTS; - "export", EXPORT; - "false", FALSE; - "forall", FORALL; - "function", FUNCTION; - "goal", GOAL; - "if", IF; - "import", IMPORT; - "in", IN; - "lemma", LEMMA; - "let", LET; - "namespace", NAMESPACE; - "not", NOT; - "predicate", PREDICATE; - "then", THEN; - "theory", THEORY; - "true", TRUE; - "type", TYPE; - "use", USE; - "with", WITH; - (* programs *) - "ghost", GHOST; - "invariant", INVARIANT; - "model", MODEL; - "val", VAL - ] - - let update_loc lexbuf file line chars = - let pos = lexbuf.lex_curr_p in - let new_file = match file with None -> pos.pos_fname | Some s -> s in - lexbuf.lex_curr_p <- - { pos with - pos_fname = new_file; - pos_lnum = line; - pos_bol = pos.pos_cnum - chars; - } - - 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 remove_underscores s = - if String.contains s '_' then begin - let count = - let nb = ref 0 in - String.iter (fun c -> if c = '_' then incr nb) s; - !nb in - let t = Bytes.create (String.length s - count) in - let i = ref 0 in - String.iter (fun c -> if c <> '_' then (Bytes.set t !i c; incr i)) s; - Bytes.unsafe_to_string t - end else s - - let loc lb = (lexeme_start_p lb, lexeme_end_p lb) - -let string_start_loc = ref Loc.dummy - let string_buf = Buffer.create 1024 - - let comment_start_loc = ref Loc.dummy - - let char_for_backslash = function - | 'n' -> '\n' - | 't' -> '\t' - | c -> c -} -let newline = '\n' -let space = [' ' '\t' '\r'] -let lalpha = ['a'-'z' '_'] -let ualpha = ['A'-'Z'] -let alpha = lalpha | ualpha -let digit = ['0'-'9'] -let digit_or_us = ['0'-'9' '_'] -let alpha_no_us = ['a'-'z' 'A'-'Z'] -let suffix = (alpha_no_us | '\''* digit_or_us)* '\''* -let lident = lalpha suffix -let uident = ualpha suffix -let lident_quote = lident ('\'' alpha_no_us suffix)+ -let uident_quote = uident ('\'' alpha_no_us suffix)+ -let hexadigit = ['0'-'9' 'a'-'f' 'A'-'F'] - -let op_char_1 = ['=' '<' '>' '~'] -let op_char_2 = ['+' '-'] -let op_char_3 = ['*' '/' '\\' '%'] -let op_char_4 = ['!' '$' '&' '?' '@' '^' '.' ':' '|' '#'] -let op_char_34 = op_char_3 | op_char_4 -let op_char_234 = op_char_2 | op_char_34 -let op_char_1234 = op_char_1 | op_char_234 - -let op_char_pref = ['!' '?'] - -rule token = parse - | "##" space* ("\"" ([^ '\010' '\013' '"' ]* as file) "\"")? - space* (digit+ as line) space* (digit+ as char) space* "##" - { update_loc lexbuf file (int_of_string line) (int_of_string char); - token lexbuf } - | '\n' - { newline lexbuf; token lexbuf } - | space+ - { token lexbuf } - | '_' - { UNDERSCORE } - | lident as id - { try Hashtbl.find keywords id with Not_found -> LIDENT id } - | lident_quote as id - { LIDENT_QUOTE id } - | uident as id - { UIDENT id } - | uident_quote as id - { UIDENT_QUOTE id } - | ['0'-'9'] ['0'-'9' '_']* as s - { INTEGER ((remove_underscores s)) } -(*| '0' ['x' 'X'] (['0'-'9' 'A'-'F' 'a'-'f']['0'-'9' 'A'-'F' 'a'-'f' '_']* as s) - { INTEGER (Why3_number.int_const_hex (Why3_lexlib.remove_underscores s)) } -| '0' ['o' 'O'] (['0'-'7'] ['0'-'7' '_']* as s) - { INTEGER (Why3_number.int_const_oct (Why3_lexlib.remove_underscores s)) } -| '0' ['b' 'B'] (['0'-'1'] ['0'-'1' '_']* as s) - { INTEGER (Why3_number.int_const_bin (Why3_lexlib.remove_underscores s)) }*) -(* | (digit+ as i) ("" as f) ['e' 'E'] (['-' '+']? digit+ as e) - | (digit+ as i) '.' (digit* as f) (['e' 'E'] (['-' '+']? digit+ as e))? - | (digit* as i) '.' (digit+ as f) (['e' 'E'] (['-' '+']? digit+ as e))? - { REAL (Why3_number.real_const_dec i f - (optmap Why3_lexlib.remove_leading_plus e)) }*) -(*| '0' ['x' 'X'] (hexadigit+ as i) ("" as f) ['p' 'P'] (['-' '+']? digit+ as e) - | '0' ['x' 'X'] (hexadigit+ as i) '.' (hexadigit* as f) - (['p' 'P'] (['-' '+']? digit+ as e))? - | '0' ['x' 'X'] (hexadigit* as i) '.' (hexadigit+ as f) - (['p' 'P'] (['-' '+']? digit+ as e))? - { REAL (Why3_number.real_const_hex i f - (optmap Why3_lexlib.remove_leading_plus e)) }*) - | "(*)" - { LEFTPAR_STAR_RIGHTPAR } - | "(*" - { comment lexbuf; token lexbuf } - | "'" (lident as id) - { QUOTE_LIDENT id } - | "'" (uident as id) - { QUOTE_UIDENT id } - | "," - { COMMA } - | "(" - { LEFTPAR } - | ")" - { RIGHTPAR } - | "{" - { LEFTBRC } - | "}" - { RIGHTBRC } - | ":" - { COLON } - | ";" - { SEMICOLON } - | "->" - { ARROW } - | "<->" - { LRARROW } - | "/\\" - { AND } - | "\\/" - { OR } - | "." - { DOT } - | "|" - { BAR } - | "<" - { LT } - | ">" - { GT } - | "<>" - { LTGT } - | "=" - { EQUAL } - | "[" - { LEFTSQ } - | "]" - { RIGHTSQ } - | op_char_pref op_char_4* as s - { OPPREF s } - | op_char_1234* op_char_1 op_char_1234* as s - { OP1 s } - | op_char_234* op_char_2 op_char_234* as s - { OP2 s } - | op_char_34* op_char_3 op_char_34* as s - { OP3 s } - | op_char_4+ as s - { OP4 s } - | "\"" - { STRING (string lexbuf) } - | eof - { EOF } - | _ as c - { raise (IllegalCharacter c) } -and comment = parse - | "(*)" - { comment lexbuf } - | "*)" - { () } - | "(*" - { comment lexbuf; comment lexbuf } - | newline - { newline lexbuf; comment lexbuf } - | eof - { - raise (Why3_loc.Why3_located (!comment_start_loc, UnterminatedComment)) - } - | _ - { comment lexbuf } - -and string = parse - | "\"" - { let s = Buffer.contents string_buf in - Buffer.clear string_buf; - s } - | "\\" (_ as c) - { if c = '\n' then newline lexbuf; - Buffer.add_char string_buf (char_for_backslash c); string lexbuf } - | newline - { newline lexbuf; Buffer.add_char string_buf '\n'; string lexbuf } - | eof - { raise (Why3_loc.Why3_located (!string_start_loc, UnterminatedString)) } - | _ as c - { Buffer.add_char string_buf c; string lexbuf } - -{ - let aux aux_fun token lexbuf = - try - let res = aux_fun token lexbuf in - Parsing.clear_parser (); - res - with - | Parsing.Parse_error -> - (* not fully qualified ! backward incompat. in Menhir !!*) - let loc = (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf) in - let lex = Lexing.lexeme lexbuf in - Parsing.clear_parser (); - Errors.error (Errors.Syntax_error (loc, lex)) - - let comment lexbuf = comment_start_loc := loc lexbuf; comment lexbuf - - let string lexbuf = string_start_loc := loc lexbuf; string lexbuf - - module Parser : Parsers.PARSER_INTERFACE = struct - let file = aux Why3_parser.file_parser token - let expr = aux Why3_parser.lexpr_parser token - let trigger = aux Why3_parser.trigger_parser token - end - - let () = (* register this parser in Input_lang *) - let p = (module Parser : Parsers.PARSER_INTERFACE) in - Parsers.register_parser ~lang:".why" p; - Parsers.register_parser ~lang:".why3" p; - - } diff --git a/src/plugins/AB-Why3/why3_loc.ml b/src/plugins/AB-Why3/why3_loc.ml deleted file mode 100644 index 5e477c0fc6..0000000000 --- a/src/plugins/AB-Why3/why3_loc.ml +++ /dev/null @@ -1,61 +0,0 @@ -(********************************************************************) -(* *) -(* The Why3 Verification Platform / The Why3 Development Team *) -(* Copyright 2010-2017 -- INRIA - CNRS - Paris-Sud University *) -(* *) -(* This software is distributed under the terms of the GNU Lesser *) -(* General Public License version 2.1, with the special exception *) -(* on linking described in file LICENSE. *) -(* *) -(********************************************************************) - -(******************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) 2018 --- OCamlPro SAS *) -(* *) -(******************************************************************************) - -open AltErgoLib -open Lexing - - -type position = Loc.t - -let user_position fname lnum cnum1 cnum2 = - let upos = - {pos_fname = fname; pos_lnum = lnum; pos_bol = cnum1; - pos_cnum = cnum2} in - (upos, upos) - -let get ({pos_fname; pos_lnum; pos_bol; pos_cnum}, _) = - (pos_fname, pos_lnum, pos_bol, pos_cnum) - - -let join (p1 : position) (p2 : position) = - match (get p1, get p2) with - ((f1, l1, b1, e1), (_, _, b2, e2 )) -> - let pos = - {pos_fname = f1; pos_lnum = l1; pos_bol = b1 ; pos_cnum = e1 + e2 - b2} in - (pos, pos) - -exception Why3_located of position * exn - -let error ?loc e = match loc with - | Some loc -> raise (Why3_located (loc, e)) - | None -> raise e - -(* located messages *) - -exception Message of string - -let errorm ?loc f = - let buf = Buffer.create 512 in - let fmt = Format.formatter_of_buffer buf in - Format.kfprintf - (fun _ -> - Format.pp_print_flush fmt (); - let s = Buffer.contents buf in - Buffer.clear buf; - error ?loc (Message s)) - fmt ("@[" ^^ f ^^ "@]") diff --git a/src/plugins/AB-Why3/why3_loc.mli b/src/plugins/AB-Why3/why3_loc.mli deleted file mode 100644 index a5111b0387..0000000000 --- a/src/plugins/AB-Why3/why3_loc.mli +++ /dev/null @@ -1,43 +0,0 @@ -(********************************************************************) -(* *) -(* The Why3 Verification Platform / The Why3 Development Team *) -(* Copyright 2010-2017 -- INRIA - CNRS - Paris-Sud University *) -(* *) -(* This software is distributed under the terms of the GNU Lesser *) -(* General Public License version 2.1, with the special exception *) -(* on linking described in file LICENSE. *) -(* *) -(********************************************************************) - -(******************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) 2018 --- OCamlPro SAS *) -(* *) -(******************************************************************************) - -open AltErgoLib - -(* locations in files *) - -type position = Loc.t - -val join : position -> position -> position - -val user_position : string -> int -> int -> int -> position - -val get : position -> string * int * int * int - -(* located exceptions *) - -exception Why3_located of position * exn - -val error: ?loc:position -> exn -> 'a - -(* messages *) - -exception Message of string - -val errorm: ?loc:position -> ('a, Format.formatter, unit, 'b) format4 -> 'a - -(*val with_location: (Lexing.lexbuf -> 'a) -> (Lexing.lexbuf -> 'a)*) diff --git a/src/plugins/AB-Why3/why3_parser.mly b/src/plugins/AB-Why3/why3_parser.mly deleted file mode 100644 index c75ca22c4c..0000000000 --- a/src/plugins/AB-Why3/why3_parser.mly +++ /dev/null @@ -1,832 +0,0 @@ -(********************************************************************) -(* *) -(* The Why3 Verification Platform / The Why3 Development Team *) -(* Copyright 2010-2017 -- INRIA - CNRS - Paris-Sud University *) -(* *) -(* This software is distributed under the terms of the GNU Lesser *) -(* General Public License version 2.1, with the special exception *) -(* on linking described in file LICENSE. *) -(* *) -(********************************************************************) - -(******************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) 2018 --- OCamlPro SAS *) -(* *) -(******************************************************************************) - -%{ - -open AltErgoLib -open Lexing -open Why3_ptree -open Parsed_interface -open Parsed - - let infix s = "infix " ^ s - let prefix s = "prefix " ^ s - - let floc s e = (s,e) - - let add_lab id l = { id with id_lab = l } - - let id_anonymous loc = { id_str = "_"; id_lab = []; id_loc = loc } - - let mk_id id s e = { id_str = id; id_lab = []; id_loc = floc s e } - - let mk_term d _ _ = d - - let error_param loc = - Why3_loc.errorm ~loc "cannot determine the type of the parameter" - - let error_loc loc = Why3_loc.error ~loc Parsing.Parse_error - - (* Added *) - - let str_of_labs labs = - String.concat " " labs - - let translate_param (loc, id_op, pty) = - match id_op with - | Some id -> (loc, id.id_str, pty) - | None -> (loc, "", pty) - - let mk_function t ty loc named_ident params = - let expr = t in - mk_function_def loc named_ident (List.map translate_param params)ty expr - - let mk_pred term params loc named_ident = - let expr = term in - match params with - | [] -> mk_ground_predicate_def loc named_ident expr - | _ -> mk_non_ground_predicate_def loc named_ident - (List.map translate_param params) expr - - let mak_logic loc ssl pptyop params = - let ppure_type_list = - List.map (fun (_, _, pty) -> pty ) params in - let logic_type = - mk_logic_type ppure_type_list pptyop in - mk_logic loc Symbols.Other ssl logic_type - - let mk_tuple pl loc = - let length = string_of_int (List.length pl) in - let name = "tuple" ^ length in - mk_external_type loc pl name - - let mk_tyapp q pl = - match q with - | { Parsed.pp_desc = PPvar "int" ; _ } -> int_type - | { Parsed.pp_desc = PPvar "bool" ; _ } -> bool_type - | { Parsed.pp_desc = PPvar "real" ; _ } -> real_type - | { Parsed.pp_desc = PPvar s; pp_loc } -> mk_external_type pp_loc pl s - | _ -> Printer.print_err "[TODO]"; assert false - - let mk_apply loc (f : Parsed.lexpr) a = - match f with - | { pp_desc = Parsed.PPapp ("mod", le) ; _ } -> - mk_application loc "comp_mod" (le @ [a]) - | { pp_desc = Parsed.PPapp ("div", le) ; _ } -> - mk_application loc "comp_div" (le @ [a]) - | { pp_desc = Parsed.PPapp ("domain_restriction", le) ; _ } -> - mk_application loc "infix_lsbr" (le @ [a]) - | { pp_desc = Parsed.PPapp ("domain_substraction", le) ; _ } -> - mk_application loc "infix_lslsbr" (le @ [a]) - | { pp_desc = Parsed.PPapp ("range_substraction", le) ; _ } -> - mk_application loc "infix_brgtgt" (le @ [a]) - | { pp_desc = Parsed.PPapp ("range_restriction", le) ; _ } -> - mk_application loc "infix_brgt" (le @ [a]) - | { pp_desc = PPvar "singleton" ; _ } -> - let empty = mk_application loc "empty" [] in - mk_application loc "add" [a; empty] - | { pp_desc = PPvar s ; _ } -> mk_application loc s [a] - | { pp_desc = PPapp (s, l) ; _ } -> mk_application loc s (l @ [a]) - | _ -> Printer.print_err "[TODO]"; assert false - - let mk_infix_ident id loc t1 t2 = - let get_infix_ident i = - List.hd (List.rev (String.split_on_char ' ' i.id_str)) in - match get_infix_ident id with - | "+" -> mk_add loc t1 t2 - | "-" -> mk_sub loc t1 t2 - | "*" -> mk_mul loc t1 t2 - | "<" -> mk_pred_lt loc t1 t2 - | "<=" -> mk_pred_le loc t1 t2 - | ">" -> mk_pred_gt loc t1 t2 - | ">=" -> mk_pred_gt loc t1 t2 - | "=" -> mk_pred_eq loc t1 t2 - | "==" -> mk_application loc "infix_eqeq" [t1; t2] - | "+->" -> mk_application loc "infix_plmngt" [t1; t2] - | "-->" -> mk_application loc "infix_mnmngt" [t1; t2] - | "<+" -> mk_application loc "infix_lspl" [t1; t2] - | "-->>" -> mk_application loc "infix_mnmngtgt" [t1; t2] - | ">->>" -> mk_application loc "infix_gtmngtgt" [t1; t2] - | ">->" -> mk_application loc "infix_gtmngt" [t1; t2] - | ">+>" -> mk_application loc "infix_gtplgt" [t1; t2] - | "+->>" -> mk_application loc "infix_plmngtgt" [t1; t2] - | ">+>>" -> mk_application loc "infix_gtplgtgt" [t1; t2] - | "|>" -> mk_application loc "infix_brgt" [t1; t2] - | "|>>" -> mk_application loc "infix_brgtgt" [t1; t2] - | "<|" -> mk_application loc "infix_lsbr" [t1; t2] - | "<<|" -> mk_application loc "infix_lslsbr" [t1; t2] - | "/|\\" | "/|" -> mk_application loc "infix_slbr" [t1; t2] - | "\\|/" | "|/" -> mk_application loc "infix_brsl" [t1; t2] - | s -> Printer.print_err "[TODO] translate symbols %S" s; - assert false - - let mk_tuple_record exp_list loc = - let length = string_of_int (List.length exp_list) in - let field_name = "Tuple" ^ length ^ "_proj_" in - let rec trad l n = - match l with - | [] -> [] - | h::t -> - let fn = field_name ^ string_of_int n in - (fn ,h)::(trad t (n + 1)) - in - let str_exp_list = trad exp_list 1 in - mk_record loc str_exp_list - - let mk_qualid = function - | { id_str = "True"; id_loc; _} -> mk_true_const id_loc - | { id_str = "False"; id_loc; _ } -> mk_false_const id_loc - | { id_str; id_loc; _ } -> mk_var id_loc id_str - - let hack_mod var { id_str; id_loc; _ } = - match var.pp_desc, id_str with - | PPvar "Power", "power" -> - (* Printer.print_dbg "hack";*) - mk_var id_loc "power1" - | _ -> mk_var id_loc id_str - -%} - -(* Tokens *) - -%token LIDENT LIDENT_QUOTE UIDENT UIDENT_QUOTE -%token INTEGER -%token OP1 OP2 OP3 OP4 OPPREF - -%token STRING -%token QUOTE_UIDENT QUOTE_LIDENT - -(* keywords *) - -%token AS AXIOM CLONE CONSTANT -%token ELSE END EPSILON EXISTS EXPORT FALSE FORALL FUNCTION -%token GOAL IF IMPORT IN LEMMA -%token LET NAMESPACE NOT PREDICATE -%token THEN THEORY TRUE TYPE USE WITH - -(* program keywords *) - -%token GHOST INVARIANT MODEL -%token VAL - -(* symbols *) - -%token AND ARROW -%token BAR -%token COLON COMMA -%token DOT EQUAL LT GT LTGT -%token LEFTPAR LEFTPAR_STAR_RIGHTPAR LEFTSQ -%token LRARROW OR -%token RIGHTPAR RIGHTSQ -%token UNDERSCORE - -%token EOF - -(* program symbols *) - -%token LEFTBRC RIGHTBRC SEMICOLON - -(* Precedences *) - -%nonassoc IN -%nonassoc DOT ELSE -%nonassoc prec_named -%nonassoc COLON -%right ARROW LRARROW -%right OR -%right AND -%nonassoc NOT -%left EQUAL LTGT LT GT OP1 -%left OP2 -%left OP3 -%left OP4 -%nonassoc prec_prefix_op -%nonassoc OPPREF - -(* Entry points *) - -%type trigger_parser -%start trigger_parser - -%type lexpr_parser -%start lexpr_parser - -%type file_parser -%start file_parser -%% - -file_parser: -| logic_file { $1 } - -lexpr_parser: -| logic_file { Printer.print_err "[TODO]"; assert false } - -trigger_parser: -| logic_file { Printer.print_err "[TODO]"; assert false } - - -(* Theories, modules, namespaces *) - -logic_file: -| theory EOF { $1 } - -theory: -| theory_head theory_decl* END - { - List.concat - (List.map - (function - | Some x -> x - | _ -> assert false - ) - (List.filter (fun x -> x <> None) $2)) - } - -theory_head: -| THEORY labels(uident_nq) { $2 } - -theory_decl: - | decl { Some $1 } - | use_clone { None } - - -(* Use and clone *) - -use_clone: -| USE use { ($2, None) } -| CLONE use { ($2, Some []) } -| CLONE use WITH comma_list1(clone_subst) { ($2, Some $4) } - -use: -| boption(IMPORT) tqualid - { () } -| boption(IMPORT) tqualid AS uident - { () } -| EXPORT tqualid - { () } - -clone_subst: -| NAMESPACE ns EQUAL ns { () } -| TYPE qualid ty_var* EQUAL ty { () } -| CONSTANT qualid EQUAL qualid { () } -| FUNCTION qualid EQUAL qualid { () } -| PREDICATE qualid EQUAL qualid { () } -| VAL qualid EQUAL qualid { () } -| LEMMA qualid { () } -| GOAL qualid { () } - -ns: -| uqualid { Some $1 } -| DOT { None } - -(* Theory declarations *) - -decl: -| TYPE with_list1(type_decl) - { $2 } -| TYPE late_invariant - { [$2] } -| CONSTANT constant_decl - { [$2] } -| FUNCTION function_decl with_logic_decl* - { ($2::$3) } -| PREDICATE predicate_decl with_logic_decl* - { ($2::$3) } -| AXIOM labels(ident_nq) COLON term - { [mk_generic_axiom (floc $startpos $endpos) $2.id_str $4] } -| GOAL labels(ident_nq) COLON term - { [mk_goal (floc $startpos $endpos) $2.id_str $4] } - -(* Type declarations *) - -type_decl: -| labels(lident_nq) ty_var* typedefn - { let _, def, _ = $3 in - let loc = floc $startpos $endpos in - let ty_vars = List.map (fun i -> i.id_str) $2 in - match def with - | None -> mk_abstract_type_decl loc ty_vars $1.id_str - | Some l -> mk_enum_type_decl loc ty_vars $1.id_str l - } -| lab_li=labels(lident_nq) ty_v=ty_var* rec_def=typerecord - { - let loc = floc $startpos $endpos in - let ty_vars = List.map (fun i -> i.id_str) ty_v in - mk_record_type_decl loc ty_vars lab_li.id_str rec_def - } - -late_invariant: -| labels(lident_nq) ty_var* invariant+ - { let loc = floc $startpos $endpos in - let ty_vars = List.map (fun i -> i.id_str) $2 in - mk_abstract_type_decl loc ty_vars $1.id_str } - -ty_var: -| labels(quote_lident) { $1 } - -typedefn: -| (* epsilon *) - { false, None, [] } -| model bar_list1(type_case) invariant* - { $1, Some $2, $3 } - -typerecord: -| model LEFTBRC li_ctr=semicolon_list1(case_type_record) RIGHTBRC { li_ctr } - -model: -| EQUAL { false } -| MODEL { true } - -case_type_record: -| lab_lid=labels(lident_nq) c=cast { lab_lid.id_str, c } - -type_case: -| labels(uident_nq) { $1.id_str } - -(* Logic declarations *) - -constant_decl: -| labels(lident_rich) cast preceded(EQUAL,term)? - { - let loc = floc $startpos $endpos in - let named_ident = - ($1.id_str, str_of_labs $1.id_lab) in - match $3 with - | None -> - mak_logic loc [named_ident] (Some $2) [] - | Some t -> - mk_function t $2 loc named_ident [] - } - -function_decl: -| labels(lident_rich) params cast preceded(EQUAL,term)? - { - let loc = floc $startpos $endpos in - let named_ident = - ($1.id_str, str_of_labs $1.id_lab) in - match $4 with - | None -> - mak_logic loc [named_ident] (Some $3) $2 - | Some t -> - mk_function t $3 loc named_ident $2 - } - -predicate_decl: -| labels(lident_rich) params preceded(EQUAL,term)? - { - let loc = floc $startpos $endpos in - let named_ident = - ($1.id_str, str_of_labs $1.id_lab) in - match $3 with - | None -> - mak_logic loc [named_ident] None $2 - | Some t -> - mk_pred t $2 loc named_ident - } - -with_logic_decl: -| WITH labels(lident_rich) params cast? preceded(EQUAL,term)? - { - let loc = floc $startpos $endpos in - let named_ident = - ($2.id_str, str_of_labs $2.id_lab) in - match $4, $5 with - | None, None -> - mak_logic loc [named_ident] None $3 - | None, Some t -> - mk_pred t $3 loc named_ident - | Some t, None -> - mak_logic loc [named_ident] (Some t) $3 - | Some t0, Some t1 -> - mk_function t1 t0 loc - named_ident $3 - } - - -(* Type expressions *) - -ty: -| ty_arg { $1 } -| lqualid ty_arg+ { mk_tyapp $1 $2 } - - -ty_arg: -| lqualid - { mk_tyapp $1 [] } -| LEFTPAR comma_list2(ty) RIGHTPAR - { mk_tuple $2 (floc $startpos $endpos) } -| LEFTPAR RIGHTPAR - { mk_tuple [] (floc $startpos $endpos) } -| LEFTPAR ty RIGHTPAR { $2 } - -cast: -| COLON ty { $2 } - -(* Parameters and binders *) - -(* [param] and [binder] below must have the same grammar - and raise [Error] in the same cases. Interpretaion of - single-standing untyped [Qident]'s is different: [param] - treats them as type expressions, [binder], as parameter - names, whose type must be inferred. *) - -params: param* { List.concat $1 } - - (*binders: binder+ { List.concat $1 }*) - -param: -| anon_binder - { error_param (floc $startpos $endpos) } -| ty_arg - { [ floc $startpos $endpos, None, $1] } -| LEFTPAR GHOST ty RIGHTPAR - { [ floc $startpos $endpos, None, $3] } -| ty_arg label label* - { error_loc (floc $startpos $endpos) } -| LEFTPAR binder_vars_rest RIGHTPAR - { match $2 with [l,_] -> error_param l - | _ -> error_loc (floc $startpos($3) $endpos($3)) } -| LEFTPAR GHOST binder_vars_rest RIGHTPAR - { match $3 with [l,_] -> error_param l - | _ -> error_loc (floc $startpos($4) $endpos($4)) } -| LEFTPAR binder_vars cast RIGHTPAR - { List.map (fun (l,i) -> (l, i, $3)) $2 } -| LEFTPAR GHOST binder_vars cast RIGHTPAR - { List.map (fun (l,i) -> (l, i, $4)) $3 } - -binder_vars: -| binder_vars_head { List.rev $1 } -| binder_vars_rest { $1 } - -binder_vars_rest: -| binder_vars_head label label* binder_var* - { List.rev_append (match $1 with - | (l, Some id) :: bl -> - let l3 = floc $startpos($3) $endpos($3) in - (Why3_loc.join l l3, Some (add_lab id ($2::$3))) :: bl - | _ -> assert false) $4 } -| binder_vars_head anon_binder binder_var* - { List.rev_append $1 ($2 :: $3) } -| anon_binder binder_var* - { $1 :: $2 } - -binder_vars_head: -| ty { - let of_id id = id.id_loc, Some id in - let push acc = function - | Parsed.PPTexternal ([], s, _) - -> (of_id (mk_id s $startpos $endpos)):: acc - | _ -> Why3_loc.error ~loc:(floc $startpos $endpos) Parsing.Parse_error in - match $1 with - | Parsed.PPTexternal (l, s, _) -> - List.fold_left push [of_id (mk_id s $startpos $endpos)] l - | _ -> Why3_loc.error ~loc:(floc $startpos $endpos) Parsing.Parse_error } - -binder_var: -| labels(lident_nq) { floc $startpos $endpos, Some $1 } -| anon_binder { $1 } - -anon_binder: -| UNDERSCORE { floc $startpos $endpos, None } - -(* Logical terms *) - -mk_term(X): d = X { mk_term d $startpos $endpos } - -term: t = mk_term(term_) { t } - -term_: -| term_arg_ - { $1 } -| NOT term - { mk_not (floc $startpos $endpos) $2 } -| prefix_op term %prec prec_prefix_op - { match $1 with - | { id_str = "prefix -" ; _ } - | { id_str = "infix -" ; _ } -> - mk_minus (floc $startpos $endpos) $2 - | _ -> - Printer.print_err "[TODO]"; assert false - } -| l = term ; o = bin_op ; r = term - { o (floc $startpos $endpos) l r } -| l = term ; o = infix_op ; r = term - { mk_infix_ident o (floc $startpos $endpos) l r } -| term_arg located(term_arg)+ (* FIXME/TODO: "term term_arg" *) - { let join f (a,_,e) = - mk_term (mk_apply (floc $startpos $endpos) f a) $startpos e in - (List.fold_left join $1 $2) } -| IF term THEN term ELSE term - { mk_ite (floc $startpos $endpos) $2 $4 $6 } -| LET pattern EQUAL term IN term - { - let loc = (floc $startpos $endpos) in - match $2 with - | Pvar id -> - mk_let loc [id.id_str, $4] $6 - | Pwild -> - mk_let loc [(id_anonymous loc).id_str, $4] $6 - | Ptuple [] -> - mk_let loc [(id_anonymous loc).id_str, - (mk_type_cast loc $4 (mk_tuple [] loc))] $6 - | Pcast (Pvar id, ty) -> - mk_let loc [id.id_str, (mk_type_cast loc $4 ty)] $6 - | Pcast (Pwild, ty) -> - let id = id_anonymous loc in - mk_let loc [id.id_str, (mk_type_cast loc $4 ty)] $6 - | _ -> assert false - } -| quant comma_list1(quant_vars) triggers DOT term - { - let vs_ty = - List.map (function (_, Some i, Some pty) -> (i.id_str, "", pty - ) | _ -> assert false) (List.concat $2) in - let triggers = - List.map (fun tl -> (tl, true)) $3 in - $1 (floc $startpos $endpos) vs_ty triggers [] $5 - } -| EPSILON - { Why3_loc.errorm "Epsilon terms are currently not supported in WhyML" } -| label term %prec prec_named - { mk_named (floc $startpos $endpos) $1 $2 } -| term cast - { mk_type_cast (floc $startpos $endpos) $1 $2 } - -term_arg: mk_term(term_arg_) { $1 } -term_dot: mk_term(term_dot_) { $1 } - -term_arg_: -| qualid - { $1 } -| numeral - { - mk_int_const (floc $startpos $endpos) $1 - } -| TRUE { mk_true_const (floc $startpos $endpos) } -| FALSE { mk_false_const (floc $startpos $endpos) } -| quote_uident - { mk_qualid $1 } -| o = oppref ; a = term_arg - { match o with - | { id_str = "prefix -" ; _ } - | { id_str = "infix -" ; _ } -> - mk_minus (floc $startpos $endpos) a - | _ -> Printer.print_err "[TODO]"; assert false - } -| term_sub_ { $1 } - -term_dot_: - | lqualid - { $1 } - | o = oppref ; a = term_dot - { match o with - | { id_str = "prefix -" ; _ } - | { id_str = "infix -" ; _ } -> - mk_minus (floc $startpos $endpos) a - | _ -> - Printer.print_err "[TODO]"; assert false - } -| term_sub_ { $1 } - -term_sub_: - | td=term_dot DOT ldr=lqualid_rich - { match ldr with - | {Parsed.pp_desc = PPvar "prefix -" ; _ } - | {Parsed.pp_desc = PPvar "infix -" ; _ } -> - mk_minus (floc $startpos $endpos) td - | {Parsed.pp_desc = PPvar s ; _ } -> - mk_dot_record (floc $startpos $endpos) td s - | _ -> Printer.print_err "[TODO]"; assert false - } -| LEFTPAR term RIGHTPAR { $2 } -| LEFTPAR RIGHTPAR - { mk_tuple_record [] (floc $startpos $endpos) } -| LEFTPAR comma_list2(term) RIGHTPAR - { mk_tuple_record $2(floc $startpos $endpos) } - -| LEFTBRC li_cr=semicolon_list1(case_record) RIGHTBRC - { mk_record (floc $startpos $endpos) li_cr } - -field_list1(X): -| fl = semicolon_list1(separated_pair(lqualid, EQUAL, X)) { fl } - -match_cases(X): -| cl = bar_list1(separated_pair(pattern, ARROW, X)) { cl } - -quant_vars: -| binder_var+ cast? - { - List.map - (fun (l,i) -> - match $2 with - | Some pty -> l, i, Some pty - | _ -> l, i, None) - $1 - } - -triggers: -| (* epsilon *) { [] } -| LEFTSQ separated_nonempty_list(BAR,comma_list1(term)) RIGHTSQ { $2 } - -%inline bin_op: -| ARROW { mk_implies } -| LRARROW { mk_iff } -| OR { mk_or } -| AND { mk_and } - -quant: -| FORALL { mk_forall } -| EXISTS { mk_exists } - -numeral: -| INTEGER { $1 } - - -invariant: -| INVARIANT LEFTBRC term RIGHTBRC { $3 } - -case_record: -| lab_li=labels(lident_nq) EQUAL t=term { lab_li.id_str, t } - - -(* Patterns *) - -pattern: pattern_ { $1 } - -pattern_: -| pat_conj_ { $1 } - -pat_conj_: -| pat_uni_ { $1 } - -pat_uni_: -| pat_arg_ { $1 } -| pat_uni_ cast { Pcast($1,$2) } - -pat_arg_: -| UNDERSCORE { Pwild } -| labels(lident_nq) { Pvar $1 } -| LEFTPAR RIGHTPAR { Ptuple [] } -| LEFTPAR pattern_ RIGHTPAR { $2 } - -(* Why3_idents *) - -ident: -| uident { $1 } -| lident { $1 } - -ident_nq: -| uident_nq { $1 } -| lident_nq { $1 } - -uident: -| UIDENT { mk_id $1 $startpos $endpos } -| UIDENT_QUOTE { mk_id $1 $startpos $endpos } - -uident_nq: -| UIDENT { mk_id $1 $startpos $endpos } -| UIDENT_QUOTE { let loc = floc $startpos($1) $endpos($1) in - Why3_loc.errorm ~loc "Symbol %s cannot be user-defined" $1 } - -lident: -| LIDENT { mk_id $1 $startpos $endpos } -| LIDENT_QUOTE { mk_id $1 $startpos $endpos } - -lident_nq: -| LIDENT { mk_id $1 $startpos $endpos } -| LIDENT_QUOTE { let loc = floc $startpos($1) $endpos($1) in - Why3_loc.errorm ~loc "Symbol %s cannot be user-defined" $1 } - - -quote_uident: -| QUOTE_UIDENT { mk_id ("'" ^ $1) $startpos $endpos } - -quote_lident: -| QUOTE_LIDENT { mk_id $1 $startpos $endpos } - -(* Why3_idents + symbolic operation names *) - -lident_rich: -| lident_nq { $1 } -| lident_op_id { $1 } - -lident_op_id: -| LEFTPAR lident_op RIGHTPAR { mk_id $2 $startpos($2) $endpos($2) } -| LEFTPAR_STAR_RIGHTPAR - { (* parentheses are removed from the location *) - let s = let s = $startpos in { s with pos_cnum = s.pos_cnum + 1 } in - let e = let e = $endpos in { e with pos_cnum = e.pos_cnum - 1 } in - mk_id (infix "*") s e } - -lident_op: -| op_symbol { infix $1 } -| op_symbol UNDERSCORE { prefix $1 } -| EQUAL { infix "=" } -| OPPREF { prefix $1 } - -op_symbol: -| OP1 { $1 } -| OP2 { $1 } -| OP3 { $1 } -| OP4 { $1 } -| LT { "<" } -| GT { ">" } - -%inline oppref: -| o = OPPREF { mk_id (prefix o) $startpos $endpos } - -prefix_op: -| op_symbol { mk_id (prefix $1) $startpos $endpos } - -%inline infix_op: -| o = OP1 { mk_id (infix o) $startpos $endpos } -| o = OP2 { mk_id (infix o) $startpos $endpos } -| o = OP3 { mk_id (infix o) $startpos $endpos } -| o = OP4 { mk_id (infix o) $startpos $endpos } -| EQUAL { mk_id (infix "=") $startpos $endpos } -| LTGT { mk_id (infix "<>") $startpos $endpos } -| LT { mk_id (infix "<") $startpos $endpos } -| GT { mk_id (infix ">") $startpos $endpos } - -(* Qualified idents *) - -qualid: -| uident { mk_qualid $1 } -| lident { mk_qualid $1 } -| lident_op_id { mk_qualid $1 } -| uqualid DOT uident { mk_qualid $3 } -| uqualid DOT lident { hack_mod $1 $3 } -| uqualid DOT lident_op_id { mk_qualid $3 } - -lqualid_rich: -| lident { mk_qualid $1 } -| lident_op_id { mk_qualid $1 } -| uqualid DOT lident { mk_qualid $3 } -| uqualid DOT lident_op_id { mk_qualid $3 } - -lqualid: -| lident { mk_qualid $1 } -| uqualid DOT lident { mk_qualid $3 } - -uqualid: -| uident { mk_qualid $1 } -| uqualid DOT uident { mk_qualid $3 } - -(* Theory/Module names *) - -tqualid: -| uident { mk_qualid $1 } -| any_qualid DOT uident { mk_qualid $3 } - -any_qualid: -| sident { $1 } -| any_qualid DOT sident { $3 } - -sident: -| ident { mk_qualid $1 } -| STRING { mk_qualid (mk_id $1 $startpos $endpos) } - -(* Labels and position markers *) - -labels(X): X label* { add_lab $1 $2 } - -label: -| STRING { $1 } - -(* Miscellaneous *) - -bar_list1(X): -| ioption(BAR) ; xl = separated_nonempty_list(BAR, X) { xl } - -with_list1(X): -| separated_nonempty_list(WITH, X) { $1 } - -comma_list2(X): -| X COMMA comma_list1(X) { $1 :: $3 } - -comma_list1(X): -| separated_nonempty_list(COMMA, X) { $1 } - -comma_list0(X): -| xl = separated_list(COMMA, X) { xl } - -semicolon_list1(X): -| x = X ; ioption(SEMICOLON) { [x] } -| x = X ; SEMICOLON ; xl = semicolon_list1(X) { x :: xl } - -located(X): X { $1, $startpos, $endpos } diff --git a/src/plugins/AB-Why3/why3_ptree.ml b/src/plugins/AB-Why3/why3_ptree.ml deleted file mode 100644 index 89729cb6b2..0000000000 --- a/src/plugins/AB-Why3/why3_ptree.ml +++ /dev/null @@ -1,54 +0,0 @@ -(********************************************************************) -(* *) -(* The Why3 Verification Platform / The Why3 Development Team *) -(* Copyright 2010-2017 -- INRIA - CNRS - Paris-Sud University *) -(* *) -(* This software is distributed under the terms of the GNU Lesser *) -(* General Public License version 2.1, with the special exception *) -(* on linking described in file LICENSE. *) -(* *) -(********************************************************************) - -(******************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) 2018 --- OCamlPro SAS *) -(* *) -(******************************************************************************) - -open AltErgoLib - -(*s Parse trees. *) - -type loc = Loc.t - -(*s Logical terms and formulas *) - -type integer_constant = string - -type constant = string - -type label = string - -type ident = { - id_str : string; - id_lab : label list; - id_loc : loc; -} - -type qualid = Parsed.lexpr - -type pty = Parsed.ppure_type - -type binder = loc * ident option * Parsed.ppure_type option - -type param = loc * ident option * Parsed.ppure_type - -type pattern = - | Pwild - | Pvar of ident - | Ptuple of pattern list - | Pcast of pattern * pty - -type term = Parsed.lexpr - diff --git a/src/plugins/AB-Why3/why3_ptree.mli b/src/plugins/AB-Why3/why3_ptree.mli deleted file mode 100644 index fa52eb23ab..0000000000 --- a/src/plugins/AB-Why3/why3_ptree.mli +++ /dev/null @@ -1,39 +0,0 @@ -(********************************************************************) -(* *) -(* The Why3 Verification Platform / The Why3 Development Team *) -(* Copyright 2010-2017 -- INRIA - CNRS - Paris-Sud University *) -(* *) -(* This software is distributed under the terms of the GNU Lesser *) -(* General Public License version 2.1, with the special exception *) -(* on linking described in file LICENSE. *) -(* *) -(********************************************************************) - -(******************************************************************************) -(* *) -(* Alt-Ergo: The SMT Solver For Software Verification *) -(* Copyright (C) 2018 --- OCamlPro SAS *) -(* *) -(******************************************************************************) - -open AltErgoLib - -type loc = Loc.t -type integer_constant = string -type constant = string -type label = string - - - -type ident = { id_str : string; id_lab : label list; id_loc : loc; } -type qualid = Parsed.lexpr -type pty = Parsed.ppure_type - -type binder = loc * ident option * Parsed.ppure_type option -type param = loc * ident option * Parsed.ppure_type -type pattern = - | Pwild - | Pvar of ident - | Ptuple of pattern list - | Pcast of pattern * pty -type term = Parsed.lexpr diff --git a/tests/bitv/testfile-array-cs.dolmen.expected b/tests/bitv/testfile-array-cs.expected similarity index 100% rename from tests/bitv/testfile-array-cs.dolmen.expected rename to tests/bitv/testfile-array-cs.expected diff --git a/tests/bitv/testfile-array-cs.dolmen.smt2 b/tests/bitv/testfile-array-cs.smt2 similarity index 100% rename from tests/bitv/testfile-array-cs.dolmen.smt2 rename to tests/bitv/testfile-array-cs.smt2 diff --git a/tests/bitv/testfile-bv2nat-delayed.dolmen.expected b/tests/bitv/testfile-bv2nat-delayed.expected similarity index 100% rename from tests/bitv/testfile-bv2nat-delayed.dolmen.expected rename to tests/bitv/testfile-bv2nat-delayed.expected diff --git a/tests/bitv/testfile-bv2nat-delayed.dolmen.smt2 b/tests/bitv/testfile-bv2nat-delayed.smt2 similarity index 100% rename from tests/bitv/testfile-bv2nat-delayed.dolmen.smt2 rename to tests/bitv/testfile-bv2nat-delayed.smt2 diff --git a/tests/bitv/testfile-bv2nat-immediate.dolmen.expected b/tests/bitv/testfile-bv2nat-immediate.expected similarity index 100% rename from tests/bitv/testfile-bv2nat-immediate.dolmen.expected rename to tests/bitv/testfile-bv2nat-immediate.expected diff --git a/tests/bitv/testfile-bv2nat-immediate.dolmen.smt2 b/tests/bitv/testfile-bv2nat-immediate.smt2 similarity index 100% rename from tests/bitv/testfile-bv2nat-immediate.dolmen.smt2 rename to tests/bitv/testfile-bv2nat-immediate.smt2 diff --git a/tests/bitv/testfile-bv2nat-models.dolmen.expected b/tests/bitv/testfile-bv2nat-models.expected similarity index 100% rename from tests/bitv/testfile-bv2nat-models.dolmen.expected rename to tests/bitv/testfile-bv2nat-models.expected diff --git a/tests/bitv/testfile-bv2nat-models.dolmen.smt2 b/tests/bitv/testfile-bv2nat-models.smt2 similarity index 100% rename from tests/bitv/testfile-bv2nat-models.dolmen.smt2 rename to tests/bitv/testfile-bv2nat-models.smt2 diff --git a/tests/bitv/testfile-bvadd-001.dolmen.expected b/tests/bitv/testfile-bvadd-001.expected similarity index 100% rename from tests/bitv/testfile-bvadd-001.dolmen.expected rename to tests/bitv/testfile-bvadd-001.expected diff --git a/tests/bitv/testfile-bvadd-001.dolmen.smt2 b/tests/bitv/testfile-bvadd-001.smt2 similarity index 100% rename from tests/bitv/testfile-bvadd-001.dolmen.smt2 rename to tests/bitv/testfile-bvadd-001.smt2 diff --git a/tests/bitv/testfile-bvadd-002.dolmen.expected b/tests/bitv/testfile-bvadd-002.expected similarity index 100% rename from tests/bitv/testfile-bvadd-002.dolmen.expected rename to tests/bitv/testfile-bvadd-002.expected diff --git a/tests/bitv/testfile-bvadd-002.dolmen.smt2 b/tests/bitv/testfile-bvadd-002.smt2 similarity index 100% rename from tests/bitv/testfile-bvadd-002.dolmen.smt2 rename to tests/bitv/testfile-bvadd-002.smt2 diff --git a/tests/bitv/testfile-bvand-001.dolmen.expected b/tests/bitv/testfile-bvand-001.expected similarity index 100% rename from tests/bitv/testfile-bvand-001.dolmen.expected rename to tests/bitv/testfile-bvand-001.expected diff --git a/tests/bitv/testfile-bvand-001.dolmen.smt2 b/tests/bitv/testfile-bvand-001.smt2 similarity index 100% rename from tests/bitv/testfile-bvand-001.dolmen.smt2 rename to tests/bitv/testfile-bvand-001.smt2 diff --git a/tests/bitv/testfile-bvnot-term.dolmen.expected b/tests/bitv/testfile-bvnot-term.expected similarity index 100% rename from tests/bitv/testfile-bvnot-term.dolmen.expected rename to tests/bitv/testfile-bvnot-term.expected diff --git a/tests/bitv/testfile-bvnot-term.dolmen.smt2 b/tests/bitv/testfile-bvnot-term.smt2 similarity index 100% rename from tests/bitv/testfile-bvnot-term.dolmen.smt2 rename to tests/bitv/testfile-bvnot-term.smt2 diff --git a/tests/bitv/testfile-bvnot.dolmen.expected b/tests/bitv/testfile-bvnot.default.expected similarity index 100% rename from tests/bitv/testfile-bvnot.dolmen.expected rename to tests/bitv/testfile-bvnot.default.expected diff --git a/tests/bitv/testfile-bvnot.dolmen.smt2 b/tests/bitv/testfile-bvnot.default.smt2 similarity index 100% rename from tests/bitv/testfile-bvnot.dolmen.smt2 rename to tests/bitv/testfile-bvnot.default.smt2 diff --git a/tests/bitv/testfile-bvor-001.dolmen.expected b/tests/bitv/testfile-bvor-001.expected similarity index 100% rename from tests/bitv/testfile-bvor-001.dolmen.expected rename to tests/bitv/testfile-bvor-001.expected diff --git a/tests/bitv/testfile-bvor-001.dolmen.smt2 b/tests/bitv/testfile-bvor-001.smt2 similarity index 100% rename from tests/bitv/testfile-bvor-001.dolmen.smt2 rename to tests/bitv/testfile-bvor-001.smt2 diff --git a/tests/bitv/testfile-bvsub-001.dolmen.expected b/tests/bitv/testfile-bvsub-001.expected similarity index 100% rename from tests/bitv/testfile-bvsub-001.dolmen.expected rename to tests/bitv/testfile-bvsub-001.expected diff --git a/tests/bitv/testfile-bvsub-001.dolmen.smt2 b/tests/bitv/testfile-bvsub-001.smt2 similarity index 100% rename from tests/bitv/testfile-bvsub-001.dolmen.smt2 rename to tests/bitv/testfile-bvsub-001.smt2 diff --git a/tests/bitv/testfile-bvsub-002.dolmen.expected b/tests/bitv/testfile-bvsub-002.expected similarity index 100% rename from tests/bitv/testfile-bvsub-002.dolmen.expected rename to tests/bitv/testfile-bvsub-002.expected diff --git a/tests/bitv/testfile-bvsub-002.dolmen.smt2 b/tests/bitv/testfile-bvsub-002.smt2 similarity index 100% rename from tests/bitv/testfile-bvsub-002.dolmen.smt2 rename to tests/bitv/testfile-bvsub-002.smt2 diff --git a/tests/bitv/testfile-bvxor-001.dolmen.expected b/tests/bitv/testfile-bvxor-001.expected similarity index 100% rename from tests/bitv/testfile-bvxor-001.dolmen.expected rename to tests/bitv/testfile-bvxor-001.expected diff --git a/tests/bitv/testfile-bvxor-001.dolmen.smt2 b/tests/bitv/testfile-bvxor-001.smt2 similarity index 100% rename from tests/bitv/testfile-bvxor-001.dolmen.smt2 rename to tests/bitv/testfile-bvxor-001.smt2 diff --git a/tests/bitv/testfile-int2bv-delayed.dolmen.expected b/tests/bitv/testfile-int2bv-delayed.expected similarity index 100% rename from tests/bitv/testfile-int2bv-delayed.dolmen.expected rename to tests/bitv/testfile-int2bv-delayed.expected diff --git a/tests/bitv/testfile-int2bv-delayed.dolmen.smt2 b/tests/bitv/testfile-int2bv-delayed.smt2 similarity index 100% rename from tests/bitv/testfile-int2bv-delayed.dolmen.smt2 rename to tests/bitv/testfile-int2bv-delayed.smt2 diff --git a/tests/bitv/testfile-int2bv-immediate.dolmen.expected b/tests/bitv/testfile-int2bv-immediate.expected similarity index 100% rename from tests/bitv/testfile-int2bv-immediate.dolmen.expected rename to tests/bitv/testfile-int2bv-immediate.expected diff --git a/tests/bitv/testfile-int2bv-immediate.dolmen.smt2 b/tests/bitv/testfile-int2bv-immediate.smt2 similarity index 100% rename from tests/bitv/testfile-int2bv-immediate.dolmen.smt2 rename to tests/bitv/testfile-int2bv-immediate.smt2 diff --git a/tests/bitv/testfile-qfbv-timeout.unix.dolmen.expected b/tests/bitv/testfile-qfbv-timeout.unix.expected similarity index 100% rename from tests/bitv/testfile-qfbv-timeout.unix.dolmen.expected rename to tests/bitv/testfile-qfbv-timeout.unix.expected diff --git a/tests/bitv/testfile-qfbv-timeout.unix.dolmen.smt2 b/tests/bitv/testfile-qfbv-timeout.unix.smt2 similarity index 100% rename from tests/bitv/testfile-qfbv-timeout.unix.dolmen.smt2 rename to tests/bitv/testfile-qfbv-timeout.unix.smt2 diff --git a/tests/dolmen/bitv/bv2nat_bvneg.dolmen.expected b/tests/dolmen/bitv/bv2nat_bvneg.expected similarity index 100% rename from tests/dolmen/bitv/bv2nat_bvneg.dolmen.expected rename to tests/dolmen/bitv/bv2nat_bvneg.expected diff --git a/tests/dolmen/bitv/bv2nat_bvneg.dolmen.smt2 b/tests/dolmen/bitv/bv2nat_bvneg.smt2 similarity index 100% rename from tests/dolmen/bitv/bv2nat_bvneg.dolmen.smt2 rename to tests/dolmen/bitv/bv2nat_bvneg.smt2 diff --git a/tests/dolmen/bitv/bv2nat_bvnot.dolmen.expected b/tests/dolmen/bitv/bv2nat_bvnot.expected similarity index 100% rename from tests/dolmen/bitv/bv2nat_bvnot.dolmen.expected rename to tests/dolmen/bitv/bv2nat_bvnot.expected diff --git a/tests/dolmen/bitv/bv2nat_bvnot.dolmen.smt2 b/tests/dolmen/bitv/bv2nat_bvnot.smt2 similarity index 100% rename from tests/dolmen/bitv/bv2nat_bvnot.dolmen.smt2 rename to tests/dolmen/bitv/bv2nat_bvnot.smt2 diff --git a/tests/dolmen/bitv/bv2nat_bvnot_range.dolmen.expected b/tests/dolmen/bitv/bv2nat_bvnot_range.expected similarity index 100% rename from tests/dolmen/bitv/bv2nat_bvnot_range.dolmen.expected rename to tests/dolmen/bitv/bv2nat_bvnot_range.expected diff --git a/tests/dolmen/bitv/bv2nat_bvnot_range.dolmen.smt2 b/tests/dolmen/bitv/bv2nat_bvnot_range.smt2 similarity index 100% rename from tests/dolmen/bitv/bv2nat_bvnot_range.dolmen.smt2 rename to tests/dolmen/bitv/bv2nat_bvnot_range.smt2 diff --git a/tests/dolmen/bitv/coherence.dolmen.expected b/tests/dolmen/bitv/coherence.expected similarity index 100% rename from tests/dolmen/bitv/coherence.dolmen.expected rename to tests/dolmen/bitv/coherence.expected diff --git a/tests/dolmen/bitv/coherence.dolmen.smt2 b/tests/dolmen/bitv/coherence.smt2 similarity index 100% rename from tests/dolmen/bitv/coherence.dolmen.smt2 rename to tests/dolmen/bitv/coherence.smt2 diff --git a/tests/dolmen/bitv/cyclic.dolmen.expected b/tests/dolmen/bitv/cyclic.expected similarity index 100% rename from tests/dolmen/bitv/cyclic.dolmen.expected rename to tests/dolmen/bitv/cyclic.expected diff --git a/tests/dolmen/bitv/cyclic.dolmen.smt2 b/tests/dolmen/bitv/cyclic.smt2 similarity index 100% rename from tests/dolmen/bitv/cyclic.dolmen.smt2 rename to tests/dolmen/bitv/cyclic.smt2 diff --git a/tests/dolmen/bitv/not-contra.dolmen.expected b/tests/dolmen/bitv/not-contra.expected similarity index 100% rename from tests/dolmen/bitv/not-contra.dolmen.expected rename to tests/dolmen/bitv/not-contra.expected diff --git a/tests/dolmen/bitv/not-contra.dolmen.smt2 b/tests/dolmen/bitv/not-contra.smt2 similarity index 100% rename from tests/dolmen/bitv/not-contra.dolmen.smt2 rename to tests/dolmen/bitv/not-contra.smt2 diff --git a/tests/dolmen/bitv/notextract.dolmen.expected b/tests/dolmen/bitv/notextract.expected similarity index 100% rename from tests/dolmen/bitv/notextract.dolmen.expected rename to tests/dolmen/bitv/notextract.expected diff --git a/tests/dolmen/bitv/notextract.dolmen.smt2 b/tests/dolmen/bitv/notextract.smt2 similarity index 100% rename from tests/dolmen/bitv/notextract.dolmen.smt2 rename to tests/dolmen/bitv/notextract.smt2 diff --git a/tests/dolmen/bitv/notnotx.dolmen.expected b/tests/dolmen/bitv/notnotx.expected similarity index 100% rename from tests/dolmen/bitv/notnotx.dolmen.expected rename to tests/dolmen/bitv/notnotx.expected diff --git a/tests/dolmen/bitv/notnotx.dolmen.smt2 b/tests/dolmen/bitv/notnotx.smt2 similarity index 100% rename from tests/dolmen/bitv/notnotx.dolmen.smt2 rename to tests/dolmen/bitv/notnotx.smt2 diff --git a/tests/dolmen/bitv/notx.dolmen.expected b/tests/dolmen/bitv/notx.expected similarity index 100% rename from tests/dolmen/bitv/notx.dolmen.expected rename to tests/dolmen/bitv/notx.expected diff --git a/tests/dolmen/bitv/notx.dolmen.smt2 b/tests/dolmen/bitv/notx.smt2 similarity index 100% rename from tests/dolmen/bitv/notx.dolmen.smt2 rename to tests/dolmen/bitv/notx.smt2 diff --git a/tests/float/test_float1.dolmen.expected b/tests/float/test_float1.expected similarity index 100% rename from tests/float/test_float1.dolmen.expected rename to tests/float/test_float1.expected diff --git a/tests/float/test_float1.dolmen.smt2 b/tests/float/test_float1.smt2 similarity index 100% rename from tests/float/test_float1.dolmen.smt2 rename to tests/float/test_float1.smt2 diff --git a/tests/float/test_float2.models.expected b/tests/float/test_float2.default.expected similarity index 100% rename from tests/float/test_float2.models.expected rename to tests/float/test_float2.default.expected diff --git a/tests/float/test_float2.models.smt2 b/tests/float/test_float2.default.smt2 similarity index 100% rename from tests/float/test_float2.models.smt2 rename to tests/float/test_float2.default.smt2 diff --git a/tests/issues/issue1024.err.dolmen.expected b/tests/issues/1024.err.default.expected similarity index 100% rename from tests/issues/issue1024.err.dolmen.expected rename to tests/issues/1024.err.default.expected diff --git a/tests/issues/issue1024.err.dolmen.smt2 b/tests/issues/1024.err.default.smt2 similarity index 100% rename from tests/issues/issue1024.err.dolmen.smt2 rename to tests/issues/1024.err.default.smt2 diff --git a/tests/issues/1163.models.expected b/tests/issues/1163.default.expected similarity index 100% rename from tests/issues/1163.models.expected rename to tests/issues/1163.default.expected diff --git a/tests/issues/1163.models.smt2 b/tests/issues/1163.default.smt2 similarity index 100% rename from tests/issues/1163.models.smt2 rename to tests/issues/1163.default.smt2 diff --git a/tests/issues/555.models.expected b/tests/issues/555.default.expected similarity index 100% rename from tests/issues/555.models.expected rename to tests/issues/555.default.expected diff --git a/tests/issues/555.models.smt2 b/tests/issues/555.default.smt2 similarity index 100% rename from tests/issues/555.models.smt2 rename to tests/issues/555.default.smt2 diff --git a/tests/issues/649/649.dolmen.smt2 b/tests/issues/649/649.smt2 similarity index 100% rename from tests/issues/649/649.dolmen.smt2 rename to tests/issues/649/649.smt2 diff --git a/tests/issues/664/664.dolmen.smt2 b/tests/issues/664/664.smt2 similarity index 100% rename from tests/issues/664/664.dolmen.smt2 rename to tests/issues/664/664.smt2 diff --git a/tests/issues/777.models.expected b/tests/issues/777.default.expected similarity index 100% rename from tests/issues/777.models.expected rename to tests/issues/777.default.expected diff --git a/tests/issues/777.models.smt2 b/tests/issues/777.default.smt2 similarity index 100% rename from tests/issues/777.models.smt2 rename to tests/issues/777.default.smt2 diff --git a/tests/issues/854/function.models.expected b/tests/issues/854/function.default.expected similarity index 100% rename from tests/issues/854/function.models.expected rename to tests/issues/854/function.default.expected diff --git a/tests/issues/854/function.models.smt2 b/tests/issues/854/function.default.smt2 similarity index 100% rename from tests/issues/854/function.models.smt2 rename to tests/issues/854/function.default.smt2 diff --git a/tests/issues/854/original.models.expected b/tests/issues/854/original.default.expected similarity index 100% rename from tests/issues/854/original.models.expected rename to tests/issues/854/original.default.expected diff --git a/tests/issues/854/original.models.smt2 b/tests/issues/854/original.default.smt2 similarity index 100% rename from tests/issues/854/original.models.smt2 rename to tests/issues/854/original.default.smt2 diff --git a/tests/issues/854/twice_eq.models.expected b/tests/issues/854/twice_eq.default.expected similarity index 100% rename from tests/issues/854/twice_eq.models.expected rename to tests/issues/854/twice_eq.default.expected diff --git a/tests/issues/854/twice_eq.models.smt2 b/tests/issues/854/twice_eq.default.smt2 similarity index 100% rename from tests/issues/854/twice_eq.models.smt2 rename to tests/issues/854/twice_eq.default.smt2 diff --git a/tests/issues/883.dolmen.expected b/tests/issues/883.expected similarity index 100% rename from tests/issues/883.dolmen.expected rename to tests/issues/883.expected diff --git a/tests/issues/883.dolmen.smt2 b/tests/issues/883.smt2 similarity index 100% rename from tests/issues/883.dolmen.smt2 rename to tests/issues/883.smt2 diff --git a/tests/issues/926.models.expected b/tests/issues/926.default.expected similarity index 100% rename from tests/issues/926.models.expected rename to tests/issues/926.default.expected diff --git a/tests/issues/926.models.smt2 b/tests/issues/926.default.smt2 similarity index 100% rename from tests/issues/926.models.smt2 rename to tests/issues/926.default.smt2 diff --git a/tests/models/adt/arith.models.expected b/tests/models/adt/arith.default.expected similarity index 100% rename from tests/models/adt/arith.models.expected rename to tests/models/adt/arith.default.expected diff --git a/tests/models/adt/arith.models.smt2 b/tests/models/adt/arith.default.smt2 similarity index 100% rename from tests/models/adt/arith.models.smt2 rename to tests/models/adt/arith.default.smt2 diff --git a/tests/models/adt/list.models.expected b/tests/models/adt/list.default.expected similarity index 100% rename from tests/models/adt/list.models.expected rename to tests/models/adt/list.default.expected diff --git a/tests/models/adt/list.models.smt2 b/tests/models/adt/list.default.smt2 similarity index 100% rename from tests/models/adt/list.models.smt2 rename to tests/models/adt/list.default.smt2 diff --git a/tests/models/adt/rec.models.expected b/tests/models/adt/rec.default.expected similarity index 100% rename from tests/models/adt/rec.models.expected rename to tests/models/adt/rec.default.expected diff --git a/tests/models/adt/rec.models.smt2 b/tests/models/adt/rec.default.smt2 similarity index 100% rename from tests/models/adt/rec.models.smt2 rename to tests/models/adt/rec.default.smt2 diff --git a/tests/models/adt/rec2.models.expected b/tests/models/adt/rec2.default.expected similarity index 100% rename from tests/models/adt/rec2.models.expected rename to tests/models/adt/rec2.default.expected diff --git a/tests/models/adt/rec2.models.smt2 b/tests/models/adt/rec2.default.smt2 similarity index 100% rename from tests/models/adt/rec2.models.smt2 rename to tests/models/adt/rec2.default.smt2 diff --git a/tests/models/adt/rec3.models.expected b/tests/models/adt/rec3.default.expected similarity index 100% rename from tests/models/adt/rec3.models.expected rename to tests/models/adt/rec3.default.expected diff --git a/tests/models/adt/rec3.models.smt2 b/tests/models/adt/rec3.default.smt2 similarity index 100% rename from tests/models/adt/rec3.models.smt2 rename to tests/models/adt/rec3.default.smt2 diff --git a/tests/models/adt/small.models.expected b/tests/models/adt/small.default.expected similarity index 100% rename from tests/models/adt/small.models.expected rename to tests/models/adt/small.default.expected diff --git a/tests/models/adt/small.models.smt2 b/tests/models/adt/small.default.smt2 similarity index 100% rename from tests/models/adt/small.models.smt2 rename to tests/models/adt/small.default.smt2 diff --git a/tests/models/arith/arith1.models.expected b/tests/models/arith/arith1.default.expected similarity index 100% rename from tests/models/arith/arith1.models.expected rename to tests/models/arith/arith1.default.expected diff --git a/tests/models/arith/arith1.models.smt2 b/tests/models/arith/arith1.default.smt2 similarity index 100% rename from tests/models/arith/arith1.models.smt2 rename to tests/models/arith/arith1.default.smt2 diff --git a/tests/models/arith/arith10.dolmen.expected b/tests/models/arith/arith10.default.expected similarity index 100% rename from tests/models/arith/arith10.dolmen.expected rename to tests/models/arith/arith10.default.expected diff --git a/tests/models/arith/arith10.dolmen.smt2 b/tests/models/arith/arith10.default.smt2 similarity index 100% rename from tests/models/arith/arith10.dolmen.smt2 rename to tests/models/arith/arith10.default.smt2 diff --git a/tests/models/arith/arith11.dolmen.expected b/tests/models/arith/arith11.default.expected similarity index 100% rename from tests/models/arith/arith11.dolmen.expected rename to tests/models/arith/arith11.default.expected diff --git a/tests/models/arith/arith11.dolmen.smt2 b/tests/models/arith/arith11.default.smt2 similarity index 100% rename from tests/models/arith/arith11.dolmen.smt2 rename to tests/models/arith/arith11.default.smt2 diff --git a/tests/models/arith/arith12.dolmen.expected b/tests/models/arith/arith12.default.expected similarity index 100% rename from tests/models/arith/arith12.dolmen.expected rename to tests/models/arith/arith12.default.expected diff --git a/tests/models/arith/arith12.dolmen.smt2 b/tests/models/arith/arith12.default.smt2 similarity index 100% rename from tests/models/arith/arith12.dolmen.smt2 rename to tests/models/arith/arith12.default.smt2 diff --git a/tests/models/arith/arith13.models.expected b/tests/models/arith/arith13.default.expected similarity index 100% rename from tests/models/arith/arith13.models.expected rename to tests/models/arith/arith13.default.expected diff --git a/tests/models/arith/arith13.models.smt2 b/tests/models/arith/arith13.default.smt2 similarity index 100% rename from tests/models/arith/arith13.models.smt2 rename to tests/models/arith/arith13.default.smt2 diff --git a/tests/models/arith/arith14.models.expected b/tests/models/arith/arith14.default.expected similarity index 100% rename from tests/models/arith/arith14.models.expected rename to tests/models/arith/arith14.default.expected diff --git a/tests/models/arith/arith14.models.smt2 b/tests/models/arith/arith14.default.smt2 similarity index 100% rename from tests/models/arith/arith14.models.smt2 rename to tests/models/arith/arith14.default.smt2 diff --git a/tests/models/arith/arith15.models.expected b/tests/models/arith/arith15.default.expected similarity index 100% rename from tests/models/arith/arith15.models.expected rename to tests/models/arith/arith15.default.expected diff --git a/tests/models/arith/arith15.models.smt2 b/tests/models/arith/arith15.default.smt2 similarity index 100% rename from tests/models/arith/arith15.models.smt2 rename to tests/models/arith/arith15.default.smt2 diff --git a/tests/models/arith/arith2.models.expected b/tests/models/arith/arith2.default.expected similarity index 100% rename from tests/models/arith/arith2.models.expected rename to tests/models/arith/arith2.default.expected diff --git a/tests/models/arith/arith2.models.smt2 b/tests/models/arith/arith2.default.smt2 similarity index 100% rename from tests/models/arith/arith2.models.smt2 rename to tests/models/arith/arith2.default.smt2 diff --git a/tests/models/arith/arith3.dolmen.expected b/tests/models/arith/arith3.default.expected similarity index 100% rename from tests/models/arith/arith3.dolmen.expected rename to tests/models/arith/arith3.default.expected diff --git a/tests/models/arith/arith3.dolmen.smt2 b/tests/models/arith/arith3.default.smt2 similarity index 100% rename from tests/models/arith/arith3.dolmen.smt2 rename to tests/models/arith/arith3.default.smt2 diff --git a/tests/models/arith/arith4.dolmen.expected b/tests/models/arith/arith4.default.expected similarity index 100% rename from tests/models/arith/arith4.dolmen.expected rename to tests/models/arith/arith4.default.expected diff --git a/tests/models/arith/arith4.dolmen.smt2 b/tests/models/arith/arith4.default.smt2 similarity index 100% rename from tests/models/arith/arith4.dolmen.smt2 rename to tests/models/arith/arith4.default.smt2 diff --git a/tests/models/arith/arith5.dolmen.expected b/tests/models/arith/arith5.default.expected similarity index 100% rename from tests/models/arith/arith5.dolmen.expected rename to tests/models/arith/arith5.default.expected diff --git a/tests/models/arith/arith5.dolmen.smt2 b/tests/models/arith/arith5.default.smt2 similarity index 100% rename from tests/models/arith/arith5.dolmen.smt2 rename to tests/models/arith/arith5.default.smt2 diff --git a/tests/models/arith/arith6.dolmen.expected b/tests/models/arith/arith6.default.expected similarity index 100% rename from tests/models/arith/arith6.dolmen.expected rename to tests/models/arith/arith6.default.expected diff --git a/tests/models/arith/arith6.dolmen.smt2 b/tests/models/arith/arith6.default.smt2 similarity index 100% rename from tests/models/arith/arith6.dolmen.smt2 rename to tests/models/arith/arith6.default.smt2 diff --git a/tests/models/arith/arith7.dolmen.expected b/tests/models/arith/arith7.default.expected similarity index 100% rename from tests/models/arith/arith7.dolmen.expected rename to tests/models/arith/arith7.default.expected diff --git a/tests/models/arith/arith7.dolmen.smt2 b/tests/models/arith/arith7.default.smt2 similarity index 100% rename from tests/models/arith/arith7.dolmen.smt2 rename to tests/models/arith/arith7.default.smt2 diff --git a/tests/models/arith/arith8.dolmen.expected b/tests/models/arith/arith8.default.expected similarity index 100% rename from tests/models/arith/arith8.dolmen.expected rename to tests/models/arith/arith8.default.expected diff --git a/tests/models/arith/arith8.dolmen.smt2 b/tests/models/arith/arith8.default.smt2 similarity index 100% rename from tests/models/arith/arith8.dolmen.smt2 rename to tests/models/arith/arith8.default.smt2 diff --git a/tests/models/arith/arith9.dolmen.expected b/tests/models/arith/arith9.default.expected similarity index 100% rename from tests/models/arith/arith9.dolmen.expected rename to tests/models/arith/arith9.default.expected diff --git a/tests/models/arith/arith9.dolmen.smt2 b/tests/models/arith/arith9.default.smt2 similarity index 100% rename from tests/models/arith/arith9.dolmen.smt2 rename to tests/models/arith/arith9.default.smt2 diff --git a/tests/models/array/array1.models.expected b/tests/models/array/array1.default.expected similarity index 100% rename from tests/models/array/array1.models.expected rename to tests/models/array/array1.default.expected diff --git a/tests/models/array/array1.models.smt2 b/tests/models/array/array1.default.smt2 similarity index 100% rename from tests/models/array/array1.models.smt2 rename to tests/models/array/array1.default.smt2 diff --git a/tests/models/array/embedded-array.models.expected b/tests/models/array/embedded-array.default.expected similarity index 100% rename from tests/models/array/embedded-array.models.expected rename to tests/models/array/embedded-array.default.expected diff --git a/tests/models/array/embedded-array.models.smt2 b/tests/models/array/embedded-array.default.smt2 similarity index 100% rename from tests/models/array/embedded-array.models.smt2 rename to tests/models/array/embedded-array.default.smt2 diff --git a/tests/models/bitv/bvand-1.models.expected b/tests/models/bitv/bvand-1.default.expected similarity index 100% rename from tests/models/bitv/bvand-1.models.expected rename to tests/models/bitv/bvand-1.default.expected diff --git a/tests/models/bitv/bvand-1.models.smt2 b/tests/models/bitv/bvand-1.default.smt2 similarity index 100% rename from tests/models/bitv/bvand-1.models.smt2 rename to tests/models/bitv/bvand-1.default.smt2 diff --git a/tests/models/bitv/bvand-2.models.expected b/tests/models/bitv/bvand-2.default.expected similarity index 100% rename from tests/models/bitv/bvand-2.models.expected rename to tests/models/bitv/bvand-2.default.expected diff --git a/tests/models/bitv/bvand-2.models.smt2 b/tests/models/bitv/bvand-2.default.smt2 similarity index 100% rename from tests/models/bitv/bvand-2.models.smt2 rename to tests/models/bitv/bvand-2.default.smt2 diff --git a/tests/models/bitv/bvor-1.models.expected b/tests/models/bitv/bvor-1.default.expected similarity index 100% rename from tests/models/bitv/bvor-1.models.expected rename to tests/models/bitv/bvor-1.default.expected diff --git a/tests/models/bitv/bvor-1.models.smt2 b/tests/models/bitv/bvor-1.default.smt2 similarity index 100% rename from tests/models/bitv/bvor-1.models.smt2 rename to tests/models/bitv/bvor-1.default.smt2 diff --git a/tests/models/bitv/bvor-2.models.expected b/tests/models/bitv/bvor-2.default.expected similarity index 100% rename from tests/models/bitv/bvor-2.models.expected rename to tests/models/bitv/bvor-2.default.expected diff --git a/tests/models/bitv/bvor-2.models.smt2 b/tests/models/bitv/bvor-2.default.smt2 similarity index 100% rename from tests/models/bitv/bvor-2.models.smt2 rename to tests/models/bitv/bvor-2.default.smt2 diff --git a/tests/models/bitv/bvxor-1.models.expected b/tests/models/bitv/bvxor-1.default.expected similarity index 100% rename from tests/models/bitv/bvxor-1.models.expected rename to tests/models/bitv/bvxor-1.default.expected diff --git a/tests/models/bitv/bvxor-1.models.smt2 b/tests/models/bitv/bvxor-1.default.smt2 similarity index 100% rename from tests/models/bitv/bvxor-1.models.smt2 rename to tests/models/bitv/bvxor-1.default.smt2 diff --git a/tests/models/bitv/bvxor-2.models.expected b/tests/models/bitv/bvxor-2.default.expected similarity index 100% rename from tests/models/bitv/bvxor-2.models.expected rename to tests/models/bitv/bvxor-2.default.expected diff --git a/tests/models/bitv/bvxor-2.models.smt2 b/tests/models/bitv/bvxor-2.default.smt2 similarity index 100% rename from tests/models/bitv/bvxor-2.models.smt2 rename to tests/models/bitv/bvxor-2.default.smt2 diff --git a/tests/models/bitv/cardinal.models.expected b/tests/models/bitv/cardinal.default.expected similarity index 100% rename from tests/models/bitv/cardinal.models.expected rename to tests/models/bitv/cardinal.default.expected diff --git a/tests/models/bitv/cardinal.models.smt2 b/tests/models/bitv/cardinal.default.smt2 similarity index 100% rename from tests/models/bitv/cardinal.models.smt2 rename to tests/models/bitv/cardinal.default.smt2 diff --git a/tests/models/bitv/cs-soundness.models.expected b/tests/models/bitv/cs-soundness.default.expected similarity index 100% rename from tests/models/bitv/cs-soundness.models.expected rename to tests/models/bitv/cs-soundness.default.expected diff --git a/tests/models/bitv/cs-soundness.models.smt2 b/tests/models/bitv/cs-soundness.default.smt2 similarity index 100% rename from tests/models/bitv/cs-soundness.models.smt2 rename to tests/models/bitv/cs-soundness.default.smt2 diff --git a/tests/models/bitv/extract.models.expected b/tests/models/bitv/extract.default.expected similarity index 100% rename from tests/models/bitv/extract.models.expected rename to tests/models/bitv/extract.default.expected diff --git a/tests/models/bitv/extract.models.smt2 b/tests/models/bitv/extract.default.smt2 similarity index 100% rename from tests/models/bitv/extract.models.smt2 rename to tests/models/bitv/extract.default.smt2 diff --git a/tests/models/bitv/manyslice.models.expected b/tests/models/bitv/manyslice.default.expected similarity index 100% rename from tests/models/bitv/manyslice.models.expected rename to tests/models/bitv/manyslice.default.expected diff --git a/tests/models/bitv/manyslice.models.smt2 b/tests/models/bitv/manyslice.default.smt2 similarity index 100% rename from tests/models/bitv/manyslice.models.smt2 rename to tests/models/bitv/manyslice.default.smt2 diff --git a/tests/models/bitv/not.models.expected b/tests/models/bitv/not.default.expected similarity index 100% rename from tests/models/bitv/not.models.expected rename to tests/models/bitv/not.default.expected diff --git a/tests/models/bitv/not.models.smt2 b/tests/models/bitv/not.default.smt2 similarity index 100% rename from tests/models/bitv/not.models.smt2 rename to tests/models/bitv/not.default.smt2 diff --git a/tests/models/bitv/optim-1.models.expected b/tests/models/bitv/optim-1.default.expected similarity index 100% rename from tests/models/bitv/optim-1.models.expected rename to tests/models/bitv/optim-1.default.expected diff --git a/tests/models/bitv/optim-1.models.smt2 b/tests/models/bitv/optim-1.default.smt2 similarity index 100% rename from tests/models/bitv/optim-1.models.smt2 rename to tests/models/bitv/optim-1.default.smt2 diff --git a/tests/models/bitv/optim-2.models.expected b/tests/models/bitv/optim-2.default.expected similarity index 100% rename from tests/models/bitv/optim-2.models.expected rename to tests/models/bitv/optim-2.default.expected diff --git a/tests/models/bitv/optim-2.models.smt2 b/tests/models/bitv/optim-2.default.smt2 similarity index 100% rename from tests/models/bitv/optim-2.models.smt2 rename to tests/models/bitv/optim-2.default.smt2 diff --git a/tests/models/bitv/optim-3.models.expected b/tests/models/bitv/optim-3.default.expected similarity index 100% rename from tests/models/bitv/optim-3.models.expected rename to tests/models/bitv/optim-3.default.expected diff --git a/tests/models/bitv/optim-3.models.smt2 b/tests/models/bitv/optim-3.default.smt2 similarity index 100% rename from tests/models/bitv/optim-3.models.smt2 rename to tests/models/bitv/optim-3.default.smt2 diff --git a/tests/models/bitv/optim-4.models.expected b/tests/models/bitv/optim-4.default.expected similarity index 100% rename from tests/models/bitv/optim-4.models.expected rename to tests/models/bitv/optim-4.default.expected diff --git a/tests/models/bitv/optim-4.models.smt2 b/tests/models/bitv/optim-4.default.smt2 similarity index 100% rename from tests/models/bitv/optim-4.models.smt2 rename to tests/models/bitv/optim-4.default.smt2 diff --git a/tests/models/bitv/optim-5.models.expected b/tests/models/bitv/optim-5.default.expected similarity index 100% rename from tests/models/bitv/optim-5.models.expected rename to tests/models/bitv/optim-5.default.expected diff --git a/tests/models/bitv/optim-5.models.smt2 b/tests/models/bitv/optim-5.default.smt2 similarity index 100% rename from tests/models/bitv/optim-5.models.smt2 rename to tests/models/bitv/optim-5.default.smt2 diff --git a/tests/models/bitv/specified.models.expected b/tests/models/bitv/specified.default.expected similarity index 100% rename from tests/models/bitv/specified.models.expected rename to tests/models/bitv/specified.default.expected diff --git a/tests/models/bitv/specified.models.smt2 b/tests/models/bitv/specified.default.smt2 similarity index 100% rename from tests/models/bitv/specified.models.smt2 rename to tests/models/bitv/specified.default.smt2 diff --git a/tests/models/bool/bool1.models.expected b/tests/models/bool/bool1.default.expected similarity index 100% rename from tests/models/bool/bool1.models.expected rename to tests/models/bool/bool1.default.expected diff --git a/tests/models/bool/bool1.models.smt2 b/tests/models/bool/bool1.default.smt2 similarity index 100% rename from tests/models/bool/bool1.models.smt2 rename to tests/models/bool/bool1.default.smt2 diff --git a/tests/models/bool/bool2.models.expected b/tests/models/bool/bool2.default.expected similarity index 100% rename from tests/models/bool/bool2.models.expected rename to tests/models/bool/bool2.default.expected diff --git a/tests/models/bool/bool2.models.smt2 b/tests/models/bool/bool2.default.smt2 similarity index 100% rename from tests/models/bool/bool2.models.smt2 rename to tests/models/bool/bool2.default.smt2 diff --git a/tests/models/bool/bool3.models.expected b/tests/models/bool/bool3.default.expected similarity index 100% rename from tests/models/bool/bool3.models.expected rename to tests/models/bool/bool3.default.expected diff --git a/tests/models/bool/bool3.models.smt2 b/tests/models/bool/bool3.default.smt2 similarity index 100% rename from tests/models/bool/bool3.models.smt2 rename to tests/models/bool/bool3.default.smt2 diff --git a/tests/models/check_sat.models.ae b/tests/models/check_sat.default.ae similarity index 100% rename from tests/models/check_sat.models.ae rename to tests/models/check_sat.default.ae diff --git a/tests/models/check_sat.models.expected b/tests/models/check_sat.default.expected similarity index 100% rename from tests/models/check_sat.models.expected rename to tests/models/check_sat.default.expected diff --git a/tests/models/complete_1.models.expected b/tests/models/complete_1.default.expected similarity index 100% rename from tests/models/complete_1.models.expected rename to tests/models/complete_1.default.expected diff --git a/tests/models/complete_1.models.smt2 b/tests/models/complete_1.default.smt2 similarity index 100% rename from tests/models/complete_1.models.smt2 rename to tests/models/complete_1.default.smt2 diff --git a/tests/models/complete_2.models.expected b/tests/models/complete_2.default.expected similarity index 100% rename from tests/models/complete_2.models.expected rename to tests/models/complete_2.default.expected diff --git a/tests/models/complete_2.models.smt2 b/tests/models/complete_2.default.smt2 similarity index 100% rename from tests/models/complete_2.models.smt2 rename to tests/models/complete_2.default.smt2 diff --git a/tests/models/complete_3.models.expected b/tests/models/complete_3.default.expected similarity index 100% rename from tests/models/complete_3.models.expected rename to tests/models/complete_3.default.expected diff --git a/tests/models/complete_3.models.smt2 b/tests/models/complete_3.default.smt2 similarity index 100% rename from tests/models/complete_3.models.smt2 rename to tests/models/complete_3.default.smt2 diff --git a/tests/models/issues/715/715_1.models.ae b/tests/models/issues/715/715_1.default.ae similarity index 100% rename from tests/models/issues/715/715_1.models.ae rename to tests/models/issues/715/715_1.default.ae diff --git a/tests/issues/649/649.dolmen.expected b/tests/models/issues/715/715_1.default.expected similarity index 100% rename from tests/issues/649/649.dolmen.expected rename to tests/models/issues/715/715_1.default.expected diff --git a/tests/models/issues/715/715_2.models.expected b/tests/models/issues/715/715_2.default.expected similarity index 100% rename from tests/models/issues/715/715_2.models.expected rename to tests/models/issues/715/715_2.default.expected diff --git a/tests/models/issues/715/715_2.models.smt2 b/tests/models/issues/715/715_2.default.smt2 similarity index 100% rename from tests/models/issues/715/715_2.models.smt2 rename to tests/models/issues/715/715_2.default.smt2 diff --git a/tests/models/issues/719.models.err.expected b/tests/models/issues/719.default.err.expected similarity index 100% rename from tests/models/issues/719.models.err.expected rename to tests/models/issues/719.default.err.expected diff --git a/tests/models/issues/719.models.err.smt2 b/tests/models/issues/719.default.err.smt2 similarity index 100% rename from tests/models/issues/719.models.err.smt2 rename to tests/models/issues/719.default.err.smt2 diff --git a/tests/models/records/record1.models.expected b/tests/models/records/record1.default.expected similarity index 100% rename from tests/models/records/record1.models.expected rename to tests/models/records/record1.default.expected diff --git a/tests/models/records/record1.models.smt2 b/tests/models/records/record1.default.smt2 similarity index 100% rename from tests/models/records/record1.models.smt2 rename to tests/models/records/record1.default.smt2 diff --git a/tests/models/records/record2.models.expected b/tests/models/records/record2.default.expected similarity index 100% rename from tests/models/records/record2.models.expected rename to tests/models/records/record2.default.expected diff --git a/tests/models/records/record2.models.smt2 b/tests/models/records/record2.default.smt2 similarity index 100% rename from tests/models/records/record2.models.smt2 rename to tests/models/records/record2.default.smt2 diff --git a/tests/models/records/record3.models.expected b/tests/models/records/record3.default.expected similarity index 100% rename from tests/models/records/record3.models.expected rename to tests/models/records/record3.default.expected diff --git a/tests/models/records/record3.models.smt2 b/tests/models/records/record3.default.smt2 similarity index 100% rename from tests/models/records/record3.models.smt2 rename to tests/models/records/record3.default.smt2 diff --git a/tests/models/uf/uf1.models.expected b/tests/models/uf/uf1.default.expected similarity index 100% rename from tests/models/uf/uf1.models.expected rename to tests/models/uf/uf1.default.expected diff --git a/tests/models/uf/uf1.models.smt2 b/tests/models/uf/uf1.default.smt2 similarity index 100% rename from tests/models/uf/uf1.models.smt2 rename to tests/models/uf/uf1.default.smt2 diff --git a/tests/models/uf/uf2.models.expected b/tests/models/uf/uf2.default.expected similarity index 100% rename from tests/models/uf/uf2.models.expected rename to tests/models/uf/uf2.default.expected diff --git a/tests/models/uf/uf2.models.smt2 b/tests/models/uf/uf2.default.smt2 similarity index 100% rename from tests/models/uf/uf2.models.smt2 rename to tests/models/uf/uf2.default.smt2 diff --git a/tests/issues/664/664.dolmen.expected b/tests/quantifiers/testfile-trigger001.default.expected similarity index 100% rename from tests/issues/664/664.dolmen.expected rename to tests/quantifiers/testfile-trigger001.default.expected diff --git a/tests/quantifiers/testfile-trigger001.dolmen.smt2 b/tests/quantifiers/testfile-trigger001.default.smt2 similarity index 100% rename from tests/quantifiers/testfile-trigger001.dolmen.smt2 rename to tests/quantifiers/testfile-trigger001.default.smt2 diff --git a/tests/quantifiers/testfile-trigger002.dolmen.ae b/tests/quantifiers/testfile-trigger002.default.ae similarity index 100% rename from tests/quantifiers/testfile-trigger002.dolmen.ae rename to tests/quantifiers/testfile-trigger002.default.ae diff --git a/tests/models/issues/715/715_1.models.expected b/tests/quantifiers/testfile-trigger002.default.expected similarity index 100% rename from tests/models/issues/715/715_1.models.expected rename to tests/quantifiers/testfile-trigger002.default.expected diff --git a/tests/quantifiers/testfile-trigger002.dolmen.expected b/tests/quantifiers/testfile-trigger002.dolmen.expected deleted file mode 100644 index a6e005255c..0000000000 --- a/tests/quantifiers/testfile-trigger002.dolmen.expected +++ /dev/null @@ -1,2 +0,0 @@ - -unknown diff --git a/tests/quantifiers/testfile-trigger003.dolmen.expected b/tests/quantifiers/testfile-trigger003.expected similarity index 100% rename from tests/quantifiers/testfile-trigger003.dolmen.expected rename to tests/quantifiers/testfile-trigger003.expected diff --git a/tests/quantifiers/testfile-trigger003.dolmen.smt2 b/tests/quantifiers/testfile-trigger003.smt2 similarity index 100% rename from tests/quantifiers/testfile-trigger003.dolmen.smt2 rename to tests/quantifiers/testfile-trigger003.smt2 diff --git a/tests/quantifiers/testfile-trigger004.dolmen.ae b/tests/quantifiers/testfile-trigger004.ae similarity index 100% rename from tests/quantifiers/testfile-trigger004.dolmen.ae rename to tests/quantifiers/testfile-trigger004.ae diff --git a/tests/quantifiers/testfile-trigger004.dolmen.expected b/tests/quantifiers/testfile-trigger004.expected similarity index 100% rename from tests/quantifiers/testfile-trigger004.dolmen.expected rename to tests/quantifiers/testfile-trigger004.expected diff --git a/tests/smtlib/testfile-declare-datatype-incremental.dolmen.expected b/tests/smtlib/testfile-declare-datatype-incremental.default.expected similarity index 100% rename from tests/smtlib/testfile-declare-datatype-incremental.dolmen.expected rename to tests/smtlib/testfile-declare-datatype-incremental.default.expected diff --git a/tests/smtlib/testfile-declare-datatype-incremental.dolmen.smt2 b/tests/smtlib/testfile-declare-datatype-incremental.default.smt2 similarity index 100% rename from tests/smtlib/testfile-declare-datatype-incremental.dolmen.smt2 rename to tests/smtlib/testfile-declare-datatype-incremental.default.smt2 diff --git a/tests/smtlib/testfile-echo1.dolmen.expected b/tests/smtlib/testfile-echo1.expected similarity index 100% rename from tests/smtlib/testfile-echo1.dolmen.expected rename to tests/smtlib/testfile-echo1.expected diff --git a/tests/smtlib/testfile-echo1.dolmen.smt2 b/tests/smtlib/testfile-echo1.smt2 similarity index 100% rename from tests/smtlib/testfile-echo1.dolmen.smt2 rename to tests/smtlib/testfile-echo1.smt2 diff --git a/tests/smtlib/testfile-echo2.dolmen.expected b/tests/smtlib/testfile-echo2.expected similarity index 100% rename from tests/smtlib/testfile-echo2.dolmen.expected rename to tests/smtlib/testfile-echo2.expected diff --git a/tests/smtlib/testfile-echo2.dolmen.smt2 b/tests/smtlib/testfile-echo2.smt2 similarity index 100% rename from tests/smtlib/testfile-echo2.dolmen.smt2 rename to tests/smtlib/testfile-echo2.smt2 diff --git a/tests/smtlib/testfile-exit.dolmen.expected b/tests/smtlib/testfile-exit.dolmen.expected deleted file mode 100644 index a6e005255c..0000000000 --- a/tests/smtlib/testfile-exit.dolmen.expected +++ /dev/null @@ -1,2 +0,0 @@ - -unknown diff --git a/tests/smtlib/testfile-exit.dolmen.smt2 b/tests/smtlib/testfile-exit.dolmen.smt2 deleted file mode 100644 index 135ade6d3a..0000000000 --- a/tests/smtlib/testfile-exit.dolmen.smt2 +++ /dev/null @@ -1,4 +0,0 @@ -(set-logic ALL) -(check-sat) -(exit) -(check-sat) \ No newline at end of file diff --git a/tests/smtlib/testfile-get-assignment1.err.dolmen.expected b/tests/smtlib/testfile-get-assignment1.err.expected similarity index 100% rename from tests/smtlib/testfile-get-assignment1.err.dolmen.expected rename to tests/smtlib/testfile-get-assignment1.err.expected diff --git a/tests/smtlib/testfile-get-assignment1.err.dolmen.smt2 b/tests/smtlib/testfile-get-assignment1.err.smt2 similarity index 100% rename from tests/smtlib/testfile-get-assignment1.err.dolmen.smt2 rename to tests/smtlib/testfile-get-assignment1.err.smt2 diff --git a/tests/smtlib/testfile-get-assignment2.err.dolmen.expected b/tests/smtlib/testfile-get-assignment2.err.expected similarity index 100% rename from tests/smtlib/testfile-get-assignment2.err.dolmen.expected rename to tests/smtlib/testfile-get-assignment2.err.expected diff --git a/tests/smtlib/testfile-get-assignment2.err.dolmen.smt2 b/tests/smtlib/testfile-get-assignment2.err.smt2 similarity index 100% rename from tests/smtlib/testfile-get-assignment2.err.dolmen.smt2 rename to tests/smtlib/testfile-get-assignment2.err.smt2 diff --git a/tests/smtlib/testfile-get-assignment3.dolmen.expected b/tests/smtlib/testfile-get-assignment3.expected similarity index 100% rename from tests/smtlib/testfile-get-assignment3.dolmen.expected rename to tests/smtlib/testfile-get-assignment3.expected diff --git a/tests/smtlib/testfile-get-assignment3.dolmen.smt2 b/tests/smtlib/testfile-get-assignment3.smt2 similarity index 100% rename from tests/smtlib/testfile-get-assignment3.dolmen.smt2 rename to tests/smtlib/testfile-get-assignment3.smt2 diff --git a/tests/smtlib/testfile-get-info1.dolmen.expected b/tests/smtlib/testfile-get-info1.default.expected similarity index 100% rename from tests/smtlib/testfile-get-info1.dolmen.expected rename to tests/smtlib/testfile-get-info1.default.expected diff --git a/tests/smtlib/testfile-get-info1.dolmen.smt2 b/tests/smtlib/testfile-get-info1.default.smt2 similarity index 100% rename from tests/smtlib/testfile-get-info1.dolmen.smt2 rename to tests/smtlib/testfile-get-info1.default.smt2 diff --git a/tests/smtlib/testfile-get-info2.err.dolmen.expected b/tests/smtlib/testfile-get-info2.err.expected similarity index 100% rename from tests/smtlib/testfile-get-info2.err.dolmen.expected rename to tests/smtlib/testfile-get-info2.err.expected diff --git a/tests/smtlib/testfile-get-info2.err.dolmen.smt2 b/tests/smtlib/testfile-get-info2.err.smt2 similarity index 100% rename from tests/smtlib/testfile-get-info2.err.dolmen.smt2 rename to tests/smtlib/testfile-get-info2.err.smt2 diff --git a/tests/smtlib/testfile-get-info3.dolmen.expected b/tests/smtlib/testfile-get-info3.expected similarity index 100% rename from tests/smtlib/testfile-get-info3.dolmen.expected rename to tests/smtlib/testfile-get-info3.expected diff --git a/tests/smtlib/testfile-get-info3.dolmen.smt2 b/tests/smtlib/testfile-get-info3.smt2 similarity index 100% rename from tests/smtlib/testfile-get-info3.dolmen.smt2 rename to tests/smtlib/testfile-get-info3.smt2 diff --git a/tests/smtlib/testfile-push-pop1.err.dolmen.expected b/tests/smtlib/testfile-push-pop1.err.default.expected similarity index 100% rename from tests/smtlib/testfile-push-pop1.err.dolmen.expected rename to tests/smtlib/testfile-push-pop1.err.default.expected diff --git a/tests/smtlib/testfile-push-pop1.err.dolmen.smt2 b/tests/smtlib/testfile-push-pop1.err.default.smt2 similarity index 100% rename from tests/smtlib/testfile-push-pop1.err.dolmen.smt2 rename to tests/smtlib/testfile-push-pop1.err.default.smt2 diff --git a/tests/quantifiers/testfile-trigger001.dolmen.expected b/tests/smtlib/testfile-push-pop2.default.expected similarity index 100% rename from tests/quantifiers/testfile-trigger001.dolmen.expected rename to tests/smtlib/testfile-push-pop2.default.expected diff --git a/tests/smtlib/testfile-push-pop2.dolmen.smt2 b/tests/smtlib/testfile-push-pop2.default.smt2 similarity index 100% rename from tests/smtlib/testfile-push-pop2.dolmen.smt2 rename to tests/smtlib/testfile-push-pop2.default.smt2 diff --git a/tests/smtlib/testfile-push-pop2.dolmen.expected b/tests/smtlib/testfile-push-pop2.dolmen.expected deleted file mode 100644 index a6e005255c..0000000000 --- a/tests/smtlib/testfile-push-pop2.dolmen.expected +++ /dev/null @@ -1,2 +0,0 @@ - -unknown diff --git a/tests/smtlib/testfile-quoted1.dolmen.expected b/tests/smtlib/testfile-quoted1.expected similarity index 100% rename from tests/smtlib/testfile-quoted1.dolmen.expected rename to tests/smtlib/testfile-quoted1.expected diff --git a/tests/smtlib/testfile-quoted1.dolmen.smt2 b/tests/smtlib/testfile-quoted1.smt2 similarity index 100% rename from tests/smtlib/testfile-quoted1.dolmen.smt2 rename to tests/smtlib/testfile-quoted1.smt2 diff --git a/tests/smtlib/testfile-reset.dolmen.expected b/tests/smtlib/testfile-reset.dolmen.expected deleted file mode 100644 index 76a9b3e2dd..0000000000 --- a/tests/smtlib/testfile-reset.dolmen.expected +++ /dev/null @@ -1,4 +0,0 @@ - -unsat - -unknown diff --git a/tests/smtlib/testfile-reset.dolmen.smt2 b/tests/smtlib/testfile-reset.dolmen.smt2 deleted file mode 100644 index 101715c147..0000000000 --- a/tests/smtlib/testfile-reset.dolmen.smt2 +++ /dev/null @@ -1,8 +0,0 @@ -(set-logic ALL) - -(declare-const b Bool) - -(assert (and b (not b))) -(check-sat) -(reset) -(check-sat) \ No newline at end of file diff --git a/tests/smtlib/testfile-steps-bound1.dolmen.err.expected b/tests/smtlib/testfile-steps-bound1.err.expected similarity index 100% rename from tests/smtlib/testfile-steps-bound1.dolmen.err.expected rename to tests/smtlib/testfile-steps-bound1.err.expected diff --git a/tests/smtlib/testfile-steps-bound1.dolmen.err.smt2 b/tests/smtlib/testfile-steps-bound1.err.smt2 similarity index 100% rename from tests/smtlib/testfile-steps-bound1.dolmen.err.smt2 rename to tests/smtlib/testfile-steps-bound1.err.smt2 diff --git a/tests/smtlib/testfile-steps-bound2.dolmen.expected b/tests/smtlib/testfile-steps-bound2.default.expected similarity index 100% rename from tests/smtlib/testfile-steps-bound2.dolmen.expected rename to tests/smtlib/testfile-steps-bound2.default.expected diff --git a/tests/smtlib/testfile-steps-bound2.dolmen.smt2 b/tests/smtlib/testfile-steps-bound2.default.smt2 similarity index 100% rename from tests/smtlib/testfile-steps-bound2.dolmen.smt2 rename to tests/smtlib/testfile-steps-bound2.default.smt2 diff --git a/tools/gentest.ml b/tools/gentest.ml index 2e9c3e86b9..b6e20987a1 100644 --- a/tools/gentest.ml +++ b/tools/gentest.ml @@ -170,10 +170,9 @@ end = struct Format.fprintf fmt "%s" filename let pp_output fmt tst = - let filename = Filename.chop_extension tst.pb_file in - let name = Cmd.name tst.cmd in - let basename = Format.asprintf "%s_%s.output" filename name in - Format.fprintf fmt "%s" ((tst.path // basename) |> mangle_path) + Format.fprintf fmt "%s_%s.output" + (tst.path // tst.pb_file |> mangle_path) + (Cmd.name tst.cmd) let pp_expected_output fmt tst = let filename = @@ -263,21 +262,8 @@ end = struct {acc with accepted_exit_codes = [1]} | "timeout" -> {acc with accepted_exit_codes = [142]} - | "dolmen" -> { - acc with - exclude = "legacy" :: acc.exclude; - filters = Some ["dolmen"] - } - | "smt2" -> { - acc with - exclude = "legacy" :: acc.exclude; - } - | "models" -> { - acc with - exclude = - "legacy" :: acc.exclude; - filters = Some ["dolmen"] - } + | "default" -> + {acc with filters = Some ["default"]} | _ -> acc ) Test.base_params @@ -365,57 +351,43 @@ let () = ] in let solvers = [ - ("runtest-quick", "dolmen", - [ "--output=smtlib2" - ; "--frontend dolmen" ]) - ; ("runtest-quick", "legacy", - [ "--output=smtlib2" - ; "--frontend legacy" - ]) + ("runtest-quick", "default", + [ "--output=smtlib2"]) ; ("runtest-quick", "tableaux", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver Tableaux" ]) ; ("runtest-quick", "tableaux_cdcl", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver Tableaux-CDCL" ]) ; ("runtest-quick", "cdcl", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL" ]) ; ("runtest-ci", "ci_tableaux_cdcl_no_minimal_bj", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL-Tableaux" ; "--no-minimal-bj" ]) ; ("runtest-ci", "ci_cdcl_tableaux_no_tableaux_cdcl_in_theories", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL-Tableaux" ; "--no-tableaux-cdcl-in-theories" ]) ; ("runtest-ci", "ci_no_tableaux_cdcl_in_instantiation", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL-Tableaux" ; "--no-tableaux-cdcl-in-instantiation" ]) ; ("runtest-ci", "ci_cdcl_tableaux_no_tableaux_cdcl_in_theories_and_instantiation", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL-Tableaux" ; "--no-tableaux-cdcl-in-theories" ; "--no-tableaux-cdcl-in-instantiation" ]) ; ("runtest-ci", "ci_cdcl_tableaux_no_minimal_bj_no_tableaux_cdcl_in_theories\ _and_instantiation", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL-Tableaux" ; "--no-minimal-bj" ; "--no-tableaux-cdcl-in-theories" ; "--no-tableaux-cdcl-in-instantiation" ]) ; ("runtest-ci", "ci_cdcl_no_minimal_bj", [ "--output=smtlib2" - ; "--frontend dolmen" ; "--sat-solver CDCL" ; "--no-minimal-bj" ])] in