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
119
Issues
119
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
337f8ad5
Commit
337f8ad5
authored
Dec 04, 2010
by
François Bobot
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Generalize scheduler and long lines
parent
bf71d8ec
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
81 additions
and
61 deletions
+81
-61
src/ide/gmain.ml
src/ide/gmain.ml
+66
-34
src/ide/scheduler.ml
src/ide/scheduler.ml
+10
-22
src/ide/scheduler.mli
src/ide/scheduler.mli
+5
-5
No files found.
src/ide/gmain.ml
View file @
337f8ad5
...
...
@@ -22,7 +22,8 @@
* bug: the file names are stored as relative, so if you restart
from another directory, they are not found
but on the other hand, storing them as relative helps if you change the machine
but on the other hand, storing them as relative helps if you change
the machine
Solution: store the name relative to the database, e.g if
dir/file.why
...
...
@@ -40,7 +41,8 @@ from another directory, they are not found
* when proof attempt is finished and is it the one currently selected,
the new output should be displayed on upper-right window
* when returning from edited proofs: should we run the prover again immediately ?
* when returning from edited proofs: should we run the prover again
immediately ?
* bug trouve par Johannes:
...
...
@@ -188,7 +190,8 @@ let project_dir, file_to_read =
let
()
=
if
not
(
Sys
.
file_exists
project_dir
)
then
begin
eprintf
"Info: '%s' does not exists. Creating directory of that name for the project@."
fname
;
eprintf
"Info: '%s' does not exists. Creating directory of that name \
for the project@."
fname
;
Unix
.
mkdir
project_dir
0o777
end
...
...
@@ -225,13 +228,21 @@ let read_file fn =
module
Model
=
struct
type
proof_attempt_status
=
|
Scheduled
(** external proof attempt is scheduled *)
|
Running
(** external proof attempt is in progress *)
|
Success
(** external proof attempt succeeded *)
|
Timeout
(** external proof attempt was interrupted *)
|
Unknown
(** external prover answered ``don't know'' or equivalent *)
|
HighFailure
(** external prover call failed *)
type
proof_attempt
=
{
prover
:
prover_data
;
proof_goal
:
goal
;
proof_row
:
Gtk
.
tree_iter
;
proof_db
:
Db
.
proof_attempt
;
mutable
status
:
Scheduler
.
proof_attempt_status
;
mutable
status
:
proof_attempt_status
;
mutable
proof_obsolete
:
bool
;
mutable
time
:
float
;
mutable
output
:
string
;
...
...
@@ -483,16 +494,16 @@ let info_window mt s =
module
Helpers
=
struct
let
image_of_result
=
function
|
Scheduler
.
Scheduled
->
!
image_scheduled
|
Scheduler
.
Running
->
!
image_running
|
Scheduler
.
Success
->
!
image_valid
|
Scheduler
.
Timeout
->
!
image_timeout
|
Scheduler
.
Unknown
->
!
image_unknown
|
Scheduler
.
HighFailure
->
!
image_failure
open
Model
let
image_of_result
=
function
|
Scheduled
->
!
image_scheduled
|
Running
->
!
image_running
|
Success
->
!
image_valid
|
Timeout
->
!
image_timeout
|
Unknown
->
!
image_unknown
|
HighFailure
->
!
image_failure
let
set_file_verified
f
=
f
.
file_verified
<-
true
;
let
row
=
f
.
file_row
in
...
...
@@ -696,7 +707,8 @@ end
let
split_transformation
=
Trans
.
lookup_transform_l
"split_goal"
gconfig
.
env
let
intro_transformation
=
Trans
.
lookup_transform
"introduce_premises"
gconfig
.
env
let
intro_transformation
=
Trans
.
lookup_transform
"introduce_premises"
gconfig
.
env
...
...
@@ -713,13 +725,13 @@ let rec reimport_any_goal parent gname t db_goal goal_obsolete =
if
goal_obsolete
&&
not
o
then
Db
.
set_obsolete
a
;
let
obsolete
=
goal_obsolete
or
o
in
let
s
=
match
s
with
|
Db
.
Undone
->
Scheduler
.
HighFailure
|
Db
.
Undone
->
Model
.
HighFailure
|
Db
.
Success
->
if
not
obsolete
then
proved
:=
true
;
Scheduler
.
Success
|
Db
.
Unknown
->
Scheduler
.
Unknown
|
Db
.
Timeout
->
Scheduler
.
Timeout
|
Db
.
Failure
->
Scheduler
.
HighFailure
Model
.
Success
|
Db
.
Unknown
->
Model
.
Unknown
|
Db
.
Timeout
->
Model
.
Timeout
|
Db
.
Failure
->
Model
.
HighFailure
in
let
(
_pa
:
Model
.
proof_attempt
)
=
Helpers
.
add_external_proof_row
~
obsolete
~
edit
goal
p
a
s
t
...
...
@@ -874,22 +886,37 @@ let () =
(* method: run a given prover on each unproved goals *)
(*****************************************************)
let
callback_of_callback
callback
=
function
|
Scheduler
.
Scheduled
->
callback
Model
.
Scheduled
0
.
""
|
Scheduler
.
Running
->
callback
Model
.
Running
0
.
""
|
Scheduler
.
InternalFailure
_
->
callback
Model
.
HighFailure
0
.
"Prover call failed"
|
Scheduler
.
Done
r
->
let
res
=
match
r
.
Call_provers
.
pr_answer
with
|
Call_provers
.
Valid
->
Model
.
Success
|
Call_provers
.
Timeout
->
Model
.
Timeout
|
Call_provers
.
Unknown
_
|
Call_provers
.
Invalid
->
Model
.
Unknown
|
Call_provers
.
Failure
_
|
Call_provers
.
HighFailure
->
Model
.
HighFailure
in
callback
res
r
.
Call_provers
.
pr_time
r
.
Call_provers
.
pr_output
let
redo_external_proof
g
a
=
let
p
=
a
.
Model
.
prover
in
let
callback
result
time
output
=
a
.
Model
.
output
<-
output
;
Helpers
.
set_proof_status
~
obsolete
:
false
a
result
time
;
if
result
=
Scheduler
.
Success
then
Helpers
.
set_proved
~
propagate
:
true
a
.
Model
.
proof_goal
;
if
result
=
Model
.
Success
then
Helpers
.
set_proved
~
propagate
:
true
a
.
Model
.
proof_goal
;
let
db_res
=
match
result
with
|
Scheduler
.
Scheduled
|
Scheduler
.
Running
->
Db
.
Undone
|
Scheduler
.
Success
->
Db
.
Success
|
Scheduler
.
Unknown
->
Db
.
Unknown
|
Scheduler
.
Timeout
->
Db
.
Timeout
|
Scheduler
.
HighFailure
->
Db
.
Failure
|
Model
.
Scheduled
|
Model
.
Running
->
Db
.
Undone
|
Model
.
Success
->
Db
.
Success
|
Model
.
Unknown
->
Db
.
Unknown
|
Model
.
Timeout
->
Db
.
Timeout
|
Model
.
HighFailure
->
Db
.
Failure
in
Db
.
set_status
a
.
Model
.
proof_db
db_res
time
in
callback
Scheduler
.
Scheduled
0
.
0
""
;
callback
Model
.
Scheduled
0
.
0
""
;
let
old
=
if
a
.
Model
.
edited_as
=
""
then
None
else
begin
eprintf
"Info: proving using edited file %s@."
a
.
Model
.
edited_as
;
...
...
@@ -899,7 +926,7 @@ let redo_external_proof g a =
Scheduler
.
schedule_proof_attempt
~
debug
:
(
gconfig
.
verbose
>
0
)
~
timelimit
:
gconfig
.
time_limit
~
memlimit
:
0
?
old
~
command
:
p
.
command
~
driver
:
p
.
driver
~
callback
~
callback
:
(
callback_of_callback
callback
)
g
.
Model
.
task
let
rec
prover_on_goal
p
g
=
...
...
@@ -910,7 +937,7 @@ let rec prover_on_goal p g =
let
db_prover
=
Db
.
prover_from_name
id
in
let
db_pa
=
Db
.
add_proof_attempt
g
.
Model
.
goal_db
db_prover
in
Helpers
.
add_external_proof_row
~
obsolete
:
false
~
edit
:
""
g
p
db_pa
Scheduler
.
Scheduled
0
.
0
g
p
db_pa
Model
.
Scheduled
0
.
0
in
redo_external_proof
g
a
;
List
.
iter
...
...
@@ -976,7 +1003,8 @@ let split_goal g =
let
sum
=
task_checksum
subtask
in
let
subtask_db
=
Db
.
add_subgoal
db_transf
subgoal_name
sum
in
let
goal
=
Helpers
.
add_goal_row
(
Model
.
Transf
tr
)
subgoal_name
subtask
subtask_db
Helpers
.
add_goal_row
(
Model
.
Transf
tr
)
subgoal_name
subtask
subtask_db
in
(
goal
::
acc
,
count
+
1
))
([]
,
1
)
subgoals
...
...
@@ -1072,7 +1100,8 @@ let split_unproved_goals () =
goals_model#append ~parent:split_row ()
in
let sum = task_checksum subtask in
let subtask_db = Db.add_subgoal db_transf subgoal_name sum in
let subtask_db = Db.add_subgoal db_transf
subgoal_name sum in
(* TODO: call add_goal_row *)
let goal = {
Model.goal_name = subgoal_name;
...
...
@@ -1161,7 +1190,8 @@ let file_menu = factory#add_submenu "_File"
let
file_factory
=
new
GMenu
.
factory
file_menu
~
accel_group
let
(
_
:
GMenu
.
image_menu_item
)
=
file_factory
#
add_image_item
~
key
:
GdkKeysyms
.
_A
~
label
:
"_Add file"
~
callback
:
select_file
file_factory
#
add_image_item
~
key
:
GdkKeysyms
.
_A
~
label
:
"_Add file"
~
callback
:
select_file
()
let
(
_
:
GMenu
.
image_menu_item
)
=
...
...
@@ -1516,10 +1546,12 @@ let scroll_to_id id =
erase_color_loc
source_view
;
color_loc
source_view
l
b
e
|
Ident
.
Fresh
->
source_view
#
source_buffer
#
set_text
"Fresh ident (no position available)
\n
"
;
source_view
#
source_buffer
#
set_text
"Fresh ident (no position available)
\n
"
;
current_file
:=
""
|
Ident
.
Derived
_
->
source_view
#
source_buffer
#
set_text
"Derived ident (no position available)
\n
"
;
source_view
#
source_buffer
#
set_text
"Derived ident (no position available)
\n
"
;
current_file
:=
""
let
color_label
=
function
...
...
@@ -1545,7 +1577,7 @@ let scroll_to_source_goal g =
|
Some
{
Task
.
task_decl
=
{
Theory
.
td_node
=
Theory
.
Decl
{
Decl
.
d_node
=
Decl
.
Dprop
(
Decl
.
Pgoal
,
_
,
f
)
}}}
->
Theory
.
Decl
{
Decl
.
d_node
=
Decl
.
Dprop
(
Decl
.
Pgoal
,
_
,
f
)}}}
->
color_f_labels
()
f
|
_
->
assert
false
...
...
@@ -1638,7 +1670,7 @@ let edit_selected_row p =
|
f
->
f
in
let
old_status
=
a
.
Model
.
status
in
Helpers
.
set_proof_status
~
obsolete
:
false
a
Scheduler
.
Running
0
.
0
;
Helpers
.
set_proof_status
~
obsolete
:
false
a
Model
.
Running
0
.
0
;
let
callback
()
=
Helpers
.
set_proof_status
~
obsolete
:
false
a
old_status
0
.
0
;
in
...
...
src/ide/scheduler.ml
View file @
337f8ad5
...
...
@@ -10,15 +10,12 @@ let async = ref (fun f () -> f ())
type
proof_attempt_status
=
|
Scheduled
(** external proof attempt is scheduled *)
|
Running
(** external proof attempt is in progress *)
|
Success
(** external proof attempt succeeded *)
|
Timeout
(** external proof attempt was interrupted *)
|
Unknown
(** external prover answered ``don't know'' or equivalent *)
|
HighFailure
(** external prover call failed *)
|
Done
of
Call_provers
.
prover_result
(** external proof done *)
|
InternalFailure
of
exn
(** external proof aborted by internal error *)
(**** queues of events to process ****)
type
callback
=
proof_attempt_status
->
float
->
string
->
unit
type
callback
=
proof_attempt_status
->
unit
type
attempt
=
bool
*
int
*
int
*
in_channel
option
*
string
*
Driver
.
driver
*
callback
*
Task
.
task
...
...
@@ -37,7 +34,7 @@ type job =
let
transf_queue
:
job
Queue
.
t
=
Queue
.
create
()
type
answer
=
|
Prover_answer
of
callback
*
proof_attempt_status
*
float
*
string
|
Prover_answer
of
callback
*
proof_attempt_status
|
Editor_exited
of
(
unit
->
unit
)
(* queue of prover answers *)
let
answers_queue
:
answer
Queue
.
t
=
Queue
.
create
()
...
...
@@ -69,7 +66,7 @@ let event_handler () =
try
begin
(* priority 1: collect answers from provers or editors *)
match
Queue
.
pop
answers_queue
with
|
Prover_answer
(
callback
,
res
,
time
,
output
)
->
|
Prover_answer
(
callback
,
res
)
->
decr
running_proofs
;
Mutex
.
unlock
queue_lock
;
(*
...
...
@@ -77,7 +74,7 @@ let event_handler () =
"[Why thread] Scheduler.event_handler: got prover answer@.";
*)
(* call GUI callback with argument [res] *)
!
async
(
fun
()
->
callback
res
time
output
)
()
!
async
(
fun
()
->
callback
res
)
()
|
Editor_exited
callback
->
Mutex
.
unlock
queue_lock
;
!
async
callback
()
...
...
@@ -138,7 +135,7 @@ let event_handler () =
incr
running_proofs
;
Mutex
.
unlock
queue_lock
;
(* build the prover task from goal in [a] *)
!
async
(
fun
()
->
callback
Running
0
.
0
""
)
()
;
!
async
(
fun
()
->
callback
Running
)
()
;
try
let
call_prover
:
unit
->
Call_provers
.
prover_result
=
(*
...
...
@@ -152,17 +149,9 @@ let event_handler () =
(
fun
()
->
let
r
=
call_prover
()
in
Mutex
.
lock
queue_lock
;
let
res
=
match
r
.
Call_provers
.
pr_answer
with
|
Call_provers
.
Valid
->
Success
|
Call_provers
.
Timeout
->
Timeout
|
Call_provers
.
Invalid
|
Call_provers
.
Unknown
_
->
Unknown
|
Call_provers
.
Failure
_
|
Call_provers
.
HighFailure
->
HighFailure
in
let
res
=
Done
r
in
Queue
.
push
(
Prover_answer
(
callback
,
res
,
r
.
Call_provers
.
pr_time
,
r
.
Call_provers
.
pr_output
))
answers_queue
;
(
Prover_answer
(
callback
,
res
))
answers_queue
;
Condition
.
signal
queue_condition
;
Mutex
.
unlock
queue_lock
;
()
...
...
@@ -174,8 +163,7 @@ let event_handler () =
eprintf
"%a@."
Exn_printer
.
exn_printer
e
;
Mutex
.
lock
queue_lock
;
Queue
.
push
(
Prover_answer
(
callback
,
HighFailure
,
0
.
0
,
"Prover call failed"
))
answers_queue
;
(
Prover_answer
(
callback
,
InternalFailure
e
))
answers_queue
;
(* Condition.signal queue_condition; *)
Mutex
.
unlock
queue_lock
;
()
...
...
src/ide/scheduler.mli
View file @
337f8ad5
...
...
@@ -28,19 +28,19 @@ val maximum_running_proofs: int ref
(** bound on the number of prover processes running in parallel.
default is 2 *)
type
proof_attempt_status
=
|
Scheduled
(** external proof attempt is scheduled *)
|
Running
(** external proof attempt is in progress *)
|
Success
(** external proof attempt succeeded *)
|
Timeout
(** external proof attempt was interrupted *)
|
Unknown
(** external prover answered ``don't know'' or equivalent *)
|
HighFailure
(** external prover call failed *)
|
Done
of
Call_provers
.
prover_result
(** external proof done *)
|
InternalFailure
of
exn
(** external proof aborted by internal error *)
val
schedule_proof_attempt
:
debug
:
bool
->
timelimit
:
int
->
memlimit
:
int
->
?
old
:
in_channel
->
command
:
string
->
driver
:
Driver
.
driver
->
callback
:
(
proof_attempt_status
->
float
->
string
->
unit
)
->
callback
:
(
proof_attempt_status
->
unit
)
->
Task
.
task
(* Db.goal *)
->
unit
(** schedules an attempt to prove goal with the given prover. This
function just prepares the goal for the proof attempt, and puts
...
...
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