Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
Why3
why3
Commits
a61a3a90
Commit
a61a3a90
authored
Mar 23, 2015
by
Andrei Paskevich
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
SMTv2 printer: pattern matching: handle the wildcard
parent
ce75ed2f
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
46 additions
and
61 deletions
+46
-61
src/printer/smtv2.ml
src/printer/smtv2.ml
+46
-61
No files found.
src/printer/smtv2.ml
View file @
a61a3a90
...
...
@@ -9,7 +9,7 @@
(* *)
(********************************************************************)
(** SMT v
1
printer with some extensions *)
(** SMT v
2
printer with some extensions *)
open
Format
open
Pp
...
...
@@ -159,59 +159,18 @@ let rec print_term info fmt t = match t.t_node with
|
Tif
(
f1
,
t1
,
t2
)
->
fprintf
fmt
"@[(ite %a@ %a@ %a)@]"
(
print_fmla
info
)
f1
(
print_term
info
)
t1
(
print_term
info
)
t2
(*
| Tcase _ -> unsupportedTerm t
"smtv2: you must eliminate match"
*)
|
Tcase
(
t
,
bl
)
->
let
subject
=
create_vsymbol
(
id_fresh
"subject"
)
(
t_type
t
)
in
fprintf
fmt
"@[(let ((%a @[%a@]))@ %a)@]"
print_var
subject
(
print_term
info
)
t
(
print_branches
info
subject
print_term
)
bl
;
forget_var
subject
|
Tcase
({
t_node
=
Tvar
v
}
,
bl
)
->
print_branches
info
v
print_term
fmt
bl
|
Tcase
(
t
,
bl
)
->
let
subject
=
create_vsymbol
(
id_fresh
"subject"
)
(
t_type
t
)
in
fprintf
fmt
"@[(let ((%a @[%a@]))@ %a)@]"
print_var
subject
(
print_term
info
)
t
(
print_branches
info
subject
print_term
)
bl
;
forget_var
subject
|
Teps
_
->
unsupportedTerm
t
"smtv2: you must eliminate epsilon"
|
Tquant
_
|
Tbinop
_
|
Tnot
_
|
Ttrue
|
Tfalse
->
raise
(
TermExpected
t
)
and
print_branches
info
subject
pr
fmt
bl
=
match
bl
with
|
[]
->
assert
false
|
br
::
bl
->
let
(
p
,
t
)
=
t_open_branch
br
in
let
constr
,
args
=
try
match
p
.
pat_node
with
|
Papp
(
cs
,
args
)
->
let
vars
=
List
.
map
(
function
{
pat_node
=
Pvar
v
}
->
v
|
_
->
raise
Exit
)
args
in
cs
,
vars
|
_
->
raise
Exit
with
Exit
->
unsupportedPattern
p
"smtv2: you must compile nested pattern-matching"
in
match
bl
with
|
[]
->
print_branch
info
subject
pr
fmt
(
constr
,
args
,
t
)
|
_
->
fprintf
fmt
"@[(ite (is-%a %a) %a %a)@]"
print_ident
constr
.
ls_name
print_var
subject
(
print_branch
info
subject
pr
)
(
constr
,
args
,
t
)
(
print_branches
info
subject
pr
)
bl
and
print_branch
info
subject
pr
fmt
(
cs
,
vars
,
t
)
=
let
i
=
ref
0
in
let
print_proj
fmt
v
=
incr
i
;
fprintf
fmt
"(%a (%a_proj_%d %a))"
print_var
v
print_ident
cs
.
ls_name
!
i
print_var
subject
in
match
vars
with
|
[]
->
pr
info
fmt
t
|
_
->
fprintf
fmt
"@[(let (%a) %a)@]"
(
print_list
space
print_proj
)
vars
(
pr
info
)
t
and
print_fmla
info
fmt
f
=
match
f
.
t_node
with
|
Tapp
({
ls_name
=
id
}
,
[]
)
->
print_ident
fmt
id
...
...
@@ -263,18 +222,44 @@ and print_fmla info fmt f = match f.t_node with
fprintf
fmt
"@[(let ((%a %a))@ %a)@]"
print_var
v
(
print_term
info
)
t1
(
print_fmla
info
)
f2
;
forget_var
v
(*
| Tcase _ -> unsupportedTerm f
"smtv2 : you must eliminate match"
*)
|
Tcase
(
t
,
bl
)
->
let
subject
=
create_vsymbol
(
id_fresh
"subject"
)
(
t_type
t
)
in
fprintf
fmt
"@[(let ((%a @[%a@]))@ %a)@]"
print_var
subject
(
print_term
info
)
t
(
print_branches
info
subject
print_fmla
)
bl
;
forget_var
subject
|
Tcase
({
t_node
=
Tvar
v
}
,
bl
)
->
print_branches
info
v
print_fmla
fmt
bl
|
Tcase
(
t
,
bl
)
->
let
subject
=
create_vsymbol
(
id_fresh
"subject"
)
(
t_type
t
)
in
fprintf
fmt
"@[(let ((%a @[%a@]))@ %a)@]"
print_var
subject
(
print_term
info
)
t
(
print_branches
info
subject
print_fmla
)
bl
;
forget_var
subject
|
Tvar
_
|
Tconst
_
|
Teps
_
->
raise
(
FmlaExpected
f
)
and
print_branches
info
subject
pr
fmt
bl
=
match
bl
with
|
[]
->
assert
false
|
br
::
bl
->
let
(
p
,
t
)
=
t_open_branch
br
in
let
error
()
=
unsupportedPattern
p
"smtv2: you must compile nested pattern matching"
in
match
p
.
pat_node
with
|
Pwild
->
pr
info
fmt
t
|
Papp
(
cs
,
args
)
->
let
args
=
List
.
map
(
function
|
{
pat_node
=
Pvar
v
}
->
v
|
_
->
error
()
)
args
in
if
bl
=
[]
then
print_branch
info
subject
pr
fmt
(
cs
,
args
,
t
)
else
fprintf
fmt
"@[(ite (is-%a %a) %a %a)@]"
print_ident
cs
.
ls_name
print_var
subject
(
print_branch
info
subject
pr
)
(
cs
,
args
,
t
)
(
print_branches
info
subject
pr
)
bl
|
_
->
error
()
and
print_branch
info
subject
pr
fmt
(
cs
,
vars
,
t
)
=
if
vars
=
[]
then
pr
info
fmt
t
else
let
tvs
=
t_freevars
Mvs
.
empty
t
in
if
List
.
for_all
(
fun
v
->
not
(
Mvs
.
mem
v
tvs
))
vars
then
pr
info
fmt
t
else
let
i
=
ref
0
in
let
pr_proj
fmt
v
=
incr
i
;
if
Mvs
.
mem
v
tvs
then
fprintf
fmt
"(%a (%a_proj_%d %a))"
print_var
v
print_ident
cs
.
ls_name
!
i
print_var
subject
in
fprintf
fmt
"@[(let (%a) %a)@]"
(
print_list
space
pr_proj
)
vars
(
pr
info
)
t
and
print_expr
info
fmt
=
TermTF
.
t_select
(
print_term
info
fmt
)
(
print_fmla
info
fmt
)
...
...
@@ -330,7 +315,7 @@ let print_constructor_decl info fmt (ls,args) =
|
[]
->
fprintf
fmt
"(%a)"
print_ident
ls
.
ls_name
|
_
->
fprintf
fmt
"@[(%a@ "
print_ident
ls
.
ls_name
;
let
_
=
let
_
=
List
.
fold_left2
(
fun
i
ty
pr
->
begin
match
pr
with
...
...
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