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
120
Issues
120
List
Boards
Labels
Service Desk
Milestones
Merge Requests
17
Merge Requests
17
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
f87661d9
Commit
f87661d9
authored
Apr 22, 2017
by
Sylvain Dailler
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Adding clean_req. Need testing.
parent
0d7de10f
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
60 additions
and
7 deletions
+60
-7
src/ide/why3ide.ml
src/ide/why3ide.ml
+4
-0
src/session/controller_itp.ml
src/session/controller_itp.ml
+20
-0
src/session/controller_itp.mli
src/session/controller_itp.mli
+6
-0
src/session/itp_communication.ml
src/session/itp_communication.ml
+2
-1
src/session/itp_communication.mli
src/session/itp_communication.mli
+1
-0
src/session/itp_server.ml
src/session/itp_server.ml
+16
-0
src/session/json_util.ml
src/session/json_util.ml
+11
-6
No files found.
src/ide/why3ide.ml
View file @
f87661d9
...
...
@@ -525,6 +525,10 @@ let (_ : GMenu.menu_item) =
let
replay_menu_item
:
GMenu
.
menu_item
=
file_factory
#
add_item
~
key
:
GdkKeysyms
.
_R
"_Replay all"
let
clean_menu_item
:
GMenu
.
menu_item
=
file_factory
#
add_item
~
key
:
GdkKeysyms
.
_L
"C_Lean all"
~
callback
:
(
fun
_
->
send_request
Clean_req
)
let
(
_
:
GMenu
.
menu_item
)
=
file_factory
#
add_item
~
key
:
GdkKeysyms
.
_Q
"_Quit"
~
callback
:
exit_function_safe
...
...
src/session/controller_itp.ml
View file @
f87661d9
...
...
@@ -689,6 +689,26 @@ let schedule_tr_with_same_arguments
let
name
=
get_transf_name
s
tr
in
schedule_transformation
c
pn
name
args
~
callback
~
notification
let
clean_session
c
~
remove
~
node_change
=
let
is_valid
(
pa
:
proof_attempt_node
)
:
bool
=
match
pa
.
Session_itp
.
proof_state
with
|
None
->
false
|
Some
pr
->
begin
match
pr
.
Call_provers
.
pr_answer
with
|
Call_provers
.
Valid
->
true
|
_
->
false
end
in
let
s
=
c
.
controller_session
in
Session_itp
.
session_iter_proof_attempt
(
fun
_
pa
->
let
pnid
=
pa
.
parent
in
Hprover
.
iter
(
fun
_
paid
->
if
(
not
(
is_valid
(
get_proof_attempt_node
s
paid
)))
then
remove_subtree
c
~
removed
:
remove
~
node_change
(
APa
paid
))
(
get_proof_attempt_ids
s
pnid
))
s
exception
BadCopyPaste
(* Reproduce the transformation made on node on an other one *)
...
...
src/session/controller_itp.mli
View file @
f87661d9
...
...
@@ -210,6 +210,12 @@ val run_strategy_on_goal :
[schedule_transformation]). [callback] is called on each step of
execution of the strategy. *)
val
clean_session
:
controller
->
remove
:
(
any
->
unit
)
->
node_change
:
(
any
->
bool
->
unit
)
->
unit
(** Remove proof_attempts that are not valid from the session *)
(* [copy_paste c a b] try to copy subtree originating at node a to node b *)
val
copy_paste
:
notification
:
(
any
->
bool
->
unit
)
->
...
...
src/session/itp_communication.ml
View file @
f87661d9
...
...
@@ -92,6 +92,7 @@ type ide_request =
|
Save_file_req
of
string
*
string
|
Get_first_unproven_node
of
node_ID
|
Get_Session_Tree_req
|
Clean_req
|
Save_req
|
Reload_req
|
Replay_req
...
...
@@ -103,7 +104,7 @@ let modify_session (r: ide_request) =
match
r
with
|
Command_req
_
|
Prove_req
_
|
Transform_req
_
|
Strategy_req
_
|
Add_file_req
_
|
Remove_subtree
_
|
Copy_paste
_
|
Copy_detached
_
|
Replay_req
->
true
|
Replay_req
|
Clean_req
->
true
|
Open_session_req
_
|
Set_max_tasks_req
_
|
Get_file_contents
_
|
Get_task
_
|
Save_file_req
_
|
Get_first_unproven_node
_
...
...
src/session/itp_communication.mli
View file @
f87661d9
...
...
@@ -99,6 +99,7 @@ type ide_request =
(* Save_file_req (filename, content_of_file). Save the file *)
|
Get_first_unproven_node
of
node_ID
|
Get_Session_Tree_req
|
Clean_req
|
Save_req
|
Reload_req
|
Replay_req
...
...
src/session/itp_server.ml
View file @
f87661d9
...
...
@@ -258,6 +258,7 @@ let print_request fmt r =
|
Copy_detached
_
->
fprintf
fmt
"copy detached"
|
Get_Session_Tree_req
->
fprintf
fmt
"get session tree"
|
Save_file_req
_
->
fprintf
fmt
"save file"
|
Clean_req
->
fprintf
fmt
"clean"
|
Save_req
->
fprintf
fmt
"save"
|
Reload_req
->
fprintf
fmt
"reload"
|
Replay_req
->
fprintf
fmt
"replay"
...
...
@@ -937,6 +938,20 @@ let () =
unproven_goals
|
_
->
Debug
.
dprintf
debug_strat
"[strategy_exec] strategy '%s' not found@."
s
(* ----------------- Clean session -------------------- *)
let
clean_session
()
=
let
d
=
get_server_data
()
in
let
node_change
x
b
=
let
nid
=
node_ID_from_any
x
in
P
.
notify
(
Node_change
(
nid
,
Proved
b
))
in
let
remove
x
=
let
nid
=
node_ID_from_any
x
in
remove_any_node_ID
x
;
P
.
notify
(
Remove
nid
)
in
C
.
clean_session
d
.
cont
~
remove
~
node_change
(* ----------------- Save session --------------------- *)
let
save_session
()
=
let
d
=
get_server_data
()
in
...
...
@@ -1012,6 +1027,7 @@ let () =
end
|
Transform_req
(
nid
,
t
,
args
)
->
apply_transform
nid
t
args
|
Strategy_req
(
nid
,
st
)
->
run_strategy_on_task
nid
st
|
Clean_req
->
clean_session
()
|
Save_req
->
save_session
()
|
Reload_req
->
reload_session
()
|
Get_Session_Tree_req
->
resend_the_tree
()
...
...
src/session/json_util.ml
View file @
f87661d9
...
...
@@ -125,6 +125,7 @@ let convert_request_constructor (r: ide_request) =
|
Copy_detached
_
->
String
"Copy_detached"
|
Get_first_unproven_node
_
->
String
"Get_first_unproven_node"
|
Get_Session_Tree_req
->
String
"Get_Session_Tree_req"
|
Clean_req
->
String
"Clean_req"
|
Save_req
->
String
"Save_req"
|
Reload_req
->
String
"Reload_req"
|
Replay_req
->
String
"Replay_req"
...
...
@@ -185,6 +186,8 @@ let print_request_to_json (r: ide_request): Json_base.value =
"node_ID"
,
Int
id
]
|
Get_Session_Tree_req
->
Obj
[
"ide_request"
,
cc
r
]
|
Clean_req
->
Obj
[
"ide_request"
,
cc
r
]
|
Save_req
->
Obj
[
"ide_request"
,
cc
r
]
|
Reload_req
->
...
...
@@ -318,9 +321,9 @@ exception NotProver
let
parse_prover_from_json
(
j
:
Json_base
.
value
)
=
match
j
with
|
Obj
[
"prover_name"
,
String
pn
;
"prover_version"
,
String
pv
;
"prover_altern"
,
String
pa
]
->
{
Whyconf
.
prover_name
=
pn
;
prover_version
=
pv
;
prover_altern
=
pa
}
"prover_version"
,
String
pv
;
"prover_altern"
,
String
pa
]
->
{
Whyconf
.
prover_name
=
pn
;
prover_version
=
pv
;
prover_altern
=
pa
}
|
_
->
raise
NotProver
exception
NotLimit
...
...
@@ -328,9 +331,9 @@ exception NotLimit
let
parse_limit_from_json
(
j
:
Json_base
.
value
)
=
match
j
with
|
Obj
[
"limit_time"
,
Int
t
;
"limit_mem"
,
Int
m
;
"limit_steps"
,
Int
s
]
->
{
limit_time
=
t
;
limit_mem
=
m
;
limit_steps
=
s
}
"limit_mem"
,
Int
m
;
"limit_steps"
,
Int
s
]
->
{
limit_time
=
t
;
limit_mem
=
m
;
limit_steps
=
s
}
|
_
->
raise
NotLimit
exception
NotRequest
of
string
...
...
@@ -371,6 +374,8 @@ let parse_request (constr: string) l =
Copy_detached
n
|
"Get_Session_Tree_req"
,
[]
->
Get_Session_Tree_req
|
"Clean_req"
,
[]
->
Clean_req
|
"Save_req"
,
[]
->
Save_req
|
"Reload_req"
,
[]
->
...
...
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