Require Import CertiGraph.unionfind.env_unionfind.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.path_lemmas.
Require Import CertiGraph.graph.subgraph2.
Require Import CertiGraph.graph.graph_relation.
Require Import CertiGraph.graph.reachable_computable.
Require Import CertiGraph.msl_application.Graph.
Require Import CertiGraph.msl_application.UnionFindGraph.
Require Import CertiGraph.msl_application.GList.
Require Import CertiGraph.msl_application.GList_UnionFind.
Require Import CertiGraph.floyd_ext.share.
Require Import CertiGraph.unionfind.spatial_graph_glist.

Local Coercion UFGraph_LGraph: UFGraph >-> LGraph.
Local Coercion LGraph_SGraph: LGraph >-> SGraph.
Local Identity Coercion ULGraph_LGraph: LGraph >-> UnionFindGraph.LGraph.
Local Identity Coercion LGraph_LabeledGraph: UnionFindGraph.LGraph >-> LabeledGraph.
Local Identity Coercion SGraph_PointwiseGraph: SGraph >-> PointwiseGraph.
Local Coercion pg_lg: LabeledGraph >-> PreGraph.

Notation vertices_at sh P g:= (@vertices_at _ _ _ _ _ mpred (@SGP pSGG_VST nat unit (sSGG_VST sh)) (SGA_VST sh) P g).
Notation whole_graph sh g := (vertices_at sh (vvalid g) g).
Notation graph sh x g := (@reachable_vertices_at _ _ _ _ _ _ _ _ _ _ (@SGP pSGG_VST nat unit (sSGG_VST sh)) _ x g).
Notation UFGraph := (@UFGraph pSGG_VST).
Notation uf_under_bound g := (uf_under_bound id g).
#[local] Existing Instances maGraph finGraph liGraph RGF.

Definition vlabel_in_bound (g: UFGraph) := forall x, vvalid g x -> Z.of_nat (vlabel g x) <= Int.max_unsigned.

Lemma rank_unchanged_in_bound: forall (g g': UFGraph), uf_equiv g g' -> rank_unchanged g g' -> vlabel_in_bound g -> vlabel_in_bound g'.
Proof. unfold uf_equiv, rank_unchanged, vlabel_in_bound. intros. destruct H as [? _]. pose proof H2. rewrite <- H in H2. rewrite <- H0; auto. Qed.

Definition mallocN_spec :=
 DECLARE _mallocN
  WITH sh: wshare, n:Z
  PRE [tint]
     PROP (0 <= n <= Int.max_signed)
     PARAMS (Vint (Int.repr n))
     GLOBALS ()
     SEP ()
  POST [ tptr tvoid ]
     EX v: addr,
     PROP ()
     LOCAL (temp ret_temp (pointer_val_val v))
     SEP (data_at sh node_type (Vint (Int.repr 0), pointer_val_val null)
              (pointer_val_val v)).

Definition find_spec :=
 DECLARE _find
  WITH sh: wshare, g: UFGraph, x: pointer_val
  PRE [tptr (Tstruct _Node noattr)]
          PROP  (vvalid g x ; uf_under_bound g)
          PARAMS (pointer_val_val x)
          GLOBALS ()
          SEP   (whole_graph sh g)
  POST [ tptr (Tstruct _Node noattr) ]
        EX g': UFGraph, EX rt : pointer_val,
        PROP (uf_equiv g g'; uf_root g' x rt ; uf_under_bound g' ; rank_unchanged g g')
        LOCAL (temp ret_temp (pointer_val_val rt))
        SEP (whole_graph sh g').

Definition unionS_spec :=
 DECLARE _unionS
  WITH sh: wshare, g: UFGraph, x: pointer_val, y: pointer_val
  PRE [tptr (Tstruct _Node noattr), tptr (Tstruct _Node noattr)]
          PROP  (vvalid g x; vvalid g y ; uf_under_bound g ; vlabel_in_bound g)
          PARAMS (pointer_val_val x; pointer_val_val y)
          GLOBALS ()
          SEP   (whole_graph sh g)
  POST [ Tvoid ]
        EX g': UFGraph,
        PROP (uf_union g x y g' ; uf_under_bound g')
        LOCAL()
        SEP (whole_graph sh g').

Definition makeSet_spec :=
  DECLARE _makeSet
  WITH sh: wshare, g: UFGraph
    PRE []
      PROP (uf_under_bound g)
      PARAMS ()
      GLOBALS ()
      SEP (whole_graph sh g)
    POST [tptr (Tstruct _Node noattr)]
      EX g': UFGraph, EX rt: pointer_val,
      PROP (~ vvalid g rt ; vvalid g' rt ; is_partial_graph g g' ; uf_under_bound g')
      LOCAL (temp ret_temp (pointer_val_val rt))
      SEP (whole_graph sh g').

Definition Gprog : funspecs := ltac:(with_library prog [mallocN_spec; makeSet_spec; find_spec; unionS_spec]).

Lemma body_makeSet: semax_body Vprog Gprog f_makeSet makeSet_spec.
Proof.
  start_function.
  forward_call (sh, if Archi.ptr64 then 16 else 8).
  - cbv [Archi.ptr64]. rep_lia.
  - Intros x.
    assert_PROP (x <> null) as x_not_null by (entailer !; destruct H1 as [? _]; apply H1).
    assert_PROP (~ vvalid g x) by (entailer; apply (@vertices_at_sepcon_unique_1x _ _ _ _ SGBA_VST _ _ (SGA_VST sh) (SGAvs_VST sh) g x (vvalid g) (O, null))).
    forward. forward. forward.
    Exists (make_set_Graph O tt tt x g x_not_null H0) x. entailer !.
    + split; [|split]; simpl; [right | apply is_partial_make_set_pregraph | apply uf_under_bound_make_set_graph]; auto.
    + assert (Coqlib.Prop_join (vvalid g) (eq x) (vvalid (make_set_Graph 0%nat tt tt x g x_not_null H0))). {
        simpl; hnf; split; intros; [unfold graph_gen.addValidFunc | subst a]; intuition.
      } assert (vgamma (make_set_Graph O tt tt x g x_not_null H0) x = (O, x)). {
        unfold vgamma, UnionFindGraph.vgamma. simpl. f_equal.
        - destruct (SGBA_VE x x); [| hnf in c; unfold Equivalence.equiv in c; exfalso]; auto.
        - unfold graph_gen.updateEdgeFunc. destruct (EquivDec.equiv_dec (x, tt) (x, tt)). 2: compute in c; exfalso; auto. destruct (SGBA_VE null null); auto.
          hnf in c. unfold Equivalence.equiv in c. exfalso; auto.
      } rewrite <- (vertices_at_sepcon_1x (make_set_Graph 0%nat tt tt x g x_not_null H0) x (vvalid g) _ (O, x)); auto. apply sepcon_derives. 1: apply derives_refl.
      assert (vertices_at sh (vvalid g) g = vertices_at sh (vvalid g) (make_set_Graph O tt tt x g x_not_null H0)). {
        apply vertices_at_vertices_identical. simpl. hnf. intros. destruct a as [y ?]. unfold Morphisms_ext.app_sig. simpl.
        unfold UnionFindGraph.vgamma. simpl. unfold graph_gen.updateEdgeFunc. f_equal.
        - destruct (SGBA_VE y x); [hnf in e; subst y; exfalso |]; auto.
        - destruct (EquivDec.equiv_dec (x, tt) (y, tt)); auto. hnf in e. inversion e. subst y. exfalso; auto.
      } rewrite <- H6. apply derives_refl.
Qed.

Lemma false_Cne_eq: forall x y, typed_false tint (force_val (sem_cmp_pp Cne (pointer_val_val x) (pointer_val_val y))) -> x = y.
Proof.
  intros. hnf in H. destruct x, y; inversion H; auto. simpl in H. clear H1. unfold sem_cmp_pp in H. simpl in H. destruct (eq_block b b0).
  - destruct (Ptrofs.eq i i0) eqn:? .
    + pose proof (Ptrofs.eq_spec i i0). rewrite Heqb1 in H0. subst; auto.
    + simpl in H. inversion H.
  - simpl in H. inversion H.
Qed.

Lemma true_Cne_neq: forall x y, typed_true tint (force_val (sem_cmp_pp Cne (pointer_val_val x) (pointer_val_val y))) -> x <> y.
Proof.
  intros. hnf in H. destruct x, y; inversion H; [|intro; inversion H0..]. simpl in H. clear H1. unfold sem_cmp_pp in H. simpl in H. destruct (eq_block b b0).
  - destruct (Ptrofs.eq i i0) eqn:? .
    + simpl in H. inversion H.
    + subst b0. pose proof (Ptrofs.eq_spec i i0). rewrite Heqb1 in H0. intro; apply H0. inversion H1. reflexivity.
  - intro. inversion H0. auto.
Qed.

Lemma graph_local_facts: forall sh x (g: UFGraph), vvalid g x -> whole_graph sh g |-- valid_pointer (pointer_val_val x).
Proof.
  intros. eapply derives_trans; [apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g (vvalid g) x (vgamma g x)); auto |].
  simpl vertex_at at 1. unfold binode. entailer!.
Qed.

Lemma body_find: semax_body Vprog Gprog f_find find_spec.
Proof.
  start_function.
  remember (vgamma g x) as rpa eqn:?H. destruct rpa as [r pa].
  (* p = x -> parent; *)
  localize [data_at sh node_type (vgamma2cdata (vgamma g x)) (pointer_val_val x)]. rewrite <- H1. simpl vgamma2cdata.
  forward. 1: entailer!; destruct pa; simpl; auto.
  unlocalize [whole_graph sh g].
  1: rewrite <- H1; simpl; apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g (vvalid g) x (r, pa)); auto.
  assert (H_PARENT_Valid: vvalid g pa) by (eapply valid_parent; eauto).
  (* if (p != x) { *)
  forward_if
    (EX g': UFGraph, EX rt : pointer_val,
     PROP (uf_equiv g g' /\ uf_root g' x rt /\ uf_under_bound g' /\ rank_unchanged g g')
     LOCAL (temp _p (pointer_val_val rt); temp _x (pointer_val_val x))
     SEP (whole_graph sh g')).
  - apply denote_tc_test_eq_split; apply graph_local_facts; auto.
  - (* p0 = find(p); *)
    forward_call (sh, g, pa). Intros vret. destruct vret as [g' root]. simpl fst in *. simpl snd in *.
    Opaque pointer_val_val. forward. Transparent pointer_val_val.
    assert (pa <> x). {
      intro; subst; apply H2; trivial.
    }
    assert (weak_valid g' root) by (right; destruct H4; apply reachable_foot_valid in H4; auto).
    assert (vvalid g' x) by (destruct H3 as [? _]; rewrite <- H3; apply H).
    assert (~ reachable g' root x) by (apply (uf_equiv_not_reachable g g' x r pa root); auto).
    assert (vertices_at sh (vvalid (Graph_gen_redirect_parent g' x root H8 H9 H10)) (Graph_gen_redirect_parent g' x root H8 H9 H10) =
            vertices_at sh (vvalid g') (Graph_gen_redirect_parent g' x root H8 H9 H10)). {
      apply vertices_at_Same_set. unfold Ensembles.Same_set, Ensembles.Included, Ensembles.In. simpl. intuition. }
    remember (vgamma g' x) as rpa eqn:?H. destruct rpa as [r' pa']. symmetry in H12.
    localize [data_at sh node_type (Vint (Int.repr (Z.of_nat r')), pointer_val_val pa') (pointer_val_val x)].
    forward. unlocalize [whole_graph sh (Graph_gen_redirect_parent g' x root H8 H9 H10)].
    + rewrite H11. apply (@graph_gen_redirect_parent_ramify _ (sSGG_VST sh)); auto. destruct H4.
      apply reachable_foot_valid in H4. intro. subst root. apply (valid_not_null g' null H4). simpl. auto.
    + Exists (Graph_gen_redirect_parent g' x root H8 H9 H10) root. rewrite H11. entailer!.
      assert (uf_root g' x root). {
        rewrite <- (uf_equiv_root_the_same g g' x root); auto.
        apply (uf_root_edge _ (liGraph g) _ pa); [| apply (vgamma_not_dst g x r pa) | rewrite (uf_equiv_root_the_same g g')]; auto.
      } split; [|split].
      * apply (graph_gen_redirect_parent_equiv g g' x r pa); auto.
      * simpl. apply (uf_root_gen_dst_same g' (liGraph g') x x root); auto. apply reachable_refl; auto.
      * apply uf_under_bound_redirect_parent; auto.
  - forward. Exists g x. entailer!.
    rename H2 into Htemp.
    assert (H2: pa = x). {
      destruct pa; destruct x; inversion Htemp; trivial.
    }
    subst pa. split.
    + apply (uf_equiv_refl _  (liGraph g)).
    + apply uf_root_vgamma with (n := r); auto.
  - Intros g' rt. forward. Exists g' rt. entailer!.
Qed. (* Original: 56.251 secs; VST 2.*: 2.084 secs*)

(* Print Assumptions body_find. *)

Lemma true_Ceq_eq: forall x y, typed_true tint (force_val (sem_cmp_pp Ceq (pointer_val_val x) (pointer_val_val y))) -> x = y.
Proof.
  intros. hnf in H. destruct x, y; inversion H; auto. simpl in H. clear H1. unfold sem_cmp_pp in H. simpl in H. destruct (eq_block b b0).
  - destruct (Ptrofs.eq i i0) eqn:? .
    + pose proof (Ptrofs.eq_spec i i0). rewrite Heqb1 in H0. subst. reflexivity.
    + simpl in H. inversion H.
  - simpl in H. inversion H.
Qed.

Lemma false_Ceq_neq: forall x y, typed_false tint (force_val (sem_cmp_pp Ceq (pointer_val_val x) (pointer_val_val y))) -> x <> y.
Proof.
  intros. hnf in H. destruct x, y; inversion H; [|intro; inversion H0..]. simpl in H. clear H1. unfold sem_cmp_pp in H. simpl in H. destruct (eq_block b b0).
  - destruct (Ptrofs.eq i i0) eqn:? .
    + simpl in H. inversion H.
    + pose proof (Ptrofs.eq_spec i i0). rewrite Heqb1 in H0. intro. apply H0. inversion H1. reflexivity.
  - intro. apply n. inversion H0; reflexivity.
Qed.

Lemma body_unionS: semax_body Vprog Gprog f_unionS unionS_spec.
Proof.
  start_function.
  forward_call (sh, g, x). Intros vret. destruct vret as [g1 x_root]. simpl fst in *. simpl snd in *. apply rank_unchanged_in_bound in H6; auto.
  assert (vvalid g1 y) by (destruct H3 as [? _]; rewrite <- H3; apply H0).
  forward_call (sh, g1, y). Intros vret. destruct vret as [g2 y_root]. simpl fst in *. simpl snd in *. apply rank_unchanged_in_bound in H11; auto.
  assert (H_VALID_XROOT: vvalid g2 x_root) by (destruct H8 as [? _]; rewrite <- H8; destruct H4; apply reachable_foot_valid in H4; apply H4).
  assert (H_VALID_YROOT: vvalid g2 y_root) by (destruct H9; apply reachable_foot_valid in H9; apply H9).
  assert (H_XROOT_NOT_NULL: x_root <> null) by (intro; subst x_root; apply (valid_not_null g2 null H_VALID_XROOT); simpl; auto).
  assert (H_YROOT_NOT_NULL: y_root <> null) by (intro; subst y_root; apply (valid_not_null g2 null H_VALID_YROOT); simpl; auto).
  forward_if_tac
    (PROP (x_root <> y_root)
     LOCAL (temp _yRoot (pointer_val_val y_root); temp _xRoot (pointer_val_val x_root);
     temp _x (pointer_val_val x); temp _y (pointer_val_val y))
     SEP (vertices_at sh (vvalid g2) g2)).
  - apply denote_tc_test_eq_split; apply graph_local_facts; auto.
  - forward.
    rename H12 into Htemp.
    assert (H12: x_root = y_root). {
      destruct x_root; destruct y_root; inversion Htemp; trivial.
    }
    Exists g2. subst y_root. entailer!. apply (the_same_root_union g g1 g2 x y x_root); auto.
  - forward.
    rename H12 into Htemp.
    assert (x_root <> y_root). {
      intro; subst; apply Htemp; trivial.
    }
    entailer!.
  - Intros. (* xRank = xRoot -> rank; *)
    remember (vgamma g2 x_root) as rpa eqn:?H. destruct rpa as [rankXRoot paXRoot]. symmetry in H13.
    localize [data_at sh node_type (vgamma2cdata (vgamma g2 x_root)) (pointer_val_val x_root)].
    rewrite H13. simpl vgamma2cdata. forward.
    unlocalize [whole_graph sh g2].
    1: rewrite H13; simpl; apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g2 (vvalid g2) x_root (rankXRoot, paXRoot)); auto.
    (* yRank = yRoot -> rank; *)
    remember (vgamma g2 y_root) as rpa eqn:?H. destruct rpa as [rankYRoot paYRoot]. symmetry in H14.
    localize [data_at sh node_type (vgamma2cdata (vgamma g2 y_root)) (pointer_val_val y_root)].
    rewrite H14. simpl vgamma2cdata. forward.
    unlocalize [whole_graph sh g2].
    1: rewrite H14; simpl; apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g2 (vvalid g2) y_root (rankYRoot, paYRoot)); auto.
    rename H_VALID_XROOT into H15. clear H1 H2 H5 H6.
    assert (Int.unsigned (Int.repr (Z.of_nat rankXRoot)) = Z.of_nat (vlabel g2 x_root)). {
      simpl vgamma in H13. inversion H13. apply Int.unsigned_repr. split; [apply Zle_0_nat | specialize (H11 x_root H15); auto].
    } assert (Int.unsigned (Int.repr (Z.of_nat rankYRoot)) = Z.of_nat (vlabel g2 y_root)). {
      simpl vgamma in H14. inversion H14. apply Int.unsigned_repr. split; [apply Zle_0_nat | specialize (H11 y_root H_VALID_YROOT); auto].
    } clear H11.
    forward_if
      (EX g': UFGraph,
       PROP (uf_union g x y g' /\ uf_under_bound g')
       LOCAL (temp _xRank (Vint (Int.repr (Z.of_nat rankXRoot))); temp _yRank (Vint (Int.repr (Z.of_nat rankYRoot)));
              temp _xRoot (pointer_val_val x_root); temp _yRoot (pointer_val_val y_root);
              temp _x (pointer_val_val x); temp _y (pointer_val_val y))
       SEP (whole_graph sh g')).
    + assert (weak_valid g2 y_root) by (right; auto).
      assert (~ reachable g2 y_root x_root) by (intro; destruct H9; specialize (H16 _ H11); auto).
      assert (vertices_at sh (vvalid (Graph_gen_redirect_parent g2 x_root y_root H6 H15 H11)) (Graph_gen_redirect_parent g2 x_root y_root H6 H15 H11) =
              vertices_at sh (vvalid g2) (Graph_gen_redirect_parent g2 x_root y_root H6 H15 H11)). {
        apply vertices_at_Same_set. unfold Ensembles.Same_set, Ensembles.Included, Ensembles.In. simpl. intuition. }
      (* xRoot -> parent = yRoot; *)
      localize [data_at sh node_type (vgamma2cdata (vgamma g2 x_root)) (pointer_val_val x_root)].
      rewrite H13. simpl vgamma2cdata. forward. unlocalize [whole_graph sh (Graph_gen_redirect_parent g2 x_root y_root H6 H15 H11)].
      1: rewrite H13; simpl vgamma2cdata; rewrite H16; apply (@graph_gen_redirect_parent_ramify _ (sSGG_VST sh)); auto.
      Exists (Graph_gen_redirect_parent g2 x_root y_root H6 H15 H11). entailer !. split.
      * apply (diff_root_union_1 g g1 g2 x y x_root y_root); auto.
      * rewrite H1 in *. rewrite H2 in *. rewrite <- Nat2Z.inj_lt in H5. destruct H9. apply uf_under_bound_redirect_parent_lt; auto.
    + assert (weak_valid g2 x_root) by (right; auto). rename H_VALID_YROOT into H11.
      assert (~ reachable g2 x_root y_root) by (intro; rewrite (uf_equiv_root_the_same g1 g2) in H4; auto; destruct H4; specialize (H17 _ H16); auto).
      assert (vertices_at sh (vvalid (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16)) (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16) =
              vertices_at sh (vvalid g2) (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16)). {
        apply vertices_at_Same_set. unfold Ensembles.Same_set, Ensembles.Included, Ensembles.In. simpl. intuition. }
      forward_if
      (EX g': UFGraph,
       PROP (uf_union g x y g' /\ uf_under_bound g')
       LOCAL (temp _xRank (Vint (Int.repr (Z.of_nat rankXRoot))); temp _yRank (Vint (Int.repr (Z.of_nat rankYRoot)));
              temp _xRoot (pointer_val_val x_root); temp _yRoot (pointer_val_val y_root);
              temp _x (pointer_val_val x); temp _y (pointer_val_val y))
       SEP (whole_graph sh g')).
      * (* yRoot -> parent = xRoot; *)
        localize [data_at sh node_type (vgamma2cdata (vgamma g2 y_root)) (pointer_val_val y_root)].
        rewrite H14. simpl vgamma2cdata. forward. unlocalize [whole_graph sh (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16)].
        1: rewrite H14; simpl vgamma2cdata; rewrite H17; apply (@graph_gen_redirect_parent_ramify _ (sSGG_VST sh)); auto.
        Exists (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16). entailer!. split.
        -- apply (diff_root_union_2 g g1 g2 x y x_root y_root); auto.
        -- rewrite H1 in *. rewrite H2 in *. rewrite <- Nat2Z.inj_lt in H18. apply uf_under_bound_redirect_parent_lt; auto.
           rewrite (uf_equiv_root_the_same g1 g2) in H4; auto. destruct H4. auto.
      * (* yRoot -> parent = xRoot; *)
        localize [data_at sh node_type (vgamma2cdata (vgamma g2 y_root)) (pointer_val_val y_root)].
        rewrite H14. simpl vgamma2cdata. forward. unlocalize [whole_graph sh (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16)].
        1: rewrite H14; simpl vgamma2cdata; rewrite H17; apply (@graph_gen_redirect_parent_ramify _ (sSGG_VST sh)); auto.
        set (g3 := Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16).
        assert (uf_union g x y g3) by (subst g3; simpl; apply (diff_root_union_2 g g1 g2 x y x_root y_root); auto).
        (* xRoot -> rank = xRank + 1; *)
        localize [data_at sh node_type (vgamma2cdata (vgamma g2 x_root)) (pointer_val_val x_root)].
        rewrite H13. simpl vgamma2cdata. forward.
        rewrite add_repr. replace (Z.of_nat rankXRoot + 1) with (Z.of_nat (rankXRoot + 1)). 2: rewrite Nat2Z.inj_add; simpl; auto.
        unlocalize [whole_graph sh (Graph_vgen g3 x_root (rankXRoot + 1)%nat)].
        -- assert (vertices_at sh (vvalid (Graph_vgen g3 x_root (rankXRoot + 1)%nat)) (Graph_vgen g3 x_root (rankXRoot + 1)%nat) =
                   vertices_at sh (vvalid g3) (Graph_vgen g3 x_root (rankXRoot + 1)%nat)). {
             apply vertices_at_Same_set. unfold Ensembles.Same_set, Ensembles.Included, Ensembles.In. simpl. intuition.
           } rewrite H20. clear H20. rewrite H13. simpl vgamma2cdata. apply (@graph_vgen_ramify _ (sSGG_VST sh)).
           ++ subst g3. simpl. destruct H8 as [? _]. rewrite <- H8. destruct H4; apply reachable_foot_valid in H4; apply H4.
           ++ subst g3. remember (Graph_gen_redirect_parent g2 y_root x_root H6 H11 H16) as g3.
              apply (graph_gen_redirect_parent_vgamma _ _ _ rankXRoot paXRoot) in Heqg3; auto. intros. inversion H20; auto.
        -- Exists (Graph_vgen g3 x_root (rankXRoot + 1)%nat). entailer!. rewrite H1 in *; rewrite H2 in *.
           assert (Z.of_nat (vlabel g2 x_root) = Z.of_nat (vlabel g2 y_root)) by (clear -H5 H18; intuition). apply Nat2Z.inj in H24.
           simpl in H13. inversion H13. apply uf_under_bound_redirect_parent_eq; auto. rewrite (uf_equiv_root_the_same g1 g2) in H4; auto. destruct H4. auto.
    + Intros g'. Exists g'. entailer!.
Qed. (* Original: 192.772 secs; VST 2.*: 4.786 secs *)


(*! Language | Semantics of typed Kôika programs with compact logs !*)
Require Export Koika.Common Koika.Environments Koika.CompactLogs Koika.Syntax Koika.TypedSyntax.

Section Interp.
  Context {pos_t var_t fn_name_t rule_name_t reg_t ext_fn_t: Type}.
  Context {reg_t_eq_dec: EqDec reg_t}.

  Context {R: reg_t -> type}.
  Context {Sigma: ext_fn_t -> ExternalSignature}.

  Context {REnv: Env reg_t}.

  Notation Log := (Log R REnv).

  Notation rule := (rule pos_t var_t fn_name_t R Sigma).
  Notation action := (action pos_t var_t fn_name_t R Sigma).
  Notation scheduler := (scheduler pos_t rule_name_t).

  Definition tcontext (sig: tsig var_t) :=
    context (fun k_tau => type_denote (snd k_tau)) sig.

  Definition acontext (sig argspec: tsig var_t) :=
    context (fun k_tau => action sig (snd k_tau)) argspec.

  Section Action.
    Context (r: REnv.(env_t) R).
    Context (sigma: forall f, Sig_denote (Sigma f)).

    Section Args.
      Context (interp_action:
                 forall {sig: tsig var_t} {tau}
                   (Gamma: tcontext sig)
                   (sched_log: Log) (action_log: Log)
                   (a: action sig tau),
                   option (Log * type_denote tau * (tcontext sig))).

      Fixpoint interp_args'
               {sig: tsig var_t}
               (Gamma: tcontext sig)
               (sched_log: Log)
               (action_log: Log)
               {argspec: tsig var_t}
               (args: acontext sig argspec)
        : option (Log * tcontext argspec * (tcontext sig)) :=
        match args with
        | CtxEmpty => Some (action_log, CtxEmpty, Gamma)
        | @CtxCons _ _ argspec k_tau arg args =>
          let/opt3 action_log, ctx, Gamma := interp_args' Gamma sched_log action_log args in
          let/opt3 action_log, v, Gamma := interp_action _ _ Gamma sched_log action_log arg in
          Some (action_log, CtxCons k_tau v ctx, Gamma)
        end.
    End Args.

    Fixpoint interp_action
             {sig: tsig var_t}
             {tau}
             (Gamma: tcontext sig)
             (sched_log: Log)
             (action_log: Log)
             (a: action sig tau)
             {struct a}
    : option (Log * tau * (tcontext sig)) :=
      match a in TypedSyntax.action _ _ _ _ _ ts tau return (tcontext ts -> option (Log * tau * (tcontext ts)))  with
      | Fail tau => fun _ =>
        None
      | Var m => fun Gamma =>
        Some (action_log, cassoc m Gamma, Gamma)
      | Const cst => fun Gamma =>
        Some (action_log, cst, Gamma)
      | Seq r1 r2 => fun Gamma =>
        let/opt3 action_log, _, Gamma := interp_action Gamma sched_log action_log r1 in
        interp_action Gamma sched_log action_log r2
      | @Assign _ _ _ _ _ _ _ _ k tau m ex => fun Gamma =>
        let/opt3 action_log, v, Gamma := interp_action Gamma sched_log action_log ex in
        Some (action_log, Ob, creplace m v Gamma)
      | @Bind _ _ _ _ _ _ _ sig tau tau' var ex body => fun (Gamma : tcontext sig) =>
        let/opt3 action_log1, v, Gamma := interp_action Gamma sched_log action_log ex in
        let/opt3 action_log2, v, Gamma := interp_action (CtxCons (var, tau) v Gamma) sched_log action_log1 body in
        Some (action_log2, v, ctl Gamma)
      | If cond tbranch fbranch => fun Gamma =>
        let/opt3 action_log, cond, Gamma := interp_action Gamma sched_log action_log cond in
        if Bits.single cond then
          interp_action Gamma sched_log action_log tbranch
        else
          interp_action Gamma sched_log action_log fbranch
      | Read P0 idx => fun Gamma =>
        if may_read0 sched_log idx then
          Some (Environments.update
                  REnv action_log idx
                  (fun rl => {| lread0 := true; lread1 := rl.(lread1);
                             lwrite0 := rl.(lwrite0); lwrite1 := rl.(lwrite1) |}),
                REnv.(getenv) r idx,
                Gamma)
        else None
      | Read P1 idx => fun Gamma =>
        if may_read1 sched_log idx then
          Some (Environments.update
                  REnv action_log idx
                  (fun rl => {| lread0 := rl.(lread1); lread1 := true;
                             lwrite0 := rl.(lwrite0); lwrite1 := rl.(lwrite1) |}),
                match (REnv.(getenv) action_log idx).(lwrite0), (REnv.(getenv) sched_log idx).(lwrite0) with
                | Some v, _ => v
                | _, Some v => v
                | _, _ => REnv.(getenv) r idx
                end,
                Gamma)
        else None
      | Write P0 idx val => fun Gamma =>
        let/opt3 action_log, val, Gamma_new := interp_action Gamma sched_log action_log val in
        if may_write0 sched_log action_log idx then
          Some (Environments.update
                  REnv action_log idx
                  (fun rl => {| lread0 := rl.(lread1); lread1 := rl.(lread1);
                             lwrite0 := Some val; lwrite1 := rl.(lwrite1) |}),
                Bits.nil, Gamma_new)
        else None
      | Write P1 idx val => fun Gamma =>
        let/opt3 action_log, val, Gamma_new := interp_action Gamma sched_log action_log val in
        if may_write1 sched_log action_log idx then
          Some (Environments.update
                  REnv action_log idx
                  (fun rl => {| lread0 := rl.(lread1); lread1 := rl.(lread1);
                             lwrite0 := rl.(lwrite0); lwrite1 := Some val |}),
                Bits.nil, Gamma_new)
        else None
      | Unop fn arg1 => fun Gamma =>
        let/opt3 action_log, arg1, Gamma := interp_action Gamma sched_log action_log arg1 in
        Some (action_log, (PrimSpecs.sigma1 fn) arg1, Gamma)
      | Binop fn arg1 arg2 => fun Gamma =>
        let/opt3 action_log, arg1, Gamma := interp_action Gamma sched_log action_log arg1 in
        let/opt3 action_log, arg2, Gamma := interp_action Gamma sched_log action_log arg2 in
        Some (action_log, (PrimSpecs.sigma2 fn) arg1 arg2, Gamma)
      | ExternalCall fn arg1 => fun Gamma =>
        let/opt3 action_log, arg1, Gamma := interp_action Gamma sched_log action_log arg1 in
        Some (action_log, sigma fn arg1, Gamma)
      | InternalCall name args body => fun Gamma =>
        let/opt3 action_log, results, Gamma := interp_args' (@interp_action) Gamma sched_log action_log args in
        let/opt3 action_log, v, _ := interp_action results sched_log action_log body in
        Some (action_log, v, Gamma)
      | APos _ a => fun Gamma =>
        interp_action Gamma sched_log action_log a
      end Gamma.

    Definition interp_rule (sched_log: Log) (rl: rule) : option Log :=
      match interp_action CtxEmpty sched_log log_empty rl with
      | Some (l, _, _) => Some l
      | None => None
      end.
  End Action.

  Section Scheduler.
    Context (r: REnv.(env_t) R).
    Context (sigma: forall f, Sig_denote (Sigma f)).
    Context (rules: rule_name_t -> rule).

    Fixpoint interp_scheduler'
             (sched_log: Log)
             (s: scheduler)
             {struct s} :=
      let interp_try rl s1 s2 :=
          match interp_rule r sigma sched_log (rules rl) with
          | Some l => interp_scheduler' (log_app l sched_log) s1
          | None => interp_scheduler' sched_log s2
          end in
      match s with
      | Done => sched_log
      | Cons r s => interp_try r s s
      | Try r s1 s2 => interp_try r s1 s2
      | SPos _ s => interp_scheduler' sched_log s
      end.

    Definition interp_scheduler (s: scheduler) :=
      interp_scheduler' log_empty s.
  End Scheduler.

  Definition interp_cycle (sigma: forall f, Sig_denote (Sigma f)) (rules: rule_name_t -> rule)
             (s: scheduler) (r: REnv.(env_t) R) :=
    commit_update r (interp_scheduler r sigma rules s).
End Interp.

Notation interp_args r sigma Gamma sched_log action_log args :=
  (interp_args' (@interp_action _ _ _ _ _ _ _ _ r sigma) Gamma sched_log action_log args).


From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.

From PromisingLib Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import Progress.

Require Import SimMemory.
Require Import SimPromises.
Require Import SimLocal.
Require Import SimThread.
Require Import iCompatibility.

Require Import FulfillStep.
Require Import ReorderStep.
Require Import ReorderRelFenceCommon.

Require Import ITreeLang.
Require Import Program.

Set Implicit Arguments.

Inductive reorder_release_fenceF: forall R (i2:MemE.t R), Prop :=
| reorder_release_fenceF_load
    l2 o2:
    reorder_release_fenceF (MemE.read l2 o2)
| reorder_release_fenceF_store
    l2 v2 o2
    (ORD21: Ordering.le o2 Ordering.plain \/ Ordering.le Ordering.acqrel o2)
    (ORD22: Ordering.le Ordering.plain o2):
    reorder_release_fenceF (MemE.write l2 v2 o2)
| reorder_release_fenceF_update
    l2 rmw2 or2 ow2
    (ORDW2: Ordering.le ow2 Ordering.plain \/ Ordering.le Ordering.acqrel ow2):
    reorder_release_fenceF (MemE.update l2 rmw2 or2 ow2)
| reorder_release_fenceF_fence:
    reorder_release_fenceF (MemE.fence Ordering.acqrel Ordering.plain)
.

Inductive sim_release_fenceF: forall R
                                     (st_src:itree MemE.t (unit * R)%type) (lc_src:Local.t) (sc1_src:TimeMap.t) (mem1_src:Memory.t)
                                     (st_tgt:itree MemE.t (unit * R)%type) (lc_tgt:Local.t) (sc1_tgt:TimeMap.t) (mem1_tgt:Memory.t), Prop :=
| sim_relese_fenceF_intro
    R (v: R) pview
    lc1_src sc1_src mem1_src
    lc1_tgt sc1_tgt mem1_tgt
    (LOCALF: sim_local pview lc1_src (local_relfenced lc1_tgt)):
    sim_release_fenceF
      (Ret (tt, v)) lc1_src sc1_src mem1_src
      (Vis (MemE.fence Ordering.plain Ordering.acqrel) (fun r => Ret (r, v))) lc1_tgt sc1_tgt mem1_tgt
.

Lemma sim_release_fenceF_step
      R
      st1_src lc1_src sc0_src mem0_src
      st1_tgt lc1_tgt sc0_tgt mem0_tgt
      (SIM: sim_release_fenceF st1_src lc1_src sc0_src mem0_src
                               st1_tgt lc1_tgt sc0_tgt mem0_tgt):
  forall sc1_src sc1_tgt
    mem1_src mem1_tgt
    (SC: TimeMap.le sc1_src sc1_tgt)
    (MEMORY: sim_memory mem1_src mem1_tgt)
    (SC_FUTURE_SRC: TimeMap.le sc0_src sc1_src)
    (SC_FUTURE_TGT: TimeMap.le sc0_tgt sc1_tgt)
    (MEM_FUTURE_SRC: Memory.future_weak mem0_src mem1_src)
    (MEM_FUTURE_TGT: Memory.future_weak mem0_tgt mem1_tgt)
    (WF_SRC: Local.wf lc1_src mem1_src)
    (WF_TGT: Local.wf lc1_tgt mem1_tgt)
    (SC_SRC: Memory.closed_timemap sc1_src mem1_src)
    (SC_TGT: Memory.closed_timemap sc1_tgt mem1_tgt)
    (MEM_SRC: Memory.closed mem1_src)
    (MEM_TGT: Memory.closed mem1_tgt),
    _sim_thread_step (lang (unit * R)%type) (lang (unit * R)%type)
                     ((@sim_thread (lang (unit * R)%type) (lang (unit * R)%type) (sim_terminal eq)) \8/ @sim_release_fenceF R)
                     st1_src lc1_src sc1_src mem1_src
                     st1_tgt lc1_tgt sc1_tgt mem1_tgt.
Proof.
  destruct SIM; ii. right.
  inv STEP_TGT; [inv STEP|dependent destruction STEP; inv LOCAL; ss; dependent destruction STATE]; ss.
  - (* promise *)
    exploit sim_local_promise_relfenced; eauto. i. des.
    esplits.
    + ss.
    + eauto.
    + econs 2. econs 1. econs; eauto.
    + auto.
    + auto.
    + auto.
    + right. econs 1; eauto.
  - (* fence *)
    exploit sim_local_fence_tgt_relfenced; try exact SC; eauto. i. des.
    esplits.
    + ss.
    + eauto.
    + econs 1.
    + auto.
    + auto.
    + auto.
    + left. eapply paco11_mon; [apply sim_itree_ret|]; ss.
Qed.

Lemma sim_release_fenceF_sim_thread R:
  @sim_release_fenceF R <8= (@sim_thread (lang (unit * R)%type) (lang (unit * R)%type) (sim_terminal eq)).
Proof.
  pcofix CIH. i. pfold. ii. ss. splits; ss; ii.
  - right. inv TERMINAL_TGT. inv PR; ss.
  - right. inv PR.
    esplits; eauto.
    eapply sim_local_memory_bot; eauto.
  - exploit sim_release_fenceF_step; try apply PR; try apply SC; eauto. i. des; eauto.
    + right. esplits; eauto.
      left. eapply paco11_mon; eauto. ss.
    + right. esplits; eauto.
Qed.

Lemma reorder_release_fenceF_sim_itree R
      (i1: MemE.t R) (REORDER: reorder_release_fenceF i1):
  sim_itree eq
            (Vis (MemE.fence Ordering.plain Ordering.acqrel) (fun r0 => Vis i1 (fun r => Ret (r0, r))))
            (Vis i1 (fun r => Vis (MemE.fence Ordering.plain Ordering.acqrel) (fun r0 => Ret (r0, r)))).
Proof.
  pcofix CIH. ii. subst. pfold. ii. splits; ii.
  { inv TERMINAL_TGT. eapply f_equal with (f:=observe) in H; ss. }
  { right. esplits; eauto.
    inv LOCAL. apply SimPromises.sem_bot_inv in PROMISES; auto. rewrite PROMISES. auto.
  }
  inv STEP_TGT.
  { (* promise *)
    right.
    inv STEP.
    exploit sim_local_promise_bot; eauto. i. des.
    esplits; try apply SC; eauto; ss.
    econs 2. econs 1; eauto. econs; eauto.
  }
  exploit sim_local_intro_relfenced; eauto. i. des.
  exploit sim_local_nonsynch_src; try exact SC_SRC; eauto using local_relfenced_wf. i. des.
  instantiate (3:=lang (unit * R)) in STEP_SRC.
  instantiate (2:=Vis (MemE.fence Ordering.plain Ordering.acqrel)
                      (fun r0 => Vis i1 (fun r => Ret (r0, r)))) in STEP_SRC.
  exploit Thread.rtc_tau_step_future; eauto. s. i. des.
  exploit sim_local_fence_src_relfenced; eauto. i. des.
  exploit Local.fence_step_future; eauto. i. des.
  inv STEP. inv LOCAL1; ss; dependent destruction STATE; inv REORDER.
  - (* load *)
    right.
    exploit sim_local_read_relfenced; eauto; try refl. i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 2]; eauto. econs. econs.
    + auto.
    + etrans; eauto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* update-load *)
    right.
    guardH ORDW2.
    exploit sim_local_read_relfenced; eauto; try refl. i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 2]; eauto. econs; eauto.
    + auto.
    + etrans; eauto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* write *)
    right.
    guardH ORD21.
    hexploit sim_local_write_relfenced; try exact SC;
      try match goal with
          | [|- is_true (Ordering.le _ _)] => refl
          end; eauto; (try by econs). i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 3]; eauto. econs. econs.
      replace sc2_src with sc1_src; eauto. apply TimeMap.antisym; ss.
    + auto.
    + auto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* update *)
    right.
    guardH ORDW2.
    exploit Local.read_step_future; eauto. i. des.
    exploit sim_local_read_relfenced; eauto; try refl. i. des.
    exploit Local.read_step_future; eauto. i. des.
    hexploit sim_local_write_relfenced; try exact SC;
      try match goal with
          | [|- is_true (Ordering.le _ _)] => refl
          end; eauto; (try by econs). i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 4]; eauto.
      * econs; eauto.
      * replace sc2_src with sc1_src; eauto. apply TimeMap.antisym; ss.
    + auto.
    + auto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* fence *)
    right.
    exploit sim_local_fence_relfenced; try exact SC; eauto; try refl. i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 5]; eauto.
      * econs. econs.
      * replace sc2_src with sc1_src; eauto. apply TimeMap.antisym; ss.
    + auto.
    + auto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* na write *)
    inv LOCAL3. destruct ord; ss.
  - (* racy read *)
    right.
    exploit sim_local_racy_read_relfenced; eauto; try refl. i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 9]; eauto. econs. econs.
    + auto.
    + etrans; eauto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* racy update-load *)
    right.
    guardH ORDW2.
    exploit sim_local_racy_read_relfenced; eauto; try refl. i. des.
    esplits.
    + ss.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs 2. econs; [|econs 9]; eauto. econs; eauto.
    + auto.
    + etrans; eauto.
    + auto.
    + left. eapply paco11_mon; [apply sim_release_fenceF_sim_thread|]; ss.
      econs. eauto.
  - (* racy write *)
    left.
    guardH ORD21.
    exploit sim_local_racy_write_relfenced;
      try match goal with
          | [|- is_true (Ordering.le _ _)] => refl
          end; eauto. i. des.
    unfold Thread.steps_failure. esplits.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs; [|econs 10]; eauto. econs. econs.
    + ss.
  - (* racy update *)
    left.
    guardH ORDW2.
    exploit sim_local_racy_update_relfenced;
      try match goal with
          | [|- is_true (Ordering.le _ _)] => refl
          end; eauto. i. des.
    unfold Thread.steps_failure. esplits.
    + etrans; [eauto|]. econs 2; [|refl]. econs.
      * econs. econs 2. econs; [|econs 5]; eauto. econs. econs.
      * ss.
    + econs 2. econs; [|econs 11]; eauto. econs; eauto.
    + ss.
Qed.


(******************************************************************************)
(** * Compilation correctness from the S_IMM memory model to the ARMv8.3 model *)
(******************************************************************************)

From hahn Require Import Hahn.
Require Import AuxRel2.
Require Import Events.
Require Import Execution.
Require Import Execution_eco.
Require Import Arm.
Require Import imm_bob.
Require Import imm_s_ppo.
Require Import imm_s_rfppo.
Require Import imm_s_hb.
Require Import imm_s.
Require Import imm_ppo.
Require Import imm_hb.
Require Import imm.
Require Import immToARMhelper.
Require Import imm_s_hb_hb.
Require Import ImmFair.
Require Import FairExecution.

Set Implicit Arguments.

Section immToARM.

Variable G : execution.

Notation "'E'" := (acts_set G).
Notation "'lab'" := (lab G).
Notation "'sb'" := (sb G).
Notation "'rf'" := (rf G).
Notation "'co'" := (co G).
Notation "'rmw'" := (rmw G).
Notation "'data'" := (data G).
Notation "'addr'" := (addr G).
Notation "'ctrl'" := (ctrl G).
Notation "'deps'" := (deps G).
Notation "'rmw_dep'" := (rmw_dep G).

Notation "'fre'" := (fre G).
Notation "'rfe'" := (rfe G).
Notation "'coe'" := (coe G).
Notation "'rfi'" := (rfi G).
Notation "'fri'" := (fri G).
Notation "'coi'" := (coi G).
Notation "'fr'" := (fr G).
Notation "'eco'" := (eco G).

Notation "'R'" := (fun a => is_true (is_r lab a)).
Notation "'W'" := (fun a => is_true (is_w lab a)).
Notation "'F'" := (fun a => is_true (is_f lab a)).
Notation "'RW'" := (R ∪₁ W).
Notation "'FR'" := (F ∪₁ R).
Notation "'FW'" := (F ∪₁ W).
Notation "'W_ex'" := (W_ex G).
Notation "'W_ex_acq'" := (W_ex ∩₁ (fun a => is_true (is_xacq lab a))).
Notation "'R_ex'" := (fun a => is_true (R_ex lab a)).

Notation "'loc'" := (loc lab).
Notation "'val'" := (val lab).
Notation "'mod'" := (mod lab).
Notation "'same_loc'" := (same_loc lab).
Notation "'detour'" := (detour G).
Notation "'bob'" := (bob G).

(* imm_s *)
Notation "'s_sw'" := (imm_s_hb.sw G).
Notation "'s_release'" := (imm_s_hb.release G).
Notation "'s_rs'" := (imm_s_hb.rs G).
Notation "'s_hb'" := (imm_s_hb.hb G).
Notation "'s_ppo'" := (imm_s_ppo.ppo G).
Notation "'s_psc_f'" := (imm_s.psc_f G).
Notation "'s_psc_base'" := (imm_s.psc_base G).
Notation "'s_ar_int'" := (imm_s_ppo.ar_int G).

(* imm *)
Notation "'sw'" := (imm_hb.sw G).
Notation "'release'" := (imm_hb.release G).
Notation "'rs'" := (imm_hb.rs G).
Notation "'hb'" := (imm_hb.hb G).
Notation "'ppo'" := (imm_ppo.ppo G).
Notation "'psc'" := (imm.psc G).
Notation "'psc_f'" := (imm.psc_f G).
Notation "'psc_base'" := (imm.psc_base G).
Notation "'ar_int'" := (imm_ppo.ar_int G).

Notation "'Pln'" := (fun a => is_true (is_only_pln lab a)).
Notation "'Rlx'" := (fun a => is_true (is_rlx lab a)).
Notation "'Rel'" := (fun a => is_true (is_rel lab a)).
Notation "'Acq'" := (fun a => is_true (is_acq lab a)).
Notation "'Acqrel'" := (fun a => is_true (is_acqrel lab a)).
Notation "'Acq/Rel'" := (fun a => is_true (is_ra lab a)).
Notation "'Sc'" := (fun a => is_true (is_sc lab a)).

(* arm *)
Notation "'obs'" := (obs G).
Notation "'obs''" := (obs' G).
Notation "'aob'" := (aob G).
Notation "'boba'" := (Arm.bob G).
Notation "'boba''" := (bob' G).
Notation "'dob'" := (dob G).

Notation "'L'" := (W ∩₁ (fun a => is_true (is_rel lab a))).
Notation "'Q'" := (R ∩₁ (fun a => is_true (is_acq lab a))).
Notation "'A'" := (R ∩₁ (fun a => is_true (is_sc  lab a))).

Notation "'F^ld'" := (F ∩₁ (fun a => is_true (is_acq lab a))).
Notation "'F^sy'" := (F ∩₁ (fun a => is_true (is_rel lab a))).

Hypothesis RMW_DEPS : rmw ⊆ ctrl ∪ data.
Hypothesis W_EX_ACQ_SB : ⦗W_ex_acq⦘ ⨾ sb ⊆ sb ⨾ ⦗F^ld⦘ ⨾  sb^?.
Hypothesis DEPS_RMW_SB : rmw_dep ⨾ sb ⊆ ctrl.
Hypothesis REX_IN_RMW_CTRL : ⦗R_ex⦘ ⨾ sb ⊆ ctrl.

Hypothesis CON: ArmConsistent G.

Lemma WF : Wf G.
Proof using CON. apply CON. Qed.
Lemma COMP : complete G.
Proof using CON. apply CON. Qed.
Lemma SC_PER_LOC : sc_per_loc G.
Proof using CON. apply CON. Qed.

Lemma RMW_COI : rmw ⨾ coi ⊆ obs' ∪ dob ∪ aob ∪ boba.
Proof using CON.
  cdes CON. rewrite rmw_in_fri; auto.
  rewrite fri_coi; auto. rewrite fri_in_fr.
  unfold Arm.obs'. eauto with hahn.
Qed.

Lemma R_ex_fail_sb_in_ctrl : ⦗R_ex \₁ dom_rel rmw⦘ ⨾ sb ⊆ ctrl.
Proof using REX_IN_RMW_CTRL.
  rewrite <- REX_IN_RMW_CTRL.
  basic_solver.
Qed.

Lemma s_ppo_in_dob : s_ppo ⊆ dob⁺.
Proof using CON DEPS_RMW_SB REX_IN_RMW_CTRL RMW_DEPS W_EX_ACQ_SB.
  unfold imm_s_ppo.ppo.
  rewrite REX_IN_RMW_CTRL.
  arewrite (data ∪ ctrl ∪ addr ⨾ sb^? ∪ rfi ∪ rmw ∪ rmw_dep ⨾ sb^? ∪ ctrl ⊆
            data ∪ ctrl ∪ addr ⨾ sb^? ∪ rfi ∪ rmw_dep ⨾ sb^?).
  { rewrite RMW_DEPS. unionL; eauto with hahn. }
  rewrite path_union, !seq_union_l, !seq_union_r. unionL.
  { apply ppo_in_dob_helper; auto. }
  assert ((data ∪ ctrl ∪ addr ⨾ sb^? ∪ rfi)＊ ⊆ sb^?) as AA.
  { rewrite (data_in_sb WF), (ctrl_in_sb WF), (addr_in_sb WF).
    arewrite (rfi ⊆ sb).
    generalize (@sb_trans G). ins. relsf. }
  rewrite AA at 2.
  rewrite ct_begin, !seqA.
  rewrite AA at 2.
  arewrite (sb^? ⨾ (sb^? ⨾ rmw_dep ⨾ sb^?)＊ ⨾ sb^? ⊆ sb^?).
  { rewrite (rmw_dep_in_sb WF). generalize (@sb_trans G). ins. relsf. }
  arewrite (rmw_dep ⨾ sb^? ⨾ ⦗W⦘ ⊆ rmw_dep ⨾ sb ⨾ ⦗W⦘).
  { rewrite (dom_r (wf_rmw_depD WF)) at 1. rewrite R_ex_in_R. type_solver. }
  sin_rewrite DEPS_RMW_SB.
  arewrite (ctrl ⊆ data ∪ ctrl ∪ addr ⨾ sb^? ∪ rfi) at 2.
  seq_rewrite <- ct_end.
  apply ppo_in_dob_helper; auto.
Qed.

Lemma s_ppo_in_ord : s_ppo ⊆ (obs⁺ ∩ sb ∪ dob ∪ aob ∪ boba' ∪ sb ⨾ ⦗F^ld⦘)⁺.
Proof using CON DEPS_RMW_SB REX_IN_RMW_CTRL RMW_DEPS W_EX_ACQ_SB.
  rewrite s_ppo_in_dob. apply clos_trans_mori. eauto with hahn.
Qed.

Lemma s_ar_int_in_ord : ⦗R⦘ ⨾ s_ar_int⁺ ⨾ ⦗W⦘ ⊆ (obs ∪ dob ∪ aob ∪ boba')⁺.
Proof using CON DEPS_RMW_SB REX_IN_RMW_CTRL RMW_DEPS W_EX_ACQ_SB.
  unfold imm_s_ppo.ar_int.
  transitivity (⦗R⦘ ⨾  ((obs⁺∩ sb) ∪ dob ∪ aob ∪ boba' ∪ sb ⨾ ⦗F^ld⦘)⁺ ⨾ ⦗W⦘).
  2: { rewrite path_union.
       relsf; unionL.
       { arewrite_id ⦗R⦘; arewrite_id ⦗W⦘.
         rels.
         arewrite (obs⁺ ∩ sb ⊆ obs⁺).
         apply inclusion_t_t2.
         apply_unionL_once.
         apply_unionL_once.
         apply_unionL_once.
         { apply inclusion_t_t. basic_solver. }
         all: rewrite <- ct_step; basic_solver. }
       rewrite (dob_in_sb WF) at 1 2.
       rewrite (aob_in_sb WF) at 1 2.
       rewrite (bob'_in_sb WF) at 1 2.
       arewrite (obs⁺ ∩ sb ⊆ sb).
       rewrite ct_begin.
       arewrite_id ⦗F^ld⦘ at 2.
       generalize (@sb_trans G); ins; relsf.
       arewrite (⦗F^ld⦘ ⨾ sb^? ⨾ ⦗W⦘ ⊆ ⦗F^ld⦘ ⨾ sb) by type_solver.
       unfold Arm.bob', Arm.bob.
       rewrite <- ct_step. basic_solver 21. }
  arewrite (detour ⊆ detour ∩ sb).
  rewrite W_ex_acq_sb_in_boba1; auto.
  rewrite bob_in_boba; auto.
  rewrite detour_in_obs; auto.
  hahn_frame.
  apply inclusion_t_t2.
  apply_unionL_once.
  2: { rewrite <- ct_step. unfold Arm.aob. basic_solver 12. }
  apply_unionL_once.
  2: { apply inclusion_t_t; basic_solver 12. }
  apply_unionL_once.
  2: by unfolder; ins; econs; eauto.
  apply_unionL_once.
  { rewrite <- ct_step; rewrite <- ct_step; unfold Arm.obs; ie_unfolder; basic_solver 12. }
  apply s_ppo_in_ord.
Qed.

Lemma C_EXT_helper: imm_s.acyc_ext G (⦗F∩₁Sc⦘ ⨾ s_hb ⨾ eco ⨾ s_hb ⨾ ⦗F∩₁Sc⦘).
Proof using CON DEPS_RMW_SB REX_IN_RMW_CTRL RMW_DEPS W_EX_ACQ_SB.
  apply (s_acyc_ext_psc_helper WF).
  rewrite s_ar_int_in_ord.
  arewrite (rfe ⊆ (obs ∪ dob ∪ aob ∪ boba')⁺ ).
  { unfold Arm.obs; rewrite <- ct_step; basic_solver 12. }
  arewrite (imm_s.psc G ⊆ imm.psc G).
  { unfold imm_s.psc, imm.psc. by rewrite s_hb_in_hb. }
  rewrite psc_in_ord; auto.
  relsf; red; relsf.
  apply (external_alt_bob' WF CON).
Qed.

Lemma C_SC : acyclic (imm_s.psc_f G ∪ imm_s.psc_base G).
Proof using CON RMW_DEPS W_EX_ACQ_SB.
  unfold imm_s.psc_f, imm_s.psc_base, imm_s.scb.
  rewrite s_hb_in_hb.
  apply immToARMhelper.C_SC; auto.
Qed.

Lemma IMM_s_coherence :
  imm_s_hb.coherence G.
Proof using CON.
  red.
  rewrite crE, seq_union_r, seq_id_r.
  rewrite s_hb_in_hb.
  apply irreflexive_union. split.
  2: { apply COH; auto. }
  rewrite hb_in_ord; auto.
  apply irreflexive_union. split.
  { by apply (@sb_irr G). }
  apply (external_alt_bob' WF CON).
Qed.

Lemma IMM_s_psc_consistent (FINDOM : set_finite E) :
  exists sc, imm_psc_consistent G sc.
Proof using CON DEPS_RMW_SB REX_IN_RMW_CTRL RMW_DEPS W_EX_ACQ_SB.
  edestruct (imm_s.s_acyc_ext_helper WF FINDOM C_EXT_helper) as [sc HH]. desc.
  exists sc. red. splits; eauto.
  2: by apply C_SC.
  red. splits; eauto; try apply CON.
  now apply IMM_s_coherence.
Qed.

Lemma no_ar_int_to_init:
  s_ar_int ≡ s_ar_int ⨾ ⦗set_compl is_init⦘.
Proof using CON.
  split; [| basic_solver]. apply domb_helper.
  rewrite imm_s_ppo.ar_int_in_sb; [| by apply WF].
  erewrite no_sb_to_init. basic_solver.
Qed.

Lemma IMM_s_fsupp
      (FSUPP : fsupp (⦗set_compl is_init⦘ ⨾ (obs ∪ dob ∪ aob ∪ boba')⁺))
      (NOSC : E ∩₁ F ∩₁ Sc ⊆₁ ∅) :
  imm_s_fair G ∅₂.
Proof using W_EX_ACQ_SB RMW_DEPS REX_IN_RMW_CTRL DEPS_RMW_SB CON.
  assert (WF' : Wf G) by apply WF.
  assert (transitive sb) as TSB by apply sb_trans.
  red.
  unfold imm_s.ar. rewrite union_false_l.
  rewrite ct_unionE, seq_union_r.
  assert (fsupp (⦗set_compl is_init⦘ ⨾ s_ar_int⁺)) as AA.
  { rewrite imm_s_ppo.ar_int_in_sb; auto.
    rewrite ct_of_trans; auto.
    by apply fsupp_sb. }
  apply fsupp_union; auto.
  rewrite <- seqA, clos_refl_trans_domb_l.
  2: { rewrite no_ar_int_to_init. basic_solver. }
  rewrite <- seqA. rewrite seqA with (r2 := ⦗set_compl is_init⦘).
  apply fsupp_seq.
  { rewrite rtE, seq_union_r. apply fsupp_union; auto.
    rewrite <- id_inter. apply fsupp_eqv. }
  arewrite (rfe ⊆ rfe ⨾ ⦗set_compl is_init⦘).
  { apply domb_helper. rewrite rfe_in_rf, no_rf_to_init; basic_solver. }
  rewrite (wf_rfeD WF), !seqA.
  rewrite ct_rotl. rewrite <- seqA.

  rewrite <- id_inter. rewrite <- seqA. apply fsupp_seq.
  2: { rewrite <- seqA. apply fsupp_seq.
       { rewrite inclusion_seq_eqv_r, rfe_in_rf. by apply fsupp_rf. }
       rewrite rtE, seq_union_r. apply fsupp_union; auto.
       rewrite <- id_inter. apply fsupp_eqv. }

  seq_rewrite <- id_inter. erewrite eqv_rel_mori with (x := R ∩₁ _).
  2: { unfolder. intros ?. apply proj1. }
  rewrite !seqA.
  arewrite (⦗R⦘ ⨾ s_ar_int＊ ⨾ ⦗W⦘ ⊆ ⦗R⦘ ⨾ s_ar_int⁺ ⨾ ⦗W⦘).
  { rewrite rtE. clear. type_solver. }
  rewrite s_ar_int_in_ord.
  arewrite (rfe ⊆ (obs ∪ dob ∪ aob ∪ boba')⁺).
  { rewrite <- ct_step. unfold Arm.obs. eauto with hahn. }
  rewrite ct_ct, rt_of_ct.
  rewrite rtE, seq_union_r.
  rewrite <- id_inter. apply fsupp_union; [by apply fsupp_eqv| ].
  eapply fsupp_mori; [| by apply FSUPP]. red. basic_solver.
Qed.

Lemma IMM_s_consistent
      (NOSC : E ∩₁ F ∩₁ Sc ⊆₁ ∅):
  imm_psc_consistent G ∅₂.
Proof using W_EX_ACQ_SB RMW_DEPS REX_IN_RMW_CTRL DEPS_RMW_SB CON.
  assert (WF' : Wf G) by apply WF.
  assert (transitive sb) as TSB by apply sb_trans.
  red; splits.
  2: now apply C_SC.
  red. splits; try apply CON.
  { constructor; rewrite ?NOSC.
    all: basic_solver. }
  { red. basic_solver. }
  { now apply IMM_s_coherence. }
  red. unfold imm_s.ar.
  arewrite (∅₂ ⊆ ⦗F∩₁Sc⦘ ⨾ s_hb ⨾ eco ⨾ s_hb ⨾ ⦗F∩₁Sc⦘).
  apply C_EXT_helper.
Qed.

Lemma IMM_s_fsupp_consistent
      (* NEXT TODO: note that here we use boba' instead of original Arm.bob *)
      (FSUPP : fsupp (⦗set_compl is_init⦘ ⨾ (obs ∪ dob ∪ aob ∪ boba')⁺))
      (NOSC : E ∩₁ F ∩₁ Sc ⊆₁ ∅) :
  ⟪ CONS  : imm_psc_consistent G ∅₂ ⟫ /\
  ⟪ FSUPP : imm_s_fair G ∅₂⟫.
Proof using CON DEPS_RMW_SB REX_IN_RMW_CTRL RMW_DEPS W_EX_ACQ_SB.
  auto using IMM_s_consistent, IMM_s_fsupp.
Qed.

End immToARM.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable goal_ : Prop.
Variable dom_ : Universe -> Prop.
Variable bin_count_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.

Variable num_1_ : Universe.
Variable num_0_ : Universe.

Variable initial_model_1 : (dom_ num_0_ /\ (dom_ num_1_ /\ bin_count_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable qed3_2 : (forall A B C D E F G H I J K L M N O P Q R S T U V W X : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X num_1_ num_1_ num_1_ -> goal_)).
Variable qed5_3 : (forall A B C D E F G H I J K L M N O P Q R S T U V : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed10_4 : (forall A B C D E F G H I J K L M N O P Q : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed11_5 : (forall A B C D E F G H I J K L M N O P : Universe, (bin_count_ A B C D E F G H I J K L M N O P num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed12_6 : (forall A B C D E F G H I J K L M N O : Universe, (bin_count_ A B C D E F G H I J K L M N O num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed13_7 : (forall A B C D E F G H I J K L M N : Universe, (bin_count_ A B C D E F G H I J K L M N num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed14_8 : (forall A B C D E F G H I J K L M : Universe, (bin_count_ A B C D E F G H I J K L M num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed15_9 : (forall A B C D E F G H I J K L : Universe, (bin_count_ A B C D E F G H I J K L num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed16_10 : (forall A B C D E F G H I J K : Universe, (bin_count_ A B C D E F G H I J K num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed17_11 : (forall A B C D E F G H I J : Universe, (bin_count_ A B C D E F G H I J num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed18_12 : (forall A B C D E F G H I : Universe, (bin_count_ A B C D E F G H I num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed19_13 : (forall A B C D E F G H : Universe, (bin_count_ A B C D E F G H num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed20_14 : (forall A B C D E F G : Universe, (bin_count_ A B C D E F G num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed21_15 : (forall A B C D E F : Universe, (bin_count_ A B C D E F num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed22_16 : (forall A B C D E : Universe, (bin_count_ A B C D E num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed23_17 : (forall A B C D : Universe, (bin_count_ A B C D num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed24_18 : (forall A B C : Universe, (bin_count_ A B C num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed25_19 : (forall A B : Universe, (bin_count_ A B num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed26_20 : (forall A : Universe, (bin_count_ A num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_)).
Variable qed27_21 : (bin_count_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> goal_).
Variable p27_22 : (forall A B C D E F G H I J K L M N O P Q R S T U V W X Y Z : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z num_0_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z num_1_)).
Variable p26_23 : (forall A B C D E F G H I J K L M N O P Q R S T U V W X Y : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X Y num_0_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X Y num_1_ num_0_)).
Variable p25_24 : (forall A B C D E F G H I J K L M N O P Q R S T U V W X : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X num_0_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W X num_1_ num_0_ num_0_)).
Variable p24_25 : (forall A B C D E F G H I J K L M N O P Q R S T U V W : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W num_0_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T U V W num_1_ num_0_ num_0_ num_0_)).
Variable p23_26 : (forall A B C D E F G H I J K L M N O P Q R S T U V : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U V num_0_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T U V num_1_ num_0_ num_0_ num_0_ num_0_)).
Variable p22_27 : (forall A B C D E F G H I J K L M N O P Q R S T U : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T U num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T U num_1_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p21_28 : (forall A B C D E F G H I J K L M N O P Q R S T : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S T num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S T num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p20_29 : (forall A B C D E F G H I J K L M N O P Q R S : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R S num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R S num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p19_30 : (forall A B C D E F G H I J K L M N O P Q R : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q R num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q R num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p18_31 : (forall A B C D E F G H I J K L M N O P Q : Universe, (bin_count_ A B C D E F G H I J K L M N O P Q num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P Q num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p17_32 : (forall A B C D E F G H I J K L M N O P : Universe, (bin_count_ A B C D E F G H I J K L M N O P num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O P num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p16_33 : (forall A B C D E F G H I J K L M N O : Universe, (bin_count_ A B C D E F G H I J K L M N O num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N O num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p15_34 : (forall A B C D E F G H I J K L M N : Universe, (bin_count_ A B C D E F G H I J K L M N num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M N num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p14_35 : (forall A B C D E F G H I J K L M : Universe, (bin_count_ A B C D E F G H I J K L M num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L M num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p13_36 : (forall A B C D E F G H I J K L : Universe, (bin_count_ A B C D E F G H I J K L num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K L num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p12_37 : (forall A B C D E F G H I J K : Universe, (bin_count_ A B C D E F G H I J K num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J K num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p11_38 : (forall A B C D E F G H I J : Universe, (bin_count_ A B C D E F G H I J num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I J num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p10_39 : (forall A B C D E F G H I : Universe, (bin_count_ A B C D E F G H I num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H I num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p9_40 : (forall A B C D E F G H : Universe, (bin_count_ A B C D E F G H num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G H num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p8_41 : (forall A B C D E F G : Universe, (bin_count_ A B C D E F G num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F G num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p7_42 : (forall A B C D E F : Universe, (bin_count_ A B C D E F num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E F num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p6_43 : (forall A B C D E : Universe, (bin_count_ A B C D E num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D E num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p5_44 : (forall A B C D : Universe, (bin_count_ A B C D num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C D num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p4_45 : (forall A B C : Universe, (bin_count_ A B C num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B C num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p3_46 : (forall A B : Universe, (bin_count_ A B num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A B num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p2_47 : (forall A : Universe, (bin_count_ A num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ A num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_)).
Variable p1_48 : (bin_count_ num_0_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ num_1_ -> bin_count_ num_1_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_ num_0_).

Theorem hdn_020_49 : goal_.
Proof.
  time tac.
Qed.

End FOFProblem.