theory newparaGste1 imports Main
begin

section{*Variables and values*}

text{*
According to the aforementioned discussion in section ?, firstly we define the variables used in the protocols.
There are two kinds of variables, global and parameterized (local)
variables. In hardware implemetations of the protocols,
the variables are implenteed as registers in global or local modules. *}

datatype varType=Ident  string | Para varType  nat |Field  varType   string

datatype scalrValueType=enum string string |index nat | boolV bool | topVal | bottomVal

(*datatype inVar = Input varType

datatype regVar= Reg varType*)

section{*Expressions and Formulas*}

datatype expType= IVar varType |
         Const scalrValueType |
         iteForm formula  expType  expType |
         uif string "expType list" |
         top |unKnown

and
 formula = eqn expType expType|
           uip string "expType list" |
           andForm  formula formula |
           neg formula|
           orForm formula formula |
           implyForm formula formula |
           chaos

primrec down ::"nat \<Rightarrow>nat list" where
down0:"down 0=[0]" |
downSuc:"down (Suc n)=Suc n #(down n)"

text{*Similarly, a parameterized formula is a function from a parameter to a formula. We also define
 the $\mathsf{forall}$ and $mathsf{exists}$ formulas$.*}
type_synonym paraFormula="nat \<Rightarrow> formula"

fun forallForm::"nat list \<Rightarrow>paraFormula \<Rightarrow> formula" where
oneAllForm: "forallForm [i] forms = forms i"|
moreAllForm: "forallForm (i#j#xs)  forms = andForm (forms i) (forallForm (j#xs)  forms)"

fun existsForm::"nat list \<Rightarrow>paraFormula \<Rightarrow> formula" where
oneExForm: " existsForm [i] forms = forms i"|
moreExForm: " existsForm (i#j#xs)  forms = orForm (forms i) (forallForm (j#xs)  forms)"

type_synonym formulaExpPair="formula \<times>  expType"

primrec caseExp::"formulaExpPair list  \<Rightarrow> expType" where
 caseNil: "caseExp [] = unKnown"|
 caseTail:"caseExp (gp # tls) =iteForm (fst gp) (snd gp) (caseExp tls )"

definition read::"varType \<Rightarrow> nat \<Rightarrow>expType \<Rightarrow>expType" where [simp]:
"read a bound e \<equiv> caseExp (map (\<lambda>i. ((eqn e (Const (index i))), IVar (Para a i))) (down bound))"

section{*assignment, statement, general statement*}
type_synonym assignType=  "varType \<times>   expType"

text{*A statement is is just a lists of assignments, but these assignments
 are extecuted in parallel, \emph{not} in a sequential order*}

(*datatype statement=  assign assignType    *)

datatype statement=  parallel "assignType  list"

text{*A parameterized statement is just a function from a parameter to a statement.
For convenience, we also define the concatation of statements, and use it to define
the $\mathsf{forall}$ statement.*}

type_synonym paraStatement= "nat \<Rightarrow> statement"

text{*A state transition from a state to another sate, which is caused by an execution of a statement, is
 defined as follows:*}

primrec statement2Assigns::"statement \<Rightarrow> assignType list" where
"statement2Assigns (parallel  S)=S"

primrec valOf::"assignType list \<Rightarrow> varType =>expType"  where
"valOf [] v=IVar v" |
"valOf (x#xs) v= (if ((fst x) =v) then (snd x) else valOf xs v)"

datatype rule =  guard formula  statement
text{*With the formalizatiion of formula and statement,
it is natural to define a rule. A guard and
 statement of a rule are also defined for convenience. *}

primrec pre::"rule \<Rightarrow> formula" where
"pre (guard f a)=f"

primrec act::"rule \<Rightarrow>statement" where
"act  (guard f a)=a"

type_synonym paraRule=" nat \<Rightarrow> rule"
text{*A parameterized rule is just from a natural number to a rule.*}

text{*Variables of a variable, an expression, a formula, and a statement is defined by
varsOfVar, varOfExp, varOfForm and varOfSent respectively*}

primrec varOfExp::"expType \<Rightarrow> varType list"  and
  varOfForm::"formula \<Rightarrow> varType list"  where

"varOfExp  (IVar v) = [ v]" |
"varOfExp   (Const j) =  []" |

"varOfExp   (iteForm f e1 e2) =(varOfForm f) @  (varOfExp   e1 )  @   (varOfExp  e2)" |
"varOfExp   (uif f es) = (concat (map varOfExp es))"|
"varOfExp   (top) =  []" |
"varOfExp   (unKnown) =  []" |

"varOfForm   (eqn e1 e2) = ( (varOfExp   e1 )  @   (varOfExp  e2))" |
"varOfForm   ( andForm f1 f2) =(  (varOfForm  f1 ) @  (varOfForm  f2 ))"|
"varOfForm   (neg f1 ) = (  (varOfForm   f1 ))"|
"varOfForm   (orForm f1 f2) =(  (varOfForm   f1 )   @   (varOfForm  f2 ))"|
"varOfForm   (implyForm f1 f2) = (  (varOfForm  f1 ) @ (varOfForm f2 ))"|
"varOfForm   (uip p es) = (concat (map varOfExp es))"|
"varOfForm   (chaos) =[]"

(*primrec  varOfSent::"statement \<Rightarrow> varType list" where
" varOfSent  (assign a)=[  (fst a)] " *)

section{*semantics of a protocol*}
text{*A  state of a protocol  is an instantaneous snapshot of its  behaviour given by an assignment of  values to variables of
the circuit. Therefore, we define:*}

type_synonym state= "varType \<Rightarrow> scalrValueType "

definition varsOfVar::" varType \<Rightarrow> varType set"  where  [simp]:
" varsOfVar x  = {x}"

type_synonym scalrValueTypeListFun="scalrValueType list \<Rightarrow> scalrValueType"

type_synonym interpretFunType="string \<Rightarrow> scalrValueTypeListFun"

type_synonym scalrValueTypeListPred="scalrValueType list \<Rightarrow> bool"

type_synonym interpretPredType="string \<Rightarrow> scalrValueTypeListPred"

primrec scalar2Bool::"scalrValueType\<Rightarrow>bool" where
" scalar2Bool (boolV b) = b"
|"scalar2Bool (index i) =False"
|"scalar2Bool (enum a s)=False"

text{*The formal semantics of an expression and a formula is formalized as follows:*}
primrec expEval :: "interpretFunType \<Rightarrow> expType \<Rightarrow> state \<Rightarrow> scalrValueType" and
 formEval :: "interpretFunType \<Rightarrow> formula \<Rightarrow> state \<Rightarrow>bool"  where

"expEval I  (IVar ie) s =  ( s ie)" |
"expEval I (Const i) s =  i"  |
"expEval I  (iteForm f e1 e2) s=
   ( if (formEval I f s) then     (expEval I e1 s)
   else (expEval I e2 s))"  |
"expEval I top  s= topVal"|
"expEval I unKnown s=bottomVal" |
"expEval I  (uif f es)  s=   (I f) (map (\<lambda> e. expEval  I e s) es) " |

evalExp: "formEval I (eqn e1 e2) s= ((expEval I e1 s) = (expEval I e2 s))" |
"formEval I  (uip p es)  s=    scalar2Bool ( (I p) (map (\<lambda> e. expEval  I e s) es)) " |
evalAnd: "formEval I ( andForm f1 f2) s=( (formEval I f1 s) \<and> (formEval I f2 s))"|
evalNeg: "formEval I (neg f1 ) s= ( \<not>(formEval I f1 s))"|
evalOr: "formEval I (orForm f1 f2) s=( (formEval I f1 s) \<or>  (formEval I f2 s))"|
evalImp:"formEval I (implyForm f1 f2) s= ( (formEval I f1 s) \<longrightarrow>  (formEval I f2 s))" |
"formEval I chaos s=True"

primrec transAux:: "assignType list \<Rightarrow>interpretFunType \<Rightarrow> state \<Rightarrow>state " where
"transAux [] I s= s " |
"transAux (pair#asgns) I s=( transAux asgns I s) ((fst pair):= expEval I (snd pair) s) "

definition trans:: "statement \<Rightarrow> interpretFunType \<Rightarrow> state \<Rightarrow>state " where [simp]:
"trans S I s \<equiv> transAux ( statement2Assigns S) I s"

text{*The reachable sate set of a protocol,
which is describled by a set of initiate formulas and a set of rules,
 can be formalized inductively as follows:*}

inductive_set reachableSet::" interpretFunType \<Rightarrow> formula set\<Rightarrow> rule set \<Rightarrow>state set"
  for  I::"interpretFunType" and inis::"formula set"  and rules::"rule set"   where

initState:  "\<lbrakk>formEval  I ini s; ini \<in>  inis\<rbrakk>  \<Longrightarrow>(  s \<in>  ( reachableSet I inis rules))" |

oneStep:    " \<lbrakk>s \<in>  reachableSet I inis rules ;
               r \<in>   rules ;formEval I (pre r ) s \<rbrakk> \<Longrightarrow>  trans  (act r ) I s  \<in>  reachableSet I inis rules"

section{*substitution, weakest precondition*}

primrec substExp :: "expType\<Rightarrow> assignType list \<Rightarrow>expType"  and
substForm ::"formula \<Rightarrow> assignType list \<Rightarrow> formula" where

substExpVar: "substExp  (IVar v') asgns=   (valOf  asgns v')  "|

substExpConst: "substExp  (Const i)  asgns= Const i" |

substTop: "substExp top asgns=top" |

substUnkown: "substExp unKnown asgns=unKnown" |

substExpite: "substExp  (iteForm f e1 e2)  asgns= (iteForm (substForm f asgns) (substExp e1  asgns) (substExp e2  asgns))"|

substUif: "substExp (uif f es) asgns =( uif f (map (\<lambda>e. substExp e asgns) es))"|

"substForm (eqn l r)  asgns=(eqn (substExp l  asgns) (substExp r  asgns))"  |
"substForm ( andForm f1 f2)  asgns =   ( andForm (substForm f1  asgns)  (substForm f2  asgns))"|
"substForm (neg f1 )   asgns= (neg ( substForm f1  asgns ))"|
"substForm (orForm f1 f2)   asgns= ( orForm (substForm f1  asgns )  (substForm f2  asgns))"|
"substForm (implyForm f1 f2)   asgns= (implyForm (substForm f1 asgns)  (substForm f2  asgns))" |
"substForm (uip p es)   asgns= ( uip p (map (\<lambda>e. substExp e asgns) es))" |
"substForm  chaos   asgns=chaos"

primrec  preCond1 ::" formula \<Rightarrow> statement  \<Rightarrow>formula" where
"preCond1 f ( parallel  S)  = substForm f S "

primrec  preExp1 ::" expType \<Rightarrow>  statement  \<Rightarrow>expType" where [simp]:
"preExp1 e  (parallel  S)  = substExp e S"

lemma lemmaOnValOf:  shows "expEval I (preExp1 (IVar v) nf) s = trans nf I s v"
  (is "?LHS1 nf =?RHS1 nf ")
proof(induct_tac nf)
  fix x
  let ?nf="parallel x"
  show "?LHS1 ?nf=?RHS1 ?nf"
  proof(auto)
  show "expEval I (valOf x v) s = transAux x I  s v"
     (is "?LHS2 x =?RHS2 x ")
  proof(induct_tac x)
  show "?LHS2 [] =?RHS2 []"
       by auto
    next
  fix a nf
  assume b1:"?LHS2 nf =?RHS2 nf"
  let ?nf="a#nf"
  show "?LHS2 ?nf =?RHS2 ?nf"
  apply(cut_tac b1,simp) done
  qed
  qed

qed

lemma itePreExp1:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans  nf I s)
   \<longrightarrow> expEval I (preExp1 x2 nf) s = expEval I x2 (trans  nf I s)
   \<longrightarrow>  expEval I (preExp1 x3 nf) s = expEval I x3 (trans  nf I s)
   \<longrightarrow>   expEval I (preExp1 (iteForm x1 x2 x3) nf) s = expEval I (iteForm x1 x2 x3) (trans  nf I s)"
   (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?p3 nf\<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf \<longrightarrow>?p3 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma eqPre:
  "expEval I (preExp1 x1 nf) s = expEval I x1 (trans nf I s)\<longrightarrow>
   expEval I (preExp1 x2 nf) s = expEval I x2 (trans nf I s)\<longrightarrow>
   formEval I (preCond1 (eqn x1 x2) nf) s = formEval I (eqn x1 x2) (trans nf I s)"
   (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma auxOnufiPre: "(\<forall>x2a. x2a \<in> set es \<longrightarrow> expEval I (preExp1 x2a (parallel S)) s = expEval I x2a (trans (parallel S) I s)) \<longrightarrow>
 (map ((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) es) =
      (map (\<lambda>e. expEval I e (transAux S I s)) es)" (is "?P es")
proof(induct_tac es)
  let ?nf="parallel S"
  show "?P []" by auto
  next
  fix x xs
  assume b1:"?P xs"
  show "?P (x#xs)" (is "?P1 (x#xs) \<longrightarrow> ?P2 (x#xs)")
  proof
  assume c1:"?P1 (x#xs)"
  have b2:"?P1 xs" by (cut_tac c1,auto )
  then have b3:"?P2 xs" by(cut_tac b1,auto)

   have b5:"((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) x =
  (\<lambda>e. expEval I e (transAux S I s)) x"
    by (cut_tac c1,simp)

  show "?P2 (x#xs)" (is "?LHS (x#xs) = ?RHS (x#xs)")
  by(cut_tac b5 b3, auto)
  qed
qed

lemma uifPre:

" (\<forall>x2a. x2a \<in> set es \<longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s)) \<longrightarrow>
             expEval I (preExp1 (uif f es) nf) s = expEval I (uif f es) (trans nf I s)   "
           (  is "?p1 nf\<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"

   show "?p1 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   proof
   assume a1:"?p1 ?nf"
   have b1:"(map ((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) es) =
      (map (\<lambda>e. expEval I e (transAux S I s)) es)"
      using a1 by auto

   then show "?LHS ?nf=?RHS ?nf" apply simp
   apply( simp add:b1)
   done
   qed

qed

lemma uipPre:

" (\<forall>x2a. x2a \<in> set es \<longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s)) \<longrightarrow>
             formEval I (preCond1 (uip pn es) nf) s =formEval I (uip pn es) (trans nf I s)   "
           (  is "?p1 nf\<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"

   show "?p1 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   proof
   assume a1:"?p1 ?nf"
   have b1:"(map ((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) es) =
      (map (\<lambda>e. expEval I e (transAux S I s)) es)"
      using a1 by auto
   then show "?LHS ?nf=?RHS ?nf" apply simp
   apply( simp add:b1)
   done
   qed

qed

lemma andPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 x2 nf) s = formEval I x2 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (andForm x1 x2) nf) s = formEval I (andForm x1 x2) (trans nf I s)"
    (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma orPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 x2 nf) s = formEval I x2 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (orForm x1 x2) nf) s = formEval I (orForm x1 x2) (trans nf I s)"
    (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma implyPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 x2 nf) s = formEval I x2 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (implyForm x1 x2) nf) s = formEval I (implyForm x1 x2) (trans nf I s)"
    (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma notPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (neg x1 ) nf) s = formEval I (neg x1 ) (trans nf I s)"
    (is "?p1 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma lemmaOnPre:
  shows "(expEval I (preExp1 e nf) s =   expEval I  e (trans nf I s)) \<and>
   (formEval I (preCond1 f nf) s = formEval I f (trans nf I s))"
   (is "((  ?LHS e =?RHS e )\<and> ( ?LHS1 f =?RHS1 f ))")
proof(induct_tac e and f)
  fix v
  let ?e="(IVar v)"
  show  "  ?LHS ?e =?RHS ?e "
  apply(simp)
  by (simp add: lemmaOnValOf)

next
  fix n
  let ?e="(Const n)"
  show  "?LHS ?e =?RHS ?e "
  proof(induct_tac nf,auto)qed

next
  fix f e1 e2
  assume b1:"( ?LHS1 f =?RHS1 f )" and
  b2:"?LHS e1 =?RHS e1 " and a3:"?LHS e2 =?RHS e2 "
  let ?e="iteForm f e1 e2"
  show "?LHS ?e =?RHS ?e " (is "?LHS1 nf=?RHS1 nf")
  by (simp add: a3 b1 b2 itePreExp1)

next
  let ?e="top"
  show "?LHS ?e =?RHS ?e "
  proof(induct_tac nf,auto)qed
next
  let ?e="unKnown"
  show "?LHS ?e =?RHS ?e "
  proof(induct_tac nf,auto)qed
next
  fix e1 e2
  assume a1:" ?LHS e1 =?RHS e1 " and a2:" ?LHS e2 =?RHS e2 "
  let ?f="eqn e1 e2"
  show "(?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1 a2 eqPre)

next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 =?RHS1 f1 )" and  a2:"  ?LHS1 f2 =?RHS1 f2 "
  let ?f="andForm f1 f2"
  show "( ?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1 a2 andPre)

next
  fix f1
  assume a1:" (?LHS1 f1 =?RHS1 f1 )"
  let ?f="neg f1"
  show "( ?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1  notPre)
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 =?RHS1 f1 )" and  a2:" ?LHS1 f2 =?RHS1 f2 "
  let ?f="implyForm f1 f2"

  show "(?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1 a2 implyPre)
next

  fix f1 f2
  assume a1:" ( ?LHS1 f1 =?RHS1 f1 )" and  a2:" ( ?LHS1 f2 =?RHS1 f2 )"
  let ?f="orForm f1 f2"

  show "(?LHS1 ?f =?RHS1 ?f )"
   by (simp add: a1 a2 orPre)
next
  let ?f="chaos"
  show "( ?LHS1 ?f =?RHS1 ?f )"
  proof(induct_tac nf,auto)qed
next
  fix fn es
  let ?e="uif fn es"
  assume a1:"(\<And>x2a. x2a \<in> set es \<Longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s))"
   show "?LHS ?e =?RHS ?e " (is "?LHS1 nf=?RHS1 nf")
   by (simp add: a1 uifPre)
next
  fix pn es
  let ?f="uip pn es"
  assume a1:"(\<And>x2a. x2a \<in> set es \<Longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s))"
   show "?LHS1 ?f =?RHS1 ?f "
   by (simp add: a1 uipPre)
qed

lemma lemmaOnPreExp:
shows "expEval I (preExp1 e nf) s =   expEval I e (trans nf I s) "
  by (simp add: lemmaOnPre)

lemma lemmaOnPreForm:
shows "formEval I (preCond1 f nf) s = formEval I f (trans nf I s)"
  by (simp add: lemmaOnPre)

section{*main lemma: consistency lemma*}

definition tautlogy::"formula \<Rightarrow>  interpretFunType \<Rightarrow>    bool" where [simp]:
"tautlogy f I \<equiv> \<forall>s. formEval I f s"

primrec andListForm::"formula list \<Rightarrow> formula " where
"andListForm [] = chaos" |
"andListForm  (f#fs) = andForm f (andListForm  fs)"

lemma andList1Aux:
   shows "formEval I ( (andListForm frms)) s  \<longrightarrow> frm \<in>set frms \<longrightarrow> formEval I ( frm) s "
   proof(induct_tac frms,auto)qed

lemma andList1:
   shows "formEval I ( (andListForm frms)) s  \<Longrightarrow>  frm \<in>set frms \<Longrightarrow> formEval I ( frm) s "
    by (metis andList1Aux)

section{*causal relations and consistency lemma*}
text{*A novel feature of our work lies in that three kinds of causal
relations are exploited, which are essentially special cases of the
general induction rule.  Consider a rule $r$, a formula $f$, and a formula set $fs$, three
 kinds of causal relations are defined as follows:*}

definition invHoldForRule1::"interpretFunType\<Rightarrow> state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule1 I s f  r \<equiv>
(formEval I (pre r) s \<longrightarrow>  formEval I (preCond1 f  (act r)) s )"
text{* $\mathsf{invHoldRule}_1(s,f, r)$ means that after rule $r$ is executed, $f$ becomes true immediately;*}

 definition invHoldForRule2::"interpretFunType\<Rightarrow> state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule2 I s f  r \<equiv>
(formEval I (preCond1 f  (act r)) s  =  formEval I f s)"
text{*$\mathsf{invHoldRule}_2(s,f, r)$ states that $\mathsf{preCond}(S,f)$ is equivalent to $f$,
which intuitively means that none of state variables in $f$ is changed, and the execution of
statement $S$ does not affect the evaluation of $f$;*}

definition  invHoldForRule3::"interpretFunType\<Rightarrow>state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
"invHoldForRule3 I s f r fs  \<equiv>
(\<exists>f'. f' \<in> fs \<and>  (formEval  I (andForm (pre r)  f') s\<longrightarrow> formEval I (preCond1 f  (act r))  s))"
text{*$\mathsf{invHoldRule}_3(s,f, r,fs)$ states that there exists another invariant $f' \in fs$ such that
  the conjunction of the guard of $r$ and $f'$ implies the precondition  $\mathsf{preCond}(S,f)$.*}

abbreviation invHoldForRule::"interpretFunType\<Rightarrow>state \<Rightarrow>formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule I s inv0 r invs \<equiv>
    invHoldForRule1 I s inv0 r \<or>  invHoldForRule2 I s inv0 r \<or>   invHoldForRule3 I s inv0 r invs "

text{*The relation $\mathsf{invHoldRule}(s, f,r,fs)$ defines a causality relation
between $f$, $r$, and $fs$, which guarantees that if each formula in $fs$ holds
before the execution of rule $r$, then $f$ holds after the execution of rule $r$.
We can also view $\mathsf{invHoldRule}(s, f, r, fs)$ as a
special kind of inductive tactics, which can be applied to prove
each formula in $fs$ holds at each inductive protocol rule cases.
Note that the three kinds of inductive tactics can be done by a theorem prover,
which is the cornerstone of our work.

With the $\mathsf{invHoldRule}$ relation, we define a consistency relation
$\mathsf{consistent}( invs,inis, rs)$ between a protocol $(inis,rs)$ and a
 set of invariants $invs=\{inv_1,\ldots, inv_n\}$. *}

definition consistent::"interpretFunType\<Rightarrow>formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where [simp]:
"consistent I invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval I ini s \<longrightarrow> formEval I inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule I s inv r invs  ))"

definition  invHoldForRule4::"interpretFunType\<Rightarrow>state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
"invHoldForRule4 I s f r fs  \<equiv>
(\<exists>fs'. fs' \<subseteq> fs \<and>  ((\<forall> f'. f'\<in>(fs' \<union> {pre r}) \<longrightarrow>formEval  I   f' s)\<longrightarrow> formEval I (preCond1 f  (act r))  s))"

abbreviation invHoldForRule'::"interpretFunType\<Rightarrow>state \<Rightarrow>formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule' I s inv0 r invs \<equiv>
    invHoldForRule1 I s inv0 r \<or>  invHoldForRule2 I s inv0 r \<or>   invHoldForRule4 I s inv0 r invs "

text{*$\mathsf{invHoldRule}_3(s,f, r,fs)$ states that there exists another invariant $f' \in fs$ such that
  the conjunction of the guard of $r$ and $f'$ implies the precondition  $\mathsf{preCond}(S,f)$.*}

lemma consistentLemma:
  assumes a1:"consistent I invs inis rs" and a2:"s \<in> reachableSet I inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval I inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold consistent_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans  (act r) I s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule3 I s inv r  invs \<or> invHoldForRule2 I s inv r   \<or> invHoldForRule1 I s inv r  "
        apply(cut_tac a1, unfold consistent_def)
        by (metis b1 oneStep(3))

     moreover
      { assume c1:"invHoldForRule3 I s inv r invs"

        let ?pref="preCond1 inv (act r)"
          have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s) \<longrightarrow>formEval I (pre r)  s\<longrightarrow> formEval I  ?pref s)  "  (is " ?P fs ")
           apply (cut_tac c1, unfold invHoldForRule3_def,auto)
          done

        then have b3':"?P fs  "
          by blast

        have b4:" (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval I ?pref s"
         by(cut_tac b4 b5 b3', auto)

        have "formEval I inv (trans (act r) I s)"
          using b6 lemmaOnPre by blast
      }

     moreover
      {assume b1':"invHoldForRule2 I s inv r "
        have b2:"formEval I inv s"
        by (metis b1 oneStep.hyps(2))

        let ?pref="preCond1 inv (act r)"
        have b3:" (  formEval I ?pref s  =  formEval I inv s)"
        by(cut_tac b1',unfold  invHoldForRule2_def,simp)

        with b2 have b4:"formEval I ?pref s"
          by auto

        have "formEval I inv (trans (act r) I s)"
          using b2 b3 lemmaOnPreForm by auto

      }
      moreover
      {assume b1':"invHoldForRule1 I s inv r "

         have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

         have "formEval I inv (trans (act r) I s)"
           apply(subgoal_tac "formEval I (preCond1 inv (act r) ) s")
           apply (simp add: lemmaOnPre)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1_def,auto)

       }
       ultimately show "formEval I inv (trans (act r) I s)"
         by blast
     qed
 qed

definition consistent'::"interpretFunType\<Rightarrow>formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where [simp]:
"consistent' I invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval I ini s \<longrightarrow> formEval I inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule' I s inv r invs  ))"

lemma consistentLemma':
  assumes a1:"consistent' I invs inis rs" and a2:"s \<in> reachableSet I inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval I inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold consistent'_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans  (act r) I s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule4 I s inv r  invs \<or> invHoldForRule2 I s inv r   \<or> invHoldForRule1 I s inv r  "
        apply(cut_tac a1, unfold consistent'_def)
        by (metis b1 oneStep(3))

     moreover
      { assume c1:"invHoldForRule4 I s inv r invs"

        let ?pref="preCond1 inv (act r)"
          have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s) \<longrightarrow>formEval I (pre r)  s\<longrightarrow> formEval I  ?pref s)  "  (is " ?P fs ")
           apply (cut_tac c1, unfold invHoldForRule4_def,auto)
          done

        then have b3':"?P fs  "
          by blast

        have b4:" (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval I ?pref s"
         by(cut_tac b4 b5 b3', auto)

        have "formEval I inv (trans (act r) I s)"
          using b6 lemmaOnPre by blast
      }

     moreover
      {assume b1':"invHoldForRule2 I s inv r "
        have b2:"formEval I inv s"
        by (metis b1 oneStep.hyps(2))

        let ?pref="preCond1 inv (act r)"
        have b3:" (  formEval I ?pref s  =  formEval I inv s)"
        by(cut_tac b1',unfold  invHoldForRule2_def,simp)

        with b2 have b4:"formEval I ?pref s"
          by auto

        have "formEval I inv (trans (act r) I s)"
          using b2 b3 lemmaOnPreForm by auto

      }
      moreover
      {assume b1':"invHoldForRule1 I s inv r "

         have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

         have "formEval I inv (trans (act r) I s)"
           apply(subgoal_tac "formEval I (preCond1 inv (act r) ) s")
           apply (simp add: lemmaOnPre)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1_def,auto)

       }
       ultimately show "formEval I inv (trans (act r) I s)"
         by blast
     qed
 qed

subsection{*more lemmas on valOf operator*}

text{*more lemmas on valOf operator*}

lemma valOfLemmaAux[simp]: "i \<le> N \<longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
  apply(induct_tac N)
  apply simp
  apply auto
done

lemma valOfLemma[simp]: "i \<le> N \<Longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
by (metis valOfLemmaAux )

lemma valOfLemma2Aux[simp]: "(var' \<notin> set (map fst xs)) \<longrightarrow> (valOf xs (var'))=IVar var'"
  apply(induct_tac xs)
  apply simp
  apply auto
done

lemma valOfLemma2[simp,intro]: "(var' \<notin> set (map fst xs)) \<Longrightarrow> (valOf xs (var'))=IVar var'"
by (metis (lifting) valOfLemma2Aux)

lemma valOfLemma3 [simp]:"(\<forall> i.  var' \<noteq> Para v i) \<Longrightarrow>
(valOf (map (\<lambda>i. (Para v i, e i)) (down N)) var')=IVar var'"
apply(rule valOfLemma2)
apply(induction N)
by auto

lemma valOfLemma4Aux :"v \<notin> set (map fst   ( statement2Assigns (parallel S))) \<longrightarrow>
( valOf ( statement2Assigns  (parallel ( S@ S'))) v) =    ( valOf ( statement2Assigns (parallel S')) v)"
    proof(induct_tac S,auto)qed

lemma valOfLemma4 [simp,intro]:"v \<notin> set (map fst   ( statement2Assigns (parallel S))) \<Longrightarrow>
( valOf ( statement2Assigns  (parallel ( S@ S'))) v) =    ( valOf ( statement2Assigns (parallel S')) v)"
by (metis valOfLemma4Aux)

lemma valOfLemma5Aux :"v \<notin> set (map fst  As') \<longrightarrow>
( valOf (As'@ As) v) =    ( valOf As) v"
    proof(induct_tac As',auto)qed

lemma valOfLemma5 :"v \<notin> set (map fst  As') \<Longrightarrow>
( valOf (As'@ As) v) =    ( valOf As) v"
   by (metis valOfLemma5Aux)

(*lemma mapFstAssignsAux:"(\<forall> i.  v' \<noteq> Para v i) \<longrightarrow> v' \<notin> set (map fst ( map (statement2Assigns o
                      (\<lambda>i. assign (Para v i,  e i))) L )) "
  apply(induct_tac L,auto) done

lemma mapFstAssigns [simp,intro]:"(\<forall> i.  v' \<noteq> Para v i) \<Longrightarrow> v' \<notin> set (map fst ( map (statement2Assigns o
                      (\<lambda>i. assign (Para v i,  e i))) L )) "
  apply(metis mapFstAssignsAux) done
*)
lemma valOfLemma6Aux :"v \<notin> set (map fst   S) \<longrightarrow>
( valOf  ( S@ S') v) =    ( valOf   S') v"
    proof(induct_tac S,auto)qed

lemma valOfLemma6 [simp,intro!]:"v \<notin> set (map fst   S) \<Longrightarrow>
( valOf  ( S@ S') v) =    ( valOf   S') v"
by (metis valOfLemma6Aux)

(*
lemma valOfLemma7 [simp]:
"map (statement2Assigns \<circ>
                      (\<lambda>i. assign (Para v i, e i)))
                  [0..<depth] = map (\<lambda>i.   (Para v i, e i)) [0..<depth]"
apply(induct_tac depth)
apply auto
done

lemma valOfLemma8 [simp]:
"map (statement2Assigns \<circ>
                      (\<lambda>i. assign (Para v i, e i)))
                  (down Last) = map (\<lambda>i.   (Para v i, e i)) (down Last)"
apply(induct_tac Last)
apply auto
done
*)
lemma valOfLemma9[simp]:
"\<forall>ASL. valOf (map (\<lambda>i.   (Para v i, e i)) [0..<depth]@ASL) (Ident v') =valOf ASL (Ident v')" (is "?P depth")
proof(induct_tac depth)
  show "?P 0"
    by auto
next
  fix n
  assume a1:"?P n"

  show "?P (Suc n)"
  proof
    fix ASL
    have a2:"(map (\<lambda>i. (Para v i, e i)) [0..<Suc n] @ ASL) =
    (map (\<lambda>i. (Para v i, e i)) [0..< n]) @((Para v ( n), e ( n))#ASL)"
    apply auto done
    have a3:" valOf ((map (\<lambda>i. (Para v i, e i)) [0..< n]) @((Para v ( n), e ( n))#ASL)) (Ident v') =
    valOf  ((Para v ( n), e ( n))#ASL) (Ident v')"
    by (simp add: local.a1)

    show "valOf (map (\<lambda>i. (Para v i, e i)) [0..<Suc n] @ ASL) (Ident v') = valOf ASL (Ident v')"
      apply(cut_tac a2 a3,auto)
   done
   qed
 qed

(*lemma valOfLemma10:"
          valOf (map (statement2Assigns \<circ>
                       (\<lambda>i. assign (Para (Ident ''mem'') i,
                                    iteForm (eqn (Const (index i)) (Const (index 0))) dataIn
                                     (caseExp
                                       (map (\<lambda>ia. (eqn (uif ''-'' [Const (index i), Const (index (Suc 0))]) (Const (index ia)), mem ia))
                                         (down depth))))))
                   [0..<depth] @
                  [(Ident ''tail'', iteForm (neg (eqn emptyFifo LOW)) (uif ''+'' [tail, Const (index (Suc 0))]) tail),
                   (Ident ''empty'', LOW)])
            (Ident ''tail'') = iteForm (neg (eqn emptyFifo LOW)) (uif ''+'' [tail, Const (index (Suc 0))]) tail"
     by auto
     *)
lemma valOfLemma11[simp]: "i \<le> N \<longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
  apply(induct_tac N)
  apply simp
  apply auto
done

lemma substMap:

shows "(\<forall> x. x \<in> set xs \<longrightarrow> substExp  x f=x)\<longrightarrow>substExp  (uif fStr xs) f =uif fStr xs"
proof(induct_tac xs,auto) qed

lemma substNIl:
  shows "(substExp e [] = e) \<and> (substForm f [] =f)"
  using substMap by(induct_tac e and f,auto)

lemma substNIlForm[simp]:
  shows " (substForm f [] =f)"
by (simp add: substNIl)

lemma substNIlExp[simp]:
  shows " (substExp e [] =e)"
by (simp add: substNIl)

lemma tautologyImplTrans[intro!]:
  assumes a1:"tautlogy (implyForm P Q) I" and a2:"tautlogy (implyForm  Q R) I"
  shows "tautlogy (implyForm P R) I"
using a2 local.a1 by auto

lemma noEffectSubstAux:

  shows " (  (v \<notin>set (varOfExp e) ) \<longrightarrow>  substExp  e ((v,e')#S)  =substExp  e S) \<and>
          (  (v \<notin>set (varOfForm f)  )\<longrightarrow> substForm f ((v,e')#S)  =  substForm f S )"

    (is "(( ?condOne e S\<longrightarrow> ?LHS e S=?RHS e S)\<and> (?condOnf f S\<longrightarrow> ?LHS1 f S=?RHS1 f S))")
  proof(induct_tac e and f,auto)qed

lemma noEffectSubstExp [simp,intro!]:

  shows " v \<notin>set (varOfExp e)  \<Longrightarrow>  substExp  e ((v,e')#S)  =substExp  e S "
by (metis noEffectSubstAux)

lemma noEffectSubstForm [simp,intro!]:

  shows "    (v \<notin>set (varOfForm f)  \<Longrightarrow>  substForm f ((v,e')#S)  =  substForm f S ) "
 by (metis noEffectSubstAux)

 lemma noEffectSubstAllAux:

  shows " (  (set (varOfExp e) \<inter> set (map fst S) ={} ) \<longrightarrow>  substExp  e S  = e) \<and>
          (  (set (varOfForm f) \<inter> set (map fst S) ={} )\<longrightarrow> substForm f S =  f )"

    (is "?P S")
  proof(induct_tac S,simp)
  fix a S
    assume a1:"?P S"
    show "?P (a#S)" (is "?P1 \<and> ?P2")
    proof(rule conjI)
    show "?P1"
    proof
      assume b1:" set (varOfExp e) \<inter> set (map fst (a # S)) = {}"
      have b2:"set (varOfExp e) \<inter> set (map fst S) ={}" by(cut_tac b1,auto)
      have b3:" substExp  e (a # S) = substExp  e S"
      proof(case_tac a,cut_tac b1,simp) qed
      have b4:"substExp  e S=e" by(cut_tac b2 a1,auto)
      show "substExp  e (a # S) = e"
      by (simp add: b3 b4)
    qed
   next
    show "?P2"
    proof
      assume b1:" set (varOfForm f) \<inter> set (map fst (a # S)) = {}"
      have b2:"set (varOfForm f) \<inter> set (map fst S) ={}" by(cut_tac b1,auto)
      have b3:" substForm  f (a # S) = substForm  f S"
      proof(case_tac a,cut_tac b1,simp) qed
      have b4:"substForm  f S=f"
      by(cut_tac b2 a1,auto)
      show "substForm  f (a # S) = f"
      by (simp add: b3 b4)
    qed
    qed
 qed

lemma noEffectPreExp [simp,intro!]:
  assumes a1:" v \<notin>set (varOfExp e)"
  shows " preExp1  e (parallel ( (v,e')#S))  = preExp1  e (parallel S) "
  by (simp add: local.a1)

lemma noEffectPreExp1 [simp,intro!]:
  assumes a1:" set (varOfExp e) \<inter>  set (map fst (  statement2Assigns (parallel S))) ={}"
  shows " preExp1  e (parallel S)  =e "
  using assms noEffectSubstAllAux by auto

lemma noEffectPreCond [simp,intro!]:
  assumes a1:" v \<notin>set (varOfForm f)"
  shows " preCond1  f (parallel ( (v,e')#S))  = preCond1  f (parallel S) "
  by (simp add: local.a1)

lemma noEffectPreCond1 [simp,intro!]:
assumes a1: "(  (set (varOfForm f) \<inter> set (map fst S) ={} ) )"
shows " substForm f S =  f"
using assms noEffectSubstAllAux by auto

lemma auxOnCaseExpMaps[simp]:
"varOfExp (caseExp (map (\<lambda>i. (f i, e i)) (down LAST)))
=concat (map (\<lambda>i. ( (varOfForm (f i))@varOfExp ( e i)))  (down LAST))"
proof(induct_tac LAST,auto)qed

lemma substByWrite[simp,intro!]:
  assumes a1:"(\<forall>j. Para mem j \<notin>set (varOfExp e'))"
shows "(substExp e'
       (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i)))) (down n))) =e'"
using a1 by(induct_tac n, auto)

lemma SucnIsNotInDownNAux: "\<forall>i. Suc n \<le> i \<longrightarrow> i \<notin> set (down n)"
proof(induct_tac n,auto)qed

lemma SucnIsNotInDownn: "Suc n \<notin> set (down n)"
by (simp add: SucnIsNotInDownNAux)

(*lemma OnIfPos1[simp,intro]:
  assumes a1:"tautlogy  (implyForm pre b) I"
  shows "tautlogy  (implyForm pre (preCond1 f (If b S1 S2))) I = tautlogy  (implyForm pre (preCond1 f  S1 )) I "
    by (cut_tac a1,auto)

lemma OnIfNeg1[simp,intro]:
  assumes a1:"tautlogy  (implyForm pre (neg b)) I"
  shows "tautlogy  (implyForm pre (preCond1 f (If b S1 S2))) I = tautlogy  (implyForm pre (preCond1 f  S2 )) I "
    by (cut_tac a1,auto)

lemma preCondAndList[simp]:
shows "tautlogy (implyForm (preCond1 (andListForm FS) S) ( andListForm (map (\<lambda>f. preCond1 f S) FS))) I"
proof(induct_tac FS,simp,case_tac S,simp ,simp,rule allI)
  fix a list x21 x22 x23 s
  assume b1:" \<forall>s. (formEval I x21 s \<and> formEval I (preCond1 (andListForm list) x22) s \<longrightarrow>
            formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s) \<and>
           (\<not> formEval I x21 s \<and> formEval I (preCond1 (andListForm list) x23) s \<longrightarrow>
            formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s) " and
         b2:"S = generalizeStatement.If x21 x22 x23 "
   show "(formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x22) s \<longrightarrow>
        formEval I (preCond1 a x22) s \<and>
        formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s) \<and>
       (\<not> formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x23) s \<longrightarrow>
        formEval I (preCond1 a x23) s \<and>
        formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s)"(is "?P \<and> ?Q")
    proof(rule conjI)
      show "?P"
      proof
        assume c1:"formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x22) s "
        show "formEval I (preCond1 a x22) s \<and>
        formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s"
        using b1 c1 lemmaOnPreForm by auto
      qed
      next
      show "?Q"
      proof
        assume c1:"\<not> formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x23) s"
        show "formEval I (preCond1 a x23) s \<and> formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s"
        using b1 c1 lemmaOnPreForm by auto
       qed
       qed
qed

lemma preCondAndListConv[simp]:
shows "tautlogy (implyForm  ( andListForm (map (\<lambda>f. preCond1 f S) FS))  (preCond1 (andListForm FS) S)) I"
proof(induct_tac FS,case_tac S,simp,simp,rule allI)
  fix x21 x22 x23 s
  assume a1:"S = generalizeStatement.If x21 x22 x23"
  show "formEval I x21 s \<and> formEval I (preCond1 chaos x22) s \<or> \<not> formEval I x21 s \<and> formEval I (preCond1 chaos x23) s" thm lemmaOnPreForm
  by (simp add: lemmaOnPreForm)
  next
  fix a list
  assume a1:"tautlogy (implyForm (andListForm (map (\<lambda>f. preCond1 f S) list)) (preCond1 (andListForm list) S)) I"
  show "tautlogy (implyForm (andListForm (map (\<lambda>f. preCond1 f S) (a # list))) (preCond1 (andListForm (a # list)) S)) I"
  proof(simp,rule allI,rule impI)
    fix s
    assume b1:"formEval I (preCond1 a S) s \<and> formEval I (andListForm (map (\<lambda>f. preCond1 f S) list)) s "
    show "formEval I (preCond1 (andForm a (andListForm list)) S) s"
    proof(case_tac S)
      fix xs
      assume c1:"S=Parallel xs"
      show "formEval I (preCond1 (andForm a (andListForm list)) S) s"
      apply(cut_tac a1 b1 c1,simp) done
      next
      fix x21 x22 x23
      assume c1:"S=generalizeStatement.If x21 x22 x23"
      show "formEval I (preCond1 (andForm a (andListForm list)) S) s"
      apply(cut_tac a1 b1 c1,simp)
      using lemmaOnPreForm by auto
    qed
    qed
qed
*)
end


(*  Title:       Safe OCL
    Author:      Denis Nikiforov, March 2019
    Maintainer:  Denis Nikiforov <denis.nikif at gmail.com>
    License:     LGPL
*)
chapter \<open>Basic Types\<close>
theory OCL_Basic_Types
  imports Main "HOL-Library.FSet" "HOL-Library.Phantom_Type"
begin

(*** Definition *************************************************************)

section \<open>Definition\<close>

text \<open>
  Basic types are parameterized over classes.\<close>

type_synonym 'a enum = "('a, String.literal) phantom"
type_synonym elit = String.literal

datatype ('a :: order) basic_type =
  OclAny
| OclVoid
| Boolean
| Real
| Integer
| UnlimitedNatural
| String
| ObjectType 'a ("\<langle>_\<rangle>\<^sub>\<T>" [0] 1000)
| Enum "'a enum"

inductive basic_subtype (infix "\<sqsubset>\<^sub>B" 65) where
  "OclVoid \<sqsubset>\<^sub>B Boolean"
| "OclVoid \<sqsubset>\<^sub>B UnlimitedNatural"
| "OclVoid \<sqsubset>\<^sub>B String"
| "OclVoid \<sqsubset>\<^sub>B \<langle>\<C>\<rangle>\<^sub>\<T>"
| "OclVoid \<sqsubset>\<^sub>B Enum \<E>"

| "UnlimitedNatural \<sqsubset>\<^sub>B Integer"
| "Integer \<sqsubset>\<^sub>B Real"
| "\<C> < \<D> \<Longrightarrow> \<langle>\<C>\<rangle>\<^sub>\<T> \<sqsubset>\<^sub>B \<langle>\<D>\<rangle>\<^sub>\<T>"

| "Boolean \<sqsubset>\<^sub>B OclAny"
| "Real \<sqsubset>\<^sub>B OclAny"
| "String \<sqsubset>\<^sub>B OclAny"
| "\<langle>\<C>\<rangle>\<^sub>\<T> \<sqsubset>\<^sub>B OclAny"
| "Enum \<E> \<sqsubset>\<^sub>B OclAny"

declare basic_subtype.intros [intro!]

inductive_cases basic_subtype_x_OclAny [elim!]: "\<tau> \<sqsubset>\<^sub>B OclAny"
inductive_cases basic_subtype_x_OclVoid [elim!]: "\<tau> \<sqsubset>\<^sub>B OclVoid"
inductive_cases basic_subtype_x_Boolean [elim!]: "\<tau> \<sqsubset>\<^sub>B Boolean"
inductive_cases basic_subtype_x_Real [elim!]: "\<tau> \<sqsubset>\<^sub>B Real"
inductive_cases basic_subtype_x_Integer [elim!]: "\<tau> \<sqsubset>\<^sub>B Integer"
inductive_cases basic_subtype_x_UnlimitedNatural [elim!]: "\<tau> \<sqsubset>\<^sub>B UnlimitedNatural"
inductive_cases basic_subtype_x_String [elim!]: "\<tau> \<sqsubset>\<^sub>B String"
inductive_cases basic_subtype_x_ObjectType [elim!]: "\<tau> \<sqsubset>\<^sub>B \<langle>\<C>\<rangle>\<^sub>\<T>"
inductive_cases basic_subtype_x_Enum [elim!]: "\<tau> \<sqsubset>\<^sub>B Enum \<E>"

inductive_cases basic_subtype_OclAny_x [elim!]: "OclAny \<sqsubset>\<^sub>B \<sigma>"
inductive_cases basic_subtype_ObjectType_x [elim!]: "\<langle>\<C>\<rangle>\<^sub>\<T> \<sqsubset>\<^sub>B \<sigma>"

lemma basic_subtype_asym:
  "\<tau> \<sqsubset>\<^sub>B \<sigma> \<Longrightarrow> \<sigma> \<sqsubset>\<^sub>B \<tau> \<Longrightarrow> False"
  by (induct rule: basic_subtype.induct, auto)

(*** Partial Order of Basic Types *******************************************)

section \<open>Partial Order of Basic Types\<close>

instantiation basic_type :: (order) order
begin

definition "(<) \<equiv> basic_subtype\<^sup>+\<^sup>+"
definition "(\<le>) \<equiv> basic_subtype\<^sup>*\<^sup>*"

(*** Strict Introduction Rules **********************************************)

subsection \<open>Strict Introduction Rules\<close>

lemma type_less_x_OclAny_intro [intro]:
  "\<tau> \<noteq> OclAny \<Longrightarrow> \<tau> < OclAny"
proof -
  have "basic_subtype\<^sup>+\<^sup>+ OclVoid OclAny"
    by (rule_tac ?b="Boolean" in tranclp.trancl_into_trancl; auto)
  moreover have "basic_subtype\<^sup>+\<^sup>+ Integer OclAny"
    by (rule_tac ?b="Real" in tranclp.trancl_into_trancl; auto)
  moreover hence "basic_subtype\<^sup>+\<^sup>+ UnlimitedNatural OclAny"
    by (rule_tac ?b="Integer" in tranclp_into_tranclp2; auto)
  ultimately show "\<tau> \<noteq> OclAny \<Longrightarrow> \<tau> < OclAny"
    unfolding less_basic_type_def
    by (induct \<tau>, auto)
qed

lemma type_less_OclVoid_x_intro [intro]:
  "\<tau> \<noteq> OclVoid \<Longrightarrow> OclVoid < \<tau>"
proof -
  have "basic_subtype\<^sup>+\<^sup>+ OclVoid OclAny"
    by (rule_tac ?b="Boolean" in tranclp.trancl_into_trancl; auto)
  moreover have "basic_subtype\<^sup>+\<^sup>+ OclVoid Integer"
    by (rule_tac ?b="UnlimitedNatural" in tranclp.trancl_into_trancl; auto)
  moreover hence "basic_subtype\<^sup>+\<^sup>+ OclVoid Real"
    by (rule_tac ?b="Integer" in tranclp.trancl_into_trancl; auto)
  ultimately show "\<tau> \<noteq> OclVoid \<Longrightarrow> OclVoid < \<tau>"
    unfolding less_basic_type_def
    by (induct \<tau>; auto)
qed

lemma type_less_x_Real_intro [intro]:
  "\<tau> = UnlimitedNatural \<Longrightarrow> \<tau> < Real"
  "\<tau> = Integer \<Longrightarrow> \<tau> < Real"
  unfolding less_basic_type_def
  by (rule rtranclp_into_tranclp2, auto)

lemma type_less_x_Integer_intro [intro]:
  "\<tau> = UnlimitedNatural \<Longrightarrow> \<tau> < Integer"
  unfolding less_basic_type_def
  by (rule rtranclp_into_tranclp2, auto)

lemma type_less_x_ObjectType_intro [intro]:
  "\<tau> = \<langle>\<C>\<rangle>\<^sub>\<T> \<Longrightarrow> \<C> < \<D> \<Longrightarrow> \<tau> < \<langle>\<D>\<rangle>\<^sub>\<T>"
  unfolding less_basic_type_def
  using dual_order.order_iff_strict by blast

(*** Strict Elimination Rules ***********************************************)

subsection \<open>Strict Elimination Rules\<close>

lemma type_less_x_OclAny [elim!]:
  "\<tau> < OclAny \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Boolean \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Integer \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Real \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = String \<Longrightarrow> P) \<Longrightarrow>
   (\<And>\<E>. \<tau> = Enum \<E> \<Longrightarrow> P) \<Longrightarrow>
   (\<And>\<C>. \<tau> = \<langle>\<C>\<rangle>\<^sub>\<T> \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_OclVoid [elim!]:
  "\<tau> < OclVoid \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_Boolean [elim!]:
  "\<tau> < Boolean \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_Real [elim!]:
  "\<tau> < Real \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Integer \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_Integer [elim!]:
  "\<tau> < Integer \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_UnlimitedNatural [elim!]:
  "\<tau> < UnlimitedNatural \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_String [elim!]:
  "\<tau> < String \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

lemma type_less_x_ObjectType [elim!]:
  "\<tau> < \<langle>\<D>\<rangle>\<^sub>\<T> \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<And>\<C>. \<tau> = \<langle>\<C>\<rangle>\<^sub>\<T> \<Longrightarrow> \<C> < \<D> \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  apply (induct rule: converse_tranclp_induct)
  apply auto[1]
  using less_trans by auto

lemma type_less_x_Enum [elim!]:
  "\<tau> < Enum \<E> \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow> P"
  unfolding less_basic_type_def
  by (induct rule: converse_tranclp_induct; auto)

(*** Properties *************************************************************)

subsection \<open>Properties\<close>

lemma basic_subtype_irrefl:
  "\<tau> < \<tau> \<Longrightarrow> False"
  for \<tau> :: "'a basic_type"
  by (cases \<tau>; auto)

lemma tranclp_less_basic_type:
  "(\<tau>, \<sigma>) \<in> {(\<tau>, \<sigma>). \<tau> \<sqsubset>\<^sub>B \<sigma>}\<^sup>+ \<longleftrightarrow> \<tau> < \<sigma>"
  by (simp add: tranclp_unfold less_basic_type_def)

lemma basic_subtype_acyclic:
  "acyclicP basic_subtype"
  apply (rule acyclicI)
  using OCL_Basic_Types.basic_subtype_irrefl
    OCL_Basic_Types.tranclp_less_basic_type by auto

lemma less_le_not_le_basic_type:
  "\<tau> < \<sigma> \<longleftrightarrow> \<tau> \<le> \<sigma> \<and> \<not> \<sigma> \<le> \<tau>"
  for \<tau> \<sigma> :: "'a basic_type"
  unfolding less_basic_type_def less_eq_basic_type_def
  apply (rule iffI; auto)
  apply (metis (mono_tags) basic_subtype_irrefl
      less_basic_type_def tranclp_rtranclp_tranclp)
  by (drule rtranclpD; auto)

lemma antisym_basic_type:
  "\<tau> \<le> \<sigma> \<Longrightarrow> \<sigma> \<le> \<tau> \<Longrightarrow> \<tau> = \<sigma>"
  for \<tau> \<sigma> :: "'a basic_type"
  unfolding less_eq_basic_type_def less_basic_type_def
  by (metis (mono_tags, lifting) less_eq_basic_type_def
      less_le_not_le_basic_type less_basic_type_def rtranclpD)

lemma order_refl_basic_type [iff]:
  "\<tau> \<le> \<tau>"
  for \<tau> :: "'a basic_type"
  by (simp add: less_eq_basic_type_def)

instance
  by standard (auto simp add: less_eq_basic_type_def
        less_le_not_le_basic_type antisym_basic_type)

end

(*** Non-Strict Introduction Rules ******************************************)

subsection \<open>Non-Strict Introduction Rules\<close>

lemma type_less_eq_x_OclAny_intro [intro]:
  "\<tau> \<le> OclAny"
  using order.order_iff_strict by auto

lemma type_less_eq_OclVoid_x_intro [intro]:
  "OclVoid \<le> \<tau>"
  using order.order_iff_strict by auto

lemma type_less_eq_x_Real_intro [intro]:
  "\<tau> = UnlimitedNatural \<Longrightarrow> \<tau> \<le> Real"
  "\<tau> = Integer \<Longrightarrow> \<tau> \<le> Real"
  using order.order_iff_strict by auto

lemma type_less_eq_x_Integer_intro [intro]:
  "\<tau> = UnlimitedNatural \<Longrightarrow> \<tau> \<le> Integer"
  using order.order_iff_strict by auto

lemma type_less_eq_x_ObjectType_intro [intro]:
  "\<tau> = \<langle>\<C>\<rangle>\<^sub>\<T> \<Longrightarrow> \<C> \<le> \<D> \<Longrightarrow> \<tau> \<le> \<langle>\<D>\<rangle>\<^sub>\<T>"
  using order.order_iff_strict by fastforce

(*** Non-Strict Elimination Rules *******************************************)

subsection \<open>Non-Strict Elimination Rules\<close>

lemma type_less_eq_x_OclAny [elim!]:
  "\<tau> \<le> OclAny \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = OclAny \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Boolean \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Integer \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Real \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = String \<Longrightarrow> P) \<Longrightarrow>
   (\<And>\<E>. \<tau> = Enum \<E> \<Longrightarrow> P) \<Longrightarrow>
   (\<And>\<C>. \<tau> = \<langle>\<C>\<rangle>\<^sub>\<T> \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_OclVoid [elim!]:
  "\<tau> \<le> OclVoid \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_Boolean [elim!]:
  "\<tau> \<le> Boolean \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Boolean \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_Real [elim!]:
  "\<tau> \<le> Real \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Integer \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Real \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_Integer [elim!]:
  "\<tau> \<le> Integer \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Integer \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_UnlimitedNatural [elim!]:
  "\<tau> \<le> UnlimitedNatural \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = UnlimitedNatural \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_String [elim!]:
  "\<tau> \<le> String \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = String \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_ObjectType [elim!]:
  "\<tau> \<le> \<langle>\<D>\<rangle>\<^sub>\<T> \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<And>\<C>. \<tau> = \<langle>\<C>\<rangle>\<^sub>\<T> \<Longrightarrow> \<C> \<le> \<D> \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

lemma type_less_eq_x_Enum [elim!]:
  "\<tau> \<le> Enum \<E> \<Longrightarrow>
   (\<tau> = OclVoid \<Longrightarrow> P) \<Longrightarrow>
   (\<tau> = Enum \<E> \<Longrightarrow> P) \<Longrightarrow> P"
  by (drule le_imp_less_or_eq; auto)

(*** Simplification Rules ***************************************************)

subsection \<open>Simplification Rules\<close>

lemma basic_type_less_left_simps [simp]:
  "OclAny < \<sigma> = False"
  "OclVoid < \<sigma> = (\<sigma> \<noteq> OclVoid)"
  "Boolean < \<sigma> = (\<sigma> = OclAny)"
  "Real < \<sigma> = (\<sigma> = OclAny)"
  "Integer < \<sigma> = (\<sigma> = OclAny \<or> \<sigma> = Real)"
  "UnlimitedNatural < \<sigma> = (\<sigma> = OclAny \<or> \<sigma> = Real \<or> \<sigma> = Integer)"
  "String < \<sigma> = (\<sigma> = OclAny)"
  "ObjectType \<C> < \<sigma> = (\<exists>\<D>. \<sigma> = OclAny \<or> \<sigma> = ObjectType \<D> \<and> \<C> < \<D>)"
  "Enum \<E> < \<sigma> = (\<sigma> = OclAny)"
  by (induct \<sigma>, auto)

lemma basic_type_less_right_simps [simp]:
  "\<tau> < OclAny = (\<tau> \<noteq> OclAny)"
  "\<tau> < OclVoid = False"
  "\<tau> < Boolean = (\<tau> = OclVoid)"
  "\<tau> < Real = (\<tau> = Integer \<or> \<tau> = UnlimitedNatural \<or> \<tau> = OclVoid)"
  "\<tau> < Integer = (\<tau> = UnlimitedNatural \<or> \<tau> = OclVoid)"
  "\<tau> < UnlimitedNatural = (\<tau> = OclVoid)"
  "\<tau> < String = (\<tau> = OclVoid)"
  "\<tau> < ObjectType \<D> = (\<exists>\<C>. \<tau> = ObjectType \<C> \<and> \<C> < \<D> \<or> \<tau> = OclVoid)"
  "\<tau> < Enum \<E> = (\<tau> = OclVoid)"
  by auto

(*** Upper Semilattice of Basic Types ***************************************)

section \<open>Upper Semilattice of Basic Types\<close>

notation sup (infixl "\<squnion>" 65)

instantiation basic_type :: (semilattice_sup) semilattice_sup
begin

(* We use "case"-style because it works faster *)
fun sup_basic_type where
  "\<langle>\<C>\<rangle>\<^sub>\<T> \<squnion> \<sigma> = (case \<sigma> of OclVoid \<Rightarrow> \<langle>\<C>\<rangle>\<^sub>\<T> | \<langle>\<D>\<rangle>\<^sub>\<T> \<Rightarrow> \<langle>\<C> \<squnion> \<D>\<rangle>\<^sub>\<T> | _ \<Rightarrow> OclAny)"
| "\<tau> \<squnion> \<sigma> = (if \<tau> \<le> \<sigma> then \<sigma> else (if \<sigma> \<le> \<tau> then \<tau> else OclAny))"

lemma sup_ge1_ObjectType:
  "\<langle>\<C>\<rangle>\<^sub>\<T> \<le> \<langle>\<C>\<rangle>\<^sub>\<T> \<squnion> \<sigma>"
  apply (induct \<sigma>; simp add: basic_subtype.simps
        less_eq_basic_type_def r_into_rtranclp)
  by (metis Nitpick.rtranclp_unfold basic_subtype.intros(8)
        le_imp_less_or_eq r_into_rtranclp sup_ge1)

lemma sup_ge1_basic_type:
  "\<tau> \<le> \<tau> \<squnion> \<sigma>"
  for \<tau> \<sigma> :: "'a basic_type"
  apply (induct \<tau>, auto)
  using sup_ge1_ObjectType by auto

lemma sup_commut_basic_type:
  "\<tau> \<squnion> \<sigma> = \<sigma> \<squnion> \<tau>"
  for \<tau> \<sigma> :: "'a basic_type"
  by (induct \<tau>; induct \<sigma>; auto simp add: sup.commute)

instance
  by standard (auto simp add: sup_ge1_basic_type
        sup_commut_basic_type sup_least_basic_type)

end

(*** Code Setup *************************************************************)

section \<open>Code Setup\<close>

code_pred basic_subtype .

fun basic_subtype_fun :: "'a::order basic_type \<Rightarrow> 'a basic_type \<Rightarrow> bool" where
  "basic_subtype_fun OclAny \<sigma> = False"
| "basic_subtype_fun OclVoid \<sigma> = (\<sigma> \<noteq> OclVoid)"
| "basic_subtype_fun Boolean \<sigma> = (\<sigma> = OclAny)"
| "basic_subtype_fun Real \<sigma> = (\<sigma> = OclAny)"
| "basic_subtype_fun Integer \<sigma> = (\<sigma> = Real \<or> \<sigma> = OclAny)"
| "basic_subtype_fun UnlimitedNatural \<sigma> = (\<sigma> = Integer \<or> \<sigma> = Real \<or> \<sigma> = OclAny)"
| "basic_subtype_fun String \<sigma> = (\<sigma> = OclAny)"
| "basic_subtype_fun \<langle>\<C>\<rangle>\<^sub>\<T> \<sigma> = (case \<sigma>
    of \<langle>\<D>\<rangle>\<^sub>\<T> \<Rightarrow> \<C> < \<D>
     | OclAny \<Rightarrow> True
     | _ \<Rightarrow> False)"
| "basic_subtype_fun (Enum _) \<sigma> = (\<sigma> = OclAny)"

lemma less_basic_type_code [code]:
  "(<) = basic_subtype_fun"
proof (intro ext iffI)
  fix \<tau> \<sigma> :: "'a basic_type"
  show "\<tau> < \<sigma> \<Longrightarrow> basic_subtype_fun \<tau> \<sigma>"
    apply (cases \<sigma>; auto)
    using basic_subtype_fun.elims(3) by fastforce
  show "basic_subtype_fun \<tau> \<sigma> \<Longrightarrow> \<tau> < \<sigma>"
    apply (erule basic_subtype_fun.elims, auto)
    by (cases \<sigma>, auto)
qed

lemma less_eq_basic_type_code [code]:
  "(\<le>) = (\<lambda>x y. basic_subtype_fun x y \<or> x = y)"
  unfolding dual_order.order_iff_strict less_basic_type_code
  by auto

end


theory Finite_Linear_Priority

imports
  Finite_Linear_Pri
begin

section \<open> Original definition \<close>

text \<open> In what follows we formalise the definition of Pri as found in
       "Expressiveness of CSP with Priority". \<close>

fun prirelacc :: "'a partialorder \<Rightarrow> 'a acceptance \<Rightarrow> 'a acceptance \<Rightarrow> bool" where
\<comment> \<open>Any acceptance Z is related to \<bullet>.\<close>
"prirelacc p \<bullet> Z = True" |
\<comment> \<open>Any acceptance Z, that is not \<bullet>, is related to A, where A is a set that
    contains events in Z, such that no event b in Z is of higher priority as
    given by the partial order p.\<close>
"prirelacc p [A]\<^sub>\<F>\<^sub>\<L> [Z]\<^sub>\<F>\<^sub>\<L> = (A = {a. a \<in> Z \<and> \<not>(\<exists>b. b\<in>Z \<and> a <\<^sup>*p b)})" |
"prirelacc p X Y = False"

text \<open> Pri is defined by the relation prirel below. The recursive case has been
       simplified in comparison to that in the paper, while the base case has
       been made clear. \<close>

fun prirel :: "'a partialorder \<Rightarrow> 'a fltrace \<Rightarrow> 'a fltrace \<Rightarrow> bool" where
\<comment> \<open>The base case of this relation is given by prirelacc. \<close>
"prirel p \<langle>A\<rangle>\<^sub>\<F>\<^sub>\<L> \<langle>Z\<rangle>\<^sub>\<F>\<^sub>\<L> = (prirelacc p A Z \<and> (A = \<bullet> \<longrightarrow> Z = \<bullet>))" |
\<comment> \<open>The relation is defined for sequences of the same length. Observe, however,
    that this would not preclude the definition of a weaker relation whereby a
    longer sequence is related to a shorter sequence (see definition commented out). \<close>
"prirel p \<langle>A\<rangle>\<^sub>\<F>\<^sub>\<L> (Z #\<^sub>\<F>\<^sub>\<L> zz) = False" | (* (prirelacc p A (acceptance Z)) *)
"prirel p (A #\<^sub>\<F>\<^sub>\<L> aa) \<langle>Z\<rangle>\<^sub>\<F>\<^sub>\<L> = False" |
\<comment> \<open>The acceptance(A) and acceptance(Z) satisfy prirelacc, the events are the same,
    and it is not the case that there is an event b in Z that has higher priority
    than event(A).\<close>
"prirel p (A #\<^sub>\<F>\<^sub>\<L> aa) (Z #\<^sub>\<F>\<^sub>\<L> zz)
  =
  ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z)
    \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
       \<or>
      acceptance(A) \<noteq> \<bullet>))"

lemma pri_induct_case:
  assumes "((prirelacc p (acceptance A) (acceptance Z)) \<and> event(A) = event(Z)
     \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
       \<or>
      acceptance(A) \<noteq> \<bullet>))"
  shows "(acceptance A \<le> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z) \<and> event(A) = event(Z)  \<and>
         (\<not> maximal(p,event(A)) \<longrightarrow> event(Z) \<in>\<^sub>\<F>\<^sub>\<L> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z)))"
  using assms apply auto
         apply (cases A, auto, cases Z, auto, case_tac a, auto, case_tac aa, auto, case_tac a, auto)
     apply (cases A, auto, cases Z, auto, case_tac a, auto, case_tac aa, auto)
    apply (cases A, auto, cases Z, auto, case_tac a, auto, case_tac aa, auto)
    apply (cases Z, auto, case_tac a, auto)
  by (cases A, auto, cases Z, auto, case_tac a, auto, case_tac aa, auto, case_tac a, auto)+

lemma priacc_imp_prirelacc:
  assumes "a \<le> priacc\<^sub>[\<^sub>p\<^sub>] aa"
  shows "prirelacc p a aa"
  using assms apply(induct aa rule:priacc.induct, auto)
   apply (cases a, auto)
  apply (cases a, auto)
    apply (metis (mono_tags, lifting) Int_iff)
   apply (metis (mono_tags, lifting) Int_Collect)
  by (smt Int_Collect)

lemma prirelacc_imp_priacc:
  assumes "prirelacc p a aa"
  shows "a \<le> priacc\<^sub>[\<^sub>p\<^sub>] aa"
  using assms apply(induct aa rule:priacc.induct, auto)
   apply (cases a, auto)
  by (cases a, auto)

lemma prirelacc_eq_priacc [simp]:
  "prirelacc p a aa \<longleftrightarrow> a \<le> priacc\<^sub>[\<^sub>p\<^sub>] aa"
  using priacc_imp_prirelacc prirelacc_imp_priacc by blast

lemma maximal_event_in_priacc [intro]:
  assumes "event Z \<in>\<^sub>\<F>\<^sub>\<L> priacc\<^sub>[\<^sub>p\<^sub>] acceptance Z" "b \<in>\<^sub>\<F>\<^sub>\<L> acceptance Z" "event Z <\<^sup>*p b"
  shows "maximal(p,event Z)"
  using assms by (cases Z, auto, case_tac a, auto)

lemma pri_induct_case':
  assumes "acceptance A \<le> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z)" "event(A) = event(Z)"
          "(\<not> maximal(p,event(A)) \<longrightarrow> event(Z) \<in>\<^sub>\<F>\<^sub>\<L> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z))"
    shows "((prirelacc p (acceptance A) (acceptance Z)) \<and> event(A) = event(Z)
     \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
       \<or>
      acceptance(A) \<noteq> \<bullet>))"
  using assms by auto

lemma prirel_alt_induct_case:
  "prirel p (A #\<^sub>\<F>\<^sub>\<L> aa) (Z #\<^sub>\<F>\<^sub>\<L> zz)
  =
  (acceptance A \<le> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z) \<and> (prirel p aa zz) \<and> event(A) = event(Z) \<and>
   (\<not> maximal(p,event(A)) \<longrightarrow> event(Z) \<in>\<^sub>\<F>\<^sub>\<L> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z)))"
proof -
  have "prirel p (A #\<^sub>\<F>\<^sub>\<L> aa) (Z #\<^sub>\<F>\<^sub>\<L> zz)
  =
  ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z)
    \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
       \<or>
      acceptance(A) \<noteq> \<bullet>))"
    by auto
  also have "... =
    ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z)
     \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
       \<or>
      acceptance(A) \<noteq> \<bullet>))"
    using event_in_acceptance by blast
  also have "... =
      (acceptance A \<le> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z) \<and> (prirel p aa zz) \<and> event(A) = event(Z)  \<and>
         (\<not> maximal(p,event(A)) \<longrightarrow> event(Z) \<in>\<^sub>\<F>\<^sub>\<L> priacc\<^sub>[\<^sub>p\<^sub>](acceptance Z)))"
    using pri_induct_case pri_induct_case' by blast
  finally show ?thesis .
qed

subsection \<open>Auxiliary results\<close>

lemma prirelacc_acceptances_eq:
  assumes "acceptance(A) \<noteq> \<bullet>"
          "acceptance(Z) \<noteq> \<bullet>"
    shows "(prirelacc p (acceptance A) (acceptance Z)) \<longleftrightarrow> acceptance(A) = [{a. a \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> \<not>(\<exists>b. b\<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> a <\<^sup>*p b)}]\<^sub>\<F>\<^sub>\<L>"
  using assms apply auto
   apply (cases A, auto, cases Z, auto)
  by (case_tac a, auto)

lemma acceptance_not_bullet_imp_prirelacc:
  assumes "acceptance(A) \<noteq> \<bullet>"
          "prirelacc p (acceptance A) (acceptance Z)"
    shows "acceptance(Z) \<noteq> \<bullet>"
  using assms by auto

lemma prirelacc_acceptance_not_bullet_imp:
  assumes "prirelacc p (acceptance A) (acceptance Z)" "acceptance(A) \<noteq> \<bullet>"
  shows "\<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b)"
  using assms apply auto
  apply (cases Z, auto, cases A, auto)
  apply (case_tac aa, auto, case_tac a, auto)
  by (metis (mono_tags, lifting) Int_Collect)

lemma maximal_not_exists_higher:
  assumes "maximal(p,event(A))"
    shows "\<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b)"
  using assms apply auto
  unfolding maximal_def apply (cases Z, auto)
  by (meson assms some_higher_not_maximal)

text \<open> We now show that the definition of prirel for the recursive case is just like
       that of Roscoe. \<close>

lemma prirel_original_induct_case:
  "prirel p (A #\<^sub>\<F>\<^sub>\<L> aa) (Z #\<^sub>\<F>\<^sub>\<L> zz)
  =
  ((prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
    ((maximal(p,event(A)) \<and> acceptance(A) = \<bullet>)
    \<or>
    (\<not>maximal(p,event(A)) \<and> acceptance(A) = \<bullet> \<and> acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
    \<or>
    (acceptance(A) \<noteq> \<bullet> \<and> acceptance(Z) \<noteq> \<bullet> \<and> acceptance(A) = [{a. a \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> \<not>(\<exists>b. b\<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> a <\<^sup>*p b)}]\<^sub>\<F>\<^sub>\<L>)
    ))
  "
proof -
  have "
    ((prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
    ((maximal(p,event(A)) \<and> acceptance(A) = \<bullet>)
    \<or>
    (\<not>maximal(p,event(A)) \<and> acceptance(A) = \<bullet> \<and> acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
    \<or>
    (acceptance(A) \<noteq> \<bullet> \<and> acceptance(Z) \<noteq> \<bullet> \<and> acceptance(A) = [{a. a \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> \<not>(\<exists>b. b\<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> a <\<^sup>*p b)}]\<^sub>\<F>\<^sub>\<L>)
    ))
  =
    ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
    (acceptance(A) = \<bullet> \<and>
       (maximal(p,event(A))
        \<or>
       (\<not>maximal(p,event(A)) \<and> acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b)))
     \<or>
     (acceptance(A) \<noteq> \<bullet> \<and> acceptance(Z) \<noteq> \<bullet>)))"
    using prirelacc_acceptances_eq by auto
  also have "... =
    ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
      (acceptance(A) = \<bullet> \<and> (maximal(p,event(A)) \<or> acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
     \<or>
     (acceptance(A) \<noteq> \<bullet>)))"
    using acceptance_not_bullet_imp_prirelacc by auto
  also have "... =
    ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
      ((maximal(p,event(A)) \<or> acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
     \<or>
     (acceptance(A) \<noteq> \<bullet>)))"
    by auto
  also have "... =
    ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>) \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet> \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b))
       \<or>
      acceptance(A) \<noteq> \<bullet>))"
    using maximal_not_exists_higher by auto
  also have "... =
    ((prirelacc p (acceptance A) (acceptance Z)) \<and> (prirel p aa zz) \<and> event(A) = event(Z) \<and> (event(A) \<in>\<^sub>\<F>\<^sub>\<L> acceptance A \<or> acceptance A = \<bullet>)
       \<and> \<not>(\<exists>b. b \<in>\<^sub>\<F>\<^sub>\<L> acceptance(Z) \<and> event(A) <\<^sup>*p b) \<and>
      (maximal(p,event(A))
       \<or>
      (acceptance(Z) \<noteq> \<bullet>)
       \<or>
      acceptance(A) \<noteq> \<bullet>))"
    apply auto
    using maximal_not_exists_higher apply blast
     apply (metis maximal_event_in_priacc not_bullet_less_eq_imp some_higher_not_maximal)
    using maximal_not_exists_higher by blast
  then show ?thesis
    using calculation by auto
qed

lemma prirel_imp_pri:
  assumes "prirel p A Z"
  shows "pri p A Z"
  using assms apply (induct p A Z rule:pri.induct, auto)
   apply (case_tac Aa, auto)
  by (metis pri_induct_case prirelacc.simps(1))

lemma pri_imp_prirel:
  assumes "pri p A Z"
  shows "prirel p A Z"
  using assms apply (induct p A Z rule:pri.induct, auto)
    apply (case_tac Za, auto)
  using event_in_acceptance by force+

definition PriOriginal :: "'a partialorder \<Rightarrow> 'a fltraces \<Rightarrow> 'a fltraces" where
"PriOriginal p F = {A|A Z. prirel p A Z \<and> Z \<in> F}"

lemma PriOriginal_eq_Pri:
  "PriOriginal p P = Pri p P"
  unfolding PriOriginal_def Pri_def apply auto
  using prirel_imp_pri apply blast
  using pri_imp_prirel by blast

lemma prirel_prirel_for_FL1:
  assumes "s \<le> t"
          "prirel p t Z"
    shows "\<exists>Y. prirel p s Y \<and> Y \<le> Z"
  using assms
proof (induct p t Z arbitrary:s rule:prirel.induct)
  case (1 p A Z)
  then show ?case
    apply (cases s, auto)
    apply (cases A, auto, cases Z, auto)
    using "1.prems"(2) less_eq_acceptance.elims(2)
    apply (metis bullet_left_zero2 order_refl prirel.simps(1) prirelacc.simps(1) x_le_x_concat2)
    using "1.prems"(2) dual_order.antisym less_eq_acceptance.simps(1)
    by (metis "1.prems"(1) prirelacc.elims(2) prirelacc.simps(3))
next
  case (2 p A Z zz)
  then show ?case by auto
next
  case (3 p A aa Z)
  then show ?case by auto
next
  case (4 p A aa Z zz)
  then show ?case
  proof (induct s)
    case (Acceptance x)
    then show ?case using 4 apply simp
      apply (cases x, simp)
      apply (metis fltrace_concat2.simps(3) prirel.simps(1) prirelacc.simps(1) x_le_x_concat2)
      apply (cases x, simp)
      by (metis acceptance.distinct(1) less_eq_fltrace.simps(2) not_bullet_less_eq_imp order_refl pri.simps(1) pri_imp_prirel)
  next
    case (AEvent x z)
    then obtain C where C:"prirel p z C \<and> C \<le> zz"
      by (meson less_eq_fltrace.simps(3) prirel_alt_induct_case)
    then have x_less_eq_A:"x \<le> A"
      using AEvent by auto
    then have event_x_z:"event(x) = event(Z)"
      by (metis AEvent.prems(3) less_eq_aevent_def prirel.simps(4))
    then show ?case using 4 AEvent
       proof (cases "acceptance(A) = \<bullet>")
         case A_bullet:True
         then show ?thesis
           using A_bullet 4 x_less_eq_A event_x_z
           apply (intro exI[where x="Z #\<^sub>\<F>\<^sub>\<L> C"], simp)
           apply (simp add: less_eq_aevent_def C)+
           apply (cases x, auto)
           by (case_tac a, auto)+
       next
         case A_not_bullet:False
         then show ?thesis using 4 AEvent
          proof (cases "acceptance(Z) = \<bullet>")
            case True
            then show ?thesis using 4 A_not_bullet
              apply (intro exI[where x="Z #\<^sub>\<F>\<^sub>\<L> C"], simp)
              apply (simp add: less_eq_aevent_def C)
              using prirelacc.elims(2) by blast
          next
            case False
            then show ?thesis using 4 A_not_bullet event_x_z
              apply (intro exI[where x="Z #\<^sub>\<F>\<^sub>\<L> C"], simp)
              apply (simp add: less_eq_aevent_def C)
              apply (cases x, auto, cases Z, auto)
              by (metis acceptance_set less_eq_aevent_def not_bullet_less_eq_imp x_less_eq_A)
          qed
       qed
  qed
qed

lemma FL1_prirel_prirel:
  assumes "prirel p x Z"
    shows "\<exists>Y. prirel p x Y \<and> Y \<le> Z"
  using assms
proof (induct p x Z rule:prirel.induct)
  case (1 p A Z)
  then show ?case
    apply auto
     apply (case_tac A, auto, case_tac Z, auto)
  using "1.prems" by blast+
next
  case (2 p A Z zz)
  then show ?case
    by auto
next
  case (3 p A aa Z)
  then show ?case
    by auto
next
  case (4 p A aa Z zz)
  then obtain C where C:"prirel p aa C \<and> C \<le> zz"
    using prirel.simps(4) by blast
  then have "(prirelacc p (acceptance A) (acceptance Z)) \<and> event(A) = event(Z)"
    using "4.prems"(1) prirel.simps(4) by blast
  then show ?case using 4 C
  proof (cases "acceptance(A) = \<bullet>")
    case A_is_bullet:True
    then show ?thesis
    proof (cases "acceptance(Z) = \<bullet>")
      case True
      then show ?thesis using 4 A_is_bullet apply auto
        apply (intro exI[where x="(\<bullet>,event(Z))\<^sub>\<F>\<^sub>\<L> #\<^sub>\<F>\<^sub>\<L> C"], auto)
        by (simp_all add:C)
    next
      case False
      then show ?thesis using 4 A_is_bullet apply auto
         apply (intro exI[where x="(\<bullet>,event(Z))\<^sub>\<F>\<^sub>\<L> #\<^sub>\<F>\<^sub>\<L> C"], auto)
          apply (simp_all add:C)
        apply (intro exI[where x="(acceptance(Z),event(Z))\<^sub>\<F>\<^sub>\<L> #\<^sub>\<F>\<^sub>\<L> C"], auto)
          apply (simp_all add:C)
        by (simp add: less_eq_aevent_def)
    qed
  next
    case A_not_bullet:False
    then show ?thesis using 4
      apply auto
          apply (intro exI[where x="(acceptance(Z),event(Z))\<^sub>\<F>\<^sub>\<L> #\<^sub>\<F>\<^sub>\<L> C"], auto)
      using C apply blast
      apply (cases A, auto)
       apply (simp add: less_eq_aevent_def)
    using C by blast
  qed
qed

lemma FL1_prirel:
  assumes "s \<le> t" "prirel p t Z" "Z \<in> P" "FL1 P"
  shows "\<exists>Z. prirel p s Z \<and> Z \<in> P"
  using assms
  by (meson FL1_def prirel_prirel_for_FL1)

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_weird_nat_add3acc_comm23
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun add3acc :: "Nat => Nat => Nat => Nat" where
"add3acc (Z) (Z) z = z"
| "add3acc (Z) (S x3) z = add3acc Z x3 (S z)"
| "add3acc (S x2) y z = add3acc x2 (S y) z"

theorem property0 :
  "((add3acc x y z) = (add3acc x z y))"
  oops

end