From Undecidability.L Require Import Util.L_facts.
From Undecidability.L.Tactics Require Import Lproc Reflection.
(* *** Lbeta: symbolic beta reduction *)
(* This module procides tactics to simlify L-term w.r.t beta reduction in L. It does so by the reflective tactic simplify_L' using the module Reflextion. *)
intros R H. now rewrite R.
Defined.
Ltac addToList a l := AddFvTail a l.
Ltac has_no_evar s := try (has_evar s;fail 1).
Ltac reflexivity' :=
match goal with
| |- ?G => has_no_evar G;reflexivity
end.
Ltac Lreflexivity :=
once lazymatch goal with
| |- _ ⇓(<=_) _ => solve [apply (@evalIn_refl 0);Lproc | apply evalIn_refl;Lproc ]
| |- _ >(<= _ ) _ => apply redLe_refl
| |- _ ⇓(?i) _ => unify i 0;split;[reflexivity|Lproc]
| |- _ ⇓ _ => solve [apply eval_refl;Lproc]
| |- _ >* _ => reflexivity
| |- _ >(_) _ => now apply pow0_refl
| |- ?t => fail "not supported by Lreflexivity:" t
end.
Ltac Lbeta' n :=
once lazymatch goal with
|- ?rel ?s _ =>
once lazymatch goal with
| |- _ >(?i) _ => tryif is_evar i
then eapply pow_trans;[simplify_L' n|]
else (eapply pow_trans_eq;[simplify_L' n| |try reflexivity])
| |- _ >(<=?i) _ => tryif is_evar i
then eapply redLe_trans;[apply pow_redLe_subrelation;simplify_L' n|]
else ((eapply redLe_trans_eq;[ | apply pow_redLe_subrelation;simplify_L' n| ]);[try reflexivity | ..])
| |- _ ⇓(<= _) _ => eapply evalLe_trans;[apply pow_redLe_subrelation;simplify_L' n|]
| |- _ ⇓(_) _ => eapply evalIn_trans;[Lbeta' n|]
| |- _ ⇓ _ => eapply eval_helper;[eapply pow_star_subrelation;simplify_L' n|]
| |- _ >* _ => etransitivity;[eapply pow_star_subrelation;simplify_L' n|]
| |- ?G => fail "Not supported for LSimpl (or other failed):" G
end;
once lazymatch goal with
|- ?rel s _ => fail "No Progress (progress in indexes are not currently noticed...)"
| |- _ => idtac
(* don;t change evars if you did not make progress!*)
end
end.
Tactic Notation "Lbeta" := once(Lbeta' 50).
(* test, approx. 2+1 seconds (proof + qed) on w550s Lemma test : (lam 0) (lam 0) >(1 ) (lam 0).  (* legacy: asserts R:= s >* ?t for some reduction of ?t *)
Tactic Notation "standardize" ident(R) constr(n) constr(s) :=
has_no_evar s;
let l := fresh "l" in
let t := fresh "t" in
evar (l : nat);
evar (t : term);
assert (R : s >(l) t) by simplify_L' n;subst l t;apply pow_star in R.
(* Goal I I >* I. *)
(* Proof.  *)
(*   standardize R 100 ((lam 0) (lam 0)); exact R.  *)
(* Qed. *)
Ltac standardizeGoal' _n:=
let R:= fresh "R" in
once lazymatch goal with (* try etransitivity is for debugging, so we can disable ProcPhi iff needed*)
| |- ?s == _ => let R:= fresh "R" in standardize R _n s;try (etransitivity;[exact (star_equiv R)|];clear R)
| |- ?s >* _ => let R:= fresh "R" in standardize R _n s;try (etransitivity;[exact R|];clear R)
end.
Ltac standardizeGoal _n :=
try progress Lbeta' _n;
try progress standardizeGoal' _n;
try progress (symmetry;standardizeGoal' _n;symmetry).

Lemma stHypo s s' t : s >* s' -> s == t -> s' == t.