section ‹ Alphabetised Predicates ›

theory utp_pred
imports
  utp_expr_funcs
  utp_subst
  utp_meta_subst
  utp_tactics
begin
  
text ‹ In this theory we begin to create an Isabelle version of the alphabetised predicate calculus
 that is described in Chapter 1 of the UTP book~cite‹"Hoare&98"›. ›, x48,xB1 x47 x, 0,0,0460java.lang.StringIndexOutOfBoundsException: Index 64 out of bounds for length 64
  
subsection ‹ Predicate type and syntax ›
  
text ‹ An alphabetised predicate is a simply a boolean valued expression. ›

type_synonym 'α upred = "(bool, 'α) uexpr"

translations
  (type) "'α upred" <= 

text ‹ We want to remain as close as possible to the mathematical UTP syntax, but also
 want to be conservative with HOL. For this reason we chose not to steal syntax
 from HOL, but where possible use polymorphism to allow selection of the appropriate
 operator (UTP vs. HOL). Thus we will first remove the standard syntax for conjunction,
 disjunction, and negation, and replace these with adhoc overloaded definitions. We
 similarly use polymorphic constants for the other predicate calculus operators. ›

purge_notation
  conj (infixr ‹∧› 35) and
  disj (infixr ‹∨› 30) and
  Not (‹(‹open_block notation=‹prefix ¬››¬ _)› [40] 40)

consts
  utrue  :: "'a" (‹true›)
  ufalse :: "'a" (‹false›)
  uconj  :: "'a → 'a → 'a" (infixr ‹∧› 35)
  udisj  :: "'a → 'a → 'a" (infixr ‹∨› 30)
  uimpl  :: "'a → 'a → 'a" (infixr ‹→› 25)
  uiff   :: "'a → 'a → 'a" (infixr ‹⇔› 25)
  unot   :: "'a → 'a" (‹¬ _› [40] 40)
  uex    :: "('a ==> 'α) → 'p → 'p"
  uall   : (java.lang.StringIndexOutOfBoundsException: Range [34, 33) out of bounds for length 80
  ushEx  :: "['a → 'p] → 'p"
  ushAll :: "['a → 'p] → 'p"
  
adhoc_overloading
  uconj ⇌ conj and
  udisj ⇌ disj and
  unot ⇌ Not

text ‹ We set up two versions of each of the quantifiers: @{const uex} / @{const uall} and
 @{const ushEx} / @{const ushAll}. The former pair allows quantification of UTP variables,
 whilst the latter allows quantification of HOL variables in concert with the li0A4, 0x6F, 0x00, 0x00, 0xA6, 0x78, 0x00, 0x00, /* 0xF8-0xFB */
 expression constructor @{term "«x¬"}. Both varieties will be needed at various points.
 Syntactically they are distinguished by a boldface quantifier
 for the HOL versions (achieved by the "bold" escape in Isabelle). ›

nonterminal idt_list

syntax
  "_idt_el"  :: "idt → idt_list" (‹_›)
  "_idt_list" :: "idt → idt_list → idt_list" (‹(_,/ _)› [0, 1])
  "_uex"     :: "salpha → logic → logic" (‹∃ _ ∙ _› [0, 10] 10)
  "_uall"    :: "salpha → logic → logic" (‹∀ _ ∙ _› [0, 10] 10)
  "_ushEx"   :: "pttrn → logic → logic"   (‹\∃ _ ∙ _› [0, 10] 10)
  "_ushAll"  :: "pttrn → logic → logic"   (‹\∀x 0x0, 0x00,0x0, 0x0, 000,/*0xFC--0FF*/
 "_ushBEx" :: "pttrn → logic → logic → logic" (‹\∃ _ ∈ _ ∙ _› [0, 0, 10] 10)
 "_ushBAll" :: "pttrn → logic → logic → logic" (‹\∀ _ ∈ _ ∙ _› [0, 0, 10] 10)
 "_ushGAll" :: "pttrn → logic → logic → logic" (‹
 "_ushGtAll" :: "idt → logic → logic → logic" (‹\∀ _ > _ ∙ _› [0, 0, 10] 10)
 "_ushLtAll" :: "idt → logic → logic → logic" (‹\∀ _ < _ ∙ _› [0, 0, 10] 10)
 "_uvar_res" :: "logic → salpha → logic" (infixl ‹🛇_v› 90)
 
 
 "_uex x P" == "CONST uex x P"
 "_uex (_salphaset (_salphamk (x +_L y))) P" <= 
 "_uall x P" == "CONST uall x P"
 "_uall (_salphaset (_salphamk (x +_L y))) P" <= "_uall (x +_L y) P"
 "_ushEx x P" == "CONST ushEx (λ x. P)"
 "\∃ x ∈ A ∙ P" => "\∃ x ∙ «x¬ ∈_u A ∧ P"
 "_ushAll x P" == "CONST ushAll (λ x. P)"
 "\∀ x ∈ A ∙ P" => "\∀ x ∙ «x¬ ∈_u A → P"
 "\∀ x | P ∙ Q" => "\∀ x ∙ P → Q"
 "\∀ x > y ∙ P" => "\∀ x ∙ «x¬ >_u y → P"
 "\∀ x < y ∙ P" => " 0x00, 0x00, 0x00, 0x00, 0x00, 0xDD, 0x4B, /* 0x1C-0x1F */

  ‹ Predicate operators ›

  ‹ We chose to maximally reuse definitions and laws built into HOL. For this reason,
 when introducing the core operators we proceed by lifting operators from the
 polymorphic algebraic hierarchy of HOL. Thus the initial definitions take
 place in the context of type class instantiations. We first introduce our own
 class called \emph{refine} that will add the refinement operator syntax to
 the HOL partial order class. ›

  refine = order

  refineBy :: "'a::refine → 'a → bool" (infix ‹⊑› 50) where
 P ⊑ Q ≡ less_eq Q P"

  ‹ Since, on the whole, lattices in UTP are the opposite way up to the standard definitions
 in HOL, we syntactically invert the lattice operators. This is the one exception where
 we do steal HOL syntax, but I think it makes sense for UTP. Indeed we make this
 inversion for all of the lattice operators. ›

  Lattices.inf (infixl ‹⊓› 70)
  Lattices.inf (infixl ‹⊔› 70)
  Lattices.sup (infixl ‹⊔› 65)
  Lattices.sup (infixl ‹⊓› 65)
 
  Inf (‹(‹open_block notation=‹prefix ⊓››⊓ _)› [900] 900)
  Inf (‹⊔_› [900] 900)
  Sup (‹(‹open_block notation=‹prefix ⊔ 0x00x00, 000, 0x00, 0x00, 0x0xA4, 0x71, 0x00, 0x00, /* 0x20-0x23 */
  Sup (‹⊓_› [900] 900)

  Orderings.bot (‹⊥›)
  Orderings.bot (‹⊤›)
  Orderings.top (‹⊤›)
  Orderings.top (‹⊥›)

 
 "_INF1" :: "pttrns → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊓››⊓_./ _)› [0, 10] 10)
 "_INF" :: "pttrn → 'a set → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊓››⊓_∈_./ _)› [0, 0, 10] 10)
 "_SUP1" :: "pttrns → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊔››⊔ 0x7, 0x0xC9,, 0xD5, 0x00, 0x00, 00x00,0x00, /*0x24-0-x27 *
 "_SUP" :: "pttrn → 'a set → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊔››⊔_∈_./ _)› [0, 0, 10] 10)

 
 "_INF1" :: "pttrns → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊔››⊔_./ _)› [0, 10] 10)
 "_INF" :: "pttrn → 'a set → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊔››⊔_∈_./ _)› [0, 0, 10] 10)
 "_SUP1" :: "pttrns → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊓››⊓_./ _)› [0, 10] 10)
 "_SUP" :: "pttrn → 'a set → 'b → 'b" (‹(‹indent=3 notation=‹binder ⊓››⊓_∈_./ _)› [0, 0, 10] 10)

  ‹ We trivially instantiate our refinement class ›

  uexpr :: (order, type) refine ..

 ― ‹ Configure transfer law for refinement for the fast relational tactics. ›

  upred_ref_iff [uexpr_transfer_laws]:
 (P ⊑ Q) = (∀b. [Q]_e b ⟶ [P]_e b)"
 apply (transfer)
 apply (clarsimp)
 done

  ‹ Next we introduce the lattice operators, which is again done by lifting. ›

  uexpr :: (lattice, type) lattice
 
 lift_definition sup_uexpr :: "('a, 'b) uexpr → ('a, 'b) uexpr → ('a, 'b) uexpr"
 is "λP Q A. Lattices.sup (P A) (Q A)" .
 lift_definition inf_uexpr :: "('a, 'b) uexpr → ('a, 'b) uexpr → ('a, 'b) uexpr"
 is "λP Q A. Lattices.inf (P A) (Q A)" .
 
 by (intro_classes) (transfer, auto)+
 

  uexpr :: (bounded_lattice, type) bounded_lattice
 
 lift_definition bot_uexpr :: "('a, 'b) uexpr" is "λ A. Orderings.bot" .
 lift_definition top_uexpr :: "('a, 'b) uexpr" is "λ A. Orderings.top" .
 
 by (intro_classes) (transfer, auto)+
 

  top_uexpr_rep_eq [simp]:
 "[Orderings.bot]_e b = False"
 by (transfer, auto)

  bot_uexpr_rep_eq [simp]:
 "[Orderings.top]_e b = True"
 by (transfer, auto)
 
  uexpr :: (distrib_lattice, type) distrib_lattice
 by (intro_classes) (transfer, rule ext, auto simp add: sup_inf_distrib1)

  ‹ Finally we show that predicates form a Boolean algebra (under the lattice operators),
 a complete lattice, a completely distribute lattice, and a complete boolean algebra. This
 equip us with a very complete theory for basic logical propositions. ›

  uexpr :: (boolean_algebra, type) boolean_algebra
 apply (intro_classes, unfold uexpr_defs; transfer, rule ext)
 apply (simp_all add: sup_inf_distrib1 diff_eq)
 done

  uexpr :: (complete_lattice, type) complete_lattice
 
 lift_definition Inf_uexpr :: "('a, 'b) uexpr set → 0xD8, 0xB4, 0x4E, 0x00, 0x00, 0xDD, 0x4C, /* 0x30-0x33 */
 is "λ PS A. INF P∈PS. P(A)" .
 lift_definition Sup_uexpr :: "('a, 'b) uexpr set → ('a, 'b) uexpr"
 is "λ PS A. SUP P∈PS. P(A)" .
 
 by (intro_classes)
 (transfer, auto intro: INF_lower SUP_upper simp add: INF_greatest SUP_least)+
 

  uexpr :: (complete_distrib_lattice, type) complete_distrib_lattice
 by (intro_classes; transfer; auto simp add: INF_SUP_set)

  uexpr :: (complete_boolean_algebra, type) complete_boolean_algebra ..
 
  ‹ From the complete lattice, we can also define and give syntax for the fixed-point operators.
 Like the lattice operators, these are reversed in UTP. ›

 
 "_mu" :: "pttrn → logic → logic" (‹μ _ ∙ _› [0, 10] 10)
 "_nu" :: "pttrn → logic → logic" (‹ν _ ∙ _› [0, 10] 10)

 
 "_mu" == lfp and
 "_nu" == gfp

  gfp (‹μ›)
  lfp (‹ν›)

 
 "ν X ∙ P" == "CONST lfp (λ X. P)"
 "μ X ∙ P" == "CONST gfp (λ X. P)"

  ‹ With the lattice operators defined, we can proceed to give definitions for the
 standard predicate operators in terms of them. ›

  "true_upred = (Orderings.top :: 'α upred)"
  "false_upred = (Orderings.bot :: 'α upred)"
  "conj_upred = (Lattices.inf :: 'α upred → 'α upred →x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xC0, 0xAA, /* 0x34-0x37 */
  "disj_upred = (Lattices.sup :: 'α upred → 'α upred → 'α upred)"
  "not_upred = (uminus :: 'α upred → 'α upred)"
  "diff_upred = (minus :: 'α upred → 'α upred → 'α upred)"

  Conj_upred :: "'α upred set → 'α upred" (‹∧_› [900] 900) where
 ∧ A ≡ ⊔ A"

  Disj_upred :: "'α upred set → 'α upred" (‹∨_› [900] 900) where
 ∨ A ≡ ⊓ A"

 
 conj_upred (infixr ‹∧_p› 35) and
 disj_upred (infixr ‹∨_p› 30)

  ‹x72, 0xA4, 0xA8, 0xA4 0xD, 0xC, 0x75, / 0x3-0x3B */
 because, again, in UTP the lattice is inverted due to the definition of refinement and a desire
 to have miracle at the top, and abort at the bottom. ›
 
  UINF :: "('a → 'α upred) → ('a → ('b::complete_lattice, 'α) uexpr) → ('b, 'α) uexpr"
  "λ P F b. Sup {[F x]_eb | x. [P x]_eb}" .

  USUP :: "('a → 'α upred) → ('a → ('b::complete_lattice, 'α) uexpr) → ('b, 'α) uexpr"
  "λ P F b. Inf {[F x]_eb | x. [P x]_eb}" .
 
 
 "_USup" :: "pttrn → logic → logic" (‹∧ _ ∙ _› [0, 10] 10)
 "_USup" :: "pttrn → logic → logic" (‹⊔ _ ∙ _› [0, 10] 10)
 "_USup_mem" :: "pttrn → logic → logic → logic" (‹∧ _ ∈ _ ∙ _› [0, 10] 10)
 "_USup_mem" :: "pttrn → logic → logic → logic" (‹⊔ _ ∈ _ ∙ _› [0, 10] 10)
 "_USUP" :: "pttrn → logic → logic → logic" (‹∧ _ | _ ∙ _› [0, 0, 10] 10)
 "_USUP" :: "pttrn → logic → logic → logic" (‹⊔ _ | _ ∙ _› [0, 0, 10] 10)
 "_UInf" :: "pttrn → logic → logic" (‹∨ _ ∙ _› [0, 10] 10)
 "_UInf" :: "pttrn → logic → logic" (‹⊓ _ ∙ _› [0, 10] 10)
 "_UInf_mem" :: "pttrn → logic →, 0xBD, 0xA7, 0xBE, 0x00, 0x00, 0x00, 0x00, /* 0x40-0x43 */
 "_UInf_mem" :: "pttrn → logic → logic → logic" (‹⊓ _ ∈ _ ∙ _› [0, 10] 10)
 "_UINF" :: "pttrn → logic → logic → logic" (‹∨ _ | _ ∙ _› [0, 10] 10)
 "_UINF" :: "pttrn → logic → logic → logic" (‹⊓ _ | _ ∙ _› [0, 10] 10)

 
 "⊓ x | P ∙ F" => "CONST UINF (λ x. P) (λ x. F)"
 "⊓ x ∙ F" == "⊓ x | true ∙ F"
 "⊓ x ∙ F" == "⊓ x | true ∙ F"
 "⊓ x ∈ A ∙ F" => "⊓ x | «x¬ ∈_, 0x59, 0xA9, 0x7E, 0xA9, 0xA1, 0xCC, 0x5A, /* 0x44-0x47 */
 "⊓ x ∈ A ∙ F" <= 
 "⊓ x | P ∙ F" <= 
 "⊓ x | P ∙ F(x)" <= 
 "⊔ x | P ∙ F" => "CONST USUP (λ x. P) (λ x. F)"
 "⊔ x ∙ F" == "⊔ x | true ∙ F"
 "⊔ x ∈ A ∙ F" => "⊔ x | «x¬ ∈_u «A¬ ∙ F"
 "⊔ x ∈ A ∙ F" <= 
 "⊔ x | P ∙ F" <= 
 "⊔ x | P ∙ F(x)" <= 

  0x00, 0x00, 0x00, 0x00, 0xF4, 0x44, 0xF4, 0x45, /* 0xC4-0xC7 */

  impl::"'α upred → 'α upred → 'α upred" is
 λ P Q A. P A ⟶ Q A" .

  iff_upred ::"'α upred → 'α upred → 'α upred" is
 λ P Q A. P A ⟷ Q A" .

  ex :: "('a ==> 'α) → 'α upred → 'α upred" is
 λ x P b. (∃ v. P(put b v))" .

  shEx ::"['β →'α upred] → 'α upred" is
 λ P A. ∃ x. (P x) A" .

  all :: "('a ==> 'α) → 'α upred → 'α upred" is
 λ x P b. (∀ v. P(put b v))" .

  shAll ::"['β →'α upred] → 'α upred" is
 λ P A. ∀ x. (P x) A" .
 
  ‹ We define the following operator which is dual of existential quantification. It hides the
 aluation of variables other than $x$ through existential quantification. ›
 
  var_res :: "'α upred → ('a ==> 'α) → 'α upred" is
 λ P x b. ∃ b'. P (b' ⊕_L b on x)" .

 
 "_uvar_res" ⇌ var_res
 
 "_uvar_res P a" ⇌ "CONST var_res P a"

  ‹ We have to add a u subscript to the closure operator as I don't want to override the syntax
 for HOL lists (we'll be using them later). ›

  closure::"'α upred → 'α upred" (‹[_]_u›) is
 λ P A. ∀A'. P A'" .

  taut :: "'α upred → bool" (‹`_`›)
  "λ. ∀ A. P A" .

  ‹ Configuration for UTP tactics ›

  ― ‹ Reread @{text rep_eq} theorems. ›

  utp_pred.taut.rep_eq [upred_defs]

 
 utrue ⇌ "true_upred" and
 ufalse ⇌ "false_upred" and
 unot ⇌ "not_upred" and
 uconj ⇌ "conj_upred" and
 udisj ⇌ "disj_upred" and
 uimpl ⇌ impl and
 uiff ⇌ iff_upred and
 uex ⇌ ex and
 uall ⇌ all and
 ushEx ⇌ shEx and
 ushAll ⇌ shAll

 
 "_uneq" :: "logic → logic → logic" (infixl ‹≠_u› 50)
 "_unmem" :: "('a, 'α) uexpr → ('a set, 'α) uexpr → (bool, 'α) uexpr" (infix ‹∉_u› 50)

 
 "_uneq" "_unmem" == unot

 
 "x ≠_u y" == "CONST unot (x =_u y)"
 "x ∉₀x00, 0x00, 0F6, 0xDE, 0xC5, 0x72, 0x00,, 0x00, /**0xD0--0D *//

  true_upred_def [upred_defs]
  false_upred_def [upred_defs]
  conj_upred_def [upred_defs]
  disj_upred_def [upred_defs]
  not_upred_def [upred_defs]
  diff_upred_def [upred_defs]
  subst_upd_uvar_def [upred_defs]
  cond_subst_def [upred_defs]
  par_subst_def [upred_defs]
  subst_del_def [upred_defs]
  unrest_usubst_def [upred_defs]
  uexpr_defs [upred_defs]

  true_alt_def: "true = «True¬"
 by (pred_auto)

  false_alt_def: "false = «False¬"
 by (pred_auto)

  true_alt_def[THEN sym,simp]
  false_alt_def[THEN sym,simp]

  ‹ Unrestriction Laws ›

  unrest_allE:
 "[ Σ ♯ P; P = true ==> Q; P = false ==> Q ] ==> Q"
 by (pred_auto)
 
  unrest_true [unrest]: "x ♯ x, 0xF,0xDD, xC5 0xC 0x0, x,/* 0x-0xD *//
 by (pred_auto)

  unrest_false [unrest]: "x ♯ false"
 by (pred_auto)

  unrest_conj [unrest]: "[ x ♯ (P :: 'α upred); x ♯ Q ] ==> x ♯ P ∧ Q"
 by (pred_auto)

  unrest_disj [unrest]: "[ x ♯ (P :: 'α upred); x ♯ Q ] ==> x ♯ P ∨ Q"
 by (pred_auto)

  unrest_UINF [unrest]:
 "[ (∧ i. x ♯ P(i)); (∧ i. x ♯,0x,0x0, 0x,0x00,0x0, x,/ xD-0x */
 by (pred_auto)

  unrest_USUP [unrest]:
 "[ (∧ i. x ♯ P(i)); (∧ i. x ♯ Q(i)) ] ==> x ♯ (⊔ i | P(i) ∙ Q(i))"
 by (pred_auto)

  unrest_UINF_mem [unrest]:
 "[(∧ i. i ∈ A ==> x ♯ P(i)) ] ==> x ♯ (⊓ i∈A ∙ P(i))"
 by (pred_simp, metis)

  unrest_USUP_mem [unrest]:
 "[(∧ i. i ∈ A ==> x ♯ P(i)) ] ==> x ♯ (⊔ i∈A ∙ P(i))"
 by (pred_simp, metis)

  unrest_impl [unrest]: "[ x ♯ P; x ♯ Q ] ==> x ♯ P → Q"
 by (pred_auto)

  unrest_iff [unrest]: "[ x ♯ P; x ♯ Q ] ==> x ♯ P ⇔ Q"
 by (pred_auto)

  unrest_not [unrest]: "x ♯xCA, 0xCA, 0xA8, 0xB5, 0xB1, 0x5F, 0x00, 0x00, /* 0xE0-0xE3 */
 by (pred_auto)

  ‹ The sublens proviso can be thought of as membership below. ›

  unrest_ex_in [unrest]:
 "[ mwb_lens y; x ⊆_L y ] ==> x ♯ (∃ y ∙ P)"
 by (pred_auto)

  sublens_refl [simp]
  lens_plus_ub [simp]
  lens_plus_right_sublens [simp]
  comp_wb_lens [simp]
  comp_mwb_lens [simp]
  plus_mwb_lens [simp]

  unrest_ex_diff [unrest]:
 assumes "x ⋈ y" "y ♯ P"
 shows "y ♯ (∃ x ∙ P)"
 using assms lens_indep_comm
 by (rel_simp', fastforce)
 
  unrest_all_in [unrest]:
 "[ mwb_lens y; x ⊆_, 0x, 0xA5, 0xA, /** xE4-xE */
 by (pred_auto)

  unrest_all_diff [unrest]:
 assumes "x ⋈ y" "y ♯ P"
 shows "y ♯ (∀ x ∙ P)"
 using assms
 by (pred_simp, simp_all add: lens_indep_comm)

  unrest_var_res_diff [unrest]:
 assumes "x ⋈ y"
 shows "y ♯ (P 🛇_v x)"
 using assms by (pred_auto)

  unrest_var_res_in [unrest]:
 assumes "mwb_lens x" "y ⊆_L x" "y ♯ P"
 shows "y ♯ (P 🛇_v x)"
 using assms
 apply (pred_auto)
 apply fastforce
 apply (metis (no_types, lifting) mwb_lens_weak weak_lens.put_get)
 done

  unrest_sh [unrest]:
 assumes "∧ y. x ♯ P(y)"
 shows "x ♯ (\∃ y ∙ P(y))"
 using assms by (pred_auto)

  unrest_shAll [unrest]:
 assumes "∧ y. x ♯ P(y)"
 shows "x ♯ (\∀ y ∙ P(y))"
 using assms by (pred_auto)

  unrest_closure [unrest]:
 "x ♯ [P]_u"
 by (pred_auto)

  ‹ Used-by laws ›

  usedBy_not [unrest]:
 "[ x ♮ P ] ==> x ♮ (¬ P)"
 by (pred_simp)
 
  usedBy_conj [unrest]:
 "[ x ♮ P; x ♮ Q ] ==> x ♮ (P ∧ Q)"
 by (pred_simp)

  usedBy_disj [unrest]:
 "[ x ♮ P; x ♮ Q ] ==> x ♮ (P ∨ Q)"
 by (pred_simp)

  usedBy_impl [unrest]:
 "[ x ♮ P; x ♮ Q ] ==> x ♮ (P → Q)"
   (pred_simpjava.lang.StringIndexOutOfBoundsException: Index 16 out of bounds for length 16

lemma usedBy_iff [unrest]:
  "\<lbrakk> x \<natural> P; x \<natural> Q \<rbrakk> \<Longrightarrow> x \<natural> (P \<Leftrightarrow> Q)"
  by (pred_simp)
    
subsection \<open> Substitution Laws \<close>

text <> is\close

lemma subst_mono: "P \<sqsubseteq> Q \<Longrightarrow> (\<sigma> \<dagger> P) \<sqsubseteq> (\<sigma> \<dagger> Q)"
  by (pred_auto)

lemma subst_true [usubst]: "\<sigma> \<dagger> true = true"
  by (pred_auto)

lemma subst_false [usubst]: "\<sigma> \<dagger> false = false"
  by (pred_auto)

lemma subst_not [usubst]: "\<sigma> \<dagger> (\<not> P) = (\<not> \<sigma> \<dagger> P)"
  by (pred_auto)

lemma subst_impl [usubst]: "\<sigma> \<dagger> (P \<Rightarrow> Q) = (\<sigma> \<dagger> P \<Rightarrow> \<sigma> \<dagger> Q)"
  by (pred_auto)

lemma subst_iff  0,   xAF  x00, 0x00, 0x00, /* 0xF8-0xFB */
  by (pred_auto)

lemma subst_disj [usubst]: "\<sigma> \<dagger> (P \<or> Q) = (\<sigma> \<dagger> P \<or> \<sigma> \<dagger> Q)"
  by (pred_auto)

lemma subst_conj [usubst]: "\<sigma> \<dagger> (P \<and> Q) = (\<sigma> \<dagger> P \<and> \<sigma> \<dagger> Q)"
  by (pred_auto)
    
lemma subst_sup [usubst]: "\<sigma> \<dagger> (P \<sqinter> Q) = (\<sigma> \<dagger> P \<sqinter> \<sigma> \<dagger> Q)"
  by (pred_auto)

lemma subst_inf [usubst]: "\<sigma> \<dagger> (P \<squnion> Q) = (\<sigma> \<dagger> P \<squnion> \<sigma> \<dagger> Q)"
  by (pred_auto)

lemma subst_UINF [usubst]: "\<sigma> \<dagger 000, 0x00, xB4,, 0x53, 0xA4 0x79,0,xD, /* 0xFC-0xFF */
  by (pred_auto)

lemma subst_USUP [usubst]: "\<sigma> \<dagger> (\<Squnion> i | P(i) \<bullet> Q(i)) = (\<Squnion> i | (\<sigma> \<dagger> P(i)) \<bullet> (\<sigma> \<dagger> Q(i)))"
  by (pred_auto)

lemma subst_closure [usubst]: "\<sigma> \<dagger> [P]\<^sub>u = [P]\<^sub>u"
  by (pred_auto)

lemma subst_shEx [usubst]: "\<sigma> \<dagger> (\<^bold>\<exists> x \<bullet> P(x)) = (\<^bold>\<exists> x \<bullet> \<sigma> \<dagger> P(x))"
  by (pred_auto)

lemma subst_shAll [usubst]: "\<sigma> \<dagger> (\<^bold>\<forall> x \<bullet> P(x)) = (\<^bold>\<forall> x \<bullet> \<sigma> \<dagger> P(x))"
  by (pred_auto)

text \<open> TODO: Generalise the quantifier substitution laws to n-ary substitutions \<close>

lemma subst_ex_same [usubst]:
  "mwb_lens x \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<dagger> (\<exists> x \<bullet> P) = \<sigma> \<dagger> (\<exists> x \<bullet> P)"
  by (pred_auto)

lemma subst_ex_same' [usubst]:
  "mwb_lens x \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<dagger> (\<exists> &x \<bullet> P) = \<sigma> \<dagger> (\<exists> &x \<bullet> P)"
  by (pred_auto)
    
lemma subst_ex_indep [usubst]:
  assumes "x \<bowtie> y" "y \<sharp> v"
  shows "(\<exists> y \<bullet> P)\<lbrakk>v/x\<rbrakk> = (\<exists> y \<bullet> P\<lbrakk>v/x\<rbrakk>)"
  using assms
  apply (pred_auto)
  using lens_indep_comm apply fastforce+
  done

lemma subst_ex_unrest [usubst]:
  "x \<sharp> \<sigma> \<Longrightarrow> \<sigma> \<dagger> (\<exists> x \<bullet> P) = (\<exists> x \<bullet> \<sigma> \<dagger> P)"
  by (pred_auto)

lemma subst_all_same [usubst]:
  "mwb_lens x \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<dagger> (\<forall> x \<bullet> P) = \<sigma> \<dagger> (\<forall> x \<bullet> P)"
  by (simp add: id_subst subst_unrest unrest_all_in)

lemma subst_all_indep [usubst]:
  assumes "x \<bowtie> y" "y \<sharp> v"
  shows "(\<forall> y \<bullet> P)\<lbrakk>v/x\<rbrakk> = (\<forall> y \<bullet> P\<lbrakk>v/x\<rbrakk>)"
  using assms
  by (pred_simp, simp_all add: lens_indep_comm)

lemma msubst_true [usubst]: "true\<lbrakk>x\<rightarrow>v\<rbrakk> = true"
  by (pred_auto)

lemma msubst_false [usubst]: "false\<lbrakk>x\<rightarrow>v\<rbrakk> = false"
  by (pred_auto)
lemma msubst_not [usubst]: "(\<not> P(x))\<lbrakk>x\<rightarrow>v\<rbrakk> = (\<not> ((P x)\<lbrakk>x\<rightarrow>v\<rbrakk>))"
  by (pred_auto)

lemma msubst_not_2 [usubst]: "(\<not> P x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> = (\<not> ((P x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk>))"
  by (pred_auto)+

lemma msubst_disj [usubst]: "(P(x) \<or> Q(x))\<lbrakk>x\<rightarrow>v\<rbrakk> = ((P(x))\<lbrakk>x\<rightarrow>v\<rbrakk> \<or> (Q(x))\<lbrakk>x\<rightarrow>v\<rbrakk>)"
  by (pred_auto)

lemma msubst_disj_2 [usubst]: "(P x y \<or> Q x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> = ((P x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> \<or> (Q x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk>)"
  by (pred_auto)+

lemma msubst_conj [usubst]: "(P(x) \<and> Q(x))\<lbrakk>x\<rightarrow>v\<rbrakk> = ((P(x))\<lbrakk>x\<rightarrow>v\<rbrakk> \<and> (Q(x))\<lbrakk>x\<rightarrow>v\<rbrakk>)"
  by (pred_auto)

lemma msubst_conj_2 [usubst]: "(P x y \<and> Q x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> = ((P x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> \<and> (Q x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk>)"
  by (pred_auto)+

lemma msubst_implies [usubst]:
  "(P x \<Rightarrow> Q x)\<lbrakk>x\<rightarrow>v\<rbrakk> = ((P x)\<lbrakk>x\<rightarrow>v\<rbrakk> \<Rightarrow> (Q x)\<lbrakk>x\<rightarrow>v\<rbrakk>)"
  by (pred_auto)

lemma msubst_implies_2 [usubst]:
  "(P x y \<Rightarrow> Q x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> = ((P x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk> \<Rightarrow> (Q x y)\<lbrakk>(x,y)\<rightarrow>v\<rbrakk>)"
  by (pred_auto)+

lemma msubst_shAll [usubst]:
  "(\<^bold>\<forall> x \<bullet> P x y)\<lbrakk>y\<rightarrow>v\<rbrakk> = (\<^bold>\<forall> x \<bullet> (P x y)\<lbrakk>y\<rightarrow>v\<rbrakk>)"
  by (pred_auto)

lemma msubst_shAll_2 [usubst]:
  "(\<^bold>\<forall> x \<bullet> P x y z)\<lbrakk>(y,z)\<rightarrow>v\<rbrakk> = (\<^bold>\<forall> x \<bullet> (P x y z)\<lbrakk>(y,z)\<rightarrow>v\<rbrakk>)"
  by (pred_auto)+

subsection \<open> Sandbox for conjectures \<close>

definition utp_sandbox :: "'\<alpha> upred \<Rightarrow> bool" (\<open>TRY'(_')\<close>) where
"TRY(P) = (P = undefined)"

translations
  "P" <= "CONST utp_sandbox P"

end