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
121
Issues
121
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
53b2d976
Commit
53b2d976
authored
Apr 13, 2016
by
Kim Nguyễn
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[trywhy3] : Implement splitting of tasks, cleaning of splited tasks and prove individual tasks.
parent
9a4b07f6
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
203 additions
and
57 deletions
+203
-57
src/trywhy3/editor_helper.js
src/trywhy3/editor_helper.js
+2
-1
src/trywhy3/trywhy3.css
src/trywhy3/trywhy3.css
+24
-6
src/trywhy3/trywhy3.html
src/trywhy3/trywhy3.html
+4
-1
src/trywhy3/trywhy3.ml
src/trywhy3/trywhy3.ml
+79
-14
src/trywhy3/why3_worker.ml
src/trywhy3/why3_worker.ml
+92
-33
src/trywhy3/worker_proto.ml
src/trywhy3/worker_proto.ml
+2
-2
No files found.
src/trywhy3/editor_helper.js
View file @
53b2d976
...
...
@@ -60,7 +60,8 @@ function realReplaceBuffer()
currentFilename
=
loadedFilename
;
//document.getElementById("filename_panel").innerHTML = loadedFilename;
loadedFilename
=
""
;
loadedBuffer
=
""
;
loadedBuffer
=
""
;
document
.
getElementById
(
"
console
"
).
innerHTML
=
""
;
}
function
confirmReplace
()
...
...
src/trywhy3/trywhy3.css
View file @
53b2d976
...
...
@@ -19,7 +19,9 @@
.task-abort
{
color
:
black
;
}
.task-selected
{
background
:
rgba
(
250
,
220
,
90
,
0.7
);
}
/* ACE Editor */
.error
{
...
...
@@ -228,32 +230,48 @@ body {
#console
ul
#theory-list
{
position
:
relative
;
list-style-type
:
none
;
list-style-position
:
inside
;
padding-left
:
0.5em
;
}
#console
ul
#theory-list
li
{
font-weight
:
bold
;
position
:
relative
;
}
#console
ul
#theory-list
li
*
{
#console
ul
#theory-list
li
{
font-weight
:
normal
;
padding-top
:
0.5em
;
padding-bottom
:
0.5em
;
}
#console
ul
#theory-list
ul
{
list-style-type
:
none
;
list-style-position
:
inside
;
padding-left
:
2em
;
}
#console
ul
#theory-list
ul
>
li
{
padding-left
:
1em
;
}
#console
ul
#theory-list
ul
ul
{
list-style-type
:
none
;
list-style-position
:
inside
;
padding-left
:
0.5
em
;
padding-left
:
2
em
;
}
#console
ul
#theory-list
ul
li
:before
{
display
:
inline-block
;
position
:
absolute
;
content
:
""
;
height
:
50%
;
top
:
0
;
left
:
-1.5em
;
width
:
1.25em
;
border-bottom
:
2pt
solid
#ddd
;
border-left
:
2pt
solid
#ddd
;
}
/* Confirmation dialog */
.btn
{
width
:
100%
;
...
...
src/trywhy3/trywhy3.html
View file @
53b2d976
...
...
@@ -69,7 +69,10 @@ yamlpp -l en src/trywhy3/index.prehtml -o src/trywhy3/index.en.html -->
<li><span>
Why3
</span>
<ul>
<li
id=
"run"
>
Execute Buffer
</li>
<li
id=
"prove"
>
Prove with Alt-Ergo
</li>
<li
id=
"prove_all"
>
Prove All with Alt-Ergo
</li>
<li
id=
"prove"
>
Prove Goal
</li>
<li
id=
"split_prove"
>
Split Goal and Prove
</li>
<li
id=
"clean"
>
Clean Goal
</li>
<li
id=
"stop"
>
Stop Alt-ergo
</li>
</ul>
</li>
...
...
src/trywhy3/trywhy3.ml
View file @
53b2d976
...
...
@@ -64,6 +64,18 @@ module Console =
let
appendChild
o
c
=
ignore
(
o
##
appendChild
(
(
c
:>
Dom
.
node
Js
.
t
)))
let
mk_li_content
id
expl
=
Js
.
string
(
Format
.
sprintf
"<span id='%s_container'><span id='%s_icon'></span> %s <span id='%s_msg'></span></span><ul id='%s_ul'></ul>"
id
id
expl
id
id
)
let
clean_task
id
=
try
let
ul
=
Dom_html
.
getElementById
(
id
^
"_ul"
)
in
ul
##
innerHTML
<-
Js
.
string
""
with
Not_found
->
()
let
attach_to_parent
id
parent_id
expl
_loc
=
let
doc
=
Dom_html
.
document
in
let
ul
=
...
...
@@ -84,18 +96,15 @@ module Console =
let
li
=
Dom_html
.
createLi
doc
in
li
##
id
<-
Js
.
string
id
;
appendChild
ul
li
;
let
span_icon
=
Dom_html
.
createSpan
doc
in
appendChild
li
span_icon
;
span_icon
##
id
<-
Js
.
string
(
id
^
"_icon"
);
appendChild
li
(
doc
##
createTextNode
(
Js
.
string
(
" "
^
expl
^
" "
)));
let
span_msg
=
Dom_html
.
createSpan
doc
in
span_msg
##
id
<-
Js
.
string
(
id
^
"_msg"
);
appendChild
li
span_msg
;
let
tul
=
Dom_html
.
createUl
doc
in
tul
##
id
<-
Js
.
string
(
id
^
"_ul"
);
appendChild
li
tul
li
##
innerHTML
<-
mk_li_content
id
expl
let
task_selection
=
Hashtbl
.
create
17
let
task_deselect
()
=
Hashtbl
.
iter
(
fun
_
span
->
span
##
classList
##
remove
(
Js
.
string
"task-selected"
))
task_selection
;
Hashtbl
.
clear
task_selection
let
print_why3_output
o
=
let
doc
=
Dom_html
.
document
in
(* see why3_worker.ml *)
...
...
@@ -116,9 +125,37 @@ module Console =
li
##
innerHTML
<-
(
Js
.
string
s
);
appendChild
ul
li
;)
sl
|
Theory
(
th_id
,
th_name
)
->
attach_to_parent
th_id
"theory-list"
th_name
[]
|
Theory
(
th_id
,
th_name
)
->
attach_to_parent
th_id
"theory-list"
th_name
[]
|
Task
(
id
,
parent_id
,
expl
,
_code
,
loc
)
->
attach_to_parent
id
parent_id
expl
loc
begin
try
ignore
(
Dom_html
.
getElementById
id
)
with
Not_found
->
attach_to_parent
id
(
parent_id
^
"_ul"
)
expl
loc
;
let
span
=
Dom_html
.
getElementById
(
id
^
"_container"
)
in
span
##
onclick
<-
Dom
.
handler
(
fun
ev
->
let
ctrl
=
Js
.
to_bool
(
ev
##
ctrlKey
)
in
if
Hashtbl
.
mem
task_selection
id
then
if
ctrl
then
begin
Hashtbl
.
remove
task_selection
id
;
(
span
##
classList
)
##
remove
(
Js
.
string
"task-selected"
);
end
else
task_deselect
()
else
begin
if
not
ctrl
then
task_deselect
()
;
Hashtbl
.
add
task_selection
id
span
;
(
span
##
classList
)
##
add
(
Js
.
string
"task-selected"
)
end
;
Js
.
_false
)
end
|
UpdateStatus
(
st
,
id
)
->
try
let
span_icon
=
Dom_html
.
getElementById
(
id
^
"_icon"
)
in
...
...
@@ -224,7 +261,9 @@ let init_why3_worker () =
Console
.
print_why3_output
msg
;
let
()
=
match
msg
with
Task
(
id
,_,_,
code
,_
)
->
push_task
(
Goal
(
id
,
code
))
Task
(
id
,_,_,
code
,_
)
->
log
(
"Got task "
^
id
);
push_task
(
Goal
(
id
,
code
))
|
_
->
()
in
Js
.
_false
));
worker
...
...
@@ -250,15 +289,39 @@ let why3_execute () =
let
code
=
Console
.
get_buffer
()
in
(
get_why3_worker
()
)
##
postMessage
(
marshal
(
ExecuteBuffer
code
))
let
array_for_all
a
f
=
let
rec
loop
i
n
=
if
i
<
n
then
(
f
a
.
(
i
))
&&
loop
(
i
+
1
)
n
else
true
in
loop
0
(
Array
.
length
a
)
let
alt_ergo_not_running
()
=
array_for_all
!
alt_ergo_workers
(
function
Busy
_
->
false
|
_
->
true
)
let
why3_transform
tr
f
()
=
if
alt_ergo_not_running
()
then
begin
Hashtbl
.
iter
(
fun
id
_
->
f
id
;
(
get_why3_worker
()
)
##
postMessage
(
marshal
(
Transform
(
tr
,
id
))))
Console
.
task_selection
;
Console
.
task_deselect
()
end
let
()
=
add_button
"prove"
why3_parse
;
add_button
"prove
_all
"
why3_parse
;
add_button
"run"
why3_execute
;
add_button
"stop"
(
fun
()
->
(
get_why3_worker
()
)
##
terminate
()
;
why3_worker
:=
Some
(
init_why3_worker
()
);
reset_workers
()
;
Console
.
set_abort_icon
()
);
add_button
"prove"
(
why3_transform
`Prove
(
fun
_
->
()
));
add_button
"split_prove"
(
why3_transform
`Split
(
fun
_
->
()
));
add_button
"clean"
(
why3_transform
`Clean
Console
.
clean_task
);
let
input_threads
=
get_opt
Dom_html
.(
CoerceTo
.
input
(
getElementById
"input-num-threads"
))
...
...
@@ -302,7 +365,9 @@ let add_file_example (buttonname, file) =
let
loaded
=
Filename
.
basename
file
in
Js
.
Unsafe
.
set
global
(
Js
.
string
"loadedFilename"
)
(
Js
.
string
loaded
);
ignore
(
Js
.
Unsafe
.
meth_call
global
"replaceWithLoaded"
[
|
|
]);
Console
.
clear
()
;
ignore
(
Js
.
Unsafe
.
meth_call
editor
"focus"
[
|
|
]);
Js
.
_false
)
in
let
button
=
...
...
src/trywhy3/why3_worker.ml
View file @
53b2d976
...
...
@@ -51,8 +51,15 @@ let alt_ergo_driver : Driver.driver =
let
()
=
log_time
(
"Initialising why3 worker: end "
)
(* *** *)
type
task_info
=
{
task
:
[
`Theory
of
Theory
.
theory
|
`Task
of
Task
.
task
];
parent_id
:
id
;
mutable
status
:
status
;
mutable
subtasks
:
id
list
;
loc
:
loc
list
;
expl
:
string
;
}
let
task_table
=
Hashtbl
.
create
17
let
task_table
:
(
id
,
task_info
)
Hashtbl
.
t
=
Hashtbl
.
create
17
let
split_trans
=
Trans
.
lookup_transform_l
"split_goal_wp"
env
...
...
@@ -68,7 +75,6 @@ let gen_id =
let
send
msg
=
ignore
(
Worker
.
post_message
(
marshal
msg
))
let
get_loc
l
=
match
l
with
Some
(
l
)
->
...
...
@@ -77,52 +83,96 @@ let get_loc l =
|
_
->
None
let
send
_task
parent_id
task
=
let
register
_task
parent_id
task
=
let
id
=
gen_id
()
in
let
()
=
Hashtbl
.
add
task_table
id
(
`Task
(
task
)
,
parent_id
,
`New
,
[]
)
in
let
vid
,
expl
,
_
=
Termcode
.
goal_expl_task
~
root
:
false
task
in
let
expl
=
match
expl
with
|
Some
s
->
s
|
None
->
vid
.
Ident
.
id_string
in
let
msg
=
Task
(
id
,
parent_id
,
expl
,
task_to_string
task
,
[
(* TODO *)
])
in
send
msg
;
send
(
UpdateStatus
(
`New
,
id
));
let
task_info
=
{
task
=
`Task
(
task
);
parent_id
=
parent_id
;
status
=
`New
;
subtasks
=
[]
;
loc
=
[
(* todo *)
];
expl
=
expl
}
in
Hashtbl
.
add
task_table
id
task_info
;
id
let
get_task
=
function
`Task
t
->
t
|
`Theory
_
->
log
(
"called get_task on a theory !"
);
assert
false
let
rec
set_status
id
st
=
try
let
info
=
Hashtbl
.
find
task_table
id
in
if
info
.
status
<>
st
then
begin
info
.
status
<-
st
;
send
(
UpdateStatus
(
st
,
id
));
let
par_info
=
Hashtbl
.
find
task_table
info
.
parent_id
in
let
has_new
,
has_unknown
=
List
.
fold_left
(
fun
(
an
,
au
)
id
->
let
info
=
Hashtbl
.
find
task_table
id
in
(
an
||
info
.
status
=
`New
)
,
(
au
||
info
.
status
=
`Unknown
))
(
false
,
false
)
par_info
.
subtasks
in
let
par_status
=
if
has_new
then
`New
else
if
has_unknown
then
`Unknown
else
`Valid
in
if
par_info
.
status
<>
par_status
then
set_status
info
.
parent_id
par_status
end
with
Not_found
->
()
let
rec
why3_prove
id
=
let
t
=
Hashtbl
.
find
task_table
id
in
match
t
.
subtasks
with
[]
->
t
.
status
<-
`Unknown
;
let
task
=
get_task
t
.
task
in
let
msg
=
Task
(
id
,
t
.
parent_id
,
t
.
expl
,
task_to_string
task
,
t
.
loc
)
in
send
msg
;
set_status
id
`New
|
l
->
List
.
iter
why3_prove
l
let
why3_split
id
=
try
let
t
ask
,
parent_id
,_,
subtasks
=
Hashtbl
.
find
task_table
id
in
match
subtasks
with
let
t
=
Hashtbl
.
find
task_table
id
in
match
t
.
subtasks
with
[]
->
let
subtasks
=
Trans
.
apply
split_trans
(
get_task
task
)
in
send
(
UpdateStatus
(
`New
,
id
));
let
sub_ids
=
List
.
fold_left
(
fun
acc
t
->
(
send_task
id
t
)
::
acc
)
[]
subtasks
in
Hashtbl
.
replace
task_table
id
(
task
,
parent_id
,
`New
,
sub_ids
)
let
subtasks
=
Trans
.
apply
split_trans
(
get_task
t
.
task
)
in
t
.
subtasks
<-
List
.
fold_left
(
fun
acc
t
->
let
tid
=
register_task
id
t
in
why3_prove
tid
;
tid
::
acc
)
[]
subtasks
|
_
->
()
with
Not_found
->
log
(
"No task with id "
^
id
)
let
set_status
st
id
=
let
rec
clean_task
id
=
try
let
task
,
parent_id
,
_
,
subs
=
Hashtbl
.
find
task_table
id
in
Hashtbl
.
replace
task_table
id
(
task
,
parent_id
,
st
,
subs
);
let
_
,_,_,
depends
=
Hashtbl
.
find
task_table
parent_id
in
send
(
UpdateStatus
(
st
,
id
));
if
List
.
for_all
(
fun
cid
->
try
match
Hashtbl
.
find
task_table
cid
with
(
_
,
_
,
`Valid
,
_
)
->
true
|
_
->
false
with
Not_found
->
false
)
depends
then
send
(
UpdateStatus
(
`Valid
,
parent_id
))
let
info
=
Hashtbl
.
find
task_table
id
in
List
.
iter
clean_task
info
.
subtasks
;
Hashtbl
.
remove
task_table
id
with
Not_found
->
log
(
"No task with id "
^
id
)
Not_found
->
()
let
why3_clean
id
=
try
let
t
=
Hashtbl
.
find
task_table
id
in
List
.
iter
clean_task
t
.
subtasks
;
t
.
subtasks
<-
[]
;
set_status
id
`Unknown
;
with
Not_found
->
()
let
why3_parse_theories
theories
=
let
theories
=
...
...
@@ -140,8 +190,16 @@ let why3_parse_theories theories =
let
()
=
send
(
Theory
(
th_id
,
th_name
))
in
send
(
UpdateStatus
(
`New
,
th_id
));
let
tasks
=
Task
.
split_theory
th
None
None
in
let
task_ids
=
List
.
fold_left
(
fun
acc
t
->
(
send_task
th_id
t
)
::
acc
)
[]
tasks
in
Hashtbl
.
add
task_table
th_id
(
`Theory
(
th
)
,
"theory-list"
,
`New
,
task_ids
)
let
task_ids
=
List
.
fold_left
(
fun
acc
t
->
let
tid
=
register_task
th_id
t
in
why3_prove
tid
;
tid
::
acc
)
[]
tasks
in
Hashtbl
.
add
task_table
th_id
{
task
=
`Theory
(
th
);
parent_id
=
"theory-list"
;
status
=
`New
;
subtasks
=
task_ids
;
loc
=
[
(* todo *)
];
expl
=
th_name
}
)
theories
let
execute_symbol
m
fmt
ps
=
...
...
@@ -255,14 +313,15 @@ let () =
let
ev
=
unmarshal
ev
in
log_time
(
"After unmarshal "
);
match
ev
with
|
Transform
(
`Split
,
id
)
->
why3_split
id
|
Transform
(
`Split
,
id
)
->
why3_split
id
|
Transform
(
`Prove
,
id
)
->
why3_prove
id
|
Transform
(
`Clean
,
id
)
->
why3_clean
id
|
ParseBuffer
code
->
Hashtbl
.
clear
task_table
;
why3_run
why3_parse_theories
Env
.
base_language
code
|
ExecuteBuffer
code
->
why3_run
why3_execute
Mlw_module
.
mlw_language
code
|
SetStatus
(
st
,
id
)
->
set_status
st
id
|
SetStatus
(
st
,
id
)
->
set_status
id
st
)
(*
Local Variables:
...
...
src/trywhy3/worker_proto.ml
View file @
53b2d976
...
...
@@ -3,7 +3,7 @@ type loc = int * int * int * int
type
status
=
[
`New
|
`Valid
|
`Unknown
]
type
why3_command
=
ParseBuffer
of
string
|
ExecuteBuffer
of
string
|
Transform
of
[
`
Split
]
*
id
|
Transform
of
[
`
Prove
|
`Split
|
`Clean
]
*
id
|
SetStatus
of
status
*
id
type
why3_output
=
Error
of
string
(* msg *)
...
...
@@ -11,7 +11,7 @@ type why3_output = Error of string (* msg *)
|
Theory
of
id
*
string
(* Theory (id, name) *)
|
Task
of
(
id
*
id
*
string
*
string
*
loc
list
)
(* id, parent id, expl, code, location list *)
|
Result
of
string
list
|
UpdateStatus
of
status
*
id
|
UpdateStatus
of
status
*
id
type
prover_command
=
OptionSteps
of
int
|
Goal
of
id
*
string
type
prover_output
=
Valid
|
Unknown
of
string
|
Invalid
of
string
...
...
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