(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Separate compilation and syntactic linking *)
(** This file follows "approach A" from the paper "Lightweight Verification of Separate Compilation" by Kang, Kim, Hur, Dreyer and Vafeiadis, POPL 2016. *)
(** * Syntactic linking *)
(** A syntactic element [A] supports syntactic linking if it is equipped with the following: - a partial binary operator [link] that produces the result of linking two elements, or fails if they cannot be linked (e.g. two definitions that are incompatible); - a preorder [linkorder] with the meaning that [linkorder a1 a2] holds if [a2] can be obtained by linking [a1] with some other syntactic element. *)
Class Linker (A: Type) := {
link: A -> A -> option A;
linkorder: A -> A -> Prop;
linkorder_refl: forall x, linkorder x x;
linkorder_trans: forall x y z, linkorder x y -> linkorder y z -> linkorder x z;
link_linkorder: forall x y z, link x y = Some z -> linkorder x z /\ linkorder y z
}.
(** Linking function definitions.  External functions of the [EF_external] kind can link with internal function definitions; the result of linking is the internal definition.  Two external functions can link if they are identical. *)
Definition link_fundef {F: Type} (fd1 fd2: fundef F) :=
match fd1, fd2 with
| Internal _, Internal _ => None
| External ef1, External ef2 =>
if external_function_eq ef1 ef2 then Some (External ef1) else None
| Internal f, External ef =>
match ef with EF_external id sg => Some (Internal f) | _ => None end
| External ef, Internal f =>
match ef with EF_external id sg => Some (Internal f) | _ => None end
end.
Inductive linkorder_fundef {F: Type}: fundef F -> fundef F -> Prop :=
| linkorder_fundef_refl: forall fd, linkorder_fundef fd fd
| linkorder_fundef_ext_int: forall f id sg, linkorder_fundef (External (EF_external id sg)) (Internal f).
Program Instance Linker_fundef (F: Type): Linker (fundef F) := {
link := link_fundef;
linkorder := linkorder_fundef
}.
Next Obligation.
constructor.
Defined.
Next Obligation.
inv H; inv H0; constructor.
Defined.
Next Obligation.
destruct x, y; simpl in H.
+ discriminate.
+ destruct e; inv H. split; constructor.
+ destruct e; inv H. split; constructor.
+ destruct (external_function_eq e e0); inv H. split; constructor.
Defined.
Global Opaque Linker_fundef.
(** Linking variable initializers.  We adopt the following conventions: - an "extern" variable has an empty initialization list; - a "common" variable has an initialization list of the form [Init_space sz]; - all other initialization lists correspond to fully defined variables, neither "common" nor "extern". *)
Inductive init_class : list init_data -> Type :=
| Init_extern: init_class nil
| Init_common: forall sz, init_class (Init_space sz :: nil)
| Init_definitive: forall il, init_class il.
Definition classify_init (i: list init_data) : init_class i :=
match i with
| nil => Init_extern
| Init_space sz :: nil => Init_common sz
| i => Init_definitive i
end.
Definition link_varinit (i1 i2: list init_data) :=
match classify_init i1, classify_init i2 with
| Init_extern, _ => Some i2
| _, Init_extern => Some i1
| Init_common sz1, _ => if zeq sz1 (init_data_list_size i2) then Some i2 else None
| _, Init_common sz2 => if zeq sz2 (init_data_list_size i1) then Some i1 else None
| _, _ => None
end.
Inductive linkorder_varinit: list init_data -> list init_data -> Prop :=
| linkorder_varinit_refl: forall il, linkorder_varinit il il
| linkorder_varinit_extern: forall il, linkorder_varinit nil il
| linkorder_varinit_common: forall sz il,
il <> nil -> init_data_list_size il = sz ->
linkorder_varinit (Init_space sz :: nil) il.
Program Instance Linker_varinit : Linker (list init_data) := {
link := link_varinit;
linkorder := linkorder_varinit
}.
Next Obligation.
constructor.
Defined.
Next Obligation.
inv H; inv H0; constructor; auto.
congruence.
simpl. generalize (init_data_list_size_pos z). xomega.
Defined.
Next Obligation.
revert H; unfold link_varinit.
destruct (classify_init x) eqn:Cx, (classify_init y) eqn:Cy; intros E; inv E; try (split; constructor; fail).
+ destruct (zeq sz (Z.max sz0 0 + 0)); inv H0.
split; constructor. congruence. auto.
+ destruct (zeq sz (init_data_list_size il)); inv H0.
split; constructor. red; intros; subst z; discriminate. auto.
+ destruct (zeq sz (init_data_list_size il)); inv H0.
split; constructor. red; intros; subst z; discriminate. auto.
Defined.
Global Opaque Linker_varinit.
(** Linking variable definitions. *)
Definition link_vardef {V: Type} {LV: Linker V} (v1 v2: globvar V) :=
match link v1.(gvar_info) v2.(gvar_info) with
| None => None
| Some info =>
match link v1.(gvar_init) v2.(gvar_init) with
| None => None
| Some init =>
if eqb v1.(gvar_readonly) v2.(gvar_readonly)
&& eqb v1.(gvar_volatile) v2.(gvar_volatile)
then Some {| gvar_info := info; gvar_init := init;
gvar_readonly := v1.(gvar_readonly);
gvar_volatile := v1.(gvar_volatile) |}
else None
end
end.
Inductive linkorder_vardef {V: Type} {LV: Linker V}: globvar V -> globvar V -> Prop :=
| linkorder_vardef_intro: forall info1 info2 i1 i2 ro vo,
linkorder info1 info2 ->
linkorder i1 i2 ->
linkorder_vardef (mkglobvar info1 i1 ro vo) (mkglobvar info2 i2 ro vo).
Program Instance Linker_vardef (V: Type) {LV: Linker V}: Linker (globvar V) := {
link := link_vardef;
linkorder := linkorder_vardef
}.
Next Obligation.
destruct x; constructor; apply linkorder_refl.
Defined.
Next Obligation.
inv H; inv H0. constructor; eapply linkorder_trans; eauto.
Defined.
Next Obligation.
revert H; unfold link_vardef.
destruct x as [f1 i1 r1 v1], y as [f2 i2 r2 v2]; simpl.
destruct (link f1 f2) as [f|] eqn:LF; try discriminate.
destruct (link i1 i2) as [i|] eqn:LI; try discriminate.
destruct (eqb r1 r2) eqn:ER; try discriminate.
destruct (eqb v1 v2) eqn:EV; intros EQ; inv EQ.
apply eqb_prop in ER; apply eqb_prop in EV; subst r2 v2.
apply link_linkorder in LF. apply link_linkorder in LI.
split; constructor; tauto.
Defined.
Global Opaque Linker_vardef.
(** A trivial linker for the trivial var info [unit]. *)
Program Instance Linker_unit: Linker unit := {
link := fun x y => Some tt;
linkorder := fun x y => True
}.
Global Opaque Linker_unit.
(** Linking global definitions *)
Definition link_def {F V: Type} {LF: Linker F} {LV: Linker V} (gd1 gd2: globdef F V) :=
match gd1, gd2 with
| Gfun f1, Gfun f2 =>
match link f1 f2 with Some f => Some (Gfun f) | None => None end
| Gvar v1, Gvar v2 =>
match link v1 v2 with Some v => Some (Gvar v) | None => None end
| _, _ => None
end.
Inductive linkorder_def {F V: Type} {LF: Linker F} {LV: Linker V}: globdef F V -> globdef F V -> Prop :=
| linkorder_def_fun: forall fd1 fd2,
linkorder fd1 fd2 ->
linkorder_def (Gfun fd1) (Gfun fd2)
| linkorder_def_var: forall v1 v2,
linkorder v1 v2 ->
linkorder_def (Gvar v1) (Gvar v2).
Program Instance Linker_def (F V: Type) {LF: Linker F} {LV: Linker V}: Linker (globdef F V) := {
link := link_def;
linkorder := linkorder_def
}.
Next Obligation.
destruct x; constructor; apply linkorder_refl.
Defined.
Next Obligation.
inv H; inv H0; constructor; eapply linkorder_trans; eauto.
Defined.
Next Obligation.
unfold link_def; intros.
destruct x as [f1|v1], y as [f2|v2]; try discriminate.
+ simpl in H. destruct (link f1 f2) as [f|] eqn:L. inv H. apply link_linkorder in L.
split; constructor; tauto. discriminate.
+ simpl in H; destruct (link v1 v2) as [v|] eqn:L; inv H. apply link_linkorder in L.
split; constructor; tauto.
Defined.
Global Opaque Linker_def.
(** Linking two compilation units.  Compilation units are represented like whole programs using the type [program F V].  If a name has a global definition in one unit but not in the other, this definition is left unchanged in the result of the link.  If a name has global definitions in both units, and is public (not static) in both, the two definitions are linked as per [Linker_def] above.  If one or both definitions are static (not public), we should ideally rename it so that it can be kept unchanged in the result of the link. This would require a general notion of renaming of global identifiers in programs that we do not have yet.  Hence, as a first step, linking is undefined if static definitions with the same name appear in both compilation units. *)
Section LINKER_PROG.
Context {F V: Type} {LF: Linker F} {LV: Linker V} (p1 p2: program F V).
Let dm1 := prog_defmap p1.
Let dm2 := prog_defmap p2.
Definition link_prog_check (x: ident) (gd1: globdef F V) :=
match dm2!x with
| None => true
| Some gd2 =>
In_dec peq x p1.(prog_public)
&& In_dec peq x p2.(prog_public)
&& match link gd1 gd2 with Some _ => true | None => false end
end.
Definition link_prog_merge (o1 o2: option (globdef F V)) :=
match o1, o2 with
| None, _ => o2
| _, None => o1
| Some gd1, Some gd2 => link gd1 gd2
end.
Definition link_prog :=
if ident_eq p1.(prog_main) p2.(prog_main)
&& PTree_Properties.for_all dm1 link_prog_check then
Some {| prog_main := p1.(prog_main);
prog_public := p1.(prog_public) ++ p2.(prog_public);
prog_defs := PTree.elements (PTree.combine link_prog_merge dm1 dm2) |}
else
None.

Lemma link_prog_inv:
forall p,
link_prog = Some p ->
p1.(prog_main) = p2.(prog_main)
/\ (forall id gd1 gd2,
dm1!id = Some gd1 -> dm2!id = Some gd2 ->
In id p1.(prog_public) /\ In id p2.(prog_public) /\ exists gd, link gd1 gd2 = Some gd)
/\ p = {| prog_main := p1.(prog_main);
prog_public := p1.(prog_public) ++ p2.(prog_public);
prog_defs := PTree.elements (PTree.combine link_prog_merge dm1 dm2) |}.