Mentions légales du service
Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
why3
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Deploy
Releases
Container registry
Monitor
Service Desk
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Why3
why3
Commits
a7720a18
Commit
a7720a18
authored
15 years ago
by
Andrei Paskevich
Browse files
Options
Downloads
Patches
Plain Diff
type and variable instantiation in terms and formulas
parent
4daf3b17
Branches
Branches containing commit
Tags
Tags containing commit
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
src/core/term.ml
+61
-49
61 additions, 49 deletions
src/core/term.ml
src/core/term.mli
+3
-0
3 additions, 0 deletions
src/core/term.mli
with
64 additions
and
49 deletions
src/core/term.ml
+
61
−
49
View file @
a7720a18
...
...
@@ -678,49 +678,49 @@ let f_let v t1 f2 =
if
not
(
ty_equal
v
.
vs_ty
t1
.
t_ty
)
then
raise
TypeMismatch
;
f_let
v
t1
f2
(*
map over symbol
s *)
(*
generic map over types, symbols and variable
s *)
let
rec
t_
s
_map
fnT
fnV
fnL
t
=
let
fn_t
=
t_
s
_map
fnT
fnV
fnL
in
let
fn_f
=
f_
s
_map
fnT
fnV
fnL
in
let
rec
t_
gen
_map
fnT
fnB
fnV
fnL
t
=
let
fn_t
=
t_
gen
_map
fnT
fnB
fnV
fnL
in
let
fn_f
=
f_
gen
_map
fnT
fnB
fnV
fnL
in
let
ty
=
fnT
t
.
t_ty
in
t_label_copy
t
(
match
t
.
t_node
with
|
Tbvar
n
->
t_bvar
n
ty
|
Tvar
v
->
t_var
(
fnV
v
ty
)
|
Tvar
v
->
fnV
v
ty
|
Tconst
_
->
t
|
Tapp
(
f
,
tl
)
->
t_app
(
fnL
f
)
(
List
.
map
fn_t
tl
)
ty
|
Tif
(
f
,
t1
,
t2
)
->
t_if
(
fn_f
f
)
(
fn_t
t1
)
(
fn_t
t2
)
|
Tlet
(
t1
,
(
u
,
t2
))
->
let
t1
=
fn_t
t1
in
t_let
(
fn
V
u
t1
.
t_ty
)
t1
(
fn_t
t2
)
let
t1
=
fn_t
t1
in
t_let
(
fn
B
u
t1
.
t_ty
)
t1
(
fn_t
t2
)
|
Tcase
(
tl
,
bl
)
->
let
fn_b
=
t_branch
fnT
fnV
fnL
in
let
fn_b
=
t_branch
fnT
fnB
fnV
fnL
in
t_case
(
List
.
map
fn_t
tl
)
(
List
.
map
fn_b
bl
)
ty
|
Teps
(
u
,
f
)
->
t_eps
(
fn
V
u
ty
)
(
fn_f
f
))
|
Teps
(
u
,
f
)
->
t_eps
(
fn
B
u
ty
)
(
fn_f
f
))
and
f_
s
_map
fnT
fnV
fnL
f
=
let
fn_t
=
t_
s
_map
fnT
fnV
fnL
in
let
fn_f
=
f_
s
_map
fnT
fnV
fnL
in
and
f_
gen
_map
fnT
fnB
fnV
fnL
f
=
let
fn_t
=
t_
gen
_map
fnT
fnB
fnV
fnL
in
let
fn_f
=
f_
gen
_map
fnT
fnB
fnV
fnL
in
f_label_copy
f
(
match
f
.
f_node
with
|
Fapp
(
p
,
tl
)
->
f_app
(
fnL
p
)
(
List
.
map
fn_t
tl
)
|
Fquant
(
q
,
(
vl
,
nv
,
tl
,
f1
))
->
let
tl
=
tr_map
fn_t
fn_f
tl
in
let
fn_v
u
=
fn
V
u
(
fnT
u
.
vs_ty
)
in
let
fn_v
u
=
fn
B
u
(
fnT
u
.
vs_ty
)
in
f_quant
q
(
List
.
map
fn_v
vl
)
nv
tl
(
fn_f
f1
)
|
Fbinop
(
op
,
f1
,
f2
)
->
f_binary
op
(
fn_f
f1
)
(
fn_f
f2
)
|
Fnot
f1
->
f_not
(
fn_f
f1
)
|
Ftrue
|
Ffalse
->
f
|
Fif
(
f1
,
f2
,
f3
)
->
f_if
(
fn_f
f1
)
(
fn_f
f2
)
(
fn_f
f3
)
|
Flet
(
t
,
(
u
,
f1
))
->
let
t1
=
fn_t
t
in
f_let
(
fn
V
u
t1
.
t_ty
)
t1
(
fn_f
f1
)
let
t1
=
fn_t
t
in
f_let
(
fn
B
u
t1
.
t_ty
)
t1
(
fn_f
f1
)
|
Fcase
(
tl
,
bl
)
->
let
fn_b
=
f_branch
fnT
fnV
fnL
in
let
fn_b
=
f_branch
fnT
fnB
fnV
fnL
in
f_case
(
List
.
map
fn_t
tl
)
(
List
.
map
fn_b
bl
))
and
t_branch
fnT
fnV
fnL
(
pl
,
nv
,
t
)
=
(
List
.
map
(
pat_s_map
fnT
fn
V
fnL
)
pl
,
nv
,
t_
s
_map
fnT
fnV
fnL
t
)
and
t_branch
fnT
fnB
fnV
fnL
(
pl
,
nv
,
t
)
=
(
List
.
map
(
pat_s_map
fnT
fn
B
fnL
)
pl
,
nv
,
t_
gen
_map
fnT
fnB
fnV
fnL
t
)
and
f_branch
fnT
fnV
fnL
(
pl
,
nv
,
f
)
=
(
List
.
map
(
pat_s_map
fnT
fn
V
fnL
)
pl
,
nv
,
f_
s
_map
fnT
fnV
fnL
f
)
and
f_branch
fnT
fnB
fnV
fnL
(
pl
,
nv
,
f
)
=
(
List
.
map
(
pat_s_map
fnT
fn
B
fnL
)
pl
,
nv
,
f_
gen
_map
fnT
fnB
fnV
fnL
f
)
let
get_fnT
fn
=
let
ht
=
Hashtbl
.
create
17
in
...
...
@@ -732,7 +732,7 @@ let get_fnT fn =
in
fnT
let
get_fn
V
()
=
let
get_fn
B
()
=
let
ht
=
Hid
.
create
17
in
let
fnV
vs
ty
=
if
ty_equal
vs
.
vs_ty
ty
then
vs
else
...
...
@@ -743,8 +743,22 @@ let get_fnV () =
in
fnV
let
t_s_map
fnT
fnL
t
=
t_s_map
(
get_fnT
fnT
)
(
get_fnV
()
)
fnL
t
let
f_s_map
fnT
fnL
f
=
f_s_map
(
get_fnT
fnT
)
(
get_fnV
()
)
fnL
f
let
get_fnV
()
=
let
fnB
=
get_fnB
()
in
fun
vs
ty
->
t_var
(
fnB
vs
ty
)
let
t_s_map
fnT
fnL
t
=
t_gen_map
(
get_fnT
fnT
)
(
get_fnB
()
)
(
get_fnV
()
)
fnL
t
let
f_s_map
fnT
fnL
f
=
f_gen_map
(
get_fnT
fnT
)
(
get_fnB
()
)
(
get_fnV
()
)
fnL
f
(* simultaneous substitution into types and terms *)
let
t_ty_subst
mapT
mapV
t
=
let
fnV
vs
_ty
=
try
Mvs
.
find
vs
mapV
with
Not_found
->
t_var
vs
in
t_gen_map
(
ty_inst
mapT
)
(
get_fnB
()
)
fnV
(
fun
ls
->
ls
)
t
let
f_ty_subst
mapT
mapV
f
=
let
fnV
vs
_ty
=
try
Mvs
.
find
vs
mapV
with
Not_found
->
t_var
vs
in
f_gen_map
(
ty_inst
mapT
)
(
get_fnB
()
)
fnV
(
fun
ls
->
ls
)
f
(* fold over symbols *)
...
...
@@ -1537,35 +1551,33 @@ let f_let_simp v t f = match f.f_node with
let
f_equ_simp
t1
t2
=
if
t_equal
t1
t2
then
f_true
else
f_equ
t1
t2
let
f_neq_simp
t1
t2
=
if
t_equal
t1
t2
then
f_false
else
f_neq
t1
t2
let
is_true_false
f
=
match
f
.
f_node
with
let
is_true_false
f
=
match
f
.
f_node
with
|
Ftrue
|
Ffalse
->
true
|
_
->
false
(* Could we add an optional argument which toggle
(* Could we add an optional argument which toggle
the simplification to the other map? *)
let
f_map_simp
fnT
fnF
f
=
f_label_copy
f
(
match
f
.
f_node
with
|
Fapp
(
p
,
[
t1
;
t2
])
when
ls_equal
p
ps_equ
->
f_equ_simp
(
fnT
t1
)
(
fnT
t2
)
|
Fapp
(
p
,
[
t1
;
t2
])
when
ls_equal
p
ps_neq
->
f_neq_simp
(
fnT
t1
)
(
fnT
t2
)
|
Fapp
(
p
,
tl
)
->
f_app_unsafe
p
(
List
.
map
fnT
tl
)
|
Fquant
(
q
,
b
)
->
let
vl
,
tl
,
f1
=
f_open_quant
b
in
let
f1'
=
fnF
f1
in
let
tl'
=
tr_map
fnT
fnF
tl
in
if
f_equal
f1'
f1
&&
trl_equal
tl'
tl
&&
not
(
is_true_false
f1
)
then
f
else
f_quant_simp
q
vl
tl'
f1'
|
Fbinop
(
op
,
f1
,
f2
)
->
f_binary_simp
op
(
fnF
f1
)
(
fnF
f2
)
|
Fnot
f1
->
f_not_simp
(
fnF
f1
)
|
Ftrue
|
Ffalse
->
f
|
Fif
(
f1
,
f2
,
f3
)
->
f_if_simp
(
fnF
f1
)
(
fnF
f2
)
(
fnF
f3
)
|
Flet
(
t
,
b
)
->
let
u
,
f1
=
f_open_bound
b
in
let
t'
=
fnT
t
in
let
f1'
=
fnF
f1
in
if
t_equal
t'
t
&&
f_equal
f1'
f1
&&
not
(
is_true_false
f1
)
then
f
else
f_let_simp
u
t'
f1'
|
Fcase
(
tl
,
bl
)
->
let
tl'
=
List
.
map
fnT
tl
in
let
tltl
=
List
.
for_all2
t_equal
tl
tl'
in
let
blbl
,
bl'
=
map_fold_left
(
f_branch'
fnF
)
true
bl
in
if
tltl
&&
blbl
then
f
else
f_case
tl'
bl'
)
let
f_map_simp
fnT
fnF
f
=
f_label_copy
f
(
match
f
.
f_node
with
|
Fapp
(
p
,
[
t1
;
t2
])
when
ls_equal
p
ps_equ
->
f_equ_simp
(
fnT
t1
)
(
fnT
t2
)
|
Fapp
(
p
,
[
t1
;
t2
])
when
ls_equal
p
ps_neq
->
f_neq_simp
(
fnT
t1
)
(
fnT
t2
)
|
Fapp
(
p
,
tl
)
->
f_app_unsafe
p
(
List
.
map
fnT
tl
)
|
Fquant
(
q
,
b
)
->
let
vl
,
tl
,
f1
=
f_open_quant
b
in
let
f1'
=
fnF
f1
in
let
tl'
=
tr_map
fnT
fnF
tl
in
if
f_equal
f1'
f1
&&
trl_equal
tl'
tl
&&
not
(
is_true_false
f1
)
then
f
else
f_quant_simp
q
vl
tl'
f1'
|
Fbinop
(
op
,
f1
,
f2
)
->
f_binary_simp
op
(
fnF
f1
)
(
fnF
f2
)
|
Fnot
f1
->
f_not_simp
(
fnF
f1
)
|
Ftrue
|
Ffalse
->
f
|
Fif
(
f1
,
f2
,
f3
)
->
f_if_simp
(
fnF
f1
)
(
fnF
f2
)
(
fnF
f3
)
|
Flet
(
t
,
b
)
->
let
u
,
f1
=
f_open_bound
b
in
let
t'
=
fnT
t
in
let
f1'
=
fnF
f1
in
if
t_equal
t'
t
&&
f_equal
f1'
f1
&&
not
(
is_true_false
f1
)
then
f
else
f_let_simp
u
t'
f1'
|
Fcase
(
tl
,
bl
)
->
let
tl'
=
List
.
map
fnT
tl
in
let
tltl
=
List
.
for_all2
t_equal
tl
tl'
in
let
blbl
,
bl'
=
map_fold_left
(
f_branch'
fnF
)
true
bl
in
if
tltl
&&
blbl
then
f
else
f_case
tl'
bl'
)
let
f_map_simp
fnT
=
f_map_simp
(
protect
fnT
)
This diff is collapsed.
Click to expand it.
src/core/term.mli
+
3
−
0
View file @
a7720a18
...
...
@@ -360,6 +360,9 @@ val f_subst : term Mvs.t -> fmla -> fmla
val
t_subst_single
:
vsymbol
->
term
->
term
->
term
val
f_subst_single
:
vsymbol
->
term
->
fmla
->
fmla
val
t_ty_subst
:
ty
Mtv
.
t
->
term
Mvs
.
t
->
term
->
term
val
f_ty_subst
:
ty
Mtv
.
t
->
term
Mvs
.
t
->
fmla
->
fmla
(** set of free variables *)
val
t_freevars
:
Svs
.
t
->
term
->
Svs
.
t
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment