Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
134a8572
Commit
134a8572
authored
Feb 28, 2012
by
François Bobot
Browse files
session_scheduler : provide the scheduler of replay inside the library
parent
2601188f
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/ide/replay.ml
View file @
134a8572
...
...
@@ -151,14 +151,8 @@ let () =
Debug
.
Opt
.
set_flags_selected
()
;
if
Debug
.
Opt
.
option_list
()
then
exit
0
let
usleep
t
=
ignore
(
Unix
.
select
[]
[]
[]
t
)
let
idle_handler
=
ref
None
let
timeout_handler
=
ref
None
module
O
=
(
struct
struct
type
key
=
int
let
create
?
parent
()
=
...
...
@@ -170,20 +164,6 @@ module O =
let
reset
()
=
()
let
idle
f
=
match
!
idle_handler
with
|
None
->
idle_handler
:=
Some
f
;
|
Some
_
->
failwith
"Replay.idle: already one handler installed"
let
timeout
~
ms
f
=
match
!
timeout_handler
with
|
None
->
timeout_handler
:=
Some
(
float
ms
/.
1000
.
0
,
f
);
|
Some
_
->
failwith
"Replay.timeout: already one handler installed"
let
notify_timer_state
w
s
r
=
Printf
.
eprintf
"Progress: %d/%d/%d
\r
%!"
w
s
r
let
init
=
(*
let cpt = ref 0 in
...
...
@@ -232,7 +212,11 @@ let unknown_prover _ _ = None
let
replace_prover
_
_
=
false
end
)
module
Scheduler
=
Session_scheduler
.
Base_scheduler
(
struct
end
)
include
Scheduler
end
module
M
=
Session_scheduler
.
Make
(
O
)
...
...
@@ -246,46 +230,7 @@ let print_result fmt
if
ans
==
Call_provers
.
HighFailure
then
fprintf
fmt
"@
\n
Prover output:@
\n
%s@."
out
let
main_loop
()
=
let
last
=
ref
(
Unix
.
gettimeofday
()
)
in
while
true
do
let
time
=
Unix
.
gettimeofday
()
-.
!
last
in
(* attempt to run timeout handler *)
let
timeout
=
match
!
timeout_handler
with
|
None
->
false
|
Some
(
ms
,
f
)
->
if
time
>
ms
then
let
b
=
f
()
in
if
b
then
true
else
begin
timeout_handler
:=
None
;
true
end
else
false
in
if
timeout
then
last
:=
Unix
.
gettimeofday
()
else
(* attempt to run the idle handler *)
match
!
idle_handler
with
|
None
->
begin
let
ms
=
match
!
timeout_handler
with
|
None
->
100
.
0
(* raise Exit *)
|
Some
(
ms
,_
)
->
ms
in
usleep
(
ms
-.
time
)
end
|
Some
f
->
let
b
=
f
()
in
if
b
then
()
else
begin
idle_handler
:=
None
;
end
done
let
main_loop
=
O
.
main_loop
(*
let model_index = Hashtbl.create 257
*)
...
...
@@ -723,8 +668,7 @@ let () =
else
begin
add_to_check
found_obs
env_session
sched
;
try
main_loop
()
with
Exit
->
eprintf
"main replayer exited unexpectedly@."
main_loop
()
;
eprintf
"main replayer exited unexpectedly@."
;
exit
1
end
with
|
S
.
OutdatedSession
->
...
...
src/session/session_scheduler.ml
View file @
134a8572
...
...
@@ -809,6 +809,77 @@ let convert_unknown_prover =
Session_tools
.
convert_unknown_prover
~
keygen
:
O
.
create
end
module
Base_scheduler
(
X
:
sig
end
)
=
(
struct
let
usleep
t
=
ignore
(
Unix
.
select
[]
[]
[]
t
)
let
idle_handler
=
ref
None
let
timeout_handler
=
ref
None
let
idle
f
=
match
!
idle_handler
with
|
None
->
idle_handler
:=
Some
f
;
|
Some
_
->
failwith
"Replay.idle: already one handler installed"
let
timeout
~
ms
f
=
match
!
timeout_handler
with
|
None
->
timeout_handler
:=
Some
(
float
ms
/.
1000
.
0
,
f
);
|
Some
_
->
failwith
"Replay.timeout: already one handler installed"
let
notify_timer_state
w
s
r
=
Printf
.
eprintf
"Progress: %d/%d/%d
\r
%!"
w
s
r
let
main_loop
()
=
let
last
=
ref
(
Unix
.
gettimeofday
()
)
in
try
while
true
do
let
time
=
Unix
.
gettimeofday
()
-.
!
last
in
(* attempt to run timeout handler *)
let
timeout
=
match
!
timeout_handler
with
|
None
->
false
|
Some
(
ms
,
f
)
->
if
time
>
ms
then
let
b
=
f
()
in
if
b
then
true
else
begin
timeout_handler
:=
None
;
true
end
else
false
in
if
timeout
then
last
:=
Unix
.
gettimeofday
()
else
(* attempt to run the idle handler *)
match
!
idle_handler
with
|
None
->
begin
let
ms
=
match
!
timeout_handler
with
|
None
->
raise
Exit
|
Some
(
ms
,_
)
->
ms
in
usleep
(
ms
-.
time
)
end
|
Some
f
->
let
b
=
f
()
in
if
b
then
()
else
begin
idle_handler
:=
None
;
end
done
with
Exit
->
()
end
)
(*
Local Variables:
compile-command: "unset LANG; make -C ../.. bin/why3ide.byte"
...
...
src/session/session_scheduler.mli
View file @
134a8572
...
...
@@ -227,6 +227,21 @@ module Make(O: OBSERVER) : sig
end
(** A functor (a state is hidden) that provide a working scheduler
and which can be used as base for an OBSERVER *)
module
Base_scheduler
(
X
:
sig
end
)
:
sig
val
timeout
:
ms
:
int
->
(
unit
->
bool
)
->
unit
val
idle
:
(
unit
->
bool
)
->
unit
val
notify_timer_state
:
int
->
int
->
int
->
unit
(** These functions have the properties required by OBSERVER *)
val
main_loop
:
unit
->
unit
(** [main_loop ()] run the main loop. Run the timeout handler and the
the idle handler registered until the two of them are done. Nothing is run
until this function is called *)
end
(*
Local Variables:
...
...
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