src/HOL/ex/Reflected_Presburger.thy
author urbanc
Tue Jun 05 09:56:19 2007 +0200 (2007-06-05)
changeset 23243 a37d3e6e8323
parent 21404 eb85850d3eb7
child 23274 f997514ad8f4
permissions -rw-r--r--
included Class.thy in the compiling process for Nominal/Examples
     1 (*  Title:      HOL/ex/PresburgerEx.thy
     2     ID:         $Id$
     3     Author:     Amine Chaieb, TU Muenchen
     4 
     5 A formalization of quantifier elimination for Presburger arithmetic
     6 based on a generic quantifier elimination algorithm and Cooper's
     7 method to eliminate on \<exists>. *)
     8 
     9 header {* Quantifier elimination for Presburger arithmetic *}
    10 
    11 theory Reflected_Presburger
    12 imports Main GCD
    13 begin
    14 
    15 (* Shadow syntax for integer terms *)
    16 datatype intterm =
    17     Cst int
    18   | Var nat
    19   | Neg intterm
    20   | Add intterm intterm 
    21   | Sub intterm intterm
    22   | Mult intterm intterm
    23 
    24 (* interpretation of intterms, takes bound variables and free variables *)
    25 consts I_intterm :: "int list \<Rightarrow> intterm \<Rightarrow> int"
    26 primrec 
    27 "I_intterm ats (Cst b) = b"
    28 "I_intterm ats (Var n) = (ats!n)"
    29 "I_intterm ats (Neg it) = -(I_intterm ats it)"
    30 "I_intterm ats (Add it1 it2) = (I_intterm ats it1) + (I_intterm ats it2)" 
    31 "I_intterm ats (Sub it1 it2) = (I_intterm ats it1) - (I_intterm ats it2)"
    32 "I_intterm ats (Mult it1 it2) = (I_intterm ats it1) * (I_intterm ats it2)"
    33 
    34 (* Shadow syntax for Presburger formulae *)
    35 datatype QF = 
    36    Lt intterm intterm
    37   |Gt intterm intterm
    38   |Le intterm intterm
    39   |Ge intterm intterm
    40   |Eq intterm intterm
    41   |Divides intterm intterm
    42   |T
    43   |F
    44   |NOT QF
    45   |And QF QF
    46   |Or QF QF
    47   |Imp QF QF
    48   |Equ QF QF
    49   |QAll QF
    50   |QEx QF
    51 
    52 (* Interpretation of Presburger formulae *)
    53 consts qinterp :: "int list \<Rightarrow> QF \<Rightarrow> bool"
    54 primrec
    55 "qinterp ats (Lt it1 it2) = (I_intterm ats it1 < I_intterm ats it2)"
    56 "qinterp ats (Gt it1 it2) = (I_intterm ats it1 > I_intterm ats it2)"
    57 "qinterp ats (Le it1 it2) = (I_intterm ats it1 \<le> I_intterm ats it2)"
    58 "qinterp ats (Ge it1 it2) = (I_intterm ats it1 \<ge> I_intterm ats it2)"
    59 "qinterp ats (Divides it1 it2) = (I_intterm ats it1 dvd I_intterm ats it2)"
    60 "qinterp ats (Eq it1 it2) = (I_intterm ats it1 = I_intterm ats it2)"
    61 "qinterp ats T = True"
    62 "qinterp ats F = False"
    63 "qinterp ats (NOT p) = (\<not>(qinterp ats p))"
    64 "qinterp ats (And p q) = (qinterp ats p \<and> qinterp ats q)"
    65 "qinterp ats (Or p q) = (qinterp ats p \<or> qinterp ats q)"
    66 "qinterp ats (Imp p q) = (qinterp ats p \<longrightarrow> qinterp ats q)"
    67 "qinterp ats (Equ p q) = (qinterp ats p = qinterp ats q)"
    68 "qinterp ats (QAll p) = (\<forall>x. qinterp (x#ats) p)"
    69 "qinterp ats (QEx p) = (\<exists>x. qinterp (x#ats) p)"
    70 
    71 (* quantifier elimination based on qe, quantifier elimination for an
    72    existential formula, with quantifier free body 
    73    Since quantifier elimination for one formula is allowed to fail,
    74    the result is of type QF option *)
    75 
    76 consts lift_bin:: "('a \<Rightarrow> 'a \<Rightarrow> 'b) \<times> 'a option \<times> 'a option \<Rightarrow> 'b option"
    77 recdef lift_bin "measure (\<lambda>(c,a,b). size a)"
    78 "lift_bin (c,Some a,Some b) = Some (c a b)"
    79 "lift_bin (c,x, y)  = None"
    80 
    81 lemma lift_bin_Some:
    82   assumes ls: "lift_bin (c,x,y) = Some t"
    83   shows "(\<exists>a. x = Some a) \<and> (\<exists>b. y = Some b)"
    84   using ls 
    85   by (cases "x", auto) (cases "y", auto)+
    86 
    87 consts lift_un:: "('a \<Rightarrow> 'b) \<Rightarrow> 'a option \<Rightarrow> 'b option"
    88 primrec
    89 "lift_un c None = None"
    90 "lift_un c (Some p) = Some (c p)"
    91 
    92 consts lift_qe:: "('a \<Rightarrow> 'b option) \<Rightarrow> 'a option \<Rightarrow> 'b option"
    93 primrec
    94 "lift_qe qe None = None"
    95 "lift_qe qe (Some p) = qe p"
    96 
    97 (* generic quantifier elimination *)
    98 consts qelim :: "(QF \<Rightarrow> QF option) \<times> QF \<Rightarrow> QF option"
    99 recdef qelim "measure (\<lambda>(qe,p). size p)"
   100 "qelim (qe, (QAll p)) = lift_un NOT (lift_qe qe (lift_un NOT (qelim (qe ,p))))"
   101 "qelim (qe, (QEx p)) = lift_qe qe (qelim (qe,p))"
   102 "qelim (qe, (And p q)) = lift_bin (And, (qelim (qe, p)), (qelim (qe, q)))"
   103 "qelim (qe, (Or p q)) = lift_bin (Or, (qelim (qe, p)), (qelim (qe, q)))"
   104 "qelim (qe, (Imp p q)) = lift_bin (Imp, (qelim (qe, p)), (qelim (qe, q)))"
   105 "qelim (qe, (Equ p q)) = lift_bin (Equ, (qelim (qe, p)), (qelim (qe, q)))"
   106 "qelim (qe,NOT p) = lift_un NOT (qelim (qe,p))"
   107 "qelim (qe, p) = Some p"
   108 
   109 (* quantifier free-ness *)
   110 consts isqfree :: "QF \<Rightarrow> bool"
   111 recdef isqfree "measure size"
   112 "isqfree (QAll p) = False"
   113 "isqfree (QEx p) = False"
   114 "isqfree (And p q) = (isqfree p \<and> isqfree q)"
   115 "isqfree (Or p q) = (isqfree p \<and> isqfree q)"
   116 "isqfree (Imp p q) = (isqfree p \<and> isqfree q)"
   117 "isqfree (Equ p q) = (isqfree p \<and> isqfree q)"
   118 "isqfree (NOT p) = isqfree p"
   119 "isqfree p = True"
   120 
   121 (* qelim lifts quantifierfreeness*)
   122 lemma qelim_qfree: 
   123   assumes qeqf: "(\<And> q q'. \<lbrakk>isqfree q ; qe q = Some q'\<rbrakk> \<Longrightarrow>  isqfree q')"
   124   shows qff:"\<And> p'. qelim (qe, p) = Some p' \<Longrightarrow> isqfree p'"
   125   using qeqf
   126 proof (induct p)
   127   case (Lt a b)
   128   have "qelim (qe, Lt a b) = Some (Lt a b)" by simp
   129   moreover have "qelim (qe,Lt a b) = Some p'" . 
   130   ultimately have "p' = Lt a b" by simp
   131   moreover have "isqfree (Lt a b)" by simp
   132   ultimately 
   133   show ?case  by simp
   134 next  
   135   case (Gt a b)
   136   have "qelim (qe, Gt a b) = Some (Gt a b)" by simp
   137   moreover have "qelim (qe,Gt a b) = Some p'" . 
   138   ultimately have "p' = Gt a b" by simp
   139   moreover have "isqfree (Gt a b)" by simp
   140   ultimately 
   141   show ?case  by simp
   142 next  
   143   case (Le a b)
   144   have "qelim (qe, Le a b) = Some (Le a b)" by simp
   145   moreover have "qelim (qe,Le a b) = Some p'" . 
   146   ultimately have "p' = Le a b" by simp
   147   moreover have "isqfree (Le a b)" by simp
   148   ultimately 
   149   show ?case  by simp
   150 next  
   151   case (Ge a b)
   152   have "qelim (qe, Ge a b) = Some (Ge a b)" by simp
   153   moreover have "qelim (qe,Ge a b) = Some p'" . 
   154   ultimately have "p' = Ge a b" by simp
   155   moreover have "isqfree (Ge a b)" by simp
   156   ultimately 
   157   show ?case  by simp
   158 next  
   159   case (Eq a b)
   160   have "qelim (qe, Eq a b) = Some (Eq a b)" by simp
   161   moreover have "qelim (qe,Eq a b) = Some p'" . 
   162   ultimately have "p' = Eq a b" by simp
   163   moreover have "isqfree (Eq a b)" by simp
   164   ultimately 
   165   show ?case  by simp
   166 next  
   167   case (Divides a b)
   168   have "qelim (qe, Divides a b) = Some (Divides a b)" by simp
   169   moreover have "qelim (qe,Divides a b) = Some p'" . 
   170   ultimately have "p' = Divides a b" by simp
   171   moreover have "isqfree (Divides a b)" by simp
   172   ultimately 
   173   show ?case  by simp
   174 next  
   175   case T 
   176   have "qelim(qe,T) = Some T" by simp
   177   moreover have "qelim(qe,T) = Some p'" .
   178   ultimately have "p' = T" by simp
   179   moreover have "isqfree T" by simp
   180   ultimately show ?case by simp
   181 next  
   182   case F
   183   have "qelim(qe,F) = Some F" by simp
   184   moreover have "qelim(qe,F) = Some p'" .
   185   ultimately have "p' = F" by simp
   186   moreover have "isqfree F" by simp
   187   ultimately show ?case by simp
   188 next  
   189   case (NOT p)
   190   from "NOT.prems" have "\<exists> p1. qelim(qe,p) = Some p1"
   191     by  (cases "qelim(qe,p)") simp_all
   192   then obtain "p1" where p1_def: "qelim(qe,p) = Some p1" by blast
   193   from "NOT.prems" have "\<And>q q'. \<lbrakk>isqfree q; qe q = Some q'\<rbrakk> \<Longrightarrow> isqfree q'" 
   194     by blast
   195   with "NOT.hyps" p1_def have p1qf: "isqfree p1" by blast
   196   then have "p' = NOT p1" using "NOT.prems" p1_def
   197     by (cases "qelim(qe,NOT p)") simp_all
   198   then show ?case using p1qf by simp
   199 next  
   200   case (And p q) 
   201   from "And.prems" have p1q1: "(\<exists>p1. qelim(qe,p) = Some p1) \<and> 
   202     (\<exists>q1. qelim(qe,q) = Some q1)" using lift_bin_Some[where c="And"] by simp
   203   from p1q1 obtain "p1" and "q1" 
   204     where p1_def: "qelim(qe,p) = Some p1" 
   205     and q1_def: "qelim(qe,q) = Some q1" by blast
   206   from prems have qf1:"isqfree p1"
   207     using p1_def by blast
   208   from prems have qf2:"isqfree q1"
   209     using q1_def by blast
   210   from "And.prems" have "qelim(qe,And p q) = Some p'" by blast
   211   then have "p' = And p1 q1" using p1_def q1_def by simp
   212   then 
   213   show ?case using qf1 qf2 by simp
   214 next  
   215   case (Or p q)
   216   from "Or.prems" have p1q1: "(\<exists>p1. qelim(qe,p) = Some p1) \<and> 
   217     (\<exists>q1. qelim(qe,q) = Some q1)" using lift_bin_Some[where c="Or"] by simp
   218   from p1q1 obtain "p1" and "q1" 
   219     where p1_def: "qelim(qe,p) = Some p1" 
   220     and q1_def: "qelim(qe,q) = Some q1" by blast
   221   from prems have qf1:"isqfree p1"
   222     using p1_def by blast
   223   from prems have qf2:"isqfree q1"
   224     using q1_def by blast
   225   from "Or.prems" have "qelim(qe,Or p q) = Some p'" by blast
   226   then have "p' = Or p1 q1" using p1_def q1_def by simp
   227   then 
   228   show ?case using qf1 qf2 by simp
   229 next  
   230   case (Imp p q)
   231   from "Imp.prems" have p1q1: "(\<exists>p1. qelim(qe,p) = Some p1) \<and> 
   232     (\<exists>q1. qelim(qe,q) = Some q1)" using lift_bin_Some[where c="Imp"] by simp
   233   from p1q1 obtain "p1" and "q1" 
   234     where p1_def: "qelim(qe,p) = Some p1" 
   235     and q1_def: "qelim(qe,q) = Some q1" by blast
   236   from prems have qf1:"isqfree p1"
   237     using p1_def by blast
   238   from prems have qf2:"isqfree q1"
   239     using q1_def by blast
   240   from "Imp.prems" have "qelim(qe,Imp p q) = Some p'" by blast
   241   then have "p' = Imp p1 q1" using p1_def q1_def by simp
   242   then 
   243   show ?case using qf1 qf2 by simp
   244 next  
   245   case (Equ p q)
   246   from "Equ.prems" have p1q1: "(\<exists>p1. qelim(qe,p) = Some p1) \<and> 
   247     (\<exists>q1. qelim(qe,q) = Some q1)" using lift_bin_Some[where c="Equ"] by simp
   248   from p1q1 obtain "p1" and "q1" 
   249     where p1_def: "qelim(qe,p) = Some p1" 
   250     and q1_def: "qelim(qe,q) = Some q1" by blast
   251   from prems have qf1:"isqfree p1"
   252     using p1_def by blast
   253   from prems have qf2:"isqfree q1"
   254     using q1_def by blast
   255   from "Equ.prems" have "qelim(qe,Equ p q) = Some p'" by blast
   256   then have "p' = Equ p1 q1" using p1_def q1_def by simp
   257   then 
   258   show ?case using qf1 qf2 by simp
   259 next 
   260   case (QEx p)
   261   from "QEx.prems" have "\<exists> p1. qelim(qe,p) = Some p1"
   262     by  (cases "qelim(qe,p)") simp_all
   263   then obtain "p1" where p1_def: "qelim(qe,p) = Some p1" by blast
   264   from "QEx.prems" have "\<And>q q'. \<lbrakk>isqfree q; qe q = Some q'\<rbrakk> \<Longrightarrow> isqfree q'" 
   265     by blast
   266   with "QEx.hyps" p1_def have p1qf: "isqfree p1" by blast
   267   from "QEx.prems" have "qe p1 = Some p'" using p1_def by simp
   268   with "QEx.prems" show ?case  using p1qf 
   269     by simp
   270 next 
   271   case (QAll p) 
   272   from "QAll.prems"
   273   have "\<exists> p1. lift_qe qe (lift_un NOT (qelim (qe ,p))) = Some p1" 
   274     by (cases "lift_qe qe (lift_un NOT (qelim (qe ,p)))") simp_all
   275   then obtain "p1" where 
   276     p1_def:"lift_qe qe (lift_un NOT (qelim (qe ,p))) = Some p1" by blast
   277   then have "\<exists> p2. lift_un NOT (qelim (qe ,p)) = Some p2"
   278     by (cases "qelim (qe ,p)") simp_all
   279   then obtain "p2" 
   280     where p2_def:"lift_un NOT (qelim (qe ,p)) = Some p2" by blast
   281   then have "\<exists> p3. qelim(qe,p) = Some p3" by (cases "qelim(qe,p)") simp_all
   282   then obtain "p3" where p3_def: "qelim(qe,p) = Some p3" by blast
   283   with prems have qf3: "isqfree p3" by blast
   284   have p2_def2: "p2 = NOT p3" using p2_def p3_def by simp
   285   then have qf2: "isqfree p2" using qf3 by simp
   286   have p1_edf2: "qe p2 = Some p1" using p1_def p2_def by simp
   287   with "QAll.prems" have qf1: "isqfree p1" using qf2 by blast
   288   from "QAll.prems" have "p' = NOT p1" using p1_def by simp
   289   with qf1 show ?case by simp
   290 qed
   291 
   292 (* qelim lifts semantical equivalence *)
   293 lemma qelim_corr: 
   294   assumes qecorr: "(\<And> q q' ats. \<lbrakk>isqfree q ; qe q = Some q'\<rbrakk> \<Longrightarrow>  (qinterp ats (QEx q)) = (qinterp ats q'))"
   295   and qeqf: "(\<And> q q'. \<lbrakk>isqfree q ; qe q = Some q'\<rbrakk> \<Longrightarrow>  isqfree q')"
   296   shows qff:"\<And> p' ats. qelim (qe, p) = Some p' \<Longrightarrow> (qinterp ats p = qinterp ats p')" (is "\<And> p' ats. ?Qe p p' \<Longrightarrow> (?F ats p = ?F ats p')")
   297   using qeqf qecorr
   298 proof (induct p)
   299   case (NOT f)  
   300   from "NOT.prems" have "\<exists>f'. ?Qe f f' " by (cases "qelim(qe,f)") simp_all
   301   then obtain "f'" where df': "?Qe f f'" by blast
   302   with prems have feqf': "?F ats f = ?F ats f'" by blast
   303   from "NOT.prems" df' have "p' = NOT f'" by simp
   304   with feqf' show ?case by simp
   305 
   306 next
   307   case (And f g) 
   308   from "And.prems" have f1g1: "(\<exists>f1. qelim(qe,f) = Some f1) \<and> 
   309     (\<exists>g1. qelim(qe,g) = Some g1)" using lift_bin_Some[where c="And"] by simp
   310   from f1g1 obtain "f1" and "g1" 
   311     where f1_def: "qelim(qe, f) = Some f1" 
   312     and g1_def: "qelim(qe,g) = Some g1" by blast
   313   from prems f1_def have feqf1: "?F ats f = ?F ats f1" by blast
   314   from prems g1_def have geqg1: "?F ats g = ?F ats g1" by blast
   315   from "And.prems" f1_def g1_def have "p' = And f1 g1" by simp
   316   with feqf1 geqg1 show ?case by simp
   317 
   318 next
   319   case (Or f g) 
   320   from "Or.prems" have f1g1: "(\<exists>f1. qelim(qe,f) = Some f1) \<and> 
   321     (\<exists>g1. qelim(qe,g) = Some g1)" using lift_bin_Some[where c="Or"] by simp
   322   from f1g1 obtain "f1" and "g1" 
   323     where f1_def: "qelim(qe, f) = Some f1" 
   324     and g1_def: "qelim(qe,g) = Some g1" by blast
   325   from prems f1_def have feqf1: "?F ats f = ?F ats  f1" by blast
   326   from prems g1_def have geqg1: "?F ats g = ?F ats g1" by blast
   327   from "Or.prems" f1_def g1_def have "p' = Or f1 g1" by simp
   328   with feqf1 geqg1 show ?case by simp
   329 next
   330   case (Imp f g)
   331   from "Imp.prems" have f1g1: "(\<exists>f1. qelim(qe,f) = Some f1) \<and> 
   332     (\<exists>g1. qelim(qe,g) = Some g1)" using lift_bin_Some[where c="Imp"] by simp
   333   from f1g1 obtain "f1" and "g1" 
   334     where f1_def: "qelim(qe, f) = Some f1" 
   335     and g1_def: "qelim(qe,g) = Some g1" by blast
   336   from prems f1_def have feqf1: "?F ats f = ?F ats f1" by blast
   337   from prems g1_def have geqg1: "?F ats g = ?F ats g1" by blast
   338   from "Imp.prems" f1_def g1_def have "p' = Imp f1 g1" by simp
   339   with feqf1 geqg1 show ?case by simp
   340 next
   341   case (Equ f g)
   342   from "Equ.prems" have f1g1: "(\<exists>f1. qelim(qe,f) = Some f1) \<and> 
   343     (\<exists>g1. qelim(qe,g) = Some g1)" using lift_bin_Some[where c="Equ"] by simp
   344   from f1g1 obtain "f1" and "g1" 
   345     where f1_def: "qelim(qe, f) = Some f1" 
   346     and g1_def: "qelim(qe,g) = Some g1" by blast
   347   from prems f1_def have feqf1: "?F ats f = ?F ats f1" by blast
   348   from prems g1_def have geqg1: "?F ats g = ?F ats g1" by blast
   349   from "Equ.prems" f1_def g1_def have "p' = Equ f1 g1" by simp
   350   with feqf1 geqg1 show ?case by simp
   351 next
   352   case (QEx f) 
   353     from "QEx.prems" have "\<exists> f1. ?Qe f f1"
   354     by  (cases "qelim(qe,f)") simp_all
   355   then obtain "f1" where f1_def: "qelim(qe,f) = Some f1" by blast
   356   from prems have qf1:"isqfree f1" using qelim_qfree by blast
   357   from prems have feqf1: "\<forall> ats. qinterp ats f = qinterp ats f1"
   358     using f1_def qf1 by blast
   359   then  have "?F ats (QEx f) = ?F ats (QEx f1)" 
   360     by simp 
   361   from prems have "qelim (qe,QEx f) = Some p'" by blast
   362   then  have "\<exists> f'. qe f1 = Some f'" using f1_def by simp
   363   then obtain "f'" where fdef': "qe f1 = Some f'" by blast
   364   with prems have exf1: "?F ats (QEx f1) = ?F ats f'" using qf1 by blast
   365   have fp: "?Qe (QEx f) f'" using f1_def fdef' by simp
   366   from prems have "?Qe (QEx f) p'" by blast 
   367   then have "p' = f'" using fp by simp
   368   then show ?case using feqf1 exf1 by simp
   369 next
   370   case (QAll f)
   371   from "QAll.prems"
   372   have "\<exists> f0. lift_un NOT (lift_qe qe (lift_un NOT (qelim (qe ,f)))) = 
   373     Some f0"
   374     by (cases "lift_un NOT (lift_qe qe (lift_un NOT (qelim (qe ,f))))") 
   375       simp_all
   376   then obtain "f0" 
   377     where f0_def: "lift_un NOT (lift_qe qe (lift_un NOT (qelim (qe ,f)))) = 
   378     Some f0" by blast
   379   then have "\<exists> f1. lift_qe qe (lift_un NOT (qelim (qe ,f))) = Some f1" 
   380     by (cases "lift_qe qe (lift_un NOT (qelim (qe ,f)))") simp_all
   381   then obtain "f1" where 
   382     f1_def:"lift_qe qe (lift_un NOT (qelim (qe ,f))) = Some f1" by blast
   383   then have "\<exists> f2. lift_un NOT (qelim (qe ,f)) = Some f2"
   384     by (cases "qelim (qe ,f)") simp_all
   385   then obtain "f2" 
   386     where f2_def:"lift_un NOT (qelim (qe ,f)) = Some f2" by blast
   387   then have "\<exists> f3. qelim(qe,f) = Some f3" by (cases "qelim(qe,f)") simp_all
   388   then obtain "f3" where f3_def: "qelim(qe,f) = Some f3" by blast
   389   from prems have qf3:"isqfree f3" using qelim_qfree by blast
   390   from prems have feqf3: "\<forall> ats. qinterp ats f = qinterp ats f3"
   391     using f3_def qf3 by blast
   392   have f23:"f2 = NOT f3" using f2_def f3_def by simp
   393   then have feqf2: "\<forall> ats. qinterp ats f = qinterp ats (NOT f2)"
   394     using feqf3 by simp
   395   have qf2: "isqfree f2" using f23 qf3 by simp
   396   have "qe f2 = Some f1" using f1_def f2_def f23 by simp
   397   with prems have exf2eqf1: "?F ats (QEx f2) = ?F ats f1" using qf2 by blast
   398   have "f0 = NOT f1" using f0_def f1_def by simp
   399   then have f0eqf1: "?F ats f0 = ?F ats (NOT f1)" by simp
   400   from prems have "qelim (qe, QAll f) = Some p'" by blast
   401   then have f0eqp': "p' = f0" using f0_def by simp
   402   have "?F ats (QAll f) = (\<forall>x. ?F (x#ats) f)" by simp
   403   also have "\<dots> = (\<not> (\<exists> x. ?F (x#ats) (NOT f)))" by simp
   404   also have "\<dots> = (\<not> (\<exists> x. ?F (x#ats) (NOT (NOT f2))))" using feqf2
   405     by auto
   406   also have "\<dots> = (\<not> (\<exists> x. ?F (x#ats) f2))" by simp
   407   also have "\<dots> = (\<not> (?F ats f1))" using exf2eqf1 by simp
   408   finally show ?case using f0eqp' f0eqf1 by simp
   409 qed simp_all
   410 
   411 (* Cooper's algorithm *)
   412 
   413 
   414 (* Transform an intform into NNF *)
   415 consts lgth :: "QF \<Rightarrow> nat"
   416        nnf :: "QF \<Rightarrow> QF"    
   417 primrec
   418 "lgth (Lt it1 it2) = 1"
   419 "lgth (Gt it1 it2) = 1"
   420 "lgth (Le it1 it2) = 1"
   421 "lgth (Ge it1 it2) = 1"
   422 "lgth (Eq it1 it2) = 1"
   423 "lgth (Divides it1 it2) = 1"
   424 "lgth T = 1"
   425 "lgth F = 1"
   426 "lgth (NOT p) = 1 + lgth p"
   427 "lgth (And p q) = 1 + lgth p + lgth q"
   428 "lgth (Or p q) = 1 + lgth p + lgth q"
   429 "lgth (Imp p q) = 1 + lgth p + lgth q"
   430 "lgth (Equ p q) = 1 + lgth p + lgth q" 
   431 "lgth (QAll p) = 1 + lgth p" 
   432 "lgth (QEx p) = 1 + lgth p" 
   433 
   434 lemma [simp] :"0 < lgth q"
   435 apply (induct_tac q)
   436 apply(auto)
   437 done
   438 
   439 (* NNF *)
   440 recdef nnf "measure (\<lambda>p. lgth p)"
   441   "nnf (Lt it1 it2) = Le (Sub it1 it2) (Cst (- 1))"
   442   "nnf (Gt it1 it2) = Le (Sub it2 it1) (Cst (- 1))"
   443   "nnf (Le it1 it2) = Le it1 it2 "
   444   "nnf (Ge it1 it2) = Le it2 it1"
   445   "nnf (Eq it1 it2) = Eq it2 it1"
   446   "nnf (Divides d t) = Divides d t"
   447   "nnf T = T"
   448   "nnf F = F"
   449   "nnf (And p q) = And (nnf p) (nnf q)"
   450   "nnf (Or p q) = Or (nnf p) (nnf q)"
   451   "nnf (Imp p q) = Or (nnf (NOT p)) (nnf q)"
   452   "nnf (Equ p q) = Or (And (nnf p) (nnf q)) 
   453   (And (nnf (NOT p)) (nnf (NOT q)))"
   454   "nnf (NOT (Lt it1 it2)) = (Le it2 it1)"
   455   "nnf (NOT (Gt it1 it2))  = (Le it1 it2)"
   456   "nnf (NOT (Le it1 it2)) = (Le (Sub it2 it1) (Cst (- 1)))"
   457   "nnf (NOT (Ge it1 it2)) = (Le (Sub it1 it2) (Cst (- 1)))"
   458   "nnf (NOT (Eq it1 it2)) = (NOT (Eq it1 it2))"
   459   "nnf (NOT (Divides d t)) = (NOT (Divides d t))"
   460   "nnf (NOT T) = F"
   461   "nnf (NOT F) = T"
   462   "nnf (NOT (NOT p)) = (nnf p)"
   463   "nnf (NOT (And p q)) = (Or (nnf (NOT p)) (nnf (NOT q)))"
   464   "nnf (NOT (Or p q)) = (And (nnf (NOT p)) (nnf (NOT q)))"
   465   "nnf (NOT (Imp p q)) = (And (nnf p) (nnf (NOT q)))"
   466   "nnf (NOT (Equ p q)) = (Or (And (nnf p) (nnf (NOT q))) (And (nnf (NOT p)) (nnf q)))"
   467 
   468 consts isnnf :: "QF \<Rightarrow> bool"
   469 recdef isnnf "measure (\<lambda>p. lgth p)"
   470   "isnnf (Le it1 it2) = True"
   471   "isnnf (Eq it1 it2) = True"
   472   "isnnf (Divides d t) = True"
   473   "isnnf T = True"
   474   "isnnf F = True"
   475   "isnnf (And p q) = (isnnf p \<and> isnnf q)"
   476   "isnnf (Or p q) = (isnnf p \<and> isnnf q)"
   477   "isnnf (NOT (Divides d t)) = True" 
   478   "isnnf (NOT (Eq it1 it2)) = True" 
   479   "isnnf p = False"
   480 
   481 (* nnf preserves semantics *)
   482 lemma nnf_corr: "isqfree p \<Longrightarrow> qinterp ats p = qinterp ats (nnf p)"
   483 by (induct p rule: nnf.induct,simp_all) 
   484 (arith, arith, arith, arith, arith, arith, arith, arith, arith, blast)
   485 
   486 
   487 (* the result of nnf is in NNF *)
   488 lemma nnf_isnnf : "isqfree p \<Longrightarrow> isnnf (nnf p)"
   489 by (induct p rule: nnf.induct, auto)
   490 
   491 lemma nnf_isqfree: "isnnf p \<Longrightarrow> isqfree p"
   492 by (induct p rule: isnnf.induct) auto
   493 
   494 (* nnf preserves quantifier freeness *)
   495 lemma nnf_qfree: "isqfree p \<Longrightarrow> isqfree(nnf p)"
   496   using nnf_isqfree nnf_isnnf by simp
   497 
   498 (* Linearization and normalization of formulae *)
   499 (* Definition of linearity of an intterm *)
   500 
   501 consts islinintterm :: "intterm \<Rightarrow> bool"
   502 recdef islinintterm "measure size"
   503 "islinintterm (Cst i) = True"
   504 "islinintterm (Add (Mult (Cst i) (Var n)) (Cst i')) = (i \<noteq> 0)"
   505 "islinintterm (Add (Mult (Cst i) (Var n)) (Add (Mult (Cst i') (Var n')) r)) = ( i \<noteq> 0 \<and> i' \<noteq> 0 \<and> n < n' \<and> islinintterm  (Add (Mult (Cst i') (Var n')) r))"
   506 "islinintterm i = False"
   507 
   508 (* subterms of linear terms are linear *)
   509 lemma islinintterm_subt:
   510   assumes lr: "islinintterm (Add (Mult (Cst i) (Var n)) r)"
   511   shows "islinintterm r"
   512 using lr
   513 by (induct r rule: islinintterm.induct) auto
   514 
   515 (* c \<noteq> 0 for linear term c.n + r*)
   516 lemma islinintterm_cnz:
   517   assumes lr: "islinintterm (Add (Mult (Cst i) (Var n)) r)"
   518   shows "i \<noteq> 0"
   519 using lr
   520 by (induct r rule: islinintterm.induct) auto
   521 
   522 lemma islininttermc0r: "islinintterm (Add (Mult (Cst c) (Var n)) r) \<Longrightarrow> (c \<noteq> 0 \<and> islinintterm r)"
   523 by (induct r rule: islinintterm.induct, simp_all)
   524 
   525 (* An alternative linearity definition *)
   526 consts islintn :: "(nat \<times> intterm) \<Rightarrow> bool"
   527 recdef islintn "measure (\<lambda> (n,t). (size t))"
   528 "islintn (n0, Cst i) = True"
   529 "islintn (n0, Add (Mult (Cst i) (Var n)) r) = (i \<noteq> 0 \<and> n0 \<le> n \<and> islintn (n+1,r))"
   530 "islintn (n0, t) = False"
   531 
   532 definition
   533   islint :: "intterm \<Rightarrow> bool" where
   534   "islint t = islintn(0,t)"
   535 
   536 (* And the equivalence to the first definition *)
   537 lemma islinintterm_eq_islint: "islinintterm t = islint t"
   538   using islint_def
   539 by (induct t rule: islinintterm.induct) auto
   540 
   541 (* monotony *)
   542 lemma islintn_mon:
   543   assumes lin: "islintn (n,t)"
   544   and mgen: "m \<le> n"
   545   shows "islintn(m,t)"
   546   using lin mgen 
   547 by (induct t rule: islintn.induct) auto
   548 
   549 lemma islintn_subt:
   550   assumes lint: "islintn(n,Add (Mult (Cst i) (Var m)) r)"
   551   shows "islintn (m+1,r)"
   552 using lint
   553 by auto
   554 
   555 (* List indexin for n > 0 *)
   556 lemma nth_pos: "0 < n \<longrightarrow> (x#xs) ! n = (y#xs) ! n"
   557 using Nat.gr0_conv_Suc 
   558 by clarsimp 
   559 
   560 lemma nth_pos2: "0 < n \<Longrightarrow> (x#xs) ! n = xs ! (n - 1)"
   561 using Nat.gr0_conv_Suc
   562 by clarsimp
   563 
   564 lemma intterm_novar0: 
   565   assumes lin: "islinintterm (Add (Mult (Cst i) (Var n)) r)"
   566   shows "I_intterm (x#ats) r = I_intterm (y#ats) r"
   567 using lin
   568 by (induct r rule: islinintterm.induct) (simp_all add: nth_pos2)
   569 (* a simple version of a general theorem: Interpretation does not depend 
   570    on the first variable if it does not occur in the term *)
   571 
   572 lemma linterm_novar0:
   573   assumes lin: "islintn (n,t)"
   574   and npos: "0 < n"
   575   shows "I_intterm (x#ats) t = I_intterm (y#ats) t"
   576 using lin npos
   577 by (induct n t rule: islintn.induct) (simp_all add: nth_pos2)
   578 
   579 (* Periodicity of dvd *)
   580 lemma dvd_period:
   581   assumes advdd: "(a::int) dvd d"
   582   shows "(a dvd (x + t)) = (a dvd ((x+ c*d) + t))"
   583 using advdd  
   584 proof-
   585   from advdd  have "\<forall>x.\<forall>k. (((a::int) dvd (x + t)) = (a dvd
   586  (x+k*d + t)))" by (rule dvd_modd_pinf)
   587   then show ?thesis by simp
   588 qed
   589 
   590 (* lin_ad adds two linear terms*)
   591 consts lin_add :: "intterm \<times> intterm \<Rightarrow> intterm"
   592 recdef lin_add "measure (\<lambda>(x,y). ((size x) + (size y)))"
   593 "lin_add (Add (Mult (Cst c1) (Var n1)) (r1),Add (Mult (Cst c2) (Var n2)) (r2)) =
   594   (if n1=n2 then 
   595   (let c = Cst (c1 + c2) 
   596    in (if c1+c2=0 then lin_add(r1,r2) else Add (Mult c (Var n1)) (lin_add (r1,r2))))
   597   else if n1 \<le> n2 then (Add (Mult (Cst c1) (Var n1)) (lin_add (r1,Add (Mult (Cst c2) (Var n2)) (r2)))) 
   598   else (Add (Mult (Cst c2) (Var n2)) (lin_add (Add (Mult (Cst c1) (Var n1)) r1,r2))))"
   599 "lin_add (Add (Mult (Cst c1) (Var n1)) (r1),Cst b) = 
   600   (Add (Mult (Cst c1) (Var n1)) (lin_add (r1, Cst b)))"  
   601 "lin_add (Cst x,Add (Mult (Cst c2) (Var n2)) (r2)) = 
   602   Add (Mult (Cst c2) (Var n2)) (lin_add (Cst x,r2))" 
   603 "lin_add (Cst b1, Cst b2) = Cst (b1+b2)"
   604 
   605 lemma lin_add_cst_corr: 
   606   assumes blin : "islintn(n0,b)"
   607   shows "I_intterm ats (lin_add (Cst a,b)) = (I_intterm ats (Add (Cst a) b))"
   608 using blin
   609 by (induct n0 b rule: islintn.induct) auto
   610 
   611 lemma lin_add_cst_corr2: 
   612   assumes blin : "islintn(n0,b)"
   613   shows "I_intterm ats (lin_add (b,Cst a)) = (I_intterm ats (Add b (Cst a)))"
   614 using blin
   615 by (induct n0 b rule: islintn.induct) auto
   616 
   617 lemma lin_add_corrh: "\<And> n01 n02. \<lbrakk> islintn (n01,a) ; islintn (n02,b)\<rbrakk> 
   618   \<Longrightarrow> I_intterm ats (lin_add(a,b)) = I_intterm ats (Add a b)"
   619 proof(induct a b rule: lin_add.induct)
   620   case (58 i n r j m s) 
   621   have "(n = m \<and> i+j = 0) \<or> (n = m \<and> i+j \<noteq> 0) \<or> n < m \<or> m < n " by arith
   622   moreover
   623   {assume "n=m\<and>i+j=0" hence ?case using prems by (auto simp add: sym[OF zadd_zmult_distrib]) }
   624   moreover
   625   {assume "n=m\<and>i+j\<noteq>0" hence ?case using prems by (auto simp add: Let_def zadd_zmult_distrib)}
   626   moreover
   627   {assume "n < m" hence ?case using prems by auto }
   628   moreover
   629   {assume "n > m" hence ?case using prems by auto }
   630   ultimately show ?case by blast
   631 qed (auto simp add: lin_add_cst_corr lin_add_cst_corr2 Let_def)
   632 
   633 (* lin_add has the semantics of Add*)
   634 lemma lin_add_corr:
   635   assumes lina: "islinintterm a"
   636   and linb: "islinintterm b"
   637   shows "I_intterm ats (lin_add (a,b)) = (I_intterm ats (Add a b))"
   638 using lina linb islinintterm_eq_islint islint_def lin_add_corrh
   639 by blast
   640 
   641 lemma lin_add_cst_lint:
   642   assumes lin: "islintn (n0,b)"
   643   shows "islintn (n0, lin_add (Cst i, b))"
   644 using lin
   645 by (induct n0 b rule: islintn.induct) auto
   646 
   647 lemma lin_add_cst_lint2:
   648   assumes lin: "islintn (n0,b)"
   649   shows "islintn (n0, lin_add (b,Cst i))"
   650 using lin
   651 by (induct n0 b rule: islintn.induct) auto
   652 
   653 (* lin_add preserves linearity..*)
   654 lemma lin_add_lint: "\<And> n0 n01 n02. \<lbrakk> islintn (n01,a) ; islintn (n02,b); n0 \<le>  min n01 n02 \<rbrakk> 
   655   \<Longrightarrow> islintn (n0, lin_add (a,b))"
   656 proof (induct a b rule: lin_add.induct)
   657   case (58 i n r j m s)
   658   have "(n =m \<and> i + j = 0) \<or> (n = m \<and> i+j \<noteq> 0) \<or> n <m \<or> m < n" by arith
   659   moreover 
   660   { assume "n = m"
   661       and  "i+j = 0"
   662     hence ?case using "58" islintn_mon[where m = "n01" and n = "Suc m"]
   663       islintn_mon[where m = "n02" and n = "Suc m"] by auto }
   664   moreover 
   665   { assume  "n = m"
   666       and "i+j \<noteq> 0"
   667     hence ?case using "58" islintn_mon[where m = "n01" and n = "Suc m"]
   668       islintn_mon[where m = "n02" and n = "Suc m"] by (auto simp add: Let_def) }
   669   moreover
   670   { assume "n < m" hence ?case using 58 by force }
   671 moreover
   672   { assume "m < n"
   673     hence ?case using 58 
   674       apply (auto simp add: Let_def) 
   675       apply (erule allE[where x = "Suc m" ] )
   676       by (erule allE[where x = "Suc m" ] ) simp }
   677   ultimately show ?case by blast
   678 qed(simp_all add: Let_def lin_add_cst_lint lin_add_cst_lint2)
   679 
   680 lemma lin_add_lin:
   681   assumes lina: "islinintterm a"
   682   and linb: "islinintterm b"
   683   shows "islinintterm (lin_add (a,b))"
   684 using islinintterm_eq_islint islint_def lin_add_lint lina linb by auto
   685 
   686 (* lin_mul multiplies a linear term by a constant *)
   687 consts lin_mul :: "int \<times> intterm \<Rightarrow> intterm"
   688 recdef lin_mul "measure (\<lambda>(c,t). size t)"
   689 "lin_mul (c,Cst i) = (Cst (c*i))"
   690 "lin_mul (c,Add (Mult (Cst c') (Var n)) r)  = 
   691   (if c = 0 then (Cst 0) else
   692   (Add (Mult (Cst (c*c')) (Var n)) (lin_mul (c,r))))"
   693 
   694 lemma zmult_zadd_distrib[simp]: "(a::int) * (b+c) = a*b + a*c"
   695 proof-
   696   have "a*(b+c) = (b+c)*a" by simp
   697   moreover have "(b+c)*a = b*a + c*a" by (simp add: zadd_zmult_distrib)
   698   ultimately show ?thesis by simp
   699 qed
   700 
   701 (* lin_mul has the semantics of Mult *)
   702 lemma lin_mul_corr: 
   703   assumes lint: "islinintterm  t"
   704   shows "I_intterm ats (lin_mul (c,t)) = I_intterm ats (Mult (Cst c) t)"
   705 using lint
   706 proof (induct c t rule: lin_mul.induct)
   707   case (21 c c' n r)
   708   have "islinintterm (Add (Mult (Cst c') (Var n)) r)" .
   709   then have "islinintterm r" 
   710     by (rule islinintterm_subt[of "c'" "n" "r"])
   711   then show ?case  using "21.hyps" "21.prems" by simp
   712 qed(auto)
   713 
   714 (* lin_mul preserves linearity *)
   715 lemma lin_mul_lin:
   716   assumes lint: "islinintterm t"
   717   shows "islinintterm (lin_mul(c,t))"
   718 using lint
   719 by (induct t rule: islinintterm.induct) auto
   720 
   721 lemma lin_mul0:
   722   assumes lint: "islinintterm t"
   723   shows "lin_mul(0,t) = Cst 0"
   724   using lint
   725   by (induct t rule: islinintterm.induct) auto
   726 
   727 lemma lin_mul_lintn:
   728   "\<And> m. islintn(m,t) \<Longrightarrow> islintn(m,lin_mul(l,t))"
   729   by (induct l t rule: lin_mul.induct) simp_all
   730 
   731 (* lin_neg neagtes a linear term *)
   732 definition
   733   lin_neg :: "intterm \<Rightarrow> intterm" where
   734   "lin_neg i = lin_mul ((-1::int),i)"
   735 
   736 (* lin_neg has the semantics of Neg *)
   737 lemma lin_neg_corr:
   738   assumes lint: "islinintterm  t"
   739   shows "I_intterm ats (lin_neg t) = I_intterm ats (Neg t)"
   740   using lint lin_mul_corr
   741   by (simp add: lin_neg_def lin_mul_corr)
   742 
   743 (* lin_neg preserves linearity *)
   744 lemma lin_neg_lin:
   745   assumes lint: "islinintterm  t"
   746   shows "islinintterm (lin_neg t)"
   747 using lint
   748 by (simp add: lin_mul_lin lin_neg_def)
   749 
   750 (* Some properties about lin_add and lin-neg should be moved above *)
   751 
   752 lemma lin_neg_idemp: 
   753   assumes lini: "islinintterm i"
   754   shows "lin_neg (lin_neg i) = i"
   755 using lini
   756 by (induct i rule: islinintterm.induct) (auto simp add: lin_neg_def)
   757 
   758 lemma lin_neg_lin_add_distrib:
   759   assumes lina : "islinintterm a"
   760   and linb :"islinintterm b"
   761   shows "lin_neg (lin_add(a,b)) = lin_add (lin_neg a, lin_neg b)"
   762 using lina linb
   763 proof (induct a b rule: lin_add.induct)
   764   case (58 c1 n1 r1 c2 n2 r2)
   765   from prems have lincnr1:"islinintterm (Add (Mult (Cst c1) (Var n1)) r1)" by simp
   766   have linr1: "islinintterm r1" by (rule islinintterm_subt[OF lincnr1])
   767   from prems have lincnr2: "islinintterm (Add (Mult (Cst c2) (Var n2)) r2)" by simp
   768   have linr2: "islinintterm r2" by (rule islinintterm_subt[OF lincnr2])
   769   have "n1 = n2 \<or> n1 < n2 \<or> n1 > n2" by arith
   770   show ?case using prems linr1 linr2 by (simp_all add: lin_neg_def Let_def)
   771 next
   772   case (59 c n r b) 
   773   from prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var n)) r)" by simp
   774   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
   775   show ?case using prems linr by (simp add: lin_neg_def Let_def)
   776 next
   777   case (60 b c n r)
   778   from prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var n)) r)" by simp
   779   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
   780   show ?case  using prems linr by (simp add: lin_neg_def Let_def)
   781 qed (simp_all add: lin_neg_def)
   782 
   783 (* linearize tries to linearize a term *)
   784 consts linearize :: "intterm \<Rightarrow> intterm option"
   785 recdef linearize "measure (\<lambda>t. size t)"
   786 "linearize (Cst b) = Some (Cst b)"
   787 "linearize (Var n) = Some (Add (Mult (Cst 1) (Var n)) (Cst 0))"
   788 "linearize (Neg i) = lift_un lin_neg (linearize i)"
   789  "linearize (Add i j) = lift_bin(\<lambda> x. \<lambda> y. lin_add(x,y), linearize i, linearize j)"
   790 "linearize (Sub i j) = 
   791   lift_bin(\<lambda> x. \<lambda> y. lin_add(x,lin_neg y), linearize i, linearize j)"
   792 "linearize (Mult i j) = 
   793   (case linearize i of
   794   None \<Rightarrow> None
   795   | Some li \<Rightarrow> (case li of 
   796      Cst b \<Rightarrow> (case linearize j of
   797       None \<Rightarrow> None
   798      | (Some lj) \<Rightarrow> Some (lin_mul(b,lj)))
   799   | _ \<Rightarrow> (case linearize j of
   800       None \<Rightarrow> None
   801     | (Some lj) \<Rightarrow> (case lj of 
   802         Cst b \<Rightarrow> Some (lin_mul (b,li))
   803       | _ \<Rightarrow> None))))"
   804 
   805 lemma linearize_linear1:
   806   assumes lin: "linearize t \<noteq> None"
   807   shows "islinintterm (the (linearize t))"
   808 using lin
   809 proof (induct t rule: linearize.induct)
   810   case (1 b) show ?case by simp  
   811 next 
   812   case (2 n) show ?case by simp 
   813 next 
   814   case (3 i) show ?case 
   815     proof-
   816     have "(linearize i = None) \<or> (\<exists>li. linearize i = Some li)" by auto
   817     moreover 
   818     { assume "linearize i = None" with prems have ?thesis by auto}
   819     moreover 
   820     { assume lini: "\<exists>li. linearize i = Some li"
   821       from lini obtain "li" where  "linearize i = Some li" by blast
   822       have linli: "islinintterm li" by (simp!)
   823       moreover have "linearize (Neg i) = Some (lin_neg li)" using prems by simp
   824       moreover from linli have "islinintterm(lin_neg li)" by (simp add: lin_neg_lin)
   825       ultimately have ?thesis by simp
   826     }
   827     ultimately show ?thesis by blast
   828   qed
   829 next 
   830   case (4 i j) show ?case 
   831     proof-
   832     have "(linearize i = None) \<or> ((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> ((\<exists> li. linearize i = Some li) \<and> (\<exists> lj. linearize j = Some lj))" by auto 
   833     moreover 
   834     {
   835       assume nlini: "linearize i = None"
   836       from nlini have "linearize (Add i j) = None" 
   837 	by simp then have ?thesis using prems by auto}
   838     moreover 
   839     { assume nlinj: "linearize j = None"
   840 	and lini: "\<exists> li. linearize i = Some li"
   841       from nlinj lini have "linearize (Add i j) = None"
   842 	by auto with prems have ?thesis by auto}
   843     moreover 
   844     { assume lini: "\<exists>li. linearize i = Some li"
   845 	and linj: "\<exists>lj. linearize j = Some lj"
   846       from lini obtain "li" where  "linearize i = Some li" by blast
   847       have linli: "islinintterm li" by (simp!)
   848       from linj obtain "lj" where  "linearize j = Some lj" by blast
   849       have linlj: "islinintterm lj" by (simp!)
   850       moreover from lini linj have "linearize (Add i j) = Some (lin_add (li,lj))" 
   851 	by (auto!)
   852       moreover from linli linlj have "islinintterm(lin_add (li,lj))" by (simp add: lin_add_lin)
   853       ultimately have ?thesis by simp  }
   854     ultimately show ?thesis by blast
   855   qed
   856 next 
   857   case (5 i j)show ?case 
   858     proof-
   859     have "(linearize i = None) \<or> ((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> ((\<exists> li. linearize i = Some li) \<and> (\<exists> lj. linearize j = Some lj))" by auto 
   860     moreover 
   861     {
   862       assume nlini: "linearize i = None"
   863       from nlini have "linearize (Sub i j) = None" by simp then have ?thesis by (auto!)
   864     }
   865     moreover 
   866     {
   867       assume lini: "\<exists> li. linearize i = Some li"
   868 	and nlinj: "linearize j = None"
   869       from nlinj lini have "linearize (Sub i j) = None" 
   870 	by auto then have ?thesis by (auto!)
   871     }
   872     moreover 
   873     {
   874       assume lini: "\<exists>li. linearize i = Some li"
   875 	and linj: "\<exists>lj. linearize j = Some lj"
   876       from lini obtain "li" where  "linearize i = Some li" by blast
   877       have linli: "islinintterm li" by (simp!)
   878       from linj obtain "lj" where  "linearize j = Some lj" by blast
   879       have linlj: "islinintterm lj" by (simp!)
   880       moreover from lini linj have "linearize (Sub i j) = Some (lin_add (li,lin_neg lj))" 
   881 	by (auto!)
   882       moreover from linli linlj have "islinintterm(lin_add (li,lin_neg lj))" by (simp add: lin_add_lin lin_neg_lin)
   883       ultimately have ?thesis by simp
   884     }
   885     ultimately show ?thesis by blast
   886   qed
   887 next
   888   case (6 i j)show ?case 
   889     proof-
   890       have cses: "(linearize i = None) \<or> 
   891 	((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> 
   892 	((\<exists> li. linearize i = Some li) \<and> (\<exists> bj. linearize j = Some (Cst bj)))
   893 	\<or> ((\<exists> bi. linearize i = Some (Cst bi)) \<and> (\<exists> lj. linearize j = Some lj))
   894 	\<or> ((\<exists> li. linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)) \<and> (\<exists> lj. linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)))" by auto 
   895     moreover 
   896     {
   897       assume nlini: "linearize i = None"
   898       from nlini have "linearize (Mult i j) = None" by (simp)
   899       with prems have ?thesis by auto }
   900     moreover 
   901     {  assume lini: "\<exists> li. linearize i = Some li"
   902 	and nlinj: "linearize j = None"
   903       from lini obtain "li" where "linearize i = Some li" by blast 
   904       moreover from nlinj lini have "linearize (Mult i j) = None"
   905 	using prems
   906 	by (cases li) (auto)
   907       with prems have ?thesis by auto}
   908     moreover 
   909     { assume lini: "\<exists>li. linearize i = Some li"
   910 	and linj: "\<exists>bj. linearize j = Some (Cst bj)"
   911       from lini obtain "li" where  li_def: "linearize i = Some li" by blast
   912       from prems have linli: "islinintterm li" by simp
   913       moreover 
   914       from linj  obtain "bj" where  bj_def: "linearize j = Some (Cst bj)" by blast
   915       have linlj: "islinintterm (Cst bj)" by simp 
   916       moreover from lini linj prems 
   917       have "linearize (Mult i j) = Some (lin_mul (bj,li))"
   918 	by (cases li) auto
   919       moreover from linli linlj have "islinintterm(lin_mul (bj,li))" by (simp add: lin_mul_lin)
   920       ultimately have ?thesis by simp  }
   921     moreover 
   922     { assume lini: "\<exists>bi. linearize i = Some (Cst bi)"
   923 	and linj: "\<exists>lj. linearize j = Some lj"
   924       from lini obtain "bi" where  "linearize i = Some (Cst bi)" by blast
   925       from prems have linli: "islinintterm (Cst bi)" by simp
   926       moreover 
   927       from linj  obtain "lj" where  "linearize j = Some lj" by blast
   928       from prems have linlj: "islinintterm lj" by simp
   929       moreover from lini linj prems have "linearize (Mult i j) = Some (lin_mul (bi,lj))" 
   930 	by simp 
   931       moreover from linli linlj have "islinintterm(lin_mul (bi,lj))" by (simp add: lin_mul_lin)
   932       ultimately have ?thesis by simp }
   933     moreover 
   934     { assume linc: "\<exists> li. linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)"
   935 	and ljnc: "\<exists> lj. linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)"
   936       from linc obtain "li" where "linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)" by blast
   937       moreover 
   938       from ljnc obtain "lj" where "linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)" by blast
   939       ultimately have "linearize (Mult i j) = None"
   940 	by (cases li, auto) (cases lj, auto)+
   941       with prems have ?thesis by simp }
   942     ultimately show ?thesis by blast
   943   qed
   944 qed  
   945 
   946 (* the result of linearize, when successful, is a linear term*)
   947 lemma linearize_linear: "\<And> t'. linearize t = Some t' \<Longrightarrow> islinintterm t'"
   948 proof-
   949   fix t'
   950   assume lint: "linearize t = Some t'"
   951   from lint have lt: "linearize t \<noteq> None" by auto
   952   then have "islinintterm (the (linearize t))" by (rule_tac  linearize_linear1[OF lt])
   953   with lint show "islinintterm t'" by simp
   954 qed
   955 
   956 lemma linearize_corr1: 
   957   assumes lin: "linearize t \<noteq> None"
   958   shows "I_intterm ats t = I_intterm ats (the (linearize t))"
   959 using lin
   960 proof (induct t rule: linearize.induct)
   961   case (3 i) show ?case 
   962     proof-
   963     have "(linearize i = None) \<or> (\<exists>li. linearize i = Some li)" by auto
   964     moreover 
   965     {
   966       assume "linearize i = None"
   967       have ?thesis using prems by simp
   968     }
   969     moreover 
   970     {
   971       assume lini: "\<exists>li. linearize i = Some li"
   972       from lini have lini2: "linearize i \<noteq> None" by auto
   973       from lini obtain "li" where  "linearize i = Some li" by blast
   974       from lini2 lini have "islinintterm (the (linearize i))"
   975 	by (simp add: linearize_linear1[OF lini2])
   976       then have linli: "islinintterm li" using prems by simp
   977       have ieqli: "I_intterm ats i = I_intterm ats li" using prems by simp
   978       moreover have "linearize (Neg i) = Some (lin_neg li)" using prems by simp
   979       moreover from ieqli linli have "I_intterm ats (Neg i) = I_intterm ats (lin_neg li)" by (simp add: lin_neg_corr[OF linli])
   980       ultimately have ?thesis using prems by (simp add: lin_neg_corr)
   981     }
   982     ultimately show ?thesis by blast
   983   qed
   984 next 
   985   case (4 i j) show ?case 
   986     proof-
   987     have "(linearize i = None) \<or> ((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> ((\<exists> li. linearize i = Some li) \<and> (\<exists> lj. linearize j = Some lj))" by auto 
   988     moreover 
   989     {
   990       assume nlini: "linearize i = None"
   991       from nlini have "linearize (Add i j) = None" by simp then have ?thesis using prems by auto
   992     }
   993     moreover 
   994     {
   995       assume nlinj: "linearize j = None"
   996 	and lini: "\<exists> li. linearize i = Some li"
   997       from nlinj lini have "linearize (Add i j) = None"	by auto 
   998       then have ?thesis using prems by auto
   999     }
  1000     moreover 
  1001     {
  1002       assume lini: "\<exists>li. linearize i = Some li"
  1003 	and linj: "\<exists>lj. linearize j = Some lj"
  1004       from lini have lini2: "linearize i \<noteq> None" by auto
  1005       from linj have linj2: "linearize j \<noteq> None" by auto
  1006       from lini obtain "li" where  "linearize i = Some li" by blast
  1007       from lini2 have "islinintterm (the (linearize i))" by (simp add: linearize_linear1)
  1008       then have linli: "islinintterm li" using prems by simp
  1009       from linj obtain "lj" where  "linearize j = Some lj" by blast
  1010       from linj2 have "islinintterm (the (linearize j))" by (simp add: linearize_linear1)
  1011       then have linlj: "islinintterm lj" using prems by simp
  1012       moreover from lini linj have "linearize (Add i j) = Some (lin_add (li,lj))"
  1013 	using prems by simp
  1014       moreover from linli linlj have "I_intterm ats (lin_add (li,lj)) = I_intterm ats (Add li lj)" by (simp add: lin_add_corr)
  1015       ultimately have ?thesis using prems by simp
  1016     }
  1017     ultimately show ?thesis by blast
  1018   qed
  1019 next 
  1020   case (5 i j)show ?case 
  1021     proof-
  1022     have "(linearize i = None) \<or> ((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> ((\<exists> li. linearize i = Some li) \<and> (\<exists> lj. linearize j = Some lj))" by auto 
  1023     moreover 
  1024     {
  1025       assume nlini: "linearize i = None"
  1026       from nlini have "linearize (Sub i j) = None" by simp then have ?thesis using prems by auto
  1027     }
  1028     moreover 
  1029     {
  1030       assume lini: "\<exists> li. linearize i = Some li"
  1031 	and nlinj: "linearize j = None"
  1032       from nlinj lini have "linearize (Sub i j) = None" 
  1033 	by auto with prems have ?thesis by auto
  1034     }
  1035     moreover 
  1036     {
  1037       assume lini: "\<exists>li. linearize i = Some li"
  1038 	and linj: "\<exists>lj. linearize j = Some lj"
  1039       from lini have lini2: "linearize i \<noteq> None" by auto
  1040       from linj have linj2: "linearize j \<noteq> None" by auto
  1041       from lini obtain "li" where  "linearize i = Some li" by blast
  1042       from lini2 have "islinintterm (the (linearize i))" by (simp add: linearize_linear1)
  1043       with prems have linli: "islinintterm li" by simp
  1044       from linj obtain "lj" where  "linearize j = Some lj" by blast
  1045       from linj2 have "islinintterm (the (linearize j))" by (simp add: linearize_linear1)
  1046       with prems have linlj: "islinintterm lj" by simp
  1047       moreover from prems have "linearize (Sub i j) = Some (lin_add (li,lin_neg lj))" 
  1048 	by simp
  1049       moreover from linlj have linnlj:"islinintterm (lin_neg lj)" by (simp add: lin_neg_lin)
  1050       moreover from linli linnlj have "I_intterm ats (lin_add (li,lin_neg lj)) = I_intterm ats (Add li (lin_neg lj))" by (simp only: lin_add_corr[OF linli linnlj])
  1051       moreover from linli linlj linnlj have "I_intterm ats (Add li (lin_neg lj)) = I_intterm ats (Sub li lj)" 
  1052 	by (simp add: lin_neg_corr)
  1053       ultimately have ?thesis using prems by simp    
  1054     }
  1055     ultimately show ?thesis by blast
  1056   qed
  1057 next
  1058   case (6 i j)show ?case 
  1059     proof-
  1060       have cses: "(linearize i = None) \<or> 
  1061 	((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> 
  1062 	((\<exists> li. linearize i = Some li) \<and> (\<exists> bj. linearize j = Some (Cst bj)))
  1063 	\<or> ((\<exists> bi. linearize i = Some (Cst bi)) \<and> (\<exists> lj. linearize j = Some lj))
  1064 	\<or> ((\<exists> li. linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)) \<and> (\<exists> lj. linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)))" by auto 
  1065     moreover 
  1066     {
  1067       assume nlini: "linearize i = None"
  1068       from nlini have "linearize (Mult i j) = None" by simp with prems  have ?thesis by auto
  1069     }
  1070     moreover 
  1071     {
  1072       assume lini: "\<exists> li. linearize i = Some li"
  1073 	and nlinj: "linearize j = None"
  1074 
  1075       from lini obtain "li" where "linearize i = Some li" by blast 
  1076       moreover from prems have "linearize (Mult i j) = None" 
  1077 	by (cases li) simp_all
  1078       with prems have ?thesis by auto
  1079     }
  1080     moreover 
  1081     {
  1082       assume lini: "\<exists>li. linearize i = Some li"
  1083 	and linj: "\<exists>bj. linearize j = Some (Cst bj)"
  1084       from lini have lini2: "linearize i \<noteq> None" by auto
  1085       from linj have linj2: "linearize j \<noteq> None" by auto
  1086       from lini obtain "li" where  "linearize i = Some li" by blast
  1087       from lini2 have "islinintterm (the (linearize i))" by (simp add: linearize_linear1)
  1088       with prems  have linli: "islinintterm li" by simp
  1089       moreover 
  1090       from linj  obtain "bj" where  "linearize j = Some (Cst bj)" by blast
  1091       have linlj: "islinintterm (Cst bj)" by simp
  1092       moreover from prems have "linearize (Mult i j) = Some (lin_mul (bj,li))"
  1093  	by (cases li) auto
  1094       then have lm1: "I_intterm ats (the(linearize (Mult i j))) = I_intterm ats (lin_mul (bj,li))" by simp
  1095       moreover from linli linlj have "I_intterm ats (lin_mul(bj,li)) = I_intterm ats (Mult li (Cst bj))" by (simp add: lin_mul_corr)
  1096       with prems 
  1097       have "I_intterm ats (lin_mul(bj,li)) = I_intterm ats (Mult li (the (linearize j)))" 
  1098 	by auto
  1099       moreover have "I_intterm ats (Mult li (the (linearize j))) = I_intterm ats (Mult i (the (linearize j)))" using prems  by simp
  1100       moreover have "I_intterm ats i = I_intterm ats (the (linearize i))"  
  1101 	using lini2 lini "6.hyps" by simp
  1102 	moreover have "I_intterm ats j = I_intterm ats (the (linearize j))"
  1103 	  using prems by (cases li) auto
  1104       ultimately have ?thesis by auto }
  1105     moreover 
  1106     { assume lini: "\<exists>bi. linearize i = Some (Cst bi)"
  1107 	and linj: "\<exists>lj. linearize j = Some lj"
  1108       from lini have lini2 : "linearize i \<noteq> None" by auto
  1109       from linj have linj2 : "linearize j \<noteq> None" by auto      
  1110       from lini obtain "bi" where  "linearize i = Some (Cst bi)" by blast
  1111       have linli: "islinintterm (Cst bi)" using prems by simp
  1112       moreover 
  1113       from linj  obtain "lj" where  "linearize j = Some lj" by blast
  1114       from linj2 have "islinintterm (the (linearize j))" by (simp add: linearize_linear1) 
  1115       then have linlj: "islinintterm lj" by (simp!)
  1116       moreover from linli lini linj have "linearize (Mult i j) = Some (lin_mul (bi,lj))"
  1117 	by (case_tac "li::intterm",auto!)
  1118       then have lm1: "I_intterm ats (the(linearize (Mult i j))) = I_intterm ats (lin_mul (bi,lj))" by simp
  1119       moreover from linli linlj have "I_intterm ats (lin_mul(bi,lj)) = I_intterm ats (Mult (Cst bi) lj)" by (simp add: lin_mul_corr)
  1120       then have "I_intterm ats (lin_mul(bi,lj)) = I_intterm ats (Mult (the (linearize i)) lj)" by (auto!)
  1121       moreover have "I_intterm ats (Mult (the (linearize i)) lj) = I_intterm ats (Mult (the (linearize i)) j)" using lini lini2  by (simp!)
  1122       moreover have "I_intterm ats i = I_intterm ats (the (linearize i))"  
  1123 	using lini2 lini "6.hyps" by simp
  1124 	moreover have "I_intterm ats j = I_intterm ats (the (linearize j))"
  1125 	  using linj linj2 lini lini2 linli linlj "6.hyps" by (auto!)
  1126 
  1127       ultimately have ?thesis by auto }
  1128     moreover 
  1129     { assume linc: "\<exists> li. linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)"
  1130 	and ljnc: "\<exists> lj. linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)"
  1131       from linc obtain "li" where "\<exists> li. linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)" by blast
  1132       moreover 
  1133       from ljnc obtain "lj" where "\<exists> lj. linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)" by blast
  1134       ultimately have "linearize (Mult i j) = None"
  1135 	apply simp
  1136 	apply (case_tac "linearize i", auto)
  1137 	apply (case_tac a)
  1138 	apply (auto!)
  1139 	by (case_tac "lj",auto)+
  1140       then have ?thesis by (simp!) }
  1141     ultimately show ?thesis by blast
  1142   qed
  1143 qed  simp_all
  1144 
  1145 
  1146 (* linearize, when successful, preserves semantics *)
  1147 lemma linearize_corr: "\<And> t'. linearize t = Some t' \<Longrightarrow> I_intterm ats t = I_intterm ats t' "
  1148 proof-
  1149   fix t'
  1150   assume lint: "linearize t = Some t'"
  1151   show  "I_intterm ats t = I_intterm ats t'"
  1152   proof-
  1153     from lint have lt: "linearize t \<noteq> None" by simp 
  1154     then have "I_intterm ats t = I_intterm ats (the (linearize t))" 
  1155       by (rule_tac linearize_corr1[OF lt])
  1156     with lint show ?thesis by simp
  1157   qed
  1158 qed
  1159 
  1160 (* tries to linearize a formula *)
  1161 consts linform :: "QF \<Rightarrow> QF option"
  1162 primrec
  1163 "linform (Le it1 it2) =  
  1164   lift_bin(\<lambda>x. \<lambda>y. Le (lin_add(x,lin_neg y)) (Cst 0),linearize it1, linearize it2)"
  1165 "linform (Eq it1 it2) =  
  1166   lift_bin(\<lambda>x. \<lambda>y. Eq (lin_add(x,lin_neg y)) (Cst 0),linearize it1, linearize it2)"
  1167 "linform (Divides d t) =  
  1168   (case linearize d of
  1169     None \<Rightarrow> None
  1170    | Some ld \<Rightarrow> (case ld of
  1171           Cst b \<Rightarrow> 
  1172                (if (b=0) then None
  1173                else 
  1174                 (case linearize t of 
  1175                  None \<Rightarrow> None
  1176                | Some lt \<Rightarrow> Some (Divides ld lt)))
  1177          | _ \<Rightarrow> None))"
  1178 "linform  T = Some T"
  1179 "linform  F = Some F"
  1180 "linform (NOT p) = lift_un NOT (linform p)"
  1181 "linform (And p q)= lift_bin(\<lambda>f. \<lambda>g. And f g, linform p, linform q)"
  1182 "linform (Or p q) = lift_bin(\<lambda>f. \<lambda>g. Or f g, linform p, linform q)"
  1183 
  1184 (* linearity of formulae *)
  1185 consts islinform :: "QF \<Rightarrow> bool"
  1186 recdef islinform "measure size"
  1187 "islinform (Le it (Cst i)) = (i=0 \<and> islinintterm it )"
  1188 "islinform (Eq it (Cst i)) = (i=0 \<and> islinintterm it)"
  1189 "islinform (Divides (Cst d) t) = (d \<noteq> 0 \<and> islinintterm t)"
  1190 "islinform  T = True"
  1191 "islinform  F = True"
  1192 "islinform (NOT (Divides (Cst d) t)) = (d \<noteq> 0 \<and> islinintterm t)"
  1193 "islinform (NOT (Eq it (Cst i))) = (i=0 \<and> islinintterm it)"
  1194 "islinform (And p q)= ((islinform p) \<and> (islinform q))"
  1195 "islinform (Or p q) = ((islinform p) \<and> (islinform q))"
  1196 "islinform p = False"
  1197 
  1198 (* linform preserves nnf, if successful *)
  1199 lemma linform_nnf: 
  1200   assumes nnfp: "isnnf p" 
  1201   shows "\<And> p'. \<lbrakk>linform p = Some p'\<rbrakk> \<Longrightarrow> isnnf p'"
  1202 using nnfp
  1203 proof (induct p rule: isnnf.induct, simp_all)
  1204   case (goal1 a b p')
  1205   show ?case 
  1206     using prems 
  1207     by (cases "linearize a", auto) (cases "linearize b", auto)
  1208 next 
  1209   case (goal2 a b p')
  1210   show ?case 
  1211     using prems 
  1212     by (cases "linearize a", auto) (cases "linearize b", auto)
  1213 next 
  1214   case (goal3 d t p')
  1215   show ?case 
  1216     using prems
  1217     apply (cases "linearize d", auto)
  1218     apply (case_tac "a",auto)
  1219     apply (case_tac "int=0",auto)
  1220     by (cases "linearize t",auto)
  1221 next
  1222   case (goal4 f g p') show ?case 
  1223     using prems
  1224     by (cases "linform f", auto) (cases "linform g", auto)
  1225 next
  1226   case (goal5 f g p') show ?case 
  1227     using prems
  1228     by (cases "linform f", auto) (cases "linform g", auto)
  1229 next
  1230   case (goal6 d t p') show ?case 
  1231     using prems
  1232     apply (cases "linearize d", auto)
  1233     apply (case_tac "a", auto)
  1234     apply (case_tac "int = 0",auto)
  1235     by (cases "linearize t", auto)
  1236 next 
  1237   case (goal7 a b p')
  1238   show ?case 
  1239     using prems 
  1240     by (cases "linearize a", auto) (cases "linearize b", auto)
  1241 
  1242 
  1243 qed
  1244 
  1245 
  1246 lemma linform_corr: "\<And> lp. \<lbrakk> isnnf p ; linform p = Some lp \<rbrakk> \<Longrightarrow> 
  1247                      (qinterp ats p = qinterp ats lp)"
  1248 proof (induct p rule: linform.induct)
  1249   case (Le x y)
  1250   show ?case
  1251     using "Le.prems"
  1252   proof-
  1253     have "(\<exists> lx ly. linearize x = Some lx \<and> linearize y = Some ly) \<or> 
  1254       (linearize x = None) \<or> (linearize y = None)"by auto
  1255     moreover 
  1256     {
  1257       assume linxy: "\<exists> lx ly. linearize x = Some lx \<and> linearize y = Some ly"
  1258       from linxy obtain "lx" "ly" 
  1259 	where lxly:"linearize x = Some lx \<and> linearize y = Some ly" by blast
  1260       then 
  1261       have lxeqx: "I_intterm ats x = I_intterm ats lx" 
  1262 	by (simp add: linearize_corr)
  1263       from lxly have lxlin: "islinintterm lx" 
  1264 	by (auto simp add: linearize_linear)
  1265       from lxly have lyeqy: "I_intterm ats y = I_intterm ats ly"
  1266 	by (simp add: linearize_corr)
  1267       from lxly have lylin: "islinintterm ly" 
  1268 	by (auto simp add: linearize_linear)
  1269       from "prems"
  1270       have lpeqle: "lp =  (Le (lin_add(lx,lin_neg ly)) (Cst 0))"
  1271 	by auto
  1272       moreover
  1273       have lin1: "islinintterm (Cst 1)" by simp
  1274       then
  1275       have ?thesis  
  1276 	using lxlin lylin lin1 lin_add_lin lin_neg_lin "prems" lxly lpeqle
  1277 	by (simp add: lin_add_corr lin_neg_corr lxeqx lyeqy)
  1278       
  1279     }
  1280     
  1281     moreover
  1282     {
  1283       assume "linearize x = None"
  1284       have ?thesis using "prems" by simp
  1285     }
  1286     
  1287     moreover
  1288     {
  1289       assume "linearize y = None"
  1290       then have ?thesis using "prems"
  1291 	by (case_tac "linearize x", auto)
  1292     }
  1293     ultimately show ?thesis by blast
  1294   qed
  1295   
  1296 next 
  1297   case (Eq x y)
  1298   show ?case
  1299     using "Eq.prems"
  1300   proof-
  1301     have "(\<exists> lx ly. linearize x = Some lx \<and> linearize y = Some ly) \<or> 
  1302       (linearize x = None) \<or> (linearize y = None)"by auto
  1303     moreover 
  1304     {
  1305       assume linxy: "\<exists> lx ly. linearize x = Some lx \<and> linearize y = Some ly"
  1306       from linxy obtain "lx" "ly" 
  1307 	where lxly:"linearize x = Some lx \<and> linearize y = Some ly" by blast
  1308       then 
  1309       have lxeqx: "I_intterm ats x = I_intterm ats lx" 
  1310 	by (simp add: linearize_corr)
  1311       from lxly have lxlin: "islinintterm lx" 
  1312 	by (auto simp add: linearize_linear)
  1313       from lxly have lyeqy: "I_intterm ats y = I_intterm ats ly"
  1314 	by (simp add: linearize_corr)
  1315       from lxly have lylin: "islinintterm ly" 
  1316 	by (auto simp add: linearize_linear)
  1317       from "prems"
  1318       have lpeqle: "lp =  (Eq (lin_add(lx,lin_neg ly)) (Cst 0))"
  1319 	by auto
  1320       moreover
  1321       have lin1: "islinintterm (Cst 1)" by simp
  1322       then
  1323       have ?thesis  
  1324 	using lxlin lylin lin1 lin_add_lin lin_neg_lin "prems" lxly lpeqle
  1325 	by (simp add: lin_add_corr lin_neg_corr lxeqx lyeqy)
  1326       
  1327     }
  1328     
  1329     moreover
  1330     {
  1331       assume "linearize x = None"
  1332       have ?thesis using "prems" by simp
  1333     }
  1334     
  1335     moreover
  1336     {
  1337       assume "linearize y = None"
  1338       then have ?thesis using "prems"
  1339 	by (case_tac "linearize x", auto)
  1340     }
  1341     ultimately show ?thesis by blast
  1342   qed
  1343   
  1344 next 
  1345   case (Divides d t)
  1346   show ?case
  1347     using "Divides.prems"
  1348     apply (case_tac "linearize d",auto)
  1349     apply (case_tac a, auto)
  1350     apply (case_tac "int = 0", auto)
  1351     apply (case_tac "linearize t", auto)
  1352     apply (simp add: linearize_corr)
  1353     apply (case_tac a, auto)
  1354     apply (case_tac "int = 0", auto)
  1355     by (case_tac "linearize t", auto simp add: linearize_corr)
  1356 next
  1357   case (NOT f) show ?case
  1358     using "prems"
  1359   proof-
  1360     have "(\<exists> lf. linform f = Some lf) \<or> (linform f = None)" by auto
  1361     moreover 
  1362     {
  1363       assume linf: "\<exists> lf. linform f = Some lf"
  1364       from prems have "isnnf (NOT f)" by simp
  1365       then have fnnf: "isnnf f" by (cases f) auto
  1366       from linf obtain "lf" where lf: "linform f = Some lf" by blast
  1367       then have "lp = NOT lf" using "prems" by auto
  1368       with "NOT.prems" "NOT.hyps" lf fnnf
  1369       have ?case by simp
  1370     }
  1371     moreover 
  1372     {
  1373       assume "linform f = None"
  1374       then 
  1375       have "linform (NOT f) = None" by simp
  1376       then 
  1377       have ?thesis  using "NOT.prems" by simp
  1378     }
  1379     ultimately show ?thesis by blast
  1380   qed
  1381 next
  1382   case (Or f g) 
  1383   show ?case using "Or.hyps"
  1384   proof -
  1385     have "((\<exists> lf. linform f = Some lf ) \<and> (\<exists> lg. linform g = Some lg)) \<or> 
  1386       (linform f = None) \<or> (linform g = None)" by auto
  1387     moreover
  1388     {
  1389       assume linf: "\<exists> lf. linform f = Some lf"
  1390 	and ling: "\<exists> lg. linform g = Some lg"
  1391       from linf obtain "lf" where lf: "linform f = Some lf" by blast
  1392       from ling obtain "lg" where lg: "linform g = Some lg" by blast
  1393       from lf lg have "linform (Or f g) = Some (Or lf lg)" by simp
  1394       then have "lp = Or lf lg" using lf lg "prems"  by simp
  1395       with lf lg "prems" have ?thesis by simp
  1396     }
  1397     moreover
  1398     {
  1399       assume "linform f = None"
  1400       then have ?thesis using "Or.prems"  by auto
  1401     }
  1402     moreover
  1403     {
  1404       assume "linform g = None"
  1405       then have ?thesis using "Or.prems"  by (case_tac "linform f", auto)
  1406       
  1407     }
  1408     ultimately show ?thesis by blast
  1409   qed
  1410 next
  1411   case (And f g) 
  1412   show ?case using "And.hyps"
  1413   proof -
  1414     have "((\<exists> lf. linform f = Some lf ) \<and> (\<exists> lg. linform g = Some lg)) \<or> 
  1415       (linform f = None) \<or> (linform g = None)" by auto
  1416     moreover
  1417     {
  1418       assume linf: "\<exists> lf. linform f = Some lf"
  1419 	and ling: "\<exists> lg. linform g = Some lg"
  1420       from linf obtain "lf" where lf: "linform f = Some lf" by blast
  1421       from ling obtain "lg" where lg: "linform g = Some lg" by blast
  1422       from lf lg have "linform (And f g) = Some (And lf lg)" by simp
  1423       then have "lp = And lf lg" using lf lg "prems"  by simp
  1424       with lf lg "prems" have ?thesis by simp
  1425     }
  1426     moreover
  1427     {
  1428       assume "linform f = None"
  1429       then have ?thesis using "And.prems"  by auto
  1430     }
  1431     moreover
  1432     {
  1433       assume "linform g = None"
  1434       then have ?thesis using "And.prems"  by (case_tac "linform f", auto)
  1435       
  1436     }
  1437     ultimately show ?thesis by blast
  1438   qed
  1439 
  1440 qed simp_all
  1441 
  1442 
  1443 (* the result of linform is a linear formula *)
  1444 lemma linform_lin: "\<And> lp. \<lbrakk> isnnf p ; linform p = Some lp\<rbrakk> \<Longrightarrow> islinform lp"
  1445 proof (induct p rule: linform.induct)
  1446    case (Le x y)
  1447   have "((\<exists> lx. linearize x = Some lx) \<and> (\<exists> ly. linearize y = Some ly)) \<or> 
  1448     (linearize x = None) \<or> (linearize y = None) " by clarsimp
  1449   moreover 
  1450   {
  1451     assume linx: "\<exists> lx. linearize x = Some lx"
  1452       and liny: "\<exists> ly. linearize y = Some ly"
  1453     from linx obtain "lx" where lx: "linearize x = Some lx" by blast
  1454     from liny obtain "ly" where ly: "linearize y = Some ly" by blast
  1455     from lx have lxlin: "islinintterm lx" by (simp add: linearize_linear)
  1456     from ly have lylin: "islinintterm ly" by (simp add: linearize_linear)    
  1457     have lin1:"islinintterm (Cst 1)" by simp
  1458     have lin0: "islinintterm (Cst 0)" by simp
  1459     from "prems"  have "lp = Le (lin_add(lx,lin_neg ly)) (Cst 0)"
  1460       by auto
  1461     with lin0 lin1 lxlin lylin "prems" 
  1462     have ?case by (simp add: lin_add_lin lin_neg_lin)
  1463     
  1464   }
  1465 
  1466   moreover 
  1467   {
  1468     assume "linearize x = None"
  1469     then have ?case using "prems" by simp
  1470   }
  1471   moreover 
  1472   {
  1473     assume "linearize y = None"
  1474     then have ?case using "prems" by (case_tac "linearize x",simp_all)
  1475   }
  1476   ultimately show ?case by blast
  1477 next
  1478    case (Eq x y)
  1479   have "((\<exists> lx. linearize x = Some lx) \<and> (\<exists> ly. linearize y = Some ly)) \<or> 
  1480     (linearize x = None) \<or> (linearize y = None) " by clarsimp
  1481   moreover 
  1482   {
  1483     assume linx: "\<exists> lx. linearize x = Some lx"
  1484       and liny: "\<exists> ly. linearize y = Some ly"
  1485     from linx obtain "lx" where lx: "linearize x = Some lx" by blast
  1486     from liny obtain "ly" where ly: "linearize y = Some ly" by blast
  1487     from lx have lxlin: "islinintterm lx" by (simp add: linearize_linear)
  1488     from ly have lylin: "islinintterm ly" by (simp add: linearize_linear)    
  1489     have lin1:"islinintterm (Cst 1)" by simp
  1490     have lin0: "islinintterm (Cst 0)" by simp
  1491     from "prems"  have "lp = Eq (lin_add(lx,lin_neg ly)) (Cst 0)"
  1492       by auto
  1493     with lin0 lin1 lxlin lylin "prems" 
  1494     have ?case by (simp add: lin_add_lin lin_neg_lin)
  1495     
  1496   }
  1497 
  1498   moreover 
  1499   {
  1500     assume "linearize x = None"
  1501     then have ?case using "prems" by simp
  1502   }
  1503   moreover 
  1504   {
  1505     assume "linearize y = None"
  1506     then have ?case using "prems" by (case_tac "linearize x",simp_all)
  1507   }
  1508   ultimately show ?case by blast
  1509 next
  1510    case (Divides d t)
  1511    show ?case 
  1512      using prems
  1513      apply (case_tac "linearize d", auto)
  1514      apply (case_tac a, auto)
  1515      apply (case_tac "int = 0", auto)
  1516 
  1517      by (case_tac "linearize t",auto simp add: linearize_linear)
  1518 next
  1519   case (Or f g)
  1520  show ?case using "Or.hyps"
  1521   proof -
  1522     have "((\<exists> lf. linform f = Some lf ) \<and> (\<exists> lg. linform g = Some lg)) \<or> 
  1523       (linform f = None) \<or> (linform g = None)" by auto
  1524     moreover
  1525     {
  1526       assume linf: "\<exists> lf. linform f = Some lf"
  1527 	and ling: "\<exists> lg. linform g = Some lg"
  1528       from linf obtain "lf" where lf: "linform f = Some lf" by blast
  1529       from ling obtain "lg" where lg: "linform g = Some lg" by blast
  1530       from lf lg have "linform (Or f g) = Some (Or lf lg)" by simp
  1531       then have "lp = Or lf lg" using lf lg "prems"  by simp
  1532       with lf lg "prems" have ?thesis by simp
  1533     }
  1534     moreover
  1535     {
  1536       assume "linform f = None"
  1537       then have ?thesis using "Or.prems"  by auto
  1538     }
  1539     moreover
  1540     {
  1541       assume "linform g = None"
  1542       then have ?thesis using "Or.prems"  by (case_tac "linform f", auto)
  1543       
  1544     }
  1545     ultimately show ?thesis by blast
  1546   qed
  1547 next
  1548   case (And f g) 
  1549   show ?case using "And.hyps"
  1550   proof -
  1551     have "((\<exists> lf. linform f = Some lf ) \<and> (\<exists> lg. linform g = Some lg)) \<or> 
  1552       (linform f = None) \<or> (linform g = None)" by auto
  1553     moreover
  1554     {
  1555       assume linf: "\<exists> lf. linform f = Some lf"
  1556 	and ling: "\<exists> lg. linform g = Some lg"
  1557       from linf obtain "lf" where lf: "linform f = Some lf" by blast
  1558       from ling obtain "lg" where lg: "linform g = Some lg" by blast
  1559       from lf lg have "linform (And f g) = Some (And lf lg)" by simp
  1560       then have "lp = And lf lg" using lf lg "prems"  by simp
  1561       with lf lg "prems" have ?thesis by simp
  1562     }
  1563     moreover
  1564     {
  1565       assume "linform f = None"
  1566       then have ?thesis using "And.prems"  by auto
  1567     }
  1568     moreover
  1569     {
  1570       assume "linform g = None"
  1571       then have ?thesis using "And.prems"  by (case_tac "linform f", auto)
  1572       
  1573     }
  1574     ultimately show ?thesis by blast
  1575   qed
  1576 next
  1577   case (NOT f) show ?case
  1578     using "prems"
  1579   proof-
  1580     have "(\<exists> lf. linform f = Some lf) \<or> (linform f = None)" by auto
  1581     moreover 
  1582     {
  1583       assume linf: "\<exists> lf. linform f = Some lf"
  1584       from prems have "isnnf (NOT f)" by simp
  1585       then have fnnf: "isnnf f" by (cases f) auto
  1586       from linf obtain "lf" where lf: "linform f = Some lf" by blast
  1587       then have "lp = NOT lf" using "prems" by auto
  1588       with "NOT.prems" "NOT.hyps" lf fnnf
  1589       have ?thesis 
  1590 	using fnnf
  1591 	apply (cases f, auto) 
  1592 	prefer 2
  1593 	apply (case_tac "linearize intterm1",auto)
  1594 	apply (case_tac a, auto)
  1595 	apply (case_tac "int = 0", auto)
  1596 	apply (case_tac "linearize intterm2") 
  1597 	apply (auto simp add: linearize_linear)
  1598 	apply (case_tac "linearize intterm1",auto)
  1599 	by (case_tac "linearize intterm2") 
  1600       (auto simp add: linearize_linear lin_add_lin lin_neg_lin)
  1601     }
  1602     moreover 
  1603     {
  1604       assume "linform f = None"
  1605       then 
  1606       have "linform (NOT f) = None" by simp
  1607       then 
  1608       have ?thesis  using "NOT.prems" by simp
  1609     }
  1610     ultimately show ?thesis by blast
  1611   qed
  1612 qed (simp_all)
  1613 
  1614 
  1615 (* linform, if successful, preserves quantifier freeness *)
  1616 lemma linform_isnnf: "islinform p \<Longrightarrow> isnnf p"
  1617 by (induct p rule: islinform.induct) auto
  1618 
  1619 lemma linform_isqfree: "islinform p \<Longrightarrow> isqfree p"
  1620 using linform_isnnf nnf_isqfree by simp
  1621 
  1622 lemma linform_qfree: "\<And> p'. \<lbrakk> isnnf p ; linform p = Some p'\<rbrakk> \<Longrightarrow> isqfree p'"
  1623 using linform_isqfree linform_lin 
  1624 by simp
  1625 
  1626 (* Definitions and lemmas about gcd and lcm *)
  1627 definition
  1628   lcm :: "nat \<times> nat \<Rightarrow> nat" where
  1629   "lcm = (\<lambda>(m,n). m*n div gcd(m,n))"
  1630 
  1631 definition
  1632   ilcm :: "int \<Rightarrow> int \<Rightarrow> int" where
  1633   "ilcm = (\<lambda>i.\<lambda>j. int (lcm(nat(abs i),nat(abs j))))"
  1634 
  1635 (* ilcm_dvd12 are needed later *)
  1636 lemma lcm_dvd1: 
  1637   assumes mpos: " m >0"
  1638   and npos: "n>0"
  1639   shows "m dvd (lcm(m,n))"
  1640 proof-
  1641   have "gcd(m,n) dvd n" by simp
  1642   then obtain "k" where "n = gcd(m,n) * k" using dvd_def by auto
  1643   then have "m*n div gcd(m,n) = m*(gcd(m,n)*k) div gcd(m,n)" by (simp add: mult_ac)
  1644   also have "\<dots> = m*k" using mpos npos gcd_zero by simp
  1645   finally show ?thesis by (simp add: lcm_def)
  1646 qed
  1647 
  1648 lemma lcm_dvd2: 
  1649   assumes mpos: " m >0"
  1650   and npos: "n>0"
  1651   shows "n dvd (lcm(m,n))"
  1652 proof-
  1653   have "gcd(m,n) dvd m" by simp
  1654   then obtain "k" where "m = gcd(m,n) * k" using dvd_def by auto
  1655   then have "m*n div gcd(m,n) = (gcd(m,n)*k)*n div gcd(m,n)" by (simp add: mult_ac)
  1656   also have "\<dots> = n*k" using mpos npos gcd_zero by simp
  1657   finally show ?thesis by (simp add: lcm_def)
  1658 qed
  1659 
  1660 lemma ilcm_dvd1: 
  1661 assumes anz: "a \<noteq> 0" 
  1662   and bnz: "b \<noteq> 0"
  1663   shows "a dvd (ilcm a b)"
  1664 proof-
  1665   let ?na = "nat (abs a)"
  1666   let ?nb = "nat (abs b)"
  1667   have nap: "?na >0" using anz by simp
  1668   have nbp: "?nb >0" using bnz by simp
  1669   from nap nbp have "?na dvd lcm(?na,?nb)" using lcm_dvd1 by simp
  1670   thus ?thesis by (simp add: ilcm_def dvd_int_iff)
  1671 qed
  1672 
  1673 
  1674 lemma ilcm_dvd2: 
  1675 assumes anz: "a \<noteq> 0" 
  1676   and bnz: "b \<noteq> 0"
  1677   shows "b dvd (ilcm a b)"
  1678 proof-
  1679   let ?na = "nat (abs a)"
  1680   let ?nb = "nat (abs b)"
  1681   have nap: "?na >0" using anz by simp
  1682   have nbp: "?nb >0" using bnz by simp
  1683   from nap nbp have "?nb dvd lcm(?na,?nb)" using lcm_dvd2 by simp
  1684   thus ?thesis by (simp add: ilcm_def dvd_int_iff)
  1685 qed
  1686 
  1687 lemma zdvd_self_abs1: "(d::int) dvd (abs d)"
  1688 by (case_tac "d <0", simp_all)
  1689 
  1690 lemma zdvd_self_abs2: "(abs (d::int)) dvd d"
  1691 by (case_tac "d<0", simp_all)
  1692 
  1693 (* lcm a b is positive for positive a and b *)
  1694 
  1695 lemma lcm_pos: 
  1696   assumes mpos: "m > 0"
  1697   and npos: "n>0"
  1698   shows "lcm (m,n) > 0"
  1699 
  1700 proof(rule ccontr, simp add: lcm_def gcd_zero)
  1701 assume h:"m*n div gcd(m,n) = 0"
  1702 from mpos npos have "gcd (m,n) \<noteq> 0" using gcd_zero by simp
  1703 hence gcdp: "gcd(m,n) > 0" by simp
  1704 with h
  1705 have "m*n < gcd(m,n)"
  1706   by (cases "m * n < gcd (m, n)") (auto simp add: div_if[OF gcdp, where m="m*n"])
  1707 moreover 
  1708 have "gcd(m,n) dvd m" by simp
  1709  with mpos dvd_imp_le have t1:"gcd(m,n) \<le> m" by simp
  1710  with npos have t1:"gcd(m,n)*n \<le> m*n" by simp
  1711  have "gcd(m,n) \<le> gcd(m,n)*n" using npos by simp
  1712  with t1 have "gcd(m,n) \<le> m*n" by arith
  1713 ultimately show "False" by simp
  1714 qed
  1715 
  1716 lemma ilcm_pos: 
  1717   assumes apos: " 0 < a"
  1718   and bpos: "0 < b" 
  1719   shows "0 < ilcm  a b"
  1720 proof-
  1721   let ?na = "nat (abs a)"
  1722   let ?nb = "nat (abs b)"
  1723   have nap: "?na >0" using apos by simp
  1724   have nbp: "?nb >0" using bpos by simp
  1725   have "0 < lcm (?na,?nb)" by (rule lcm_pos[OF nap nbp])
  1726   thus ?thesis by (simp add: ilcm_def)
  1727 qed
  1728 
  1729 (* fomlcm computes the lcm of all c, where c is the coeffitient of Var 0 *)
  1730 consts formlcm :: "QF \<Rightarrow> int"
  1731 recdef formlcm "measure size"
  1732 "formlcm (Le (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = abs c "
  1733 "formlcm (Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = abs c "
  1734 "formlcm (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = abs c"
  1735 "formlcm (NOT p) = formlcm p"
  1736 "formlcm (And p q)= ilcm (formlcm p) (formlcm q)"
  1737 "formlcm (Or p q) = ilcm (formlcm p) (formlcm q)"
  1738 "formlcm p = 1"
  1739 
  1740 (* the property that formlcm should fullfill *)
  1741 consts divideallc:: "int \<times> QF \<Rightarrow> bool"
  1742 recdef divideallc "measure (\<lambda>(i,p). size p)"
  1743 "divideallc (l,Le (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = (c dvd l)"
  1744 "divideallc (l,Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = (c dvd l)"
  1745 "divideallc(l,Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = (c dvd l)"
  1746 "divideallc (l,NOT p) = divideallc(l,p)"
  1747 "divideallc (l,And p q) = (divideallc (l,p) \<and> divideallc (l,q))"
  1748 "divideallc (l,Or p q) = (divideallc (l,p) \<and> divideallc (l,q))"
  1749 "divideallc p = True"
  1750 
  1751 (* formlcm retuns a positive integer *)
  1752 lemma formlcm_pos: 
  1753   assumes linp: "islinform p"
  1754   shows "0 < formlcm p"
  1755 using linp
  1756 proof (induct p rule: formlcm.induct, simp_all add: ilcm_pos)
  1757   case (goal1 c r i)
  1758   have "i=0 \<or> i \<noteq> 0" by simp
  1759   moreover
  1760   {
  1761     assume "i \<noteq> 0" then have ?case using prems by simp
  1762   }
  1763   moreover 
  1764   {
  1765     assume iz: "i = 0"
  1766     then have "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  1767     then have "c\<noteq>0" 
  1768       using prems
  1769       by (simp add: islininttermc0r[where c="c" and n="0" and r="r"])
  1770     then have ?case by simp
  1771   }
  1772   ultimately 
  1773   show ?case by blast
  1774 next 
  1775   case (goal2 c r i)
  1776   have "i=0 \<or> i \<noteq> 0" by simp
  1777   moreover
  1778   {
  1779     assume "i \<noteq> 0" then have ?case using prems by simp
  1780   }
  1781   moreover 
  1782   {
  1783     assume iz: "i = 0"
  1784     then have "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  1785     then have "c\<noteq>0" 
  1786       using prems
  1787       by (simp add: islininttermc0r[where c="c" and n="0" and r="r"])
  1788     then have ?case by simp
  1789   }
  1790   ultimately 
  1791   show ?case by blast
  1792 
  1793 next 
  1794   case (goal3 d c r)
  1795   show ?case using prems by (simp add: islininttermc0r[where c="c" and n="0" and r="r"])
  1796 next
  1797   case (goal4 f)
  1798   show ?case using prems 
  1799     by (cases f,auto) (case_tac "intterm2", auto,case_tac "intterm1", auto)
  1800 qed
  1801 
  1802 lemma divideallc_mono: "\<And> c. \<lbrakk> divideallc(c,p) ; c dvd d\<rbrakk> \<Longrightarrow> divideallc (d,p)"
  1803 proof (induct d p rule: divideallc.induct, simp_all)
  1804   case (goal1 l a b) show ?case by ( rule zdvd_trans [where m="a" and n="b" and k="l"])
  1805 next
  1806   case (goal2 l a b) show ?case by ( rule zdvd_trans [where m="a" and n="b" and k="l"])
  1807 next
  1808  case (goal3 l a b) show ?case by ( rule zdvd_trans [where m="a" and n="b" and k="l"])
  1809 next
  1810   case (goal4 l f g k)
  1811   have  "divideallc (l,g)" using prems by clarsimp
  1812   moreover have "divideallc (l,f)" using prems by clarsimp
  1813   ultimately
  1814   show ?case  by simp
  1815 next 
  1816   case (goal5 l f g k)
  1817   have  "divideallc (l,g)" using prems by clarsimp
  1818   moreover have "divideallc (l,f)" using prems by clarsimp
  1819   ultimately
  1820   show ?case  by simp
  1821   
  1822 qed
  1823 
  1824 (* fomlcm retuns a number all coeffitients of Var 0 divide *)
  1825 
  1826 lemma formlcm_divideallc: 
  1827   assumes linp: "islinform p"
  1828   shows "divideallc(formlcm p, p)"
  1829 using linp
  1830 proof (induct p rule: formlcm.induct, simp_all add: zdvd_self_abs1)
  1831   case (goal1 f)
  1832   show ?case using prems
  1833     by (cases f,auto) (case_tac "intterm2", auto, case_tac "intterm1",auto)
  1834 next 
  1835   case (goal2 f g)
  1836   have "formlcm f >0" using formlcm_pos prems by simp 
  1837     hence "formlcm f \<noteq> 0" by simp
  1838   moreover have "formlcm g > 0" using formlcm_pos prems by simp
  1839   hence "formlcm g \<noteq> 0" by simp
  1840   ultimately
  1841   show ?case using prems formlcm_pos
  1842      by (simp add: ilcm_dvd1 ilcm_dvd2 
  1843        divideallc_mono[where c="formlcm f" and d="ilcm (formlcm f) (formlcm g)"]  
  1844        divideallc_mono[where c="formlcm g" and d="ilcm (formlcm f) (formlcm g)"])
  1845 next 
  1846   case (goal3 f g)
  1847   have "formlcm f >0" using formlcm_pos prems by simp 
  1848     hence "formlcm f \<noteq> 0" by simp
  1849   moreover have "formlcm g > 0" using formlcm_pos prems by simp
  1850   hence "formlcm g \<noteq> 0" by simp
  1851   ultimately
  1852   show ?case using prems 
  1853     by (simp add: ilcm_dvd1 ilcm_dvd2 
  1854       divideallc_mono[where c="formlcm f" and d="ilcm (formlcm f) (formlcm g)"]  
  1855       divideallc_mono[where c="formlcm g" and d="ilcm (formlcm f) (formlcm g)"])
  1856 qed
  1857 
  1858 (* adjustcoeff transforms the formula given an l , look at correctness thm*)
  1859 consts adjustcoeff :: "int \<times> QF \<Rightarrow> QF"
  1860 recdef adjustcoeff "measure (\<lambda>(l,p). size p)"
  1861 "adjustcoeff (l,(Le (Add (Mult (Cst c) (Var 0)) r) (Cst i))) = 
  1862   (if c\<le>0 then 
  1863   Le (Add (Mult (Cst -1) (Var 0)) (lin_mul (- (l div c), r))) (Cst (0::int))
  1864   else
  1865   Le (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))) (Cst (0::int)))"
  1866 "adjustcoeff (l,(Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i))) = 
  1867   (Eq (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))) (Cst (0::int)))"
  1868 "adjustcoeff (l,Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = 
  1869   Divides (Cst ((l div c) * d))
  1870   (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r)))"
  1871 "adjustcoeff (l,NOT (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r))) = NOT (Divides (Cst ((l div c) * d))
  1872   (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))))"
  1873 "adjustcoeff (l,(NOT(Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i)))) = 
  1874   (NOT(Eq (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))) (Cst (0::int))))"
  1875 "adjustcoeff (l,And p q) = And (adjustcoeff (l,p)) (adjustcoeff(l,q))"
  1876 "adjustcoeff (l,Or p q) = Or (adjustcoeff (l,p)) (adjustcoeff(l,q))"
  1877 "adjustcoeff (l,p) = p"
  1878 
  1879 
  1880 (* unitycoeff expects a quantifier free formula an transforms it to an equivalent formula where the bound variable occurs only with coeffitient 1  or -1 *)
  1881 definition
  1882   unitycoeff :: "QF \<Rightarrow> QF" where
  1883   "unitycoeff p =
  1884   (let l = formlcm p;
  1885        p' = adjustcoeff (l,p)
  1886    in (if l=1 then p' else 
  1887       (And (Divides (Cst l) (Add (Mult (Cst 1) (Var 0)) (Cst 0))) p')))"
  1888 
  1889 (* what is a unified formula *)
  1890 consts isunified :: "QF \<Rightarrow> bool"
  1891 recdef isunified "measure size"
  1892 "isunified (Le (Add (Mult (Cst i) (Var 0)) r) (Cst z)) = 
  1893   ((abs i) = 1  \<and> (islinform(Le (Add (Mult (Cst i) (Var 0)) r) (Cst z))))"
  1894 "isunified (Eq (Add (Mult (Cst i) (Var 0)) r) (Cst z)) = 
  1895   ((abs i) = 1  \<and> (islinform(Le (Add (Mult (Cst i) (Var 0)) r) (Cst z))))"
  1896 "isunified (NOT(Eq (Add (Mult (Cst i) (Var 0)) r) (Cst z))) = 
  1897   ((abs i) = 1  \<and> (islinform(Le (Add (Mult (Cst i) (Var 0)) r) (Cst z))))"
  1898 "isunified (Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r)) = 
  1899   ((abs i) = 1 \<and> (islinform(Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r))))"
  1900 "isunified (NOT(Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r))) = 
  1901   ((abs i) = 1 \<and> (islinform(NOT(Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r)))))"
  1902 "isunified (And p q) = (isunified p \<and> isunified q)"
  1903 "isunified (Or p q) = (isunified p \<and> isunified q)"
  1904 "isunified p = islinform p"
  1905 
  1906 lemma unified_islinform: "isunified p \<Longrightarrow> islinform p"
  1907 by (induct p rule: isunified.induct) auto
  1908 
  1909 lemma adjustcoeff_lenpos: 
  1910   "0 < n \<Longrightarrow> adjustcoeff (l, Le (Add (Mult (Cst i) (Var n)) r) (Cst c)) =
  1911     Le (Add (Mult (Cst i) (Var n)) r) (Cst c)"
  1912 by (cases n, auto)
  1913 
  1914 lemma adjustcoeff_eqnpos: 
  1915   "0 < n \<Longrightarrow> adjustcoeff (l, Eq (Add (Mult (Cst i) (Var n)) r) (Cst c)) =
  1916     Eq (Add (Mult (Cst i) (Var n)) r) (Cst c)"
  1917 by (cases n, auto)
  1918 
  1919 
  1920 (* Properties of adjustcoeff and unitycoeff *)
  1921 
  1922 (* Some simple lemmas used afterwards *)
  1923 lemma zmult_zle_mono: "(i::int) \<le> j \<Longrightarrow> 0 \<le> k \<Longrightarrow> k * i \<le> k * j"
  1924   apply (erule order_le_less [THEN iffD1, THEN disjE, of "0::int"])
  1925   apply (erule order_le_less [THEN iffD1, THEN disjE])
  1926   apply (rule order_less_imp_le)
  1927   apply (rule zmult_zless_mono2)
  1928   apply simp_all
  1929   done
  1930 
  1931 lemma zmult_zle_mono_eq:
  1932   assumes kpos: "0 < k"
  1933   shows "((i::int) \<le> j) = (k*i \<le> k*j)" (is "?P = ?Q")
  1934 proof
  1935   assume P: ?P
  1936   from kpos have kge0: "0 \<le> k" by simp
  1937   show ?Q
  1938     by (rule zmult_zle_mono[OF P kge0])
  1939 next 
  1940   assume ?Q
  1941   then have "k*i - k*j \<le> 0" by simp
  1942   then have le1: "k*(i-j) \<le> k*0"
  1943     by (simp add: zdiff_zmult_distrib2)
  1944   have "i -j \<le> 0" 
  1945     by (rule mult_left_le_imp_le[OF le1 kpos])
  1946   then 
  1947   show ?P by simp
  1948 qed
  1949   
  1950 
  1951 lemma adjustcoeff_le_corr:
  1952   assumes lpos: "0 < l"
  1953   and ipos: "0 < (i::int)"
  1954   and dvd: "i dvd l"
  1955   shows "(i*x + r \<le> 0) = (l*x + ((l div i)*r) \<le> 0)"
  1956 proof-
  1957   from lpos ipos have ilel: "i\<le>l" by (simp add: zdvd_imp_le [OF dvd lpos])
  1958   from ipos have inz: "i \<noteq> 0" by simp
  1959   have "i div i\<le> l div i"
  1960     by (simp add: zdiv_mono1[OF ilel ipos])
  1961   then have ldivipos:"0 < l div i" 
  1962     by (simp add: zdiv_self[OF inz])
  1963   
  1964   from dvd have "\<exists>i'. i*i' = l" by (auto simp add: dvd_def)
  1965   then obtain "i'" where ii'eql: "i*i' = l" by blast
  1966   have "(i * x + r \<le> 0) = (l div i * (i * x + r) \<le> l div i * 0)"
  1967     by (rule zmult_zle_mono_eq[OF ldivipos, where i="i*x + r" and j="0"])
  1968   also
  1969   have "(l div i * (i * x + r) \<le> l div i * 0) = ((l div i * i) * x + ((l div i)*r) \<le> 0)"
  1970     by (simp add: mult_ac)
  1971   also have "((l div i * i) * x + ((l div i)*r) \<le> 0) = (l*x + ((l div i)*r) \<le> 0)"
  1972     using sym[OF ii'eql] inz
  1973     by (simp add: zmult_ac)
  1974   finally  
  1975   show ?thesis
  1976     by simp
  1977 qed
  1978 
  1979 lemma adjustcoeff_le_corr2:
  1980   assumes lpos: "0 < l"
  1981   and ineg: "(i::int) < 0"
  1982   and dvd: "i dvd l"
  1983   shows "(i*x + r \<le> 0) = ((-l)*x + ((-(l div i))*r) \<le> 0)"
  1984 proof-
  1985   from dvd have midvdl: "-i dvd l" by simp
  1986   from ineg have mipos: "0 < -i" by simp
  1987   from lpos ineg have milel: "-i\<le>l" by (simp add: zdvd_imp_le [OF midvdl lpos])
  1988   from ineg have inz: "i \<noteq> 0" by simp
  1989   have "l div i\<le> -i div i"
  1990     by (simp add: zdiv_mono1_neg[OF milel ineg])
  1991   then have "l div i \<le> -1" 
  1992     apply (simp add: zdiv_zminus1_eq_if[OF inz, where a="i"])
  1993     by (simp add: zdiv_self[OF inz])
  1994   then have ldivineg: "l div i < 0" by simp
  1995   then have mldivipos: "0 < - (l div i)" by simp
  1996   
  1997   from dvd have "\<exists>i'. i*i' = l" by (auto simp add: dvd_def)
  1998   then obtain "i'" where ii'eql: "i*i' = l" by blast
  1999   have "(i * x + r \<le> 0) = (- (l div i) * (i * x + r) \<le> - (l div i) * 0)"
  2000     by (rule zmult_zle_mono_eq[OF mldivipos, where i="i*x + r" and j="0"])
  2001   also
  2002   have "(- (l div i) * (i * x + r) \<le> - (l div i) * 0) = (-((l div i) * i) * x \<le> (l div i)*r)"
  2003     by (simp add: mult_ac)
  2004   also have " (-((l div i) * i) * x \<le> (l div i)*r) = (- (l*x) \<le> (l div i)*r)"
  2005     using sym[OF ii'eql] inz
  2006     by (simp add: zmult_ac)
  2007   finally  
  2008   show ?thesis
  2009     by simp
  2010 qed
  2011 
  2012 (* FIXME : Move this theorem above, it simplifies the 2 theorems above : adjustcoeff_le_corr1,2 *)
  2013 lemma dvd_div_pos: 
  2014   assumes bpos: "0 < (b::int)"
  2015   and anz: "a\<noteq>0"
  2016   and dvd: "a dvd b"
  2017   shows "(b div a)*a = b"
  2018 proof-
  2019   from anz have "0 < a \<or> a < 0" by arith
  2020   moreover
  2021   {
  2022     assume apos: "0 < a" 
  2023     from bpos apos have aleb: "a\<le>b" by (simp add: zdvd_imp_le [OF dvd bpos])
  2024     have "a div a\<le> b div a"
  2025       by (simp add: zdiv_mono1[OF aleb apos])
  2026     then have bdivapos:"0 < b div a" 
  2027       by (simp add: zdiv_self[OF anz])
  2028     
  2029     from dvd have "\<exists>a'. a*a' = b" by (auto simp add: dvd_def)
  2030     then obtain "a'" where aa'eqb: "a*a' = b" by blast
  2031     then have ?thesis  using anz sym[OF aa'eqb] by simp
  2032     
  2033   }
  2034   moreover
  2035   {
  2036     assume aneg: "a < 0"
  2037     from dvd have midvdb: "-a dvd b" by simp
  2038     from aneg have mapos: "0 < -a" by simp
  2039     from bpos aneg have maleb: "-a\<le>b" by (simp add: zdvd_imp_le [OF midvdb bpos])
  2040     from aneg have anz: "a \<noteq> 0" by simp
  2041     have "b div a\<le> -a div a"
  2042       by (simp add: zdiv_mono1_neg[OF maleb aneg])
  2043     then have "b div a \<le> -1" 
  2044       apply (simp add: zdiv_zminus1_eq_if[OF anz, where a="a"])
  2045       by (simp add: zdiv_self[OF anz])
  2046     then have bdivaneg: "b div a < 0" by simp
  2047     then have mbdivapos: "0 < - (b div a)" by simp
  2048     
  2049     from dvd have "\<exists>a'. a*a' = b" by (auto simp add: dvd_def)
  2050     then obtain "a'" where aa'eqb: "a*a' = b" by blast
  2051     then have ?thesis using anz sym[OF aa'eqb] by (simp)
  2052   }
  2053   ultimately show ?thesis by blast
  2054 qed
  2055 
  2056 lemma adjustcoeff_eq_corr: 
  2057   assumes lpos: "(0::int) < l"
  2058   and inz: "i \<noteq> 0"
  2059   and dvd: "i dvd l"
  2060   shows "(i*x + r = 0) = (l*x + ((l div i)*r) = 0)"
  2061 proof-
  2062   have ldvdii: "(l div i)*i = l" by (rule dvd_div_pos[OF lpos inz dvd])
  2063   have ldivinz: "l div i \<noteq> 0" using inz ldvdii lpos by auto
  2064   have "(i*x + r = 0) = ((l div i)*(i*x + r) = (l div i)*0)"
  2065     using ldivinz by arith
  2066   also have "\<dots> = (((l div i)*i)*x + (l div i)*r = 0)"
  2067     by (simp add: zmult_ac)
  2068   finally show ?thesis using ldvdii by simp
  2069 qed
  2070 
  2071 
  2072 
  2073 (* Correctness theorem for adjustcoeff *)
  2074 lemma adjustcoeff_corr:
  2075   assumes linp: "islinform p"
  2076   and alldvd: "divideallc (l,p)"
  2077   and lpos: "0 < l"
  2078   shows "qinterp (a#ats) p = qinterp ((a*l)#ats) (adjustcoeff(l, p))"
  2079 using linp alldvd
  2080 proof (induct p rule: islinform.induct,simp_all)
  2081   case (goal1 t c)
  2082   from prems have cz: "c=0" by simp
  2083     then have ?case
  2084       using prems
  2085     proof(induct t rule: islinintterm.induct)
  2086       case (2 i n i') show ?case using prems
  2087 	proof-
  2088 	  from prems have "i\<noteq>0" by simp
  2089 	  then 
  2090 	  have "(n=0 \<and> i < 0) \<or> (n=0 \<and> i > 0) \<or> n\<noteq>0" by arith
  2091 	  moreover 
  2092 	  {
  2093 	    assume "n\<noteq>0" then have ?thesis 
  2094 	      by (simp add: nth_pos2 adjustcoeff_lenpos)
  2095 	  }
  2096 	  moreover
  2097 	  {
  2098 	    assume nz: "n=0"
  2099 	      and ipos: "0 < i"
  2100 	    from prems nz have idvdl: "i dvd l" by simp
  2101 	    have "(i*a + i' \<le> 0) = (l*a+ ((l div i)*i') \<le> 0)" 
  2102 	      by (rule adjustcoeff_le_corr[OF lpos ipos idvdl])
  2103 	    then 
  2104 	    have ?thesis using prems by (simp add: mult_ac)
  2105 	  }
  2106 	  moreover
  2107 	  {
  2108 	    assume nz: "n=0"
  2109 	      and ineg: "i < 0"
  2110 	    from prems nz have idvdl: "i dvd l" by simp
  2111 	    have "(i*a+i' \<le> 0) = (-l*a + (-(l div i) * i') \<le> 0)"
  2112 	      by (rule adjustcoeff_le_corr2[OF lpos ineg idvdl])
  2113 	    then 
  2114 	    have ?thesis using prems
  2115 	      by (simp add: zmult_ac)
  2116 	  }
  2117 	  ultimately show ?thesis by blast
  2118 	qed
  2119       next
  2120 	case (3 i n i' n' r) show ?case  using prems
  2121 	proof-
  2122 	  from prems 
  2123 	  have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2124 	    by simp
  2125 	  then
  2126 	  have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2127 	    by (simp add: islinintterm_eq_islint)
  2128 	  then have linr: "islintn(Suc n',r)"
  2129 	    by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2130 	  from lininrp have linr2: "islinintterm r"
  2131 	    by (simp add: islinintterm_subt[OF lininrp])
  2132 	  from prems have "n < n'" by simp
  2133 	  then have nppos: "0 < n'" by simp
  2134 	  from prems have "i\<noteq>0" by simp
  2135 	  then 
  2136 	  have "(n=0 \<and> i < 0) \<or> (n=0 \<and> i > 0) \<or> n\<noteq>0" by arith
  2137 	  moreover 
  2138 	  {
  2139 	    assume nnz: "n\<noteq>0"
  2140 	    from linr have ?thesis using nppos nnz intterm_novar0[OF lininrp] prems
  2141 	      apply (simp add: adjustcoeff_lenpos linterm_novar0[OF linr, where x="a" and y="a*l"])
  2142 	      by (simp add: nth_pos2)
  2143 	      
  2144 	  }
  2145 	  moreover
  2146 	  {
  2147 	    assume nz: "n=0"
  2148 	      and ipos: "0 < i"
  2149 	    from prems nz have idvdl: "i dvd l" by simp
  2150 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0) =
  2151 	      (l * a + l div i * (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0)"
  2152 	      by (rule adjustcoeff_le_corr[OF lpos ipos idvdl])
  2153 	    then 
  2154 	    have ?thesis using prems linr linr2
  2155 	      by (simp add: mult_ac nth_pos2 lin_mul_corr 
  2156 		linterm_novar0[OF linr, where x="a" and y="a*l"])
  2157 	  }
  2158 	  moreover
  2159 	  {
  2160 	    assume nz: "n=0"
  2161 	      and ineg: "i < 0"
  2162 	    from prems nz have idvdl: "i dvd l" by simp
  2163 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0) =
  2164 	      (- l * a + - (l div i) * (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0)"
  2165 	      by (rule adjustcoeff_le_corr2[OF lpos ineg idvdl, where  x="a" and r="(i'* (a#ats) ! n' + I_intterm (a#ats) r )"])
  2166 	    then 
  2167 	    have ?thesis using prems linr linr2
  2168 	      by (simp add: zmult_ac nth_pos2 lin_mul_corr 
  2169 		linterm_novar0[OF linr, where x="a" and y="a*l"] )
  2170 	  }
  2171 	  ultimately show ?thesis by blast
  2172 	qed	  
  2173     qed simp_all
  2174     then show ?case by simp 
  2175   
  2176 next
  2177   case (goal2 t c)
  2178   from prems have cz: "c=0" by simp
  2179     then have ?case
  2180       using prems
  2181     proof(induct t rule: islinintterm.induct)
  2182       case (2 i n i') show ?case using prems
  2183 	proof-
  2184 	  from prems have inz: "i\<noteq>0" by simp
  2185 	  then 
  2186 	  have "n=0 \<or> n\<noteq>0" by arith
  2187 	  moreover 
  2188 	  {
  2189 	    assume "n\<noteq>0" then have ?thesis 
  2190 	      by (simp add: nth_pos2 adjustcoeff_eqnpos)
  2191 	  }
  2192 	  moreover
  2193 	  {
  2194 	    assume nz: "n=0"
  2195 	    from prems nz have idvdl: "i dvd l" by simp
  2196 	    have "(i*a + i' = 0) = (l*a+ ((l div i)*i') = 0)" 
  2197 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2198 	    then 
  2199 	    have ?thesis using prems by (simp add: mult_ac)
  2200 	  }
  2201 	  ultimately show ?thesis by blast
  2202 	qed
  2203       next
  2204 	case (3 i n i' n' r) show ?case  using prems
  2205 	proof-
  2206 	  from prems 
  2207 	  have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2208 	    by simp
  2209 	  then
  2210 	  have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2211 	    by (simp add: islinintterm_eq_islint)
  2212 	  then have linr: "islintn(Suc n',r)"
  2213 	    by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2214 	  from lininrp have linr2: "islinintterm r"
  2215 	    by (simp add: islinintterm_subt[OF lininrp])
  2216 	  from prems have "n < n'" by simp
  2217 	  then have nppos: "0 < n'" by simp
  2218 	  from prems have "i\<noteq>0" by simp
  2219 	  then 
  2220 	  have "n=0 \<or> n\<noteq>0" by arith
  2221 	  moreover 
  2222 	  {
  2223 	    assume nnz: "n\<noteq>0"
  2224 	    from linr have ?thesis using nppos nnz intterm_novar0[OF lininrp] prems
  2225 	      apply (simp add: adjustcoeff_eqnpos linterm_novar0[OF linr, where x="a" and y="a*l"])
  2226 	      by (simp add: nth_pos2)
  2227 	      
  2228 	  }
  2229 	  moreover
  2230 	  {
  2231 	    assume nz: "n=0"
  2232 	    from prems have inz: "i \<noteq> 0" by auto
  2233 	    from prems nz have idvdl: "i dvd l" by simp
  2234 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0) =
  2235 	      (l * a + l div i * (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0)"
  2236 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2237 	    then 
  2238 	    have ?thesis using prems linr linr2
  2239 	      by (simp add: mult_ac nth_pos2 lin_mul_corr 
  2240 		linterm_novar0[OF linr, where x="a" and y="a*l"])
  2241 	  }
  2242 	  ultimately show ?thesis by blast
  2243 	qed	  
  2244     qed simp_all
  2245     then show ?case by simp 
  2246   
  2247 next
  2248   case (goal3 d t) show ?case
  2249     using prems
  2250     proof (induct t rule: islinintterm.induct)
  2251       case (2 i n i') 
  2252       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2253       moreover
  2254       {
  2255 	assume "\<exists>m. n = Suc m"
  2256 	then have ?case using prems  by auto
  2257       }
  2258       moreover 
  2259       {
  2260 	assume nz: "n=0"
  2261 	from prems have inz: "i\<noteq>0" by simp
  2262 	from prems have idvdl: "i dvd l" by simp
  2263 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2264 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2265 	  
  2266 	then have ?case using prems
  2267 	  apply simp
  2268 	  apply (simp add: 
  2269 	    ac_dvd_eq[OF ldivinz, where m="d" and c="i" and n="a" and t="i'"] 
  2270 	    ldiviieql)
  2271 	  by (simp add: zmult_commute)
  2272       }
  2273       ultimately show ?case by blast
  2274 
  2275     next 
  2276       case (3 i n i' n' r)
  2277       from prems 
  2278       have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2279 	by simp
  2280       then
  2281       have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2282 	by (simp add: islinintterm_eq_islint)
  2283       then have linr: "islintn(Suc n',r)"
  2284 	by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2285       from lininrp have linr2: "islinintterm r"
  2286 	by (simp add: islinintterm_subt[OF lininrp])
  2287       from prems have "n < n'" by simp
  2288       then have nppos: "0 < n'" by simp
  2289       from prems have inz: "i\<noteq>0" by simp
  2290       
  2291       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2292       moreover
  2293       {
  2294 	assume "\<exists>m. n = Suc m"
  2295 	then have npos: "0 < n" by arith
  2296 	have ?case using nppos intterm_novar0[OF lininrp] prems
  2297 	  apply (auto simp add: linterm_novar0[OF linr, where x="a" and y="a*l"])
  2298 	  by (simp_all add: nth_pos2)
  2299       }
  2300       moreover 
  2301       {
  2302 	assume nz: "n=0"
  2303 	from prems have idvdl: "i dvd l" by simp
  2304 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2305 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2306 	  
  2307 	then have ?case using prems linr2 linr
  2308 	  apply (simp add: nth_pos2 lin_mul_corr linterm_novar0)
  2309 	  
  2310 	  apply (simp add: ac_dvd_eq[OF ldivinz, where m="d" and c="i" and n="a" and t="(i' * ats ! (n' - Suc 0) + I_intterm (a # ats) r)"] ldiviieql)
  2311 	  by (simp add: zmult_ac linterm_novar0[OF linr, where x="a" and y="a*l"])
  2312       }
  2313       ultimately show ?case by blast
  2314       
  2315     qed simp_all
  2316 next
  2317   case (goal4 d t) show ?case
  2318     using prems
  2319     proof (induct t rule: islinintterm.induct)
  2320       case (2 i n i') 
  2321       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2322       moreover
  2323       {
  2324 	assume "\<exists>m. n = Suc m"
  2325 	then have ?case using prems  by auto
  2326       }
  2327       moreover 
  2328       {
  2329 	assume nz: "n=0"
  2330 	from prems have inz: "i\<noteq>0" by simp
  2331 	from prems have idvdl: "i dvd l" by simp
  2332 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2333 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2334 	  
  2335 	then have ?case using prems
  2336 	  apply simp
  2337 	  apply (simp add: 
  2338 	    ac_dvd_eq[OF ldivinz, where m="d" and c="i" and n="a" and t="i'"] 
  2339 	    ldiviieql)
  2340 	  by (simp add: zmult_commute)
  2341       }
  2342       ultimately show ?case by blast
  2343 
  2344     next 
  2345       case (3 i n i' n' r)
  2346       from prems 
  2347       have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2348 	by simp
  2349       then
  2350       have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2351 	by (simp add: islinintterm_eq_islint)
  2352       then have linr: "islintn(Suc n',r)"
  2353 	by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2354       from lininrp have linr2: "islinintterm r"
  2355 	by (simp add: islinintterm_subt[OF lininrp])
  2356       from prems have "n < n'" by simp
  2357       then have nppos: "0 < n'" by simp
  2358       from prems have inz: "i\<noteq>0" by simp
  2359       
  2360       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2361       moreover
  2362       {
  2363 	assume "\<exists>m. n = Suc m"
  2364 	then have npos: "0 < n" by arith
  2365 	have ?case using nppos intterm_novar0[OF lininrp] prems
  2366 	  apply (auto simp add: linterm_novar0[OF linr, where x="a" and y="a*l"])
  2367 	  by (simp_all add: nth_pos2)
  2368       }
  2369       moreover 
  2370       {
  2371 	assume nz: "n=0"
  2372 	from prems have idvdl: "i dvd l" by simp
  2373 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2374 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2375 	  
  2376 	then have ?case using prems linr2 linr
  2377 	  apply (simp add: nth_pos2 lin_mul_corr linterm_novar0)
  2378 	  
  2379 	  apply (simp add: ac_dvd_eq[OF ldivinz, where m="d" and c="i" and n="a" and t="(i' * ats ! (n' - Suc 0) + I_intterm (a # ats) r)"] ldiviieql)
  2380 	  by (simp add: zmult_ac linterm_novar0[OF linr, where x="a" and y="a*l"])
  2381       }
  2382       ultimately show ?case by blast
  2383       
  2384     qed simp_all
  2385 next
  2386     case (goal5 t c)
  2387   from prems have cz: "c=0" by simp
  2388     then have ?case
  2389       using prems
  2390     proof(induct t rule: islinintterm.induct)
  2391       case (2 i n i') show ?case using prems
  2392 	proof-
  2393 	  from prems have inz: "i\<noteq>0" by simp
  2394 	  then 
  2395 	  have "n=0 \<or> n\<noteq>0" by arith
  2396 	  moreover 
  2397 	  {
  2398 	    assume "n\<noteq>0" then have ?thesis
  2399 	      using prems
  2400 	      by (cases n, simp_all)
  2401 	  }
  2402 	  moreover
  2403 	  {
  2404 	    assume nz: "n=0"
  2405 	    from prems nz have idvdl: "i dvd l" by simp
  2406 	    have "(i*a + i' = 0) = (l*a+ ((l div i)*i') = 0)" 
  2407 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2408 	    then 
  2409 	    have ?thesis using prems by (simp add: mult_ac)
  2410 	  }
  2411 	  ultimately show ?thesis by blast
  2412 	qed
  2413       next
  2414 	case (3 i n i' n' r) show ?case  using prems
  2415 	proof-
  2416 	  from prems 
  2417 	  have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2418 	    by simp
  2419 	  then
  2420 	  have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2421 	    by (simp add: islinintterm_eq_islint)
  2422 	  then have linr: "islintn(Suc n',r)"
  2423 	    by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2424 	  from lininrp have linr2: "islinintterm r"
  2425 	    by (simp add: islinintterm_subt[OF lininrp])
  2426 	  from prems have "n < n'" by simp
  2427 	  then have nppos: "0 < n'" by simp
  2428 	  from prems have "i\<noteq>0" by simp
  2429 	  then 
  2430 	  have "n=0 \<or> n\<noteq>0" by arith
  2431 	  moreover 
  2432 	  {
  2433 	    assume nnz: "n\<noteq>0"
  2434 	    then have ?thesis using prems linr nppos nnz intterm_novar0[OF lininrp]
  2435 	      by (cases n, simp_all)
  2436 	    (simp add: nth_pos2 linterm_novar0[OF linr, where x="a" and y="a*l"])
  2437 	  }
  2438 	  moreover
  2439 	  {
  2440 	    assume nz: "n=0"
  2441 	    from prems have inz: "i \<noteq> 0" by auto
  2442 	    from prems nz have idvdl: "i dvd l" by simp
  2443 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0) =
  2444 	      (l * a + l div i * (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0)"
  2445 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2446 	    then 
  2447 	    have ?thesis using prems linr linr2
  2448 	      by (simp add: mult_ac nth_pos2 lin_mul_corr 
  2449 		linterm_novar0[OF linr, where x="a" and y="a*l"])
  2450 	  }
  2451 	  ultimately show ?thesis by blast
  2452 	qed	  
  2453     qed simp_all
  2454     then show ?case by simp 
  2455   
  2456 qed
  2457 
  2458 (* unitycoeff preserves semantics *)
  2459 lemma unitycoeff_corr:
  2460   assumes linp: "islinform p"
  2461   shows "qinterp ats (QEx p) = qinterp ats (QEx (unitycoeff p))"
  2462 proof-
  2463   
  2464   have lpos: "0 < formlcm p" by (rule formlcm_pos[OF linp])
  2465   have dvd : "divideallc (formlcm p, p)" by (rule formlcm_divideallc[OF linp])
  2466   show ?thesis  using prems lpos dvd 
  2467   proof (simp add: unitycoeff_def Let_def,case_tac "formlcm p = 1",
  2468       simp_all add: adjustcoeff_corr)
  2469     show "(\<exists>x. qinterp (x * formlcm p # ats) (adjustcoeff (formlcm p, p))) =
  2470       (\<exists>x. formlcm p dvd x \<and>
  2471       qinterp (x # ats) (adjustcoeff (formlcm p, p)))"
  2472       (is "(\<exists>x. ?P(x* (formlcm p))) = (\<exists>x. formlcm p dvd x \<and> ?P x)")
  2473     proof-
  2474       have "(\<exists>x. ?P(x* (formlcm p))) = (\<exists>x. ?P((formlcm p)*x))"
  2475 	by (simp add: mult_commute)
  2476       also have "(\<exists>x. ?P((formlcm p)*x)) = (\<exists>x. (formlcm p dvd x) \<and> ?P x)"
  2477 	by (simp add: unity_coeff_ex[where P="?P"])
  2478       finally show ?thesis by simp
  2479     qed
  2480   qed
  2481 qed
  2482 
  2483 (* the resul of adjustcoeff is unified for all l with divideallc (l,p) *)
  2484 lemma adjustcoeff_unified: 
  2485   assumes linp: "islinform p"
  2486   and dvdc: "divideallc(l,p)"
  2487   and lpos: "l > 0"
  2488   shows "isunified (adjustcoeff(l, p))"
  2489   using linp dvdc lpos
  2490   proof(induct l p rule: adjustcoeff.induct,simp_all add: lin_mul_lintn islinintterm_eq_islint islint_def)
  2491     case (goal1 l d c r)
  2492     from prems have "c >0 \<or> c < 0" by auto
  2493     moreover {
  2494       assume cpos: "c > 0 "
  2495       from prems have lp: "l > 0" by simp
  2496       from prems have cdvdl: "c dvd l" by simp
  2497       have clel: "c \<le> l" by (rule zdvd_imp_le[OF cdvdl lp])
  2498       have "c div c \<le>  l div c" by (rule zdiv_mono1[OF clel cpos])
  2499       then have ?case using cpos by (simp add: zdiv_self)      
  2500     }
  2501     moreover {
  2502       assume cneg: "c < 0"
  2503       
  2504      have mcpos: "-c > 0" by simp
  2505       then have mcnz: "-c \<noteq> 0" by simp
  2506       from prems have mcdvdl: "-c dvd l" 
  2507 	by simp 
  2508       then have l1:"l mod -c = 0" by (simp add: zdvd_iff_zmod_eq_0)
  2509       from prems have lp: "l >0" by simp
  2510       have mclel: "-c \<le> l" by (rule zdvd_imp_le[OF mcdvdl lp])
  2511       have "l div c = (-l div -c)"  by simp
  2512       also have "\<dots> = - (l div -c)" using l1
  2513 	by (simp only: zdiv_zminus1_eq_if[OF mcnz, where a="l"]) simp
  2514       finally have diveq: "l div c = - (l div -c)" by simp
  2515       
  2516       have "-c div -c \<le> l div -c" by (rule zdiv_mono1[OF mclel mcpos])
  2517       then have "0 < l div -c" using cneg
  2518 	by (simp add: zdiv_self)
  2519       then have ?case using diveq by simp
  2520     }
  2521     ultimately  show ?case by blast
  2522   next
  2523     case (goal2 l p)    from prems have "c >0 \<or> c < 0" by auto
  2524     moreover {
  2525       assume cpos: "c > 0 "
  2526       from prems have lp: "l > 0" by simp
  2527       from prems have cdvdl: "c dvd l" by simp
  2528       have clel: "c \<le> l" by (rule zdvd_imp_le[OF cdvdl lp])
  2529       have "c div c \<le>  l div c" by (rule zdiv_mono1[OF clel cpos])
  2530       then have ?case using cpos by (simp add: zdiv_self)      
  2531     }
  2532     moreover {
  2533       assume cneg: "c < 0"
  2534       
  2535      have mcpos: "-c > 0" by simp
  2536       then have mcnz: "-c \<noteq> 0" by simp
  2537       from prems have mcdvdl: "-c dvd l" 
  2538 	by simp 
  2539       then have l1:"l mod -c = 0" by (simp add: zdvd_iff_zmod_eq_0)
  2540       from prems have lp: "l >0" by simp
  2541       have mclel: "-c \<le> l" by (rule zdvd_imp_le[OF mcdvdl lp])
  2542       have "l div c = (-l div -c)"  by simp
  2543       also have "\<dots> = - (l div -c)" using l1
  2544 	by (simp only: zdiv_zminus1_eq_if[OF mcnz, where a="l"]) simp
  2545       finally have diveq: "l div c = - (l div -c)" by simp
  2546       
  2547       have "-c div -c \<le> l div -c" by (rule zdiv_mono1[OF mclel mcpos])
  2548       then have "0 < l div -c" using cneg
  2549 	by (simp add: zdiv_self)
  2550       then have ?case using diveq by simp
  2551     }
  2552     ultimately  show ?case by blast
  2553   qed
  2554 
  2555 lemma adjustcoeff_lcm_unified:
  2556   assumes linp: "islinform p"
  2557   shows "isunified (adjustcoeff(formlcm p, p))"
  2558 using linp adjustcoeff_unified formlcm_pos formlcm_divideallc
  2559 by simp
  2560 
  2561 (* the result of unitycoeff is unified *)
  2562 lemma unitycoeff_unified:
  2563   assumes linp: "islinform p"
  2564   shows "isunified (unitycoeff p)"
  2565 using linp formlcm_pos[OF linp]
  2566 proof (auto simp add: unitycoeff_def Let_def adjustcoeff_lcm_unified)
  2567   assume f1: "formlcm p = 1"
  2568   have "isunified (adjustcoeff(formlcm p, p))" 
  2569     by (rule adjustcoeff_lcm_unified[OF linp])
  2570   with f1 
  2571   show "isunified (adjustcoeff(1,p))" by simp
  2572 qed
  2573 
  2574 lemma unified_isnnf: 
  2575   assumes unifp: "isunified p"
  2576   shows "isnnf p"
  2577   using unified_islinform[OF unifp] linform_isnnf
  2578   by simp
  2579 
  2580 lemma unified_isqfree: "isunified p\<Longrightarrow> isqfree p"
  2581 using unified_islinform linform_isqfree
  2582 by auto
  2583 
  2584 (* Plus/Minus infinity , B and A set definitions *)
  2585 
  2586 consts minusinf :: "QF \<Rightarrow> QF"
  2587        plusinf  :: "QF \<Rightarrow> QF"
  2588        aset     :: "QF \<Rightarrow> intterm list"
  2589        bset     :: "QF \<Rightarrow> intterm list"
  2590 
  2591 recdef minusinf "measure size"
  2592 "minusinf (Le (Add (Mult (Cst c) (Var 0)) r) z) =
  2593   (if c < 0 then F else T)"
  2594 "minusinf (Eq (Add (Mult (Cst c) (Var 0)) r) z) = F"
  2595 "minusinf (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) = T"
  2596 "minusinf (And p q) = And (minusinf p) (minusinf q)"
  2597 "minusinf (Or p q) = Or (minusinf p) (minusinf q)"
  2598 "minusinf p = p"
  2599 
  2600 recdef plusinf "measure size"
  2601 "plusinf (Le (Add (Mult (Cst c) (Var 0)) r) z) =
  2602   (if c < 0 then T else F)"
  2603 "plusinf (Eq (Add (Mult (Cst c) (Var 0)) r) z) = F"
  2604 "plusinf (NOT (Eq (Add (Mult (Cst c) (Var 0)) r) z)) = T"
  2605 "plusinf (And p q) = And (plusinf p) (plusinf q)"
  2606 "plusinf (Or p q) = Or (plusinf p) (plusinf q)"
  2607 "plusinf p = p"
  2608 
  2609 recdef bset "measure size"
  2610 "bset (Le (Add (Mult (Cst c) (Var 0)) r) z) = 
  2611  (if c < 0 then [lin_add(r,(Cst -1)), r]
  2612          else [lin_add(lin_neg r,(Cst -1))])"
  2613 "bset (Eq (Add (Mult (Cst c) (Var 0)) r) z) =  
  2614   (if c < 0 then [lin_add(r,(Cst -1))]
  2615          else [lin_add(lin_neg r,(Cst -1))])"
  2616 "bset (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) =  
  2617   (if c < 0 then [r]
  2618          else [lin_neg r])"
  2619 "bset (And p q) = (bset p) @ (bset q)"
  2620 "bset (Or p q) = (bset p) @ (bset q)"
  2621 "bset p = []"
  2622 
  2623 recdef aset "measure size"
  2624 "aset (Le (Add (Mult (Cst c) (Var 0)) r) z) = 
  2625   (if c < 0 then [lin_add (r, Cst 1)]
  2626          else [lin_add (lin_neg r, Cst 1), lin_neg r])"
  2627 "aset (Eq (Add (Mult (Cst c) (Var 0)) r) z) = 
  2628   (if c < 0 then [lin_add(r,(Cst 1))]
  2629        else [lin_add(lin_neg r,(Cst 1))])"
  2630 "aset (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) = 
  2631   (if c < 0 then [r] 
  2632       else [lin_neg r])"
  2633 "aset (And p q) = (aset p) @ (aset q)"
  2634 "aset (Or p q) = (aset p) @ (aset q)"
  2635 "aset p = []"
  2636 
  2637 (* divlcm computes \<delta> = lcm d , where d | x +t occurs in p *)
  2638 consts divlcm :: "QF \<Rightarrow> int"
  2639 recdef divlcm "measure size"
  2640 "divlcm (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = (abs d)"
  2641 "divlcm (NOT p) = divlcm p"
  2642 "divlcm (And p q)= ilcm (divlcm p) (divlcm q)"
  2643 "divlcm (Or p q) = ilcm (divlcm p) (divlcm q)"
  2644 "divlcm p = 1"
  2645 
  2646 (* the preoperty of \<delta> *)
  2647 consts alldivide :: "int \<times> QF \<Rightarrow> bool"
  2648 recdef alldivide "measure (%(d,p). size p)"
  2649 "alldivide (d,(Divides (Cst d') (Add (Mult (Cst c) (Var 0)) r))) = 
  2650   (d' dvd d)"
  2651 "alldivide (d,(NOT p)) = alldivide (d,p)"
  2652 "alldivide (d,(And p q)) = (alldivide (d,p) \<and> alldivide (d,q))"
  2653 "alldivide (d,(Or p q)) = ((alldivide (d,p)) \<and> (alldivide (d,q)))"
  2654 "alldivide (d,p) = True"
  2655 
  2656 (* alldivide is monotone *)
  2657 lemma alldivide_mono: "\<And> d'. \<lbrakk> alldivide (d,p) ; d dvd d'\<rbrakk> \<Longrightarrow> alldivide (d',p)"
  2658 proof(induct d p rule: alldivide.induct, simp_all add: ilcm_dvd1 ilcm_dvd2)
  2659   fix "d1" "d2" "d3"
  2660   assume th1:"d2 dvd (d1::int)"
  2661     and th2: "d1 dvd d3"
  2662   show "d2 dvd d3" by (rule zdvd_trans[OF th1 th2])
  2663 qed
  2664 
  2665 (* Some simple lemmas *)
  2666 lemma zdvd_eq_zdvd_abs: " (d::int) dvd d' = (d dvd (abs d')) "
  2667 proof-
  2668   have "d' < 0 \<or> d' \<ge> 0" by arith
  2669   moreover
  2670   {
  2671     assume dn': "d' < 0"
  2672     then have "abs d' = - d'" by simp
  2673     then 
  2674     have ?thesis by (simp)
  2675   }
  2676   moreover 
  2677   {
  2678     assume dp': "d' \<ge> 0"
  2679     then have "abs d' = d'" by simp
  2680     then have ?thesis  by simp
  2681   }
  2682     ultimately show ?thesis by blast
  2683 qed
  2684 
  2685 lemma zdvd_refl_abs: "(d::int) dvd (abs d)"
  2686 proof-
  2687   have "d dvd d" by simp
  2688   then show ?thesis by (simp add: iffD1 [OF zdvd_eq_zdvd_abs [where d = "d" and d'="d"]])
  2689 qed
  2690 
  2691 (* \<delta> > 0*)
  2692 lemma divlcm_pos: 
  2693   assumes 
  2694   linp: "islinform p"
  2695   shows "0 < divlcm p"
  2696 using linp
  2697 proof (induct p rule: divlcm.induct,simp_all add: ilcm_pos)
  2698   case (goal1 f) show ?case 
  2699     using prems 
  2700     by (cases f, auto) (case_tac "intterm1", auto)
  2701 qed
  2702 
  2703 lemma nz_le: "(x::int) > 0 \<Longrightarrow> x \<noteq> 0" by auto
  2704 (* divlcm is correct *)
  2705 lemma divlcm_corr:
  2706   assumes 
  2707   linp: "islinform p"
  2708   shows "alldivide (divlcm p,p)"
  2709   using linp divlcm_pos
  2710 proof (induct p rule: divlcm.induct,simp_all add: zdvd_refl_abs,clarsimp simp add: Nat.gr0_conv_Suc)
  2711   case (goal1 f)
  2712   have "islinform f" using prems  
  2713     by (cases f, auto) (case_tac "intterm2", auto,case_tac "intterm1", auto)
  2714   then have "alldivide (divlcm f, f)"  using prems by simp
  2715   moreover have "divlcm (NOT f) = divlcm f" by simp
  2716   moreover have "alldivide (x,f) = alldivide (x,NOT f)" by simp
  2717   ultimately show ?case by simp
  2718 next
  2719   case (goal2 f g)
  2720   have dvd1: "(divlcm f) dvd (ilcm (divlcm f) (divlcm g))" 
  2721     using prems by(simp add: ilcm_dvd1 nz_le)
  2722   have dvd2: "(divlcm g) dvd (ilcm (divlcm f) (divlcm g))" 
  2723     using prems by (simp add: ilcm_dvd2 nz_le)
  2724   from dvd1 prems 
  2725   have "alldivide (ilcm (divlcm f) (divlcm g), f)" 
  2726     by (simp add: alldivide_mono[where d= "divlcm f" and p="f" and d' ="ilcm (divlcm f) (divlcm g)"])
  2727   moreover   from dvd2 prems 
  2728    have "alldivide (ilcm (divlcm f) (divlcm g), g)" 
  2729     by (simp add: alldivide_mono[where d= "divlcm g" and p="g" and d' ="ilcm (divlcm f) (divlcm g)"])
  2730   ultimately show ?case by simp
  2731 next
  2732   case (goal3 f g)
  2733   have dvd1: "(divlcm f) dvd (ilcm (divlcm f) (divlcm g))" 
  2734     using prems by (simp add: nz_le ilcm_dvd1)
  2735   have dvd2: "(divlcm g) dvd (ilcm (divlcm f) (divlcm g))" 
  2736     using prems by (simp add: nz_le ilcm_dvd2)
  2737   from dvd1 prems 
  2738   have "alldivide (ilcm (divlcm f) (divlcm g), f)" 
  2739     by (simp add: alldivide_mono[where d= "divlcm f" and p="f" and d' ="ilcm (divlcm f) (divlcm g)"])
  2740   moreover   from dvd2 prems 
  2741    have "alldivide (ilcm (divlcm f) (divlcm g), g)" 
  2742     by (simp add: alldivide_mono[where d= "divlcm g" and p="g" and d' ="ilcm (divlcm f) (divlcm g)"])
  2743   ultimately show ?case by simp
  2744 qed
  2745 
  2746 
  2747 (* Properties of  minusinf and plusinf*)
  2748 
  2749 (* minusinf p and p are the same for minusinfity \<dots> *)
  2750 lemma minusinf_eq: 
  2751   assumes unifp: "isunified p" 
  2752   shows "\<exists> z. \<forall> x. x < z \<longrightarrow> (qinterp (x#ats) p = qinterp (x#ats) (minusinf p))"
  2753 using unifp unified_islinform[OF unifp]
  2754 proof (induct p rule: minusinf.induct)
  2755   case (1 c r z)
  2756   have "c <0 \<or> 0 \<le> c" by arith
  2757   moreover 
  2758   {
  2759     assume cneg: " c < 0"
  2760     from prems have z0: "z= Cst 0" 
  2761       by (cases z,auto)
  2762     with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2763       by simp
  2764 
  2765     from prems z0 have ?case 
  2766       proof-
  2767 	show ?thesis
  2768 	  using prems z0
  2769       apply auto
  2770       apply (rule exI[where x="I_intterm (a # ats) r"])
  2771       apply (rule allI)
  2772       proof-
  2773 	fix x
  2774 	show "x < I_intterm (a # ats) r \<longrightarrow> \<not> - x + I_intterm (x # ats) r \<le> 0"
  2775 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2776       qed
  2777     qed
  2778   }
  2779   moreover
  2780   {
  2781     assume cpos: "0 \<le> c"
  2782     from prems have z0: "z= Cst 0" 
  2783       by (cases z) auto
  2784     with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2785       by simp
  2786     
  2787     from prems z0 have ?case
  2788       proof-
  2789 	show ?thesis
  2790 	  using prems z0
  2791       apply auto
  2792       apply (rule exI[where x="-(I_intterm (a # ats) r)"])
  2793       apply (rule allI)
  2794       proof-
  2795 	fix x
  2796 	show "x < - I_intterm (a # ats) r \<longrightarrow> x + I_intterm (x # ats) r \<le> 0"
  2797 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2798       qed
  2799     qed
  2800   }
  2801     
  2802     ultimately show ?case by blast
  2803 next
  2804   case (2 c r z)
  2805   from prems have z0: "z= Cst 0" 
  2806     by (cases z,auto)
  2807   with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2808     by simp
  2809   have "c <0 \<or> 0 \<le> c" by arith
  2810   moreover 
  2811   {
  2812     assume cneg: " c < 0"
  2813     from prems z0 have ?case 
  2814       proof-
  2815 	show ?thesis
  2816 	  using prems z0
  2817       apply auto
  2818       apply (rule exI[where x="I_intterm (a # ats) r"])
  2819       apply (rule allI)
  2820       proof-
  2821 	fix x
  2822 	show "x < I_intterm (a # ats) r \<longrightarrow> \<not> - x + I_intterm (x # ats) r = 0"
  2823 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2824       qed
  2825     qed
  2826   }
  2827   moreover
  2828   {
  2829     assume cpos: "0 \<le> c"
  2830     from prems z0 have ?case
  2831       proof-
  2832 	show ?thesis
  2833 	  using prems z0
  2834       apply auto
  2835       apply (rule exI[where x="-(I_intterm (a # ats) r)"])
  2836       apply (rule allI)
  2837       proof-
  2838 	fix x
  2839 	show "x < - I_intterm (a # ats) r \<longrightarrow> x + I_intterm (x # ats) r \<noteq> 0"
  2840 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2841       qed
  2842     qed
  2843   }
  2844     
  2845     ultimately show ?case by blast
  2846 next
  2847   case (3 c r z)
  2848   from prems have z0: "z= Cst 0" 
  2849     by (cases z,auto)
  2850   with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2851     by simp
  2852   have "c <0 \<or> 0 \<le> c" by arith
  2853   moreover 
  2854   {
  2855     assume cneg: " c < 0"
  2856     from prems z0 have ?case 
  2857       proof-
  2858 	show ?thesis
  2859 	  using prems z0
  2860       apply auto
  2861       apply (rule exI[where x="I_intterm (a # ats) r"])
  2862       apply (rule allI)
  2863       proof-
  2864 	fix x
  2865 	show "x < I_intterm (a # ats) r \<longrightarrow> \<not> - x + I_intterm (x # ats) r = 0"
  2866 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2867       qed
  2868     qed
  2869   }
  2870   moreover
  2871   {
  2872     assume cpos: "0 \<le> c"
  2873     from prems z0 have ?case
  2874       proof-
  2875 	show ?thesis
  2876 	  using prems z0
  2877       apply auto
  2878       apply (rule exI[where x="-(I_intterm (a # ats) r)"])
  2879       apply (rule allI)
  2880       proof-
  2881 	fix x
  2882 	show "x < - I_intterm (a # ats) r \<longrightarrow> x + I_intterm (x # ats) r \<noteq> 0"
  2883 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2884       qed
  2885     qed
  2886   }
  2887     
  2888     ultimately show ?case by blast
  2889 next
  2890   
  2891   case (4 f g) 
  2892   from prems obtain "zf" where 
  2893     zf:"\<forall>x<zf. qinterp (x # ats) f = qinterp (x # ats) (minusinf f)" by auto
  2894   from prems obtain "zg" where 
  2895     zg:"\<forall>x<zg. qinterp (x # ats) g = qinterp (x # ats) (minusinf g)" by auto
  2896   from zf zg show ?case 
  2897     apply auto
  2898     apply (rule exI[where x="min zf zg"])
  2899     by simp
  2900   
  2901 next case (5 f g)  
  2902   from prems obtain "zf" where 
  2903     zf:"\<forall>x<zf. qinterp (x # ats) f = qinterp (x # ats) (minusinf f)" by auto
  2904   from prems obtain "zg" where 
  2905     zg:"\<forall>x<zg. qinterp (x # ats) g = qinterp (x # ats) (minusinf g)" by auto
  2906   from zf zg show ?case 
  2907     apply auto
  2908     apply (rule exI[where x="min zf zg"])
  2909     by simp
  2910   
  2911 qed simp_all
  2912 
  2913 (* miusinf p behaves periodically*)
  2914 lemma minusinf_repeats: 
  2915   assumes alldvd: "alldivide (d,p)"
  2916   and unity: "isunified p"
  2917   shows "qinterp (x#ats) (minusinf p) = qinterp ((x + c*d)#ats) (minusinf p)"
  2918   using alldvd unity unified_islinform[OF unity]
  2919 proof(induct p rule: islinform.induct, simp_all)
  2920   case (goal1 t a)
  2921   show ?case
  2922     using prems
  2923     apply (cases t, simp_all add: nth_pos2)
  2924     apply (case_tac "intterm1", simp_all)
  2925     apply (case_tac "intterm1a",simp_all)
  2926     by (case_tac "intterm2a",simp_all)
  2927   (case_tac "nat",simp_all add: nth_pos2 intterm_novar0[where x="x" and y="x+c*d"])
  2928 next 
  2929   case (goal2 t a)
  2930   show ?case
  2931     using prems
  2932     apply (cases t, simp_all add: nth_pos2)
  2933     apply (case_tac "intterm1", simp_all)
  2934     apply (case_tac "intterm1a",simp_all)
  2935     by (case_tac "intterm2a",simp_all)
  2936   (case_tac "nat",simp_all add: nth_pos2 intterm_novar0[where x="x" and y="x+c*d"])
  2937 next 
  2938   case (goal3 a t)
  2939   show ?case using prems
  2940 
  2941   proof(induct t rule: islinintterm.induct, simp_all add: nth_pos2)
  2942     case (goal1 i n i')
  2943     show ?case
  2944       using prems
  2945     proof(cases n, simp_all, case_tac "i=1", simp,
  2946 	simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"])
  2947       case goal1
  2948       from prems have "(abs i = 1) \<and> i \<noteq> 1" by auto 
  2949       then  have im1: "i=-1" by arith
  2950       then have "(a dvd i*x + i') = (a dvd x + (-i'))" 
  2951 	by (simp add: uminus_dvd_conv'[where d="a" and t="-x +i'"])
  2952       moreover 
  2953       from im1 have "(a dvd i*x + (i*(c * d)) + i') = (a dvd (x + c*d - i'))"
  2954 	apply simp
  2955 	apply (simp add: uminus_dvd_conv'[where d="a" and t="-x - c * d + i'"])
  2956 	by (simp add: zadd_ac)
  2957       ultimately 
  2958       have eq1:"((a dvd i*x + i') = (a dvd i*x + (i*(c * d)) + i')) = 
  2959 	((a dvd x + (-i'))  = (a dvd (x + c*d - i')))" by simp
  2960       moreover 
  2961       have dvd2: "(a dvd x + (-i')) = (a dvd x + c * d + (-i'))"
  2962 	by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  2963       ultimately show ?case by simp
  2964     qed
  2965   next
  2966     case (goal2 i n i' n' r)
  2967     have "n = 0 \<or> 0 < n" by arith
  2968     moreover 
  2969     {
  2970       assume npos: "0 < n"
  2971       from prems have "n < n'" by simp then have "0 < n'" by simp
  2972       moreover from prems
  2973       have linr: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  2974       ultimately have ?case 
  2975 	using prems npos
  2976 	by (simp add: nth_pos2 intterm_novar0[OF linr,where x="x" and y="x + c*d"])
  2977     }
  2978     moreover 
  2979     {
  2980       assume n0: "n=0"
  2981       from prems have lin2: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  2982       from prems have "n < n'" by simp then have npos': "0 < n'" by simp
  2983       with prems have ?case
  2984       proof(simp add: intterm_novar0[OF lin2, where x="x" and y="x+c*d"] 
  2985 	  nth_pos2 dvd_period,case_tac "i=1",
  2986 	  simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"], simp)
  2987 	case goal1
  2988 	from prems have "abs i = 1 \<and> i\<noteq>1" by auto
  2989 	then have mi: "i = -1" by arith
  2990 	have "(a dvd -x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)) = 
  2991 	  (a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))" 
  2992 	  by (simp add: 
  2993 	    uminus_dvd_conv'[where d="a" and 
  2994 	    t="-x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)"])
  2995 	also 
  2996 	have "(a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  2997 	  (a dvd x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))"
  2998 	  by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  2999 	also 
  3000 	have "(a dvd x +c*d + 
  3001 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  3002 	  (a dvd -(x +c*d + 
  3003 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))"
  3004 	  by (rule uminus_dvd_conv'[where d="a" and 
  3005 	    t="x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)"])
  3006 	also
  3007 	have "(a dvd -(x +c*d + 
  3008 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))
  3009 	  = (a dvd
  3010           - x - c * d + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r))" 
  3011 	  by (auto,simp_all add: zadd_ac)
  3012 	finally show ?case using mi by auto
  3013       qed
  3014     }
  3015     ultimately show ?case by blast
  3016   qed
  3017 next 
  3018   case (goal4 a t)
  3019   show ?case using prems 
  3020   proof(induct t rule: islinintterm.induct, simp_all,case_tac "n=0",
  3021       simp_all add: nth_pos2)
  3022     case (goal1 i n i')
  3023     show ?case
  3024       using prems
  3025     proof(case_tac "i=1", simp,
  3026 	simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"])
  3027       case goal1
  3028       from prems have "abs i = 1 \<and> i\<noteq>1" by auto 
  3029       then have im1: "i=-1" by arith
  3030       then have "(a dvd i*x + i') = (a dvd x + (-i'))" 
  3031 	by (simp add: uminus_dvd_conv'[where d="a" and t="-x +i'"])
  3032       moreover 
  3033       from im1 have "(a dvd i*x + (i*(c * d)) + i') = (a dvd (x + c*d - i'))"
  3034 	apply simp
  3035 	apply (simp add: uminus_dvd_conv'[where d="a" and t="-x - c * d + i'"])
  3036 	by (simp add: zadd_ac)
  3037       ultimately 
  3038       have eq1:"((a dvd i*x + i') = (a dvd i*x + (i*(c * d)) + i')) = 
  3039 	((a dvd x + (-i'))  = (a dvd (x + c*d - i')))" by simp
  3040       moreover 
  3041       have dvd2: "(a dvd x + (-i')) = (a dvd x + c * d + (-i'))"
  3042 	by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  3043       ultimately show ?thesis by simp
  3044     qed
  3045   next
  3046     case (goal2 i n i' n' r)
  3047     have "n = 0 \<or> 0 < n" by arith
  3048     moreover 
  3049     {
  3050       assume npos: "0 < n"
  3051       from prems have "n < n'" by simp then have "0 < n'" by simp
  3052       moreover from prems
  3053       have linr: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  3054       ultimately have ?case 
  3055 	using prems npos
  3056 	by (simp add: nth_pos2 intterm_novar0[OF linr,where x="x" and y="x + c*d"])
  3057     }
  3058     moreover 
  3059     {
  3060       assume n0: "n=0"
  3061       from prems have lin2: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  3062       from prems have "n < n'" by simp then have npos': "0 < n'" by simp
  3063       with prems have ?case
  3064       proof(simp add: intterm_novar0[OF lin2, where x="x" and y="x+c*d"] 
  3065 	  nth_pos2 dvd_period,case_tac "i=1",
  3066 	  simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"], simp)
  3067 	case goal1
  3068 	from prems have "abs i = 1 \<and> i\<noteq>1" by auto
  3069 	then have mi: "i = -1" by arith
  3070 	have "(a dvd -x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)) = 
  3071 	  (a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))" 
  3072 	  by (simp add: 
  3073 	    uminus_dvd_conv'[where d="a" and 
  3074 	    t="-x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)"])
  3075 	also 
  3076 	have "(a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  3077 	  (a dvd x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))"
  3078 	  by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  3079 	also 
  3080 	have "(a dvd x +c*d + 
  3081 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  3082 	  (a dvd -(x +c*d + 
  3083 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))"
  3084 	  by (rule uminus_dvd_conv'[where d="a" and 
  3085 	    t="x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)"])
  3086 	also
  3087 	have "(a dvd -(x +c*d + 
  3088 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))
  3089 	  = (a dvd
  3090           - x - c * d + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r))" 
  3091 	  by (auto,simp_all add: zadd_ac)
  3092 	finally show ?case using mi by auto
  3093       qed
  3094     }
  3095     ultimately show ?case by blast
  3096   qed
  3097 next 
  3098   case (goal5 t a)
  3099   show ?case
  3100     using prems
  3101     apply (cases t, simp_all add: nth_pos2)
  3102     apply (case_tac "intterm1", simp_all)
  3103     apply (case_tac "intterm1a",simp_all)
  3104     by (case_tac "intterm2a",simp_all)
  3105   (case_tac "nat",simp_all add: nth_pos2 intterm_novar0[where x="x" and y="x+c*d"])
  3106 qed
  3107 
  3108 lemma minusinf_repeats2:
  3109   assumes alldvd: "alldivide (d,p)"
  3110   and unity: "isunified p"
  3111   shows "\<forall> x k. (qinterp (x#ats) (minusinf p) = qinterp ((x - k*d)#ats) (minusinf p))" 
  3112   (is "\<forall> x k. ?P x = ?P (x - k*d)")
  3113 proof(rule allI, rule allI)
  3114   fix x k
  3115   show "?P x = ?P (x - k*d)"
  3116   proof-
  3117     have "?P x = ?P (x + (-k)*d)" by (rule minusinf_repeats[OF alldvd unity])
  3118     then have "?P x = ?P (x - (k*d))" by simp
  3119     then show ?thesis by blast 
  3120   qed
  3121 qed
  3122 
  3123 
  3124 (* existence for minusinf p is existence for p *)
  3125 lemma minusinf_lemma:
  3126   assumes unifp: "isunified p"
  3127   and exminf: "\<exists> j \<in> {1 ..d}. qinterp (j#ats) (minusinf p)" (is "\<exists> j \<in> {1 .. d}. ?P1 j")
  3128   shows "\<exists> x. qinterp (x#ats) p" (is "\<exists> x. ?P x")
  3129 proof-
  3130   from exminf obtain "j" where P1j: "?P1 j" by blast
  3131   have ePeqP1: "\<exists>z. \<forall> x. x < z \<longrightarrow> (?P x = ?P1 x)"
  3132     by (rule minusinf_eq[OF unifp])
  3133   then obtain "z" where P1eqP : "\<forall> x. x < z \<longrightarrow> (?P x = ?P1 x)" by blast
  3134   let ?d = "divlcm p"
  3135   have alldvd: "alldivide (?d,p)" using unified_islinform[OF unifp] divlcm_corr
  3136     by auto
  3137   have dpos: "0 < ?d" using unified_islinform[OF unifp] divlcm_pos
  3138     by simp
  3139   have P1eqP1 : "\<forall> x k. ?P1 x = ?P1 (x - k*(?d))"
  3140     by (rule minusinf_repeats2[OF alldvd unifp])
  3141   let ?w = "j - (abs (j-z) +1)* ?d"
  3142   show "\<exists> x. ?P x"
  3143   proof
  3144     have w: "?w < z" 
  3145       by (rule decr_lemma[OF dpos])
  3146     
  3147     have "?P1 j = ?P1 ?w" using P1eqP1 by blast
  3148     also have "\<dots> = ?P ?w"  using w P1eqP by blast
  3149     finally show "?P ?w" using P1j by blast
  3150   qed
  3151 qed
  3152 
  3153 (* limited search for the withness for minusinf p, due to peridicity *)
  3154 lemma minusinf_disj:
  3155   assumes unifp: "isunified p"
  3156   shows "(\<exists> x. qinterp (x#ats) (minusinf p)) = 
  3157   (\<exists> j \<in> { 1.. divlcm p}. qinterp (j#ats) (minusinf p))" 
  3158   (is "(\<exists> x. ?P x) = (\<exists> j \<in> { 1.. ?d}. ?P j)")
  3159 proof
  3160   have linp: "islinform p" by (rule unified_islinform[OF unifp])
  3161   have dpos: "0 < ?d" by (rule divlcm_pos[OF linp])
  3162   have alldvd: "alldivide(?d,p)" by (rule divlcm_corr[OF linp])
  3163   {
  3164     assume "\<exists> j\<in> {1 .. ?d}. ?P j"
  3165     then show "\<exists> x. ?P x" using dpos  by auto
  3166   next
  3167     assume "\<exists> x. ?P x"
  3168     then obtain "x" where P: "?P x" by blast
  3169     have modd: "\<forall>x k. ?P x = ?P (x - k*?d)"
  3170       by (rule minusinf_repeats2[OF alldvd unifp])
  3171     
  3172     have "x mod ?d = x - (x div ?d)*?d"
  3173       by(simp add:zmod_zdiv_equality mult_ac eq_diff_eq)
  3174     hence Pmod: "?P x = ?P (x mod ?d)" using modd by simp
  3175     show "\<exists> j\<in> {1 .. ?d}. ?P j"
  3176     proof (cases)
  3177       assume "x mod ?d = 0"
  3178       hence "?P 0" using P Pmod by simp
  3179       moreover have "?P 0 = ?P (0 - (-1)*?d)" using modd by blast
  3180       ultimately have "?P ?d" by simp
  3181       moreover have "?d \<in> {1 .. ?d}" using dpos 
  3182 	by (simp add:atLeastAtMost_iff)
  3183       ultimately show "\<exists> j\<in> {1 .. ?d}. ?P j" ..
  3184     next 
  3185       assume not0: "x mod ?d \<noteq> 0"
  3186       have "?P(x mod ?d)" using dpos P Pmod by(simp add:pos_mod_sign pos_mod_bound)
  3187       moreover have "x mod ?d : {1 .. ?d}"
  3188       proof -
  3189 	have "0 \<le> x mod ?d" by(rule pos_mod_sign[OF dpos])
  3190 	moreover have "x mod ?d < ?d"  by(rule pos_mod_bound[OF dpos])
  3191 	ultimately show ?thesis using not0 by(simp add:atLeastAtMost_iff)
  3192       qed
  3193       ultimately show "\<exists> j\<in> {1 .. ?d}. ?P j" ..
  3194     qed
  3195   }
  3196 qed
  3197 
  3198 lemma minusinf_qfree:
  3199   assumes linp : "islinform p"
  3200   shows "isqfree (minusinf p)"
  3201   using linp
  3202  by (induct p rule: minusinf.induct) auto 
  3203 
  3204 (* Properties of bset and a set *)
  3205 
  3206 (* The elements of a bset are linear *) 
  3207 lemma bset_lin:
  3208   assumes unifp: "isunified p"
  3209   shows "\<forall> b \<in> set (bset p). islinintterm b"
  3210 using unifp unified_islinform[OF unifp]
  3211 proof (induct p rule: bset.induct, auto)
  3212   case (goal1 c r z)
  3213   from prems have "z = Cst 0" by (cases z, simp_all)
  3214   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3215   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3216   have "islinintterm (Cst -1)" by simp
  3217   then show ?case using linr lin_add_lin by simp
  3218 next 
  3219   case (goal2 c r z)
  3220   from prems have "z = Cst 0" by (cases z, simp_all)
  3221   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3222   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3223   show ?case by (rule linr)
  3224 next
  3225   case (goal3 c r z)
  3226   from prems have "z = Cst 0" by (cases z, simp_all) 
  3227   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3228   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3229   have "islinintterm (Cst -1)" by simp
  3230   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3231 next
  3232   case (goal4 c r z)
  3233   from prems have "z = Cst 0" by (cases z, simp_all) 
  3234   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3235   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3236   have "islinintterm (Cst -1)" by simp
  3237   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3238 next
  3239   case (goal5 c r z)
  3240   from prems have "z = Cst 0" by (cases z, simp_all) 
  3241   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3242   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3243   have "islinintterm (Cst -1)" by simp
  3244   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3245 next
  3246   case (goal6 c r z)
  3247   from prems have "z = Cst 0" by (cases z, simp_all) 
  3248   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3249   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3250   have "islinintterm (Cst -1)" by simp
  3251   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3252 next
  3253   case (goal7 c r z)
  3254   from prems have "z = Cst 0" by (cases z, simp_all) 
  3255   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3256   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3257   have "islinintterm (Cst -1)" by simp
  3258   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3259 qed
  3260 
  3261 (* The third lemma in Norrisch's Paper *)
  3262 lemma bset_disj_repeat:
  3263   assumes unifp: "isunified p"
  3264   and alldvd: "alldivide (d,p)"
  3265   and dpos: "0 < d"
  3266   and nob: "(qinterp (x#ats) q) \<and> \<not>(\<exists>j\<in> {1 .. d}. \<exists> b \<in> set (bset p). (qinterp (((I_intterm (a#ats) b) + j)#ats) q)) \<and>(qinterp (x#ats) p)" 
  3267   (is "?Q x \<and> \<not>(\<exists> j\<in> {1.. d}. \<exists> b\<in> ?B. ?Q (?I a b + j)) \<and> ?P x") 
  3268     shows "?P (x -d)"  
  3269   using unifp nob alldvd unified_islinform[OF unifp]
  3270 proof (induct p rule: islinform.induct,auto)
  3271   case (goal1 t)
  3272   from prems 
  3273   have lint: "islinintterm t" by simp
  3274   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3275     by (induct t rule: islinintterm.induct) auto
  3276   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3277   moreover
  3278   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3279     then obtain "i" "n" "r" where 
  3280       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3281       by blast
  3282     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3283       by simp
  3284     have linr: "islinintterm r" 
  3285       by (rule islinintterm_subt[OF lininr])
  3286     have "n=0 \<or> n>0" by arith
  3287     moreover {assume "n>0" then have ?case 
  3288 	using prems
  3289 	by (simp add: nth_pos2 
  3290 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3291     moreover 
  3292     {assume nz: "n = 0"
  3293       from prems have "abs i = 1" by auto 
  3294       then have "i = -1 \<or> i =1" by arith
  3295       moreover
  3296       {
  3297 	assume i1: "i=1"
  3298 	have ?case  using dpos prems  
  3299 	  by (auto simp add: intterm_novar0[OF lininr, where x="x" and y="x - d"])
  3300       }
  3301       moreover 
  3302       {
  3303 	assume im1: "i = -1"
  3304 	have ?case 
  3305 	  using prems 
  3306 	proof(auto simp add: intterm_novar0[OF lininr, where x="x - d" and y="x"], cases)
  3307 	  assume "- x + d +  ?I x r \<le> 0"
  3308 	  then show "- x + d + ?I x r \<le> 0" .
  3309 	next 
  3310 	  assume np: "\<not> - x + d +  ?I x r \<le> 0"
  3311 	  then have ltd:"x - ?I x r \<le> d - 1" by simp 
  3312 	  from prems have "-x + ?I x r \<le> 0" by simp
  3313 	  then have ge0: "x - ?I x r \<ge> 0" 
  3314 	    by simp
  3315 	  from ltd ge0 have "x - ?I x r = 0 \<or> (1 \<le> x - ?I x r \<and> x - ?I x r \<le> d - 1) " by arith
  3316 	  moreover
  3317 	  {
  3318 	    assume "x - ?I x r = 0"
  3319 	    then have xeqr: "x = ?I x r" by simp
  3320 	    from prems have "?Q x" by simp
  3321 	    with xeqr have qr:"?Q (?I x r)" by simp
  3322 	    from prems have lininr: "islinintterm (Add (Mult (Cst i) (Var 0)) r)" by simp
  3323 	    have "islinintterm r" by (rule islinintterm_subt[OF lininr])
  3324 	    from prems 
  3325 	    have "\<forall>j\<in>{1..d}. \<not> ?Q (?I a r + -1 + j)"
  3326 	      using linr by (auto simp add: lin_add_corr)
  3327 	    moreover from dpos have "1 \<in> {1..d}" by simp
  3328 	    ultimately have " \<not> ?Q (?I a r + -1 + 1)" by blast
  3329 	    with dpos linr have "\<not> ?Q (?I x r)"
  3330 	      by (simp add: intterm_novar0[OF lininr, where x="x" and y="a"] lin_add_corr)
  3331 	    with qr have "- x + d + ?I x r \<le> 0" by simp
  3332 	  }
  3333 	  moreover
  3334 	  {
  3335 	    assume gt0: "1 \<le> x - ?I x r \<and> x - ?I x r \<le> d - 1"
  3336 	    then have "\<exists> j\<in> {1 .. d - 1}. x - ?I x r =  j" by simp
  3337 	    then have "\<exists> j\<in> {1 .. d}. x - ?I x r =  j" by auto
  3338 	    then obtain  "j" where con: "1\<le>j \<and> j \<le> d  \<and> x - ?I x r = j" by auto
  3339 	    then have xeqr: "x = ?I x r + j" by auto
  3340 	    with prems have "?Q (?I x r + j)" by simp
  3341 	    with con have qrpj: "\<exists> j\<in> {1 .. d}. ?Q (?I x r + j)" by auto
  3342 	    from prems have "\<forall>j\<in>{1..d}. \<not> ?Q (?I a r + j)" by auto
  3343 	    then have "\<not> (\<exists> j\<in>{1..d}. ?Q (?I x r + j))" 
  3344 	      by (simp add: intterm_novar0[OF lininr, where x="x" and y="a"])
  3345 	    with qrpj prems have "- x + d + ?I x r \<le> 0" by simp 
  3346 	    
  3347 	  }
  3348 	  ultimately show "- x + d + ?I x r \<le> 0" by blast
  3349 	qed
  3350       }
  3351       ultimately have ?case by blast
  3352     }
  3353     ultimately have ?case by blast
  3354   }
  3355   ultimately show ?case by blast
  3356 next  
  3357   case (goal3 a t)
  3358   from prems 
  3359   have lint: "islinintterm t" by simp
  3360   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3361     by (induct t rule: islinintterm.induct) auto
  3362   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3363   moreover
  3364   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3365     then obtain "i" "n" "r" where 
  3366       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3367       by blast
  3368     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3369       by simp
  3370     have linr: "islinintterm r" 
  3371       by (rule islinintterm_subt[OF lininr])
  3372     have "n=0 \<or> n>0" by arith
  3373     moreover {assume "n>0" then have ?case using prems 
  3374 	by (simp add: nth_pos2 
  3375 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3376     moreover {
  3377       assume nz: "n=0"
  3378       from prems have "abs i = 1" by auto
  3379       then have ipm: "i=1 \<or> i = -1" by arith
  3380       from nz prems have advdixr: "a dvd (i * x) + I_intterm (x # ats) r" 
  3381 	by simp
  3382       from prems have "a dvd d" by simp
  3383       then have advdid: "a dvd i*d" using ipm by auto  
  3384       have ?case
  3385       using prems ipm 
  3386       by (auto simp add: intterm_novar0[OF lininr, where x="x-d" and y="x"] dvd_period[OF advdid, where x="i*x" and c="-1"])
  3387   }
  3388   ultimately have ?case by blast
  3389   } ultimately show ?case by blast
  3390 next
  3391 
  3392   case (goal4 a t)
  3393   from prems 
  3394   have lint: "islinintterm t" by simp
  3395   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3396     by (induct t rule: islinintterm.induct) auto
  3397   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3398   moreover
  3399   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3400     then obtain "i" "n" "r" where 
  3401       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3402       by blast
  3403     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3404       by simp
  3405     have linr: "islinintterm r" 
  3406       by (rule islinintterm_subt[OF lininr])
  3407 
  3408     have "n=0 \<or> n>0" by arith
  3409     moreover {assume "n>0" then have ?case using prems 
  3410 	by (simp add: nth_pos2 
  3411 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3412     moreover {
  3413       assume nz: "n=0"
  3414       from prems have "abs i = 1" by auto
  3415       then have ipm: "i =1 \<or> i = -1" by arith
  3416       from nz prems have advdixr: "\<not> (a dvd (i * x) + I_intterm (x # ats) r)" 
  3417 	by simp
  3418       from prems have "a dvd d" by simp
  3419       then have advdid: "a dvd i*d" using ipm by auto
  3420       have ?case
  3421       using prems ipm 
  3422       by (auto simp add: intterm_novar0[OF lininr, where x="x-d" and y="x"] dvd_period[OF advdid, where x="i*x" and c="-1"])
  3423   }
  3424   ultimately have ?case by blast
  3425   } ultimately show ?case by blast
  3426 next 
  3427   case (goal2 t)
  3428   from prems
  3429   have lint: "islinintterm t" by simp
  3430   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3431     by (induct t rule: islinintterm.induct) auto
  3432   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3433   moreover
  3434   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3435     then obtain "i" "n" "r" where 
  3436       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3437       by blast
  3438     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3439       by simp
  3440     have linr: "islinintterm r" 
  3441       by (rule islinintterm_subt[OF lininr])
  3442     have "n=0 \<or> n>0" by arith
  3443     moreover {assume "n>0" then have ?case 
  3444 	using prems
  3445 	by (simp add: nth_pos2 
  3446 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3447     moreover 
  3448     {assume nz: "n = 0"
  3449       from prems have "abs i = 1" by auto 
  3450       then have "i = -1 \<or> i =1" by arith
  3451       moreover
  3452       {
  3453 	assume i1: "i=1"
  3454 	with prems have px: "x + ?I x r = 0" by simp
  3455 	then have "x = (- ?I x r - 1) + 1" by simp
  3456 	hence q1: "?Q ((- ?I x r - 1) + 1)" by simp
  3457 	from prems have "\<not> (?Q ((?I a (lin_add(lin_neg r, Cst -1))) + 1))"
  3458 	  by auto
  3459 	hence "\<not> (?Q ((- ?I a r - 1) + 1))" 
  3460 	  using lin_add_corr lin_neg_corr linr lin_neg_lin
  3461 	  by simp
  3462 	hence "\<not> (?Q ((- ?I x r - 1) + 1))" 
  3463 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3464 	  by simp
  3465 	with q1 have  ?case by simp
  3466       }
  3467       moreover 
  3468       {
  3469 	assume im1: "i = -1"
  3470 	with prems have px: "-x + ?I x r = 0" by simp
  3471 	then have "x = ?I x r" by simp
  3472 	hence q1: "?Q (?I x r)" by simp
  3473 	from prems have "\<not> (?Q ((?I a (lin_add(r, Cst -1))) + 1))"
  3474 	  by auto
  3475 	hence "\<not> (?Q (?I a r))" 
  3476 	  using lin_add_corr lin_neg_corr linr lin_neg_lin
  3477 	  by simp
  3478 	hence "\<not> (?Q (?I x r ))" 
  3479 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3480 	  by simp
  3481 	with q1 have  ?case by simp
  3482       }
  3483       ultimately have ?case by blast
  3484     }
  3485     ultimately have ?case by blast
  3486   }
  3487   ultimately show ?case by blast
  3488 next
  3489   case (goal5 t)
  3490   from prems
  3491   have lint: "islinintterm t" by simp
  3492   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3493     by (induct t rule: islinintterm.induct) auto
  3494   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3495   moreover
  3496   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3497     then obtain "i" "n" "r" where 
  3498       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3499       by blast
  3500     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3501       by simp
  3502     have linr: "islinintterm r" 
  3503       by (rule islinintterm_subt[OF lininr])
  3504     have "n=0 \<or> n>0" by arith
  3505     moreover {assume "n>0" then have ?case 
  3506 	using prems
  3507 	by (simp add: nth_pos2 
  3508 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3509     moreover 
  3510     {assume nz: "n = 0"
  3511       from prems have "abs i = 1" by auto 
  3512       then have "i = -1 \<or> i =1" by arith
  3513       moreover
  3514       {
  3515 	assume i1: "i=1"
  3516 	with prems have px: "x -d + ?I (x-d) r = 0" by simp
  3517 	hence "x = (- ?I x r) + d" 
  3518 	  using intterm_novar0[OF lininr, where x="x" and y="x-d"]
  3519 	  by simp
  3520 	hence q1: "?Q (- ?I x r + d)" by simp
  3521 	from prems have "\<not> (?Q ((?I a (lin_neg r)) + d))"
  3522 	  by auto
  3523 	hence "\<not> (?Q (- ?I a r + d))" 
  3524 	  using lin_neg_corr linr by simp
  3525 	hence "\<not> (?Q ((- ?I x r + d)))" 
  3526 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3527 	  by simp
  3528 	with q1 have  ?case by simp
  3529       }
  3530       moreover 
  3531       {
  3532 	assume im1: "i = -1"
  3533 	with prems have px: "- (x -d) + ?I (x - d) r = 0" by simp
  3534 	then have "x = ?I x r + d "
  3535  	  using intterm_novar0[OF lininr, where x="x" and y="x-d"]
  3536 	  by simp
  3537 	hence q1: "?Q (?I x r + d)" by simp
  3538 	from prems have "\<not> (?Q ((?I a r) + d))"
  3539 	  by auto
  3540 	hence "\<not> (?Q (?I x r + d))" 
  3541 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3542 	  by simp
  3543 	with q1 have  ?case by simp
  3544       }
  3545       ultimately have ?case by blast
  3546     }
  3547     ultimately have ?case by blast
  3548   }
  3549   ultimately show ?case by blast
  3550   
  3551 qed
  3552   
  3553 lemma bset_disj_repeat2:
  3554   assumes unifp: "isunified p"
  3555 
  3556   shows "\<forall> x. \<not>(\<exists>j\<in> {1 .. (divlcm p)}. \<exists> b \<in> set (bset p). 
  3557   (qinterp (((I_intterm (a#ats) b) + j)#ats) p))  
  3558   \<longrightarrow> (qinterp (x#ats) p) \<longrightarrow> (qinterp ((x - (divlcm p))#ats) p)" 
  3559   (is "\<forall> x. \<not>(\<exists> j\<in> {1 .. ?d}. \<exists> b\<in> ?B. ?P (?I a b + j)) \<longrightarrow> ?P x \<longrightarrow> ?P (x - ?d)")
  3560 proof
  3561   fix x
  3562   have linp: "islinform p" by (rule unified_islinform[OF unifp])
  3563   have dpos: "?d > 0" by (rule divlcm_pos[OF linp])
  3564   have alldvd: "alldivide(?d,p)" by (rule divlcm_corr[OF linp])
  3565     show "\<not>(\<exists> j\<in> {1 .. ?d}. \<exists> b\<in> ?B. ?P (?I a b + j)) \<longrightarrow> ?P x \<longrightarrow> ?P (x - ?d)"
  3566     using prems bset_disj_repeat[OF unifp alldvd dpos]
  3567     by blast
  3568 qed
  3569 
  3570 (* Cooper's theorem in the minusinfinity version *)
  3571 lemma cooper_mi_eq: 
  3572   assumes unifp : "isunified p"
  3573   shows "(\<exists> x. qinterp (x#ats) p) = 
  3574   ((\<exists> j \<in> {1 .. (divlcm p)}. qinterp (j#ats) (minusinf p)) \<or> 
  3575   (\<exists> j \<in> {1 .. (divlcm p)}. \<exists> b \<in> set (bset p). 
  3576   qinterp (((I_intterm (a#ats) b) + j)#ats) p))"
  3577   (is "(\<exists> x. ?P x) = ((\<exists> j\<in> {1 .. ?d}. ?MP j) \<or> (\<exists> j \<in> ?D. \<exists> b\<in> ?B. ?P (?I a b + j)))")
  3578 proof-
  3579   have linp :"islinform p" by (rule unified_islinform[OF unifp])
  3580   have dpos: "?d > 0" by (rule divlcm_pos[OF linp])
  3581   have alldvd: "alldivide(?d,p)" by (rule divlcm_corr[OF linp])
  3582   have eMPimpeP: "(\<exists>j \<in> ?D. ?MP j) \<longrightarrow> (\<exists>x. ?P x)"
  3583     by (simp add: minusinf_lemma[OF unifp, where d="?d" and ats="ats"])
  3584   have ePimpeP: "(\<exists> j \<in> ?D. \<exists> b\<in> ?B. ?P (?I a b + j)) \<longrightarrow> (\<exists> x. ?P x)"
  3585     by blast
  3586   have bst_rep: "\<forall> x. \<not> (\<exists> j \<in> ?D. \<exists> b \<in> ?B. ?P (?I a b + j)) \<longrightarrow> ?P x \<longrightarrow> ?P (x - ?d)"
  3587     by (rule bset_disj_repeat2[OF unifp])
  3588   have MPrep: "\<forall> x k. ?MP x = ?MP (x- k*?d)"
  3589     by (rule minusinf_repeats2[OF alldvd unifp])
  3590   have MPeqP: "\<exists> z. \<forall>  x < z. ?P x = ?MP x"
  3591     by (rule minusinf_eq[OF unifp])
  3592   let ?B'= "{?I a b| b. b\<in> ?B}"
  3593   from bst_rep have bst_rep2: "\<forall>x. \<not> (\<exists>j\<in>?D. \<exists>b\<in> ?B'. ?P (b+j)) \<longrightarrow> ?P x \<longrightarrow> ?P (x - ?d)"
  3594     by auto
  3595   show ?thesis 
  3596   using cpmi_eq[OF dpos MPeqP bst_rep2 MPrep]
  3597   by auto
  3598 qed
  3599 
  3600 (* A formalized analogy between aset, bset, plusinfinity and minusinfinity *)
  3601 
  3602 consts mirror:: "QF \<Rightarrow> QF"
  3603 recdef mirror "measure size"
  3604 "mirror (Le (Add (Mult (Cst c) (Var 0)) r) z) =
  3605   (Le (Add (Mult (Cst (- c)) (Var 0)) r) z)"
  3606 "mirror (Eq (Add (Mult (Cst c) (Var 0)) r) z) =
  3607   (Eq (Add (Mult (Cst (- c)) (Var 0)) r) z)"
  3608 "mirror (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = 
  3609   (Divides (Cst d) (Add (Mult (Cst (- c)) (Var 0)) r))"
  3610 "mirror (NOT(Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r))) = 
  3611   (NOT(Divides (Cst d) (Add (Mult (Cst (- c)) (Var 0)) r)))"
  3612 "mirror (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) =
  3613   (NOT(Eq (Add (Mult (Cst (- c)) (Var 0)) r) z))"
  3614 "mirror (And p q) = And (mirror p) (mirror q)"
  3615 "mirror (Or p q) = Or (mirror p) (mirror q)"
  3616 "mirror p = p"
  3617 (* mirror preserves unifiedness *)
  3618 
  3619 lemma[simp]: "(abs (i::int) = 1) = (i =1 \<or> i = -1)"  by arith
  3620 lemma mirror_unified:
  3621   assumes unif: "isunified p"
  3622   shows "isunified (mirror p)"
  3623   using unif
  3624 proof (induct p rule: mirror.induct, simp_all)
  3625   case (goal1 c r z)
  3626   from prems have zz: "z = Cst 0" by (cases z, simp_all) 
  3627   then show ?case using prems 
  3628     by (auto simp add: islinintterm_eq_islint islint_def)
  3629 next 
  3630   case (goal2 c r z)
  3631   from prems have zz: "z = Cst 0" by (cases z, simp_all) 
  3632   then show ?case using prems 
  3633     by (auto simp add: islinintterm_eq_islint islint_def)
  3634 next
  3635   case (goal3 d c r) show ?case using prems by (auto simp add: islinintterm_eq_islint islint_def) 
  3636 next 
  3637   case (goal4 d c r) show ?case using prems  by (auto simp add: islinintterm_eq_islint islint_def)
  3638 next 
  3639  case (goal5 c r z)
  3640   from prems have zz: "z = Cst 0" by (cases z, simp_all) 
  3641   then show ?case using prems 
  3642     by (auto simp add: islinintterm_eq_islint islint_def)
  3643 qed
  3644 
  3645 (* relationship between plusinf and minusinf *)
  3646 lemma plusinf_eq_minusinf_mirror:
  3647   assumes unifp: "isunified p"
  3648   shows "(qinterp (x#ats) (plusinf p)) = (qinterp ((- x)#ats) (minusinf (mirror p)))"
  3649 using unifp unified_islinform[OF unifp]
  3650 proof (induct p rule: islinform.induct, simp_all)
  3651   case (goal1 t z)
  3652   from prems 
  3653   have lint: "islinintterm t" by simp
  3654   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3655     by (induct t rule: islinintterm.induct) auto
  3656   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3657   moreover
  3658   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3659     then obtain "i" "n" "r" where 
  3660       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3661       by blast
  3662     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3663       by simp
  3664     have linr: "islinintterm r" 
  3665       by (rule islinintterm_subt[OF lininr])
  3666     have ?case using prems 
  3667       by (cases n, auto simp add: nth_pos2 
  3668 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3669   ultimately show ?case by blast
  3670     
  3671 next
  3672   case (goal2 t z)
  3673   from prems 
  3674   have lint: "islinintterm t" by simp
  3675   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3676     by (induct t rule: islinintterm.induct) auto
  3677   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3678   moreover
  3679   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3680     then obtain "i" "n" "r" where 
  3681       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3682       by blast
  3683     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3684       by simp
  3685     have linr: "islinintterm r" 
  3686       by (rule islinintterm_subt[OF lininr])
  3687     have ?case using prems 
  3688       by (cases n, auto simp add: nth_pos2 
  3689 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3690   ultimately show ?case by blast
  3691 next
  3692   case (goal3 d t)
  3693   
  3694  from prems 
  3695   have lint: "islinintterm t" by simp
  3696   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3697     by (induct t rule: islinintterm.induct) auto
  3698   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3699   moreover
  3700   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3701     then obtain "i" "n" "r" where 
  3702       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3703       by blast
  3704     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3705       by simp
  3706     have linr: "islinintterm r" 
  3707       by (rule islinintterm_subt[OF lininr])
  3708 
  3709     have ?case using prems 
  3710       by (cases n, simp_all add: nth_pos2 
  3711 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3712   ultimately show ?case by blast
  3713 next
  3714 
  3715   case (goal4 d t)
  3716   
  3717  from prems 
  3718   have lint: "islinintterm t" by simp
  3719   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3720     by (induct t rule: islinintterm.induct) auto
  3721   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3722   moreover
  3723   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3724     then obtain "i" "n" "r" where 
  3725       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3726       by blast
  3727     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3728       by simp
  3729     have linr: "islinintterm r" 
  3730       by (rule islinintterm_subt[OF lininr])
  3731 
  3732     have ?case using prems 
  3733       by (cases n, simp_all add: nth_pos2 
  3734 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3735   ultimately show ?case by blast
  3736 next
  3737   case (goal5 t z)
  3738   from prems 
  3739   have lint: "islinintterm t" by simp
  3740   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3741     by (induct t rule: islinintterm.induct) auto
  3742   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3743   moreover
  3744   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3745     then obtain "i" "n" "r" where 
  3746       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3747       by blast
  3748     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3749       by simp
  3750     have linr: "islinintterm r" 
  3751       by (rule islinintterm_subt[OF lininr])
  3752     have ?case using prems 
  3753       by (cases n, auto simp add: nth_pos2 
  3754 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3755   ultimately show ?case by blast
  3756 qed
  3757 
  3758 (* relationship between aset abd bset *)
  3759 lemma aset_eq_bset_mirror: 
  3760   assumes unifp: "isunified p"
  3761   shows "set (aset p) = set (map lin_neg (bset (mirror p)))"
  3762 using unifp
  3763 proof(induct p rule: mirror.induct)
  3764   case (1 c r z) 
  3765   from prems have zz: "z = Cst 0"
  3766     by (cases z, auto)
  3767   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3768   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3769   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3770   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3771   show ?case  using prems linr zz apply (auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3772     by (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin)
  3773 next
  3774   case (2 c r z)   from prems have zz: "z = Cst 0"
  3775     by (cases z, auto)
  3776   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3777   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3778   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3779   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3780   show ?case  using prems linr zz
  3781     by (auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3782   (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin lin_neg_lin)
  3783 
  3784 next
  3785   case (5 c r z)  from prems have zz: "z = Cst 0"
  3786     by (cases z, auto)
  3787   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3788   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3789   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3790   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3791   show ?case  using prems linr zz
  3792     by(auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3793   
  3794 qed simp_all
  3795 
  3796 (* relationship between aset abd bset 2*)
  3797 lemma aset_eq_bset_mirror2: 
  3798   assumes unifp: "isunified p"
  3799   shows "aset p = map lin_neg (bset (mirror p))"
  3800 using unifp
  3801 proof(induct p rule: mirror.induct)
  3802   case (1 c r z) 
  3803   from prems have zz: "z = Cst 0"
  3804     by (cases z, auto)
  3805   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3806   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3807   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3808   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3809   show ?case  using prems linr zz
  3810     apply (simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3811     apply (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin)
  3812     by arith
  3813 next
  3814   case (2 c r z)   from prems have zz: "z = Cst 0"
  3815     by (cases z, auto)
  3816   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3817   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3818   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3819   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3820   show ?case  using prems linr zz
  3821     by(auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3822     (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin lin_neg_lin)
  3823 
  3824 next
  3825   case (5 c r z)  from prems have zz: "z = Cst 0"
  3826     by (cases z, auto)
  3827   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3828   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3829   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3830   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3831   show ?case  using prems linr zz
  3832     by(auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3833   
  3834 qed simp_all
  3835 
  3836 (* mirror preserves divlcm *)
  3837 lemma divlcm_mirror_eq:
  3838   assumes unifp: "isunified p"
  3839   shows "divlcm p = divlcm (mirror p)"
  3840   using unifp
  3841 by (induct p rule: mirror.induct) auto
  3842 
  3843 (* mirror almost preserves semantics *)  
  3844 lemma mirror_interp: 
  3845   assumes unifp: "isunified p"
  3846   shows "(qinterp (x#ats) p) = (qinterp ((- x)#ats) (mirror p))" (is "?P x = ?MP (-x)")
  3847 using unifp unified_islinform[OF unifp]
  3848 proof (induct p rule: islinform.induct)
  3849   case (1 t z)
  3850   from prems have zz: "z = 0" by simp
  3851   from prems 
  3852   have lint: "islinintterm t" by simp
  3853   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3854     by (induct t rule: islinintterm.induct) auto
  3855   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3856   moreover
  3857   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3858     then obtain "i" "n" "r" where 
  3859       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3860       by blast
  3861     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3862       by simp
  3863     have linr: "islinintterm r" 
  3864       by (rule islinintterm_subt[OF lininr])
  3865     have ?case using prems zz
  3866       by (cases n) (simp_all add: nth_pos2 
  3867 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3868   }
  3869   ultimately show ?case by blast
  3870 next
  3871   case (2 t z)
  3872   from prems have zz: "z = 0" by simp
  3873   from prems 
  3874   have lint: "islinintterm t" by simp
  3875   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3876     by (induct t rule: islinintterm.induct) auto
  3877   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3878   moreover
  3879   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3880     then obtain "i" "n" "r" where 
  3881       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3882       by blast
  3883     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3884       by simp
  3885     have linr: "islinintterm r" 
  3886       by (rule islinintterm_subt[OF lininr])
  3887     have ?case using prems zz
  3888       by (cases n) (simp_all add: nth_pos2 
  3889 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3890   }
  3891   ultimately show ?case by blast
  3892 next
  3893   case (3 d t) 
  3894   from prems 
  3895   have lint: "islinintterm t" by simp
  3896   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3897     by (induct t rule: islinintterm.induct) auto
  3898   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3899   moreover
  3900   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3901     then obtain "i" "n" "r" where 
  3902       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3903       by blast
  3904     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3905       by simp
  3906     have linr: "islinintterm r" 
  3907       by (rule islinintterm_subt[OF lininr])
  3908     have ?case
  3909       using prems linr 
  3910       by (cases n) (simp_all add: nth_pos2
  3911 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3912   }
  3913   ultimately show ?case by blast
  3914 next
  3915 
  3916   case (6 d t) 
  3917   from prems 
  3918   have lint: "islinintterm t" by simp
  3919   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3920     by (induct t rule: islinintterm.induct) auto
  3921   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3922   moreover
  3923   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3924     then obtain "i" "n" "r" where 
  3925       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3926       by blast
  3927     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3928       by simp
  3929     have linr: "islinintterm r" 
  3930       by (rule islinintterm_subt[OF lininr])
  3931     have ?case
  3932       using prems linr 
  3933       by (cases n) (simp_all add: nth_pos2
  3934 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3935   }
  3936   ultimately show ?case by blast
  3937 next 
  3938   case (7 t z)
  3939   from prems have zz: "z = 0" by simp
  3940   from prems 
  3941   have lint: "islinintterm t" by simp
  3942   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3943     by (induct t rule: islinintterm.induct) auto
  3944   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3945   moreover
  3946   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3947     then obtain "i" "n" "r" where 
  3948       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3949       by blast
  3950     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3951       by simp
  3952     have linr: "islinintterm r" 
  3953       by (rule islinintterm_subt[OF lininr])
  3954     have ?case using prems zz
  3955       by (cases n) (simp_all add: nth_pos2 
  3956 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3957   }
  3958   ultimately show ?case by blast 
  3959 qed simp_all
  3960 
  3961 
  3962 lemma mirror_interp2: 
  3963   assumes unifp: "islinform p"
  3964   shows "(qinterp (x#ats) p) = (qinterp ((- x)#ats) (mirror p))" (is "?P x = ?MP (-x)")
  3965 using unifp 
  3966 proof (induct p rule: islinform.induct)
  3967   case (1 t z)
  3968   from prems have zz: "z = 0" by simp
  3969   from prems 
  3970   have lint: "islinintterm t" by simp
  3971   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3972     by (induct t rule: islinintterm.induct) auto
  3973   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3974   moreover
  3975   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3976     then obtain "i" "n" "r" where 
  3977       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3978       by blast
  3979     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3980       by simp
  3981     have linr: "islinintterm r" 
  3982       by (rule islinintterm_subt[OF lininr])
  3983     have ?case using prems zz
  3984       by (cases n) (simp_all add: nth_pos2 
  3985 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3986   }
  3987   ultimately show ?case by blast
  3988 next
  3989   case (2 t z)
  3990   from prems have zz: "z = 0" by simp
  3991   from prems 
  3992   have lint: "islinintterm t" by simp
  3993   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3994     by (induct t rule: islinintterm.induct) auto
  3995   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3996   moreover
  3997   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3998     then obtain "i" "n" "r" where 
  3999       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4000       by blast
  4001     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4002       by simp
  4003     have linr: "islinintterm r" 
  4004       by (rule islinintterm_subt[OF lininr])
  4005     have ?case using prems zz
  4006       by (cases n) (simp_all add: nth_pos2 
  4007 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4008   }
  4009   ultimately show ?case by blast
  4010 next
  4011   case (3 d t) 
  4012   from prems 
  4013   have lint: "islinintterm t" by simp
  4014   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  4015     by (induct t rule: islinintterm.induct) auto
  4016   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  4017   moreover
  4018   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  4019     then obtain "i" "n" "r" where 
  4020       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4021       by blast
  4022     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4023       by simp
  4024     have linr: "islinintterm r" 
  4025       by (rule islinintterm_subt[OF lininr])
  4026     have ?case
  4027       using prems linr 
  4028       by (cases n) (simp_all add: nth_pos2
  4029 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4030   }
  4031   ultimately show ?case by blast
  4032 next
  4033 
  4034   case (6 d t) 
  4035   from prems 
  4036   have lint: "islinintterm t" by simp
  4037   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  4038     by (induct t rule: islinintterm.induct) auto
  4039   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  4040   moreover
  4041   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  4042     then obtain "i" "n" "r" where 
  4043       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4044       by blast
  4045     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4046       by simp
  4047     have linr: "islinintterm r" 
  4048       by (rule islinintterm_subt[OF lininr])
  4049     have ?case
  4050       using prems linr 
  4051       by (cases n) (simp_all add: nth_pos2
  4052 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4053   }
  4054   ultimately show ?case by blast
  4055 next 
  4056   case (7 t z)
  4057   from prems have zz: "z = 0" by simp
  4058   from prems 
  4059   have lint: "islinintterm t" by simp
  4060   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  4061     by (induct t rule: islinintterm.induct) auto
  4062   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  4063   moreover
  4064   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  4065     then obtain "i" "n" "r" where 
  4066       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4067       by blast
  4068     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4069       by simp
  4070     have linr: "islinintterm r" 
  4071       by (rule islinintterm_subt[OF lininr])
  4072     have ?case using prems zz
  4073       by (cases n) (simp_all add: nth_pos2 
  4074 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4075   }
  4076   ultimately show ?case by blast 
  4077 qed simp_all
  4078 
  4079 (* mirror preserves existence *)
  4080 lemma mirror_ex: 
  4081   assumes unifp: "isunified p"
  4082   shows "(\<exists> x. (qinterp (x#ats) p)) = (\<exists> y. (qinterp (y#ats) (mirror p)))" 
  4083   (is "(\<exists> x. ?P x) = (\<exists> y. ?MP y)")
  4084 proof
  4085   assume "\<exists> x. ?P x"
  4086   then obtain "x" where px:"?P x" by blast
  4087   have "?MP (-x)" 
  4088     using px
  4089     by(simp add: mirror_interp[OF unifp, where x="x"])
  4090   then show "\<exists> y. ?MP y" by blast
  4091 next 
  4092   assume "\<exists> y. ?MP y"
  4093   then obtain "y" where mpy: "?MP y" by blast
  4094   have "?P (-y)"
  4095     using mpy
  4096     by (simp add: mirror_interp[OF unifp, where x="-y"])
  4097   then show "\<exists> x. ?P x" by blast
  4098 qed
  4099 
  4100 lemma mirror_ex2: 
  4101   assumes unifp: "isunified p"
  4102   shows "qinterp ats (QEx p) = qinterp ats (QEx (mirror p))"
  4103 using mirror_ex[OF unifp] by simp
  4104 
  4105   
  4106 (* Cooper's theorem in its plusinfinity version *)
  4107 lemma cooper_pi_eq:
  4108   assumes unifp : "isunified p"
  4109   shows "(\<exists> x. qinterp (x#ats) p) = 
  4110   ((\<exists> j \<in> {1 .. (divlcm p)}. qinterp (-j#ats) (plusinf p)) \<or> 
  4111   (\<exists> j \<in> {1 .. (divlcm p)}. \<exists> b \<in> set (aset p). 
  4112   qinterp (((I_intterm (a#ats) b) - j)#ats) p))"
  4113   (is "(\<exists> x. ?P x) = ((\<exists> j\<in> {1 .. ?d}. ?PP (-j)) \<or> (\<exists> j \<in> ?D. \<exists> b\<in> ?A. ?P (?I a b - j)))")
  4114 proof-
  4115   have unifmp: "isunified (mirror p)" by (rule mirror_unified[OF unifp])
  4116   have th1: 
  4117     "(\<exists> j\<in> {1 .. ?d}. ?PP (-j)) = (\<exists> j\<in> {1..?d}.  qinterp (j # ats) (minusinf (mirror p)))"
  4118     by (simp add: plusinf_eq_minusinf_mirror[OF unifp])
  4119   have dth: "?d = divlcm (mirror p)"
  4120     by (rule divlcm_mirror_eq[OF unifp])
  4121   have "(\<exists> j \<in> ?D. \<exists> b\<in> ?A. ?P (?I a b - j)) = 
  4122     (\<exists> j\<in> ?D. \<exists> b \<in> set (map lin_neg (bset (mirror p))). ?P (?I a b - j))"
  4123     by (simp only: aset_eq_bset_mirror[OF unifp])
  4124   also have "\<dots> = (\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (?I a (lin_neg b) - j))"
  4125     by simp
  4126   also have "\<dots> = (\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (-(?I a b + j)))"
  4127   proof
  4128     assume "\<exists>j\<in>{1..divlcm p}.
  4129       \<exists>b\<in>set (bset (mirror p)). qinterp ((I_intterm (a # ats) (lin_neg b) - j) # ats) p"
  4130     then
  4131     obtain "j" and "b" where 
  4132       pbmj: "j\<in> ?D \<and> b\<in> set (bset (mirror p)) \<and> ?P (?I a (lin_neg b) - j)" by blast
  4133     then have linb: "islinintterm b" 
  4134       by (auto simp add:bset_lin[OF unifmp])
  4135     from linb pbmj have "?P (-(?I a b + j))" by (simp add: lin_neg_corr)
  4136     then show "\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (-(?I a b + j))"
  4137       using pbmj
  4138       by auto
  4139   next 
  4140     assume "\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (-(?I a b + j))"
  4141     then obtain "j" and "b" where 
  4142       pbmj: "j\<in> ?D \<and> b\<in> set (bset (mirror p)) \<and> ?P (-(?I a b + j))"
  4143       by blast
  4144     then have linb: "islinintterm b" 
  4145       by (auto simp add:bset_lin[OF unifmp])
  4146     from linb pbmj have "?P (?I a (lin_neg b) - j)"  
  4147       by (simp add: lin_neg_corr)
  4148     then show "\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (?I a (lin_neg b) - j)"
  4149       using pbmj by auto
  4150   qed
  4151   finally 
  4152   have bth: "(\<exists> j\<in> ?D. \<exists> b\<in> ?A. ?P (?I a b - j)) =
  4153     (\<exists>j\<in> ?D. \<exists> b\<in>set (bset (mirror p)). 
  4154     qinterp ((I_intterm (a # ats) b + j) # ats) (mirror p))"
  4155     by (simp add: mirror_interp[OF unifp] zadd_ac)
  4156   from bth dth th1
  4157   have "(\<exists> x. ?P x) = (\<exists> x. qinterp (x#ats) (mirror p))"
  4158     by (simp add: mirror_ex[OF unifp])
  4159   also have "\<dots> = ((\<exists>j\<in>{1..divlcm (mirror p)}. qinterp (j # ats) (minusinf (mirror p))) \<or>
  4160     (\<exists>j\<in>{1..divlcm (mirror p)}.
  4161     \<exists>b\<in>set (bset (mirror p)). qinterp ((I_intterm (a # ats) b + j) # ats) (mirror p)))"
  4162     (is "(\<exists> x. ?MP x) = ((\<exists> j\<in> ?DM. ?MPM j) \<or> (\<exists> j \<in> ?DM. \<exists> b\<in> ?BM. ?MP (?I a b + j)))")
  4163     by (rule cooper_mi_eq[OF unifmp])
  4164   also 
  4165   have "\<dots> = ((\<exists> j\<in> ?D. ?PP (-j)) \<or> (\<exists> j \<in> ?D. \<exists> b\<in> ?BM. ?MP (?I a b + j)))"
  4166     using bth th1 dth by simp
  4167   finally  show ?thesis using sym[OF bth] by simp
  4168 qed
  4169    
  4170 
  4171 (* substitution of a term into a Qfree formula, substitution of Bound 0 by i*)
  4172 
  4173 consts subst_it:: "intterm \<Rightarrow> intterm \<Rightarrow> intterm"
  4174 primrec
  4175 "subst_it i (Cst b) = Cst b"
  4176 "subst_it i (Var n) = (if n = 0 then i else Var n)"
  4177 "subst_it i (Neg it) = Neg (subst_it i it)"
  4178 "subst_it i (Add it1 it2) = Add (subst_it i it1) (subst_it i it2)" 
  4179 "subst_it i (Sub it1 it2) = Sub (subst_it i it1) (subst_it i it2)"
  4180 "subst_it i (Mult it1 it2) = Mult (subst_it i it1) (subst_it i it2)"
  4181 
  4182 
  4183 (* subst_it preserves semantics *)
  4184 lemma subst_it_corr: 
  4185 "I_intterm (a#ats) (subst_it i t) = I_intterm ((I_intterm (a#ats) i)#ats) t"
  4186 by (induct t rule: subst_it.induct, simp_all add: nth_pos2)
  4187 
  4188 consts subst_p:: "intterm \<Rightarrow> QF \<Rightarrow> QF"
  4189 primrec
  4190 "subst_p i (Le it1 it2) = Le (subst_it i it1) (subst_it i it2)"
  4191 "subst_p i (Lt it1 it2) = Lt (subst_it i it1) (subst_it i it2)"
  4192 "subst_p i (Ge it1 it2) = Ge (subst_it i it1) (subst_it i it2)"
  4193 "subst_p i (Gt it1 it2) = Gt (subst_it i it1) (subst_it i it2)"
  4194 "subst_p i (Eq it1 it2) = Eq (subst_it i it1) (subst_it i it2)"
  4195 "subst_p i (Divides d t) = Divides (subst_it i d) (subst_it i t)"
  4196 "subst_p i T = T"
  4197 "subst_p i F = F"
  4198 "subst_p i (And p q) = And (subst_p i p) (subst_p i q)"
  4199 "subst_p i (Or p q) = Or (subst_p i p) (subst_p i q)"
  4200 "subst_p i (Imp p q) = Imp (subst_p i p) (subst_p i q)"
  4201 "subst_p i (Equ p q) = Equ (subst_p i p) (subst_p i q)"
  4202 "subst_p i (NOT p) = (NOT (subst_p i p))"
  4203 
  4204 (* subs_p preserves correctness *)
  4205 lemma subst_p_corr: 
  4206   assumes qf: "isqfree p" 
  4207   shows "qinterp (a # ats) (subst_p i p) = qinterp ((I_intterm (a#ats) i)#ats) p "
  4208   using qf
  4209 by (induct p rule: subst_p.induct) (simp_all add: subst_it_corr)
  4210 
  4211 (* novar0 p is true if the fomula doese not depend on the quantified variable*)
  4212 consts novar0I:: "intterm \<Rightarrow> bool"
  4213 primrec
  4214 "novar0I (Cst i) = True"
  4215 "novar0I (Var n) = (n > 0)"
  4216 "novar0I (Neg a) = (novar0I a)"
  4217 "novar0I (Add a b) = (novar0I a \<and> novar0I b)"
  4218 "novar0I (Sub a b) = (novar0I a \<and> novar0I b)"
  4219 "novar0I (Mult a b) = (novar0I a \<and> novar0I b)"
  4220 
  4221 consts novar0:: "QF \<Rightarrow> bool"
  4222 recdef novar0 "measure size"
  4223 "novar0 (Lt a b) = (novar0I a \<and> novar0I b)"
  4224 "novar0 (Gt a b) = (novar0I a \<and> novar0I b)"
  4225 "novar0 (Le a b) = (novar0I a \<and> novar0I b)"
  4226 "novar0 (Ge a b) = (novar0I a \<and> novar0I b)"
  4227 "novar0 (Eq a b) = (novar0I a \<and> novar0I b)"
  4228 "novar0 (Divides a b) = (novar0I a \<and> novar0I b)"
  4229 "novar0 T = True" 
  4230 "novar0 F = True"
  4231 "novar0 (NOT p) = novar0 p" 
  4232 "novar0 (And p q) = (novar0 p \<and> novar0 q)"
  4233 "novar0 (Or p q)  = (novar0 p \<and> novar0 q)"
  4234 "novar0 (Imp p q) = (novar0 p \<and> novar0 q)"
  4235 "novar0 (Equ p q) = (novar0 p \<and> novar0 q)"
  4236 "novar0 p = False"
  4237 
  4238 (* Interpretation of terms, that doese not depend on Var 0 *)
  4239 lemma I_intterm_novar0:
  4240   assumes nov0: "novar0I x"
  4241   shows "I_intterm (a#ats) x = I_intterm (b#ats) x"
  4242 using nov0
  4243 by (induct x) (auto simp add: nth_pos2)
  4244 
  4245 (* substition is meaningless for term independent of Var 0*)
  4246 lemma subst_p_novar0_corr:
  4247 assumes qfp: "isqfree p"
  4248   and nov0: "novar0I i"
  4249   shows "qinterp (a#ats) (subst_p i p) = qinterp (I_intterm (b#ats) i#ats) p"
  4250 proof-
  4251   have "qinterp (a#ats) (subst_p i p) = qinterp (I_intterm (a#ats) i#ats) p"
  4252     by (rule subst_p_corr[OF qfp])
  4253   moreover have "I_intterm (a#ats) i#ats = I_intterm (b#ats) i#ats"
  4254     by (simp add: I_intterm_novar0[OF nov0, where a="a" and b="b"])
  4255   ultimately show ?thesis by simp
  4256 qed
  4257 
  4258 (* linearity and independence on Var 0*)
  4259 lemma lin_novar0: 
  4260   assumes linx: "islinintterm x"
  4261   and nov0: "novar0I x"
  4262   shows "\<exists> n > 0. islintn(n,x)"
  4263 using linx nov0
  4264 by (induct x rule: islinintterm.induct) auto
  4265 
  4266 lemma lintnpos_novar0:
  4267  assumes  npos: "n > 0"
  4268   and linx: "islintn(n,x)"
  4269   shows "novar0I x"
  4270 using npos linx
  4271 by (induct n x rule: islintn.induct) auto
  4272 
  4273 (* lin_add preserves independence on Var 0*)
  4274 lemma lin_add_novar0:
  4275   assumes nov0a: "novar0I a"
  4276   and nov0b : "novar0I b"
  4277   and lina : "islinintterm a"
  4278   and linb: "islinintterm b"
  4279   shows "novar0I (lin_add (a,b))"
  4280 proof-
  4281   have "\<exists> na > 0. islintn(na, a)" by (rule lin_novar0[OF lina nov0a]) 
  4282   then obtain "na" where na: "na > 0 \<and> islintn(na,a)" by blast
  4283   have "\<exists> nb > 0. islintn(nb, b)" by (rule lin_novar0[OF linb nov0b]) 
  4284   then obtain "nb" where nb: "nb > 0 \<and> islintn(nb,b)" by blast
  4285   from na have napos: "na > 0" by simp
  4286   from na have linna: "islintn(na,a)" by simp
  4287   from nb have nbpos: "nb > 0" by simp
  4288   from nb have linnb: "islintn(nb,b)" by simp
  4289   have "min na nb \<le> min na nb" by simp
  4290   then have "islintn (min na nb, lin_add(a,b))" by (simp add: lin_add_lint[OF linna linnb])
  4291   moreover have "min na nb > 0" using napos nbpos by (simp add: min_def)
  4292   ultimately show ?thesis by (simp only: lintnpos_novar0)
  4293 qed
  4294 
  4295 (* lin__mul preserves independence on Var 0*)
  4296 lemma lin_mul_novar0:
  4297   assumes linx: "islinintterm x"
  4298   and nov0: "novar0I x"
  4299   shows "novar0I (lin_mul(i,x))"
  4300   using linx nov0
  4301 proof (induct i x rule: lin_mul.induct, auto)
  4302   case (goal1 c c' n r)
  4303   from prems have lincnr: "islinintterm (Add (Mult (Cst c') (Var n)) r)" by simp
  4304   have "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4305   then show ?case using prems by simp
  4306 qed
  4307     
  4308 (* lin_neg preserves indepenednce on Var 0*)
  4309 lemma lin_neg_novar0:
  4310   assumes linx: "islinintterm x"
  4311   and nov0: "novar0I x"
  4312   shows "novar0I (lin_neg x)"
  4313 by (auto simp add: lin_mul_novar0 linx nov0 lin_neg_def)
  4314 
  4315 (* subterms of linear terms are independent on Var 0*)
  4316 lemma intterm_subt_novar0:
  4317   assumes lincnr: "islinintterm (Add (Mult (Cst c) (Var n)) r)"
  4318   shows "novar0I r"
  4319 proof-
  4320   have cnz: "c \<noteq> 0" by (rule islinintterm_cnz[OF lincnr])
  4321   have "islintn(0,Add (Mult (Cst c) (Var n)) r)" using lincnr
  4322     by (simp only: islinintterm_eq_islint islint_def)
  4323   then have "islintn (n+1,r)" by auto
  4324   moreover have "n+1 >0 " by arith
  4325   ultimately show ?thesis 
  4326     using lintnpos_novar0
  4327     by auto
  4328 qed
  4329 
  4330 (* decrease the De-Bruijn indices*)
  4331 consts decrvarsI:: "intterm \<Rightarrow> intterm"
  4332 primrec
  4333 "decrvarsI (Cst i) = (Cst i)"
  4334 "decrvarsI (Var n) = (Var (n - 1))"
  4335 "decrvarsI (Neg a) = (Neg (decrvarsI a))"
  4336 "decrvarsI (Add a b) = (Add (decrvarsI a) (decrvarsI b))"
  4337 "decrvarsI (Sub a b) = (Sub (decrvarsI a) (decrvarsI b))"
  4338 "decrvarsI (Mult a b) = (Mult (decrvarsI a) (decrvarsI b))"
  4339 
  4340 (* One can decrease the indics for terms and formulae independent on Var 0*)
  4341 lemma intterm_decrvarsI:
  4342   assumes nov0: "novar0I t"
  4343   shows "I_intterm (a#ats) t = I_intterm ats (decrvarsI t)"
  4344 using nov0
  4345 by (induct t) (auto simp add: nth_pos2)
  4346 
  4347 consts decrvars:: "QF \<Rightarrow> QF"
  4348 primrec
  4349 "decrvars (Lt a b) = (Lt (decrvarsI a) (decrvarsI b))"
  4350 "decrvars (Gt a b) = (Gt (decrvarsI a) (decrvarsI b))"
  4351 "decrvars (Le a b) = (Le (decrvarsI a) (decrvarsI b))"
  4352 "decrvars (Ge a b) = (Ge (decrvarsI a) (decrvarsI b))"
  4353 "decrvars (Eq a b) = (Eq (decrvarsI a) (decrvarsI b))"
  4354 "decrvars (Divides a b) = (Divides (decrvarsI a) (decrvarsI b))"
  4355 "decrvars T = T" 
  4356 "decrvars F = F"
  4357 "decrvars (NOT p) = (NOT (decrvars p))" 
  4358 "decrvars (And p q) = (And (decrvars p) (decrvars q))"
  4359 "decrvars (Or p q)  = (Or (decrvars p) (decrvars q))"
  4360 "decrvars (Imp p q) = (Imp (decrvars p) (decrvars q))"
  4361 "decrvars (Equ p q) = (Equ (decrvars p) (decrvars q))"
  4362 
  4363 (* decrvars preserves quantifier freeness*)
  4364 lemma decrvars_qfree: "isqfree p \<Longrightarrow> isqfree (decrvars p)"
  4365 by (induct p rule: isqfree.induct, auto)
  4366 
  4367 lemma novar0_qfree: "novar0 p \<Longrightarrow> isqfree p"
  4368 by (induct p) auto
  4369 
  4370 lemma qinterp_novar0:
  4371   assumes nov0: "novar0 p"
  4372   shows "qinterp (a#ats) p = qinterp ats (decrvars p)"
  4373 using nov0
  4374 by(induct p) (simp_all add: intterm_decrvarsI)
  4375 
  4376 (* All elements of bset p doese not depend on Var 0*)
  4377 lemma bset_novar0:
  4378   assumes unifp: "isunified p"
  4379   shows "\<forall> b\<in> set (bset p). novar0I b "
  4380   using unifp
  4381 proof(induct p rule: bset.induct)
  4382   case (1 c r z) 
  4383   from prems have zz: "z = Cst 0" by (cases "z", auto) 
  4384     from prems zz have lincnr: "islinintterm(Add (Mult (Cst c) (Var 0)) r)" by simp
  4385     have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4386     have novar0r: "novar0I r" by (rule intterm_subt_novar0[OF lincnr])
  4387     from prems zz have "c = 1 \<or> c = -1" by auto
  4388     moreover 
  4389     {
  4390       assume c1: "c=1"
  4391       have lin1: "islinintterm (Cst 1)" by simp
  4392       have novar01: "novar0I (Cst 1)" by simp
  4393       then have ?case 
  4394 	using prems zz novar0r lin1 novar01
  4395 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4396     }
  4397     moreover 
  4398     {
  4399       assume c1: "c= -1"
  4400       have lin1: "islinintterm (Cst -1)" by simp
  4401       have novar01: "novar0I (Cst -1)" by simp
  4402       then have ?case 
  4403 	using prems zz novar0r lin1 novar01
  4404 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4405     }
  4406     ultimately show ?case by blast
  4407 next 
  4408   case (2 c r z) 
  4409   from prems have zz: "z = Cst 0" by (cases "z", auto) 
  4410     from prems zz have lincnr: "islinintterm(Add (Mult (Cst c) (Var 0)) r)" by simp
  4411     have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4412     have novar0r: "novar0I r" by (rule intterm_subt_novar0[OF lincnr])
  4413     from prems zz have "c = 1 \<or> c = -1" by auto
  4414     moreover 
  4415     {
  4416       assume c1: "c=1"
  4417       have lin1: "islinintterm (Cst 1)" by simp
  4418       have novar01: "novar0I (Cst 1)" by simp
  4419       then have ?case 
  4420 	using prems zz novar0r lin1 novar01
  4421 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4422     }
  4423     moreover 
  4424     {
  4425       assume c1: "c= -1"
  4426       have lin1: "islinintterm (Cst -1)" by simp
  4427       have novar01: "novar0I (Cst -1)" by simp
  4428       then have ?case 
  4429 	using prems zz novar0r lin1 novar01
  4430 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4431     }
  4432     ultimately show ?case by blast
  4433 next 
  4434   case (3 c r z) 
  4435   from prems have zz: "z = Cst 0" by (cases "z", auto) 
  4436     from prems zz have lincnr: "islinintterm(Add (Mult (Cst c) (Var 0)) r)" by simp
  4437     have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4438     have novar0r: "novar0I r" by (rule intterm_subt_novar0[OF lincnr])
  4439     from prems zz have "c = 1 \<or> c = -1" by auto
  4440     moreover 
  4441     {
  4442       assume c1: "c=1"
  4443       have lin1: "islinintterm (Cst 1)" by simp
  4444       have novar01: "novar0I (Cst 1)" by simp
  4445       then have ?case 
  4446 	using prems zz novar0r lin1 novar01
  4447 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4448     }
  4449     moreover 
  4450     {
  4451       assume c1: "c= -1"
  4452       have lin1: "islinintterm (Cst -1)" by simp
  4453       have novar01: "novar0I (Cst -1)" by simp
  4454       then have ?case 
  4455 	using prems zz novar0r lin1 novar01
  4456 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4457     }
  4458     ultimately show ?case by blast
  4459 qed auto
  4460 
  4461 (* substitution preserves independence on Var 0*)
  4462 lemma subst_it_novar0:
  4463   assumes nov0x: "novar0I x"
  4464   shows "novar0I (subst_it x t)"
  4465   using nov0x
  4466   by (induct t) auto
  4467 
  4468 lemma subst_p_novar0:
  4469   assumes nov0x:"novar0I x"
  4470   and qfp: "isqfree p"
  4471   shows "novar0 (subst_p x p)"
  4472   using nov0x qfp
  4473   by (induct p rule: novar0.induct) (simp_all add: subst_it_novar0)
  4474 
  4475 (* linearize preserves independence on Var 0 *)
  4476 lemma linearize_novar0: 
  4477   assumes nov0t: "novar0I t "
  4478   shows "\<And> t'. linearize t = Some t' \<Longrightarrow> novar0I t'"
  4479 using nov0t
  4480 proof(induct t rule: novar0I.induct)
  4481   case (Neg a)
  4482   let ?la = "linearize a"
  4483   from prems have "\<exists> a'. ?la = Some a'" by (cases ?la, auto)
  4484   then obtain "a'" where "?la = Some a'" by blast
  4485   with prems have nv0a':"novar0I a'" by simp
  4486   have "islinintterm a'" using prems by (simp add: linearize_linear)
  4487   with nv0a' have "novar0I (lin_neg a')" 
  4488     by (simp add: lin_neg_novar0)
  4489   then 
  4490   show ?case using prems by simp 
  4491 next 
  4492   case (Add a b) 
  4493   let ?la = "linearize a"
  4494   let ?lb = "linearize b"
  4495   from prems have linab: "linearize (Add a b) = Some t'" by simp
  4496   then have "\<exists> a'. ?la = Some a'" by (cases ?la) auto
  4497   then obtain "a'" where "?la = Some a'" by blast
  4498   with prems have nv0a':"novar0I a'" by simp
  4499   have lina': "islinintterm a'" using prems by (simp add: linearize_linear)
  4500   from linab have "\<exists> b'. ?lb = Some b'"
  4501     by (cases ?la, auto) (cases ?lb, auto)
  4502   then obtain "b'" where "?lb = Some b'" by blast
  4503   with prems have nv0b':"novar0I b'" by simp
  4504   have linb': "islinintterm b'" using prems by (simp add: linearize_linear)
  4505   then show ?case using prems lina' linb' nv0a' nv0b'
  4506     by (auto simp add: lin_add_novar0)
  4507 next 
  4508   case (Sub a b)
  4509     let ?la = "linearize a"
  4510   let ?lb = "linearize b"
  4511   from prems have linab: "linearize (Sub a b) = Some t'" by simp
  4512   then have "\<exists> a'. ?la = Some a'" by (cases ?la) auto
  4513   then obtain "a'" where "?la = Some a'" by blast
  4514   with prems have nv0a':"novar0I a'" by simp
  4515   have lina': "islinintterm a'" using prems by (simp add: linearize_linear)
  4516   from linab have "\<exists> b'. ?lb = Some b'"
  4517     by (cases ?la, auto) (cases ?lb, auto)
  4518   then obtain "b'" where "?lb = Some b'" by blast
  4519   with prems have nv0b':"novar0I b'" by simp
  4520   have linb': "islinintterm b'" using prems by (simp add: linearize_linear)
  4521   then show ?case using prems lina' linb' nv0a' nv0b'
  4522     by (auto simp add: lin_add_novar0 lin_neg_novar0 lin_neg_lin)
  4523 next 
  4524   case (Mult a b)     
  4525   let ?la = "linearize a"
  4526   let ?lb = "linearize b"
  4527   from prems have linab: "linearize (Mult a b) = Some t'" by simp
  4528   then have "\<exists> a'. ?la = Some a'" by (cases ?la, auto)
  4529   then obtain "a'" where "?la = Some a'" by blast
  4530   with prems have nv0a':"novar0I a'" by simp
  4531   have lina': "islinintterm a'" using prems by (simp add: linearize_linear)
  4532   from prems linab have "\<exists> b'. ?lb = Some b'"
  4533     apply (cases ?la, auto)
  4534     by (cases "a'",auto) (cases ?lb, auto)+
  4535   then obtain "b'" where "?lb = Some b'" by blast
  4536   with prems have nv0b':"novar0I b'" by simp
  4537   have linb': "islinintterm b'" using prems by (simp add: linearize_linear)
  4538   then show ?case using prems lina' linb' nv0a' nv0b' 
  4539     by (cases "a'",auto simp add: lin_mul_novar0)
  4540   (cases "b'",auto simp add: lin_mul_novar0)
  4541 qed auto
  4542 
  4543 
  4544 (* simplification of formulae *)
  4545 consts psimpl :: "QF \<Rightarrow> QF"
  4546 recdef psimpl "measure size"
  4547 "psimpl (Le l r) = 
  4548   (case (linearize (Sub l r)) of
  4549    None \<Rightarrow> Le l r
  4550  | Some x \<Rightarrow> (case x of 
  4551        Cst i \<Rightarrow> (if i \<le> 0 then T else F)
  4552      | _ \<Rightarrow> (Le x (Cst 0))))"
  4553 "psimpl (Eq l r) = 
  4554   (case (linearize (Sub l r)) of
  4555    None \<Rightarrow> Eq l r
  4556  | Some x \<Rightarrow> (case x of 
  4557        Cst i \<Rightarrow> (if i = 0 then T else F)
  4558      | _ \<Rightarrow> (Eq x (Cst 0))))"
  4559 
  4560 "psimpl (Divides (Cst d) t) = 
  4561   (case (linearize t) of
  4562   None \<Rightarrow> (Divides (Cst d) t)
  4563   | Some c \<Rightarrow> (case c of
  4564      Cst i \<Rightarrow> (if d dvd i then T else F)
  4565    | _ \<Rightarrow>  (Divides (Cst d) c)))"
  4566 
  4567 "psimpl (And p q) = 
  4568   (let p'= psimpl p
  4569   in (case p' of 
  4570        F \<Rightarrow> F
  4571       |T \<Rightarrow> psimpl q
  4572       | _ \<Rightarrow> let q' = psimpl q
  4573              in (case q' of
  4574                      F \<Rightarrow> F
  4575                    | T \<Rightarrow> p'
  4576                    | _ \<Rightarrow> (And p' q'))))"
  4577 
  4578 "psimpl (Or p q) = 
  4579   (let p'= psimpl p
  4580   in (case p' of 
  4581         T \<Rightarrow> T
  4582       | F \<Rightarrow> psimpl q
  4583       | _ \<Rightarrow> let q' = psimpl q
  4584              in (case q' of
  4585                      T \<Rightarrow> T
  4586                    | F \<Rightarrow> p'
  4587                    | _ \<Rightarrow> (Or p' q'))))"
  4588 
  4589 "psimpl (Imp p q) = 
  4590   (let p'= psimpl p
  4591   in (case p' of 
  4592        F \<Rightarrow> T
  4593       |T \<Rightarrow> psimpl q
  4594       | NOT p1 \<Rightarrow> let q' = psimpl q
  4595              in (case q' of
  4596                      F \<Rightarrow> p1
  4597                    | T \<Rightarrow> T
  4598                    | _ \<Rightarrow> (Or p1 q'))
  4599       | _ \<Rightarrow> let q' = psimpl q
  4600              in (case q' of
  4601                      F \<Rightarrow> NOT p'
  4602                    | T \<Rightarrow> T
  4603                    | _ \<Rightarrow> (Imp p' q'))))"
  4604 
  4605 "psimpl (Equ p q) = 
  4606   (let p'= psimpl p ; q' = psimpl q
  4607   in (case p' of 
  4608         T \<Rightarrow> q'
  4609       | F \<Rightarrow> (case q' of
  4610                   T \<Rightarrow> F
  4611                 | F \<Rightarrow> T
  4612                 | NOT q1 \<Rightarrow> q1
  4613                 | _ \<Rightarrow> NOT q')
  4614       | NOT p1 \<Rightarrow>  (case q' of
  4615                   T \<Rightarrow> p'
  4616                 | F \<Rightarrow> p1
  4617                 | NOT q1 \<Rightarrow> (Equ p1 q1)
  4618                 | _ \<Rightarrow> (Equ p' q'))
  4619       | _ \<Rightarrow> (case q' of
  4620                   T \<Rightarrow> p'
  4621                 | F \<Rightarrow> NOT p'
  4622                 | _ \<Rightarrow> (Equ p' q'))))"
  4623 
  4624 "psimpl (NOT p) = 
  4625   (let p' = psimpl p
  4626   in ( case p' of 
  4627        F \<Rightarrow> T
  4628      | T \<Rightarrow> F
  4629      | NOT p1 \<Rightarrow> p1 
  4630      | _ \<Rightarrow> (NOT p')))"
  4631 "psimpl p = p"
  4632 
  4633 (* psimpl preserves semantics *)
  4634 lemma psimpl_corr: "qinterp ats p = qinterp ats (psimpl p)"
  4635 proof(induct p rule: psimpl.induct)
  4636   case (1 l r)
  4637   have "(\<exists> lx. linearize (Sub l r) = Some lx) \<or> (linearize (Sub l r) = None)" by auto
  4638   moreover
  4639   {
  4640     assume lin: "\<exists> lx. linearize (Sub l r) = Some lx"
  4641     from lin obtain "lx" where lx: "linearize (Sub l r) = Some lx" by blast
  4642     from lx have "I_intterm ats (Sub l r) = I_intterm ats lx"
  4643       by (rule linearize_corr[where t="Sub l r" and t'= "lx"])
  4644     then have feq: "qinterp ats (Le l r) = qinterp ats (Le lx (Cst 0))" by (simp , arith)
  4645     from lx have lxlin: "islinintterm lx" by (rule linearize_linear)
  4646     from lxlin feq have ?case 
  4647       proof-
  4648 	have "(\<exists> i. lx = Cst i) \<or> (\<not> (\<exists> i. lx = Cst i))" by blast
  4649 	moreover
  4650 	{
  4651 	  assume lxcst: "\<exists> i. lx = Cst i"
  4652 	  from lxcst obtain "i" where lxi: "lx = Cst i" by blast
  4653 	  with feq have "qinterp ats (Le l r) = (i \<le> 0)" by simp
  4654 	  then have ?case using prems by simp
  4655 	}
  4656 	moreover 
  4657 	{
  4658 	  assume "(\<not> (\<exists> i. lx = Cst i))"
  4659 	  then have "(case lx of 
  4660 	    Cst i \<Rightarrow> (if i \<le> 0 then T else F)
  4661 	    | _ \<Rightarrow> (Le lx (Cst 0))) = (Le lx (Cst 0))" 
  4662 	    by (case_tac "lx::intterm", auto)
  4663 	  with prems lxlin feq have ?case by auto
  4664 	}
  4665 	ultimately show ?thesis  by blast
  4666       qed
  4667   }
  4668   moreover
  4669   {
  4670     assume "linearize (Sub l r) = None"
  4671     then have ?case using prems by simp
  4672   }
  4673   ultimately show ?case by blast
  4674   
  4675 next 
  4676   case (2 l r)
  4677   have "(\<exists> lx. linearize (Sub l r) = Some lx) \<or> (linearize (Sub l r) = None)" by auto
  4678   moreover
  4679   {
  4680     assume lin: "\<exists> lx. linearize (Sub l r) = Some lx"
  4681     from lin obtain "lx" where lx: "linearize (Sub l r) = Some lx" by blast
  4682     from lx have "I_intterm ats (Sub l r) = I_intterm ats lx"
  4683       by (rule linearize_corr[where t="Sub l r" and t'= "lx"])
  4684     then have feq: "qinterp ats (Eq l r) = qinterp ats (Eq lx (Cst 0))" by (simp , arith)
  4685     from lx have lxlin: "islinintterm lx" by (rule linearize_linear)
  4686     from lxlin feq have ?case 
  4687       proof-
  4688 	have "(\<exists> i. lx = Cst i) \<or> (\<not> (\<exists> i. lx = Cst i))" by blast
  4689 	moreover
  4690 	{
  4691 	  assume lxcst: "\<exists> i. lx = Cst i"
  4692 	  from lxcst obtain "i" where lxi: "lx = Cst i" by blast
  4693 	  with feq have "qinterp ats (Eq l r) = (i = 0)" by simp
  4694 	  then have ?case using prems by simp
  4695 	}
  4696 	moreover 
  4697 	{
  4698 	  assume "(\<not> (\<exists> i. lx = Cst i))"
  4699 	  then have "(case lx of 
  4700 	    Cst i \<Rightarrow> (if i = 0 then T else F)
  4701 	    | _ \<Rightarrow> (Eq lx (Cst 0))) = (Eq lx (Cst 0))" 
  4702 	    by (case_tac "lx::intterm", auto)
  4703 	  with prems lxlin feq have ?case by auto
  4704 	}
  4705 	ultimately show ?thesis  by blast
  4706       qed
  4707   }
  4708   moreover
  4709   {
  4710     assume "linearize (Sub l r) = None"
  4711     then have ?case using prems by simp
  4712   }
  4713   ultimately show ?case by blast
  4714   
  4715 next 
  4716     
  4717   case (3 d t)  
  4718   have "(\<exists> lt. linearize t = Some lt) \<or> (linearize t = None)" by auto
  4719   moreover
  4720   {
  4721     assume lin: "\<exists> lt. linearize t  = Some lt"
  4722     from lin obtain "lt" where lt: "linearize t = Some lt" by blast
  4723     from lt have "I_intterm ats t = I_intterm ats lt"
  4724       by (rule linearize_corr[where t="t" and t'= "lt"])
  4725     then have feq: "qinterp ats (Divides (Cst d) t) = qinterp ats (Divides (Cst d) lt)" by (simp)
  4726     from lt have ltlin: "islinintterm lt" by (rule linearize_linear)
  4727     from ltlin feq have ?case using prems  apply simp by (case_tac "lt::intterm", simp_all)
  4728   }
  4729   moreover
  4730   {
  4731     assume "linearize t = None"
  4732     then have ?case using prems by simp
  4733   }
  4734   ultimately show ?case by blast
  4735   
  4736 next 
  4737   case (4 f g)
  4738 
  4739     let ?sf = "psimpl f"
  4740   let ?sg = "psimpl g"
  4741   show ?case using prems 
  4742     by (cases ?sf, simp_all add: Let_def) (cases ?sg, simp_all)+
  4743 next
  4744   case (5 f g)
  4745       let ?sf = "psimpl f"
  4746   let ?sg = "psimpl g"
  4747   show ?case using prems
  4748     apply (cases ?sf, simp_all add: Let_def) 
  4749     apply (cases ?sg, simp_all)
  4750     apply (cases ?sg, simp_all)
  4751     apply (cases ?sg, simp_all)
  4752     apply (cases ?sg, simp_all)
  4753     apply (cases ?sg, simp_all)
  4754     apply (cases ?sg, simp_all)
  4755     apply (cases ?sg, simp_all)
  4756     apply blast
  4757     apply (cases ?sg, simp_all)
  4758     apply (cases ?sg, simp_all)
  4759      apply (cases ?sg, simp_all)
  4760    apply blast
  4761     apply (cases ?sg, simp_all)
  4762     by (cases ?sg, simp_all) (cases ?sg, simp_all)
  4763 next
  4764   case (6 f g)
  4765   let ?sf = "psimpl f"
  4766   let ?sg = "psimpl g"
  4767   show ?case using prems 
  4768     apply(simp add: Let_def)
  4769     apply(cases ?sf,simp_all)
  4770     apply (simp_all add: Let_def)
  4771     apply(cases ?sg, simp_all)
  4772     apply(cases ?sg, simp_all)
  4773     apply(cases ?sg, simp_all)
  4774     apply(cases ?sg, simp_all)
  4775     apply(cases ?sg, simp_all)
  4776     apply(cases ?sg, simp_all)
  4777     apply(cases ?sg, simp_all)
  4778     apply blast
  4779     apply blast
  4780     apply blast
  4781     apply blast
  4782     apply blast
  4783     apply blast
  4784     apply blast
  4785     apply blast
  4786     apply blast
  4787     apply blast
  4788     apply blast
  4789     apply blast
  4790     apply blast
  4791     apply(cases ?sg, simp_all)
  4792     apply(cases ?sg, simp_all)
  4793     apply(cases ?sg, simp_all)
  4794     apply(cases ?sg, simp_all)
  4795     apply(cases ?sg, simp_all)
  4796     apply(cases ?sg, simp_all)
  4797     done
  4798 next
  4799   case (7 f g)
  4800   let ?sf = "psimpl f"
  4801   let ?sg = "psimpl g"
  4802   show ?case 
  4803     using prems
  4804     by (cases ?sf, simp_all add: Let_def) (cases ?sg, simp_all)+
  4805 next
  4806   case (8 f) show ?case 
  4807     using prems
  4808     apply (simp add: Let_def)
  4809     by (case_tac "psimpl f", simp_all)
  4810 qed simp_all
  4811 
  4812 (* psimpl preserves independence on Var 0*)
  4813 lemma psimpl_novar0:
  4814   assumes nov0p: "novar0 p"
  4815   shows "novar0 (psimpl p)"
  4816   using nov0p
  4817 proof (induct p rule: psimpl.induct)
  4818   case (1 l r)
  4819   let ?ls = "linearize (Sub l r)"
  4820   have "?ls = None \<or> (\<exists> x. ?ls = Some x)" by auto
  4821   moreover
  4822   {
  4823     assume "?ls = None" then have ?case using prems by simp
  4824   }
  4825   moreover {
  4826     assume "\<exists> x. ?ls = Some x"
  4827     then obtain "x" where ls_d: "?ls = Some x" by blast
  4828     from prems have "novar0I l" by simp
  4829     moreover from prems have "novar0I r" by simp
  4830     ultimately have nv0s: "novar0I (Sub l r)" by simp
  4831     from prems have "novar0I x" 
  4832       by (simp add: linearize_novar0[OF nv0s, where t'="x"])
  4833     then have ?case
  4834       using prems
  4835       by (cases "x") auto
  4836   }
  4837   ultimately show ?case by blast
  4838 next
  4839   case (2 l r)
  4840   let ?ls = "linearize (Sub l r)"
  4841   have "?ls = None \<or> (\<exists> x. ?ls = Some x)" by auto
  4842   moreover
  4843   {
  4844     assume "?ls = None" then have ?case using prems by simp
  4845   }
  4846   moreover {
  4847     assume "\<exists> x. ?ls = Some x"
  4848     then obtain "x" where ls_d: "?ls = Some x" by blast
  4849     from prems have "novar0I l" by simp
  4850     moreover from prems have "novar0I r" by simp
  4851     ultimately have nv0s: "novar0I (Sub l r)" by simp
  4852     from prems have "novar0I x" 
  4853       by (simp add: linearize_novar0[OF nv0s, where t'="x"])
  4854     then have ?case using prems by (cases "x") auto
  4855   }
  4856   ultimately show ?case by blast
  4857 next
  4858   case (3 d t)
  4859   let ?lt = "linearize t"
  4860   have "?lt = None \<or> (\<exists> x. ?lt = Some x)"  by auto
  4861   moreover 
  4862   { assume "?lt = None" then have ?case using prems by simp }
  4863   moreover {
  4864     assume "\<exists>x. ?lt = Some x"
  4865     then obtain "x" where x_d: "?lt = Some x" by blast
  4866     from prems have nv0t: "novar0I t" by simp
  4867     with x_d have "novar0I x" 
  4868       by (simp add: linearize_novar0[OF nv0t])
  4869     with prems have ?case 
  4870       by (cases "x") simp_all
  4871   }
  4872   ultimately show ?case by blast
  4873 next
  4874   case (4 f g)
  4875   let ?sf = "psimpl f"
  4876   let ?sg = "psimpl g"
  4877   show ?case using prems 
  4878     by (cases ?sf, simp_all add: Let_def) (cases ?sg,simp_all)+
  4879 next
  4880   case (5 f g)
  4881   let ?sf = "psimpl f"
  4882   let ?sg = "psimpl g"
  4883   show ?case using prems
  4884     by (cases ?sf, simp_all add: Let_def) (cases ?sg,simp_all)+
  4885 next
  4886   case (6 f g)
  4887   let ?sf = "psimpl f"
  4888   let ?sg = "psimpl g"
  4889   show ?case using prems
  4890     by (cases ?sf, simp_all add: Let_def) (cases ?sg,simp_all)+
  4891 next
  4892   case (7 f g)
  4893   let ?sf = "psimpl f"
  4894   let ?sg = "psimpl g"
  4895   show ?case using prems
  4896     by (cases ?sf, simp_all add: Let_def) (cases ?sg,simp_all)+
  4897 next
  4898   case (8 f)
  4899   let ?sf = "psimpl f"
  4900   from prems have nv0sf:"novar0 ?sf" by simp
  4901   show ?case using prems nv0sf by (cases ?sf, auto simp add: Let_def)
  4902 qed simp_all
  4903 
  4904 (* implements a disj of p applied to all elements of the list*)
  4905 consts explode_disj :: "(intterm list \<times> QF) \<Rightarrow> QF"
  4906 recdef explode_disj "measure (\<lambda>(is,p). length is)"
  4907 "explode_disj ([],p) = F"
  4908 "explode_disj (i#is,p) = 
  4909   (let pi = psimpl (subst_p i p)
  4910    in ( case pi of
  4911         T \<Rightarrow> T 
  4912        | F \<Rightarrow> explode_disj (is,p)
  4913        | _ \<Rightarrow> (let r = explode_disj (is,p)
  4914                in (case r of
  4915                       T \<Rightarrow> T
  4916                     | F \<Rightarrow> pi
  4917                     | _ \<Rightarrow> Or pi r))))"
  4918 
  4919 (* correctness theorem for one iteration of explode_disj *)
  4920 lemma explode_disj_disj: 
  4921   assumes qfp: "isqfree p"
  4922   shows "(qinterp (x#xs) (explode_disj(i#is,p))) = 
  4923   (qinterp (x#xs) (subst_p i p) \<or> (qinterp (x#xs) (explode_disj(is,p))))"
  4924   using qfp
  4925 proof-
  4926   let ?pi = "psimpl (subst_p i p)"
  4927   have pi: "qinterp (x#xs) ?pi = qinterp (x#xs) (subst_p i p)"
  4928     by (simp add: psimpl_corr[where p="(subst_p i p)"])
  4929   let ?dp = "explode_disj(is,p)"
  4930   show ?thesis using pi
  4931   proof (cases)
  4932     assume "?pi= T \<or> ?pi = F"
  4933     then show ?thesis using pi by (case_tac "?pi::QF", auto)
  4934     
  4935   next
  4936     assume notTF: "\<not> (?pi = T \<or> ?pi = F)" 
  4937     let ?dp = "explode_disj(is,p)"
  4938     have dp_cases: "explode_disj(i#is,p) = 
  4939       (case (explode_disj(is,p)) of
  4940       T \<Rightarrow> T
  4941       | F \<Rightarrow> psimpl (subst_p i p)
  4942       | _ \<Rightarrow> Or (psimpl (subst_p i p)) (explode_disj(is,p)))" using notTF
  4943       by (cases "?pi")
  4944     (simp_all add: Let_def cong del: QF.weak_case_cong)
  4945     show ?thesis using pi dp_cases notTF
  4946     proof(cases)
  4947       assume "?dp = T \<or> ?dp = F"
  4948       then show ?thesis 
  4949 	using pi dp_cases
  4950 	by (cases "?dp") auto
  4951     next
  4952       assume "\<not> (?dp = T \<or> ?dp = F)"
  4953       then show ?thesis using pi dp_cases notTF
  4954 	by (cases ?dp) auto 
  4955     qed
  4956   qed
  4957 qed
  4958 
  4959 (* correctness theorem for explode_disj *)
  4960 lemma explode_disj_corr: 
  4961   assumes qfp: "isqfree p"
  4962   shows "(\<exists> x \<in> set xs. qinterp (a#ats) (subst_p x p)) = 
  4963   (qinterp (a#ats) (explode_disj(xs,p)))" (is "(\<exists> x \<in> set xs. ?P x) = (?DP a xs )")
  4964   using qfp
  4965   proof (induct xs)
  4966     case Nil show ?case by simp
  4967   next 
  4968     case (Cons y ys)
  4969     have "(\<exists> x \<in> set (y#ys). ?P x) = (?P y \<or> (\<exists> x\<in> set ys. ?P x))"
  4970       by auto
  4971     also have "\<dots> = (?P y \<or> ?DP a ys)" using "Cons.hyps" qfp by auto 
  4972     also have "\<dots> = ?DP a (y#ys)" using explode_disj_disj[OF qfp] by auto
  4973     finally show ?case by simp
  4974 qed
  4975 
  4976 (* explode_disj preserves independence on Var 0*)
  4977 lemma explode_disj_novar0:
  4978   assumes nov0xs: "\<forall>x \<in> set xs. novar0I x"
  4979   and qfp: "isqfree p"
  4980   shows "novar0 (explode_disj (xs,p))"
  4981   using nov0xs qfp
  4982 proof (induct xs, auto simp add: Let_def)
  4983   case (goal1 a as)
  4984   let ?q = "subst_p a p"
  4985   let ?qs = "psimpl ?q"
  4986   have "?qs = T \<or> ?qs = F \<or> (?qs \<noteq> T \<or> ?qs \<noteq> F)" by simp
  4987   moreover
  4988   { assume "?qs = T"  then have ?case  by simp }
  4989   moreover
  4990   { assume "?qs = F"  then have ?case by simp }
  4991   moreover
  4992   {
  4993     assume qsnTF: "?qs \<noteq> T \<and> ?qs \<noteq> F"
  4994     let ?r = "explode_disj (as,p)"
  4995     have nov0qs: "novar0 ?qs"
  4996       using prems
  4997       by (auto simp add: psimpl_novar0 subst_p_novar0)
  4998     have "?r = T \<or> ?r = F \<or> (?r \<noteq> T \<or> ?r \<noteq> F)" by simp
  4999     moreover
  5000     { assume "?r = T" then have ?case by (cases ?qs) auto  }
  5001     moreover
  5002     { assume "?r = F"  then have ?case  using nov0qs by (cases ?qs, auto)  }
  5003     moreover
  5004     { assume "?r \<noteq> T \<and> ?r \<noteq> F"  then have ?case using nov0qs prems qsnTF
  5005 	by (cases ?qs, auto simp add: Let_def) (cases ?r,auto)+
  5006     }
  5007     ultimately have ?case by blast
  5008   }
  5009   ultimately show ?case by blast
  5010 qed  
  5011   
  5012 (* Some simple lemmas used for technical reasons *)
  5013 lemma eval_Or_cases: 
  5014   "qinterp (a#ats) (case f of 
  5015        T \<Rightarrow> T
  5016        | F \<Rightarrow> g
  5017        | _ \<Rightarrow> (case g of 
  5018                      T \<Rightarrow> T
  5019                    | F \<Rightarrow> f
  5020                    | _ \<Rightarrow> Or f g)) = (qinterp (a#ats) f \<or> qinterp (a#ats) g)"
  5021 proof-
  5022   let ?result = "
  5023     (case f of 
  5024     T \<Rightarrow> T
  5025     | F \<Rightarrow> g
  5026     | _ \<Rightarrow> (case g of 
  5027     T \<Rightarrow> T
  5028     | F \<Rightarrow> f
  5029     | _ \<Rightarrow> Or f g))"
  5030   have "f = T \<or> f = F \<or> (f \<noteq> T \<and> f\<noteq> F)" by auto
  5031   moreover 
  5032   {
  5033     assume fT: "f = T"
  5034     then have ?thesis by auto
  5035   }
  5036   moreover 
  5037   {
  5038     assume "f=F"
  5039     then have ?thesis by auto
  5040   }
  5041   moreover 
  5042   {
  5043     assume fnT: "f\<noteq>T"
  5044       and fnF: "f\<noteq>F"
  5045     have "g = T \<or> g = F \<or> (g \<noteq> T \<and> g\<noteq> F)" by auto
  5046     moreover 
  5047     {
  5048       assume "g=T"
  5049       then have ?thesis using fnT fnF by (cases f, auto)
  5050     }
  5051     moreover 
  5052     {
  5053       assume "g=F"
  5054       then have ?thesis using fnT fnF by (cases f, auto)
  5055     }
  5056     moreover 
  5057     {
  5058       assume gnT: "g\<noteq>T"
  5059 	and gnF: "g\<noteq>F"
  5060       then have "?result = (case g of 
  5061         T \<Rightarrow> T
  5062         | F \<Rightarrow> f
  5063         | _ \<Rightarrow> Or f g)"
  5064 	using fnT fnF
  5065 	by (cases f, auto)
  5066       also have "\<dots> = Or f g"
  5067 	using gnT gnF
  5068 	by (cases g, auto)
  5069       finally have "?result = Or f g" by simp
  5070       then
  5071       have  ?thesis by simp
  5072     }
  5073     ultimately have ?thesis by blast
  5074 	   
  5075   }
  5076   
  5077   ultimately show ?thesis by blast
  5078 qed
  5079 
  5080 lemma or_case_novar0:
  5081   assumes fnTF: "f \<noteq> T \<and> f \<noteq> F"
  5082   and gnTF: "g \<noteq> T \<and> g \<noteq> F"
  5083   and f0: "novar0 f"
  5084   and g0: "novar0 g"
  5085   shows "novar0 
  5086      (case f of T \<Rightarrow> T | F \<Rightarrow> g
  5087      | _ \<Rightarrow> (case g of T \<Rightarrow> T | F \<Rightarrow> f | _ \<Rightarrow> Or f g))"
  5088 using fnTF gnTF f0 g0
  5089 by (cases f, auto) (cases g, auto)+
  5090 
  5091 
  5092 (* An implementation of sets trough lists *)
  5093 definition
  5094   list_insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  5095   "list_insert x xs = (if x mem xs then xs else x#xs)"
  5096 
  5097 lemma list_insert_set: "set (list_insert x xs) = set (x#xs)"
  5098 by(induct xs) (auto simp add: list_insert_def)
  5099 
  5100 consts list_union :: "('a list \<times> 'a list) \<Rightarrow> 'a list"
  5101 
  5102 recdef list_union "measure (\<lambda>(xs,ys). length xs)"
  5103 "list_union ([], ys) = ys"
  5104 "list_union (xs, []) = xs"
  5105 "list_union (x#xs,ys) = list_insert x (list_union (xs,ys))"
  5106 
  5107 lemma list_union_set: "set (list_union(xs,ys)) = set (xs@ys)"
  5108   by(induct xs ys rule: list_union.induct, auto simp add:list_insert_set)
  5109 
  5110 
  5111 consts list_set ::"'a list \<Rightarrow> 'a list"
  5112 primrec 
  5113   "list_set [] = []"
  5114   "list_set (x#xs) = list_insert x (list_set xs)"
  5115 
  5116 lemma list_set_set: "set xs = set (list_set xs)"
  5117 by (induct xs) (auto simp add: list_insert_set)
  5118 
  5119 consts iupto :: "int \<times> int \<Rightarrow> int list"
  5120 recdef iupto "measure (\<lambda> (i,j). nat (j - i +1))"
  5121 "iupto(i,j) = (if j<i then [] else (i#(iupto(i+1,j))))"
  5122 
  5123 (* correctness theorem for iupto *)
  5124 lemma iupto_set: "set (iupto(i,j)) = {i .. j}"
  5125 proof(induct rule: iupto.induct)
  5126   case (1 a b)
  5127   show ?case
  5128     using prems by (simp add: simp_from_to)
  5129 qed
  5130 
  5131 consts all_sums :: "int \<times> intterm list \<Rightarrow> intterm list"
  5132 recdef all_sums "measure (\<lambda>(i,is). length is)"
  5133 "all_sums (j,[]) = []"
  5134 "all_sums (j,i#is) = (map (\<lambda>x. lin_add (i,(Cst x))) (iupto(1,j))@(all_sums (j,is)))"
  5135 (* all_sums preserves independence on Var 0*)
  5136 lemma all_sums_novar0:
  5137   assumes nov0xs: "\<forall> x\<in> set xs. novar0I x"
  5138   and linxs: "\<forall> x\<in> set xs. islinintterm x "
  5139   shows "\<forall> x\<in> set (all_sums (d,xs)). novar0I x"
  5140   using nov0xs linxs
  5141 proof(induct d xs rule: all_sums.induct)
  5142   case 1 show ?case by simp
  5143 next 
  5144   case (2 j a as)
  5145   have lina: "islinintterm a" using "2.prems" by auto
  5146   have nov0a: "novar0I a" using "2.prems" by auto
  5147   let ?ys = "map (\<lambda>x. lin_add (a,(Cst x))) (iupto(1,j))"
  5148   have nov0ys: "\<forall> y\<in> set ?ys. novar0I y"
  5149   proof-
  5150     have linx: "\<forall> x \<in> set (iupto(1,j)). islinintterm (Cst x)" by simp
  5151     have nov0x: "\<forall> x \<in> set (iupto(1,j)). novar0I (Cst x)" by simp
  5152     with nov0a lina linx have "\<forall> x\<in> set (iupto(1,j)). novar0I (lin_add (a,Cst x))" 
  5153       by (simp add: lin_add_novar0)
  5154     then show ?thesis by auto
  5155   qed
  5156   from "2.prems"
  5157   have linas: "\<forall>u\<in>set as. islinintterm u" by auto
  5158   from "2.prems" have nov0as: "\<forall>u\<in>set as. novar0I u" by auto
  5159   from "2.hyps" linas nov0as have nov0alls: "\<forall>u\<in>set (all_sums (j, as)). novar0I u" by simp
  5160   from nov0alls nov0ys have 
  5161     cs: "(\<forall> u\<in> set (?ys@ (all_sums (j,as))). novar0I u)"
  5162     by (simp only: sym[OF list_all_iff]) auto
  5163   
  5164   have "all_sums(j,a#as) = ?ys@(all_sums(j,as))"
  5165     by simp
  5166   then 
  5167   have "?case = (\<forall> x\<in> set (?ys@ (all_sums (j,as))). novar0I x)"
  5168     by auto
  5169   with cs show ?case by blast
  5170 qed
  5171 
  5172 (* correctness theorem for all_sums*)
  5173 lemma all_sums_ex: 
  5174   "(\<exists> j\<in> {1..d}. \<exists> b\<in> (set xs). P (lin_add(b,Cst j))) = 
  5175   (\<exists> x\<in> set (all_sums (d,xs)). P x)"
  5176 proof(induct d xs rule: all_sums.induct)
  5177   case (1 a) show ?case by simp
  5178 next 
  5179   case (2 a y ys)
  5180   have "(\<exists> x\<in> set (map (\<lambda>x. lin_add (y,(Cst x))) (iupto(1,a))) . P x) = 
  5181     (\<exists> j\<in> set (iupto(1,a)). P (lin_add(y,Cst j)))" 
  5182     by auto
  5183   also have "\<dots> = (\<exists> j\<in> {1..a}. P (lin_add(y,Cst j)))" 
  5184     by (simp only : iupto_set)
  5185   finally
  5186   have dsj1:"(\<exists>j\<in>{1..a}. P (lin_add (y, Cst j))) = (\<exists>x\<in>set (map (\<lambda>x. lin_add (y, Cst x)) (iupto (1, a))). P x)" by simp
  5187   
  5188   from prems have "(\<exists> j\<in> {1..a}. \<exists> b\<in> (set (y#ys)). P (lin_add(b,Cst j))) = 
  5189     ((\<exists> j\<in> {1..a}. P (lin_add(y,Cst j))) \<or> (\<exists> j\<in> {1..a}. \<exists> b \<in> set ys. P (lin_add(b,Cst j))))" by auto
  5190   also
  5191   have " \<dots> = ((\<exists> j\<in> {1..a}. P (lin_add(y,Cst j))) \<or> (\<exists> x\<in> set (all_sums(a, ys)). P x))" using prems by simp
  5192   also have "\<dots> = ((\<exists>x\<in>set (map (\<lambda>x. lin_add (y, Cst x)) (iupto (1, a))). P x) \<or> (\<exists>x\<in>set (all_sums (a, ys)). P x))" using dsj1 by simp
  5193   also have "\<dots> = (\<exists> x\<in> (set (map (\<lambda>x. lin_add (y, Cst x)) (iupto (1, a)))) \<union> (set (all_sums(a, ys))). P x)" by blast
  5194   finally show ?case by simp
  5195 qed
  5196 
  5197 
  5198 
  5199 (* explode_minf (p,B)  assumes that p is unified and B = bset p, it computes the rhs of cooper_mi_eq*)
  5200 
  5201 consts explode_minf :: "(QF \<times> intterm list) \<Rightarrow> QF"
  5202 recdef explode_minf "measure size"
  5203 "explode_minf (q,B) = 
  5204   (let d = divlcm q;
  5205        pm = minusinf q;
  5206         dj1 = explode_disj ((map Cst (iupto (1, d))),pm)
  5207    in (case dj1 of 
  5208          T \<Rightarrow> T
  5209        | F \<Rightarrow> explode_disj (all_sums (d,B),q)
  5210         | _ \<Rightarrow> (let dj2 = explode_disj (all_sums (d,B),q)
  5211               in ( case dj2 of 
  5212                      T \<Rightarrow> T
  5213                    | F \<Rightarrow> dj1
  5214                    | _ \<Rightarrow> Or dj1 dj2))))"
  5215 
  5216 (* The result of the rhs of cooper's theorem doese not depend on Var 0*)
  5217 lemma explode_minf_novar0:
  5218   assumes unifp : "isunified p"
  5219   and bst: "set (bset p) = set B"
  5220   shows "novar0 (explode_minf (p,B))"
  5221 proof-
  5222   let ?d = "divlcm p"
  5223   let ?pm = "minusinf p"
  5224   let ?dj1 = "explode_disj (map Cst (iupto(1,?d)),?pm)"
  5225   
  5226   have qfpm: "isqfree ?pm"  using unified_islinform[OF unifp] minusinf_qfree by simp
  5227   have dpos: "?d >0" using unified_islinform[OF unifp] divlcm_pos by simp 
  5228   have "\<forall> x\<in> set (map Cst (iupto(1,?d))). novar0I x" by auto
  5229   then have dj1_nov0: "novar0 ?dj1" using qfpm explode_disj_novar0 by simp
  5230   
  5231   let ?dj2 = "explode_disj (all_sums (?d,B),p)"
  5232   have 
  5233     bstlin: "\<forall>b\<in>set B. islinintterm b"
  5234     using bset_lin[OF unifp] bst
  5235     by simp
  5236   
  5237   have bstnov0: "\<forall>b\<in>set B. novar0I b"
  5238     using bst bset_novar0[OF unifp] by simp
  5239   have allsnov0: "\<forall>x\<in>set (all_sums(?d,B)). novar0I x "
  5240     by (simp add:all_sums_novar0[OF bstnov0 bstlin] )
  5241   then have dj2_nov0: "novar0 ?dj2" 
  5242     using explode_disj_novar0 unified_isqfree[OF unifp] bst by simp
  5243   have "?dj1 = T \<or> ?dj1 = F \<or> (?dj1 \<noteq> T \<and> ?dj1 \<noteq> F)" by auto
  5244   moreover
  5245   { assume "?dj1 = T" then have ?thesis by simp }
  5246   moreover
  5247   { assume "?dj1 = F" then have ?thesis using bst dj2_nov0 by (simp add: Let_def)}
  5248   moreover
  5249   {
  5250     assume dj1nFT:"?dj1 \<noteq> T \<and> ?dj1 \<noteq> F"
  5251     
  5252     have "?dj2 = T \<or> ?dj2 = F \<or> (?dj2 \<noteq> T \<and> ?dj2 \<noteq> F)" by auto
  5253     moreover
  5254     { assume "?dj2 = T" then have ?thesis by (cases ?dj1) simp_all }
  5255     moreover
  5256     { assume "?dj2 = F" then have ?thesis using dj1_nov0 bst
  5257 	by (cases ?dj1) (simp_all add: Let_def)}
  5258     moreover
  5259     {
  5260       assume dj2_nTF:"?dj2 \<noteq> T \<and> ?dj2 \<noteq> F"
  5261       let ?res = "\<lambda>f. \<lambda>g. (case f of T \<Rightarrow> T | F \<Rightarrow> g
  5262 	| _ \<Rightarrow> (case g of T \<Rightarrow> T| F \<Rightarrow> f| _ \<Rightarrow> Or f g))"
  5263       have expth: "explode_minf (p,B) = ?res ?dj1 ?dj2"
  5264 	by (simp add: Let_def del: iupto.simps split del: split_if
  5265 	  cong del: QF.weak_case_cong)
  5266       then have ?thesis
  5267 	using prems or_case_novar0 [OF dj1nFT dj2_nTF dj1_nov0 dj2_nov0]
  5268 	by (simp add: Let_def del: iupto.simps cong del: QF.weak_case_cong)
  5269     }
  5270     ultimately have ?thesis by blast
  5271   }
  5272   ultimately show ?thesis by blast
  5273 qed
  5274   
  5275 (* explode_minf computes the rhs of cooper's thm*)
  5276 lemma explode_minf_corr:
  5277   assumes unifp : "isunified p"
  5278   and bst: "set (bset p) = set B"
  5279   shows "(\<exists> x . qinterp (x#ats) p) = (qinterp (a#ats) (explode_minf (p,B)))"
  5280   (is "(\<exists> x. ?P x) = (?EXP a p)")
  5281 proof-
  5282   let ?d = "divlcm p"
  5283   let ?pm = "minusinf p"
  5284   let ?dj1 = "explode_disj (map Cst (iupto(1,?d)),?pm)"
  5285   have qfpm: "isqfree ?pm"  using unified_islinform[OF unifp] minusinf_qfree by simp 
  5286   have nnfp: "isnnf p" by (rule unified_isnnf[OF unifp])
  5287 
  5288   have "(\<exists>j\<in>{1..?d}. qinterp (j # ats) (minusinf p))
  5289     = (\<exists>j\<in> set (iupto(1,?d)). qinterp (j#ats) (minusinf p))"
  5290     (is "(\<exists> j\<in> {1..?d}. ?QM j) = \<dots>")
  5291     by (simp add: sym[OF iupto_set] )
  5292   also
  5293   have "\<dots> =(\<exists>j\<in> set (iupto(1,?d)). qinterp ((I_intterm (a#ats) (Cst j))#ats) (minusinf p))"
  5294     by simp
  5295   also have 
  5296     "\<dots> = (\<exists>j\<in> set (map Cst (iupto(1,?d))). qinterp ((I_intterm (a#ats) j)#ats) (minusinf p))" by simp
  5297   also have 
  5298     "\<dots> = 
  5299     (\<exists>j\<in> set (map Cst (iupto(1,?d))). qinterp (a#ats) (subst_p j (minusinf p)))"
  5300     by (simp add: subst_p_corr[OF qfpm])
  5301   finally have dj1_thm: 
  5302     "(\<exists> j\<in> {1..?d}. ?QM j) = (qinterp (a#ats) ?dj1)"
  5303     by (simp only: explode_disj_corr[OF qfpm])
  5304   let ?dj2 = "explode_disj (all_sums (?d,B),p)"
  5305   have 
  5306     bstlin: "\<forall>b\<in>set B. islinintterm b" 
  5307     using bst by (simp add: bset_lin[OF unifp])
  5308   have bstnov0: "\<forall>b\<in>set B. novar0I b" 
  5309     using bst by (simp add: bset_novar0[OF unifp])
  5310   have allsnov0: "\<forall>x\<in>set (all_sums(?d,B)). novar0I x "
  5311     by (simp add:all_sums_novar0[OF bstnov0 bstlin] )
  5312   have "(\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)) = 
  5313    (\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) (lin_add(b,Cst j))))"
  5314     using bst by (auto simp add: lin_add_corr bset_lin[OF unifp])
  5315   also have "\<dots> = (\<exists> x \<in> set (all_sums (?d, B)). ?P (I_intterm (a#ats) x))"
  5316     by (simp add: all_sums_ex[where P="\<lambda> t. ?P (I_intterm (a#ats) t)"])
  5317   finally 
  5318   have "(\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)) = 
  5319     (\<exists> x \<in> set (all_sums (?d, B)). qinterp (a#ats) (subst_p x p))"
  5320     using allsnov0 prems linform_isqfree unified_islinform[OF unifp]
  5321     by (simp add: all_sums_ex subst_p_corr)
  5322   also have "\<dots> = (qinterp (a#ats) ?dj2)"
  5323     using linform_isqfree unified_islinform[OF unifp]
  5324     by (simp add: explode_disj_corr)
  5325   finally have dj2th: 
  5326     "(\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)) =  
  5327     (qinterp (a#ats) ?dj2)" by simp
  5328   let ?result = "\<lambda>f. \<lambda>g. 
  5329     (case f of 
  5330     T \<Rightarrow> T
  5331     | F \<Rightarrow> g
  5332     | _ \<Rightarrow> (case g of 
  5333     T \<Rightarrow> T
  5334     | F \<Rightarrow> f
  5335     | _ \<Rightarrow> Or f g))"
  5336   have "?EXP a p =  qinterp (a#ats) (?result ?dj1 ?dj2)"
  5337     by (simp only: explode_minf.simps Let_def)
  5338   also
  5339   have "\<dots> = (qinterp (a#ats) ?dj1 \<or> qinterp (a#ats) ?dj2)" 
  5340     by (rule eval_Or_cases[where f="?dj1" and g="?dj2" and a="a" and ats="ats"])
  5341   also 
  5342   have "\<dots> = ((\<exists> j\<in> {1..?d}. ?QM j) \<or> 
  5343     (\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)))"
  5344     by (simp add: dj1_thm dj2th)
  5345   also
  5346   have "\<dots> = (\<exists> x. ?P x)"
  5347     using bst sym[OF cooper_mi_eq[OF unifp]] by simp
  5348   finally show ?thesis by simp
  5349 qed
  5350 
  5351 
  5352 lemma explode_minf_corr2:
  5353   assumes unifp : "isunified p"
  5354   and bst: "set (bset p) = set B"
  5355   shows "(qinterp ats (QEx p)) = (qinterp ats (decrvars(explode_minf (p,B))))"
  5356   (is "?P = (?Qe p)")
  5357 proof-
  5358   have "?P = (\<exists>x. qinterp (x#ats) p)" by simp
  5359   also have "\<dots>  = (qinterp (a # ats) (explode_minf (p,B)))"
  5360     using unifp bst explode_minf_corr by simp
  5361   finally have ex: "?P = (qinterp (a # ats) (explode_minf (p,B)))" .
  5362   have nv0: "novar0 (explode_minf (p,B))"
  5363     by (rule explode_minf_novar0[OF unifp])
  5364   show ?thesis
  5365     using qinterp_novar0[OF nv0] ex by simp
  5366 qed
  5367 
  5368 (* An implementation of cooper's method for both plus/minus/infinity *)
  5369 
  5370 (* unify the formula *)
  5371 definition unify:: "QF \<Rightarrow> (QF \<times> intterm list)" where
  5372   "unify p =
  5373   (let q = unitycoeff p;
  5374        B = list_set(bset q);
  5375        A = list_set (aset q)
  5376   in
  5377   if (length B \<le> length A)
  5378              then (q,B)
  5379              else (mirror q, map lin_neg A))"
  5380   
  5381 (* unify behaves like unitycoeff *)
  5382 lemma unify_ex:
  5383   assumes linp: "islinform p"
  5384   shows "qinterp ats (QEx p) = qinterp ats (QEx (fst (unify p)))"
  5385 proof-
  5386   have "length (list_set(bset (unitycoeff p))) \<le> length (list_set (aset (unitycoeff p))) \<or> length (list_set(bset (unitycoeff p))) > length (list_set (aset (unitycoeff p)))" by arith
  5387   moreover
  5388   {
  5389     assume "length (list_set(bset (unitycoeff p))) \<le> length (list_set (aset (unitycoeff p)))"
  5390     then have "fst (unify p) = unitycoeff p" using unify_def by (simp add: Let_def)
  5391     then have ?thesis using unitycoeff_corr[OF linp]
  5392       by simp
  5393   }
  5394   moreover 
  5395   {
  5396     assume "length (list_set(bset (unitycoeff p))) > length (list_set (aset (unitycoeff p)))"
  5397     then have unif: "fst(unify p) = mirror (unitycoeff p)"
  5398       using unify_def by (simp add: Let_def)
  5399     let ?q ="unitycoeff p"
  5400     have unifq: "isunified ?q" by(rule unitycoeff_unified[OF linp])
  5401     have linq: "islinform ?q" by (rule unified_islinform[OF unifq])
  5402     have "qinterp ats (QEx ?q) = qinterp ats (QEx (mirror ?q))" 
  5403       by (rule mirror_ex2[OF unifq])
  5404     moreover have "qinterp ats (QEx p) = qinterp ats (QEx ?q)"
  5405       using unitycoeff_corr linp by simp
  5406     ultimately have ?thesis using prems unif by simp
  5407   }
  5408   ultimately show ?thesis by blast
  5409 qed
  5410 
  5411 (* unify's result is a unified formula *)
  5412 lemma unify_unified: 
  5413   assumes linp: "islinform p"
  5414   shows "isunified (fst (unify p))"
  5415   using linp unitycoeff_unified mirror_unified unify_def unified_islinform
  5416   by (auto simp add: Let_def)
  5417 
  5418 
  5419 (* unify preserves quantifier-freeness*)
  5420 lemma unify_qfree:
  5421   assumes linp: "islinform p"
  5422   shows "isqfree (fst(unify p))"
  5423   using linp unify_unified unified_isqfree by simp
  5424 
  5425 lemma unify_bst: 
  5426   assumes linp: " islinform p" 
  5427   and unif: "unify p = (q,B)"
  5428   shows "set B = set (bset q)" 
  5429 proof-
  5430   let ?q = "unitycoeff p"
  5431   let ?a = "aset ?q"
  5432   let ?b = "bset ?q"
  5433   let ?la = "list_set ?a"
  5434   let ?lb = "list_set ?b"
  5435   have " length ?lb \<le> length ?la \<or> length ?lb > length ?la" by arith
  5436   moreover 
  5437   {
  5438     assume "length ?lb \<le> length ?la"
  5439     then
  5440     have "unify p = (?q,?lb)"using unify_def prems by (simp add: Let_def)
  5441     then 
  5442     have ?thesis using prems by (simp add: sym[OF list_set_set])
  5443   }
  5444   moreover
  5445   {    assume "length ?lb > length ?la"
  5446     have r: "unify p = (mirror ?q,map lin_neg ?la)"using unify_def prems by (simp add: Let_def)
  5447     have lin: "\<forall> x\<in> set (bset (mirror ?q)). islinintterm x"
  5448       using bset_lin mirror_unified unitycoeff_unified[OF linp] by auto
  5449     with r prems aset_eq_bset_mirror lin_neg_idemp unitycoeff_unified linp
  5450     have "set B = set (map lin_neg (map lin_neg (bset (mirror (unitycoeff p)))))"
  5451        by (simp add: sym[OF list_set_set])
  5452      also have "\<dots> = set (map (\<lambda>x. lin_neg (lin_neg x)) (bset (mirror (unitycoeff p))))"
  5453        by auto
  5454      also have "\<dots> = set (bset (mirror (unitycoeff p)))"
  5455        using lin lin_neg_idemp  by (auto simp add: map_idI)
  5456      finally
  5457      have ?thesis using r prems aset_eq_bset_mirror lin_neg_idemp unitycoeff_unified linp
  5458        by (simp add: sym[OF list_set_set])}
  5459   ultimately show ?thesis by blast
  5460 qed
  5461 
  5462 lemma explode_minf_unify_novar0: 
  5463   assumes linp: "islinform p"
  5464   shows "novar0 (explode_minf (unify p))"
  5465 proof-
  5466   have "\<exists> q B. unify p = (q,B)" by simp
  5467   then obtain "q" "B" where qB_def: "unify p = (q,B)" by blast
  5468   have unifq: "isunified q" using unify_unified[OF linp] qB_def by simp
  5469   have bst: "set B = set (bset q)" using unify_bst linp qB_def by simp
  5470   from unifq bst explode_minf_novar0 show ?thesis
  5471     using qB_def by simp
  5472 qed
  5473 
  5474 lemma explode_minf_unify_corr2:
  5475   assumes linp: "islinform p"
  5476   shows "qinterp ats (QEx p) = qinterp ats (decrvars(explode_minf(unify p)))"
  5477 proof-
  5478   have "\<exists> q B. unify p = (q,B)" by simp
  5479   then obtain "q" "B" where qB_def: "unify p = (q,B)" by blast
  5480   have unifq: "isunified q" using unify_unified[OF linp] qB_def by simp
  5481   have bst: "set (bset q) = set B" using unify_bst linp qB_def by simp
  5482   from explode_minf_corr2[OF unifq bst] unify_ex[OF linp] show ?thesis
  5483     using qB_def by simp
  5484 qed
  5485 (* An implementation of cooper's method *)
  5486 definition
  5487   cooper:: "QF \<Rightarrow> QF option" where
  5488   "cooper p = lift_un (\<lambda>q. decrvars(explode_minf (unify q))) (linform (nnf p))"
  5489 
  5490 (* cooper eliminates quantifiers *)
  5491 lemma cooper_qfree: "(\<And> q q'. \<lbrakk>isqfree q ; cooper q = Some q'\<rbrakk> \<Longrightarrow>  isqfree q')"
  5492 proof-
  5493   fix "q" "q'"
  5494   assume qfq: "isqfree q"
  5495     and qeq: "cooper q = Some q'"
  5496   from qeq have "\<exists>p. linform (nnf q) = Some p"
  5497     by (cases "linform (nnf q)") (simp_all add: cooper_def)
  5498   then obtain "p" where p_def: "linform (nnf q) = Some p" by blast
  5499   have linp: "islinform p" using p_def linform_lin nnf_isnnf qfq 
  5500     by auto
  5501   have nnfq: "isnnf (nnf q)" using nnf_isnnf qfq by simp
  5502   then have nnfp: "isnnf p" using linform_nnf[OF nnfq] p_def by auto
  5503   have qfp: "isqfree p" using linp linform_isqfree by simp 
  5504   have "cooper q = Some (decrvars(explode_minf (unify p)))" using p_def 
  5505     by (simp add: cooper_def del: explode_minf.simps)
  5506   then have "q' = decrvars (explode_minf (unify p))" using qeq by simp
  5507   with linp qfp nnfp  unify_unified unify_qfree unified_islinform 
  5508   show "isqfree q'"
  5509     using novar0_qfree explode_minf_unify_novar0 decrvars_qfree
  5510     by simp
  5511 qed
  5512 
  5513 (* cooper preserves semantics *)
  5514 lemma cooper_corr: "(\<And> q q' ats. \<lbrakk>isqfree q ; cooper q = Some q'\<rbrakk> \<Longrightarrow>  (qinterp ats (QEx q)) = (qinterp ats q'))"  (is "\<And> q q' ats. \<lbrakk> _ ; _ \<rbrakk> \<Longrightarrow> (?P ats (QEx q) = ?P ats q')")
  5515 proof-
  5516   fix "q" "q'" "ats"
  5517   assume qfq: "isqfree q"
  5518     and qeq: "cooper q = Some q'"
  5519   from qeq have "\<exists>p. linform (nnf q) = Some p"
  5520     by (cases "linform (nnf q)") (simp_all add: cooper_def)
  5521   then obtain "p" where p_def: "linform (nnf q) = Some p" by blast
  5522   have linp: "islinform p" using p_def linform_lin nnf_isnnf qfq by auto
  5523   have qfp: "isqfree p" using linp linform_isqfree by simp 
  5524   have nnfq: "isnnf (nnf q)" using nnf_isnnf qfq by simp
  5525   then have nnfp: "isnnf p" using linform_nnf[OF nnfq] p_def by auto
  5526   have "\<forall> ats. ?P ats q = ?P ats (nnf q)" using nnf_corr qfq by auto
  5527   then have qeqp: "\<forall> ats. ?P ats q = ?P ats p"
  5528     using linform_corr p_def nnf_isnnf qfq
  5529     by auto
  5530 
  5531   have "cooper q = Some (decrvars (explode_minf (unify p)))" using p_def 
  5532     by (simp add: cooper_def del: explode_minf.simps)
  5533   then have decr: "q' = decrvars(explode_minf (unify p))" using qeq by simp
  5534   have eqq:"?P ats (QEx q) = ?P ats (QEx p)" using qeqp by auto
  5535   with decr explode_minf_unify_corr2 unified_islinform unify_unified linp 
  5536   show "?P ats (QEx q) = ?P ats q'" by simp
  5537 qed  
  5538 
  5539 (* A decision procedure for Presburger Arithmetics *)
  5540 definition
  5541   pa:: "QF \<Rightarrow> QF option" where
  5542   "pa p \<equiv> lift_un psimpl (qelim(cooper, p))"
  5543 
  5544 lemma psimpl_qfree: "isqfree p \<Longrightarrow> isqfree (psimpl p)"
  5545 apply(induct p rule: isqfree.induct)
  5546 apply(auto simp add: Let_def)
  5547 apply (simp_all cong del: QF.weak_case_cong add: Let_def)
  5548 apply (case_tac "psimpl p", auto)
  5549 apply (case_tac "psimpl q", auto)
  5550 apply (case_tac "psimpl q", auto)
  5551 apply (case_tac "psimpl q", auto)
  5552 apply (case_tac "psimpl q", auto)
  5553 apply (case_tac "psimpl q", auto)
  5554 apply (case_tac "psimpl q", auto)
  5555 apply (case_tac "psimpl q", auto)
  5556 apply (case_tac "psimpl q", auto)
  5557 apply (case_tac "psimpl q", auto)
  5558 apply (case_tac "psimpl q", auto)
  5559 apply (case_tac "psimpl q", auto)
  5560 apply (case_tac "psimpl p", auto)
  5561 apply (case_tac "psimpl q", auto)
  5562 apply (case_tac "psimpl q", auto)
  5563 apply (case_tac "psimpl q", auto)
  5564 apply (case_tac "psimpl q", auto)
  5565 apply (case_tac "psimpl q", auto)
  5566 apply (case_tac "psimpl q", auto)
  5567 apply (case_tac "psimpl q", auto)
  5568 apply (case_tac "psimpl q", auto)
  5569 apply (case_tac "psimpl q", auto)
  5570 apply (case_tac "psimpl q", auto)
  5571 apply (case_tac "psimpl q", auto)
  5572 apply (case_tac "psimpl p", auto)
  5573 apply (case_tac "psimpl q", auto)
  5574 apply (case_tac "psimpl q", auto)
  5575 apply (case_tac "psimpl q", auto)
  5576 apply (case_tac "psimpl q", auto)
  5577 apply (case_tac "psimpl q", auto)
  5578 apply (case_tac "psimpl q", auto)
  5579 apply (case_tac "psimpl q", auto)
  5580 apply (case_tac "psimpl q", auto)
  5581 apply (case_tac "psimpl q", auto)
  5582 apply (case_tac "psimpl q", auto)
  5583 apply (case_tac "psimpl q", auto)
  5584 apply (case_tac "psimpl p", auto)
  5585 apply (case_tac "psimpl q", auto)
  5586 apply (case_tac "psimpl q", auto)
  5587 apply (case_tac "psimpl q", auto)
  5588 apply (case_tac "psimpl q", auto)
  5589 apply (case_tac "psimpl q", auto)
  5590 apply (case_tac "psimpl q", auto)
  5591 apply (case_tac "psimpl q", auto)
  5592 apply (case_tac "psimpl q", auto)
  5593 apply (case_tac "psimpl q", auto)
  5594 apply (case_tac "psimpl q", auto)
  5595 apply (case_tac "psimpl q", auto)
  5596 apply (case_tac "psimpl q", auto)
  5597 
  5598 apply (case_tac "psimpl p", auto)
  5599 apply (case_tac "lift_bin (\<lambda>x y. lin_add (x, lin_neg y), linearize y,
  5600                    linearize z)", auto)
  5601 apply (case_tac "a",auto)
  5602 apply (case_tac "lift_bin (\<lambda>x y. lin_add (x, lin_neg y), linearize ac,
  5603                    linearize ad)", auto)
  5604 apply (case_tac "a",auto)
  5605 apply (case_tac "ae", auto)
  5606 apply (case_tac "linearize af", auto)
  5607 by (case_tac "a", auto)
  5608 
  5609 (* pa eliminates quantifiers *)
  5610 theorem pa_qfree: "\<And> p'. pa p = Some p' \<Longrightarrow> isqfree p'"
  5611 proof(simp only: pa_def)
  5612 fix "p'"
  5613 assume qep: "lift_un psimpl (qelim (cooper, p)) = Some p'"
  5614 then have "\<exists> q. qelim (cooper, p) = Some q"
  5615   by (cases "qelim(cooper, p)") auto
  5616 then obtain "q" where q_def: "qelim (cooper, p) = Some q" by blast
  5617 have "\<And>q q'. \<lbrakk>isqfree q; cooper q = Some q'\<rbrakk> \<Longrightarrow> isqfree q'" using cooper_qfree by blast
  5618 with q_def
  5619 have "isqfree q" using qelim_qfree by blast
  5620 then have "isqfree (psimpl q)" using psimpl_qfree
  5621   by auto
  5622 then show "isqfree p'"
  5623   using prems 
  5624   by simp
  5625 
  5626 qed
  5627 
  5628 (* pa preserves semantics *)
  5629 theorem pa_corr: 
  5630   "\<And> p'. pa p = Some p' \<Longrightarrow> (qinterp ats p = qinterp ats p')"
  5631 proof(simp only: pa_def)
  5632   fix "p'"
  5633   assume qep: "lift_un psimpl (qelim(cooper, p)) = Some p'"
  5634  then have "\<exists> q. qelim (cooper, p) = Some q"
  5635   by (cases "qelim(cooper, p)") auto
  5636 then obtain "q" where q_def: "qelim (cooper, p) = Some q" by blast 
  5637   have cp1:"\<And>q q' ats. 
  5638     \<lbrakk>isqfree q; cooper q = Some q'\<rbrakk> \<Longrightarrow> qinterp ats (QEx q) = qinterp ats q'"
  5639     using cooper_corr by blast
  5640   moreover have cp2: "\<And>q q'. \<lbrakk>isqfree q; cooper q = Some q'\<rbrakk> \<Longrightarrow> isqfree q'"
  5641     using cooper_qfree by blast
  5642   ultimately have "qinterp ats p = qinterp ats q" using qelim_corr qep psimpl_corr q_def
  5643     by blast
  5644   then have "qinterp ats p = qinterp ats (psimpl q)" using psimpl_corr q_def
  5645     by auto
  5646   then show "qinterp ats p = qinterp ats p'" using prems 
  5647     by simp
  5648 qed
  5649 
  5650 lemma [code]: "linearize (Mult i j) = 
  5651   (case linearize i of
  5652   None \<Rightarrow> None
  5653   | Some li \<Rightarrow> (case li of 
  5654      Cst b \<Rightarrow> (case linearize j of
  5655       None \<Rightarrow> None
  5656      | (Some lj) \<Rightarrow> Some (lin_mul(b,lj)))
  5657   | _ \<Rightarrow> (case linearize j of
  5658       None \<Rightarrow> None
  5659     | (Some lj) \<Rightarrow> (case lj of 
  5660         Cst b \<Rightarrow> Some (lin_mul (b,li))
  5661       | _ \<Rightarrow> None))))"
  5662 by simp
  5663 
  5664 lemma [code]: "psimpl (And p q) = 
  5665   (let p'= psimpl p
  5666   in (case p' of 
  5667        F \<Rightarrow> F
  5668       |T \<Rightarrow> psimpl q
  5669       | _ \<Rightarrow> let q' = psimpl q
  5670              in (case q' of
  5671                      F \<Rightarrow> F
  5672                    | T \<Rightarrow> p'
  5673                    | _ \<Rightarrow> (And p' q'))))"
  5674 
  5675 by simp
  5676 
  5677 lemma [code]: "psimpl (Or p q) = 
  5678   (let p'= psimpl p
  5679   in (case p' of 
  5680         T \<Rightarrow> T
  5681       | F \<Rightarrow> psimpl q
  5682       | _ \<Rightarrow> let q' = psimpl q
  5683              in (case q' of
  5684                      T \<Rightarrow> T
  5685                    | F \<Rightarrow> p'
  5686                    | _ \<Rightarrow> (Or p' q'))))"
  5687 
  5688 by simp
  5689 
  5690 lemma [code]: "psimpl (Imp p q) = 
  5691   (let p'= psimpl p
  5692   in (case p' of 
  5693        F \<Rightarrow> T
  5694       |T \<Rightarrow> psimpl q
  5695       | NOT p1 \<Rightarrow> let q' = psimpl q
  5696              in (case q' of
  5697                      F \<Rightarrow> p1
  5698                    | T \<Rightarrow> T
  5699                    | _ \<Rightarrow> (Or p1 q'))
  5700       | _ \<Rightarrow> let q' = psimpl q
  5701              in (case q' of
  5702                      F \<Rightarrow> NOT p'
  5703                    | T \<Rightarrow> T
  5704                    | _ \<Rightarrow> (Imp p' q'))))"
  5705 by simp
  5706 
  5707 declare zdvd_iff_zmod_eq_0 [code]
  5708 
  5709 (*
  5710 generate_code ("presburger.ML") test = "pa"
  5711 use "rcooper.ML"
  5712 oracle rpresburger_oracle ("term") = RCooper.rpresburger_oracle
  5713 use "rpresbtac.ML"
  5714 setup RPresburger.setup
  5715 *)
  5716 
  5717 end