Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
FP
Stacked Borrows Coq
Commits
f9c9f0a8
Commit
f9c9f0a8
authored
Jul 07, 2019
by
Ralf Jung
Browse files
well-formedness
parent
80572367
Changes
11
Hide whitespace changes
Inline
Side-by-side
theories/lang/lang_base.v
View file @
f9c9f0a8
...
...
@@ -286,9 +286,9 @@ Qed.
(
**
Global
static
function
table
*
)
Record
function
:=
FunV
{
fun_
b
:
list
binder
;
fun_
e
:
expr
;
fun_closed:
Closed
(
fun_
b
+
b
+
[])
fun_
e
fun_
args
:
list
binder
;
fun_
body
:
expr
;
fun_closed:
Closed
(
fun_
args
+
b
+
[])
fun_
body
}
.
Arguments
FunV
_
_
{
_
}
.
Definition
fn_env
:=
gmap
fn_id
function
.
...
...
theories/opt/ex1.v
View file @
f9c9f0a8
...
...
@@ -59,7 +59,7 @@ Admitted.
(
**
Top
-
level
theorem
:
Two
programs
that
only
differ
in
the
"ex1"
function
are
related
.
*
)
Lemma
ex1
(
prog
:
fn_env
)
:
Corollary
ex1
(
prog
:
fn_env
)
:
stuck_decidable
→
has_main
prog
→
let
prog_src
:=
<
[
"ex1"
:=
ex1_unopt
]
>
prog
in
...
...
theories/opt/ex1_down.v
View file @
f9c9f0a8
...
...
@@ -23,13 +23,6 @@ Definition ex1_down_opt : function :=
.
Lemma
ex1_down_sim_fun
fs
ft
:
⊨ᶠ
{
fs
,
ft
}
ex1_down
≥
ex1_down_opt
.
Lemma
ex1_down_sim_fun
:
⊨ᶠ
ex1_down
≥
ex1_down_opt
.
Proof
.
intros
r
es
et
vls
vlt
σ
s
σ
t
FREL
SUBSTs
SUBSTt
.
destruct
vls
as
[
|
vs
[]];
[
done
|
|
done
].
simpl
in
SUBSTs
.
destruct
vlt
as
[
|
vt
[]];
[
done
|
|
done
].
simpl
in
SUBSTt
.
simplify_eq
.
(
*
InitCall
*
)
exists
10
%
nat
.
apply
sim_body_init_call
.
simpl
.
Abort
.
theories/opt/ex2.v
View file @
f9c9f0a8
...
...
@@ -24,6 +24,6 @@ Definition ex2_opt : function :=
"v"
.
Lemma
ex2_sim_body
fs
ft
:
⊨ᶠ
{
fs
,
ft
}
ex2
≥
ex2_opt
.
Lemma
ex2_sim_body
:
⊨ᶠ
ex2
≥
ex2_opt
.
Proof
.
Abort
.
theories/opt/ex2_down.v
View file @
f9c9f0a8
...
...
@@ -23,13 +23,6 @@ Definition ex2_down_opt : function :=
.
Lemma
ex2_down_sim_fun
fs
ft
:
⊨ᶠ
{
fs
,
ft
}
ex2_down
≥
ex2_down_opt
.
Lemma
ex2_down_sim_fun
:
⊨ᶠ
ex2_down
≥
ex2_down_opt
.
Proof
.
intros
r
es
et
vls
vlt
σ
s
σ
t
FREL
SUBSTs
SUBSTt
.
destruct
vls
as
[
|
vs
[]];
[
done
|
|
done
].
simpl
in
SUBSTs
.
destruct
vlt
as
[
|
vt
[]];
[
done
|
|
done
].
simpl
in
SUBSTt
.
simplify_eq
.
(
*
InitCall
*
)
exists
10
%
nat
.
apply
sim_body_init_call
.
simpl
.
Abort
.
theories/opt/ex3.v
View file @
f9c9f0a8
...
...
@@ -32,13 +32,6 @@ Definition ex3_opt_2 : function :=
Call
#[
ScFnPtr
"f"
]
[]
.
Lemma
ex3_sim_fun
fs
ft
:
⊨ᶠ
{
fs
,
ft
}
ex3
≥
ex3_opt_1
.
Lemma
ex3_sim_fun
:
⊨ᶠ
ex3
≥
ex3_opt_1
.
Proof
.
intros
r
es
et
vls
vlt
σ
s
σ
t
FREL
SUBSTs
SUBSTt
.
destruct
vls
as
[
|
vs
[]];
[
done
|
|
done
].
simpl
in
SUBSTs
.
destruct
vlt
as
[
|
vt
[]];
[
done
|
|
done
].
simpl
in
SUBSTt
.
simplify_eq
.
(
*
InitCall
*
)
exists
10
%
nat
.
apply
sim_body_init_call
.
simpl
.
Abort
.
theories/opt/ex3_down.v
View file @
f9c9f0a8
...
...
@@ -34,13 +34,6 @@ Definition ex3_down_opt_2 : function :=
"v"
.
Lemma
ex3_down_sim_fun
fs
ft
:
⊨ᶠ
{
fs
,
ft
}
ex3_down
≥
ex3_down_opt_1
.
Lemma
ex3_down_sim_fun
:
⊨ᶠ
ex3_down
≥
ex3_down_opt_1
.
Proof
.
intros
r
es
et
vls
vlt
σ
s
σ
t
FREL
SUBSTs
SUBSTt
.
destruct
vls
as
[
|
vs
[]];
[
done
|
|
done
].
simpl
in
SUBSTs
.
destruct
vlt
as
[
|
vt
[]];
[
done
|
|
done
].
simpl
in
SUBSTt
.
simplify_eq
.
(
*
InitCall
*
)
exists
10
%
nat
.
apply
sim_body_init_call
.
simpl
.
Abort
.
theories/sim/instance.v
View file @
f9c9f0a8
...
...
@@ -18,7 +18,7 @@ Definition sim_mod_fun f1 f2 :=
Definition
sim_mod_funs
(
fns
fnt
:
fn_env
)
:=
∀
name
fn_src
,
fns
!!
name
=
Some
fn_src
→
∃
fn_tgt
,
fnt
!!
name
=
Some
fn_tgt
∧
length
fn_src
.(
fun_
b
)
=
length
fn_tgt
.(
fun_
b
)
∧
length
fn_src
.(
fun_
args
)
=
length
fn_tgt
.(
fun_
args
)
∧
sim_mod_fun
fn_src
fn_tgt
.
Notation
"⊨ᶠ f1 ≥ f2"
:=
...
...
@@ -27,7 +27,7 @@ Notation "⊨ᶠ f1 ≥ f2" :=
(
**
The
modular
version
permits
insertion
.
*
)
Lemma
sim_local_funs_lookup_insert
fns
fnt
x
fs
ft
:
length
fns
.(
fun_
b
)
=
length
fnt
.(
fun_
b
)
→
length
fns
.(
fun_
args
)
=
length
fnt
.(
fun_
args
)
→
sim_local_funs_lookup
fs
ft
→
sim_local_funs_lookup
(
<
[
x
:=
fns
]
>
fs
)
(
<
[
x
:=
fnt
]
>
ft
).
Proof
.
...
...
@@ -41,7 +41,7 @@ Proof.
Qed
.
Lemma
sim_mod_funs_insert
fs
ft
x
fns
fnt
:
length
fns
.(
fun_
b
)
=
length
fnt
.(
fun_
b
)
→
length
fns
.(
fun_
args
)
=
length
fnt
.(
fun_
args
)
→
(
⊨ᶠ
fns
≥
fnt
)
→
sim_mod_funs
fs
ft
→
sim_mod_funs
(
<
[
x
:=
fns
]
>
fs
)
(
<
[
x
:=
fnt
]
>
ft
).
...
...
theories/sim/local.v
View file @
f9c9f0a8
...
...
@@ -126,8 +126,8 @@ Definition sim_local_fun
(
esat
:
A
→
call_id
→
Prop
)
(
fn_src
fn_tgt
:
function
)
:
Prop
:=
∀
r
es
et
(
vl_src
vl_tgt
:
list
value
)
σ
s
σ
t
(
VALEQ
:
Forall2
(
vrel
r
)
vl_src
vl_tgt
)
(
EQS
:
subst_l
fn_src
.(
fun_
b
)
(
Val
<
$
>
vl_src
)
fn_src
.(
fun_
e
)
=
Some
es
)
(
EQT
:
subst_l
fn_tgt
.(
fun_
b
)
(
Val
<
$
>
vl_tgt
)
fn_tgt
.(
fun_
e
)
=
Some
et
),
(
EQS
:
subst_l
fn_src
.(
fun_
args
)
(
Val
<
$
>
vl_src
)
fn_src
.(
fun_
body
)
=
Some
es
)
(
EQT
:
subst_l
fn_tgt
.(
fun_
args
)
(
Val
<
$
>
vl_tgt
)
fn_tgt
.(
fun_
body
)
=
Some
et
),
∃
idx
,
sim_local_body
r
idx
(
InitCall
es
)
σ
s
(
InitCall
et
)
σ
t
(
fun_post
esat
σ
t
.(
scs
)).
...
...
@@ -135,13 +135,13 @@ Definition sim_local_fun
Definition
sim_local_funs
(
esat
:
A
→
call_id
→
Prop
)
:
Prop
:=
∀
name
fn_src
,
fs
!!
name
=
Some
fn_src
→
∃
fn_tgt
,
ft
!!
name
=
Some
fn_tgt
∧
length
fn_src
.(
fun_
b
)
=
length
fn_tgt
.(
fun_
b
)
∧
length
fn_src
.(
fun_
args
)
=
length
fn_tgt
.(
fun_
args
)
∧
sim_local_fun
esat
fn_src
fn_tgt
.
Definition
sim_local_funs_lookup
:
Prop
:=
∀
name
fn_src
,
fs
!!
name
=
Some
fn_src
→
∃
fn_tgt
,
ft
!!
name
=
Some
fn_tgt
∧
length
fn_src
.(
fun_
b
)
=
length
fn_tgt
.(
fun_
b
).
length
fn_src
.(
fun_
args
)
=
length
fn_tgt
.(
fun_
args
).
Lemma
sim_local_funs_to_lookup
esat
:
sim_local_funs
esat
→
sim_local_funs_lookup
.
...
...
theories/sim/refl.v
View file @
f9c9f0a8
...
...
@@ -3,7 +3,42 @@ From stbor.sim Require Import refl_step.
Set
Default
Proof
Using
"Type"
.
(
**
Enable
use
of
[
Forall
]
in
recursion
.
*
)
Lemma
Forall_id
{
A
:
Type
}
(
P
:
A
→
Prop
)
(
l
:
list
A
)
:
Forall
P
l
↔
Forall
id
(
map
P
l
).
Proof
.
induction
l
;
simpl
;
first
by
eauto
using
Forall_nil
.
split
;
intros
[
??
]
%
Forall_cons_1
;
apply
Forall_cons
;
simpl
;
tauto
.
Qed
.
(
**
"Well-formed"
code
doen
'
t
contain
literal
pointers
,
places
or
administrative
operations
(
init_call
/
end_call
).
Defined
by
recursion
to
make
sure
we
don
'
t
miss
a
case
.
*
)
Fixpoint
scalar_wf
(
a
:
scalar
)
:
Prop
:=
match
a
with
|
ScPoison
|
ScInt
_
|
ScFnPtr
_
=>
True
|
ScnPtr
=>
False
end
.
Definition
value_wf
(
v
:
value
)
:
Prop
:=
Forall
scalar_wf
v
.
Fixpoint
expr_wf
(
e
:
expr
)
:
Prop
:=
match
e
with
(
*
Structural
cases
.
*
)
|
Val
v
=>
value_wf
v
|
Call
f
args
=>
expr_wf
f
∧
Forall
id
(
map
expr_wf
args
)
|
Case
e
branches
=>
expr_wf
e
∧
Forall
id
(
map
expr_wf
branches
)
|
Var
_
|
Alloc
_
=>
True
|
Deref
e
_
|
Ref
e
|
Copy
e
|
Retag
e
_
=>
expr_wf
e
|
Proj
e1
e2
|
Conc
e1
e2
|
BinOp
_
e1
e2
|
Let
_
e1
e2
|
Write
e1
e2
=>
expr_wf
e1
∧
expr_wf
e2
(
*
Forbidden
cases
.
*
)
|
InitCall
e
|
EndCall
e
=>
False
|
Place
_
_
_
=>
False
|
Free
_
=>
False
(
*
TODO
:
We
'
d
like
to
support
deallocation
!
*
)
end
.
Theorem
sim_mod_fun_refl
f
:
expr_wf
f
.(
fun_body
)
→
⊨ᶠ
f
≥
f
.
Proof
.
Admitted
.
...
...
@@ -15,4 +50,4 @@ Proof.
{
intros
??
.
rewrite
lookup_empty
.
done
.
}
apply
sim_mod_funs_insert
;
try
done
.
apply
sim_mod_fun_refl
.
Q
ed
.
Admitt
ed
.
theories/sim/simple.v
View file @
f9c9f0a8
...
...
@@ -45,13 +45,13 @@ Qed.
(
**
Simple
proof
for
a
function
taking
one
argument
.
*
)
(
*
TODO
:
make
the
two
call
stacks
the
same
.
*
)
Lemma
sim_fun_simple1
n
(
esf
etf
:
function
)
:
length
(
esf
.(
fun_
b
))
=
1
%
nat
→
length
(
etf
.(
fun_
b
))
=
1
%
nat
→
length
(
esf
.(
fun_
args
))
=
1
%
nat
→
length
(
etf
.(
fun_
args
))
=
1
%
nat
→
(
∀
fs
ft
rf
es
css
et
cst
vs
vt
,
sim_local_funs_lookup
fs
ft
→
vrel
rf
vs
vt
→
subst_l
(
esf
.(
fun_
b
))
[
Val
vs
]
(
esf
.(
fun_
e
))
=
Some
es
→
subst_l
(
etf
.(
fun_
b
))
[
Val
vt
]
(
etf
.(
fun_
e
))
=
Some
et
→
subst_l
(
esf
.(
fun_
args
))
[
Val
vs
]
(
esf
.(
fun_
body
))
=
Some
es
→
subst_l
(
etf
.(
fun_
args
))
[
Val
vt
]
(
etf
.(
fun_
body
))
=
Some
et
→
rf
⊨ˢ
{
n
,
fs
,
ft
}
(
InitCall
es
,
css
)
≥
(
InitCall
et
,
cst
)
:
fun_post_simple
cst
)
→
⊨ᶠ
esf
≥
etf
.
Proof
.
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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