Ltac simplify_add_composite_definitions env cl :=
match cl with
| Composite ?id ?su ?m ?a :: ?cl' =>
let d := constr:(composite_of_def env id su m a)
in let d' := simplify_composite_of_def d
in let env' :=  constr:(PTree.set id d' env)
in let env' := eval simpl in env' in
simplify_add_composite_definitions env' cl'
| nil => constr:(Errors.OK env)
end.
Ltac make_composite_env composites :=
let j := constr:(build_composite_env' composites I)
in let j := eval unfold composites in j
in let j := eval cbv beta iota zeta delta [
build_composite_env' build_composite_env
PTree.empty
] in j
in  match j with context C [add_composite_definitions PTree.Leaf ?c] =>
let cd := simplify_add_composite_definitions (@PTree.Leaf composite) c in
cd (* let j := context C [cd] in j *)
end.
Ltac make_composite_env0 prog :=
let c := constr:(prog_types prog) in
let c := eval unfold prog, prog_types, Clightdefs.mkprogram in c in
match c with context C [build_composite_env' ?comp I] =>
let comp' := make_composite_env comp
in match comp' with Errors.OK ?ce =>
ce
end
end.
Ltac make_compspecs prog :=
let cenv := make_composite_env0 prog in
let cenv_consistent_ := constr:((composite_env_consistent_i composite_consistent cenv ltac:(repeat constructor)): composite_env_consistent cenv) in
let cenv_legal_fieldlist_ := constr:((composite_env_consistent_i' composite_legal_fieldlist cenv ltac:(repeat constructor)): composite_env_legal_fieldlist cenv) in
let cenv_legal_su_ := constr:((composite_env_consistent_i (fun c co => composite_complete_legal_cosu_type c (co_members co) = true) cenv ltac:(repeat constructor)): composite_env_complete_legal_cosu_type cenv) in
let ha_env := eval cbv in (hardware_alignof_env cenv) in
let Hha_env := constr: (eq_refl: ha_env = hardware_alignof_env cenv) in
let ha_env_consistent := constr: (hardware_alignof_consistency cenv ha_env cenv_consistent_ Hha_env) in
let ha_env_complete := constr: (hardware_alignof_completeness cenv ha_env Hha_env) in
let la_env := eval cbv in (legal_alignas_env cenv ha_env) in
let Hla_env := constr: (eq_refl: la_env = legal_alignas_env cenv ha_env) in
let la_env_consistent := constr: (legal_alignas_env_consistency' cenv ha_env la_env cenv_consistent_ Hla_env) in
let la_env_complete := constr: (legal_alignas_env_completeness' cenv ha_env la_env Hla_env) in
let la_env_sound := constr: (legal_alignas_soundness cenv ha_env la_env cenv_consistent_ cenv_legal_su_ ha_env_consistent ha_env_complete la_env_consistent la_env_complete) in
refine (  {| cenv_cs := cenv ;
cenv_consistent := cenv_consistent_;
cenv_legal_fieldlist := cenv_legal_fieldlist_;
cenv_legal_su := cenv_legal_su_;
ha_env_cs := ha_env;
ha_env_cs_consistent := ha_env_consistent;
ha_env_cs_complete := ha_env_complete;
la_env_cs := la_env;
la_env_cs_consistent := la_env_consistent;
la_env_cs_complete := la_env_complete;
la_env_cs_sound := la_env_sound |}).
Fixpoint missing_ids {A} (t: PTree.tree A) (al: list ident) :=
match al with
| a::al' => match PTree.get a t with None => a::nil | _ => nil end ++
missing_ids t al'
| nil => nil
end.
Ltac simpl_prog_defs p :=
match p with context C [prog_defs (Clightdefs.mkprogram _ ?d _ _ _)] =>
let q := context C [d] in q
end.
Ltac with_library' p G :=
let g := eval hnf in G in
let x := constr:(augment_funspecs' (prog_funct p) g) in
let x := eval cbv beta iota zeta delta [prog_funct] in x in
let x := simpl_prog_defs x in
let x := eval hnf in x in
match x with
| Some ?l => exact l
| None =>
let t := constr:(List.fold_right (fun i t => PTree.set i tt t) (PTree.empty _)
(map fst (prog_funct p))) in
let t := eval compute in t in
let missing := constr:(missing_ids t (map fst G)) in
let missing := eval simpl in missing in
match missing with
| nil => fail "Superfluous funspecs?"
| _ => fail  "The following names have funspecs but no function definitions: " missing
end
end.
Ltac with_library prog G :=
let pr := eval unfold prog in prog in  with_library' pr G.

(* Specifications: *)
Lemma mk_funspec_congr:
forall a b c d e f g a' b' c' d' e' f' g',
a=a' -> b=b' -> c=c' -> JMeq d d' -> JMeq e e' ->
mk_funspec a b c d e f g = mk_funspec a' b' c' d' e' f' g'.