Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
A
APoCI
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
CI / CD Analytics
Repository Analytics
Value Stream Analytics
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Jobs
Commits
Open sidebar
Adrien KOUTSOS
APoCI
Commits
58e124fc
Commit
58e124fc
authored
Mar 30, 2018
by
Adrien KOUTSOS
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
compressed proofs
parent
65b7a967
Pipeline
#1652
passed with stage
in 2 minutes and 35 seconds
Changes
6
Pipelines
1
Hide whitespace changes
Inline
Sidebyside
Showing
6 changed files
with
76 additions
and
166 deletions
+76
166
src/interactive.ml
src/interactive.ml
+60
64
src/main.ml
src/main.ml
+1
2
src/proof.ml
src/proof.ml
+10
77
src/proof.mli
src/proof.mli
+2
17
src/state.ml
src/state.ml
+2
4
src/state.mli
src/state.mli
+1
2
No files found.
src/interactive.ml
View file @
58e124fc
...
...
@@ 41,54 +41,56 @@ let tact_or a b sk fk =
in the formula). Moreover if two rules have the same index they are applied
in the order they had in r_and_index_list. *)
let
unary_build
proof
r_and_index_list
=
List
.
fold_left
(
fun
(
prev_proof
,
l_fun_error
,
l_error
)
(
rule
,
index
)
>
(* We compute the offset coming from the previously applied rules. *)
let
offset
=
(
Formula
.
length
prev_proof
.
goal
)

(
Formula
.
length
proof
.
goal
)
in
try
let
new_form
=
unary_apply
prev_proof
.
goal
rule
(
index
+
offset
)
in
(* Ignore the rule if the formula is unchanged. *)
if
new_form
<>
prev_proof
.
goal
then
begin
let
new_proof
=
{
goal
=
new_form
;
premises
=
Dangling
;
back_track
=
BT
prev_proof
;
node_type
=
Internal
}
in
prev_proof
.
premises
<
PUnary
(
new_proof
,
index
+
offset
,
rule
);
(
new_proof
,
l_fun_error
,
l_error
)
end
else
(
prev_proof
,
l_fun_error
,
l_error
)
let
(
new_goal
,
l_fun_error
,
l_error
,
i_rule_list
)
=
List
.
fold_left
(
fun
(
goal
,
l_fun_error
,
l_error
,
i_rule_list
)
(
rule
,
index
)
>
(* We compute the offset coming from the previously applied rules. *)
let
offset
=
(
Formula
.
length
goal
)

(
Formula
.
length
proof
.
goal
)
in
with

Rule_not_applicable
>
(
prev_proof
,
l_fun_error
,
(
index
+
offset
)
::
l_error
)
try
(
unary_apply
goal
rule
(
index
+
offset
)
,
l_fun_error
,
l_error
,
(
index
+
offset
,
rule
)
::
i_rule_list
)
with

Rule_not_applicable
>
(
goal
,
l_fun_error
,
(
index
+
offset
)
::
l_error
,
i_rule_list
)

Bad_rule
(
s
,
rule
)
>
let
err_fun
=
fun
()
>
Fmt
.
pf
Fmt
.
stderr
"@[Bad rule:@;%a@;%s@]
\n
@?%!"
print_rule_long
rule
s
in

Bad_rule
(
s
,
rule
)
>
let
err_fun
=
fun
()
>
Fmt
.
pf
Fmt
.
stderr
"@[Bad rule:@;%a@;%s@]
\n
@?%!"
print_rule_long
rule
s
in
(
prev_proof
,
err_fun
::
l_fun_error
,
(
index
+
offset
)
::
l_error
))
(
goal
,
err_fun
::
l_fun_error
,
(
index
+
offset
)
::
l_error
,
i_rule_list
))
(
proof
,
[]
,
[]
)
(
proof
.
goal
,
[]
,
[]
,
[]
)
(* We sort the list in increasing order with respect to the indices.
Therefore, we apply the rules from left to right. *)
(
List
.
stable_sort
(
fun
(
_
,
i
)
(
_
,
j
)
>
Pervasives
.
compare
i
j
)
r_and_index_list
)
(* We sort the list in increasing order with respect to the indices.
Therefore, we apply the rules from left to right. *)
(
List
.
stable_sort
(
fun
(
_
,
i
)
(
_
,
j
)
>
Pervasives
.
compare
i
j
)
r_and_index_list
)
in
(* Ignore the rule if the formula is unchanged. *)
if
new_goal
<>
proof
.
goal
then
begin
let
new_proof
=
{
goal
=
new_goal
;
premises
=
Dangling
;
back_track
=
BT
proof
}
in
proof
.
premises
<
PUnary
(
new_proof
,
List
.
rev
i_rule_list
);
(
new_proof
,
l_fun_error
,
l_error
)
end
else
(
proof
,
l_fun_error
,
l_error
)
(* unary_aux state r_and_index_list:
state: current state of the interactive loop.
r_and_index_list: see unary_build. *)
...
...
@@ 121,14 +123,12 @@ let binary_aux state rule l_prem r_prem sk sk' fk =
let
l_proof
=
{
goal
=
c_bind
proof
.
goal
l_prem
;
premises
=
Dangling
;
back_track
=
BT
proof
;
node_type
=
Internal
}
back_track
=
BT
proof
}
and
r_proof
=
{
goal
=
c_bind
proof
.
goal
r_prem
;
premises
=
Dangling
;
back_track
=
BT
proof
;
node_type
=
Internal
}
in
back_track
=
BT
proof
}
in
proof
.
premises
<
PBinary
(
l_proof
,
r_proof
,
rule
);
(
l_proof
,
r_proof
)
in
...
...
@@ 224,14 +224,14 @@ let apply_dup state =
let
n_proof
=
{
goal
=
n_goal
;
premises
=
Dangling
;
back_track
=
BT
state
.
c_proof
;
node_type
=
Internal
}
in
back_track
=
BT
state
.
c_proof
}
in
state
.
c_proof
.
premises
<
PUnary
(
n_proof
,

1
,
Duplicate
);
state
.
c_proof
<
n_proof
;
end
;
state
.
c_proof
.
premises
<
PUnary
(
n_proof
,
[

1
,
Duplicate
]);
state
;;
{
state
with
c_proof
=
n_proof
}
end
else
state
(* apply_unitary_and_set_feedback state axiom : Try to apply the unitary axiom
'axiom' to the current goal and set the feedback result field in the
...
...
@@ 658,12 +658,11 @@ let extend_unitary : type a. a axiom_type > state > state =
let
n_proof
=
{
goal
=
new_goal
;
premises
=
Dangling
;
back_track
=
BT
state
.
c_proof
;
node_type
=
Internal
}
in
back_track
=
BT
state
.
c_proof
}
in
state
.
c_proof
.
premises
<
PUnary
(
n_proof
,
[

1
,
Restr
]);
state
.
c_proof
.
premises
<
PUnary
(
n_proof
,
1
,
Restr
);
state
.
c_proof
<
n_proof
;
state
;;
{
state
with
c_proof
=
n_proof
}
(******************************)
...
...
@@ 1030,7 +1029,9 @@ let auto_guard state sk fk =
state
in
(* We apply the auto_guard element created *)
guard_decryption_list
state
constr
g_data_list
sk
fk
;;
let
sk'
state
fk
=
sk
(
simplify
~
collect
:
true
state
)
fk
in
guard_decryption_list
state
constr
g_data_list
sk'
fk
;;
(* auto_intro state goal : automatically guard decryption that have missing
...
...
@@ 1663,8 +1664,6 @@ add_c_action
let
try_cca
state
=
let
state
=
simplify
state
in
let
(
state
,
bool_res
)
=
apply_unitary_and_set_feedback
~
print
:
true
CCA
state
in
...
...
@@ 1693,6 +1692,7 @@ add_c_action
extend_unitary
CCA
state
>
simplify
>
auto_intro
CCA
>
simplify
else
simplify
state
in
...
...
@@ 1750,13 +1750,9 @@ let rec exec_cmd_list l state sk fk = match l with
let
rec
interactive_loop
state
sk
fk
=
let
state
=
simplify
~
collect
:
true
state
let
state
=
simplify
state
>
new_screen
in
(* We set the current proof node to be a User node, to allow backtracking
to it. *)
set_user_node
state
.
c_proof
;
Printf
.
printf
"> %!"
;
let
input_string
=
if
state
.
param
.
shell_mode
then
...
...
src/main.ml
View file @
58e124fc
...
...
@@ 99,8 +99,7 @@ let main_interactive () =
List
.
map
(
fun
formula
>
{
goal
=
formula
;
premises
=
Dangling
;
back_track
=
Root
;
node_type
=
User
})
back_track
=
Root
})
formula_list
in
interactive_proof
(
List
.
map
(
State
.
new_state
param
)
proof_list
);;
...
...
src/proof.ml
View file @
58e124fc
...
...
@@ 3,20 +3,17 @@ open Axiom_result
open
Axiom
open
Rule
type
node_type
=
Internal

User
type
proof
=
{
mutable
goal
:
formula
;
mutable
premises
:
inference
;
back_track
:
back_proof
;
mutable
node_type
:
node_type
}
back_track
:
back_proof
}
and
back_proof
=
BT
of
proof

Root
and
inference
=

Dangling

PAxiom
:
_
axiom_type
>
inference

PUnary
of
proof
*
int
*
rule

PUnary
of
proof
*
(
int
*
rule
)
list

PBinary
of
proof
*
proof
*
rule
...
...
@@ 24,75 +21,6 @@ and inference =
(* Proof Tree Navigation *)
(*************************)
let
set_user_node
proof
=
proof
.
node_type
<
User
;;
(* get_danglings proof: Get the danglings leaves from proof. *)
let
get_danglings
proof
=
let
rec
aux
proof
acc
=
match
proof
.
premises
with

Dangling
>
proof
::
acc

PAxiom
_
>
acc

PUnary
(
n_proof
,_,_
)
>
aux
n_proof
acc

PBinary
(
l_proof
,
r_proof
,_
)
>
aux
r_proof
(
aux
l_proof
acc
)
in
aux
proof
[]
(* back_track c_proof danglings: Back track one step from c_proof, and update
accordingly the list of danglings leaves. *)
let
rec
back_track
c_proof
danglings
=
match
c_proof
.
back_track
with

Root
>
(
c_proof
,
danglings
)

BT
father
>
match
father
.
premises
with

Dangling

PAxiom
_
>
failwith
"Back Tracking Error: Not Possible"

PUnary
(
_
,_,_
)
>
if
father
.
node_type
=
User
then
(
father
,
danglings
)
else
back_track
father
danglings

PBinary
(
l_proof
,
r_proof
,_
)
>
let
to_remove
=
if
c_proof
==
l_proof
then
get_danglings
r_proof
else
if
c_proof
==
r_proof
then
get_danglings
l_proof
else
failwith
"Back Tracking Error: badly formed proof tree"
in
let
new_danglings
=
List
.
filter
(
fun
x
>
not
(
List
.
mem
x
to_remove
))
danglings
in
if
father
.
node_type
=
User
then
(
father
,
new_danglings
)
else
back_track
father
new_danglings
exception
Bad_for_track
(* for_track c_proof: Go one step forward into the proof tree c_proof, and give
the new dangling leaves. *)
let
for_track
c_proof
=
let
rec
aux
c_proof
acc
=
match
c_proof
.
premises
with

Dangling

PAxiom
_
>
raise
Bad_for_track

PUnary
(
n_proof
,_,_
)
>
if
n_proof
.
node_type
=
User
then
(
n_proof
,
acc
)
else
aux
n_proof
acc

PBinary
(
l_proof
,
r_proof
,_
)
>
if
l_proof
.
node_type
=
User
then
(
l_proof
,
r_proof
::
acc
)
else
aux
l_proof
(
r_proof
::
acc
)
in
aux
c_proof
[]
let
rec
get_root
proof
=
match
proof
.
back_track
with

Root
>
proof

BT
p_proof
>
get_root
p_proof
...
...
@@ 116,9 +44,14 @@ let rec print_proof_latex channel proof =
print_formula_latex
channel
proof
.
goal
;
fprintf
channel
"}
\n
{}"
;

PUnary
(
n_proof
,
pos
,
rule
)
>
fprintf
channel
"
\\
infer[{
\\
huge
\\
text{%s}(%d)}]{
\n
"
(
rule_to_string
rule
)
pos
;

PUnary
(
n_proof
,
r_list
)
>
fprintf
channel
"
\\
infer[{
\\
huge%a}]{
\n
"
(
fun
chan
list
>
List
.
iter
(
fun
(
pos
,
rule
)
>
fprintf
chan
"
\t
ext{%s}(%d)"
(
rule_to_string
rule
)
pos
)
list
)
r_list
;
print_formula_latex
channel
proof
.
goal
;
fprintf
channel
"}
\n
{
\n
"
;
print_proof_latex
channel
n_proof
;
...
...
src/proof.mli
View file @
58e124fc
...
...
@@ 3,39 +3,24 @@ open Axiom_result
open
Axiom
open
Rule
type
node_type
=
Internal

User
type
proof
=
{
mutable
goal
:
formula
;
mutable
premises
:
inference
;
back_track
:
back_proof
;
mutable
node_type
:
node_type
}
back_track
:
back_proof
}
and
back_proof
=
BT
of
proof

Root
and
inference
=

Dangling

PAxiom
:
_
axiom_type
>
inference

PUnary
of
proof
*
int
*
rule

PUnary
of
proof
*
(
int
*
rule
)
list

PBinary
of
proof
*
proof
*
rule
exception
Bad_for_track
(*************************)
(* Proof Tree Navigation *)
(*************************)
val
set_user_node
:
proof
>
unit
(* back_track c_proof danglings: Back track one step from c_proof, and update
accordingly the list of danglings leaves. *)
val
back_track
:
proof
>
proof
list
>
proof
*
proof
list
(* for_track c_proof: Go one step forward into the proof tree c_proof, and give
the new dangling leaves. *)
val
for_track
:
proof
>
proof
*
proof
list
val
get_root
:
proof
>
proof
...
...
src/state.ml
View file @
58e124fc
...
...
@@ 2,14 +2,13 @@ open Term
open
Proof
(*  c_proof : The current goal.
 danglings : All the other danglings node in the proof tree.
 input_history : The user input history.
 error_message : Error messages to be printed at the next interactive loop.
 l_error_ref : Positions where errors occured in the current interactive
loop.
 param: The parameters of the interactive loop state. *)
type
state
=
{
mutable
c_proof
:
proof
;
{
c_proof
:
proof
;
mutable
input_history
:
string
list
;
error_message
:
unit
>
unit
;
l_error_ref
:
int
list
;
...
...
@@ 27,8 +26,7 @@ let dummy_state () =
let
dummy_proof
=
{
goal
=
dummy_formula
;
premises
=
Dangling
;
back_track
=
Root
;
node_type
=
Internal
}
in
back_track
=
Root
}
in
{
c_proof
=
dummy_proof
;
input_history
=
[]
;
...
...
src/state.mli
View file @
58e124fc
...
...
@@ 10,14 +10,13 @@ open Side
(*********************)
(*  c_proof : The current goal.
 danglings : All the other danglings node in the proof tree.
 input_history : The user input history.
 error_message : Error messages to be printed at the next interactive loop.
 l_error_ref : Positions where errors occured in the current interactive
loop.
 param: The parameters of the interactive loop state. *)
type
state
=
{
mutable
c_proof
:
proof
;
{
c_proof
:
proof
;
mutable
input_history
:
string
list
;
error_message
:
unit
>
unit
;
l_error_ref
:
int
list
;
...
...
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