theory UnitPropagate
imports AssertLiteral
begin
(*********************************************************************************)
(*    A P P L Y    U N I T    P R O P A G A T E                                  *)
(*********************************************************************************)

lemma applyUnitPropagateEffect:
assumes
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"

  "\<not> (getConflictFlag state)"
  "getQ state \<noteq> []"
shows
  "let uLiteral = hd (getQ state) in
   let state' = applyUnitPropagate state in
      \<exists> uClause. formulaEntailsClause (getF state) uClause \<and>
                 isUnitClause uClause uLiteral (elements (getM state)) \<and>
                 (getM state') = (getM state) @ [(uLiteral, False)]"
proof-
  let ?uLiteral = "hd (getQ state)"
  obtain uClause
    where "uClause el (getF state)" "isUnitClause uClause ?uLiteral (elements (getM state))"
    using assms
    unfolding InvariantQCharacterization_def
    by force
  thus ?thesis
    using assms
    using assertLiteralEffect[of "state" "?uLiteral" "False"]
    unfolding applyUnitPropagate_def
    using formulaEntailsItsClauses[of "uClause" "getF state"]
    by (auto simp add: Let_def )
qed

lemma InvariantConsistentAfterApplyUnitPropagate:
assumes
  "InvariantConsistent (getM state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "getQ state \<noteq> []"
  "\<not> (getConflictFlag state)"
shows
  "let state' = applyUnitPropagate state in
     InvariantConsistent (getM state')
  "
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "applyUnitPropagate state"
  obtain uClause
    where "isUnitClause uClause ?uLiteral (elements (getM state))" and
    "(getM ?state') = (getM state) @ [(?uLiteral, False)]"
    using assms
    using applyUnitPropagateEffect[of "state"]
    by (auto simp add: Let_def)
  thus ?thesis
    using assms
    using InvariantConsistentAfterUnitPropagate[of "getM state" "uClause" "?uLiteral" "getM ?state'"]
    by (auto simp add: Let_def)
qed

lemma InvariantUniqAfterApplyUnitPropagate:
assumes
  "InvariantUniq (getM state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "getQ state \<noteq> []"
  "\<not> (getConflictFlag state)"
shows
  "let state' = applyUnitPropagate state in
     InvariantUniq (getM state')
  "
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "applyUnitPropagate state"
  obtain uClause
    where "isUnitClause uClause ?uLiteral (elements (getM state))" and
    "(getM ?state') = (getM state) @ [(?uLiteral, False)]"
    using assms
    using applyUnitPropagateEffect[of "state"]
    by (auto simp add: Let_def)
  thus ?thesis
    using assms
    using InvariantUniqAfterUnitPropagate[of "getM state" "uClause" "?uLiteral" "getM ?state'"]
    by (auto simp add: Let_def)
qed

lemma InvariantWatchCharacterizationAfterApplyUnitPropagate:
assumes
  "InvariantConsistent (getM state)"
  "InvariantUniq (getM state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "(getQ state) \<noteq> []"
  "\<not> (getConflictFlag state)"
shows
  "let state' = applyUnitPropagate state in
        InvariantWatchCharacterization (getF state') (getWatch1 state') (getWatch2 state') (getM state')"
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "assertLiteral ?uLiteral False state"
  let ?state'' = "applyUnitPropagate state"
  have "InvariantConsistent (getM ?state')"
    using assms
    using InvariantConsistentAfterApplyUnitPropagate[of "state"]
    unfolding applyUnitPropagate_def
    by (auto simp add: Let_def)
  moreover
  have "InvariantUniq (getM ?state')"
    using assms
    using InvariantUniqAfterApplyUnitPropagate[of "state"]
    unfolding applyUnitPropagate_def
    by (auto simp add: Let_def)
  ultimately
  show ?thesis
    using assms
    using InvariantWatchCharacterizationAfterAssertLiteral[of "state" "?uLiteral" "False"]
    using assertLiteralEffect
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)
qed

lemma InvariantConflictFlagCharacterizationAfterApplyUnitPropagate:
assumes
  "InvariantConsistent (getM state)"
  "InvariantUniq (getM state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "\<not> getConflictFlag state"
  "getQ state \<noteq> []"
shows
  "let state' = (applyUnitPropagate state) in
      InvariantConflictFlagCharacterization (getConflictFlag state') (getF state') (getM state')"
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "assertLiteral ?uLiteral False state"
  let ?state'' = "applyUnitPropagate state"
  have "InvariantConsistent (getM ?state')"
    using assms
    using InvariantConsistentAfterApplyUnitPropagate[of "state"]
    unfolding applyUnitPropagate_def
    by (auto simp add: Let_def)
  moreover
  have "InvariantUniq (getM ?state')"
    using assms
    using InvariantUniqAfterApplyUnitPropagate[of "state"]
    unfolding applyUnitPropagate_def
    by (auto simp add: Let_def)
  ultimately
  show ?thesis
    using assms
    using InvariantConflictFlagCharacterizationAfterAssertLiteral[of "state" "?uLiteral" "False"]
    using assertLiteralEffect
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)
qed

lemma InvariantConflictClauseCharacterizationAfterApplyUnitPropagate:
assumes
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)"
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsUniq (getWatchList state)"
  "\<not> getConflictFlag state"
shows
   "let state' = applyUnitPropagate state in
    InvariantConflictClauseCharacterization (getConflictFlag state') (getConflictClause state') (getF state') (getM state')"
using assms
using InvariantConflictClauseCharacterizationAfterAssertLiteral[of "state" "hd (getQ state)" "False"]
unfolding applyUnitPropagate_def
unfolding InvariantWatchesEl_def
unfolding InvariantWatchListsContainOnlyClausesFromF_def
unfolding InvariantWatchListsCharacterization_def
unfolding InvariantWatchListsUniq_def
unfolding InvariantConflictClauseCharacterization_def
by (simp add: Let_def)

lemma InvariantQCharacterizationAfterApplyUnitPropagate:
assumes
  "InvariantConsistent (getM state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantUniqQ (getQ state)"
  "(getQ state) \<noteq> []"
  "\<not> (getConflictFlag state)"
shows
  "let state'' = applyUnitPropagate state in
     InvariantQCharacterization (getConflictFlag state'') (getQ state'') (getF state'') (getM state'')"
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "assertLiteral ?uLiteral False state"
  let ?state'' = "applyUnitPropagate state"
  have "InvariantConsistent (getM ?state')"
    using assms
    using InvariantConsistentAfterApplyUnitPropagate[of "state"]
    unfolding applyUnitPropagate_def
    by (auto simp add: Let_def)
  hence "InvariantQCharacterization (getConflictFlag ?state') (removeAll ?uLiteral (getQ ?state')) (getF ?state') (getM ?state')"
    using assms
    using InvariantQCharacterizationAfterAssertLiteral[of "state" "?uLiteral" "False"]
    using assertLiteralEffect[of "state" "?uLiteral" "False"]
    by (simp add: Let_def)
  moreover
  have "InvariantUniqQ (getQ ?state')"
    using assms
    using InvariantUniqQAfterAssertLiteral[of "state" "?uLiteral" "False"]
    by (simp add: Let_def)

  have "?uLiteral = (hd (getQ ?state'))"
  proof-
    obtain s
      where "(getQ state) @ s = getQ ?state'"
      using assms
      using assertLiteralEffect[of "state" "?uLiteral" "False"]
      unfolding isPrefix_def
      by auto
    hence "getQ ?state' = (getQ state) @ s"
      by (rule sym)
    thus ?thesis
      using \<open>getQ state \<noteq> []\<close>
      using hd_append[of "getQ state" "s"]
      by auto
  qed

  hence "set (getQ ?state'') = set (removeAll ?uLiteral (getQ ?state'))"
    using assms
    using \<open>InvariantUniqQ (getQ ?state')\<close>
    unfolding InvariantUniqQ_def
    using uniqHeadTailSet[of "getQ ?state'"]
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)
  ultimately
  show ?thesis
    unfolding InvariantQCharacterization_def
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)
qed

lemma InvariantUniqQAfterApplyUnitPropagate:
assumes
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)"
  "InvariantUniqQ (getQ state)"
  "getQ state \<noteq> []"
shows
  "let state'' = applyUnitPropagate state in
      InvariantUniqQ (getQ state'')"
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "assertLiteral ?uLiteral False state"
  let ?state'' = "applyUnitPropagate state"
  have "InvariantUniqQ (getQ ?state')"
    using assms
    using InvariantUniqQAfterAssertLiteral[of "state" "?uLiteral" "False"]
    by (simp add: Let_def)
  moreover
  obtain s
    where "getQ state @ s = getQ ?state'"
    using assms
    using assertLiteralEffect[of "state" "?uLiteral" "False"]
    unfolding isPrefix_def
    by auto
  hence "getQ ?state' = getQ state @ s"
    by (rule sym)
  with \<open>getQ state \<noteq> []\<close>
  have "getQ ?state' \<noteq> []"
    by simp
  ultimately
  show ?thesis
    using \<open>getQ state \<noteq> []\<close>
    unfolding InvariantUniqQ_def
    unfolding applyUnitPropagate_def
    using hd_Cons_tl[of "getQ ?state'"]
    using uniqAppendIff[of "[hd (getQ ?state')]" "tl (getQ ?state')"]
    by (simp add: Let_def)
qed

lemma InvariantNoDecisionsWhenConflictNorUnitAfterUnitPropagate:
assumes
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantNoDecisionsWhenConflict (getF state) (getM state) (currentLevel (getM state))"
  "InvariantNoDecisionsWhenUnit (getF state) (getM state) (currentLevel (getM state))"
shows
  "let state' = applyUnitPropagate state in
     InvariantNoDecisionsWhenConflict (getF state') (getM state') (currentLevel (getM state')) \<and>
     InvariantNoDecisionsWhenUnit (getF state') (getM state') (currentLevel (getM state'))"
using assms
unfolding applyUnitPropagate_def
using InvariantsNoDecisionsWhenConflictNorUnitAfterAssertLiteral[of "state" "False" "hd (getQ state)"]
unfolding InvariantNoDecisionsWhenConflict_def
by (simp add: Let_def)

lemma InvariantGetReasonIsReasonAfterApplyUnitPropagate:
assumes
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)" and
  "InvariantUniqQ (getQ state)" and
  "InvariantGetReasonIsReason (getReason state) (getF state) (getM state) (set (getQ state))" and
  "getQ state \<noteq> []" and
  "\<not> getConflictFlag state"
shows
  "let state' = applyUnitPropagate state in
     InvariantGetReasonIsReason (getReason state') (getF state') (getM state') (set (getQ state'))"
proof-
  let ?state0 = "state \<lparr> getM := getM state @ [(hd (getQ state), False)]\<rparr>"
  let ?state' = "assertLiteral (hd (getQ state)) False state"
  let ?state'' = "applyUnitPropagate state"

  have "InvariantGetReasonIsReason (getReason ?state0) (getF ?state0) (getM ?state0) (set (removeAll (hd (getQ ?state0)) (getQ ?state0)))"
  proof-

    {
      fix l::Literal
      assume *: "l el (elements (getM ?state0)) \<and> \<not> l el (decisions (getM ?state0)) \<and> elementLevel l (getM ?state0) > 0"
      hence "\<exists> reason. getReason ?state0 l = Some reason \<and> 0 \<le> reason \<and> reason < length (getF ?state0) \<and>
               isReason (nth (getF ?state0) reason) l (elements (getM ?state0))"
      proof (cases "l el (elements (getM state))")
        case True
        from *
        have "\<not> l el (decisions (getM state))"
          by (auto simp add: markedElementsAppend)
        from *
        have "elementLevel l (getM state) > 0"
          using elementLevelAppend[of "l" "getM state" "[(hd (getQ state), False)]"]
          using \<open>l el (elements (getM state))\<close>
          by simp
        show ?thesis
          using \<open>InvariantGetReasonIsReason (getReason state) (getF state) (getM state) (set (getQ state))\<close>
          using \<open>l el (elements (getM state))\<close>
          using \<open>\<not> l el (decisions (getM state))\<close>
          using \<open>elementLevel l (getM state) > 0\<close>
          unfolding InvariantGetReasonIsReason_def
          by (auto simp add: isReasonAppend)
      next
        case False
        with *
        have "l = hd (getQ state)"
          by simp

        have "currentLevel (getM ?state0) > 0"
          using *
          using elementLevelLeqCurrentLevel[of "l" "getM ?state0"]
          by auto
        hence "currentLevel (getM state) > 0"
          unfolding currentLevel_def
          by (simp add: markedElementsAppend)
        moreover
        have "hd (getQ ?state0) el (getQ state)"
          using \<open>getQ state \<noteq> []\<close>
          by simp
        ultimately
        obtain reason
          where "getReason state (hd (getQ state)) = Some reason" "0 \<le> reason \<and> reason < length (getF state)"
          "isUnitClause (nth (getF state) reason) (hd (getQ state)) (elements (getM state)) \<or>
           clauseFalse (nth (getF state) reason) (elements (getM state))"
          using \<open>InvariantGetReasonIsReason (getReason state) (getF state) (getM state) (set (getQ state))\<close>
          unfolding InvariantGetReasonIsReason_def
          by auto
        hence "isUnitClause (nth (getF state) reason) (hd (getQ state)) (elements (getM state))"
          using \<open>\<not> getConflictFlag state\<close>
          using \<open>InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)\<close>
          unfolding InvariantConflictFlagCharacterization_def
          using nth_mem[of "reason" "getF state"]
          using formulaFalseIffContainsFalseClause[of "getF state" "elements (getM state)"]
          by simp
        thus ?thesis
          using \<open>getReason state (hd (getQ state)) = Some reason\<close> \<open>0 \<le> reason \<and> reason < length (getF state)\<close>
          using isUnitClauseIsReason[of "nth (getF state) reason" "hd (getQ state)" "elements (getM state)" "[hd (getQ state)]"]
          using \<open>l = hd (getQ state)\<close>
          by simp
     qed
    }
    moreover
    {
      fix literal::Literal
      assume "currentLevel (getM ?state0) > 0"
      hence "currentLevel (getM state) > 0"
        unfolding currentLevel_def
        by (simp add: markedElementsAppend)

      assume"literal el removeAll (hd (getQ ?state0)) (getQ ?state0)"
      hence "literal \<noteq> hd (getQ state)" "literal el getQ state"
        by auto

      then obtain reason
        where "getReason state literal = Some reason" "0 \<le> reason \<and> reason < length (getF state)" and
        *: "isUnitClause (nth (getF state) reason) literal (elements (getM state)) \<or>
            clauseFalse (nth (getF state) reason) (elements (getM state))"
        using \<open>currentLevel (getM state) > 0\<close>
        using \<open>InvariantGetReasonIsReason (getReason state) (getF state) (getM state) (set (getQ state))\<close>
        unfolding InvariantGetReasonIsReason_def
        by auto
      hence "\<exists> reason. getReason ?state0 literal = Some reason \<and> 0 \<le> reason \<and> reason < length (getF ?state0) \<and>
              (isUnitClause (nth (getF ?state0) reason) literal (elements (getM ?state0)) \<or>
               clauseFalse (nth (getF ?state0) reason) (elements (getM ?state0)))"
      proof (cases "isUnitClause (nth (getF state) reason) literal (elements (getM state))")
        case True
        show ?thesis
        proof (cases "opposite literal = hd (getQ state)")
          case True
          thus ?thesis
            using \<open>isUnitClause (nth (getF state) reason) literal (elements (getM state))\<close>
            using \<open>getReason state literal = Some reason\<close>
            using \<open>literal \<noteq> hd (getQ state)\<close>
            using \<open>0 \<le> reason \<and> reason < length (getF state)\<close>
            unfolding isUnitClause_def
            by (auto simp add: clauseFalseIffAllLiteralsAreFalse)
        next
          case False
          thus ?thesis
            using \<open>isUnitClause (nth (getF state) reason) literal (elements (getM state))\<close>
            using \<open>getReason state literal = Some reason\<close>
            using \<open>literal \<noteq> hd (getQ state)\<close>
            using \<open>0 \<le> reason \<and> reason < length (getF state)\<close>
            unfolding isUnitClause_def
            by auto
        qed
      next
        case False
        with *
        have "clauseFalse (nth (getF state) reason) (elements (getM state))"
          by simp
        thus ?thesis
          using \<open>getReason state literal = Some reason\<close>
          using \<open>0 \<le> reason \<and> reason < length (getF state)\<close>
          using clauseFalseAppendValuation[of "nth (getF state) reason" "elements (getM state)" "[hd (getQ state)]"]
          by auto
      qed
    }
    ultimately
    show ?thesis
      unfolding InvariantGetReasonIsReason_def
      by auto
  qed

  hence "InvariantGetReasonIsReason (getReason ?state') (getF ?state') (getM ?state') (set (removeAll (hd (getQ state)) (getQ state)) \<union> (set (getQ ?state') - set (getQ state)))"
    using assms
    unfolding assertLiteral_def
    unfolding notifyWatches_def
    using InvariantGetReasonIsReasonAfterNotifyWatches[of
      "?state0" "getWatchList ?state0 (opposite (hd (getQ state)))"  "opposite (hd (getQ state))" "getM state" "False"
      "set (removeAll (hd (getQ ?state0)) (getQ ?state0))" "[]"]
    unfolding InvariantWatchListsContainOnlyClausesFromF_def
    unfolding InvariantWatchListsCharacterization_def
    unfolding InvariantWatchListsUniq_def
    by (auto simp add: Let_def)

  obtain s
    where "getQ state @ s = getQ ?state'"
    using assms
    using assertLiteralEffect[of "state" "hd (getQ state)" "False"]
    unfolding isPrefix_def
    by auto
  hence "getQ ?state' = getQ state @ s"
    by simp
  hence "hd (getQ ?state') = hd (getQ state)"
    using hd_append2[of "getQ state" "s"]
    using \<open>getQ state \<noteq> []\<close>
    by simp

  have " set (removeAll (hd (getQ state)) (getQ state)) \<union> (set (getQ ?state') - set (getQ state)) =
         set (removeAll (hd (getQ state)) (getQ ?state'))"
    using \<open>getQ ?state' = getQ state @ s\<close>
    using \<open>getQ state \<noteq> []\<close>
    by auto

  have "uniq (getQ ?state')"
    using assms
    using InvariantUniqQAfterAssertLiteral[of "state" "hd (getQ state)" "False"]
    unfolding InvariantUniqQ_def
    by (simp add: Let_def)

  have "set (getQ ?state'') = set (removeAll (hd (getQ state)) (getQ ?state'))"
    using \<open>uniq (getQ ?state')\<close>
    using \<open>hd (getQ ?state') = hd (getQ state)\<close>
    using uniqHeadTailSet[of "getQ ?state'"]
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)

  thus ?thesis
    using \<open>InvariantGetReasonIsReason (getReason ?state') (getF ?state') (getM ?state') (set (removeAll (hd (getQ state)) (getQ state)) \<union> (set (getQ ?state') - set (getQ state)))\<close>
    using \<open>set (getQ ?state'') = set (removeAll (hd (getQ state)) (getQ ?state'))\<close>
    using \<open>set (removeAll (hd (getQ state)) (getQ state)) \<union> (set (getQ ?state') - set (getQ state)) =
         set (removeAll (hd (getQ state)) (getQ ?state'))\<close>
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)
qed

lemma InvariantEquivalentZLAfterApplyUnitPropagate:
assumes
  "InvariantEquivalentZL (getF state) (getM state) Phi"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"

  "\<not> (getConflictFlag state)"
  "getQ state \<noteq> []"
shows
  "let state' = applyUnitPropagate state in
      InvariantEquivalentZL (getF state') (getM state') Phi
  "
proof-
  let ?uLiteral = "hd (getQ state)"
  let ?state' = "applyUnitPropagate state"
  let ?FM = "getF state @ val2form (elements (prefixToLevel 0 (getM state)))"
  let ?FM' = "getF ?state' @ val2form (elements (prefixToLevel 0 (getM ?state')))"

  obtain uClause
    where "formulaEntailsClause (getF state) uClause" and
    "isUnitClause uClause ?uLiteral (elements (getM state))" and
    "(getM ?state') = (getM state) @ [(?uLiteral, False)]"
    "(getF ?state') = (getF state)"
    using assms
    using applyUnitPropagateEffect[of "state"]
    unfolding applyUnitPropagate_def
    using assertLiteralEffect
    by (auto simp add: Let_def)
  note * = this

  show ?thesis
  proof (cases "currentLevel (getM state) = 0")
    case True
    hence "getM state = prefixToLevel 0 (getM state)"
      by (rule currentLevelZeroTrailEqualsItsPrefixToLevelZero)

    have "?FM' = ?FM @ [[?uLiteral]]"
      using *
      using \<open>(getM ?state') = (getM state) @ [(?uLiteral, False)]\<close>
      using prefixToLevelAppend[of "0" "getM state" "[(?uLiteral, False)]"]
      using \<open>currentLevel (getM state) = 0\<close>
      using \<open>getM state = prefixToLevel 0 (getM state)\<close>
      by (auto simp add: val2formAppend)

    have "formulaEntailsLiteral ?FM ?uLiteral"
      using *
      using unitLiteralIsEntailed [of "uClause" "?uLiteral" "elements (getM state)" "(getF state)"]
      using \<open>InvariantEquivalentZL (getF state) (getM state) Phi\<close>
      using \<open>getM state = prefixToLevel 0 (getM state)\<close>
      unfolding InvariantEquivalentZL_def
      by simp
    hence "formulaEntailsClause ?FM [?uLiteral]"
      unfolding formulaEntailsLiteral_def
      unfolding formulaEntailsClause_def
      by (auto simp add: clauseTrueIffContainsTrueLiteral)

    show ?thesis
      using \<open>InvariantEquivalentZL (getF state) (getM state) Phi\<close>
      using \<open>?FM' = ?FM @ [[?uLiteral]]\<close>
      using \<open>formulaEntailsClause ?FM [?uLiteral]\<close>
      unfolding InvariantEquivalentZL_def
      using extendEquivalentFormulaWithEntailedClause[of "Phi" "?FM" "[?uLiteral]"]
      by (simp add: equivalentFormulaeSymmetry)
  next
    case False
    hence "?FM = ?FM'"
      using *
      using prefixToLevelAppend[of "0" "getM state" "[(?uLiteral, False)]"]
      by (simp add: Let_def)
    thus ?thesis
      using \<open>InvariantEquivalentZL (getF state) (getM state) Phi\<close>
      unfolding InvariantEquivalentZL_def
      by (simp add: Let_def)
  qed
qed

lemma InvariantVarsQTl:
assumes
  "InvariantVarsQ Q F0 Vbl"
  "Q \<noteq> []"
shows
  "InvariantVarsQ (tl Q) F0 Vbl"
proof-
  have "InvariantVarsQ ((hd Q) # (tl Q)) F0 Vbl"
    using assms
    by simp
  hence "{var (hd Q)} \<union> vars (tl Q) \<subseteq> vars F0 \<union> Vbl"
    unfolding InvariantVarsQ_def
    by simp
  thus ?thesis
    unfolding InvariantVarsQ_def
    by simp
qed

lemma InvariantsVarsAfterApplyUnitPropagate:
assumes
  "InvariantConsistent (getM state)"
  "InvariantUniq (getM state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)" and
  "InvariantQCharacterization False (getQ state) (getF state) (getM state)" and
  "getQ state \<noteq> []"
  "\<not> getConflictFlag state"
  "InvariantVarsM (getM state) F0 Vbl" and
  "InvariantVarsQ (getQ state) F0 Vbl" and
  "InvariantVarsF (getF state) F0 Vbl"
shows
  "let state' = applyUnitPropagate state in
     InvariantVarsM (getM state') F0 Vbl \<and>
     InvariantVarsQ (getQ state') F0 Vbl"
proof-
  let ?state' = "assertLiteral (hd (getQ state)) False state"
  let ?state'' = "applyUnitPropagate state"
  have "InvariantVarsQ (getQ ?state') F0 Vbl"
    using assms
    using InvariantConsistentAfterApplyUnitPropagate[of "state"]
    using InvariantUniqAfterApplyUnitPropagate[of "state"]
    using InvariantVarsQAfterAssertLiteral[of "state" "hd (getQ state)" "False" "F0" "Vbl"]
    using assertLiteralEffect[of "state" "hd (getQ state)" "False"]
    unfolding applyUnitPropagate_def
    by (simp add: Let_def)
  moreover
  have "(getQ ?state') \<noteq> []"
    using assms
    using assertLiteralEffect[of "state" "hd (getQ state)" "False"]
    using \<open>getQ state \<noteq> []\<close>
    unfolding isPrefix_def
    by auto
  ultimately
  have "InvariantVarsQ (getQ ?state'') F0 Vbl"
    unfolding applyUnitPropagate_def
    using InvariantVarsQTl[of "getQ ?state'" F0 Vbl]
    by (simp add: Let_def)
  moreover
  have "var (hd (getQ state)) \<in> vars F0 \<union> Vbl"
    using \<open>getQ state \<noteq> []\<close>
    using \<open>InvariantVarsQ (getQ state) F0 Vbl\<close>
    using hd_in_set[of "getQ state"]
    using clauseContainsItsLiteralsVariable[of "hd (getQ state)" "getQ state"]
    unfolding InvariantVarsQ_def
    by auto
  hence "InvariantVarsM (getM ?state'') F0 Vbl"
    using assms
    using assertLiteralEffect[of "state" "hd (getQ state)" "False"]
    using varsAppendValuation[of "elements (getM state)" "[hd (getQ state)]"]
    unfolding applyUnitPropagate_def
    unfolding InvariantVarsM_def
    by (simp add: Let_def)
  ultimately
  show ?thesis
    by (simp add: Let_def)
qed

(*********************************************************************************)
(*   E X H A U S T I V E   U N I T   P R O P A G A T E                           *)
(*********************************************************************************)

definition "lexLessState (Vbl::Variable set) == {(state1, state2).
  (getM state1, getM state2) \<in> lexLessRestricted Vbl}"

lemma exhaustiveUnitPropagateTermination:
fixes
  state::State and Vbl::"Variable set"
assumes
  "InvariantUniq (getM state)"
  "InvariantConsistent (getM state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantUniqQ (getQ state)"
  "InvariantVarsM (getM state) F0 Vbl"
  "InvariantVarsQ (getQ state) F0 Vbl"
  "InvariantVarsF (getF state) F0 Vbl"
  "finite Vbl"
shows
  "exhaustiveUnitPropagate_dom state"
using assms
proof (induct rule: wf_induct[of "lexLessState (vars F0 \<union> Vbl)"])
  case 1
  show ?case
    unfolding wf_eq_minimal
  proof-
    show "\<forall>Q (state::State). state \<in> Q \<longrightarrow> (\<exists>stateMin\<in>Q. \<forall>state'. (state', stateMin) \<in> lexLessState (vars F0 \<union> Vbl) \<longrightarrow> state' \<notin> Q)"
    proof-
      {
        fix Q :: "State set" and state :: State
        assume "state \<in> Q"
        let ?Q1 = "{M::LiteralTrail. \<exists> state. state \<in> Q \<and> (getM state) = M}"
        from \<open>state \<in> Q\<close>
        have "getM state \<in> ?Q1"
          by auto
        have "wf (lexLessRestricted (vars F0 \<union> Vbl))"
          using \<open>finite Vbl\<close>
          using finiteVarsFormula[of "F0"]
          using  wfLexLessRestricted[of "vars F0 \<union> Vbl"]
          by simp
        with \<open>getM state \<in> ?Q1\<close>
        obtain Mmin where "Mmin \<in> ?Q1" "\<forall>M'. (M', Mmin) \<in> lexLessRestricted (vars F0 \<union> Vbl) \<longrightarrow> M' \<notin> ?Q1"
          unfolding wf_eq_minimal
          apply (erule_tac x="?Q1" in allE)
          apply (erule_tac x="getM state" in allE)
          by auto
        from \<open>Mmin \<in> ?Q1\<close> obtain stateMin
          where "stateMin \<in> Q" "(getM stateMin) = Mmin"
          by auto
        have "\<forall>state'. (state', stateMin) \<in> lexLessState (vars F0 \<union> Vbl) \<longrightarrow> state' \<notin> Q"
        proof
          fix state'
          show "(state', stateMin) \<in> lexLessState (vars F0 \<union> Vbl) \<longrightarrow> state' \<notin> Q"
          proof
            assume "(state', stateMin) \<in> lexLessState (vars F0 \<union> Vbl)"
            hence "(getM state', getM stateMin) \<in> lexLessRestricted (vars F0 \<union> Vbl)"
              unfolding lexLessState_def
              by auto
            from \<open>\<forall>M'. (M', Mmin) \<in> lexLessRestricted (vars F0 \<union> Vbl) \<longrightarrow> M' \<notin> ?Q1\<close>
              \<open>(getM state', getM stateMin) \<in> lexLessRestricted (vars F0 \<union> Vbl)\<close> \<open>getM stateMin = Mmin\<close>
            have "getM state' \<notin> ?Q1"
              by simp
            with \<open>getM stateMin = Mmin\<close>
            show "state' \<notin> Q"
              by auto
          qed
        qed
        with \<open>stateMin \<in> Q\<close>
        have "\<exists> stateMin \<in> Q. (\<forall>state'. (state', stateMin) \<in> lexLessState (vars F0 \<union> Vbl) \<longrightarrow> state' \<notin> Q)"
          by auto
      }
      thus ?thesis
        by auto
    qed
  qed
next
  case (2 state')
  note ih = this
  show ?case
  proof (cases "getQ state' = [] \<or> getConflictFlag state'")
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "InvariantWatchCharacterization (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'') (getM ?state'')"
      using ih
      using InvariantWatchCharacterizationAfterApplyUnitPropagate[of "state'"]
      unfolding InvariantQCharacterization_def
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantQCharacterization (getConflictFlag ?state'') (getQ ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantQCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConflictFlagCharacterization (getConflictFlag ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantConflictFlagCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniqQ (getQ ?state'')"
      using ih
      using InvariantUniqQAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConsistent (getM ?state'')"
      using ih
      using InvariantConsistentAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniq (getM ?state'')"
      using ih
      using InvariantUniqAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantVarsM (getM ?state'') F0 Vbl" "InvariantVarsQ (getQ ?state'') F0 Vbl"
      using ih
      using \<open>\<not> (getQ state' = [] \<or> getConflictFlag state')\<close>
      using InvariantsVarsAfterApplyUnitPropagate[of "state'" "F0" "Vbl"]
      by (auto simp add: Let_def)
    moreover
    have "InvariantVarsF (getF ?state'') F0 Vbl"
      unfolding applyUnitPropagate_def
      using assertLiteralEffect[of "state'" "hd (getQ state')" "False"]
      using ih
      by (simp add: Let_def)
    moreover
    have "(?state'', state') \<in> lexLessState (vars F0 \<union> Vbl)"
    proof-
      have "getM ?state'' = getM state' @ [(hd (getQ state'), False)]"
        unfolding applyUnitPropagate_def
        using ih
        using assertLiteralEffect[of "state'" "hd (getQ state')" "False"]
        by (simp add: Let_def)
      thus ?thesis
        unfolding lexLessState_def
        unfolding lexLessRestricted_def
        using lexLessAppend[of "[(hd (getQ state'), False)]" "getM state'"]
        using \<open>InvariantConsistent (getM ?state'')\<close>
        unfolding InvariantConsistent_def
        using \<open>InvariantConsistent (getM state')\<close>
        unfolding InvariantConsistent_def
        using \<open>InvariantUniq (getM ?state'')\<close>
        unfolding InvariantUniq_def
        using \<open>InvariantUniq (getM state')\<close>
        unfolding InvariantUniq_def
        using \<open>InvariantVarsM (getM ?state'') F0 Vbl\<close>
        using \<open>InvariantVarsM (getM state') F0 Vbl\<close>
        unfolding InvariantVarsM_def
        by simp
    qed
    ultimately
    have "exhaustiveUnitPropagate_dom ?state''"
      using ih
      by auto
    thus ?thesis
      using exhaustiveUnitPropagate_dom.intros[of "state'"]
      using False
      by simp
  next
    case True
    show ?thesis
      apply (rule exhaustiveUnitPropagate_dom.intros)
      using True
      by simp
  qed
qed

lemma exhaustiveUnitPropagatePreservedVariables:
assumes
  "exhaustiveUnitPropagate_dom state"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
shows
  "let state' = exhaustiveUnitPropagate state in
       (getSATFlag state') = (getSATFlag state)"
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      by (simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "getSATFlag ?state'' = getSATFlag state'"
      unfolding applyUnitPropagate_def
      using assertLiteralEffect[of "state'" "hd (getQ state')" "False"]
      using ih
      by (simp add: Let_def)
    ultimately
    show ?thesis
      using ih
      using False
      by (simp add: Let_def)
  qed
qed

lemma exhaustiveUnitPropagatePreservesCurrentLevel:
assumes
  "exhaustiveUnitPropagate_dom state"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
shows
  "let state' = exhaustiveUnitPropagate state in
       currentLevel (getM state') = currentLevel (getM state)"
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      by (simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "currentLevel (getM state') = currentLevel (getM ?state'')"
      unfolding applyUnitPropagate_def
      using assertLiteralEffect[of "state'" "hd (getQ state')" "False"]
      using ih
      unfolding currentLevel_def
      by (simp add: Let_def markedElementsAppend)
    ultimately
    show ?thesis
      using ih
      using False
      by (simp add: Let_def)
  qed
qed

lemma InvariantsAfterExhaustiveUnitPropagate:
assumes
  "exhaustiveUnitPropagate_dom state"
  "InvariantConsistent (getM state)"
  "InvariantUniq (getM state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantUniqQ (getQ state)"
  "InvariantVarsQ (getQ state) F0 Vbl"
  "InvariantVarsM (getM state) F0 Vbl"
  "InvariantVarsF (getF state) F0 Vbl"
shows
  "let state' = exhaustiveUnitPropagate state in
       InvariantConsistent (getM state') \<and>
       InvariantUniq (getM state') \<and>
       InvariantWatchListsContainOnlyClausesFromF (getWatchList state') (getF state') \<and>
       InvariantWatchListsUniq (getWatchList state') \<and>
       InvariantWatchListsCharacterization (getWatchList state') (getWatch1 state') (getWatch2 state') \<and>
       InvariantWatchesEl (getF state') (getWatch1 state') (getWatch2 state') \<and>
       InvariantWatchesDiffer (getF state') (getWatch1 state') (getWatch2 state') \<and>
       InvariantWatchCharacterization (getF state') (getWatch1 state') (getWatch2 state') (getM state') \<and>
       InvariantConflictFlagCharacterization (getConflictFlag state') (getF state') (getM state') \<and>
       InvariantQCharacterization (getConflictFlag state') (getQ state') (getF state') (getM state') \<and>
       InvariantUniqQ (getQ state') \<and>
       InvariantVarsQ (getQ state') F0 Vbl \<and>
       InvariantVarsM (getM state') F0 Vbl \<and>
       InvariantVarsF (getF state') F0 Vbl
"
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      using ih
      by (auto simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "InvariantWatchCharacterization (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'') (getM ?state'')"
      using ih
      using InvariantWatchCharacterizationAfterApplyUnitPropagate[of "state'"]
      unfolding InvariantQCharacterization_def
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantQCharacterization (getConflictFlag ?state'') (getQ ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantQCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConflictFlagCharacterization (getConflictFlag ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantConflictFlagCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniqQ (getQ ?state'')"
      using ih
      using InvariantUniqQAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConsistent (getM ?state'')"
      using ih
      using InvariantConsistentAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniq (getM ?state'')"
      using ih
      using InvariantUniqAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantVarsM (getM ?state'') F0 Vbl" "InvariantVarsQ (getQ ?state'') F0 Vbl"
      using ih
      using \<open>\<not> (getConflictFlag state' \<or> getQ state' = [])\<close>
      using InvariantsVarsAfterApplyUnitPropagate[of "state'" "F0" "Vbl"]
      by (auto simp add: Let_def)
    moreover
    have "InvariantVarsF (getF ?state'') F0 Vbl"
      unfolding applyUnitPropagate_def
      using assertLiteralEffect[of "state'" "hd (getQ state')" "False"]
      using ih
      by (simp add: Let_def)
    ultimately
    show ?thesis
      using ih
      using False
      by (simp add: Let_def)
  qed
qed

lemma InvariantConflictClauseCharacterizationAfterExhaustivePropagate:
assumes
  "exhaustiveUnitPropagate_dom state"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantConflictClauseCharacterization (getConflictFlag state) (getConflictClause state) (getF state) (getM state)"
shows
  "let state' = exhaustiveUnitPropagate state in
   InvariantConflictClauseCharacterization (getConflictFlag state') (getConflictClause state') (getF state') (getM state')"
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      using ih
      by (auto simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih(2) ih(3) ih(4) ih(5) ih(6) ih(7)
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "InvariantConflictClauseCharacterization (getConflictFlag ?state'') (getConflictClause ?state'') (getF ?state'') (getM ?state'')"
      using ih(2) ih(3) ih(4) ih(5) ih(6)
      using \<open>\<not> (getConflictFlag state' \<or> getQ state' = [])\<close>
      using InvariantConflictClauseCharacterizationAfterApplyUnitPropagate[of "state'"]
      by (auto simp add: Let_def)
    ultimately
    show ?thesis
      using ih(1) ih(2)
      using False
      by (simp only: Let_def) (blast)
  qed
qed

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih(5) ih(6) ih(7) ih(8) ih(9)
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "InvariantWatchCharacterization (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'') (getM ?state'')"
      using ih
      using InvariantWatchCharacterizationAfterApplyUnitPropagate[of "state'"]
      unfolding InvariantQCharacterization_def
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantQCharacterization (getConflictFlag ?state'') (getQ ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantQCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConflictFlagCharacterization (getConflictFlag ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantConflictFlagCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniqQ (getQ ?state'')"
      using ih
      using InvariantUniqQAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConsistent (getM ?state'')"
      using ih
      using InvariantConsistentAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniq (getM ?state'')"
      using ih
      using InvariantUniqAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantNoDecisionsWhenUnit (getF ?state'') (getM ?state'') (currentLevel (getM ?state''))"
         "InvariantNoDecisionsWhenConflict (getF ?state'') (getM ?state'') (currentLevel (getM ?state''))"
      using ih(5) ih(8) ih(11) ih(12) ih(14) ih(15)
      using InvariantNoDecisionsWhenConflictNorUnitAfterUnitPropagate[of "state'"]
      by (auto simp add: Let_def)
    ultimately
    show ?thesis
      using ih(1) ih(2)
      using False
      by (simp add: Let_def)
  qed
qed

lemma InvariantGetReasonIsReasonAfterExhaustiveUnitPropagate:
assumes
  "exhaustiveUnitPropagate_dom state"
  "InvariantConsistent (getM state)"
  "InvariantUniq (getM state)"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantUniqQ (getQ state)" and
  "InvariantGetReasonIsReason (getReason state) (getF state) (getM state) (set (getQ state))"
shows
  "let state' = exhaustiveUnitPropagate state in
       InvariantGetReasonIsReason (getReason state') (getF state') (getM state') (set (getQ state'))"
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      using ih
      by (auto simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "InvariantWatchCharacterization (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'') (getM ?state'')"
      using ih
      using InvariantWatchCharacterizationAfterApplyUnitPropagate[of "state'"]
      unfolding InvariantQCharacterization_def
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantQCharacterization (getConflictFlag ?state'') (getQ ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantQCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConflictFlagCharacterization (getConflictFlag ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantConflictFlagCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniqQ (getQ ?state'')"
      using ih
      using InvariantUniqQAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConsistent (getM ?state'')"
      using ih
      using InvariantConsistentAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniq (getM ?state'')"
      using ih
      using InvariantUniqAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantGetReasonIsReason (getReason ?state'') (getF ?state'') (getM ?state'') (set (getQ ?state''))"
      using ih
      using InvariantGetReasonIsReasonAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    ultimately
    show ?thesis
      using ih
      using False
      by (simp add: Let_def)
  qed
qed

lemma InvariantEquivalentZLAfterExhaustiveUnitPropagate:
assumes
  "exhaustiveUnitPropagate_dom state"
  "InvariantConsistent (getM state)"
  "InvariantUniq (getM state)"
  "InvariantEquivalentZL (getF state) (getM state) Phi"
  "InvariantWatchListsContainOnlyClausesFromF (getWatchList state) (getF state)" and
  "InvariantWatchListsUniq (getWatchList state)" and
  "InvariantWatchListsCharacterization (getWatchList state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchesEl (getF state) (getWatch1 state) (getWatch2 state)" and
  "InvariantWatchesDiffer (getF state) (getWatch1 state) (getWatch2 state)"
  "InvariantWatchCharacterization (getF state) (getWatch1 state) (getWatch2 state) (getM state)"
  "InvariantConflictFlagCharacterization (getConflictFlag state) (getF state) (getM state)"
  "InvariantQCharacterization (getConflictFlag state) (getQ state) (getF state) (getM state)"
  "InvariantUniqQ (getQ state)"
shows
  "let state' = exhaustiveUnitPropagate state in
      InvariantEquivalentZL (getF state') (getM state') Phi
  "
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      using ih
      by (simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    moreover
    have "InvariantWatchListsContainOnlyClausesFromF (getWatchList ?state'') (getF ?state'')" and
      "InvariantWatchListsUniq (getWatchList ?state'')" and
      "InvariantWatchListsCharacterization (getWatchList ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      "InvariantWatchesEl (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')" and
      "InvariantWatchesDiffer (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'')"
      using ih
      using WatchInvariantsAfterAssertLiteral[of "state'" "hd (getQ state')" "False"]
      unfolding applyUnitPropagate_def
      by (auto simp add: Let_def)
    moreover
    have "InvariantWatchCharacterization (getF ?state'') (getWatch1 ?state'') (getWatch2 ?state'') (getM ?state'')"
      using ih
      using InvariantWatchCharacterizationAfterApplyUnitPropagate[of "state'"]
      unfolding InvariantQCharacterization_def
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantQCharacterization (getConflictFlag ?state'') (getQ ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantQCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConflictFlagCharacterization (getConflictFlag ?state'') (getF ?state'') (getM ?state'')"
      using ih
      using InvariantConflictFlagCharacterizationAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniqQ (getQ ?state'')"
      using ih
      using InvariantUniqQAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantConsistent (getM ?state'')"
      using ih
      using InvariantConsistentAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantUniq (getM ?state'')"
      using ih
      using InvariantUniqAfterApplyUnitPropagate[of "state'"]
      using False
      by (simp add: Let_def)
    moreover
    have "InvariantEquivalentZL (getF ?state'') (getM ?state'') Phi"
      using ih
      using InvariantEquivalentZLAfterApplyUnitPropagate[of "state'" "Phi"]
      using False
      by (simp add: Let_def)
    moreover
    have "currentLevel (getM state') = currentLevel (getM ?state'')"
      unfolding applyUnitPropagate_def
      using assertLiteralEffect[of "state'" "hd (getQ state')" "False"]
      using ih
      unfolding currentLevel_def
      by (simp add: Let_def markedElementsAppend)
    ultimately
    show ?thesis
      using ih
      using False
      by (auto simp only: Let_def)
  qed
qed

lemma conflictFlagOrQEmptyAfterExhaustiveUnitPropagate:
assumes
"exhaustiveUnitPropagate_dom state"
shows
"let state' = exhaustiveUnitPropagate state in
    (getConflictFlag state') \<or> (getQ state' = [])"
using assms
proof (induct state rule: exhaustiveUnitPropagate_dom.induct)
  case (step state')
  note ih = this
  show ?case
  proof (cases "(getConflictFlag state') \<or> (getQ state') = []")
    case True
    with exhaustiveUnitPropagate.simps[of "state'"]
    have "exhaustiveUnitPropagate state' = state'"
      by simp
    thus ?thesis
      using True
      by (simp only: Let_def)
  next
    case False
    let ?state'' = "applyUnitPropagate state'"

    have "exhaustiveUnitPropagate state' = exhaustiveUnitPropagate ?state''"
      using exhaustiveUnitPropagate.simps[of "state'"]
      using False
      by simp
    thus ?thesis
      using ih
      using False
      by (simp add: Let_def)
  qed
qed

end


theory HC_To_UHC_Poly
  imports "../TSTSC_Poly" HC_To_UHC
begin

subsection\<open>The reduction from \<open>HC\<close> to \<open>UHC\<close> is polynomial\<close>
subsubsection\<open>Definitions\<close>

definition "size_uhc = (\<lambda>G. card (verts G) + card (arcs G))"
definition "size_hc = (\<lambda>G. card (verts G))"
definition "hc_to_uhc_space n  = 3 * n+ 9 * n * n + 2"

definition "mop_check_wf_digraph Gr = SPECT [wf_digraph Gr \<mapsto> 1]"
definition "mop_check_finite Gr = SPECT [finite (verts Gr) \<mapsto> 1]"
definition "mop_check_functions Gr = SPECT [((tail Gr = fst \<and> head Gr = snd) \<or> arcs Gr = {}) \<mapsto> 3]"

definition "mop_verts_G Gr = SPECT [ {(v, (0::nat))|v. v \<in> verts Gr} \<union> {(v, 1)|v. v \<in> verts Gr}
  \<union> {(v, 2)|v. v \<in> verts Gr} \<mapsto> 3 * (card (verts Gr))]"

definition "mop_arcs_G Gr = SPECT [
            {((v, 0), (v, 1))|v. v \<in> verts Gr} \<union>{((v, 1), (v, 0))|v. v \<in> verts Gr}\<union>
          {((v, 1), (v, 2))|v. v \<in> verts Gr}\<union>{((v, 2), (v, 1))|v. v \<in> verts Gr}\<union>
          {((v, 2), (u, 0))|v u e. e \<in> arcs Gr \<and> v = tail Gr e \<and> u = head Gr e \<and> u \<noteq> v}\<union>
          {((u, 0), (v, 2))|v u e. e \<in> arcs Gr \<and> v = tail Gr e \<and> u = head Gr e \<and> u \<noteq> v}
    \<mapsto> 3 * card (verts Gr) * 3 * (card (verts Gr))]"

definition "hc_to_uhc_alg = (\<lambda>G.
  do {
    bg \<leftarrow> mop_check_wf_digraph G;
    bfu  \<leftarrow> mop_check_functions G;
    bfi \<leftarrow> mop_check_finite G;
    cVG \<leftarrow> mop_set_card (verts G);
    if bg \<and> bfu then
      do {
        if bfi then
        do {
          if cVG > 1 then
          do {
            V \<leftarrow> mop_verts_G G;
            E  \<leftarrow> mop_arcs_G G;
            RETURNT \<lparr>verts = V, arcs = E, tail = fst, head = snd\<rparr>
          }
          else RETURNT \<lparr>verts = {}, arcs = {}, tail = fst, head = snd\<rparr>
        }
        else RETURNT \<lparr>verts = {(v, 0)|v. v \<in> verts G}, arcs = {}, tail = fst, head = snd\<rparr>
      }
    else RETURNT (let x = (SOME x. x \<in> arcs G) in
      \<lparr>verts = {}, arcs = {((head G x, 0), (head G x, 1))}, tail = fst, head = snd\<rparr>)
  } )"

definition "hc_to_uhc_time n = 6 + 3*n + 3 * n * 3 * n"

subsubsection\<open>Auxiliary proofs\<close>

lemma wf_digraph_card_arcs:
  assumes "wf_digraph Gr" "(tail Gr = fst \<and> head Gr = snd) \<or> arcs Gr = {}"
    "finite (verts Gr)"
  shows "card (arcs Gr) \<le> card (verts Gr) * card (verts Gr)"
proof -
  have "arcs Gr \<subseteq> (verts Gr)\<times> (verts Gr)"
    using assms wf_digraph.head_in_verts wf_digraph.tail_in_verts by fastforce
  then show ?thesis
    using assms by (metis card_cartesian_product card_mono finite_cartesian_product_iff)
qed

lemma card_verts:
  assumes "finite (verts Gr)"
  shows "card (verts (hc_to_uhc Gr)) \<le> 3 * card (verts Gr)"
proof -
  let ?S1 = "{(v, 0::nat)|v. v \<in> verts Gr}" and ?S2 = "{(v, 1::nat)|v. v \<in> verts Gr}"
      and ?S3 = "{(v, 2::nat)|v. v \<in> verts Gr}"
  from assms have
    "card ?S1 \<le> card (verts Gr)" "card ?S2 \<le> card (verts Gr)" "card ?S3 \<le> card (verts Gr)"
    by (auto intro: card_image_le simp: setcompr_eq_image)
  then have "card ?S1 + card ?S2 + card ?S3 \<le> 3 * card (verts Gr)" (is "?lhs \<le> _")
    by auto
  also have "card (?S1 \<union> ?S2 \<union> ?S3) \<le> ?lhs"
    by (rule order.trans, rule card_Un_le) (intro order.refl add_mono card_Un_le)
  ultimately show ?thesis
    using \<open>finite (verts Gr)\<close> unfolding hc_to_uhc_def by (auto simp: Let_def)
qed

lemma card_arcs:
  assumes "finite (verts Gr)" "wf_digraph Gr" "(tail Gr = fst \<and> head Gr = snd) \<or> arcs Gr = {}"
  shows "card(arcs (hc_to_uhc Gr)) \<le> 9 * (card (verts Gr)) * (card (verts Gr))"
proof -
  have "finite (verts (hc_to_uhc Gr))"
    "tail (hc_to_uhc Gr) = fst \<and> head (hc_to_uhc Gr) = snd"
    "wf_digraph (hc_to_uhc Gr)"
    using assms by (auto simp: hc_to_uhc_def wf_digraph_def)
  then have 2: "card (arcs (hc_to_uhc Gr))
      \<le> card (verts (hc_to_uhc Gr)) * card (verts (hc_to_uhc Gr))"
    using wf_digraph_card_arcs by blast
  have "card (verts (hc_to_uhc Gr)) \<le> 3 * card (verts Gr)"
    using assms card_verts assms(1) by auto
  then have "card (arcs (hc_to_uhc Gr)) \<le> 3 * card (verts Gr)* 3 * card (verts Gr)"
    using 2 by (smt le_trans mult.assoc mult_le_mono)
  then show ?thesis
    using assms wf_digraph_card_arcs card_verts by linarith
qed

lemma aux1:
  assumes "finite (verts Gr)" "wf_digraph Gr" "(tail Gr = fst \<and> head Gr = snd) \<or> arcs Gr = {}"
  shows "card (verts (hc_to_uhc Gr))+ card(arcs (hc_to_uhc Gr))
        \<le> 3 * card (verts Gr) + 9 * card (verts Gr) * card (verts Gr)" (is "?A + ?B \<le> ?C")
proof -
  have 1: "?A \<le> 3 * card (verts Gr)"
    using card_verts assms not_wf_digraph_not_arcs_empty by auto
  have "?B \<le> 9 * card (verts Gr) * card (verts Gr)"
    using card_arcs assms not_wf_digraph_not_arcs_empty by auto
  then show ?thesis
    using 1 by simp
qed

subsubsection \<open>Main proofs\<close>

lemma vcs_to_vcl_size: "size_uhc (hc_to_uhc Gr) \<le> hc_to_uhc_space (size_hc Gr)"
proof -
  consider (inf) "infinite (verts Gr)"
    | (not_wf) "\<not> wf_digraph Gr"
    | (not_wf2) "\<not> ((tail Gr = fst \<and> head Gr = snd) \<or> arcs Gr = {})"
    | (wf) "finite (verts Gr)" "wf_digraph Gr" "(tail Gr = fst \<and> head Gr = snd) \<or> arcs Gr = {}"
    by auto
  then show ?thesis
  proof cases
    case inf
    have "infinite {(v, 0 :: nat) |v. v \<in> verts Gr}"
    proof (rule ccontr, simp)
      assume "finite {(v, 0) |v. v \<in> verts Gr}"
      moreover have "verts Gr = fst ` {(v, 0) |v. v \<in> verts Gr}"
        by auto
      ultimately show False
        by (smt inf finite_imageI)
    qed
    then show ?thesis
      by (auto simp: Let_def hc_to_uhc_def size_uhc_def hc_to_uhc_space_def)
  next
    case wf
    then show ?thesis
      using card_arcs card_verts
      by (simp add: size_uhc_def hc_to_uhc_space_def HC_To_UHC_Poly.aux1 le_SucI size_hc_def)
  qed (auto simp: Let_def hc_to_uhc_def size_uhc_def hc_to_uhc_space_def)
qed

lemma vcs_to_vcl_refines:
  "hc_to_uhc_alg Gr \<le> SPEC (\<lambda>y. y = (hc_to_uhc Gr)) (\<lambda>_. hc_to_uhc_time (size_hc Gr))"
  unfolding SPEC_def
  unfolding hc_to_uhc_alg_def hc_to_uhc_def
    mop_check_ugraph_def  mop_check_wf_digraph_def mop_check_functions_def mop_check_finite_def
    mop_arcs_G_def mop_verts_G_def mop_set_card_def
  by (rule T_specifies_I, vcg' \<open>-\<close> rules: T_SPEC )
     (auto simp: hc_to_uhc_time_def one_enat_def size_hc_def numeral_eq_enat)

theorem cnf_sat_to_clique_ispolyred: "ispolyred hc_to_uhc_alg hc uhc size_hc size_uhc"
  unfolding ispolyred_def
  apply(rule exI[where x=hc_to_uhc])
  apply(rule exI[where x=hc_to_uhc_time])
  apply(rule exI[where x=hc_to_uhc_space])
  apply(safe)
  subgoal using vcs_to_vcl_refines by blast
  subgoal using vcs_to_vcl_size by blast
  subgoal unfolding poly_def hc_to_uhc_time_def apply(rule exI[where x=2]) by auto
  subgoal unfolding poly_def hc_to_uhc_space_def apply(rule exI[where x=2]) by auto
  subgoal using is_reduction_hc_uhc .
  done

end


theory javacap_typing
imports
  Main
  javacap_syntax
  javacap_auxiliary
begin

(* \<T> is a tuple of the type and label. This is convenient as they are often used together. *)
type_synonym \<T> = "\<tau> \<times> label"

(* local environment *)
type_synonym lenv = "(var \<rightharpoonup> \<T>)"

(* synonym to provide additional meaning to capability sets passed around *)
type_synonym require_caps = "iname set" (* method requires clause *)
type_synonym parent_caps = "iname set" (* label of parent object *)

(* Method environment. Used as part of the context in which to type-check statements.
   The first component is the class name in which the method is declared.
   The second component is the labelled return type of the method.
   The third component is the requires clause of the method.
   *)
record msenv =
  mscname :: "cname"
  msreturn :: "\<T>"
  msreq :: "require_caps"

(* "(cname \<times> (\<T> \<times> require_caps))"

abbreviation msreq :: "msenv \<Rightarrow> require_caps"
  where "msreq \<equiv> snd"

abbreviation msreturn :: "msenv \<Rightarrow> \<T>"
  where "msreturn \<equiv> fst"*)

definition intersect_label :: "\<T> \<Rightarrow> parent_caps \<Rightarrow> \<T>"
  where "intersect_label \<equiv> (\<lambda>(t,\<gamma>) \<gamma>'. (t,\<gamma> \<inter> \<gamma>'))"

lemma intersect_label_type:
  shows "ttype (intersect_label T \<gamma>) = ttype T"
  unfolding intersect_label_def by (simp add: case_prod_beta')

lemma intersect_label_label:
  shows "tlabel (intersect_label T \<gamma>) = (tlabel T) \<inter> \<gamma>"
  unfolding intersect_label_def by (simp add: case_prod_beta')

lemma intersect_label_vary:
  assumes "T' = intersect_label T \<gamma>0"
  assumes "\<gamma> = (\<gamma>0 \<inter> \<gamma>1)"
  shows "(intersect_label T \<gamma>) = (intersect_label T' \<gamma>1)"
  using assms unfolding intersect_label_def by (simp add: case_prod_beta' inf_assoc)

abbreviation var_type :: "lenv \<Rightarrow> var \<Rightarrow> \<T> option" ("_\<lbrakk>_\<rbrakk>\<^sub>v" 50)
  where "var_type \<equiv> id"

(* Subtyping relation *)
inductive subtype :: "prog \<Rightarrow> \<tau> \<Rightarrow> \<tau> \<Rightarrow> bool" ("_ \<turnstile> _ <: _")  (* \<Gamma> \<turnstile> t1 <: t2, i.e. t1 implements t2 *)
  for P :: "prog"
  where subtype_self:   "P \<turnstile> t <: t" |
        subtype_cextend: "\<lbrakk>t1 \<noteq> Object; (class P t1) = Some c1; (cextends c1 = t2)\<rbrakk> \<Longrightarrow> P \<turnstile> (ClassT t1) <: (ClassT t2)" |
        subtype_cimpl:   "\<lbrakk>(class P t1) = Some c1; (t2 \<in> set (cimpl c1))\<rbrakk> \<Longrightarrow> P \<turnstile> (ClassT t1) <: (IfaceT t2)" |
        subtype_iextend:  "\<lbrakk>(interface P t1) = Some i1; (t2 \<in> set (iextends i1))\<rbrakk> \<Longrightarrow> P \<turnstile> (IfaceT t1) <: (IfaceT t2)" |
        subtype_trans: "\<lbrakk>P \<turnstile> t1 <: t2 ; P \<turnstile> t2 <: t3\<rbrakk> \<Longrightarrow> P \<turnstile> t1 <: t3"

(* Lemmas for subtyping relation *)
lemma subtype_derived_class: (* Classes can only derive classes. *)
  assumes ct1_extends_t0: "(P \<turnstile> ct1 <: (ClassT t0))"
  shows "\<exists>t1. ct1 = (ClassT t1)"
proof -
  have "(P \<turnstile> ct1 <: (ClassT t0))" using ct1_extends_t0 by simp
  then show ?thesis proof (induction "ct1" "(ClassT t0)" arbitrary: t0)
    case (subtype_self)
    then show ?case by simp
  next
    case (subtype_cextend t1 c1 t2)
    then show ?case by simp
  next
    case (subtype_trans t1 t2)
    then show ?case by blast
  qed
qed

lemma subtype_int_parity:
  shows "P \<turnstile> t1 <: t0 \<Longrightarrow> (t1 = ValT t) = (t0 = ValT t)"
proof (induction "t1" "t0" rule:subtype.induct)
  case subtype_self
  then show ?case by simp
next
  case (subtype_cextend t1 c1 t2)
  then show ?case by simp
next
  case (subtype_cimpl t1 c1 t2)
  then show ?case by simp
next
  case subtype_iextend
  then show ?case by simp
next
  case (subtype_trans t1 t2 t3)
  then show ?case by simp
qed

lemma subtype_exists:
  shows "P \<turnstile> t1 <: t0 \<Longrightarrow> is_type P t0 \<Longrightarrow> is_type P t1"
proof (induction "t1" "t0"  rule:subtype.induct)
  case subtype_self
  then show ?case by auto
next
  case (subtype_cextend t1 c1 t2)
  then show ?case using is_class_def by simp
next
  case (subtype_cimpl t1 c1 t2)
  then show ?case using is_class_def by simp
next
  case subtype_iextend
  then show ?case using is_interface_def by simp
next
  case (subtype_trans t1 t2 t3)
  then show ?case using subtype_derived_class by blast
qed

lemma subclass_subtype:
  shows "(c,s)\<in>(subclass P) \<Longrightarrow> P \<turnstile> (ClassT c) <: (ClassT s)"
proof (induction rule:rtrancl_induct)
  case base
  then show ?case using subtype_self by simp
next
  case (step y z)
  moreover have "P \<turnstile> (ClassT y) <: (ClassT z)"
    using step subtype_cextend unfolding direct_subclass_def by blast
  ultimately show ?case using subtype_trans by metis
qed

end