(** 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
}.(** 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
}.(** 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
}.(** 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
}.(** 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
}.(** 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).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).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).Instance Linker_fundef (F: Type): Linker (fundef F) := {
  link := link_fundef;
  linkorder := linkorder_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.(** 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.(** 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.(** 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.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.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.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.Instance Linker_varinit : Linker (list init_data) := {
  link := link_varinit;
  linkorder := linkorder_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).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).Instance Linker_vardef (V: Type) {LV: Linker V}: Linker (globvar V) := {
  link := link_vardef;
  linkorder := linkorder_vardef
}.(** A trivial linker for the trivial var info [unit]. *)

Instance Linker_unit: Linker unit := {
  link := fun x y => Some tt;
  linkorder := fun x y => True
}.(** 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).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).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).Instance Linker_def (F V: Type) {LF: Linker F} {LV: Linker V}: Linker (globdef F V) := {
  link := link_def;
  linkorder := linkorder_def
}.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.Inductive match_globvar: globvar V1 -> globvar V2 -> Prop :=
  | match_globvar_intro: forall i1 i2 init ro vo,
      match_varinfo i1 i2 ->
      match_globvar (mkglobvar i1 init ro vo) (mkglobvar i2 init ro vo).Inductive match_globvar: globvar V1 -> globvar V2 -> Prop :=
  | match_globvar_intro: forall i1 i2 init ro vo,
      match_varinfo i1 i2 ->
      match_globvar (mkglobvar i1 init ro vo) (mkglobvar i2 init ro vo).Inductive match_globdef (ctx: C): globdef F1 V1 -> globdef F2 V2 -> Prop :=
  | match_globdef_fun: forall ctx' f1 f2,
      linkorder ctx' ctx ->
      match_fundef ctx' f1 f2 ->
      match_globdef ctx (Gfun f1) (Gfun f2)
  | match_globdef_var: forall v1 v2,
      match_globvar v1 v2 ->
      match_globdef ctx (Gvar v1) (Gvar v2).Inductive match_globdef (ctx: C): globdef F1 V1 -> globdef F2 V2 -> Prop :=
  | match_globdef_fun: forall ctx' f1 f2,
      linkorder ctx' ctx ->
      match_fundef ctx' f1 f2 ->
      match_globdef ctx (Gfun f1) (Gfun f2)
  | match_globdef_var: forall v1 v2,
      match_globvar v1 v2 ->
      match_globdef ctx (Gvar v1) (Gvar v2).Inductive match_globdef (ctx: C): globdef F1 V1 -> globdef F2 V2 -> Prop :=
  | match_globdef_fun: forall ctx' f1 f2,
      linkorder ctx' ctx ->
      match_fundef ctx' f1 f2 ->
      match_globdef ctx (Gfun f1) (Gfun f2)
  | match_globdef_var: forall v1 v2,
      match_globvar v1 v2 ->
      match_globdef ctx (Gvar v1) (Gvar v2).Definition match_ident_globdef
     (ctx: C) (ig1: ident * globdef F1 V1) (ig2: ident * globdef F2 V2) : Prop :=
  fst ig1 = fst ig2 /\ match_globdef ctx (snd ig1) (snd ig2).Definition match_program_gen (ctx: C) (p1: program F1 V1) (p2: program F2 V2) : Prop :=
  list_forall2 (match_ident_globdef ctx) p1.(prog_defs) p2.(prog_defs)
  /\ p2.(prog_main) = p1.(prog_main)
  /\ p2.(prog_public) = p1.(prog_public).

(* Specifications: *)
Lemma match_program_gen_main: forall ctx p1 p2, match_program_gen ctx p1 p2 -> p2.(prog_main) = p1.(prog_main).
Lemma match_program_public: forall ctx p1 p2, match_program_gen ctx p1 p2 -> p2.(prog_public) = p1.(prog_public).
Lemma match_program_gen_len_defs: forall ctx p1 p2, match_program_gen ctx p1 p2 -> length (AST.prog_defs p1) =length (AST.prog_defs p2) .