(*
   Title: Psi-calculi
   Based on the AFP entry by Jesper Bengtson (jebe@itu.dk), 2012
*)
theory Weaken_Bisimulation
  imports Weaken_Simulation Weaken_Stat_Imp
begin

context weak
begin

lemma weakenMonoCoinduct: "\<And>x y xa xb xc P Q \<Psi>.
                      x \<le> y \<Longrightarrow>
                      (\<Psi> \<rhd> Q \<leadsto>\<^sub>w<{(xc, xb, xa). x xc xb xa}> P) \<longrightarrow>
                     (\<Psi> \<rhd> Q \<leadsto>\<^sub>w<{(xb, xa, xc). y xb xa xc}> P)"
apply auto
apply(rule weakenSimMonotonic)
by(auto dest: le_funE)

lemma weakenMonoCoinduct2: "\<And>x y xa xb xc P Q \<Psi>.
                      x \<le> y \<Longrightarrow>
                      (\<Psi> \<rhd> Q \<lessapprox>\<^sub>w<{(xc, xb, xa). x xc xb xa}> P) \<longrightarrow>
                     (\<Psi> \<rhd> Q \<lessapprox>\<^sub>w<{(xb, xa, xc). y xb xa xc}> P)"
apply auto
apply(rule weakenStatImpMonotonic)
by(auto dest: le_funE)

coinductive_set weakenBisim :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
where
  step: "\<lbrakk>\<Psi> \<rhd> P \<lessapprox>\<^sub>w<weakenBisim> Q; \<Psi> \<rhd> P \<leadsto>\<^sub>w<weakenBisim> Q;
          \<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>',  P, Q) \<in> weakenBisim; (\<Psi>, Q, P) \<in> weakenBisim\<rbrakk> \<Longrightarrow> (\<Psi>, P, Q) \<in> weakenBisim"
monos weakenMonoCoinduct weakenMonoCoinduct2

abbreviation
  weakenBisimJudge ("_ \<rhd> _ \<approx>\<^sub>w _" [70, 70, 70] 65) where "\<Psi> \<rhd> P \<approx>\<^sub>w Q \<equiv> (\<Psi>, P, Q) \<in> weakenBisim"
abbreviation
  weakenBisimNilJudge ("_ \<approx>\<^sub>w _" [70, 70] 65) where "P \<approx>\<^sub>w Q \<equiv> \<one> \<rhd> P \<approx>\<^sub>w Q"

lemma weakenBisimCoinductAux[consumes 1]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<rhd> P \<lessapprox>\<^sub>w<(X \<union> weakenBisim)> Q) \<and>
                                    (\<Psi> \<rhd> P \<leadsto>\<^sub>w<(X \<union> weakenBisim)> Q) \<and>
                                    (\<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X \<or> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> weakenBisim) \<and>
                                    ((\<Psi>, Q, P) \<in> X \<or> (\<Psi>, Q, P) \<in> weakenBisim)"

  shows "(\<Psi>, P, Q) \<in> weakenBisim"
proof -
  have "X \<union> weakenBisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> weakenBisim}" by auto
  with assms show ?thesis
    by coinduct (simp add: rtrancl_def)
qed

lemma weakenBisimCoinduct[consumes 1, case_names cStatImp cSim cExt cSym]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> \<Psi>' \<rhd> R \<lessapprox>\<^sub>w<(X \<union> weakenBisim)> S"
  and     "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> \<Psi>' \<rhd> R \<leadsto>\<^sub>w<(X \<union> weakenBisim)> S"
  and     "\<And>\<Psi>' R S \<Psi>''. (\<Psi>', R, S) \<in> X \<Longrightarrow> (\<Psi>' \<otimes> \<Psi>'', R, S) \<in> X \<or> \<Psi>' \<otimes> \<Psi>'' \<rhd> R \<approx>\<^sub>w S"
  and     "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> (\<Psi>', S, R) \<in> X \<or> \<Psi>' \<rhd> S \<approx>\<^sub>w R"

  shows "\<Psi> \<rhd> P \<approx>\<^sub>w Q"
proof -
  have "X \<union> weakenBisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> weakenBisim}" by auto
  with assms show ?thesis
    by coinduct (simp add: rtrancl_def)
qed

lemma weakenBisimWeakCoinductAux[consumes 1]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<lessapprox>\<^sub>w<X> Q \<and>
                                     \<Psi> \<rhd> P \<leadsto>\<^sub>w<X> Q \<and> (\<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X) \<and>
                                    (\<Psi>, Q, P) \<in> X"

  shows "\<Psi> \<rhd> P \<approx>\<^sub>w Q"
using assms
by(coinduct rule: weakenBisimCoinductAux) (blast intro: weakenSimMonotonic weakenStatImpMonotonic)

lemma weakenBisimE:
  fixes P  :: "('a, 'b, 'c) psi"
  and   Q  :: "('a, 'b, 'c) psi"
  and   \<Psi>  :: 'b
  and   \<Psi>' :: 'b

  assumes "\<Psi> \<rhd> P \<approx>\<^sub>w Q"

  shows "\<Psi> \<rhd> P \<lessapprox>\<^sub>w<weakenBisim> Q"
  and   "\<Psi> \<rhd> P \<leadsto>\<^sub>w<weakenBisim> Q"
  and   "\<Psi> \<otimes> \<Psi>' \<rhd> P \<approx>\<^sub>w Q"
  and   "\<Psi> \<rhd> Q \<approx>\<^sub>w P"
using assms
by(auto intro: weakenBisim.cases simp add: rtrancl_def)

lemma weakenBisimWeakCoinduct[consumes 1, case_names cStatImp cSim cExt cSym]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<lessapprox>\<^sub>w<X> Q"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>\<^sub>w<X> Q"
  and     "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi>, Q, P) \<in> X"

  shows "(\<Psi>, P, Q) \<in> weakenBisim"
proof -
  have "X \<union> weakenBisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> weakenBisim}" by auto
  with assms show ?thesis
    by(coinduct rule: weakenBisimWeakCoinductAux) blast
qed

lemma weakenBisimEqWeakBisim[simp]: "weakenBisim = weakBisim"
proof auto
  fix \<Psi> P Q
  assume "\<Psi> \<rhd> P \<approx>\<^sub>w Q" thus "\<Psi> \<rhd> P \<approx> Q"
  proof(coinduct rule: weakBisimWeakCoinduct)
    case(cStatImp \<Psi> P Q)
    from `\<Psi> \<rhd> P \<approx>\<^sub>w Q` have "\<Psi> \<rhd> P \<lessapprox>\<^sub>w<weakenBisim> Q" by(rule weakenBisimE)
    thus ?case using weakenBisimE(3) by(rule weakenStatImpWeakStatImp)
  next
    case(cSim \<Psi> P Q)
    from `\<Psi> \<rhd> P \<approx>\<^sub>w Q` weakenBisimE
    show ?case by(rule weakenSimWeakSim)
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by(rule weakenBisimE)
  next
    case(cSym \<Psi> P Q)
    thus ?case by(rule weakenBisimE)
  qed
next
  fix \<Psi> P Q
  assume "\<Psi> \<rhd> P \<approx> Q" thus "\<Psi> \<rhd> P \<approx>\<^sub>w Q"
  proof(coinduct rule: weakenBisimWeakCoinduct)
    case(cStatImp \<Psi> P Q)
    from `\<Psi> \<rhd> P \<approx> Q` have "\<Psi> \<rhd> P \<lessapprox><weakBisim> Q" by(rule weakBisimE)
    thus ?case using statEqWeakBisim by(rule weak_stat_impWeakenStatImp)
  next
    case(cSim \<Psi> P Q)
    from `\<Psi> \<rhd> P \<approx> Q` have "\<Psi> \<rhd> P \<leadsto><weakBisim> Q" by(rule weakBisimE)
    thus ?case using statEqWeakBisim by(rule weakSimWeakenSim)
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by(rule weakBisimE)
  next
    case(cSym \<Psi> P Q)
    thus ?case by(rule weakBisimE)
  qed
qed

lemma weakenTransitiveWeakCoinduct[case_names cStatImp cSim cExt cSym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and rStatImp: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<lessapprox>\<^sub>w<X> Q"
  and rSim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>\<^sub>w<({(\<Psi>, P, Q) | \<Psi> P Q. \<exists>P' Q'. \<Psi> \<rhd> P \<sim> P' \<and>
                                                                        (\<Psi>, P', Q') \<in> X \<and>
                                                                        \<Psi> \<rhd> Q' \<sim> Q})> Q"
  and rExt: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X"
  and rSym: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi>, Q, P) \<in> X"

  shows "\<Psi> \<rhd> P \<approx>\<^sub>w Q"
proof -
  from p `eqvt X` have "\<Psi> \<rhd> P \<approx> Q"
  proof(coinduct rule: weakTransitiveWeakCoinduct)
    case(cStatImp \<Psi> P Q)
    from `(\<Psi>, P, Q) \<in> X` have "\<Psi> \<rhd> P \<lessapprox>\<^sub>w<X> Q" by(rule rStatImp)
    thus ?case using rExt by(rule weakenStatImpWeakStatImp)
  next
    case(cSim \<Psi> P Q)
    let ?Y = "{(\<Psi>, P, Q) | \<Psi> P Q. \<exists>P' Q'. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"
    note `(\<Psi>, P, Q) \<in> X`
    moreover note rStatImp rSim
    moreover have "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> ?Y \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> ?Y"
      by(blast dest: bisimE rExt)
    ultimately show ?case using rSym by(rule weakenSimWeakSim)
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by(rule rExt)
  next
    case(cSym \<Psi> P Q)
    thus ?case by(rule rSym)
  qed
  thus ?thesis by(simp add: weakenBisimEqWeakBisim)
qed

lemma weakenTransitiveCoinduct[case_names cStatImp cSim cExt cSym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and rStatImp: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<lessapprox>\<^sub>w<(X \<union> weakenBisim)> Q"
  and rSim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>\<^sub>w<({(\<Psi>, P, Q) | \<Psi> P Q. \<exists>P' Q'. \<Psi> \<rhd> P \<sim> P' \<and>
                                                                        (\<Psi>, P', Q') \<in> (X \<union> weakenBisim) \<and>
                                                                        \<Psi> \<rhd> Q' \<sim> Q})> Q"
  and rExt: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X \<union> weakenBisim"
  and rSym: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi>, Q, P) \<in> X \<union> weakenBisim"

  shows "\<Psi> \<rhd> P \<approx>\<^sub>w Q"
proof -
  from p have "(\<Psi>, P, Q) \<in> X \<union> weakenBisim" by auto
  moreover from `eqvt X` have "eqvt(X \<union> weakenBisim)" by auto
  ultimately show ?thesis
  proof(coinduct rule: weakenTransitiveWeakCoinduct)
    case(cStatImp \<Psi> P Q)
    thus ?case by(fastforce intro: rStatImp weakenBisimE(1) weakenStatImpMonotonic)
  next
    case(cSim \<Psi> P Q)
    thus ?case by(fastforce intro: rSim weakenBisimE(2) weakenSimMonotonic bisim_reflexive)
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by(blast dest: weakenBisimE rExt)
  next
    case(cSym \<Psi> P Q)
    thus ?case by(blast dest: weakenBisimE rSym)
  qed
qed

end

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |                January 2006               |
            |                  March 2007  (modified)   |
            |                 August 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory FNF_F_sf_int
imports FNF_F_sf_def
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  disj_not1: (~ P | Q) = (P --> Q)                   *)

declare disj_not1 [simp del]

(*  The following simplification rules are deleted in this theory file *)
(*       P (if Q then x else y) = ((Q --> P x) & (~ Q --> P y))        *)
(* Isabelle 2017: split_if --> if_split *)

declare if_split  [split del]

(*****************************************************************

         1. full sequentialization for Rep_int_choice_nat
         2. full sequentialization for Rep_int_choice_set
         3. full sequentialization for Int_choice
         3.

 *****************************************************************)

(*============================================================*
 |                                                            |
 |                    Rep_int_choice_nat                      |
 |                                                            |
 *============================================================*)

definition
  fsfF_Rep_int_choice ::
  "'a sets_nats => ('a aset_anat => ('p,'a) proc) => ('p,'a) proc"
  where
  fsfF_Rep_int_choice_def :
    "fsfF_Rep_int_choice C SPf ==
     if (sumset C = {}) then SDIV else !! :C .. SPf"

syntax
  "_fsfF_Rep_int_choice" ::
      "'a sets_nats => ('a aset_anat => ('p,'a) proc) => ('p,'a) proc"
                                     ("(1!! :_ ..seq /_)" [900,68] 68)
  "@fsfF_Rep_int_choice"::
      "pttrn => 'a sets_nats => ('p,'a) proc => ('p,'a) proc"
                               ("(1!! _:_ ..seq /_)" [900,900,68] 68)

translations
  "!! :C ..seq SPf"  == "CONST fsfF_Rep_int_choice C SPf"
  "!! c:C ..seq SP"  == "!! :C ..seq (%c. SP)"

(*------------------------------------------------------------*
 |                        in fsfF_proc                        |
 *------------------------------------------------------------*)

lemma fsfF_Rep_int_choice_in:
  "ALL c: sumset C. SPf c : fsfF_proc ==> !! :C ..seq SPf : fsfF_proc"
apply (simp add: fsfF_Rep_int_choice_def)

(* Isabelle 2017 *)
 apply (simp split: if_split)
 apply (intro impI)

 apply (rule fsfF_procI)
 apply (simp)
done

(*------------------------------------------------------------*
 |             syntactical transformation to fsfF             |
 *------------------------------------------------------------*)

lemma cspF_fsfF_Rep_int_choice_eqF:
  "!! :C .. SPf =F !! :C ..seq SPf"
apply (simp add: fsfF_Rep_int_choice_def)
apply (case_tac "sumset C={}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_DIV)
apply (simp)
apply (rule cspF_SDIV_eqF)

      (* N~={} *)
apply (simp)
done

(* =F also can be semi-automatically proven by using tactics. *)
(*
lemma "!! :C .. SPf =F !! :C ..seq SPf"
apply (simp add: fsfF_Rep_int_choice_def)
  apply (case_tac "sumset C={}")
  apply (cspF_hsf)
apply (rule cspF_SDIV_eqF)
done
*)

lemmas cspF_fsfF_Rep_int_choice_eqF_sym =
       cspF_fsfF_Rep_int_choice_eqF[THEN cspF_sym]

(*============================================================*
 |                                                            |
 |                       for convenience                      |
 |                                                            |
 *============================================================*)

definition
  fsfF_Rep_int_choice_set ::
    "'a set set => ('a set => ('p,'a) proc) => ('p,'a) proc"
                                      ("(1!set :_ ..seq /_)" [900,68] 68)
  where
  fsfF_Rep_int_choice_set_def:
        "!set :Xs ..seq Pf == !! c:(type1 Xs) ..seq (Pf ((inv type1) c))"

definition
  fsfF_Rep_int_choice_nat ::
    "nat set => (nat => ('p,'a) proc) => ('p,'a) proc"
                                      ("(1!nat :_ ..seq /_)" [900,68] 68)
  where
  fsfF_Rep_int_choice_nat_def:
        "!nat :N ..seq Pf == !! c:(type2 N) ..seq (Pf ((inv type2) c))"

syntax
  "@fsfF_Rep_int_choice_set" ::
       "pttrn => ('a set) set => ('a set => ('p,'a) proc) => ('p,'a) proc"
                                      ("(1!set _:_ ..seq /_)" [900,900,68] 68)
  "@fsfF_Rep_int_choice_nat" ::
       "pttrn => nat set => (nat => ('p,'a) proc) => ('p,'a) proc"
                                      ("(1!nat _:_ ..seq /_)" [900,900,68] 68)

translations
    "!set X:Xs ..seq P" == "!set :Xs ..seq (%X. P)"
    "!nat n:N ..seq P"  == "!nat :N ..seq (%n. P)"

(* com *)

definition
  fsfF_Rep_int_choice_com :: "'a set => ('a => ('p,'a) proc) => ('p,'a) proc"
                                      ("(1! :_ ..seq /_)" [900,68] 68)
  where
  fsfF_Rep_int_choice_com_def:
     "! :A ..seq Pf == !set X:{{a} |a. a : A} ..seq Pf (the_elem(X))"

syntax
  "@fsfF_Rep_int_choice_com" ::
      "pttrn => 'a set => ('a => ('p,'a) proc) => ('p,'a) proc"
                                      ("(1! _:_ ..seq /_)" [900,900,68] 68)
translations
    "! x:X ..seq P"    == "! :X ..seq (%x. P)"

(* f *)

definition
  fsfF_Rep_int_choice_f :: "('b => 'a)
          => 'b set => ('b => ('p,'a) proc) => ('p,'a) proc"
                                        ("(1!<_> :_ ..seq /_)" [0,900,68] 68)
  where
  fsfF_Rep_int_choice_f_def :
        "!<f> :X ..seq Pf == ! :(f ` X) ..seq (%x. (Pf ((inv f) x)))"

syntax
  "@fsfF_Rep_int_choice_f"::
  "('b => 'a) => pttrn => 'b set => ('p,'a) proc => ('p,'a) proc"
                               ("(1!<_> _:_ ..seq /_)" [0,900,900,68] 68)
translations
  "!<f> x:X ..seq P"   == "!<f> :X ..seq (%x. P)"

(*============================================================*
 |                                                            |
 |                 convenient expressions                     |
 |                                                            |
 *============================================================*)

(*------------------------------------*
 |                 in                 |
 *------------------------------------*)

lemma fsfF_Rep_int_choice_nat_in:
  "ALL n:N. SPf n : fsfF_proc ==>
       !nat :N ..seq SPf : fsfF_proc"
apply (simp add: fsfF_Rep_int_choice_nat_def)
apply (rule fsfF_Rep_int_choice_in)
apply (auto)
done

lemma fsfF_Rep_int_choice_set_in:
  "ALL X:Xs. SPf X : fsfF_proc ==>
       !set :Xs ..seq SPf : fsfF_proc"
apply (simp add: fsfF_Rep_int_choice_set_def)
apply (rule fsfF_Rep_int_choice_in)
apply (auto)
done

lemma fsfF_Rep_int_choice_com_in:
  "ALL x:X. SPf x : fsfF_proc ==>
       ! :X ..seq SPf : fsfF_proc"
apply (simp add: fsfF_Rep_int_choice_com_def)
apply (rule fsfF_Rep_int_choice_set_in)
apply (auto)
done

lemma fsfF_Rep_int_choice_f_in:
  "[| inj f ; ALL x:X. SPf x : fsfF_proc |] ==>
    !<f> :X ..seq SPf : fsfF_proc"
apply (insert fsfF_Rep_int_choice_com_in[of "(f ` X)" "(%x. SPf (inv f x))"])
apply (simp add: fsfF_Rep_int_choice_f_def)
done

(*------------------------------------*
 |                 eqF                |
 *------------------------------------*)

lemma cspF_fsfF_Rep_int_choice_nat_eqF:
  "!nat :N .. SPf =F !nat :N ..seq SPf"
apply (simp add: fsfF_Rep_int_choice_nat_def)
apply (simp add: Rep_int_choice_nat_def)
apply (simp add: cspF_fsfF_Rep_int_choice_eqF)
done

lemma cspF_fsfF_Rep_int_choice_set_eqF:
  "!set :Xs .. SPf =F !set :Xs ..seq SPf"
apply (simp add: fsfF_Rep_int_choice_set_def)
apply (simp add: Rep_int_choice_set_def)
apply (simp add: cspF_fsfF_Rep_int_choice_eqF)
done

lemma cspF_fsfF_Rep_int_choice_com_eqF:
  "! :X .. SPf =F ! :X ..seq SPf"
apply (simp add: fsfF_Rep_int_choice_com_def)
apply (simp add: Rep_int_choice_com_def)
apply (simp add: cspF_fsfF_Rep_int_choice_set_eqF)
done

lemma cspF_fsfF_Rep_int_choice_f_eqF:
  "inj f ==>
   !<f> :X .. SPf =F !<f> :X ..seq SPf"
apply (insert cspF_fsfF_Rep_int_choice_com_eqF
              [of "(f ` X)" "(%x. SPf (inv f x))"])
apply (simp add: Rep_int_choice_f_def)
apply (simp add: fsfF_Rep_int_choice_f_def)
done

(*============================================================*
 |                                                            |
 |                        Int_choice                          |
 |                                                            |
 *============================================================*)

definition
  fsfF_Int_choice ::
  "('p,'a) proc => ('p,'a) proc => ('p,'a) proc"
        ("(1_ /|~|seq _)" [64,65] 64)

  where
  fsfF_Int_choice_def :
    "P |~|seq Q ==
           !nat : {0, (Suc 0)} ..
               (%x. if (x = 0) then P else Q)"

(*------------------------------------------------------------*
 |                        in fsfF_proc                        |
 *------------------------------------------------------------*)

lemma fsfF_Int_choice_in:
  "[| P : fsfF_proc ; Q : fsfF_proc |] ==>
   P |~|seq Q : fsfF_proc"
apply (simp add: fsfF_Int_choice_def)
apply (simp add: Rep_int_choice_ss_def)
apply (rule fsfF_proc_int)
apply (auto)
done

(*------------------------------------------------------------*
 |             syntactical transformation to fsfF             |
 *------------------------------------------------------------*)

lemma cspF_fsfF_Int_choice_eqF:
  "P |~| Q =F P |~|seq Q"
apply (simp add: fsfF_Int_choice_def)
apply (rule cspF_rw_left)
apply (rule cspF_Int_choice_to_Rep)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_IF_split)
apply (auto)
done

(****************** to add them again ******************)

declare if_split    [split]
declare disj_not1   [simp]

end


(*
  Author: Mohammad Abdulaziz
*)

theory Solve_SASP
  imports AST_SAS_Plus_Equivalence "SAT_Solve_SAS_Plus"
          "HOL-Data_Structures.RBT_Map" "HOL-Library.Code_Target_Nat" HOL.String
          AI_Planning_Languages_Semantics.SASP_Checker Set2_Join_RBT
begin

subsection \<open>SAT encoding works for Fast-Downward's representation\<close>

context abs_ast_prob
begin

theorem is_serial_sol_then_valid_plan_encoded:
  "\<A> \<Turnstile> \<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop abs_prob)) t \<Longrightarrow>
   valid_plan
        (decode_abs_plan
           (rem_noops
                   (map (\<lambda>op. \<phi>\<^sub>O\<inverse> (prob_with_noop abs_prob) op)
                        (concat (\<Phi>\<inverse> (\<phi> (prob_with_noop abs_prob)) \<A> t)))))"
  by (fastforce intro!: is_serial_sol_then_valid_plan abs_prob_valid
                        sas_plus_problem_has_serial_solution_iff_i')

lemma length_abs_ast_plan: "length \<pi>s = length (abs_ast_plan \<pi>s)"
  by (auto simp: abs_ast_plan_def)

theorem valid_plan_then_is_serial_sol_encoded:
  "valid_plan \<pi>s \<Longrightarrow> length \<pi>s \<le>  h \<Longrightarrow> \<exists>\<A>. \<A> \<Turnstile> \<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop abs_prob)) h"
  apply(subst (asm) length_abs_ast_plan)
  by (fastforce intro!: sas_plus_problem_has_serial_solution_iff_ii' abs_prob_valid
                        valid_plan_then_is_serial_sol)
end

section \<open>DIMACS-like semantics for CNF formulae\<close>

text \<open>We now push the SAT encoding towards a lower-level representation by replacing the atoms which
      have variable IDs and time steps into natural numbers.\<close>

lemma gtD: "((l::nat) < n) \<Longrightarrow> (\<exists>m. n = Suc m \<and> l \<le> m)"
  by (induction n) auto

locale cnf_to_dimacs =
  fixes h :: nat and n_ops :: nat
begin

fun var_to_dimacs where
  "var_to_dimacs (Operator t k) = 1 + t + k * h"
| "var_to_dimacs (State t k) = 1 + n_ops * h + t + k * (h)"

definition dimacs_to_var where
  "dimacs_to_var v \<equiv>
     if v < 1 + n_ops * h then
       Operator ((v - 1) mod (h)) ((v - 1) div (h))
     else
       (let k = ((v - 1) - n_ops * h) in
          State (k mod (h)) (k div (h)))"

fun valid_state_var where
  "valid_state_var (Operator t k) \<longleftrightarrow> t < h \<and> k < n_ops"
| "valid_state_var (State t k) \<longleftrightarrow> t < h"

lemma State_works:
"valid_state_var (State t k) \<Longrightarrow>
      dimacs_to_var (var_to_dimacs (State t k)) =
         (State t k)"
  by (induction k) (auto simp add: dimacs_to_var_def add.left_commute Let_def)

lemma Operator_works:
   "valid_state_var (Operator t k) \<Longrightarrow>
      dimacs_to_var (var_to_dimacs (Operator t k)) =
         (Operator t k)"
  by (induction k) (auto simp add: algebra_simps dimacs_to_var_def gr0_conv_Suc nat_le_iff_add dest!: gtD)

lemma sat_plan_to_dimacs_works:
  "valid_state_var sv \<Longrightarrow>
     dimacs_to_var (var_to_dimacs sv) = sv"
  apply(cases sv)
  using State_works Operator_works
  by auto

end

lemma changing_atoms_works:
  "(\<And>x. P x \<Longrightarrow> (f o g) x = x) \<Longrightarrow> (\<forall>x\<in>atoms phi. P x) \<Longrightarrow> M \<Turnstile> phi \<longleftrightarrow> M o f \<Turnstile> map_formula g phi"
  by (induction phi) auto

lemma changing_atoms_works':
  "M o g \<Turnstile> phi \<longleftrightarrow> M  \<Turnstile> map_formula g phi"
  by (induction phi) auto

context cnf_to_dimacs
begin

lemma sat_plan_to_dimacs:
  "(\<And>sv. sv\<in>atoms sat_plan_formula \<Longrightarrow> valid_state_var sv) \<Longrightarrow>
       M \<Turnstile> sat_plan_formula
         \<longleftrightarrow> M o dimacs_to_var \<Turnstile> map_formula var_to_dimacs sat_plan_formula"
  by(auto intro!: changing_atoms_works[where P = valid_state_var] simp: sat_plan_to_dimacs_works)

lemma dimacs_to_sat_plan:
  "M o var_to_dimacs \<Turnstile> sat_plan_formula
     \<longleftrightarrow> M \<Turnstile> map_formula var_to_dimacs sat_plan_formula"
  using changing_atoms_works' .

end

locale sat_solve_sasp = abs_ast_prob "\<Pi>" + cnf_to_dimacs "Suc h" "Suc (length ast\<delta>)"
  for \<Pi> h
begin

lemma encode_initial_state_valid:
  "sv \<in> atoms (encode_initial_state Prob) \<Longrightarrow> valid_state_var sv"
  by (auto simp add: encode_state_variable_def Let_def encode_initial_state_def split: sat_plan_variable.splits bool.splits)

lemma length_operators: "length (operators_of (\<phi> (prob_with_noop abs_prob))) = Suc (length ast\<delta>)"
  by(simp add: abs_prob_def abs_ast_operator_section_def sas_plus_problem_to_strips_problem_def prob_with_noop_def)

lemma encode_operator_effect_valid_1: "t < h \<Longrightarrow> op \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
       sv \<in> atoms
        (\<^bold>\<And>(map (\<lambda>v.
              \<^bold>\<not>(Atom (Operator t (index (operators_of (\<phi> (prob_with_noop abs_prob))) op)))
              \<^bold>\<or> Atom (State (Suc t) (index vs v)))
            asses)) \<Longrightarrow>
       valid_state_var sv"
  using length_operators
  by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)

lemma encode_operator_effect_valid_2: "t < h \<Longrightarrow> op \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
       sv \<in> atoms
        (\<^bold>\<And>(map (\<lambda>v.
              \<^bold>\<not>(Atom (Operator t (index (operators_of (\<phi> (prob_with_noop abs_prob))) op)))
               \<^bold>\<or> \<^bold>\<not> (Atom (State (Suc t) (index vs v))))
            asses)) \<Longrightarrow>
       valid_state_var sv"
  using length_operators
  by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)

end

lemma atoms_And_append: "atoms (\<^bold>\<And> (as1 @ as2)) = atoms (\<^bold>\<And> as1) \<union>  atoms (\<^bold>\<And> as2)"
  by (induction as1) auto

context sat_solve_sasp
begin

lemma encode_operator_effect_valid:
  "sv \<in> atoms (encode_operator_effect (\<phi> (prob_with_noop abs_prob)) t op) \<Longrightarrow>
    t < h \<Longrightarrow> op \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
    valid_state_var sv"
  by (force simp: encode_operator_effect_def Let_def atoms_And_append
            intro!: encode_operator_effect_valid_1 encode_operator_effect_valid_2)

end

lemma foldr_And: "foldr (\<^bold>\<and>) as (\<^bold>\<not> \<bottom>) = (\<^bold>\<And> as)"
  by (induction as) auto

context sat_solve_sasp
begin

lemma encode_all_operator_effects_valid:
   "t < Suc h \<Longrightarrow>
    sv \<in> atoms (encode_all_operator_effects (\<phi> (prob_with_noop abs_prob)) (operators_of (\<phi> (prob_with_noop abs_prob))) t) \<Longrightarrow>
    valid_state_var sv"
  unfolding encode_all_operator_effects_def foldr_And
  by (force simp add: encode_operator_effect_valid)

lemma encode_operator_precondition_valid_1:
  "t < h \<Longrightarrow> op \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
       sv \<in> atoms
        (\<^bold>\<And>(map (\<lambda>v.
        \<^bold>\<not> (Atom (Operator t (index (operators_of (\<phi> (prob_with_noop abs_prob))) op))) \<^bold>\<or> Atom (State t (f v)))
      asses)) \<Longrightarrow>
       valid_state_var sv"
  using length_operators
  by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)

lemma encode_operator_precondition_valid:
  "sv \<in> atoms (encode_operator_precondition (\<phi> (prob_with_noop abs_prob)) t op) \<Longrightarrow>
    t < h \<Longrightarrow> op \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
    valid_state_var sv"
  by (force simp: encode_operator_precondition_def Let_def
            intro!: encode_operator_precondition_valid_1)

lemma encode_all_operator_preconditions_valid:
   "t < Suc h \<Longrightarrow>
    sv \<in> atoms (encode_all_operator_preconditions (\<phi> (prob_with_noop abs_prob)) (operators_of (\<phi> (prob_with_noop abs_prob))) t) \<Longrightarrow>
    valid_state_var sv"
  unfolding encode_all_operator_preconditions_def foldr_And
  by (force simp add: encode_operator_precondition_valid)

lemma encode_operators_valid:
   "sv \<in> atoms (encode_operators (\<phi> (prob_with_noop abs_prob)) t) \<Longrightarrow> t < Suc h \<Longrightarrow>
    valid_state_var sv"
  unfolding encode_operators_def Let_def
  by (force simp add: encode_all_operator_preconditions_valid encode_all_operator_effects_valid)

lemma encode_negative_transition_frame_axiom':
  "t < h \<Longrightarrow>
   set deleting_operators \<subseteq> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
    sv \<in> atoms
       (\<^bold>\<not>(Atom (State t v_idx))
          \<^bold>\<or> (Atom (State (Suc t) v_idx)
          \<^bold>\<or> \<^bold>\<Or> (map (\<lambda>op. Atom (Operator t (index (operators_of (\<phi> (prob_with_noop abs_prob))) op)))
          deleting_operators))) \<Longrightarrow>
    valid_state_var sv"
  by (induction deleting_operators) (auto simp: length_operators[symmetric] cnf_to_dimacs.valid_state_var.simps)

lemma encode_negative_transition_frame_axiom_valid:
  "sv \<in> atoms (encode_negative_transition_frame_axiom (\<phi> (prob_with_noop abs_prob)) t v) \<Longrightarrow>  t < h \<Longrightarrow>
    valid_state_var sv"
  unfolding encode_negative_transition_frame_axiom_def Let_def
  apply(intro encode_negative_transition_frame_axiom'[of t])
  by auto

lemma encode_positive_transition_frame_axiom_valid:
  "sv \<in> atoms (encode_positive_transition_frame_axiom (\<phi> (prob_with_noop abs_prob)) t v) \<Longrightarrow> t < h \<Longrightarrow>
    valid_state_var sv"
  unfolding encode_positive_transition_frame_axiom_def Let_def
  apply(intro encode_negative_transition_frame_axiom'[of t])
  by auto

lemma encode_all_frame_axioms_valid:
  "sv \<in> atoms (encode_all_frame_axioms (\<phi> (prob_with_noop abs_prob)) t) \<Longrightarrow> t < Suc h \<Longrightarrow>
    valid_state_var sv"
  unfolding encode_all_frame_axioms_def Let_def atoms_And_append
  by (force simp add: encode_negative_transition_frame_axiom_valid encode_positive_transition_frame_axiom_valid)

lemma encode_goal_state_valid:
  "sv \<in> atoms (encode_goal_state Prob t) \<Longrightarrow> t < Suc h \<Longrightarrow> valid_state_var sv"
  by (auto simp add: encode_state_variable_def Let_def encode_goal_state_def split: sat_plan_variable.splits bool.splits)

lemma encode_problem_valid:
  "sv \<in> atoms (encode_problem (\<phi> (prob_with_noop abs_prob)) h) \<Longrightarrow> valid_state_var sv"
  unfolding encode_problem_def
  using encode_initial_state_valid encode_operators_valid encode_all_frame_axioms_valid encode_goal_state_valid
  by fastforce

lemma encode_interfering_operator_pair_exclusion_valid:
  "sv \<in> atoms (encode_interfering_operator_pair_exclusion (\<phi> (prob_with_noop abs_prob)) t op\<^sub>1 op\<^sub>2) \<Longrightarrow> t < Suc h \<Longrightarrow>
       op\<^sub>1 \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow> op\<^sub>2 \<in> set (operators_of (\<phi> (prob_with_noop abs_prob))) \<Longrightarrow>
       valid_state_var sv"
  by (auto simp: encode_interfering_operator_pair_exclusion_def Let_def length_operators[symmetric] cnf_to_dimacs.valid_state_var.simps)

lemma encode_interfering_operator_exclusion_valid:
  "sv \<in> atoms (encode_interfering_operator_exclusion (\<phi> (prob_with_noop abs_prob)) t) \<Longrightarrow> t < Suc h \<Longrightarrow>
      valid_state_var sv"
  unfolding encode_interfering_operator_exclusion_def Let_def foldr_And
  by (force simp add: encode_interfering_operator_pair_exclusion_valid)

lemma encode_problem_with_operator_interference_exclusion_valid:
  "sv \<in> atoms (encode_problem_with_operator_interference_exclusion (\<phi> (prob_with_noop abs_prob)) h) \<Longrightarrow> valid_state_var sv"
  unfolding encode_problem_with_operator_interference_exclusion_def
  using encode_initial_state_valid encode_operators_valid encode_all_frame_axioms_valid encode_goal_state_valid
        encode_interfering_operator_exclusion_valid
  by fastforce

lemma planning_by_cnf_dimacs_complete:
  "valid_plan \<pi>s \<Longrightarrow> length \<pi>s \<le> h \<Longrightarrow>
     \<exists>M. M \<Turnstile> map_formula var_to_dimacs (\<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop  abs_prob)) h)"
  using valid_plan_then_is_serial_sol_encoded
        sat_plan_to_dimacs[OF encode_problem_with_operator_interference_exclusion_valid]
  by meson

lemma planning_by_cnf_dimacs_sound:
  "\<A> \<Turnstile> map_formula var_to_dimacs (\<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop abs_prob)) t) \<Longrightarrow>
   valid_plan
        (decode_abs_plan
           (rem_noops
             (map (\<lambda>op. \<phi>\<^sub>O\<inverse> (prob_with_noop abs_prob) op)
                (concat (\<Phi>\<inverse> (\<phi> (prob_with_noop abs_prob)) (\<A> o var_to_dimacs) t)))))"
  using changing_atoms_works'
  by (fastforce intro!: is_serial_sol_then_valid_plan_encoded)

end

subsection \<open>Going from Formualae to DIMACS-like CNF\<close>

text \<open>We now represent the CNF formulae into a very low-level representation that is reminiscent to
      the DIMACS representation, where a CNF formula is a list of list of integers.\<close>

fun disj_to_dimacs::"nat formula \<Rightarrow> int list" where
  "disj_to_dimacs (\<phi>\<^sub>1 \<^bold>\<or> \<phi>\<^sub>2) = disj_to_dimacs \<phi>\<^sub>1 @ disj_to_dimacs \<phi>\<^sub>2"
| "disj_to_dimacs \<bottom> = []"
| "disj_to_dimacs (Not \<bottom>) = [-1::int,1::int]"
| "disj_to_dimacs (Atom v) = [int v]"
| "disj_to_dimacs (Not (Atom v)) = [-(int v)]"

fun cnf_to_dimacs::"nat formula \<Rightarrow> int list list" where
  "cnf_to_dimacs (\<phi>\<^sub>1 \<^bold>\<and> \<phi>\<^sub>2) = cnf_to_dimacs \<phi>\<^sub>1 @ cnf_to_dimacs \<phi>\<^sub>2"
| "cnf_to_dimacs d = [disj_to_dimacs d]"

definition "dimacs_lit_to_var l \<equiv> nat (abs l)"

definition "find_max (xs::nat list)\<equiv> (fold max xs 1)"

lemma find_max_works:
"x \<in> set xs \<Longrightarrow> x \<le> find_max xs" (is "?P \<Longrightarrow> ?Q")
proof-
  have "x \<in> set xs \<Longrightarrow> (x::nat) \<le> (fold max xs m)" for m
    unfolding max_def
    apply (induction xs arbitrary: m rule: rev_induct)
    using nat_le_linear
    by (auto dest:  le_trans simp add:)
  thus "?P \<Longrightarrow> ?Q"
    by(auto simp add: find_max_def max_def)
qed

fun formula_vars where
"formula_vars (\<bottom>) = []" |
"formula_vars (Atom k) = [k]" |
"formula_vars (Not F) = formula_vars F" |
"formula_vars (And F G) = formula_vars F @ formula_vars G" |
"formula_vars (Imp F G) = formula_vars F @ formula_vars G" |
"formula_vars (Or F G) = formula_vars F @ formula_vars G"

lemma atoms_formula_vars: "atoms f = set (formula_vars f)"
  by (induction f) auto

lemma max_var: "v \<in> atoms (f::nat formula) \<Longrightarrow> v \<le> find_max (formula_vars f)"
  using find_max_works
  by(simp add: atoms_formula_vars)

definition "dimacs_max_var cs \<equiv> find_max (map (find_max o (map (nat o abs))) cs)"

lemma fold_max_ge: "b \<le> a \<Longrightarrow> (b::nat) \<le> fold (\<lambda>x m. if m \<le> x then x else m) ys a"
  by (induction ys arbitrary: a b) auto

lemma find_max_append:  "find_max (xs @ ys) = max (find_max xs) (find_max ys) "
  apply(simp only: Max.set_eq_fold[symmetric] append_Cons[symmetric] set_append find_max_def)
  by (metis List.finite_set Max.union Un_absorb Un_insert_left Un_insert_right list.distinct(1) list.simps(15) set_empty)

definition dimacs_model::"int list \<Rightarrow> int list list \<Rightarrow> bool" where
  "dimacs_model ls cs \<equiv> (\<forall>c\<in>set cs. (\<exists>l\<in>set ls. l \<in> set c)) \<and>
                              distinct (map dimacs_lit_to_var ls)"

fun model_to_dimacs_model where
  "model_to_dimacs_model M (v#vs) = (if M v then int v else - (int v)) # (model_to_dimacs_model M vs)"
| "model_to_dimacs_model _ [] = []"

lemma model_to_dimacs_model_append:
 "set (model_to_dimacs_model M (vs @ vs')) = set (model_to_dimacs_model M vs) \<union> set (model_to_dimacs_model M vs')"
  by (induction vs) auto

lemma upt_append_sing: "xs @ [x] = [a..<n_vars] \<Longrightarrow> a < n_vars \<Longrightarrow> (xs = [a..<n_vars - 1] \<and> x = n_vars-1 \<and> n_vars > 0)"
  by (induction "n_vars") auto

lemma upt_eqD: "upt a b = upt a b' \<Longrightarrow> (b = b' \<or> b' \<le> a \<or> b \<le> a)"
  by (induction b) (auto dest!: upt_append_sing split: if_splits)

lemma pos_in_model: "M n \<Longrightarrow> 0 < n \<Longrightarrow> n < n_vars \<Longrightarrow> int n \<in> set (model_to_dimacs_model M [1..<n_vars])"
  by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append )

lemma neg_in_model: "\<not> M n \<Longrightarrow> 0 < n \<Longrightarrow> n < n_vars \<Longrightarrow> - (int n) \<in> set (model_to_dimacs_model M [1..<n_vars])"
  by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append)

lemma in_model: "0 < n \<Longrightarrow> n < n_vars \<Longrightarrow> int n \<in> set (model_to_dimacs_model M [1..<n_vars]) \<or> - (int n) \<in> set (model_to_dimacs_model M [1..<n_vars])"
  using pos_in_model neg_in_model
  by metis

lemma model_to_dimacs_model_all_vars:
  "(\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_cnf f \<Longrightarrow> M \<Turnstile> f \<Longrightarrow>
        (\<forall>n<n_vars. 0 < n \<longrightarrow> (int n \<in> set (model_to_dimacs_model M [(1::nat)..<n_vars]) \<or>
                              -(int n) \<in> set (model_to_dimacs_model M [(1::nat)..<n_vars])))"
  using in_model neg_in_model pos_in_model
  by (auto simp add: le_less model_to_dimacs_model_append split: if_splits)

lemma cnf_And: "set (cnf_to_dimacs (f1 \<^bold>\<and> f2)) = set (cnf_to_dimacs f1) \<union> set (cnf_to_dimacs f2)"
  by auto

lemma one_always_in:
  "1 < n_vars \<Longrightarrow> 1 \<in> set (model_to_dimacs_model M ([1..<n_vars])) \<or> - 1 \<in> set (model_to_dimacs_model M ([1..<n_vars]))"
  by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append)

lemma [simp]: "(atoms (f1 \<^bold>\<or> f2)) = atoms f1 \<union> atoms f2"
  by auto

lemma isdisj_disjD: "(is_disj (f1 \<^bold>\<or> f2)) \<Longrightarrow> is_disj f1 \<and> is_disj f2"
  by (cases f1; auto)

lemma disj_to_dimacs_sound:
   "1 < n_vars \<Longrightarrow> (\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_disj f \<Longrightarrow> M \<Turnstile> f
     \<Longrightarrow> \<exists>l\<in>set (model_to_dimacs_model M [(1::nat)..<n_vars]). l \<in> set (disj_to_dimacs f)"
  apply(induction f)
  using neg_in_model pos_in_model one_always_in
  by (fastforce elim!: is_lit_plus.elims dest!: isdisj_disjD)+

lemma is_cnf_disj: "is_cnf (f1 \<^bold>\<or> f2) \<Longrightarrow> (\<And>f. f1 \<^bold>\<or> f2 = f \<Longrightarrow> is_disj f \<Longrightarrow> P) \<Longrightarrow> P"
  by auto

lemma cnf_to_dimacs_disj: "is_disj f \<Longrightarrow> cnf_to_dimacs f = [disj_to_dimacs f]"
  by (induction f) auto

lemma model_to_dimacs_model_all_clauses:
  "1 < n_vars \<Longrightarrow> (\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_cnf f \<Longrightarrow> M \<Turnstile> f \<Longrightarrow>
        c\<in>set (cnf_to_dimacs f) \<Longrightarrow> \<exists>l\<in>set (model_to_dimacs_model M [(1::nat)..<n_vars]). l \<in> set c"
proof(induction f arbitrary: )
  case (Not f)
  then show ?case
    using in_model neg_in_model
    by (fastforce elim!: is_lit_plus.elims)+
next
  case (Or f1 f2)
  then show ?case
    using cnf_to_dimacs_disj disj_to_dimacs_sound
    by(elim is_cnf_disj, simp)
qed (insert in_model neg_in_model pos_in_model, auto)

lemma upt_eq_Cons_conv:
  "(x#xs = [i..<j]) = (i < j \<and> i = x \<and> [i+1..<j] = xs)"
  using upt_eq_Cons_conv
  by metis

lemma model_to_dimacs_model_append':
 "(model_to_dimacs_model M (vs @ vs')) = (model_to_dimacs_model M vs) @ (model_to_dimacs_model M vs')"
  by (induction vs) auto

lemma model_to_dimacs_neg_nin:
 "n_vars \<le> x \<Longrightarrow> int x \<notin> set (model_to_dimacs_model M [a..<n_vars])"
  by (induction n_vars arbitrary: a) (auto simp: model_to_dimacs_model_append')

lemma model_to_dimacs_pos_nin:
 "n_vars \<le> x \<Longrightarrow> - int x \<notin> set (model_to_dimacs_model M [a..<n_vars])"
  by (induction n_vars arbitrary: a) (auto simp: model_to_dimacs_model_append')

lemma int_cases2':
  "z \<noteq> 0 \<Longrightarrow> (\<And>n. 0 \<noteq> (int n) \<Longrightarrow> z = int n \<Longrightarrow> P) \<Longrightarrow> (\<And>n. 0 \<noteq> - (int n) \<Longrightarrow> z = - (int n) \<Longrightarrow> P) \<Longrightarrow> P"
  by (metis (full_types) int_cases2)

lemma model_to_dimacs_model_distinct:
  "1 < n_vars \<Longrightarrow> distinct (map dimacs_lit_to_var (model_to_dimacs_model M [1..<n_vars]))"
  by (induction n_vars)
     (fastforce elim!: int_cases2'
                simp add: dimacs_lit_to_var_def model_to_dimacs_model_append'
                          model_to_dimacs_neg_nin model_to_dimacs_pos_nin)+

lemma model_to_dimacs_model_sound:
  "1 < n_vars \<Longrightarrow> (\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_cnf f \<Longrightarrow> M \<Turnstile> f \<Longrightarrow>
        dimacs_model (model_to_dimacs_model M [(1::nat)..<n_vars]) (cnf_to_dimacs f)"
  unfolding dimacs_model_def
  using model_to_dimacs_model_all_vars model_to_dimacs_model_all_clauses model_to_dimacs_model_distinct
  by auto

lemma model_to_dimacs_model_sound_exists:
  "1 < n_vars \<Longrightarrow> (\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_cnf f \<Longrightarrow> M \<Turnstile> f \<Longrightarrow>
        \<exists>M_dimacs. dimacs_model M_dimacs (cnf_to_dimacs f)"
  using model_to_dimacs_model_sound
  by metis

definition dimacs_to_atom ::"int \<Rightarrow> nat formula" where
  "dimacs_to_atom l \<equiv> if (l < 0) then Not (Atom (nat (abs l))) else Atom (nat (abs l))"

definition dimacs_to_disj::"int list \<Rightarrow> nat formula" where
  "dimacs_to_disj f \<equiv> \<^bold>\<Or> (map dimacs_to_atom f)"

definition dimacs_to_cnf::"int list list \<Rightarrow> nat formula" where
  "dimacs_to_cnf f \<equiv> \<^bold>\<And>map dimacs_to_disj f"

definition "dimacs_model_to_abs dimacs_M M \<equiv>
  fold (\<lambda>l M. if (l > 0) then M((nat (abs l)):= True) else M((nat (abs l)):= False)) dimacs_M M"

lemma dimacs_model_to_abs_atom:
  "0 < x \<Longrightarrow> int x \<in> set dimacs_M \<Longrightarrow> distinct (map dimacs_lit_to_var  dimacs_M) \<Longrightarrow> dimacs_model_to_abs dimacs_M M x"
proof (induction dimacs_M arbitrary: M rule: rev_induct)
  case (snoc a dimacs_M)
  thus ?case
    by (auto simp add: dimacs_model_to_abs_def dimacs_lit_to_var_def image_def)
qed auto

lemma dimacs_model_to_abs_atom':
  "0 < x \<Longrightarrow> -(int x) \<in> set dimacs_M \<Longrightarrow> distinct (map dimacs_lit_to_var  dimacs_M) \<Longrightarrow> \<not> dimacs_model_to_abs dimacs_M M x"
proof (induction dimacs_M arbitrary: M rule: rev_induct)
  case (snoc a dimacs_M)
  thus ?case
    by (auto simp add: dimacs_model_to_abs_def dimacs_lit_to_var_def image_def)
qed auto

lemma model_to_dimacs_model_complete_disj:
  "(\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_disj f \<Longrightarrow> distinct (map dimacs_lit_to_var dimacs_M)
     \<Longrightarrow> dimacs_model dimacs_M (cnf_to_dimacs f) \<Longrightarrow> dimacs_model_to_abs dimacs_M (\<lambda>_. False) \<Turnstile> f"
  by (induction f)
     (fastforce elim!: is_lit_plus.elims dest!: isdisj_disjD
                simp: cnf_to_dimacs_disj dimacs_model_def dimacs_model_to_abs_atom'
                      dimacs_model_to_abs_atom)+

lemma model_to_dimacs_model_complete:
  "(\<forall>v\<in>atoms f. 0 < v \<and> v < n_vars) \<Longrightarrow> is_cnf f \<Longrightarrow> distinct (map dimacs_lit_to_var dimacs_M)
     \<Longrightarrow> dimacs_model dimacs_M (cnf_to_dimacs f) \<Longrightarrow> dimacs_model_to_abs dimacs_M (\<lambda>_. False) \<Turnstile> f"
proof(induction f)
  case (Not f)
  then show ?case
    by (auto elim!: is_lit_plus.elims simp add: dimacs_model_to_abs_atom' dimacs_model_def)
next
  case (Or f1 f2)
  then show ?case
    using cnf_to_dimacs_disj model_to_dimacs_model_complete_disj
    by(elim is_cnf_disj, simp add: dimacs_model_def)
qed (insert dimacs_model_to_abs_atom, auto simp: dimacs_model_def)

lemma model_to_dimacs_model_complete_max_var:
  "(\<forall>v\<in>atoms f. 0 < v) \<Longrightarrow> is_cnf f \<Longrightarrow>
   dimacs_model dimacs_M (cnf_to_dimacs f) \<Longrightarrow>
     dimacs_model_to_abs dimacs_M (\<lambda>_. False) \<Turnstile> f"
  using le_imp_less_Suc[OF max_var]
  by (auto intro!: model_to_dimacs_model_complete simp: dimacs_model_def)

lemma model_to_dimacs_model_sound_max_var:
  "(\<forall>v\<in>atoms f. 0 < v) \<Longrightarrow> is_cnf f \<Longrightarrow> M \<Turnstile> f \<Longrightarrow>
     dimacs_model (model_to_dimacs_model M [(1::nat)..<(find_max (formula_vars f) + 2)])
                  (cnf_to_dimacs f)"
  using le_imp_less_Suc[unfolded Suc_eq_plus1, OF max_var]
  by (fastforce intro!: model_to_dimacs_model_sound)

context sat_solve_sasp
begin

lemma [simp]: "var_to_dimacs sv > 0"
  by(cases sv) auto

lemma var_to_dimacs_pos:
  "v \<in> atoms (map_formula var_to_dimacs f) \<Longrightarrow> 0 < v"
  by (induction f) auto

lemma map_is_disj: "is_disj f \<Longrightarrow> is_disj (map_formula F f)"
  by (induction f) (auto elim: is_lit_plus.elims)

lemma map_is_cnf: "is_cnf f \<Longrightarrow> is_cnf (map_formula F f)"
  by (induction f) (auto elim: is_lit_plus.elims simp: map_is_disj)

lemma planning_dimacs_complete:
  "valid_plan \<pi>s \<Longrightarrow> length \<pi>s \<le> h \<Longrightarrow>
   let cnf_formula = (map_formula var_to_dimacs
                                  (\<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop abs_prob)) h))
   in
       \<exists>dimacs_M. dimacs_model dimacs_M (cnf_to_dimacs cnf_formula)"
  unfolding Let_def
  by (fastforce simp: var_to_dimacs_pos
                dest!: planning_by_cnf_dimacs_complete
                intro: model_to_dimacs_model_sound_max_var map_is_cnf
                       is_cnf_encode_problem_with_operator_interference_exclusion
                       is_valid_problem_sas_plus_then_strips_transformation_too
                       noops_valid abs_prob_valid)

lemma planning_dimacs_sound:
  "let cnf_formula =
     (map_formula var_to_dimacs
                  (\<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop abs_prob)) h))
   in
     dimacs_model dimacs_M (cnf_to_dimacs cnf_formula) \<Longrightarrow>
   valid_plan
        (decode_abs_plan
            (rem_noops
              (map (\<lambda>op. \<phi>\<^sub>O\<inverse> (prob_with_noop abs_prob) op)
                   (concat
                    (\<Phi>\<inverse> (\<phi> (prob_with_noop abs_prob)) ((dimacs_model_to_abs dimacs_M (\<lambda>_. False)) o var_to_dimacs) h)))))"
  by(fastforce simp: var_to_dimacs_pos Let_def
               intro: planning_by_cnf_dimacs_sound model_to_dimacs_model_complete_max_var
                      map_is_cnf is_cnf_encode_problem_with_operator_interference_exclusion
                      is_valid_problem_sas_plus_then_strips_transformation_too abs_prob_valid
                      noops_valid)

end

section \<open>Code Generation\<close>

text \<open>We now generate SML code equivalent to the functions that encode a problem as a CNF formula
      and that decode the model of the given encodings into a plan.\<close>

definition
"SASP_to_DIMACS h prob \<equiv>
   cnf_to_dimacs
     (map_formula
       (cnf_to_dimacs.var_to_dimacs (Suc h) (Suc (length (ast_problem.ast\<delta> prob))))
         (\<Phi>\<^sub>\<forall> (\<phi> (prob_with_noop (ast_problem.abs_prob prob))) h))"

lemma planning_dimacs_complete_code:
  "\<lbrakk>ast_problem.well_formed prob;
    \<forall>\<pi>\<in>set (ast_problem.ast\<delta> prob). is_standard_operator' \<pi>;
    ast_problem.valid_plan prob \<pi>s;
    length \<pi>s \<le> h\<rbrakk> \<Longrightarrow>
   let cnf_formula = (SASP_to_DIMACS h prob) in
       \<exists>dimacs_M. dimacs_model dimacs_M cnf_formula"
  unfolding SASP_to_DIMACS_def Let_def
  apply(rule sat_solve_sasp.planning_dimacs_complete[unfolded Let_def])
  apply unfold_locales
  by auto

definition "SASP_to_DIMACS' h prob \<equiv> SASP_to_DIMACS h (rem_implicit_pres_ops prob)"

lemma planning_dimacs_complete_code':
  "\<lbrakk>ast_problem.well_formed prob;
    (\<And>op. op \<in> set (ast_problem.ast\<delta> prob) \<Longrightarrow> consistent_pres_op op);
    (\<And>op. op \<in> set (ast_problem.ast\<delta> prob) \<Longrightarrow> is_standard_operator op);
    ast_problem.valid_plan prob \<pi>s;
    length \<pi>s \<le> h\<rbrakk> \<Longrightarrow>
   let cnf_formula = (SASP_to_DIMACS' h prob) in
       \<exists>dimacs_M. dimacs_model dimacs_M cnf_formula"
  unfolding Let_def SASP_to_DIMACS'_def
  by (auto simp add: rem_implicit_pres_ops_valid_plan[symmetric] wf_ast_problem_def
           simp del: rem_implicit_pres.simps
           intro!: rem_implicit_pres_is_standard_operator'
                   planning_dimacs_complete_code[unfolded Let_def]
                   rem_implicit_pres_ops_well_formed
           dest!: rem_implicit_pres_ops_in\<delta>D)

text \<open>A function that does the checks required by the completeness theorem above, and returns
      appropriate error messages if any of the checks fail.\<close>

definition
  "encode h prob \<equiv>
     if ast_problem.well_formed prob then
       if (\<forall>op \<in> set (ast_problem.ast\<delta> prob). consistent_pres_op op) then
         if (\<forall>op \<in> set (ast_problem.ast\<delta> prob). is_standard_operator op) then
           Inl (SASP_to_DIMACS' h prob)
         else
           Inr (STR ''Error: Conditional effects!'')
       else
         Inr (STR ''Error: Preconditions inconsistent'')
     else
       Inr (STR ''Error: Problem malformed!'')"

lemma encode_sound:
  "\<lbrakk>ast_problem.valid_plan prob \<pi>s; length \<pi>s \<le> h;
        encode h prob = Inl cnf_formula\<rbrakk> \<Longrightarrow>
         (\<exists>dimacs_M. dimacs_model dimacs_M cnf_formula)"
  unfolding encode_def
  by (auto split: if_splits simp: list.pred_set
           intro: planning_dimacs_complete_code'[unfolded Let_def])

lemma encode_complete:
  "encode h prob = Inr err \<Longrightarrow>
     \<not>(ast_problem.well_formed prob \<and> (\<forall>op \<in> set (ast_problem.ast\<delta> prob). consistent_pres_op op) \<and>
     (\<forall>op \<in> set (ast_problem.ast\<delta> prob). is_standard_operator op))"
  unfolding encode_def
  by (auto split: if_splits simp: list.pred_set
           intro: planning_dimacs_complete_code'[unfolded Let_def])

definition match_pre where
    "match_pre \<equiv> \<lambda>(x,v) s. s x = Some v"

definition match_pres where
    "match_pres pres s \<equiv> \<forall>pre\<in>set pres. match_pre pre s"

lemma match_pres_distinct:
  "distinct (map fst pres) \<Longrightarrow> match_pres pres s \<longleftrightarrow> Map.map_of pres \<subseteq>\<^sub>m s"
  unfolding match_pres_def match_pre_def
  using map_le_def map_of_SomeD
  apply (auto split: prod.splits)
   apply fastforce
  using domI map_of_is_SomeI
  by smt

fun tree_map_of where
  "tree_map_of updatea T [] = T"
| "tree_map_of updatea T ((v,a)#m) = updatea v a (tree_map_of updatea T m)"

context Map
begin

abbreviation "tree_map_of' \<equiv> tree_map_of update"

lemma tree_map_of_invar: "invar T \<Longrightarrow> invar (tree_map_of' T pres)"
  by (induction pres) (auto simp add: invar_update)

lemma tree_map_of_works: "lookup (tree_map_of' empty pres) x = map_of pres x"
  by (induction pres) (auto simp: map_empty map_update[OF tree_map_of_invar[OF invar_empty]])

lemma tree_map_of_dom: "dom (lookup (tree_map_of' empty pres)) = dom (map_of pres)"
  by (induction pres) (auto simp: map_empty map_update[OF tree_map_of_invar[OF invar_empty]] tree_map_of_works)
end

lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
  by (induction xs rule: induct_list012) auto

context Map_by_Ordered
begin

lemma tree_map_of_distinct: "distinct (map fst (inorder (tree_map_of' empty pres)))"
  apply(induction pres)
   apply(clarsimp simp: map_empty inorder_empty)
  using distinct_if_sorted invar_def invar_empty invar_update tree_map_of_invar
  by blast

end

lemma set_tree_intorder: "set_tree t = set (inorder t)"
  by (induction t) auto

lemma map_of_eq:
  "map_of xs = Map.map_of xs"
  by (induction xs) (auto simp: map_of_simps split: option.split)

lemma lookup_someD: "lookup T x = Some y \<Longrightarrow> \<exists>p. p \<in> set (inorder T) \<and> p = (x, y)"
  by (induction T) (auto split: if_splits)

lemma map_of_lookup: "sorted1 (inorder T) \<Longrightarrow> Map.map_of (inorder T) = lookup T"
  apply(induction T)
   apply (auto split: prod.splits intro!: map_le_antisym
      simp: lookup_map_of map_add_Some_iff map_of_None2 sorted_wrt_append)
  using lookup_someD
  by (force simp: map_of_eq map_add_def map_le_def
            split: option.splits)+

lemma map_le_cong: "(\<And>x. m1 x = m2 x) \<Longrightarrow> m1 \<subseteq>\<^sub>m s \<longleftrightarrow> m2 \<subseteq>\<^sub>m s"
  by presburger

lemma match_pres_submap:
  "match_pres (inorder (M.tree_map_of' empty pres)) s \<longleftrightarrow> Map.map_of pres \<subseteq>\<^sub>m s"
  using match_pres_distinct[OF M.tree_map_of_distinct]
  by (smt M.invar_def M.invar_empty M.tree_map_of_invar M.tree_map_of_works map_le_cong map_of_eq map_of_lookup)

lemma [code]:
  "SAS_Plus_Representation.is_operator_applicable_in s op \<longleftrightarrow>
      match_pres (inorder (M.tree_map_of' empty (SAS_Plus_Representation.precondition_of op))) s"
  by (simp add: match_pres_submap SAS_Plus_Representation.is_operator_applicable_in_def)

definition "decode_DIMACS_model dimacs_M h prob \<equiv>
  (ast_problem.decode_abs_plan prob
      (rem_noops
         (map (\<lambda>op. \<phi>\<^sub>O\<inverse> (prob_with_noop (ast_problem.abs_prob prob)) op)
           (concat
              (\<Phi>\<inverse> (\<phi> (prob_with_noop (ast_problem.abs_prob prob)))
                   ((dimacs_model_to_abs dimacs_M (\<lambda>_. False)) o
                     (cnf_to_dimacs.var_to_dimacs (Suc h)
                        (Suc (length (ast_problem.ast\<delta> prob)))))
                   h)))))"

lemma planning_dimacs_sound_code:
  "\<lbrakk>ast_problem.well_formed prob;
    \<forall>\<pi>\<in>set (ast_problem.ast\<delta> prob). is_standard_operator' \<pi>\<rbrakk> \<Longrightarrow>
    let
      cnf_formula = (SASP_to_DIMACS h prob);
      decoded_plan = decode_DIMACS_model dimacs_M h prob
    in
     (dimacs_model dimacs_M cnf_formula \<longrightarrow> ast_problem.valid_plan prob decoded_plan)"
  unfolding SASP_to_DIMACS_def decode_DIMACS_model_def Let_def
  apply(rule impI sat_solve_sasp.planning_dimacs_sound[unfolded Let_def])+
  apply unfold_locales
  by auto

definition
  "decode_DIMACS_model' dimacs_M h prob \<equiv>
     decode_DIMACS_model dimacs_M h (rem_implicit_pres_ops prob)"

lemma planning_dimacs_sound_code':
  "\<lbrakk>ast_problem.well_formed prob;
   (\<And>op. op \<in> set (ast_problem.ast\<delta> prob) \<Longrightarrow> consistent_pres_op op);
    \<forall>\<pi>\<in>set (ast_problem.ast\<delta> prob). is_standard_operator \<pi>\<rbrakk> \<Longrightarrow>
    let
      cnf_formula = (SASP_to_DIMACS' h prob);
      decoded_plan = decode_DIMACS_model' dimacs_M h prob
    in
     (dimacs_model dimacs_M cnf_formula \<longrightarrow> ast_problem.valid_plan prob decoded_plan)"
  unfolding SASP_to_DIMACS'_def decode_DIMACS_model'_def
  apply(subst rem_implicit_pres_ops_valid_plan[symmetric])
  by(fastforce simp only: rem_implicit_pres_ops_valid_plan wf_ast_problem_def
           intro!: rem_implicit_pres_is_standard_operator'
                   rem_implicit_pres_ops_well_formed
                   rev_iffD2[OF _ rem_implicit_pres_ops_valid_plan]
                   planning_dimacs_sound_code wf_ast_problem.intro
           dest!: rem_implicit_pres_ops_in\<delta>D)+

text \<open>Checking if the model satisfies the formula takes the longest time in the decoding function.
      We reimplement that part using red black trees, which makes it 10 times faster, on average!\<close>

fun list_to_rbt :: "int list \<Rightarrow> int rbt" where
  "list_to_rbt [] = Leaf"
| "list_to_rbt (x#xs) = insert_rbt x (list_to_rbt xs)"

lemma inv_list_to_rbt: "invc (list_to_rbt xs) \<and> invh (list_to_rbt xs)"
  by (induction xs) (auto simp: rbt_def RBT.inv_insert)

lemma Tree2_list_to_rbt: "Tree2.bst (list_to_rbt xs)"
  by (induction xs) (auto simp: RBT.bst_insert)

lemma set_list_to_rbt: "Tree2.set_tree (list_to_rbt xs) = set xs"
  by (induction xs) (simp add: RBT.set_tree_insert Tree2_list_to_rbt)+

text \<open>The following \<close>

lemma dimacs_model_code[code]:
  "dimacs_model ls cs \<longleftrightarrow>
        (let tls = list_to_rbt ls in
          (\<forall>c\<in>set cs. size (inter_rbt (tls) (list_to_rbt c)) \<noteq> 0) \<and>
               distinct (map dimacs_lit_to_var ls))"
  using RBT.set_tree_inter[OF Tree2_list_to_rbt Tree2_list_to_rbt]
  apply (auto simp: dimacs_model_def Let_def set_list_to_rbt inter_rbt_def)
  apply (metis IntI RBT.set_empty empty_iff)
  by (metis Tree2.eq_set_tree_empty disjoint_iff_not_equal)

definition
  "decode M h prob \<equiv>
     if ast_problem.well_formed prob then
       if (\<forall>op\<in>set (ast_problem.ast\<delta> prob). consistent_pres_op op) then
         if (\<forall>op\<in>set (ast_problem.ast\<delta> prob). is_standard_operator op) then
           if (dimacs_model M (SASP_to_DIMACS' h prob)) then
             Inl (decode_DIMACS_model' M h prob)
           else Inr (STR ''Error: Model does not solve the problem!'')
         else
           Inr (STR ''Error: Conditional effects!'')
       else
         Inr (STR ''Error: Preconditions inconsistent'')
     else
       Inr (STR ''Error: Problem malformed!'')"

lemma decode_sound:
  "decode M h prob = Inl plan \<Longrightarrow>
         ast_problem.valid_plan prob plan"
  unfolding decode_def
  apply (auto split: if_splits simp: list.pred_set)
  using planning_dimacs_sound_code'
  by auto

lemma decode_complete:
  "decode M h prob = Inr err \<Longrightarrow>
         \<not> (ast_problem.well_formed prob \<and>
            (\<forall>op \<in> set (ast_problem.ast\<delta> prob). consistent_pres_op op) \<and>
            (\<forall>\<pi>\<in>set (ast_problem.ast\<delta> prob). is_standard_operator \<pi>) \<and>
            dimacs_model M (SASP_to_DIMACS' h prob))"
  unfolding decode_def
  by (auto split: if_splits simp: list.pred_set)

lemma [code]:
  "ListMem x' []= False"
  "ListMem x' (x#xs) = (x' = x \<or> ListMem x' xs)"
  by (simp add: ListMem_iff)+

lemmas [code] = SASP_to_DIMACS_def ast_problem.abs_prob_def
                ast_problem.abs_ast_variable_section_def ast_problem.abs_ast_operator_section_def
                ast_problem.abs_ast_initial_state_def ast_problem.abs_range_map_def
                ast_problem.abs_ast_goal_def cnf_to_dimacs.var_to_dimacs.simps
                ast_problem.ast\<delta>_def ast_problem.astDom_def ast_problem.abs_ast_operator_def
                ast_problem.astI_def ast_problem.astG_def ast_problem.lookup_action_def
                ast_problem.I_def execute_operator_sas_plus_def ast_problem.decode_abs_plan_def

definition nat_opt_of_integer :: "integer \<Rightarrow> nat option" where
       "nat_opt_of_integer i = (if (i \<ge> 0) then Some (nat_of_integer i) else None)"

definition max_var :: "int list \<Rightarrow> int" where
       "max_var xs \<equiv> fold (\<lambda>(x::int) (y::int). if abs x \<ge> abs y then (abs x) else y) xs (0::int)"

export_code encode nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode
    String.implode max_var concat char_of_nat Int.nat integer_of_int length int_of_integer
  in SML module_name exported file_prefix SASP_to_DIMACS

export_code decode nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode
    String.implode max_var concat char_of_nat Int.nat integer_of_int length int_of_integer
  in SML module_name exported file_prefix decode_DIMACS_model

end


theory Proof_4_589
  imports Proofs4
begin

thm VC589_def

abbreviation s where " s s0 PdOut'value paid'value opened'value \<equiv>
 (toEnv
   (setPstate
     (setPstate
       (setVarBool
         (setVarBool
           (setPstate
             (setVarBool
               (setVarBool (setVarBool (setVarBool s0 PdOut' PdOut'value) paid' paid'value) opened'
                 opened'value)
               Controller'minimalOpened' False)
             Init'init' Controller'isClosed')
           EntranceController'isClosed' False)
         Controller'isOpened' True)
       Controller'minimalOpened' Unlocker'unlock')
     Controller'isClosed' EntranceController'isClosed'))"

theorem proof_4_589: "VC589 inv4 env s0 PdOut_value paid_value opened_value"
  apply(simp only: VC589_def inv4_def R4_def extraInv_def)
  apply(rule impI)
  apply(rule conjI)
   apply(rule conjI)
    apply simp
   apply(drule conjE)
    prefer 2
    apply assumption
   apply(drule conjE)
    prefer 2
    apply assumption
   apply((rule allI)+)
  subgoal premises vc_prems for s1 s2
    using vc_prems(2) apply -
    apply(drule conjE)
     prefer 2
     apply assumption
    subgoal premises invs0
      apply(rule impI)
      apply(rule disjE[of "100 < toEnvNum s2 (s s0 PdOut_value paid_value opened_value)"
"100 = toEnvNum s2 (s s0 PdOut_value paid_value opened_value)"])
      using le_imp_less_or_eq apply blast
      apply(rule cut_rl[of "\<exists>s4. toEnvP s4 \<and>
         substate s2 s4 \<and>
         substate s4 s0 \<and>
         toEnvNum s2 s4 \<le> 100 \<and>
         \<not> getVarBool s4 Controller'minimalOpened' \<and>
         (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s4 \<and> s3 \<noteq> s4 \<longrightarrow> getVarBool s3 Controller'minimalOpened')"])
        apply(drule exE)
         prefer 2
         apply assumption
      subgoal for s4
        apply(rule exI[of _ s4])
        by simp
      subgoal premises req_prems
        using invs0(1) req_prems apply -
        apply(drule conjE)
         prefer 2
         apply assumption
        apply(drule allE[of _ s1])
        prefer 2
         apply assumption
        apply(drule allE[of _ s2])
        prefer 2
         apply assumption
        by(simp split: if_splits)
      apply(rule cut_rl[of "\<forall> s5. toEnvP s5 \<and> substate s2 s5 \<and> substate s5 (s s0 PdOut_value paid_value opened_value) \<longrightarrow>
pred4 s1 s2 (s s0 PdOut_value paid_value opened_value) s5"])
       apply(drule allE[of _ s2])
      prefer 2
        apply assumption
       apply(drule impE)
      prefer 3
      apply assumption
      using substate_refl apply blast
       apply(simp only: pred4_def)
       apply(drule impE)
      prefer 3
      apply assumption
      using substate_refl substate_trans substate_antisym apply blast
       apply assumption
      apply(rule allI)
      subgoal premises prems for s5
        apply(induction rule: state_ind)
        using prems(1) apply simp
         apply(simp only: pred4_def)
         apply(rule impI)

         apply(rule exI[of _  "s s0 PdOut_value paid_value opened_value"])
         apply(((rule conjI),simp)+)
        using substate_trans substate_antisym apply blast

        subgoal for s5
          apply(simp only: pred4_def)
          apply(rule impI)
          apply(cases "getVarBool (predEnv s5) open' = False")
           apply(rule exI[of _ "predEnv s5"])
           apply(rule conjI)
        apply(rule toEnvP_substate_pred_imp_toEnvP_pred[of s2])
            apply blast
       apply(rule conjI)
          using substate_refl apply simp
       apply(rule conjI)
      using predEnv_substate substate_trans apply blast
       apply(rule conjI)
      using toEnvNum3[of s2 "predEnv s5"
 "(s s0 PdOut_value paid_value opened_value) "]
        apply force
       apply(rule conjI)
        apply blast
      using substate_antisym apply blast
      apply(drule impE)
        prefer 3
        apply assumption
       apply(((rule conjI),blast)+)
      using substate_imp_substatete_predEnv_or_eq apply blast
      apply(drule exE)
       prefer 2
       apply assumption
      subgoal for s4
        apply(rule exI[of _ s4])
       apply(rule conjI)
         apply blast
        apply(rule conjI)
        using predEnv_substate substate_trans apply blast
        apply(((rule conjI),blast)+)
        using predEnv_substate_imp_substate_or_eq by blast
      done
    done
  done
  done


(*  Title:      HOL/Auth/n_deadlock_lemma_inv__3_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

(*header{*The n_deadlock Protocol Case Study*}*)

theory n_deadlock_lemma_inv__3_on_rules imports n_deadlock_lemma_on_inv__3
begin
section{*All lemmas on causal relation between inv__3*}
lemma lemma_inv__3_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__3  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_TryVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_CritVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_ExitVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_IdleVsinv__3) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end