Progress on porting to Coq 8.6

Frap.v

@@ -19,7 +19,79 @@ Ltac inductN n :=
       end
   end.
 
-Ltac induct e := inductN e || dependent induction e.
+Ltac same_structure x y :=
+  match x with
+  | ?f ?a1 ?b1 ?c1 ?d1 =>
+    match y with
+    | f ?a2 ?b2 ?c2 ?d2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2; same_structure d1 d2
+    | _ => fail 2
+    end
+  | ?f ?a1 ?b1 ?c1 =>
+    match y with
+    | f ?a2 ?b2 ?c2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2
+    | _ => fail 2
+    end
+  | ?f ?a1 ?b1 =>
+    match y with
+    | f ?a2 ?b2 => same_structure a1 a2; same_structure b1 b2
+    | _ => fail 2
+    end
+  | ?f ?a1 =>
+    match y with
+    | f ?a2 => same_structure a1 a2
+    | _ => fail 2
+    end
+  | _ =>
+    match y with
+    | ?f ?a1 ?b1 ?c1 ?d1 =>
+      match x with
+      | f ?a2 ?b2 ?c2 ?d2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2; same_structure d1 d2
+      | _ => fail 2
+      end
+    | ?f ?a1 ?b1 ?c1 =>
+      match x with
+      | f ?a2 ?b2 ?c2 => same_structure a1 a2; same_structure b1 b2; same_structure c1 c2
+      | _ => fail 2
+      end
+    | ?f ?a1 ?b1 =>
+      match x with
+      | f ?a2 ?b2 => same_structure a1 a2; same_structure b1 b2
+      | _ => fail 2
+      end
+    | ?f ?a1 =>
+      match x with
+      | f ?a2 => same_structure a1 a2
+      | _ => fail 2
+      end
+    | _ => idtac
+    end
+  end.
+
+Ltac instantiate_obvious1 H :=
+  match type of H with
+  | ?x = ?y -> _ =>
+    (same_structure x y; specialize (H eq_refl)) || fail 3
+  | JMeq.JMeq ?x ?y -> _ =>
+    (same_structure x y; specialize (H JMeq.JMeq_refl)) || fail 3
+  | forall x : ?T, _ =>
+    match type of T with
+    | Prop => fail 1
+    | _ =>
+      let x' := fresh x in
+      evar (x' : T);
+      let x'' := eval unfold x' in x' in specialize (H x''); clear x';
+        instantiate_obvious1 H
+    end
+  end.
+
+Ltac instantiate_obvious H := repeat instantiate_obvious1 H.
+
+Ltac instantiate_obviouses :=
+  repeat match goal with
+         | [ H : _ |- _ ] => instantiate_obvious H
+         end.
+
+Ltac induct e := (inductN e || dependent induction e); instantiate_obviouses.
 
 Ltac invert' H := inversion H; clear H; subst.
 
@@ -244,9 +316,9 @@ Ltac total_ordering N M := destruct (totally_ordered N M).
 
 Ltac inList x xs :=
   match xs with
-  | (x, _) => constr:true
+  | (x, _) => true
   | (_, ?xs') => inList x xs'
-  | _ => constr:false
+  | _ => false
   end.
 
 Ltac maybe_simplify_map m found kont :=

LambdaCalculusAndTypeSoundness.v

@@ -630,25 +630,26 @@ Module Stlc.
     propositional.
 
     right.
-    invert H1; invert H.
+    (* Some automation is needed here to maintain compatibility with
-    invert H2; invert H0.
+     * name generation in different Coq versions. *)
+    match goal with
+    | [ H1 : value e1, H2 : hasty $0 e1 _ |- _ ] => invert H1; invert H2
+    end.
+    match goal with
+    | [ H1 : value e2, H2 : hasty $0 e2 _ |- _ ] => invert H1; invert H2
+    end.
     exists (Const (n + n0)).
     eapply StepRule with (C := Hole).
     eauto.
     eauto.
     constructor.
 
-    invert H2.
+    match goal with
-    right.
+    | [ H : exists x, _ |- _ ] => invert H
-    invert H3.
+    end.
-    exists (Plus e1 x).
+    match goal with
-    eapply StepRule with (C := Plus2 e1 C).
+    | [ H : step _ _ |- _ ] => invert H
-    eauto.
+    end.
-    eauto.
-    assumption.
-
-    invert H1.
-    invert H3.
     right.
     exists (Plus x e2).
     eapply StepRule with (C := Plus1 C e2).
@@ -656,8 +657,25 @@ Module Stlc.
     eauto.
     assumption.
 
-    invert H1.
+    match goal with
-    invert H3.
+    | [ H : exists x, _ |- _ ] => invert H
+    end.
+    match goal with
+    | [ H : step _ _ |- _ ] => invert H
+    end.
+    right.
+    exists (Plus e1 x).
+    eapply StepRule with (C := Plus2 e1 C).
+    eauto.
+    eauto.
+    assumption.
+
+    match goal with
+    | [ H : exists x, step e1 _ |- _ ] => invert H
+    end.
+    match goal with
+    | [ H : step _ _ |- _ ] => invert H
+    end.
     right.
     exists (Plus x e2).
     eapply StepRule with (C := Plus1 C e2).
@@ -671,7 +689,9 @@ Module Stlc.
     propositional.
 
     right.
-    invert H1; invert H.
+    match goal with
+    | [ H1 : value e1, H2 : hasty $0 e1 _ |- _ ] => invert H1; invert H2
+    end.
     exists (subst e2 x e0).
     eapply StepRule with (C := Hole).
     eauto.
@@ -679,17 +699,12 @@ Module Stlc.
     constructor.
     assumption.
 
-    invert H2.
+    match goal with
-    right.
+    | [ H : exists x, _ |- _ ] => invert H
-    invert H3.
+    end.
-    exists (App e1 x).
+    match goal with
-    eapply StepRule with (C := App2 e1 C).
+    | [ H : step _ _ |- _ ] => invert H
-    eauto.
+    end.
-    eauto.
-    assumption.
-
-    invert H1.
-    invert H3.
     right.
     exists (App x e2).
     eapply StepRule with (C := App1 C e2).
@@ -697,8 +712,25 @@ Module Stlc.
     eauto.
     assumption.
 
-    invert H1.
+    match goal with
-    invert H3.
+    | [ H : exists x, _ |- _ ] => invert H
+    end.
+    match goal with
+    | [ H : step _ _ |- _ ] => invert H
+    end.
+    right.
+    exists (App e1 x).
+    eapply StepRule with (C := App2 e1 C).
+    eauto.
+    eauto.
+    assumption.
+
+    match goal with
+    | [ H : exists x, step e1 _ |- _ ] => invert H
+    end.
+    match goal with
+    | [ H : step _ _ |- _ ] => invert H
+    end.
     right.
     exists (App x e2).
     eapply StepRule with (C := App1 C e2).
@@ -775,10 +807,8 @@ Module Stlc.
     constructor.
 
     constructor.
-    apply IHhasty1.
+    eapply IHhasty1; equality.
-    assumption.
+    eapply IHhasty2; equality.
-    apply IHhasty2.
-    assumption.
 
     cases (x0 ==v x).
 
@@ -800,10 +830,8 @@ Module Stlc.
     assumption.
 
     econstructor.
-    apply IHhasty1.
+    eapply IHhasty1; equality.
-    assumption.
+    eapply IHhasty2; equality.
-    apply IHhasty2.
-    assumption.
   Qed.
 
   (* We're almost ready for the other main property.  Let's prove it first

OperationalSemantics_template.v

@@ -813,6 +813,8 @@ Module Concurrent.
     -> cstep (v, c) (v', c').
   Proof.
     induct 1; repeat match goal with
+                     | [ H : forall a b c d, _ = _ -> _ = _ -> _ |- _ ] =>
+                       specialize (H _ _ _ _ eq_refl eq_refl)
                      | [ H : cstep _ _ |- _ ] => invert H
                      end; eauto.
   Qed.

SeparationLogic.v

@@ -854,7 +854,8 @@ Proof.
   cases (x0 $? a); try equality.
   eauto using lookup_Some_dom.
   eauto using lookup_Some_dom.
-  rewrite lookup_join2 in H8; eauto.
+  rewrite lookup_join2 in H8.
+  eapply H2; eassumption.
   eauto using lookup_None_dom.
 Qed.
 

SeparationLogic_template.v

@@ -1102,7 +1102,8 @@ Proof.
   cases (x0 $? a); try equality.
   eauto using lookup_Some_dom.
   eauto using lookup_Some_dom.
-  rewrite lookup_join2 in H8; eauto.
+  rewrite lookup_join2 in H8.
+  eapply H2; eassumption.
   eauto using lookup_None_dom.
 Qed.