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
79a51b83
Commit
79a51b83
authored
15 years ago
by
Andrei Paskevich
Browse files
Options
Downloads
Patches
Plain Diff
refresh ls_defn on every open
parent
a8731c85
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/core/decl.ml
+34
-30
34 additions, 30 deletions
src/core/decl.ml
with
34 additions
and
30 deletions
src/core/decl.ml
+
34
−
30
View file @
79a51b83
...
...
@@ -33,28 +33,13 @@ type ty_decl = tysymbol * ty_def
(** Logic declaration *)
type
ls_defn
=
lsymbol
*
vsymbol
list
*
expr
*
fmla
type
ls_defn
=
lsymbol
*
fmla
type
logic_decl
=
lsymbol
*
ls_defn
option
exception
UnboundVars
of
Svs
.
t
exception
IllegalConstructor
of
lsymbol
let
extract_ls_defn
f
=
let
vl
,
ef
=
f_open_forall
f
in
match
ef
.
f_node
with
|
Fapp
(
s
,
[
t1
;
t2
])
when
s
==
ps_equ
->
begin
match
t1
.
t_node
with
|
Tapp
(
fs
,
_
)
->
fs
,
Some
(
fs
,
vl
,
Term
t2
,
f
)
|
_
->
assert
false
end
|
Fbinop
(
Fiff
,
f1
,
f2
)
->
begin
match
f1
.
f_node
with
|
Fapp
(
ps
,
_
)
->
ps
,
Some
(
ps
,
vl
,
Fmla
f2
,
f
)
|
_
->
assert
false
end
|
_
->
assert
false
let
check_fvs
f
=
let
fvs
=
f_freevars
Svs
.
empty
f
in
if
Svs
.
is_empty
fvs
then
f
else
raise
(
UnboundVars
fvs
)
...
...
@@ -63,22 +48,39 @@ let make_fs_defn fs vl t =
if
fs
.
ls_constr
then
raise
(
IllegalConstructor
fs
);
let
hd
=
t_app
fs
(
List
.
map
t_var
vl
)
t
.
t_ty
in
let
fd
=
f_forall
vl
[]
(
f_equ
hd
t
)
in
extract_ls_defn
fd
fs
,
Some
(
fs
,
check_fvs
fd
)
let
make_ps_defn
ps
vl
f
=
let
hd
=
f_app
ps
(
List
.
map
t_var
vl
)
in
let
pd
=
f_forall
vl
[]
(
f_iff
hd
f
)
in
extract_ls_defn
pd
ps
,
Some
(
ps
,
check_fvs
pd
)
let
make_ls_defn
ls
vl
=
e_apply
(
make_fs_defn
ls
vl
)
(
make_ps_defn
ls
vl
)
let
open_fs_defn
=
function
(
_
,
vl
,
Term
t
,_
)
->
(
vl
,
t
)
|
_
->
assert
false
let
extract_ls_defn
(
_
,
f
)
=
let
vl
,
ef
=
f_open_forall
f
in
match
ef
.
f_node
with
|
Fapp
(
s
,
[
t1
;
t2
])
when
s
==
ps_equ
->
begin
match
t1
.
t_node
with
|
Tapp
(
fs
,
_
)
->
fs
,
vl
,
Term
t2
|
_
->
assert
false
end
|
Fbinop
(
Fiff
,
f1
,
f2
)
->
begin
match
f1
.
f_node
with
|
Fapp
(
ps
,
_
)
->
ps
,
vl
,
Fmla
f2
|
_
->
assert
false
end
|
_
->
assert
false
let
open_ls_defn
ld
=
let
_
,
vl
,
e
=
extract_ls_defn
ld
in
vl
,
e
let
open_ps_defn
=
function
(
_
,
vl
,
Fmla
f
,_
)
->
(
vl
,
f
)
|
_
->
assert
false
let
open_fs_defn
ld
=
let
_
,
vl
,
e
=
extract_ls_defn
ld
in
match
e
with
Term
t
->
vl
,
t
|
_
->
assert
false
let
open_ls_defn
(
_
,
vl
,
e
,_
)
=
(
vl
,
e
)
let
open_ps_defn
ld
=
let
_
,
vl
,
e
=
extract_ls_defn
ld
in
match
e
with
Fmla
f
->
vl
,
f
|
_
->
assert
false
let
ls_defn_axiom
(
_
,
_,_,
f
)
=
f
let
ls_defn_axiom
(
_
,
f
)
=
f
(** Inductive predicate declaration *)
...
...
@@ -135,7 +137,7 @@ module Hsdecl = Hashcons.Make (struct
|
_
->
false
let
eq_ld
(
ls1
,
ld1
)
(
ls2
,
ld2
)
=
ls1
==
ls2
&&
match
ld1
,
ld2
with
|
Some
(
_
,
_,_,
f1
)
,
Some
(
_
,
_,_,
f2
)
->
f1
==
f2
|
Some
(
_
,
f1
)
,
Some
(
_
,
f2
)
->
f1
==
f2
|
None
,
None
->
true
|
_
->
false
...
...
@@ -158,7 +160,7 @@ module Hsdecl = Hashcons.Make (struct
1
+
Hashcons
.
combine_list
tag
ts
.
ts_name
.
id_tag
l
let
hs_ld
(
ls
,
ld
)
=
Hashcons
.
combine
ls
.
ls_name
.
id_tag
(
Hashcons
.
combine_option
(
fun
(
_
,
_,_,
f
)
->
f
.
f_tag
)
ld
)
(
Hashcons
.
combine_option
(
fun
(
_
,
f
)
->
f
.
f_tag
)
ld
)
let
hs_prop
(
pr
,
f
)
=
Hashcons
.
combine
pr
.
pr_name
.
id_tag
f
.
f_tag
...
...
@@ -239,7 +241,7 @@ let create_ty_decl tdl =
let
create_logic_decl
ldl
=
if
ldl
=
[]
then
raise
EmptyDecl
;
let
check_decl
acc
(
ls
,
ld
)
=
match
ld
with
|
Some
(
s
,_
,_,_
)
when
s
!=
ls
->
raise
(
BadLogicDecl
ls
.
ls_name
)
|
Some
(
s
,_
)
when
s
!=
ls
->
raise
(
BadLogicDecl
ls
.
ls_name
)
|
_
->
add_id
acc
ls
.
ls_name
in
ignore
(
List
.
fold_left
check_decl
Sid
.
empty
ldl
);
...
...
@@ -271,12 +273,13 @@ let create_ind_decl idl =
let
add
acc
(
ps
,_
)
=
Sls
.
add
ps
acc
in
let
sps
=
List
.
fold_left
add
Sls
.
empty
idl
in
let
check_ax
ps
acc
(
pr
,
f
)
=
let
_
,
f
=
f_open_forall
f
in
let
rec
clause
acc
f
=
match
f
.
f_node
with
|
Fquant
(
Fforall
,
f
)
->
let
_
,_,
f
=
f_open_quant
f
in
clause
acc
f
|
Fbinop
(
Fimplies
,
g
,
f
)
->
clause
(
g
::
acc
)
f
|
_
->
(
acc
,
f
)
in
let
cls
,
f
=
clause
[]
f
in
let
cls
,
f
=
clause
[]
(
check_fvs
f
)
in
match
f
.
f_node
with
|
Fapp
(
s
,
tl
)
when
s
==
ps
->
let
tymatch
sb
t
ty
=
...
...
@@ -296,6 +299,8 @@ let create_ind_decl idl =
ignore
(
List
.
fold_left
check_decl
Sid
.
empty
idl
);
create_ind_decl
idl
let
create_prop_decl
k
p
f
=
create_prop_decl
k
p
(
check_fvs
f
)
(** Split declarations *)
let
build_dls
get_id
get_dep
dl
=
...
...
@@ -340,9 +345,8 @@ let get_logic_dep next loan (_,ld) =
let
dep
acc
ls
=
if
Sid
.
mem
ls
.
ls_name
next
then
Sid
.
add
ls
.
ls_name
acc
else
acc
in
match
ld
with
|
Some
(
_
,_,
Term
t
,_
)
->
t_s_fold
dts
dep
loan
t
|
Some
(
_
,_,
Fmla
f
,_
)
->
f_s_fold
dts
dep
loan
f
|
None
->
loan
|
Some
(
_
,
f
)
->
f_s_fold
dts
dep
loan
f
|
None
->
loan
let
get_ind_id
(
ps
,_
)
=
ps
.
ls_name
...
...
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