End LINK_LIST_MATCH.
(** * Linking and composition of compilation passes *)
Set Implicit Arguments.
(** A generic language is a type of programs and a linker. *)
Structure Language := mklang { lang_prog :> Type; lang_link: Linker lang_prog }.
Canonical Structure Language_gen (A: Type) (L: Linker A) : Language := @mklang A L.
(** A compilation pass from language [S] (source) to language [T] (target) is a matching relation between [S] programs and [T] programs, plus two linkers, one for [S] and one for [T], and a property of commutation with linking. *)
Record Pass (S T: Language) := mkpass {
pass_match :> lang_prog S -> lang_prog T -> Prop;
pass_match_link: @TransfLink (lang_prog S) (lang_prog T) (lang_link S) (lang_link T) pass_match
}.
Arguments mkpass {S} {T} (pass_match) {pass_match_link}.
Program Definition pass_identity (l: Language): Pass l l :=
{| pass_match := fun p1 p2 => p1 = p2;
pass_match_link := _ |}.
Next Obligation.
red; intros. subst. exists p; auto.
Defined.
Program Definition pass_compose {l1 l2 l3: Language} (pass: Pass l1 l2) (pass': Pass l2 l3) : Pass l1 l3 :=
{| pass_match := fun p1 p3 => exists p2, pass_match pass p1 p2 /\ pass_match pass' p2 p3;
pass_match_link := _ |}.
Next Obligation.
red; intros.
destruct H0 as (p1' & A1 & B1).
destruct H1 as (p2' & A2 & B2).
edestruct (pass_match_link pass) as (p' & A & B); eauto.
edestruct (pass_match_link pass') as (tp & C & D); eauto.
Defined.
(** A list of compilation passes that can be composed. *)
Inductive Passes: Language -> Language -> Type :=
| pass_nil: forall l, Passes l l
| pass_cons: forall l1 l2 l3, Pass l1 l2 -> Passes l2 l3 -> Passes l1 l3.
Infix ":::" := pass_cons (at level 60, right associativity) : linking_scope.
(** The pass corresponding to the composition of a list of passes. *)
Fixpoint compose_passes (l l': Language) (passes: Passes l l') : Pass l l' :=
match passes in Passes l l' return Pass l l' with
| pass_nil l => pass_identity l
| pass_cons l1 l2 l3 pass1 passes => pass_compose pass1 (compose_passes passes)
end.
(** Some more lemmas about [nlist_forall2]. *)

(* Specifications: *)
Lemma nlist_forall2_identity:
forall (A: Type) (la lb: nlist A),
nlist_forall2 (fun a b => a = b) la lb -> la = lb.
Lemma nlist_forall2_compose_inv:
forall (A B C: Type) (R1: A -> B -> Prop) (R2: B -> C -> Prop)
(la: nlist A) (lc: nlist C),
nlist_forall2 (fun a c => exists b, R1 a b /\ R2 b c) la lc ->
exists lb: nlist B, nlist_forall2 R1 la lb /\ nlist_forall2 R2 lb lc.