From Undecidability.L Require Import Tactics.Computable Lproc Lbeta ComputableTime mixedTactics.
(* *** Lrewrite: simplification with correctness statements*)
(* This module simplifies L-terms by rewriting with correctness-lemmatas form the hint library Lrewrite *)
(* For Time Complexity: *)
Ltac find_Lrewrite_lemma :=
match goal with
|- ?R ?s _ => has_no_evar s;solve [eauto 20 with Lrewrite nocore|eassumption]
end.
Hint Extern 0 (proc _) => solve [Lproc] : Lrewrite.
Hint Extern 0 (lambda _) => solve [Lproc] : Lrewrite.
Hint Extern 0 (closed _) => solve [Lproc] : Lrewrite.
Hint Extern 0 (_ >(<= _ ) _) => eapply pow_redLe_subrelation : Lrewrite.
Hint Extern 0 (_ >* _) => eapply redLe_star_subrelation : Lrewrite.
Hint Extern 0 (_ >* _) => eapply eval_star_subrelation : Lrewrite.
(* replace int by intT if possible*)
Ltac Ltransitivity :=
once lazymatch goal with
| |- _ >(<= _ ) _ => eapply redLe_trans
| |- _ >* _ => eapply star_trans
| |- _ >(_) _ => eapply pow_add with (R:=step)
| |- ?t => fail "not supported by Ltransitivity:" t
end.
(* generate all goals for bottom-up-rewriting*)
Ltac Lrewrite_generateGoals :=
once lazymatch goal with
| |- app _ _ >(<= _ ) _ => eapply redLe_app_helper;[instantiate;Lrewrite_generateGoals..|idtac]
| |- app _ _ >* _ => eapply pow_app_helper  ;[instantiate;Lrewrite_generateGoals..|idtac]
| |- ?s >(<= _ ) _ => (is_evar s;fail 10000) ||idtac
| |- ?s >* _ => (is_evar s;reflexivity) ||idtac
end.
Ltac useFixHypo :=
once lazymatch goal with
|- ?s >* ?t =>
has_no_evar s;
let IH := fresh "IH" in
unshelve epose (IH:=_);[|(notypeclasses refine (_:{v:term & computesExp _ _ s v}));solve [eauto]|];
let v := constr:(projT1 IH) in
assert (IHR := fst (projT2 IH));
let IHInts := constr:( snd (projT2 IH)) in
once lazymatch type of IHInts with
computes ?ty _ ?v =>
change v with (@ext _ ty _ (Build_computable IHInts)) in IHR;exact (proj1 IHR)
end
| |- ?s >(<= ?i ) ?t=>
has_no_evar s;
let IH := fresh "IH" in
unshelve epose (IH:=_);[|(notypeclasses refine (_:{v:term & computesTimeExp _ _ s _ v _}));solve [eauto]|];
let v := constr:(projT1 IH) in
assert (IHR := fst (projT2 IH));
let IHInts := constr:( snd (projT2 IH)) in
once lazymatch type of IHInts with
computesTime ?ty _ ?v _=>
change v with (@extT _ ty _ _ (Build_computableTime IHInts)) in IHR;exact (proj1 IHR)
end
end.
Ltac LrewriteTime_solveGoals :=
try find_Lrewrite_lemma;
try useFixHypo;
once lazymatch goal with
(* Computability: *)
| |- @ext _ (@TyB _ _)  _ ?inted >* _ =>
(progress rewrite (ext_is_enc);[>LrewriteTime_solveGoals..]) || Lreflexivity
| |- app (@ext _ (_ ~> _ ) _ _) (ext _) >* _ => etransitivity;[apply extApp|LrewriteTime_solveGoals]
| |- app (@ext _ (_ ~> _ ) _ ?ints) (@enc _ ?reg ?x) >* ?v =>
change (app (@ext _ _ _ ints) (@ext _ _ _ (reg_is_ext reg x)) >* v);LrewriteTime_solveGoals
(* Complexity*)
| |- @extT _ (@TyB _ _) _ _ ?inted >(<= _ ) _ =>
(progress rewrite (extT_is_enc);[>LrewriteTime_solveGoals..]) || Lreflexivity
| |- app (@extT _ (_ ~> _ ) _ _ ?fInts) (@extT _ _ _ _ ?xInts) >(<= _ ) _ => eapply redLe_trans;
[let R := fresh "R" in
specialize (extTApp fInts xInts) as R;
once lazymatch type of R with
(* As we might build n using the projection on an on-ty-fly constructed computableTime-instance, we mustavoid it to depend on the proof that the time function is correct*)
?s >(<= ?n) ?t => let n' := eval unfold evalTime in n in
change (s >(<= n') t) in R
end; exact R
|LrewriteTime_solveGoals]
| |- app (@extT _ (_ ~> _ ) _ _ ?ints) (@enc _ ?reg ?x) >(<= ?k ) ?v =>
change (app (@extT _ _ _ _ ints) (@extT _ _ _ _ (reg_is_extT reg x)) >(<= k) v);LrewriteTime_solveGoals
(*| xInts : computes ?ty ?x ?xInt _ |- ?R ?xInt ?res => change (R (@ext _ _ x (Build_computable xInts)) res) ;reflexivity*)
(* Correctness Lemmatas: *)
(* do nothing to debug: use idtac here!*)
| |- _ >(<= _ ) _ => Lreflexivity (* TO DEBUG: use idtac here*)
| |- _ >* _ => reflexivity (* TO DEBUG: use idtac here*)
end.
Ltac Lrewrite_old tt:=
once lazymatch goal with
|- ?rel ?s _ =>
once lazymatch goal with
| |- _ >(<=_) _ =>
try (eapply redLe_trans;[Lrewrite_generateGoals;[>LrewriteTime_solveGoals..]|])
| |- _ >* _ =>
try (etransitivity;[Lrewrite_generateGoals;[>LrewriteTime_solveGoals..]|])
end;
once lazymatch goal with
|- ?rel s _ => fail "No Progress (progress in indices are not currently noticed...)"
(* don;t change evars if you did not make progress!*)
| |- _ => idtac
end
| |- _ => idtac
end.
Ltac Lrewrite_wrapper k:=
once lazymatch goal with
| |- _ >(<= _) _ => k idtac
| |- _ ⇓(<= _) _ => try (eapply evalLe_trans;[progress (Lrewrite_wrapper k);Lreflexivity|])
| |- _ ⇓( _) _ => idtac "Lrewrite_prepare does not support s ⇓(k) y, only s ⇓(<=k) t)" (*try (eapply evalIn_trans;[progress Lrewrite_prepare;Lreflexivity|])*)
| |- _ >(_) _ => idtac "Lrewrite_prepare does not support s >(k) y, only s >(<=k) t)"
| |- _ >* _ => k idtac(* Lrewrite_prepare_old *)
| |- eval _ _ => try (eapply eval_helper;[progress (Lrewrite_wrapper k);Lreflexivity|])
| |- _ == _ => try (progress (eapply Lrewrite_equiv_helper;[try (Lrewrite_wrapper k);reflexivity..|]))
end.
Ltac Lrewrite := Lrewrite_wrapper Lrewrite_old.
Tactic Notation "Lrewrite" "in" hyp(_H) :=
once lazymatch type of _H with
| _ == _ => eapply Lrewrite_in_helper in _H; [ |try Lrewrite;reflexivity |try Lrewrite;reflexivity]
| _ >* _ => idtac "not supported yet"
end.

Lemma ext_rel_helper X `(H:registered X) (x:X) (inst : computable x) (R: term -> term -> Prop) u:
R (enc x) u -> R (@ext _ _ _ inst) u.