Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
126
Issues
126
List
Boards
Labels
Service Desk
Milestones
Merge Requests
16
Merge Requests
16
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
d813b7f2
Commit
d813b7f2
authored
Mar 22, 2010
by
Francois Bobot
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
smt printer smt.ml "smtv1"
parent
2f080442
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
344 additions
and
9 deletions
+344
-9
Makefile.in
Makefile.in
+1
-1
lib/drivers/cvc3.drv
lib/drivers/cvc3.drv
+73
-0
src/core/ident.ml
src/core/ident.ml
+6
-0
src/core/ident.mli
src/core/ident.mli
+3
-0
src/driver/call_provers.ml
src/driver/call_provers.ml
+12
-6
src/printer/alt_ergo.ml
src/printer/alt_ergo.ml
+4
-2
src/printer/smt.ml
src/printer/smt.ml
+227
-0
src/printer/smt.mli
src/printer/smt.mli
+18
-0
No files found.
Makefile.in
View file @
d813b7f2
...
...
@@ -136,7 +136,7 @@ DRIVER_CMO := call_provers.cmo dynlink_compat.cmo driver_parser.cmo\
driver_lexer.cmo driver.cmo
DRIVER_CMO
:=
$(
addprefix
src/driver/,
$(DRIVER_CMO)
)
PRINTER_CMO
:=
print_real.cmo alt_ergo.cmo why3.cmo
PRINTER_CMO
:=
print_real.cmo alt_ergo.cmo why3.cmo
smt.cmo
PRINTER_CMO
:=
$(
addprefix
src/printer/,
$(PRINTER_CMO)
)
CMO
=
$(UTIL_CMO)
$(CORE_CMO)
$(PARSER_CMO)
$(DRIVER_CMO)
\
...
...
lib/drivers/cvc3.drv
0 → 100644
View file @
d813b7f2
(* Why driver for SMT syntax *)
prelude "(* this is a prelude for smtlib*)"
printer "smtv1"
filename "%f-%t-%s.smt"
call_on_stdin "cvc3 -lang smt"
valid "unsat"
unknown "\\bunknown\\b\\|\\bsat\\b" "Unknown"
(* À discuter *)
transformations
"simplify_recursive_definition"
(*"split_goal_pos"*) "split_goal_pos_neg"
"inline_trivial"
"remove_logic_definition"
"encoding_decorate"
end
theory BuiltIn
syntax type int "Int"
syntax type real "Real"
syntax logic (_=_) "(= %1 %2)"
syntax logic (_<>_) "(not (= %1 %2))"
end
theory prelude.Int
prelude "(* this is a prelude for Alt-Ergo arithmetic *)"
syntax logic zero "0"
syntax logic (_+_) "(+ %1 %2)"
syntax logic (_-_) "(- %1 %2)"
syntax logic (_*_) "(* %1 %2)"
syntax logic (_/_) "(div_int %1 %2)"
syntax logic (-_) "(-%1)"
syntax logic (_<=_) "(<= %1 %2)"
syntax logic (_< _) "(< %1 %2)"
syntax logic (_>=_) "(>= %1 %2)"
syntax logic (_> _) "(> %1 %2)"
remove prop One_neutral
remove prop Add_assoc
remove prop Add_comm
remove prop Zero_neutral
remove prop Neg
remove prop Mul_comm
remove prop Mul_assoc
remove prop Mul_distr
end
theory algebra.AC
tag cloned logic op "AC"
remove cloned prop Comm
remove cloned prop Assoc
end
(*
Local Variables:
mode: why
compile-command: "make -C ../.. bench"
End:
*)
src/core/ident.ml
View file @
d813b7f2
...
...
@@ -75,6 +75,12 @@ let rec id_derived_from i1 i2 = i1 == i2 ||
|
Derived
i3
->
id_derived_from
i3
i2
|
_
->
false
)
let
rec
id_from_user
i
=
match
i
.
id_origin
with
|
Derived
i
->
id_from_user
i
|
User
l
->
Some
l
|
Fresh
->
None
(** Unique names for pretty printing *)
type
ident_printer
=
...
...
src/core/ident.mli
View file @
d813b7f2
...
...
@@ -62,6 +62,9 @@ val id_dup : ident -> preid
(* id_derived_from i1 i2 <=> i1 is derived from i2 *)
val
id_derived_from
:
ident
->
ident
->
bool
(* id_derived_from i1 i2 <=> i1 is derived from i2 *)
val
id_from_user
:
ident
->
Loc
.
position
option
(** Unique persistent names for pretty printing *)
type
ident_printer
...
...
src/driver/call_provers.ml
View file @
d813b7f2
...
...
@@ -70,6 +70,8 @@ let remove_file ?(debug=false) f =
(*let environment = Unix.environment ()*)
let
()
=
Sys
.
set_signal
Sys
.
sigpipe
Sys
.
Signal_ignore
let
timed_sys_command
?
formatter
?
(
debug
=
false
)
?
timeout
cmd
=
let
t0
=
Unix
.
times
()
in
let
cmd
=
match
timeout
with
...
...
@@ -77,12 +79,16 @@ let timed_sys_command ?formatter ?(debug=false) ?timeout cmd =
|
Some
timeout
->
Format
.
sprintf
"%s %d %s 2>&1"
!
cpulimit
timeout
cmd
in
if
debug
then
Format
.
eprintf
"command line: %s@."
cmd
;
let
(
cin
,
cout
)
as
p
=
Unix
.
open_process
cmd
in
(
match
formatter
with
|
None
->
()
|
Some
formatter
->
let
fmt
=
formatter_of_out_channel
cout
in
formatter
fmt
);
close_out
cout
;
begin
try
(
match
formatter
with
|
None
->
()
|
Some
formatter
->
let
fmt
=
formatter_of_out_channel
cout
in
formatter
fmt
);
close_out
cout
;
with
Sys_error
s
->
if
debug
then
Format
.
eprintf
"Sys_error : %s@."
s
end
;
let
out
=
Sysutil
.
channel_contents
cin
in
let
ret
=
Unix
.
close_process
p
in
let
t1
=
Unix
.
times
()
in
...
...
src/printer/alt_ergo.ml
View file @
d813b7f2
...
...
@@ -33,8 +33,10 @@ let ident_printer =
let
print_ident
fmt
id
=
fprintf
fmt
"%s"
(
id_unique
ident_printer
id
)
let
print_tvsymbols
fmt
id
=
fprintf
fmt
"'%s"
(
id_unique
ident_printer
id
.
tv_name
)
let
print_tvsymbols
fmt
tv
=
let
sanitize
n
=
"'"
^
n
in
let
n
=
id_unique
ident_printer
~
sanitizer
:
sanitize
tv
.
tv_name
in
fprintf
fmt
"%s"
n
let
forget_var
v
=
forget_id
ident_printer
v
.
vs_name
...
...
src/printer/smt.ml
0 → 100644
View file @
d813b7f2
(**************************************************************************)
(* *)
(* 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
Format
open
Pp
open
Ident
open
Ty
open
Term
open
Decl
open
Task
let
ident_printer
=
let
bls
=
[
"and"
;
" benchmark"
;
" distinct"
;
"exists"
;
"false"
;
"flet"
;
"forall"
;
"if then else"
;
"iff"
;
"implies"
;
"ite"
;
"let"
;
"logic"
;
"not"
;
"or"
;
"sat"
;
"theory"
;
"true"
;
"unknown"
;
"unsat"
;
"xor"
;
"assumption"
;
"axioms"
;
"defintion"
;
"extensions"
;
"formula"
;
"funs"
;
"extrafuns"
;
"extrasorts"
;
"extrapreds"
;
"language"
;
"notes"
;
"preds"
;
"sorts"
;
"status"
;
"theory"
;
"Int"
;
"Real"
;
"Bool"
;
"Array"
;
"U"
;
"select"
;
"store"
]
in
let
san
=
sanitizer
char_to_alpha
char_to_alnumus
in
create_ident_printer
bls
~
sanitizer
:
san
let
print_ident
fmt
id
=
fprintf
fmt
"%s"
(
id_unique
ident_printer
id
)
let
print_tvsymbols
fmt
id
=
assert
false
let
forget_var
v
=
forget_id
ident_printer
v
.
vs_name
let
print_var
fmt
{
vs_name
=
id
}
=
let
sanitize
n
=
"?"
^
n
in
let
n
=
id_unique
ident_printer
~
sanitizer
:
sanitize
id
in
fprintf
fmt
"%s"
n
let
rec
print_type
drv
fmt
ty
=
match
ty
.
ty_node
with
|
Tyvar
id
->
print_tvsymbols
fmt
id
|
Tyapp
(
ts
,
tl
)
->
match
Driver
.
query_ident
drv
ts
.
ts_name
with
|
Driver
.
Remove
->
assert
false
(* Mettre une erreur *)
|
Driver
.
Syntax
s
->
Driver
.
syntax_arguments
s
(
print_type
drv
)
fmt
tl
|
Driver
.
Tag
_
->
begin
match
ty
.
ty_node
with
|
Tyvar
_
->
assert
false
|
Tyapp
(
ts
,
[]
)
->
print_ident
fmt
ts
.
ts_name
|
Tyapp
(
ts
,
[
ty
])
->
fprintf
fmt
"%a %a"
(
print_type
drv
)
ty
print_ident
ts
.
ts_name
|
Tyapp
(
ts
,
tyl
)
->
fprintf
fmt
"(%a) %a"
(
print_list
comma
(
print_type
drv
))
tyl
print_ident
ts
.
ts_name
end
let
rec
print_term
drv
fmt
t
=
match
t
.
t_node
with
|
Tbvar
_
->
assert
false
|
Tconst
c
->
Pretty
.
print_const
fmt
c
|
Tvar
v
->
print_var
fmt
v
|
Tapp
(
ls
,
tl
)
->
begin
match
Driver
.
query_ident
drv
ls
.
ls_name
with
|
Driver
.
Remove
->
assert
false
(* Mettre une erreur *)
|
Driver
.
Syntax
s
->
Driver
.
syntax_arguments
s
(
print_term
drv
)
fmt
tl
|
Driver
.
Tag
_
->
match
tl
with
|
[]
->
print_ident
fmt
ls
.
ls_name
|
tl
->
fprintf
fmt
"@[(%a %a)@]"
print_ident
ls
.
ls_name
(
print_list
space
(
print_term
drv
))
tl
end
|
Tlet
(
t1
,
tb
)
->
let
v
,
t2
=
t_open_bound
tb
in
fprintf
fmt
"@[(let %a = %a@ in %a)@]"
print_ident
v
.
vs_name
(
print_term
drv
)
t1
(
print_term
drv
)
t2
;
forget_var
v
|
Tcase
_
->
assert
false
|
Teps
_
->
assert
false
let
rec
print_fmla
drv
fmt
f
=
match
f
.
f_node
with
|
Fapp
({
ls_name
=
id
}
,
[]
)
->
print_ident
fmt
id
|
Fapp
(
ls
,
tl
)
->
begin
match
Driver
.
query_ident
drv
ls
.
ls_name
with
|
Driver
.
Remove
->
assert
false
(* Mettre une erreur *)
|
Driver
.
Syntax
s
->
Driver
.
syntax_arguments
s
(
print_term
drv
)
fmt
tl
|
Driver
.
Tag
_
->
fprintf
fmt
"(%a %a)"
print_ident
ls
.
ls_name
(
print_list
space
(
print_term
drv
))
tl
end
|
Fquant
(
q
,
fq
)
->
let
q
=
match
q
with
Fforall
->
"forall"
|
Fexists
->
"exists"
in
let
vl
,
tl
,
f
=
f_open_quant
fq
in
(* TODO trigger *)
let
rec
forall
fmt
=
function
|
[]
->
print_fmla
drv
fmt
f
|
v
::
l
->
fprintf
fmt
"@[(%s (%a %a)@ %a)@]"
q
print_var
v
(
print_type
drv
)
v
.
vs_ty
forall
l
in
forall
fmt
vl
;
List
.
iter
forget_var
vl
|
Fbinop
(
Fand
,
f1
,
f2
)
->
fprintf
fmt
"@[(and@ %a %a)@]"
(
print_fmla
drv
)
f1
(
print_fmla
drv
)
f2
|
Fbinop
(
For
,
f1
,
f2
)
->
fprintf
fmt
"@[(or@ %a %a)@]"
(
print_fmla
drv
)
f1
(
print_fmla
drv
)
f2
|
Fbinop
(
Fimplies
,
f1
,
f2
)
->
fprintf
fmt
"@[(implies@ %a %a)@]"
(
print_fmla
drv
)
f1
(
print_fmla
drv
)
f2
|
Fbinop
(
Fiff
,
f1
,
f2
)
->
fprintf
fmt
"@[(iff@ %a %a)@]"
(
print_fmla
drv
)
f1
(
print_fmla
drv
)
f2
|
Fnot
f
->
fprintf
fmt
"@[(not@ %a)@]"
(
print_fmla
drv
)
f
|
Ftrue
->
fprintf
fmt
"true"
|
Ffalse
->
fprintf
fmt
"false"
|
Fif
(
f1
,
f2
,
f3
)
->
fprintf
fmt
"@[(if_then_else %a %a %a@]"
(* TODO Not sure *)
(
print_fmla
drv
)
f1
(
print_fmla
drv
)
f2
(
print_fmla
drv
)
f3
|
Flet
_
->
(* TODO *)
assert
false
|
Fcase
_
->
assert
false
and
print_expr
drv
fmt
=
e_apply
(
print_term
drv
fmt
)
(
print_fmla
drv
fmt
)
and
print_triggers
drv
fmt
tl
=
print_list
comma
(
print_expr
drv
)
fmt
tl
let
print_logic_binder
drv
fmt
v
=
fprintf
fmt
"%a: %a"
print_ident
v
.
vs_name
(
print_type
drv
)
v
.
vs_ty
let
print_type_decl
drv
fmt
=
function
|
ts
,
Tabstract
->
begin
match
Driver
.
query_ident
drv
ts
.
ts_name
with
|
Driver
.
Remove
|
Driver
.
Syntax
_
->
false
|
Driver
.
Tag
_
->
match
ts
.
ts_args
with
|
[]
->
fprintf
fmt
":extrasorts (%a)"
print_ident
ts
.
ts_name
;
true
|
_
->
assert
false
end
|
_
,
Talgebraic
_
->
assert
false
let
print_logic_decl
drv
task
fmt
(
ls
,
ld
)
=
match
Driver
.
query_ident
drv
ls
.
ls_name
with
|
Driver
.
Remove
|
Driver
.
Syntax
_
->
false
|
Driver
.
Tag
s
->
begin
match
ld
with
|
None
->
begin
match
ls
.
ls_value
with
|
None
->
fprintf
fmt
"@[<hov 2>:extrapreds ((%a %a))@]@
\n
"
print_ident
ls
.
ls_name
(
print_list
space
(
print_type
drv
))
ls
.
ls_args
|
Some
value
->
fprintf
fmt
"@[<hov 2>:extrafuns ((%a %a %a))@]@
\n
"
print_ident
ls
.
ls_name
(
print_list
space
(
print_type
drv
))
ls
.
ls_args
(
print_type
drv
)
value
end
|
Some
ld
->
assert
false
(* Dealt in Encoding *)
end
;
true
let
print_decl
drv
task
fmt
d
=
match
d
.
d_node
with
|
Dtype
dl
->
print_list_opt
newline
(
print_type_decl
drv
)
fmt
dl
|
Dlogic
dl
->
print_list_opt
newline
(
print_logic_decl
drv
task
)
fmt
dl
|
Dind
_
->
assert
false
(* TODO *)
|
Dprop
(
Paxiom
,
pr
,
_
)
when
Driver
.
query_ident
drv
pr
.
pr_name
=
Driver
.
Remove
->
false
|
Dprop
(
Paxiom
,
pr
,
f
)
->
fprintf
fmt
"@[<hov 2>:assumption@ %a@]@
\n
"
(
print_fmla
drv
)
f
;
true
|
Dprop
(
Pgoal
,
pr
,
f
)
->
fprintf
fmt
"@[:formula@
\n
"
;
fprintf
fmt
"@[;; %a@]@
\n
"
print_ident
pr
.
pr_name
;
(
match
id_from_user
pr
.
pr_name
with
|
None
->
()
|
Some
loc
->
fprintf
fmt
" @[;; %a@]@
\n
"
Loc
.
gen_report_position
loc
);
fprintf
fmt
" @[(not@ %a)@]"
(
print_fmla
drv
)
f
;
true
|
Dprop
(
Plemma
,
_
,
_
)
->
assert
false
let
print_context
drv
fmt
task
=
fprintf
fmt
"(benchmark toto@
\n
"
(*print_ident (Task.task_goal task).pr_name*)
;
fprintf
fmt
" :status unknown@
\n
"
;
let
decls
=
Task
.
task_decls
task
in
ignore
(
print_list_opt
(
add_flush
newline2
)
(
print_decl
drv
task
)
fmt
decls
);
fprintf
fmt
"@
\n
)@."
let
()
=
Driver
.
register_printer
"smtv1"
(
fun
drv
fmt
task
->
forget_all
ident_printer
;
print_context
drv
fmt
task
)
src/printer/smt.mli
0 → 100644
View file @
d813b7f2
(**************************************************************************)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment