Require Export Monotonicity.
(** ** The [transport] tactic *)
(** Often, we know that a number of terms are related, and need to transport hypotheses built out the the left-hand sides into ones with similar shapes, but built out of the right-hand sides. For instance, in cirumstances where [rauto] can establish [option_rel R x y], we will want to turn a hypothesis of the form [x = Some a] into one of the form [y = Some b], and remember that [R a b]. This is the role of the [transport] tactic. *)
(** *** Transportable hypotheses *)
(* To make the tactic extensible, we use the following typeclass to declare patterns of relations and hypothesis shapes that can be handled in this way. *)
Class Transport {A B} (R: rel A B) (a: A) (b: B) (PA: Prop) (PB: Prop) :=
transport: R a b -> PA -> PB.
(** One stereotypical example is [option_le]: the [Transport] instance defined in the [OptionRel] library allows us to transport hypothese of the form [x = Some a] into hypotheses of the form [y = Some b], with [a] and [b] related by [R] whenever [x] and [y] are related by [option_le R], and similarly for [None] and [option_rel].  Other instances are declared below. *)
Global Instance prod_rel_transport_eq_pair {A1 B1 A2 B2} (R1: rel A1 B1) (R2: rel A2 B2) x y a1 a2:
Transport (prod_rel R1 R2) x y (x = (a1, a2)) (exists b1 b2, y = (b1, b2) /\ R1 a1 b1 /\ R2 a2 b2).
(** For [set_le] the situation is slightly more involved, for two reasons. First, a regular [eapply set_le_transport] fails to unify the parameter [B] of [Transport] against the [_ -> Prop] provied by the instance below. This can be worked around by pre-unifying that specific parameter. Second, because [set_le_transport] is potentially applicable to virtually any hypothesis (since there is no strongly distinguishing syntactic format in our target hypotheses), it makes [transport_hyps] very slow.  To address this, we explicitely register hints based on the [set_le_transport] tactic, which looks for "keywords" before doing anything, then applies the lemma with the required unification preparation. For example, [set_le_transport] is used in the following way in the [SimClight] library: << Hint Extern 1 (Transport _ _ _ _ _) => set_le_transport @assign_loc : typeclass_instances. >> Note that it's necessary to use [@] because [assign_loc] is parametrized by typeclasses, and we want to avoid undue specialization at hint registration time. *)
Ltac set_le_transport keyword :=
lazymatch goal with
| |- @Transport ?A ?B ?R ?a ?b ?PA ?PB =>
lazymatch PA with
| context [keyword] =>
let Xv := fresh "X" in evar (Xv: Type);
let X := eval red in Xv in clear Xv;
unify B (X -> Prop);
eapply set_le_transport
end
end.
(** We defined a few more relation patterns based on [set_le] and [rel_curry], with a similar strategy. *)
Ltac rel_curry_set_le_transport keyword :=
lazymatch goal with
| |- @Transport ?A ?B ?R ?a ?b ?PA ?PB =>
lazymatch PA with
| context [keyword] =>
let Xv := fresh "X" in evar (Xv: Type);
let X := eval red in Xv in clear Xv;
let Yv := fresh "Y" in evar (Yv: Type);
let Y := eval red in Yv in clear Yv;
unify B (X -> Y -> Prop);
eapply rel_curry_set_le_transport
end
end.
Ltac rel_curry2_set_le_transport keyword :=
lazymatch goal with
| |- @Transport ?A ?B ?R ?a ?b ?PA ?PB =>
lazymatch PA with
| context [keyword] =>
let Xv := fresh "X" in evar (Xv: Type);
let X := eval red in Xv in clear Xv;
let Yv := fresh "Y" in evar (Yv: Type);
let Y := eval red in Yv in clear Yv;
let Zv := fresh "Y" in evar (Yv: Type);
let Z := eval red in Yv in clear Yv;
unify B (X -> Y -> Z -> Prop);
eapply rel_curry2_set_le_transport
end
end.
(** The situation for [impl] is similar: since this transport instance can apply to pretty much anything, we need to register it on a case-by-case basis. Here is an example used in the CertiKOS proof for hypotheses of the form [writable_block ge b]: << Hint Extern 10 (Transport _ _ _ (writable_block _ _) _) => eapply impl_transport : typeclass_instances. >> *)

Lemma impl_transport P Q:
Transport impl P Q P Q.