Skip to content
Snippets Groups Projects
Commit 7040c040 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Make simplify_error_equality a bit faster.

It is still rather slow, though.
parent d4da6f17
No related branches found
No related tags found
No related merge requests found
...@@ -16,6 +16,16 @@ Notation "'guard' P 'with' e ; o" := (error_guard P e (λ _, o)) ...@@ -16,6 +16,16 @@ Notation "'guard' P 'with' e ; o" := (error_guard P e (λ _, o))
Definition error_of_option {A E} (x : option A) (e : E) : sum E A := Definition error_of_option {A E} (x : option A) (e : E) : sum E A :=
match x with Some a => inr a | None => inl e end. match x with Some a => inr a | None => inl e end.
Lemma bind_inr {A B E} (f : A E + B) x b :
x ≫= f = inr b a, x = inr a f a = inr b.
Proof. destruct x; naive_solver. Qed.
Lemma fmap_inr {A B E} (f : A B) (x : E + A) b :
f <$> x = inr b a, x = inr a f a = b.
Proof. destruct x; naive_solver. Qed.
Lemma error_of_option_inr {A E} (o : option A) (e : E) a :
error_of_option o e = inr a o = Some a.
Proof. destruct o; naive_solver. Qed.
Tactic Notation "case_error_guard" "as" ident(Hx) := Tactic Notation "case_error_guard" "as" ident(Hx) :=
match goal with match goal with
| H : context C [@error_guard _ ?P ?dec _ ?e ?x] |- _ => | H : context C [@error_guard _ ?P ?dec _ ?e ?x] |- _ =>
...@@ -31,33 +41,18 @@ Tactic Notation "case_error_guard" := ...@@ -31,33 +41,18 @@ Tactic Notation "case_error_guard" :=
Tactic Notation "simplify_error_equality" := Tactic Notation "simplify_error_equality" :=
repeat match goal with repeat match goal with
| _ => progress simplify_equality' | _ => progress simplify_equality'
| H : error_of_option ?o ?e = ?x |- _ => | H : error_of_option ?o ?e = ?x |- _ => apply error_of_option_inr in H
match o with Some _ => fail 1 | None => fail 1 | _ => idtac end;
match x with inr _ => idtac | inl _ => idtac | _ => fail 1 end;
let y := fresh in destruct o as [y|] eqn:?;
[change (inr y = x) in H|change (inl e = x) in H]
| H : mbind (M:=sum _) ?f ?o = ?x |- _ => | H : mbind (M:=sum _) ?f ?o = ?x |- _ =>
match o with inr _ => fail 1 | inl _ => fail 1 | _ => idtac end; apply bind_inr in H; destruct H as (?&?&?)
match x with inr _ => idtac | inl _ => idtac | _ => fail 1 end;
let e := fresh in let y := fresh in destruct o as [e|y] eqn:?;
[change (inl e = x) in H|change (f y = x) in H]
| H : ?x = mbind (M:=sum _) ?f ?o |- _ =>
match o with inr _ => fail 1 | inl _ => fail 1 | _ => idtac end;
match x with inr _ => idtac | inl _ => idtac | _ => fail 1 end;
let e := fresh in let y := fresh in destruct o as [e|y] eqn:?;
[change (inl e = x) in H|change (f y = x) in H]
| H : fmap (M:=sum _) ?f ?o = ?x |- _ => | H : fmap (M:=sum _) ?f ?o = ?x |- _ =>
match o with inr _ => fail 1 | inl _ => fail 1 | _ => idtac end; apply fmap_inr in H; destruct H as (?&?&?)
match x with inr _ => idtac | inl _ => idtac | _ => fail 1 end; | H : mbind (M:=option) ?f ?o = ?x |- _ =>
let e := fresh in let y := fresh in destruct o as [e|y] eqn:?; apply bind_Some in H; destruct H as (?&?&?)
[change (inl e = x) in H|change (inr (f y) = x) in H] | H : fmap (M:=option) ?f ?o = ?x |- _ =>
| H : ?x = fmap (M:=sum _) ?f ?o |- _ => apply fmap_Some in H; destruct H as (?&?&?)
match o with inr _ => fail 1 | inl _ => fail 1 | _ => idtac end;
match x with inr _ => idtac | inl _ => idtac | _ => fail 1 end;
let e := fresh in let y := fresh in destruct o as [e|y] eqn:?;
[change (inl e = x) in H|change (inr (f y) = x) in H]
| _ => progress case_decide | _ => progress case_decide
| _ => progress case_error_guard | _ => progress case_error_guard
| _ => progress case_option_guard
end. end.
Section mapM. Section mapM.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment