Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
8874bce9
Commit
8874bce9
authored
Mar 16, 2010
by
Andrei Paskevich
Browse files
- make the interface to ls_defn more straightforward
- assure generation of new variables on create_ls_defn
parent
38810ff7
Changes
8
Hide whitespace changes
Inline
Side-by-side
src/core/pretty.ml
View file @
8874bce9
...
...
@@ -278,7 +278,7 @@ let print_type_decl fmt (ts,def) = match def with
let
print_type_decl
fmt
d
=
print_type_decl
fmt
d
;
forget_tvs
()
let
print_ls_defn
fmt
ld
=
let
_
,
vl
,
e
=
open_ls_defn
ld
in
let
vl
,
e
=
open_ls_defn
ld
in
fprintf
fmt
" =@ %a"
print_expr
e
;
List
.
iter
forget_var
vl
...
...
src/core/theory.ml
View file @
8874bce9
...
...
@@ -43,24 +43,6 @@ type logic_decl = lsymbol * ls_defn option
exception
UnboundVars
of
Svs
.
t
exception
IllegalConstructor
of
lsymbol
let
check_fvs
f
=
let
fvs
=
f_freevars
Svs
.
empty
f
in
if
Svs
.
is_empty
fvs
then
f
else
raise
(
UnboundVars
fvs
)
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
fs
,
vl
,
Term
t
,
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
ps
,
vl
,
Fmla
f
,
check_fvs
pd
let
make_ls_defn
ls
vl
=
e_apply
(
make_fs_defn
ls
vl
)
(
make_ps_defn
ls
vl
)
let
extract_ls_defn
f
=
let
vl
,
ef
=
f_open_forall
f
in
match
ef
.
f_node
with
...
...
@@ -76,15 +58,28 @@ let extract_ls_defn f =
end
|
_
->
assert
false
let
open_ls_defn
(
ls
,
vl
,
e
,_
)
=
(
ls
,
vl
,
e
)
let
check_fvs
f
=
let
fvs
=
f_freevars
Svs
.
empty
f
in
if
Svs
.
is_empty
fvs
then
f
else
raise
(
UnboundVars
fvs
)
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
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
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
open_fs_defn
=
function
|
(
fs
,
vl
,
Term
t
,_
)
->
(
fs
,
vl
,
t
)
|
_
->
assert
false
let
open_ps_defn
=
function
(
_
,
vl
,
Fmla
f
,_
)
->
(
vl
,
f
)
|
_
->
assert
false
let
open_ps_defn
=
function
|
(
ps
,
vl
,
Fmla
f
,_
)
->
(
ps
,
vl
,
f
)
|
_
->
assert
false
let
open_ls_defn
(
_
,
vl
,
e
,_
)
=
(
vl
,
e
)
let
ls_defn_axiom
(
_
,_,_,
f
)
=
f
...
...
src/core/theory.mli
View file @
8874bce9
...
...
@@ -35,17 +35,17 @@ type ty_decl = tysymbol * ty_def
type
ls_defn
val
make_ls_defn
:
lsymbol
->
vsymbol
list
->
expr
->
ls_defn
val
make_fs_defn
:
lsymbol
->
vsymbol
list
->
term
->
ls_defn
val
make_ps_defn
:
lsymbol
->
vsymbol
list
->
fmla
->
ls_defn
type
logic_decl
=
lsymbol
*
ls_defn
option
val
open
_ls_defn
:
ls_defn
->
lsymbol
*
vsymbol
list
*
expr
val
open
_fs_defn
:
ls_defn
->
lsymbol
*
vsymbol
list
*
term
val
open
_ps_defn
:
ls_defn
->
lsymbol
*
vsymbol
list
*
fmla
val
make
_ls_defn
:
lsymbol
->
vsymbol
list
->
expr
->
logic_decl
val
make
_fs_defn
:
lsymbol
->
vsymbol
list
->
term
->
logic_decl
val
make
_ps_defn
:
lsymbol
->
vsymbol
list
->
fmla
->
logic_decl
val
ls_defn_axiom
:
ls_defn
->
fmla
val
open_ls_defn
:
ls_defn
->
vsymbol
list
*
expr
val
open_fs_defn
:
ls_defn
->
vsymbol
list
*
term
val
open_ps_defn
:
ls_defn
->
vsymbol
list
*
fmla
type
logic_decl
=
lsymbol
*
ls_defn
option
val
ls_defn_axiom
:
ls_defn
->
fmla
(* inductive predicate declaration *)
...
...
src/output/alt_ergo.ml
View file @
8874bce9
...
...
@@ -160,7 +160,7 @@ let print_logic_decl drv ctxt fmt (ls,ld) =
(
print_list
comma
(
print_type
drv
))
ls
.
ls_args
(
print_option_or_default
"prop"
(
print_type
drv
))
ls
.
ls_value
|
Some
ld
->
let
_
,
vl
,
e
=
open_ls_defn
ld
in
let
vl
,
e
=
open_ls_defn
ld
in
begin
match
e
with
|
Term
t
->
(* TODO AC? *)
...
...
src/output/why3.ml
View file @
8874bce9
...
...
@@ -292,7 +292,7 @@ let print_type_decl drv fmt d =
|
_
->
print_type_decl
drv
fmt
d
;
forget_tvs
()
let
print_ls_defn
drv
fmt
ld
=
let
_
,
vl
,
e
=
open_ls_defn
ld
in
let
vl
,
e
=
open_ls_defn
ld
in
fprintf
fmt
" =@ %a"
(
print_expr
drv
)
e
;
List
.
iter
forget_var
vl
...
...
src/parser/typing.ml
View file @
8874bce9
...
...
@@ -870,8 +870,8 @@ let add_logics dl th =
match
d
.
ld_type
with
|
None
->
(* predicate *)
let
ps
=
Hashtbl
.
find
psymbols
id
in
let
defn
=
match
d
.
ld_def
with
|
None
->
None
begin
match
d
.
ld_def
with
|
None
->
ps
,
None
|
Some
f
->
let
f
=
dfmla
denv
f
in
let
vl
=
match
ps
.
ls_value
with
...
...
@@ -879,13 +879,12 @@ let add_logics dl th =
|
_
->
assert
false
in
let
env
=
env_of_vsymbol_list
vl
in
Some
(
make_ps_defn
ps
vl
(
fmla
env
f
))
in
ps
,
defn
make_ps_defn
ps
vl
(
fmla
env
f
)
end
|
Some
ty
->
(* function *)
let
fs
=
Hashtbl
.
find
fsymbols
id
in
let
defn
=
match
d
.
ld_def
with
|
None
->
None
begin
match
d
.
ld_def
with
|
None
->
fs
,
None
|
Some
t
->
let
loc
=
t
.
pp_loc
in
let
t
=
dterm
denv
t
in
...
...
@@ -894,15 +893,13 @@ let add_logics dl th =
|
_
->
assert
false
in
let
env
=
env_of_vsymbol_list
vl
in
try
Some
(
make_fs_defn
fs
vl
(
term
env
t
)
)
try
make_fs_defn
fs
vl
(
term
env
t
)
with
_
->
term_expected_type
~
loc
t
.
dt_ty
(
dty
denv
ty
)
in
fs
,
defn
end
in
let
dl
=
List
.
map
type_decl
dl
in
List
.
fold_left
add_decl
th
(
create_logic_decls
dl
)
let
term
env
t
=
let
denv
=
create_denv
env
in
let
t
=
dterm
denv
t
in
...
...
src/transform/inlining.ml
View file @
8874bce9
...
...
@@ -75,19 +75,19 @@ let fold isnotinlinedt isnotinlinedf ctxt0 (env, ctxt) =
match
ld
with
|
None
->
env
,
add_decl
ctxt
d
|
Some
ld
->
let
_
,
vs
,
e
=
open_ls_defn
ld
in
let
vs
,
e
=
open_ls_defn
ld
in
match
e
with
|
Term
t
->
let
t
=
replacet
env
t
in
if
t_s_any
ffalse
((
==
)
ls
)
t
||
isnotinlinedt
t
then
env
,
add_decl
ctxt
(
create_logic_decl
[
(
ls
,
Some
(
make_fs_defn
ls
vs
t
))
])
(
create_logic_decl
[
make_fs_defn
ls
vs
t
])
else
{
env
with
fs
=
Mls
.
add
ls
(
vs
,
t
)
env
.
fs
}
,
ctxt
|
Fmla
f
->
let
f
=
replacep
env
f
in
if
f_s_any
ffalse
((
==
)
ls
)
f
||
isnotinlinedf
f
then
env
,
add_decl
ctxt
(
create_logic_decl
[
(
ls
,
Some
(
make_ps_defn
ls
vs
f
))
])
(
create_logic_decl
[
make_ps_defn
ls
vs
f
])
else
{
env
with
ps
=
Mls
.
add
ls
(
vs
,
f
)
env
.
ps
}
,
ctxt
end
|
Dind
dl
->
...
...
@@ -97,10 +97,12 @@ let fold isnotinlinedt isnotinlinedf ctxt0 (env, ctxt) =
|
Dlogic
dl
->
env
,
add_decl
ctxt
(
create_logic_decl
(
List
.
map
(
fun
(
ls
,
ld
)
->
ls
,
Util
.
option_map
(
fun
ld
->
let
_
,
vs
,
e
=
open_ls_defn
ld
in
let
e
=
e_map
(
replacet
env
)
(
replacep
env
)
e
in
make_ls_defn
ls
vs
e
)
ld
)
dl
))
(
List
.
map
(
fun
(
ls
,
ld
)
->
match
ld
with
|
None
->
ls
,
None
|
Some
ld
->
let
vs
,
e
=
open_ls_defn
ld
in
let
e
=
e_map
(
replacet
env
)
(
replacep
env
)
e
in
make_ls_defn
ls
vs
e
)
dl
))
|
Dtype
dl
->
env
,
add_decl
ctxt
d
|
Dprop
(
k
,
pr
,
f
)
->
env
,
add_decl
ctxt
(
create_prop_decl
k
pr
(
replacep
env
f
))
...
...
src/transform/transform.ml
View file @
8874bce9
...
...
@@ -241,9 +241,9 @@ let rewrite_elt rt rf d =
|
Dlogic
l
->
[
create_logic_decl
(
List
.
map
(
function
|
(
ls
,
Some
def
)
->
let
(
ls
,
vsl
,
expr
)
=
open_ls_defn
def
in
let
vsl
,
expr
=
open_ls_defn
def
in
let
expr
=
e_map
rt
rf
expr
in
(
ls
,
Some
(
make_ls_defn
ls
vsl
expr
))
make_ls_defn
ls
vsl
expr
|
l
->
l
)
l
)]
|
Dind
indl
->
[
create_ind_decl
(
List
.
map
(
fun
(
ls
,
pl
)
->
ls
,
...
...
Write
Preview
Supports
Markdown
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