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
Joshua Yanovski
iris-coq
Commits
8d840a4b
Commit
8d840a4b
authored
Jan 05, 2016
by
Ralf Jung
Browse files
find_redex: complicated and not useful
parent
25e9b4b1
Changes
1
Hide whitespace changes
Inline
Side-by-side
channel/heap_lang.v
View file @
8d840a4b
...
...
@@ -189,163 +189,6 @@ Proof.
clear
-
Hv
'
.
intros
(
σ'
&
e
''
&
σ''
&
ef
&
Hstep
).
destruct
Hstep
;
simpl
in
*
;
discriminate
.
Qed
.
(
*
TODO
RJ
:
Isn
'
t
there
a
shorter
way
to
define
this
?
Or
maybe
we
don
'
t
need
it
?
*
)
Fixpoint
find_redex
(
e
:
expr
)
:
option
(
ectx
*
expr
)
:=
match
e
with
|
Var
_
=>
None
|
Lit
_
_
=>
None
|
App
e1
e2
=>
match
find_redex
e1
with
|
Some
(
K
'
,
e
'
)
=>
Some
(
AppLCtx
K
'
e2
,
e
'
)
|
None
=>
match
find_redex
e2
,
e2v
e1
with
|
Some
(
K
'
,
e
'
),
Some
v1
=>
Some
(
AppRCtx
v1
K
'
,
e
'
)
|
None
,
Some
(
LamV
e1
'
)
=>
match
e2v
e2
with
|
Some
v2
=>
Some
(
EmptyCtx
,
App
e1
e2
)
|
None
=>
None
end
|
_
,
_
=>
None
(
*
cannot
happen
*
)
end
end
|
Lam
_
=>
None
|
Pair
e1
e2
=>
match
find_redex
e1
with
|
Some
(
K
'
,
e
'
)
=>
Some
(
PairLCtx
K
'
e2
,
e
'
)
|
None
=>
match
find_redex
e2
,
e2v
e1
with
|
Some
(
K
'
,
e
'
),
Some
v1
=>
Some
(
PairRCtx
v1
K
'
,
e
'
)
|
_
,
_
=>
None
end
end
|
Fst
e
=>
match
find_redex
e
with
|
Some
(
K
'
,
e
'
)
=>
Some
(
FstCtx
K
'
,
e
'
)
|
None
=>
match
e2v
e
with
|
Some
(
PairV
v1
v2
)
=>
Some
(
EmptyCtx
,
Fst
e
)
|
_
=>
None
end
end
|
Snd
e
=>
match
find_redex
e
with
|
Some
(
K
'
,
e
'
)
=>
Some
(
SndCtx
K
'
,
e
'
)
|
None
=>
match
e2v
e
with
|
Some
(
PairV
v1
v2
)
=>
Some
(
EmptyCtx
,
Snd
e
)
|
_
=>
None
end
end
|
InjL
e
=>
'
(
e
'
,
K
'
)
←
find_redex
e
;
Some
(
InjLCtx
e
'
,
K
'
)
|
InjR
e
=>
'
(
e
'
,
K
'
)
←
find_redex
e
;
Some
(
InjRCtx
e
'
,
K
'
)
|
Case
e0
e1
e2
=>
match
find_redex
e0
with
|
Some
(
K
'
,
e
'
)
=>
Some
(
CaseCtx
K
'
e1
e2
,
e
'
)
|
None
=>
match
e2v
e0
with
|
Some
(
InjLV
v0
'
)
=>
Some
(
EmptyCtx
,
Case
e0
e1
e2
)
|
Some
(
InjRV
v0
'
)
=>
Some
(
EmptyCtx
,
Case
e0
e1
e2
)
|
_
=>
None
end
end
end
.
Lemma
find_redex_found
e
K
'
e
'
:
find_redex
e
=
Some
(
K
'
,
e
'
)
->
reducible
e
'
/
\
e
=
fill
K
'
e
'
.
Proof
.
revert
K
'
e
'
;
induction
e
;
intros
K
'
e
'
;
simpl
;
try
discriminate
.
-
destruct
(
find_redex
e1
)
as
[[
K1
'
e1
'
]
|
].
+
intros
Heq
;
inversion
Heq
.
edestruct
IHe1
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
+
destruct
(
find_redex
e2
)
as
[[
K2
'
e2
'
]
|
].
*
case_eq
(
e2v
e1
);
[
|
discriminate
];
intros
v1
Hv1
.
intros
Heq
;
inversion
Heq
.
edestruct
IHe2
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
using
f_equal2
,
e2e
.
*
case_eq
(
e2v
e1
);
[
|
discriminate
];
intros
v1
Hv1
;
destruct
v1
;
try
discriminate
;
[].
case_eq
(
e2v
e2
);
[
|
discriminate
];
intros
v2
Hv2
.
apply
e2e
in
Hv1
.
apply
e2e
in
Hv2
.
intros
Heq
;
inversion
Heq
;
subst
.
split
;
[
|
reflexivity
].
do
4
eexists
.
eapply
Beta
with
(
σ
:=
tt
),
v2v
.
-
destruct
(
find_redex
e1
)
as
[[
K1
'
e1
'
]
|
].
+
intros
Heq
;
inversion
Heq
.
edestruct
IHe1
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
+
destruct
(
find_redex
e2
)
as
[[
K2
'
e2
'
]
|
];
[
|
discriminate
].
case_eq
(
e2v
e1
);
[
|
discriminate
];
intros
v1
Hv1
.
intros
Heq
;
inversion
Heq
.
edestruct
IHe2
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
using
f_equal2
,
e2e
.
-
destruct
(
find_redex
e
)
as
[[
K1
'
e1
'
]
|
].
+
intros
Heq
;
inversion
Heq
.
edestruct
IHe
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
+
case_eq
(
e2v
e
);
[
|
discriminate
];
intros
v1
Hv1
;
destruct
v1
;
try
discriminate
;
[].
apply
e2e
in
Hv1
.
intros
Heq
;
inversion
Heq
;
subst
.
split
;
[
|
reflexivity
].
do
4
eexists
.
eapply
FstS
with
(
σ
:=
tt
);
fold
v2e
;
eapply
v2v
.
(
*
RJ
:
Why
do
I
have
to
fold
here
?
*
)
-
destruct
(
find_redex
e
)
as
[[
K1
'
e1
'
]
|
].
+
intros
Heq
;
inversion
Heq
.
edestruct
IHe
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
+
case_eq
(
e2v
e
);
[
|
discriminate
];
intros
v1
Hv1
;
destruct
v1
;
try
discriminate
;
[].
apply
e2e
in
Hv1
.
intros
Heq
;
inversion
Heq
;
subst
.
split
;
[
|
reflexivity
].
do
4
eexists
.
eapply
SndS
with
(
σ
:=
tt
);
fold
v2e
;
eapply
v2v
.
(
*
RJ
:
Why
do
I
have
to
fold
here
?
*
)
-
destruct
(
find_redex
e
)
as
[[
K1
'
e1
'
]
|
];
simpl
;
[
|
discriminate
].
intros
Heq
;
inversion
Heq
.
edestruct
IHe
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
-
destruct
(
find_redex
e
)
as
[[
K1
'
e1
'
]
|
];
simpl
;
[
|
discriminate
].
intros
Heq
;
inversion
Heq
.
edestruct
IHe
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
-
destruct
(
find_redex
e
)
as
[[
K1
'
e1
'
]
|
];
simpl
.
+
intros
Heq
;
inversion
Heq
.
edestruct
IHe
;
[
reflexivity
|
].
simpl
;
subst
;
eauto
.
+
case_eq
(
e2v
e
);
[
|
discriminate
];
intros
v1
Hv1
;
destruct
v1
;
try
discriminate
;
[
|
];
apply
e2e
in
Hv1
.
*
intros
Heq
;
inversion
Heq
;
subst
.
split
;
[
|
reflexivity
].
do
4
eexists
.
eapply
CaseL
with
(
σ
:=
tt
),
v2v
.
*
intros
Heq
;
inversion
Heq
;
subst
.
split
;
[
|
reflexivity
].
do
4
eexists
.
eapply
CaseR
with
(
σ
:=
tt
),
v2v
.
Qed
.
Lemma
find_redex_reducible
e
K
'
e
'
:
find_redex
e
=
Some
(
K
'
,
e
'
)
->
reducible
e
'
.
Proof
.
eapply
find_redex_found
.
Qed
.
Lemma
find_redex_fill
e
K
'
e
'
:
find_redex
e
=
Some
(
K
'
,
e
'
)
->
e
=
fill
K
'
e
'
.
Proof
.
eapply
find_redex_found
.
Qed
.
Lemma
stuck_find_redex
e
:
stuck
e
->
find_redex
e
=
None
.
Proof
.
intros
Hstuck
.
case_eq
(
find_redex
e
);
[
|
reflexivity
].
intros
[
K
'
e
'
]
Hfind
.
exfalso
.
eapply
Hstuck
;
eauto
using
find_redex_fill
,
find_redex_reducible
.
Qed
.
Lemma
find_redex_val
e
v
:
e2v
e
=
Some
v
->
find_redex
e
=
None
.
Proof
.
intros
Heq
.
apply
e2e
in
Heq
.
subst
.
eauto
using
stuck_find_redex
,
values_stuck
.
Qed
.
Lemma
reducible_find_redex
{
e
K
'
e
'
}
:
e
=
fill
K
'
e
'
->
reducible
e
'
->
find_redex
e
=
Some
(
K
'
,
e
'
).
Proof
.
revert
e
;
induction
K
'
=>
e
Hfill
Hred
;
subst
e
;
simpl
.
-
(
*
Base
case
:
Empty
context
*
)
destruct
Hred
as
(
σ'
&
e
''
&
σ''
&
ef
&
Hstep
).
destruct
Hstep
;
simpl
.
+
erewrite
find_redex_val
by
eassumption
.
by
rewrite
Hv2
.
+
erewrite
find_redex_val
by
eassumption
.
erewrite
find_redex_val
by
eassumption
.
by
rewrite
Hv1
Hv2
.
+
erewrite
find_redex_val
by
eassumption
.
erewrite
find_redex_val
by
eassumption
.
by
rewrite
Hv1
Hv2
.
+
erewrite
find_redex_val
by
eassumption
.
by
rewrite
Hv0
.
+
erewrite
find_redex_val
by
eassumption
.
by
rewrite
Hv0
.
-
by
erewrite
IHK
'
.
-
erewrite
find_redex_val
by
eapply
v2v
.
by
erewrite
IHK
'
;
rewrite
?
v2v
.
-
by
erewrite
IHK
'
.
-
erewrite
find_redex_val
by
eapply
v2v
.
by
erewrite
IHK
'
;
rewrite
?
v2v
.
-
by
erewrite
IHK
'
.
-
by
erewrite
IHK
'
.
-
by
erewrite
IHK
'
.
-
by
erewrite
IHK
'
.
-
by
erewrite
IHK
'
.
Qed
.
Lemma
find_redex_stuck
e
:
find_redex
e
=
None
->
stuck
e
.
Proof
.
intros
Hfind
K
'
e
'
Hstuck
Hred
.
cut
(
find_redex
e
=
Some
(
K
'
,
e
'
)).
{
by
rewrite
Hfind
.
}
by
eapply
reducible_find_redex
.
Qed
.
Lemma
fill_not_value
e
K
:
e2v
e
=
None
->
e2v
(
fill
K
e
)
=
None
.
...
...
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