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
9f15e991
Commit
9f15e991
authored
Sep 29, 2011
by
Andrei Paskevich
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
prepare some generic utilities for realization
parent
f7f65b21
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
71 additions
and
26 deletions
+71
-26
src/core/task.ml
src/core/task.ml
+39
-2
src/core/task.mli
src/core/task.mli
+23
-7
src/driver/driver.ml
src/driver/driver.ml
+4
-10
src/driver/driver.mli
src/driver/driver.mli
+5
-7
No files found.
src/core/task.ml
View file @
9f15e991
...
...
@@ -55,16 +55,19 @@ type clone_map = tdecl_set Mid.t
type
meta_map
=
tdecl_set
Mmeta
.
t
let
cm_find
cm
th
=
Mid
.
find_default
th
.
th_name
tds_empty
cm
let
mm_find
mm
t
=
Mmeta
.
find_default
t
tds_empty
mm
let
cm_add
cm
th
td
=
Mid
.
change
th
.
th_name
(
function
|
None
->
Some
(
tds_singleton
td
)
|
Some
tds
->
Some
(
tds_add
td
tds
))
cm
let
mm_add
mm
t
td
=
Mmeta
.
change
t
(
function
|
None
->
Some
(
tds_singleton
td
)
|
Some
tds
->
Some
(
tds_add
td
tds
))
mm
let
mm_add
mm
t
td
=
if
t
.
meta_excl
then
Mmeta
.
add
t
(
tds_singleton
td
)
mm
else
Mmeta
.
add
t
(
tds_add
td
(
mm_find
mm
t
))
mm
else
mm_add
mm
t
td
(** Task *)
...
...
@@ -220,6 +223,40 @@ let task_tdecls = task_fold (fun acc td -> td::acc) []
let
task_decls
=
task_fold
(
fun
acc
td
->
match
td
.
td_node
with
Decl
d
->
d
::
acc
|
_
->
acc
)
[]
(* Realization utilities *)
let
used_theories
task
=
let
used
{
tds_set
=
s
}
=
let
th
=
match
Mtdecl
.
choose
s
with
|
{
td_node
=
Clone
(
th
,_
)
}
,
_
->
th
|
_
->
assert
false
in
let
td
=
create_null_clone
th
in
if
Stdecl
.
mem
td
s
then
Some
th
else
None
in
Mid
.
map_filter
used
(
task_clone
task
)
let
used_symbols
thmap
=
let
dict
th
=
Mid
.
map
(
fun
()
->
th
)
th
.
th_local
in
let
join
_
=
Mid
.
union
(
fun
_
->
assert
false
)
in
Mid
.
fold
join
(
Mid
.
map
dict
thmap
)
Mid
.
empty
let
local_decls
task
symbmap
=
let
rec
skip
t
=
function
|
{
td_node
=
Clone
(
th
,_
)
}
::
rest
when
id_equal
t
.
th_name
th
.
th_name
->
rest
|
_
::
rest
->
skip
t
rest
|
[]
->
[]
in
let
rec
filter
acc
=
function
|
{
td_node
=
Decl
d
}
::
rest
->
let
id
=
Sid
.
choose
d
.
d_news
in
(
try
filter
acc
(
skip
(
Mid
.
find
id
symbmap
)
rest
)
with
Not_found
->
filter
(
d
::
acc
)
rest
)
|
_
::
rest
->
filter
acc
rest
|
[]
->
List
.
rev
acc
in
filter
[]
(
task_tdecls
task
)
(* Selectors *)
exception
NotTaggingMeta
of
meta
...
...
src/core/task.mli
View file @
9f15e991
...
...
@@ -83,8 +83,29 @@ val add_prop_decl : task -> prop_kind -> prsymbol -> term -> task
(** {2 utilities} *)
val
split_theory
:
theory
->
Spr
.
t
option
->
task
->
task
list
(** [split_theory th s] returns the tasks of [th] which end by one
of [s]. They are in the opposite order than in the theory *)
(** [split_theory th s t] returns the tasks of [th] added to [t]
that end by one of [s]. They are in the opposite order than
in the theory *)
val
bisect
:
(
task
->
bool
)
->
task
->
task
(** [bisect test task] return a task included in [task] which is at
the limit of truthness of the function test. The returned task is
included in [task] and if any declarations are removed from it the
task doesn't verify test anymore *)
(** {2 realization utilities} *)
val
used_theories
:
task
->
theory
Mid
.
t
(** returns a map from theory names to theories themselves *)
val
used_symbols
:
theory
Mid
.
t
->
theory
Mid
.
t
(** takes the result of [used_theories] and returns
a map from symbol names to their theories of origin *)
val
local_decls
:
task
->
theory
Mid
.
t
->
decl
list
(** takes the result of [used_symbols] adn returns
the list of declarations that are not imported
with those theories or derived thereof *)
(** {2 bottom-up, tail-recursive traversal functions} *)
...
...
@@ -120,8 +141,3 @@ exception GoalFound
exception
SkipFound
exception
LemmaFound
val
bisect
:
(
task
->
bool
)
->
task
->
task
(** [bisect test task] return a task included in [task] which is at
the limit of truthness of the function test. The returned task is
included in [task] and if any declarations are removed from it the
task doesn't verify test anymore *)
src/driver/driver.ml
View file @
9f15e991
...
...
@@ -294,6 +294,10 @@ let print_task ?old drv fmt task =
let
task
=
prepare_task
drv
task
in
print_task_prepared
?
old
drv
fmt
task
let
print_theory
?
old
drv
fmt
th
=
let
task
=
Task
.
use_export
None
th
in
print_task
?
old
drv
fmt
task
let
prove_task_prepared
~
command
?
timelimit
?
memlimit
?
old
drv
task
=
let
buf
=
Buffer
.
create
1024
in
let
fmt
=
formatter_of_buffer
buf
in
...
...
@@ -332,13 +336,3 @@ let () = Exn_printer.register (fun fmt exn -> match exn with
"%a is not a predicate symbol"
Pretty
.
print_ls
ls
|
e
->
raise
e
)
let
print_theory
?
old
drv
fmt
th
=
let
task
=
Task
.
use_export
None
th
in
print_task
?
old
drv
fmt
task
src/driver/driver.mli
View file @
9f15e991
...
...
@@ -48,6 +48,11 @@ val print_task :
?
old
:
in_channel
->
driver
->
Format
.
formatter
->
Task
.
task
->
unit
val
print_theory
:
?
old
:
in_channel
->
driver
->
Format
.
formatter
->
Theory
.
theory
->
unit
(** produce a realization of the given theory using the given driver *)
val
prove_task
:
command
:
string
->
?
timelimit
:
int
->
...
...
@@ -68,11 +73,4 @@ val prove_task_prepared :
?
memlimit
:
int
->
?
old
:
in_channel
->
driver
->
Task
.
task
->
Call_provers
.
pre_prover_call
(***)
val
print_theory
:
?
old
:
in_channel
->
driver
->
Format
.
formatter
->
Theory
.
theory
->
unit
(** produce a realization of the given theory using the given driver *)
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