Commit 7c16a22b authored by Michael Sammler's avatar Michael Sammler
Browse files

only one let binding

TODO: This branch is probably not a good idea since it recreates a lot
of let-bindings instead of sharing them.
parent 2fbd018d
Pipeline #58409 failed with stage
in 8 minutes and 58 seconds
...@@ -298,12 +298,35 @@ Ltac liFresh := ...@@ -298,12 +298,35 @@ Ltac liFresh :=
end. end.
*) *)
Ltac li_let_bind T tac :=
try lazymatch goal with | H := LET_ID _ |- _ => clear H end;
tryif is_var T then idtac else
let H := fresh "CONT" in
lazymatch goal with
| HL := LET_ID ?X |- _ =>
pose H := T;
let G := tac H in
change_no_check G;
revert HL H;
lazymatch goal with
| |- let H1 := ?X1 in let H2 := ?X2 in ?G =>
change (let H2 := LET_ID (let H1 := X1 in X2) in G);
intros H2
end
| _ =>
pose H := (LET_ID T);
let G := tac H in
change_no_check G
end.
(* Ltac do_li_let_bind T tac := *)
(* try (assert_fails (is_var T); *)
(* let H := fresh "GOAL" in *)
(* pose H := (LET_ID T); *)
(* let G := tac H in *)
(* change_no_check G). *)
Tactic Notation "li_let_bind" constr(T) tactic3(tac) := Tactic Notation "li_let_bind" constr(T) tactic3(tac) :=
try (assert_fails (is_var T); li_let_bind T tac.
let H := fresh "GOAL" in
pose H := (LET_ID T);
let G := tac H in
change_no_check G).
(* unfold_let_goal_tac lets users unfold custom definitions. *) (* unfold_let_goal_tac lets users unfold custom definitions. *)
Ltac unfold_let_goal_tac H := idtac. Ltac unfold_let_goal_tac H := idtac.
...@@ -311,17 +334,45 @@ Ltac liUnfoldLetGoal := ...@@ -311,17 +334,45 @@ Ltac liUnfoldLetGoal :=
let do_unfold P := let do_unfold P :=
let H := get_head P in let H := get_head P in
is_var H; is_var H;
unfold LET_ID in H; first [
unfold_let_goal_tac H; lazymatch goal with
(* This unfold inserts a cast but that is not too bad for | H' := LET_ID (let X := ?A in ?B) |- _ =>
performance since the goal is small at this point. *) constr_eq H H';
unfold H; revert H';
try clear H lazymatch goal with
| |- let H' := LET_ID (let X := ?A in ?B) in ?G =>
change (let X := A in let H' := B in G);
intros ?
end;
cbv zeta
end |
unfold LET_ID in H;
unfold_let_goal_tac H;
(* This unfold inserts a cast but that is not too bad for
performance since the goal is small at this point. *)
unfold H;
try clear H
]
in in
lazymatch goal with lazymatch goal with
| |- envs_entails _ (?P _) => do_unfold P | |- envs_entails _ (?P _) => do_unfold P
| |- envs_entails _ ?P => do_unfold P | |- envs_entails _ ?P => do_unfold P
end. end.
(* Ltac liUnfoldLetGoal := *)
(* let do_unfold P := *)
(* let H := get_head P in *)
(* is_var H; *)
(* unfold LET_ID in H; *)
(* unfold_let_goal_tac H; *)
(* (* This unfold inserts a cast but that is not too bad for *)
(* performance since the goal is small at this point. *) *)
(* unfold H; *)
(* try clear H *)
(* in *)
(* lazymatch goal with *)
(* | |- envs_entails _ (?P ∗ _) => do_unfold P *)
(* | |- envs_entails _ ?P => do_unfold P *)
(* end. *)
Ltac liUnfoldLetsContaining H := Ltac liUnfoldLetsContaining H :=
repeat match goal with repeat match goal with
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment