Skip to content

GitLab

why3
why3
Commit 9ea5cab3 authored by MARCHE Claude's avatar MARCHE Claude
Browse files
Options

new files for distrib

parent 33503e93
Show whitespace changes
Inline Side-by-side
Showing with 48 additions and 2721 deletions
INSTALL 0 → 100644
View file @ 9ea5cab3
Installation instructions
Shortly, installation is done by
./configure
make
make install (as root)
To install also the Ocaml library do
make byte
make install-lib (as root)
For detailed instructions and required dependencies, please see
the manual (doc/manual.pdf), Chapter 7.
\ No newline at end of file
Makefile.in
View file @ 9ea5cab3
......@@ -229,8 +229,6 @@ install_no_local::
mkdir -p $(DATADIR)/why3/theories
mkdir -p $(DATADIR)/why3/theories/transform
mkdir -p $(DATADIR)/why3/drivers
mkdir -p $(OCAMLLIB)/why3
cp -f src/why.cmi src/why.cma src/why.cmxa $(OCAMLLIB)/why3
cp -f theories/*.why $(DATADIR)/why3/theories
cp -f theories/transform/*.why $(DATADIR)/why3/theories/transform
cp -f drivers/*.drv $(DATADIR)/why3/drivers
......@@ -239,14 +237,22 @@ install_no_local::
cp -f share/emacs/why.el $(DATADIR)/why3/emacs/why.el
cp -f share/lang/why.lang $(DATADIR)/why3/lang/why.lang
install_no_local_lib::
mkdir -p $(OCAMLLIB)/why3
cp -f src/why.cm* $(OCAMLLIB)/why3
if test -f src/why.a; then cp -f src/why.a $(OCAMLLIB)/why3; fi
ifeq ("@ENABLE_LOCAL@","no")
install: install_no_local
install-lib: install_no_local_lib
else
install:
install install-lib:
@echo "You use a local configuration you can't install with it."
@echo "Run ./configure without --enable-local"
endif
install-all: install install-lib
##################
# Why binary
......@@ -740,74 +746,6 @@ clean::
rm -f $(PLUGGENERATED)
rm -f .depend.plug
## install: install-binary install-lib install-man
##
## BINARYFILES = $(BINARY) bin/whyide.$(OCAMLBEST)
##
## # install-binary should not depend on $(BINARYFILES); otherwise it
## # enforces the compilation of whyide, even when lablgtk2 is not installed
## install-binary:
## mkdir -p $(BINDIR)
## cp -f $(BINARY) $(BINDIR)/why$(EXE)
## if test -f bin/whyide.$(OCAMLBEST); then \
## cp -f bin/whyide.$(OCAMLBEST) $(BINDIR)/whyide-bin$(EXE); \
## fi
##
## install-lib:
## mkdir -p $(LIBDIR)/why/why
##
## install-man:
## mkdir -p $(MANDIR)/man1
## cp -f doc/*.1 $(MANDIR)/man1
##
## install-coq-no:
## install-coq-yes: install-coq-@COQVER@
## install-coq-v7:
## mkdir -p $(LIBDIR)/why/coq7
## cp -f $(V7FILES) $(LIBDIR)/why/coq7
## cp -f $(VO7) $(LIBDIR)/why/coq7
## install-coq-v8 install-coq-v8.1:
## if test -w $(COQLIB) ; then \
## mkdir -p $(COQLIB)/user-contrib ; \
## cp -f $(V8FILES) $(COQLIB)/user-contrib ; \
## cp -f $(VO8) $(COQLIB)/user-contrib ; \
## else \
## echo "Cannot copy to Coq standard library. Add $(LIBDIR)/why/coq to Coq include path." ;\
## mkdir -p $(LIBDIR)/why/coq ;\
## cp -f $(VO8) $(V8FILES) $(LIBDIR)/why/coq ;\
## fi
##
## install-pvs-no:
## install-pvs-yes: $(PVSFILES)
## mkdir -p $(PVSLIB)/why
## cp $(PVSFILES) $(PVSFILES:.pvs=.prf) $(PVSLIB)/why
## cp lib/pvs/top.pvs lib/pvs/pvscontext.el $(PVSLIB)/why
## @echo "====== Compiling PVS theories, this may take some time ======"
## (cd $(PVSLIB)/why ; @PVSC@ -batch -l pvscontext.el -q -v 2 > top.out)
## @echo "====== Done compiling PVS theories ======"
##
## install-mizar-no:
## install-mizar-yes:
## mkdir -p @MIZARLIB@/mml/dict
## cp lib/mizar/why.miz @MIZARLIB@/mml
## cp lib/mizar/dict/why.voc @MIZARLIB@/mml/dict
##
## local-install: $(BINARY) $(WHYCONFIG) $(JESSIE) bin/whyide.$(OCAMLBEST) byte bin/whyide.byte
## cp $(BINARY) $$HOME/bin/why
## cp $(WHYCONFIG) $$HOME/bin/why
## cp $(JESSIE) $$HOME/bin/jessie
## if test -f bin/whyide.$(OCAMLBEST); then \
## cp -f bin/whyide.$(OCAMLBEST) $$HOME/bin/whyide; \
## fi
##
## local: install
##
## win: why.nsi
## "/cygdrive/c/Program Files (x86)/NSIS/makensis" /DVERSION=$(VERSION) why.nsi
##
## zip:
## zip -A -r why-$(VERSION).zip c:/why/bin c:/why/lib c:/coq/lib/contrib/why c:/coq/lib/contrib7/why
################
# documentation
################
......
OCAML-LICENSE 0 → 100644
View file @ 9ea5cab3
TODO: Andrei
\ No newline at end of file
README
View file @ 9ea5cab3
......@@ -4,6 +4,11 @@ Why3 is a tool for automated and interactive proving in first-order
polymorphic logic. It provides a collection of command-line tools, a
graphical interface and an Objective Caml library.
PROJECT HOME
============
https://gforge.inria.fr/projects/why3
DOCUMENTATION
=============
......@@ -32,4 +37,4 @@ xx (see file OCAML-LICENSE).
INSTALLATION
============
See the enclosed file INSTALL.
See the file INSTALL.
ROADMAP
View file @ 9ea5cab3
......@@ -4,7 +4,7 @@
== Documentation ==
* API: Andrei + Francois
* tools: WhyML (JC), IDE (Claude)
* tools: IDE (Claude)
* semantics:
* tutorial for API:
** build a task
......@@ -22,11 +22,17 @@
== Misc ==
* README (done)
* INSTALL (done)
* LICENSE (done)
* OCAML-LICENSE (TODO: Andrei)
* Builtin arrays in provers (Francois)
(done) make install
(done) debug "make -j"
* META for ocamlfind
* headers
* make install (done)
* make export (TODO: JCF)
* "make -j" (done)
* META for ocamlfind (TODO: ?)
* headers (TODO: ?)
......@@ -34,6 +40,7 @@
= Roadmap for 2011 =
* WhyML (JC)
* Jessie3
* traceability
* Coq plugin
......
doc/manual.tex
View file @ 9ea5cab3
......@@ -82,7 +82,7 @@ We gratefully thank all the people who contributed to this document:
\input{library.tex}
\input{whyml.tex}
% \input{whyml.tex}
\input{api.tex}
......
src/manager/db.ml deleted 100644 → 0
View file @ 33503e93
(**************************************************************************)
(* *)
(* Copyright (C) 2010- *)
(* Francois Bobot *)
(* Jean-Christophe Filliatre *)
(* Johannes Kanig *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software 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. *)
(* *)
(**************************************************************************)
open Why
open Sqlite3
type transaction_mode = | Deferred | Immediate | Exclusive
type handle = {
raw_db : Sqlite3.db;
mutable in_transaction: int;
busyfn: Sqlite3.db -> unit;
mode: transaction_mode;
}
let current_db = ref None
let current () =
match !current_db with
| None -> failwith "Db.current: database not yet initialized"
| Some x -> x
let default_busyfn (_db:Sqlite3.db) =
prerr_endline "Db.default_busyfn WARNING: busy";
(* Thread.delay (Random.float 1.) *)
ignore (Unix.select [] [] [] (Random.float 1.))
let raise_sql_error x = raise (Sqlite3.Error (Rc.to_string x))
(*
let try_finally fn finalfn =
try
let r = fn () in
finalfn ();
r
with e -> begin
prerr_string "Db.try_finally WARNING: exception: ";
prerr_endline (Printexc.to_string e);
prerr_endline "== exception backtrace ==";
Printexc.print_backtrace stderr;
prerr_endline "== end of backtrace ==";
finalfn ();
raise e
end
*)
(* retry until a non-BUSY error code is returned *)
let rec db_busy_retry db fn =
match fn () with
| Rc.BUSY ->
(*
prerr_endline "Db.db_busy_retry: BUSY";
*)
db.busyfn db.raw_db; db_busy_retry db fn
| x ->
(*
prerr_string "Db.db_busy_retry: ";
prerr_endline (Rc.to_string x);
*)
x
(* make sure an OK is returned from the database *)
let db_must_ok db fn =
match db_busy_retry db fn with
| Rc.OK -> ()
| x -> raise_sql_error x
(* make sure a DONE is returned from the database *)
let db_must_done db fn =
match db_busy_retry db fn with
| Rc.DONE -> ()
| x -> raise_sql_error x
(* request a transaction *)
let transaction db fn =
let m = match db.mode with
| Deferred -> "DEFERRED"
| Immediate -> "IMMEDIATE"
| Exclusive -> "EXCLUSIVE"
in
try
db_must_ok db
(fun () -> exec db.raw_db ("BEGIN " ^ m ^ " TRANSACTION"));
assert (db.in_transaction = 0);
db.in_transaction <- 1;
let res = fn () in
db_must_ok db (fun () -> exec db.raw_db "END TRANSACTION");
assert (db.in_transaction = 1);
db.in_transaction <- 0;
res
with
e ->
prerr_string "Db.transaction WARNING: exception: ";
prerr_endline (Printexc.to_string e);
prerr_endline "== exception backtrace ==";
Printexc.print_backtrace stderr;
prerr_endline "== end of backtrace ==";
db_must_ok db (fun () -> exec db.raw_db "END TRANSACTION");
assert (db.in_transaction = 1);
db.in_transaction <- 0;
raise e
(* iterate over a result set *)
let step_fold db stmt iterfn =
let stepfn () = Sqlite3.step stmt in
let rec fn a = match db_busy_retry db stepfn with
| Sqlite3.Rc.ROW -> fn (iterfn stmt :: a)
| Sqlite3.Rc.DONE -> a
| x -> raise_sql_error x
in
fn []
(* DB/SQL helpers *)
let bind db sql l =
let stmt = Sqlite3.prepare db.raw_db sql in
let _ =
List.fold_left
(fun i v -> db_must_ok db (fun () -> Sqlite3.bind stmt i v); succ i)
1 l
in stmt
let stmt_column_INT stmt i msg =
match Sqlite3.column stmt i with
| Sqlite3.Data.INT i -> i
| _ -> failwith msg
let stmt_column_FLOAT stmt i msg =
match Sqlite3.column stmt i with
| Sqlite3.Data.FLOAT i -> i
| _ -> failwith msg
let stmt_column_TEXT stmt i msg =
match Sqlite3.column stmt i with
| Sqlite3.Data.TEXT i -> i
| _ -> failwith msg
let stmt_column_int stmt i msg =
match Sqlite3.column stmt i with
| Sqlite3.Data.INT i -> Int64.to_int i
| _ -> failwith msg
let int64_from_bool b =
if b then 1L else 0L
let bool_from_int64 i =
if i=0L then false else
if i=1L then true else
failwith "Db.bool_from_int64"
let stmt_column_bool stmt i msg =
match Sqlite3.column stmt i with
| Sqlite3.Data.INT i -> bool_from_int64 i
| _ -> failwith msg
(** Data *)
type db_ident = int64
type loc_record =
{ mutable loc_id : db_ident option;
(** when None, the record has never been stored in database yet *)
mutable file : string;
mutable line : int;
mutable start : int;
mutable stop : int;
}
type proof_attempt_status =
| Scheduled (** external proof attempt is scheduled *)
| Running (** external proof attempt is in progress *)
| Success (** external proof attempt succeeded *)
| Timeout (** external proof attempt was interrupted *)
| Unknown (** external prover answered ``don't know'' or equivalent *)
| HighFailure (** external prover call failed *)
let string_of_status = function
| Scheduled -> "Scheduled"
| Running -> "Running"
| Success -> "Success"
| Timeout -> "Timeout"
| Unknown -> "Unknown"
| HighFailure -> "HighFailure"
let print_status fmt s = Format.fprintf fmt "%s" (string_of_status s)
type prover =
{ prover_id : db_ident;
prover_name : string;
(*
prover_short : string;
prover_long : string;
prover_command : string;
prover_driver_checksum : string;
*)
}
let prover_name p = p.prover_name
type external_proof = {
mutable external_proof_id : db_ident;
mutable prover : db_ident;
mutable timelimit : int;
mutable memlimit : int;
mutable status : proof_attempt_status;
mutable result_time : float;
mutable trace : string;
mutable proof_obsolete : bool;
}
let timelimit e = e.timelimit
let memlimit e = e.memlimit
let status e = e.status
let result_time e = e.result_time
let trace e = e.trace
let proof_obsolete e = e.proof_obsolete
type goal_origin =
| Goal of string * string
(*
| VCfun of loc * explain * ...
| Subgoal of goal
*)
type transf_data =
{ transf_name : string;
transf_action : Task.task Trans.tlist
}
type goal = {
mutable goal_id : db_ident;
mutable goal_origin : goal_origin;
mutable task : Task.task;
mutable task_checksum: string;
mutable proved : bool;
(** invariant: g.proved == true iff
exists attempts a in g.attempts, a.obsolete == false and
(a = External e and e.result == Valid or
a = Transf(gl) and forall g in gl, g.proved)
*)
mutable observers: (bool -> unit) list;
(** observers that wants to be notified by any changes of the proved status *)
(*
mutable external_proofs : external_proof list;
mutable transformations : transf list;
*)
}
and transf = {
mutable transf_id : db_ident;
mutable transf_data : transf_data;
mutable transf_obsolete : bool;
mutable subgoals : goal list;
}
let goal_task g = g.task
let goal_task_checksum g = g.task_checksum
let goal_proved g = g.proved
let transf_data t = t.transf_data
let transf_obsolete t = t.transf_obsolete
let subgoals t = t.subgoals
let rec string_from_origin o =
match o with
| Goal(t,n) -> t ^ "." ^ n
let goal_name g = string_from_origin g.goal_origin
module Driver = struct
let init db =
let sql =
"CREATE TABLE IF NOT EXISTS prover \
(prover_id INTEGER PRIMARY KEY AUTOINCREMENT,prover_name TEXT);"
in
db_must_ok db (fun () -> Sqlite3.exec db.raw_db sql);
let sql =
"CREATE UNIQUE INDEX IF NOT EXISTS prover_name_idx \
ON prover (prover_name)"
in
db_must_ok db (fun () -> Sqlite3.exec db.raw_db sql)
(*
let delete db pr =
let id = pr.prover_id in
let sql = "DELETE FROM prover WHERE id=?" in
let stmt = Sqlite3.prepare db.raw_db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore (step_fold db stmt (fun _ -> ()));
pr.prover_id <- 0L
*)
let add db name =
transaction db
(fun () ->
let sql = "INSERT INTO prover VALUES(NULL,?)" in
let stmt = bind db sql [ Sqlite3.Data.TEXT name ] in
db_must_done db (fun () -> Sqlite3.step stmt);
let new_id = Sqlite3.last_insert_rowid db.raw_db in
{ prover_id = new_id ; prover_name = name })
let get db name =
let sql =
"SELECT prover.prover_id, prover.prover_name FROM prover \
WHERE prover.prover_name=?"
in
let stmt = bind db sql [Sqlite3.Data.TEXT name] in
(* convert statement into record *)
let of_stmt stmt =
{ prover_id =
(match Sqlite3.column stmt 0 with
| Sqlite3.Data.INT i -> i
| x ->
try Int64.of_string (Sqlite3.Data.to_string x)
with _ -> failwith "Db.Driver.get") ;
prover_name =
(match Sqlite3.column stmt 1 with
| x -> Sqlite3.Data.to_string x)
}
in
(* execute the SQL query *)
match step_fold db stmt of_stmt with
| [] -> raise Not_found
| [x] -> x
| _ -> assert false
let from_id db id =
let sql =
"SELECT prover.prover_id, prover.prover_name FROM prover \
WHERE prover.prover_id=?"
in
let stmt = bind db sql [Sqlite3.Data.INT id] in
(* convert statement into record *)
let of_stmt stmt =
{ prover_id = id ;
prover_name = stmt_column_TEXT stmt 1
"Driver.from_id: bad prover_name";
}
in
(* execute the SQL query *)
match step_fold db stmt of_stmt with
| [] -> raise Not_found
| [x] -> x
| _ -> assert false
end
let prover_memo = Hashtbl.create 7
let get_prover_from_id id =
try
Hashtbl.find prover_memo id
with Not_found ->
let p =
let db = current () in
try Driver.from_id db id
with Not_found -> assert false
in
Hashtbl.add prover_memo id p;
p
let prover e = get_prover_from_id e.prover
let get_prover name (* ~short ~long ~command ~driver *) =
let db = current () in
(*
let checksum = Digest.file driver in
*)
try Driver.get db name (* ~short ~long ~command ~checksum *)
with Not_found ->
Driver.add db name (* ~short ~long ~command ~checksum *)
module Loc = struct
let init db =
let sql =
"CREATE TABLE IF NOT EXISTS loc \
(id INTEGER PRIMARY KEY AUTOINCREMENT,file TEXT,line INTEGER,\
start INTEGER,stop INTEGER);"
in
db_must_ok db (fun () -> Sqlite3.exec db.raw_db sql)
(* admin functions *)
let delete db loc =
match loc.loc_id with
| None -> ()
| Some id ->
let sql = "DELETE FROM loc WHERE id=?" in
let stmt = bind db sql [Sqlite3.Data.INT id] in
ignore (step_fold db stmt (fun _ -> ()));
loc.loc_id <- None
let save db (loc : loc_record) =
transaction db
(fun () ->
(* insert any foreign-one fields into their table and get id *)
let curobj_id = match loc.loc_id with
| None ->
(* insert new record *)
let sql = "INSERT INTO loc VALUES(NULL,?,?,?,?)" in
let stmt = bind db sql [
Sqlite3.Data.TEXT loc.file ;
Sqlite3.Data.INT (Int64.of_int loc.line);
Sqlite3.Data.INT (Int64.of_int loc.start);
Sqlite3.Data.INT (Int64.of_int loc.stop);
]
in
db_must_done db (fun () -> Sqlite3.step stmt);
let new_id = Sqlite3.last_insert_rowid db.raw_db in
loc.loc_id <- Some new_id;
new_id
| Some id ->
(* update *)
let sql =
"UPDATE loc SET file=?,line=?,start=?,stop=? WHERE id=?"
in
let stmt = bind db sql [
Sqlite3.Data.TEXT loc.file ;
Sqlite3.Data.INT (Int64.of_int loc.line);
Sqlite3.Data.INT (Int64.of_int loc.start);
Sqlite3.Data.INT (Int64.of_int loc.stop);
Sqlite3.Data.INT id;
]
in
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
curobj_id)
(* General get function for any of the columns *)
let get ?id ?file ?line ?start ?stop ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in