src/HOL/ex/Reflected_Presburger.thy
author obua
Mon Apr 10 16:00:34 2006 +0200 (2006-04-10)
changeset 19404 9bf2cdc9e8e8
parent 18576 8d98b7711e47
child 19623 12e6cc4382ae
permissions -rw-r--r--
Moved stuff from Ring_and_Field to Matrix
     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
    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 constdefs islint :: "intterm \<Rightarrow> bool"
   533   "islint t \<equiv> islintn(0,t)"
   534 
   535 (* And the equivalence to the first definition *)
   536 lemma islinintterm_eq_islint: "islinintterm t = islint t"
   537   using islint_def
   538 by (induct t rule: islinintterm.induct) auto
   539 
   540 (* monotony *)
   541 lemma islintn_mon:
   542   assumes lin: "islintn (n,t)"
   543   and mgen: "m \<le> n"
   544   shows "islintn(m,t)"
   545   using lin mgen 
   546 by (induct t rule: islintn.induct) auto
   547 
   548 lemma islintn_subt:
   549   assumes lint: "islintn(n,Add (Mult (Cst i) (Var m)) r)"
   550   shows "islintn (m+1,r)"
   551 using lint
   552 by auto
   553 
   554 (* List indexin for n > 0 *)
   555 lemma nth_pos: "0 < n \<longrightarrow> (x#xs) ! n = (y#xs) ! n"
   556 using Nat.gr0_conv_Suc 
   557 by clarsimp 
   558 
   559 lemma nth_pos2: "0 < n \<Longrightarrow> (x#xs) ! n = xs ! (n - 1)"
   560 using Nat.gr0_conv_Suc
   561 by clarsimp
   562 
   563 lemma intterm_novar0: 
   564   assumes lin: "islinintterm (Add (Mult (Cst i) (Var n)) r)"
   565   shows "I_intterm (x#ats) r = I_intterm (y#ats) r"
   566 using lin
   567 by (induct r rule: islinintterm.induct) (simp_all add: nth_pos2)
   568 (* a simple version of a general theorem: Interpretation does not depend 
   569    on the first variable if it does not occur in the term *)
   570 
   571 lemma linterm_novar0:
   572   assumes lin: "islintn (n,t)"
   573   and npos: "0 < n"
   574   shows "I_intterm (x#ats) t = I_intterm (y#ats) t"
   575 using lin npos
   576 by (induct n t rule: islintn.induct) (simp_all add: nth_pos2)
   577 
   578 (* Periodicity of dvd *)
   579 lemma dvd_period:
   580   assumes advdd: "(a::int) dvd d"
   581   shows "(a dvd (x + t)) = (a dvd ((x+ c*d) + t))"
   582 using advdd  
   583 proof-
   584   from advdd  have "\<forall>x.\<forall>k. (((a::int) dvd (x + t)) = (a dvd
   585  (x+k*d + t)))" by (rule dvd_modd_pinf)
   586   then show ?thesis by simp
   587 qed
   588 
   589 (* lin_ad adds two linear terms*)
   590 consts lin_add :: "intterm \<times> intterm \<Rightarrow> intterm"
   591 recdef lin_add "measure (\<lambda>(x,y). ((size x) + (size y)))"
   592 "lin_add (Add (Mult (Cst c1) (Var n1)) (r1),Add (Mult (Cst c2) (Var n2)) (r2)) =
   593   (if n1=n2 then 
   594   (let c = Cst (c1 + c2) 
   595    in (if c1+c2=0 then lin_add(r1,r2) else Add (Mult c (Var n1)) (lin_add (r1,r2))))
   596   else if n1 \<le> n2 then (Add (Mult (Cst c1) (Var n1)) (lin_add (r1,Add (Mult (Cst c2) (Var n2)) (r2)))) 
   597   else (Add (Mult (Cst c2) (Var n2)) (lin_add (Add (Mult (Cst c1) (Var n1)) r1,r2))))"
   598 "lin_add (Add (Mult (Cst c1) (Var n1)) (r1),Cst b) = 
   599   (Add (Mult (Cst c1) (Var n1)) (lin_add (r1, Cst b)))"  
   600 "lin_add (Cst x,Add (Mult (Cst c2) (Var n2)) (r2)) = 
   601   Add (Mult (Cst c2) (Var n2)) (lin_add (Cst x,r2))" 
   602 "lin_add (Cst b1, Cst b2) = Cst (b1+b2)"
   603 
   604 lemma lin_add_cst_corr: 
   605   assumes blin : "islintn(n0,b)"
   606   shows "I_intterm ats (lin_add (Cst a,b)) = (I_intterm ats (Add (Cst a) b))"
   607 using blin
   608 by (induct n0 b rule: islintn.induct) auto
   609 
   610 lemma lin_add_cst_corr2: 
   611   assumes blin : "islintn(n0,b)"
   612   shows "I_intterm ats (lin_add (b,Cst a)) = (I_intterm ats (Add b (Cst a)))"
   613 using blin
   614 by (induct n0 b rule: islintn.induct) auto
   615 
   616 lemma lin_add_corrh: "\<And> n01 n02. \<lbrakk> islintn (n01,a) ; islintn (n02,b)\<rbrakk> 
   617   \<Longrightarrow> I_intterm ats (lin_add(a,b)) = I_intterm ats (Add a b)"
   618 proof(induct a b rule: lin_add.induct)
   619   case (58 i n r j m s) 
   620   have "(n = m \<and> i+j = 0) \<or> (n = m \<and> i+j \<noteq> 0) \<or> n < m \<or> m < n " by arith
   621   moreover
   622   {assume "n=m\<and>i+j=0" hence ?case using prems by (auto simp add: sym[OF zadd_zmult_distrib]) }
   623   moreover
   624   {assume "n=m\<and>i+j\<noteq>0" hence ?case using prems by (auto simp add: Let_def zadd_zmult_distrib)}
   625   moreover
   626   {assume "n < m" hence ?case using prems by auto }
   627   moreover
   628   {assume "n > m" hence ?case using prems by auto }
   629   ultimately show ?case by blast
   630 qed (auto simp add: lin_add_cst_corr lin_add_cst_corr2 Let_def)
   631 
   632 (* lin_add has the semantics of Add*)
   633 lemma lin_add_corr:
   634   assumes lina: "islinintterm a"
   635   and linb: "islinintterm b"
   636   shows "I_intterm ats (lin_add (a,b)) = (I_intterm ats (Add a b))"
   637 using lina linb islinintterm_eq_islint islint_def lin_add_corrh
   638 by blast
   639 
   640 lemma lin_add_cst_lint:
   641   assumes lin: "islintn (n0,b)"
   642   shows "islintn (n0, lin_add (Cst i, b))"
   643 using lin
   644 by (induct n0 b rule: islintn.induct) auto
   645 
   646 lemma lin_add_cst_lint2:
   647   assumes lin: "islintn (n0,b)"
   648   shows "islintn (n0, lin_add (b,Cst i))"
   649 using lin
   650 by (induct n0 b rule: islintn.induct) auto
   651 
   652 (* lin_add preserves linearity..*)
   653 lemma lin_add_lint: "\<And> n0 n01 n02. \<lbrakk> islintn (n01,a) ; islintn (n02,b); n0 \<le>  min n01 n02 \<rbrakk> 
   654   \<Longrightarrow> islintn (n0, lin_add (a,b))"
   655 proof (induct a b rule: lin_add.induct)
   656   case (58 i n r j m s)
   657   have "(n =m \<and> i + j = 0) \<or> (n = m \<and> i+j \<noteq> 0) \<or> n <m \<or> m < n" by arith
   658   moreover 
   659   { assume "n = m"
   660       and  "i+j = 0"
   661     hence ?case using "58" islintn_mon[where m = "n01" and n = "Suc m"]
   662       islintn_mon[where m = "n02" and n = "Suc m"] by auto }
   663   moreover 
   664   { assume  "n = m"
   665       and "i+j \<noteq> 0"
   666     hence ?case using "58" islintn_mon[where m = "n01" and n = "Suc m"]
   667       islintn_mon[where m = "n02" and n = "Suc m"] by (auto simp add: Let_def) }
   668   moreover
   669   { assume "n < m" hence ?case using 58 by force }
   670 moreover
   671   { assume "m < n"
   672     hence ?case using 58 
   673       apply (auto simp add: Let_def) 
   674       apply (erule allE[where x = "Suc m" ] )
   675       by (erule allE[where x = "Suc m" ] ) simp }
   676   ultimately show ?case by blast
   677 qed(simp_all add: Let_def lin_add_cst_lint lin_add_cst_lint2)
   678 
   679 lemma lin_add_lin:
   680   assumes lina: "islinintterm a"
   681   and linb: "islinintterm b"
   682   shows "islinintterm (lin_add (a,b))"
   683 using islinintterm_eq_islint islint_def lin_add_lint lina linb by auto
   684 
   685 (* lin_mul multiplies a linear term by a constant *)
   686 consts lin_mul :: "int \<times> intterm \<Rightarrow> intterm"
   687 recdef lin_mul "measure (\<lambda>(c,t). size t)"
   688 "lin_mul (c,Cst i) = (Cst (c*i))"
   689 "lin_mul (c,Add (Mult (Cst c') (Var n)) r)  = 
   690   (if c = 0 then (Cst 0) else
   691   (Add (Mult (Cst (c*c')) (Var n)) (lin_mul (c,r))))"
   692 
   693 lemma zmult_zadd_distrib[simp]: "(a::int) * (b+c) = a*b + a*c"
   694 proof-
   695   have "a*(b+c) = (b+c)*a" by simp
   696   moreover have "(b+c)*a = b*a + c*a" by (simp add: zadd_zmult_distrib)
   697   ultimately show ?thesis by simp
   698 qed
   699 
   700 (* lin_mul has the semantics of Mult *)
   701 lemma lin_mul_corr: 
   702   assumes lint: "islinintterm  t"
   703   shows "I_intterm ats (lin_mul (c,t)) = I_intterm ats (Mult (Cst c) t)"
   704 using lint
   705 proof (induct c t rule: lin_mul.induct)
   706   case (21 c c' n r)
   707   have "islinintterm (Add (Mult (Cst c') (Var n)) r)" .
   708   then have "islinintterm r" 
   709     by (rule islinintterm_subt[of "c'" "n" "r"])
   710   then show ?case  using "21.hyps" "21.prems" by simp
   711 qed(auto)
   712 
   713 (* lin_mul preserves linearity *)
   714 lemma lin_mul_lin:
   715   assumes lint: "islinintterm t"
   716   shows "islinintterm (lin_mul(c,t))"
   717 using lint
   718 by (induct t rule: islinintterm.induct) auto
   719 
   720 lemma lin_mul0:
   721   assumes lint: "islinintterm t"
   722   shows "lin_mul(0,t) = Cst 0"
   723   using lint
   724   by (induct t rule: islinintterm.induct) auto
   725 
   726 lemma lin_mul_lintn:
   727   "\<And> m. islintn(m,t) \<Longrightarrow> islintn(m,lin_mul(l,t))"
   728   by (induct l t rule: lin_mul.induct) simp_all
   729 
   730 (* lin_neg neagtes a linear term *)
   731 constdefs lin_neg :: "intterm \<Rightarrow> intterm"
   732 "lin_neg i == lin_mul ((-1::int),i)"
   733 
   734 (* lin_neg has the semantics of Neg *)
   735 lemma lin_neg_corr:
   736   assumes lint: "islinintterm  t"
   737   shows "I_intterm ats (lin_neg t) = I_intterm ats (Neg t)"
   738   using lint lin_mul_corr
   739   by (simp add: lin_neg_def lin_mul_corr)
   740 
   741 (* lin_neg preserves linearity *)
   742 lemma lin_neg_lin:
   743   assumes lint: "islinintterm  t"
   744   shows "islinintterm (lin_neg t)"
   745 using lint
   746 by (simp add: lin_mul_lin lin_neg_def)
   747 
   748 (* Some properties about lin_add and lin-neg should be moved above *)
   749 
   750 lemma lin_neg_idemp: 
   751   assumes lini: "islinintterm i"
   752   shows "lin_neg (lin_neg i) = i"
   753 using lini
   754 by (induct i rule: islinintterm.induct) (auto simp add: lin_neg_def)
   755 
   756 lemma lin_neg_lin_add_distrib:
   757   assumes lina : "islinintterm a"
   758   and linb :"islinintterm b"
   759   shows "lin_neg (lin_add(a,b)) = lin_add (lin_neg a, lin_neg b)"
   760 using lina linb
   761 proof (induct a b rule: lin_add.induct)
   762   case (58 c1 n1 r1 c2 n2 r2)
   763   from prems have lincnr1:"islinintterm (Add (Mult (Cst c1) (Var n1)) r1)" by simp
   764   have linr1: "islinintterm r1" by (rule islinintterm_subt[OF lincnr1])
   765   from prems have lincnr2: "islinintterm (Add (Mult (Cst c2) (Var n2)) r2)" by simp
   766   have linr2: "islinintterm r2" by (rule islinintterm_subt[OF lincnr2])
   767   have "n1 = n2 \<or> n1 < n2 \<or> n1 > n2" by arith
   768   show ?case using prems linr1 linr2 by (simp_all add: lin_neg_def Let_def)
   769 next
   770   case (59 c n r b) 
   771   from prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var n)) r)" by simp
   772   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
   773   show ?case using prems linr by (simp add: lin_neg_def Let_def)
   774 next
   775   case (60 b c n r)
   776   from prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var n)) r)" by simp
   777   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
   778   show ?case  using prems linr by (simp add: lin_neg_def Let_def)
   779 qed (simp_all add: lin_neg_def)
   780 
   781 (* linearize tries to linearize a term *)
   782 consts linearize :: "intterm \<Rightarrow> intterm option"
   783 recdef linearize "measure (\<lambda>t. size t)"
   784 "linearize (Cst b) = Some (Cst b)"
   785 "linearize (Var n) = Some (Add (Mult (Cst 1) (Var n)) (Cst 0))"
   786 "linearize (Neg i) = lift_un lin_neg (linearize i)"
   787  "linearize (Add i j) = lift_bin(\<lambda> x. \<lambda> y. lin_add(x,y), linearize i, linearize j)"
   788 "linearize (Sub i j) = 
   789   lift_bin(\<lambda> x. \<lambda> y. lin_add(x,lin_neg y), linearize i, linearize j)"
   790 "linearize (Mult i j) = 
   791   (case linearize i of
   792   None \<Rightarrow> None
   793   | Some li \<Rightarrow> (case li of 
   794      Cst b \<Rightarrow> (case linearize j of
   795       None \<Rightarrow> None
   796      | (Some lj) \<Rightarrow> Some (lin_mul(b,lj)))
   797   | _ \<Rightarrow> (case linearize j of
   798       None \<Rightarrow> None
   799     | (Some lj) \<Rightarrow> (case lj of 
   800         Cst b \<Rightarrow> Some (lin_mul (b,li))
   801       | _ \<Rightarrow> None))))"
   802 
   803 lemma linearize_linear1:
   804   assumes lin: "linearize t \<noteq> None"
   805   shows "islinintterm (the (linearize t))"
   806 using lin
   807 proof (induct t rule: linearize.induct)
   808   case (1 b) show ?case by simp  
   809 next 
   810   case (2 n) show ?case by simp 
   811 next 
   812   case (3 i) show ?case 
   813     proof-
   814     have "(linearize i = None) \<or> (\<exists>li. linearize i = Some li)" by auto
   815     moreover 
   816     { assume "linearize i = None" with prems have ?thesis by auto}
   817     moreover 
   818     { assume lini: "\<exists>li. linearize i = Some li"
   819       from lini obtain "li" where  "linearize i = Some li" by blast
   820       have linli: "islinintterm li" by (simp!)
   821       moreover have "linearize (Neg i) = Some (lin_neg li)" using prems by simp
   822       moreover from linli have "islinintterm(lin_neg li)" by (simp add: lin_neg_lin)
   823       ultimately have ?thesis by simp
   824     }
   825     ultimately show ?thesis by blast
   826   qed
   827 next 
   828   case (4 i j) show ?case 
   829     proof-
   830     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 
   831     moreover 
   832     {
   833       assume nlini: "linearize i = None"
   834       from nlini have "linearize (Add i j) = None" 
   835 	by (simp add: Let_def measure_def inv_image_def) then have ?thesis using prems by auto}
   836     moreover 
   837     { assume nlinj: "linearize j = None"
   838 	and lini: "\<exists> li. linearize i = Some li"
   839       from nlinj lini have "linearize (Add i j) = None" 
   840 	by (simp add: Let_def measure_def inv_image_def, auto) with prems  have ?thesis by auto}
   841     moreover 
   842     { assume lini: "\<exists>li. linearize i = Some li"
   843 	and linj: "\<exists>lj. linearize j = Some lj"
   844       from lini obtain "li" where  "linearize i = Some li" by blast
   845       have linli: "islinintterm li" by (simp!)
   846       from linj obtain "lj" where  "linearize j = Some lj" by blast
   847       have linlj: "islinintterm lj" by (simp!)
   848       moreover from lini linj have "linearize (Add i j) = Some (lin_add (li,lj))" 
   849 	by (simp add: measure_def inv_image_def, auto!)
   850       moreover from linli linlj have "islinintterm(lin_add (li,lj))" by (simp add: lin_add_lin)
   851       ultimately have ?thesis by simp  }
   852     ultimately show ?thesis by blast
   853   qed
   854 next 
   855   case (5 i j)show ?case 
   856     proof-
   857     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 
   858     moreover 
   859     {
   860       assume nlini: "linearize i = None"
   861       from nlini have "linearize (Sub i j) = None" by (simp add: Let_def measure_def inv_image_def) then have ?thesis by (auto!)
   862     }
   863     moreover 
   864     {
   865       assume lini: "\<exists> li. linearize i = Some li"
   866 	and nlinj: "linearize j = None"
   867       from nlinj lini have "linearize (Sub i j) = None" 
   868 	by (simp add: Let_def measure_def inv_image_def, auto) then have ?thesis by (auto!)
   869     }
   870     moreover 
   871     {
   872       assume lini: "\<exists>li. linearize i = Some li"
   873 	and linj: "\<exists>lj. linearize j = Some lj"
   874       from lini obtain "li" where  "linearize i = Some li" by blast
   875       have linli: "islinintterm li" by (simp!)
   876       from linj obtain "lj" where  "linearize j = Some lj" by blast
   877       have linlj: "islinintterm lj" by (simp!)
   878       moreover from lini linj have "linearize (Sub i j) = Some (lin_add (li,lin_neg lj))" 
   879 	by (simp add: measure_def inv_image_def, auto!)
   880       moreover from linli linlj have "islinintterm(lin_add (li,lin_neg lj))" by (simp add: lin_add_lin lin_neg_lin)
   881       ultimately have ?thesis by simp
   882     }
   883     ultimately show ?thesis by blast
   884   qed
   885 next
   886   case (6 i j)show ?case 
   887     proof-
   888       have cses: "(linearize i = None) \<or> 
   889 	((\<exists> li. linearize i = Some li) \<and> linearize j = None) \<or> 
   890 	((\<exists> li. linearize i = Some li) \<and> (\<exists> bj. linearize j = Some (Cst bj)))
   891 	\<or> ((\<exists> bi. linearize i = Some (Cst bi)) \<and> (\<exists> lj. linearize j = Some lj))
   892 	\<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 
   893     moreover 
   894     {
   895       assume nlini: "linearize i = None"
   896       from nlini have "linearize (Mult i j) = None" 
   897 	by (simp add: Let_def measure_def inv_image_def)  
   898       with prems have ?thesis by auto }
   899     moreover 
   900     {  assume lini: "\<exists> li. linearize i = Some li"
   901 	and nlinj: "linearize j = None"
   902       from lini obtain "li" where "linearize i = Some li" by blast 
   903       moreover from nlinj lini have "linearize (Mult i j) = None"
   904 	using prems
   905 	by (cases li ) (auto simp add: Let_def measure_def inv_image_def)
   906       with prems have ?thesis by auto}
   907     moreover 
   908     { assume lini: "\<exists>li. linearize i = Some li"
   909 	and linj: "\<exists>bj. linearize j = Some (Cst bj)"
   910       from lini obtain "li" where  li_def: "linearize i = Some li" by blast
   911       from prems have linli: "islinintterm li" by simp
   912       moreover 
   913       from linj  obtain "bj" where  bj_def: "linearize j = Some (Cst bj)" by blast
   914       have linlj: "islinintterm (Cst bj)" by simp 
   915       moreover from lini linj prems 
   916       have "linearize (Mult i j) = Some (lin_mul (bj,li))"
   917 	by (cases li) (auto simp add: measure_def inv_image_def)
   918       moreover from linli linlj have "islinintterm(lin_mul (bj,li))" by (simp add: lin_mul_lin)
   919       ultimately have ?thesis by simp  }
   920     moreover 
   921     { assume lini: "\<exists>bi. linearize i = Some (Cst bi)"
   922 	and linj: "\<exists>lj. linearize j = Some lj"
   923       from lini obtain "bi" where  "linearize i = Some (Cst bi)" by blast
   924       from prems have linli: "islinintterm (Cst bi)" by simp
   925       moreover 
   926       from linj  obtain "lj" where  "linearize j = Some lj" by blast
   927       from prems have linlj: "islinintterm lj" by simp
   928       moreover from lini linj prems have "linearize (Mult i j) = Some (lin_mul (bi,lj))" 
   929 	by (simp add: measure_def inv_image_def) 
   930       moreover from linli linlj have "islinintterm(lin_mul (bi,lj))" by (simp add: lin_mul_lin)
   931       ultimately have ?thesis by simp }
   932     moreover 
   933     { assume linc: "\<exists> li. linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)"
   934 	and ljnc: "\<exists> lj. linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)"
   935       from linc obtain "li" where "linearize i = Some li \<and> \<not> (\<exists> bi. li = Cst bi)" by blast
   936       moreover 
   937       from ljnc obtain "lj" where "linearize j = Some lj \<and> \<not> (\<exists> bj. lj = Cst bj)" by blast
   938       ultimately have "linearize (Mult i j) = None"
   939 	by (cases li, auto simp add: measure_def inv_image_def) (cases lj, auto)+
   940       with prems have ?thesis by simp }
   941     ultimately show ?thesis by blast
   942   qed
   943 qed  
   944 
   945 (* the result of linearize, when successful, is a linear term*)
   946 lemma linearize_linear: "\<And> t'. linearize t = Some t' \<Longrightarrow> islinintterm t'"
   947 proof-
   948   fix t'
   949   assume lint: "linearize t = Some t'"
   950   from lint have lt: "linearize t \<noteq> None" by auto
   951   then have "islinintterm (the (linearize t))" by (rule_tac  linearize_linear1[OF lt])
   952   with lint show "islinintterm t'" by simp
   953 qed
   954 
   955 lemma linearize_corr1: 
   956   assumes lin: "linearize t \<noteq> None"
   957   shows "I_intterm ats t = I_intterm ats (the (linearize t))"
   958 using lin
   959 proof (induct t rule: linearize.induct)
   960   case (3 i) show ?case 
   961     proof-
   962     have "(linearize i = None) \<or> (\<exists>li. linearize i = Some li)" by auto
   963     moreover 
   964     {
   965       assume "linearize i = None"
   966       have ?thesis using prems by simp
   967     }
   968     moreover 
   969     {
   970       assume lini: "\<exists>li. linearize i = Some li"
   971       from lini have lini2: "linearize i \<noteq> None" by auto
   972       from lini obtain "li" where  "linearize i = Some li" by blast
   973       from lini2 lini have "islinintterm (the (linearize i))"
   974 	by (simp add: linearize_linear1[OF lini2])
   975       then have linli: "islinintterm li" using prems by simp
   976       have ieqli: "I_intterm ats i = I_intterm ats li" using prems by simp
   977       moreover have "linearize (Neg i) = Some (lin_neg li)" using prems by simp
   978       moreover from ieqli linli have "I_intterm ats (Neg i) = I_intterm ats (lin_neg li)" by (simp add: lin_neg_corr[OF linli])
   979       ultimately have ?thesis using prems by (simp add: lin_neg_corr)
   980     }
   981     ultimately show ?thesis by blast
   982   qed
   983 next 
   984   case (4 i j) show ?case 
   985     proof-
   986     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 
   987     moreover 
   988     {
   989       assume nlini: "linearize i = None"
   990       from nlini have "linearize (Add i j) = None" by (simp add: Let_def measure_def inv_image_def) then have ?thesis using prems by auto
   991     }
   992     moreover 
   993     {
   994       assume nlinj: "linearize j = None"
   995 	and lini: "\<exists> li. linearize i = Some li"
   996       from nlinj lini have "linearize (Add i j) = None" 
   997 	by (simp add: Let_def measure_def inv_image_def, 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 add: measure_def inv_image_def)
  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 add: Let_def measure_def inv_image_def) 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 (simp add: Let_def measure_def inv_image_def, 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 add: measure_def inv_image_def)
  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 add: Let_def measure_def inv_image_def) 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 add: Let_def measure_def inv_image_def)
  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 simp add: measure_def inv_image_def) 
  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 simp add: measure_def inv_image_def)
  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))" 	apply (simp add: measure_def inv_image_def) 
  1117 	apply auto 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 add: measure_def inv_image_def)
  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 constdefs lcm :: "nat \<times> nat \<Rightarrow> nat"
  1628   "lcm \<equiv> (\<lambda>(m,n). m*n div gcd(m,n))"
  1629 
  1630 constdefs ilcm :: "int \<Rightarrow> int \<Rightarrow> int"
  1631   "ilcm \<equiv> \<lambda>i.\<lambda>j. int (lcm(nat(abs i),nat(abs j)))"
  1632 
  1633 (* ilcm_dvd12 are needed later *)
  1634 lemma lcm_dvd1: 
  1635   assumes mpos: " m >0"
  1636   and npos: "n>0"
  1637   shows "m dvd (lcm(m,n))"
  1638 proof-
  1639   have "gcd(m,n) dvd n" by simp
  1640   then obtain "k" where "n = gcd(m,n) * k" using dvd_def by auto
  1641   then have "m*n div gcd(m,n) = m*(gcd(m,n)*k) div gcd(m,n)" by (simp add: mult_ac)
  1642   also have "\<dots> = m*k" using mpos npos gcd_zero by simp
  1643   finally show ?thesis by (simp add: lcm_def)
  1644 qed
  1645 
  1646 lemma lcm_dvd2: 
  1647   assumes mpos: " m >0"
  1648   and npos: "n>0"
  1649   shows "n dvd (lcm(m,n))"
  1650 proof-
  1651   have "gcd(m,n) dvd m" by simp
  1652   then obtain "k" where "m = gcd(m,n) * k" using dvd_def by auto
  1653   then have "m*n div gcd(m,n) = (gcd(m,n)*k)*n div gcd(m,n)" by (simp add: mult_ac)
  1654   also have "\<dots> = n*k" using mpos npos gcd_zero by simp
  1655   finally show ?thesis by (simp add: lcm_def)
  1656 qed
  1657 
  1658 lemma ilcm_dvd1: 
  1659 assumes anz: "a \<noteq> 0" 
  1660   and bnz: "b \<noteq> 0"
  1661   shows "a dvd (ilcm a b)"
  1662 proof-
  1663   let ?na = "nat (abs a)"
  1664   let ?nb = "nat (abs b)"
  1665   have nap: "?na >0" using anz by simp
  1666   have nbp: "?nb >0" using bnz by simp
  1667   from nap nbp have "?na dvd lcm(?na,?nb)" using lcm_dvd1 by simp
  1668   thus ?thesis by (simp add: ilcm_def dvd_int_iff)
  1669 qed
  1670 
  1671 
  1672 lemma ilcm_dvd2: 
  1673 assumes anz: "a \<noteq> 0" 
  1674   and bnz: "b \<noteq> 0"
  1675   shows "b dvd (ilcm a b)"
  1676 proof-
  1677   let ?na = "nat (abs a)"
  1678   let ?nb = "nat (abs b)"
  1679   have nap: "?na >0" using anz by simp
  1680   have nbp: "?nb >0" using bnz by simp
  1681   from nap nbp have "?nb dvd lcm(?na,?nb)" using lcm_dvd2 by simp
  1682   thus ?thesis by (simp add: ilcm_def dvd_int_iff)
  1683 qed
  1684 
  1685 lemma zdvd_self_abs1: "(d::int) dvd (abs d)"
  1686 by (case_tac "d <0", simp_all)
  1687 
  1688 lemma zdvd_self_abs2: "(abs (d::int)) dvd d"
  1689 by (case_tac "d<0", simp_all)
  1690 
  1691 (* lcm a b is positive for positive a and b *)
  1692 
  1693 lemma lcm_pos: 
  1694   assumes mpos: "m > 0"
  1695   and npos: "n>0"
  1696   shows "lcm (m,n) > 0"
  1697 
  1698 proof(rule ccontr, simp add: lcm_def gcd_zero)
  1699 assume h:"m*n div gcd(m,n) = 0"
  1700 from mpos npos have "gcd (m,n) \<noteq> 0" using gcd_zero by simp
  1701 hence gcdp: "gcd(m,n) > 0" by simp
  1702 with h
  1703 have "m*n < gcd(m,n)"
  1704   by (cases "m * n < gcd (m, n)") (auto simp add: div_if[OF gcdp, where m="m*n"])
  1705 moreover 
  1706 have "gcd(m,n) dvd m" by simp
  1707  with mpos dvd_imp_le have t1:"gcd(m,n) \<le> m" by simp
  1708  with npos have t1:"gcd(m,n)*n \<le> m*n" by simp
  1709  have "gcd(m,n) \<le> gcd(m,n)*n" using npos by simp
  1710  with t1 have "gcd(m,n) \<le> m*n" by arith
  1711 ultimately show "False" by simp
  1712 qed
  1713 
  1714 lemma ilcm_pos: 
  1715   assumes apos: " 0 < a"
  1716   and bpos: "0 < b" 
  1717   shows "0 < ilcm  a b"
  1718 proof-
  1719   let ?na = "nat (abs a)"
  1720   let ?nb = "nat (abs b)"
  1721   have nap: "?na >0" using apos by simp
  1722   have nbp: "?nb >0" using bpos by simp
  1723   have "0 < lcm (?na,?nb)" by (rule lcm_pos[OF nap nbp])
  1724   thus ?thesis by (simp add: ilcm_def)
  1725 qed
  1726 
  1727 (* fomlcm computes the lcm of all c, where c is the coeffitient of Var 0 *)
  1728 consts formlcm :: "QF \<Rightarrow> int"
  1729 recdef formlcm "measure size"
  1730 "formlcm (Le (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = abs c "
  1731 "formlcm (Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = abs c "
  1732 "formlcm (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = abs c"
  1733 "formlcm (NOT p) = formlcm p"
  1734 "formlcm (And p q)= ilcm (formlcm p) (formlcm q)"
  1735 "formlcm (Or p q) = ilcm (formlcm p) (formlcm q)"
  1736 "formlcm p = 1"
  1737 
  1738 (* the property that formlcm should fullfill *)
  1739 consts divideallc:: "int \<times> QF \<Rightarrow> bool"
  1740 recdef divideallc "measure (\<lambda>(i,p). size p)"
  1741 "divideallc (l,Le (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = (c dvd l)"
  1742 "divideallc (l,Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i)) = (c dvd l)"
  1743 "divideallc(l,Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = (c dvd l)"
  1744 "divideallc (l,NOT p) = divideallc(l,p)"
  1745 "divideallc (l,And p q) = (divideallc (l,p) \<and> divideallc (l,q))"
  1746 "divideallc (l,Or p q) = (divideallc (l,p) \<and> divideallc (l,q))"
  1747 "divideallc p = True"
  1748 
  1749 (* formlcm retuns a positive integer *)
  1750 lemma formlcm_pos: 
  1751   assumes linp: "islinform p"
  1752   shows "0 < formlcm p"
  1753 using linp
  1754 proof (induct p rule: formlcm.induct, simp_all add: ilcm_pos)
  1755   case (goal1 c r i)
  1756   have "i=0 \<or> i \<noteq> 0" by simp
  1757   moreover
  1758   {
  1759     assume "i \<noteq> 0" then have ?case using prems by simp
  1760   }
  1761   moreover 
  1762   {
  1763     assume iz: "i = 0"
  1764     then have "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  1765     then have "c\<noteq>0" 
  1766       using prems
  1767       by (simp add: islininttermc0r[where c="c" and n="0" and r="r"])
  1768     then have ?case by simp
  1769   }
  1770   ultimately 
  1771   show ?case by blast
  1772 next 
  1773   case (goal2 c r i)
  1774   have "i=0 \<or> i \<noteq> 0" by simp
  1775   moreover
  1776   {
  1777     assume "i \<noteq> 0" then have ?case using prems by simp
  1778   }
  1779   moreover 
  1780   {
  1781     assume iz: "i = 0"
  1782     then have "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  1783     then have "c\<noteq>0" 
  1784       using prems
  1785       by (simp add: islininttermc0r[where c="c" and n="0" and r="r"])
  1786     then have ?case by simp
  1787   }
  1788   ultimately 
  1789   show ?case by blast
  1790 
  1791 next 
  1792   case (goal3 d c r)
  1793   show ?case using prems by (simp add: islininttermc0r[where c="c" and n="0" and r="r"])
  1794 next
  1795   case (goal4 f)
  1796   show ?case using prems 
  1797     by (cases f,auto) (case_tac "intterm2", auto,case_tac "intterm1", auto)
  1798 qed
  1799 
  1800 lemma divideallc_mono: "\<And> c. \<lbrakk> divideallc(c,p) ; c dvd d\<rbrakk> \<Longrightarrow> divideallc (d,p)"
  1801 proof (induct d p rule: divideallc.induct, simp_all)
  1802   case (goal1 l a b) show ?case by ( rule zdvd_trans [where m="a" and n="b" and k="l"])
  1803 next
  1804   case (goal2 l a b) show ?case by ( rule zdvd_trans [where m="a" and n="b" and k="l"])
  1805 next
  1806  case (goal3 l a b) show ?case by ( rule zdvd_trans [where m="a" and n="b" and k="l"])
  1807 next
  1808   case (goal4 l f g k)
  1809   have  "divideallc (l,g)" using prems by clarsimp
  1810   moreover have "divideallc (l,f)" using prems by clarsimp
  1811   ultimately
  1812   show ?case  by simp
  1813 next 
  1814   case (goal5 l f g k)
  1815   have  "divideallc (l,g)" using prems by clarsimp
  1816   moreover have "divideallc (l,f)" using prems by clarsimp
  1817   ultimately
  1818   show ?case  by simp
  1819   
  1820 qed
  1821 
  1822 (* fomlcm retuns a number all coeffitients of Var 0 divide *)
  1823 
  1824 lemma formlcm_divideallc: 
  1825   assumes linp: "islinform p"
  1826   shows "divideallc(formlcm p, p)"
  1827 using linp
  1828 proof (induct p rule: formlcm.induct, simp_all add: zdvd_self_abs1)
  1829   case (goal1 f)
  1830   show ?case using prems
  1831     by (cases f,auto) (case_tac "intterm2", auto, case_tac "intterm1",auto)
  1832 next 
  1833   case (goal2 f g)
  1834   have "formlcm f >0" using formlcm_pos prems by simp 
  1835     hence "formlcm f \<noteq> 0" by simp
  1836   moreover have "formlcm g > 0" using formlcm_pos prems by simp
  1837   hence "formlcm g \<noteq> 0" by simp
  1838   ultimately
  1839   show ?case using prems formlcm_pos
  1840      by (simp add: ilcm_dvd1 ilcm_dvd2 
  1841        divideallc_mono[where c="formlcm f" and d="ilcm (formlcm f) (formlcm g)"]  
  1842        divideallc_mono[where c="formlcm g" and d="ilcm (formlcm f) (formlcm g)"])
  1843 next 
  1844   case (goal3 f g)
  1845   have "formlcm f >0" using formlcm_pos prems by simp 
  1846     hence "formlcm f \<noteq> 0" by simp
  1847   moreover have "formlcm g > 0" using formlcm_pos prems by simp
  1848   hence "formlcm g \<noteq> 0" by simp
  1849   ultimately
  1850   show ?case using prems 
  1851     by (simp add: ilcm_dvd1 ilcm_dvd2 
  1852       divideallc_mono[where c="formlcm f" and d="ilcm (formlcm f) (formlcm g)"]  
  1853       divideallc_mono[where c="formlcm g" and d="ilcm (formlcm f) (formlcm g)"])
  1854 qed
  1855 
  1856 (* adjustcoeff transforms the formula given an l , look at correctness thm*)
  1857 consts adjustcoeff :: "int \<times> QF \<Rightarrow> QF"
  1858 recdef adjustcoeff "measure (\<lambda>(l,p). size p)"
  1859 "adjustcoeff (l,(Le (Add (Mult (Cst c) (Var 0)) r) (Cst i))) = 
  1860   (if c\<le>0 then 
  1861   Le (Add (Mult (Cst -1) (Var 0)) (lin_mul (- (l div c), r))) (Cst (0::int))
  1862   else
  1863   Le (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))) (Cst (0::int)))"
  1864 "adjustcoeff (l,(Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i))) = 
  1865   (Eq (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))) (Cst (0::int)))"
  1866 "adjustcoeff (l,Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = 
  1867   Divides (Cst ((l div c) * d))
  1868   (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r)))"
  1869 "adjustcoeff (l,NOT (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r))) = NOT (Divides (Cst ((l div c) * d))
  1870   (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))))"
  1871 "adjustcoeff (l,(NOT(Eq (Add (Mult (Cst c) (Var 0)) r) (Cst i)))) = 
  1872   (NOT(Eq (Add (Mult (Cst 1) (Var 0)) (lin_mul (l div c, r))) (Cst (0::int))))"
  1873 "adjustcoeff (l,And p q) = And (adjustcoeff (l,p)) (adjustcoeff(l,q))"
  1874 "adjustcoeff (l,Or p q) = Or (adjustcoeff (l,p)) (adjustcoeff(l,q))"
  1875 "adjustcoeff (l,p) = p"
  1876 
  1877 
  1878 (* unitycoeff expects a quantifier free formula an transforms it to an equivalent formula where the bound variable occurs only with coeffitient 1  or -1 *)
  1879 constdefs unitycoeff :: "QF \<Rightarrow> QF"
  1880   "unitycoeff p == 
  1881   (let l = formlcm p;
  1882        p' = adjustcoeff (l,p)
  1883    in (if l=1 then p' else 
  1884       (And (Divides (Cst l) (Add (Mult (Cst 1) (Var 0)) (Cst 0))) p')))"
  1885 
  1886 (* what is a unified formula *)
  1887 consts isunified :: "QF \<Rightarrow> bool"
  1888 recdef isunified "measure size"
  1889 "isunified (Le (Add (Mult (Cst i) (Var 0)) r) (Cst z)) = 
  1890   ((abs i) = 1  \<and> (islinform(Le (Add (Mult (Cst i) (Var 0)) r) (Cst z))))"
  1891 "isunified (Eq (Add (Mult (Cst i) (Var 0)) r) (Cst z)) = 
  1892   ((abs i) = 1  \<and> (islinform(Le (Add (Mult (Cst i) (Var 0)) r) (Cst z))))"
  1893 "isunified (NOT(Eq (Add (Mult (Cst i) (Var 0)) r) (Cst z))) = 
  1894   ((abs i) = 1  \<and> (islinform(Le (Add (Mult (Cst i) (Var 0)) r) (Cst z))))"
  1895 "isunified (Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r)) = 
  1896   ((abs i) = 1 \<and> (islinform(Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r))))"
  1897 "isunified (NOT(Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r))) = 
  1898   ((abs i) = 1 \<and> (islinform(NOT(Divides (Cst d) (Add (Mult (Cst i) (Var 0)) r)))))"
  1899 "isunified (And p q) = (isunified p \<and> isunified q)"
  1900 "isunified (Or p q) = (isunified p \<and> isunified q)"
  1901 "isunified p = islinform p"
  1902 
  1903 lemma unified_islinform: "isunified p \<Longrightarrow> islinform p"
  1904 by (induct p rule: isunified.induct) auto
  1905 
  1906 lemma adjustcoeff_lenpos: 
  1907   "0 < n \<Longrightarrow> adjustcoeff (l, Le (Add (Mult (Cst i) (Var n)) r) (Cst c)) =
  1908     Le (Add (Mult (Cst i) (Var n)) r) (Cst c)"
  1909 by (cases n, auto)
  1910 
  1911 lemma adjustcoeff_eqnpos: 
  1912   "0 < n \<Longrightarrow> adjustcoeff (l, Eq (Add (Mult (Cst i) (Var n)) r) (Cst c)) =
  1913     Eq (Add (Mult (Cst i) (Var n)) r) (Cst c)"
  1914 by (cases n, auto)
  1915 
  1916 
  1917 (* Properties of adjustcoeff and unitycoeff *)
  1918 
  1919 (* Some simple lemmas used afterwards *)
  1920 lemma zmult_zle_mono: "(i::int) \<le> j \<Longrightarrow> 0 \<le> k \<Longrightarrow> k * i \<le> k * j"
  1921   apply (erule order_le_less [THEN iffD1, THEN disjE, of "0::int"])
  1922   apply (erule order_le_less [THEN iffD1, THEN disjE])
  1923   apply (rule order_less_imp_le)
  1924   apply (rule zmult_zless_mono2)
  1925   apply simp_all
  1926   done
  1927 
  1928 lemma zmult_zle_mono_eq:
  1929   assumes kpos: "0 < k"
  1930   shows "((i::int) \<le> j) = (k*i \<le> k*j)" (is "?P = ?Q")
  1931 proof
  1932   assume P: ?P
  1933   from kpos have kge0: "0 \<le> k" by simp
  1934   show ?Q
  1935     by (rule zmult_zle_mono[OF P kge0])
  1936 next 
  1937   assume ?Q
  1938   then have "k*i - k*j \<le> 0" by simp
  1939   then have le1: "k*(i-j) \<le> k*0"
  1940     by (simp add: zdiff_zmult_distrib2)
  1941   have "i -j \<le> 0" 
  1942     by (rule mult_left_le_imp_le[OF le1 kpos])
  1943   then 
  1944   show ?P by simp
  1945 qed
  1946   
  1947 
  1948 lemma adjustcoeff_le_corr:
  1949   assumes lpos: "0 < l"
  1950   and ipos: "0 < (i::int)"
  1951   and dvd: "i dvd l"
  1952   shows "(i*x + r \<le> 0) = (l*x + ((l div i)*r) \<le> 0)"
  1953 proof-
  1954   from lpos ipos have ilel: "i\<le>l" by (simp add: zdvd_imp_le [OF dvd lpos])
  1955   from ipos have inz: "i \<noteq> 0" by simp
  1956   have "i div i\<le> l div i"
  1957     by (simp add: zdiv_mono1[OF ilel ipos])
  1958   then have ldivipos:"0 < l div i" 
  1959     by (simp add: zdiv_self[OF inz])
  1960   
  1961   from dvd have "\<exists>i'. i*i' = l" by (auto simp add: dvd_def)
  1962   then obtain "i'" where ii'eql: "i*i' = l" by blast
  1963   have "(i * x + r \<le> 0) = (l div i * (i * x + r) \<le> l div i * 0)"
  1964     by (rule zmult_zle_mono_eq[OF ldivipos, where i="i*x + r" and j="0"])
  1965   also
  1966   have "(l div i * (i * x + r) \<le> l div i * 0) = ((l div i * i) * x + ((l div i)*r) \<le> 0)"
  1967     by (simp add: mult_ac)
  1968   also have "((l div i * i) * x + ((l div i)*r) \<le> 0) = (l*x + ((l div i)*r) \<le> 0)"
  1969     using sym[OF ii'eql] inz
  1970     by (simp add: zmult_ac)
  1971   finally  
  1972   show ?thesis
  1973     by simp
  1974 qed
  1975 
  1976 lemma adjustcoeff_le_corr2:
  1977   assumes lpos: "0 < l"
  1978   and ineg: "(i::int) < 0"
  1979   and dvd: "i dvd l"
  1980   shows "(i*x + r \<le> 0) = ((-l)*x + ((-(l div i))*r) \<le> 0)"
  1981 proof-
  1982   from dvd have midvdl: "-i dvd l" by simp
  1983   from ineg have mipos: "0 < -i" by simp
  1984   from lpos ineg have milel: "-i\<le>l" by (simp add: zdvd_imp_le [OF midvdl lpos])
  1985   from ineg have inz: "i \<noteq> 0" by simp
  1986   have "l div i\<le> -i div i"
  1987     by (simp add: zdiv_mono1_neg[OF milel ineg])
  1988   then have "l div i \<le> -1" 
  1989     apply (simp add: zdiv_zminus1_eq_if[OF inz, where a="i"])
  1990     by (simp add: zdiv_self[OF inz])
  1991   then have ldivineg: "l div i < 0" by simp
  1992   then have mldivipos: "0 < - (l div i)" by simp
  1993   
  1994   from dvd have "\<exists>i'. i*i' = l" by (auto simp add: dvd_def)
  1995   then obtain "i'" where ii'eql: "i*i' = l" by blast
  1996   have "(i * x + r \<le> 0) = (- (l div i) * (i * x + r) \<le> - (l div i) * 0)"
  1997     by (rule zmult_zle_mono_eq[OF mldivipos, where i="i*x + r" and j="0"])
  1998   also
  1999   have "(- (l div i) * (i * x + r) \<le> - (l div i) * 0) = (-((l div i) * i) * x \<le> (l div i)*r)"
  2000     by (simp add: mult_ac)
  2001   also have " (-((l div i) * i) * x \<le> (l div i)*r) = (- (l*x) \<le> (l div i)*r)"
  2002     using sym[OF ii'eql] inz
  2003     by (simp add: zmult_ac)
  2004   finally  
  2005   show ?thesis
  2006     by simp
  2007 qed
  2008 
  2009 (* FIXME : Move this theorem above, it simplifies the 2 theorems above : adjustcoeff_le_corr1,2 *)
  2010 lemma dvd_div_pos: 
  2011   assumes bpos: "0 < (b::int)"
  2012   and anz: "a\<noteq>0"
  2013   and dvd: "a dvd b"
  2014   shows "(b div a)*a = b"
  2015 proof-
  2016   from anz have "0 < a \<or> a < 0" by arith
  2017   moreover
  2018   {
  2019     assume apos: "0 < a" 
  2020     from bpos apos have aleb: "a\<le>b" by (simp add: zdvd_imp_le [OF dvd bpos])
  2021     have "a div a\<le> b div a"
  2022       by (simp add: zdiv_mono1[OF aleb apos])
  2023     then have bdivapos:"0 < b div a" 
  2024       by (simp add: zdiv_self[OF anz])
  2025     
  2026     from dvd have "\<exists>a'. a*a' = b" by (auto simp add: dvd_def)
  2027     then obtain "a'" where aa'eqb: "a*a' = b" by blast
  2028     then have ?thesis  using anz sym[OF aa'eqb] by simp
  2029     
  2030   }
  2031   moreover
  2032   {
  2033     assume aneg: "a < 0"
  2034     from dvd have midvdb: "-a dvd b" by simp
  2035     from aneg have mapos: "0 < -a" by simp
  2036     from bpos aneg have maleb: "-a\<le>b" by (simp add: zdvd_imp_le [OF midvdb bpos])
  2037     from aneg have anz: "a \<noteq> 0" by simp
  2038     have "b div a\<le> -a div a"
  2039       by (simp add: zdiv_mono1_neg[OF maleb aneg])
  2040     then have "b div a \<le> -1" 
  2041       apply (simp add: zdiv_zminus1_eq_if[OF anz, where a="a"])
  2042       by (simp add: zdiv_self[OF anz])
  2043     then have bdivaneg: "b div a < 0" by simp
  2044     then have mbdivapos: "0 < - (b div a)" by simp
  2045     
  2046     from dvd have "\<exists>a'. a*a' = b" by (auto simp add: dvd_def)
  2047     then obtain "a'" where aa'eqb: "a*a' = b" by blast
  2048     then have ?thesis using anz sym[OF aa'eqb] by (simp)
  2049   }
  2050   ultimately show ?thesis by blast
  2051 qed
  2052 
  2053 lemma adjustcoeff_eq_corr: 
  2054   assumes lpos: "(0::int) < l"
  2055   and inz: "i \<noteq> 0"
  2056   and dvd: "i dvd l"
  2057   shows "(i*x + r = 0) = (l*x + ((l div i)*r) = 0)"
  2058 proof-
  2059   have ldvdii: "(l div i)*i = l" by (rule dvd_div_pos[OF lpos inz dvd])
  2060   have ldivinz: "l div i \<noteq> 0" using inz ldvdii lpos by auto
  2061   have "(i*x + r = 0) = ((l div i)*(i*x + r) = (l div i)*0)"
  2062     using ldivinz by arith
  2063   also have "\<dots> = (((l div i)*i)*x + (l div i)*r = 0)"
  2064     by (simp add: zmult_ac)
  2065   finally show ?thesis using ldvdii by simp
  2066 qed
  2067 
  2068 
  2069 
  2070 (* Correctness theorem for adjustcoeff *)
  2071 lemma adjustcoeff_corr:
  2072   assumes linp: "islinform p"
  2073   and alldvd: "divideallc (l,p)"
  2074   and lpos: "0 < l"
  2075   shows "qinterp (a#ats) p = qinterp ((a*l)#ats) (adjustcoeff(l, p))"
  2076 using linp alldvd
  2077 proof (induct p rule: islinform.induct,simp_all)
  2078   case (goal1 t c)
  2079   from prems have cz: "c=0" by simp
  2080     then have ?case
  2081       using prems
  2082     proof(induct t rule: islinintterm.induct)
  2083       case (2 i n i') show ?case using prems
  2084 	proof-
  2085 	  from prems have "i\<noteq>0" by simp
  2086 	  then 
  2087 	  have "(n=0 \<and> i < 0) \<or> (n=0 \<and> i > 0) \<or> n\<noteq>0" by arith
  2088 	  moreover 
  2089 	  {
  2090 	    assume "n\<noteq>0" then have ?thesis 
  2091 	      by (simp add: nth_pos2 adjustcoeff_lenpos)
  2092 	  }
  2093 	  moreover
  2094 	  {
  2095 	    assume nz: "n=0"
  2096 	      and ipos: "0 < i"
  2097 	    from prems nz have idvdl: "i dvd l" by simp
  2098 	    have "(i*a + i' \<le> 0) = (l*a+ ((l div i)*i') \<le> 0)" 
  2099 	      by (rule adjustcoeff_le_corr[OF lpos ipos idvdl])
  2100 	    then 
  2101 	    have ?thesis using prems by (simp add: mult_ac)
  2102 	  }
  2103 	  moreover
  2104 	  {
  2105 	    assume nz: "n=0"
  2106 	      and ineg: "i < 0"
  2107 	    from prems nz have idvdl: "i dvd l" by simp
  2108 	    have "(i*a+i' \<le> 0) = (-l*a + (-(l div i) * i') \<le> 0)"
  2109 	      by (rule adjustcoeff_le_corr2[OF lpos ineg idvdl])
  2110 	    then 
  2111 	    have ?thesis using prems
  2112 	      by (simp add: zmult_ac)
  2113 	  }
  2114 	  ultimately show ?thesis by blast
  2115 	qed
  2116       next
  2117 	case (3 i n i' n' r) show ?case  using prems
  2118 	proof-
  2119 	  from prems 
  2120 	  have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2121 	    by simp
  2122 	  then
  2123 	  have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2124 	    by (simp add: islinintterm_eq_islint)
  2125 	  then have linr: "islintn(Suc n',r)"
  2126 	    by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2127 	  from lininrp have linr2: "islinintterm r"
  2128 	    by (simp add: islinintterm_subt[OF lininrp])
  2129 	  from prems have "n < n'" by simp
  2130 	  then have nppos: "0 < n'" by simp
  2131 	  from prems have "i\<noteq>0" by simp
  2132 	  then 
  2133 	  have "(n=0 \<and> i < 0) \<or> (n=0 \<and> i > 0) \<or> n\<noteq>0" by arith
  2134 	  moreover 
  2135 	  {
  2136 	    assume nnz: "n\<noteq>0"
  2137 	    from linr have ?thesis using nppos nnz intterm_novar0[OF lininrp] prems
  2138 	      apply (simp add: adjustcoeff_lenpos linterm_novar0[OF linr, where x="a" and y="a*l"])
  2139 	      by (simp add: nth_pos2)
  2140 	      
  2141 	  }
  2142 	  moreover
  2143 	  {
  2144 	    assume nz: "n=0"
  2145 	      and ipos: "0 < i"
  2146 	    from prems nz have idvdl: "i dvd l" by simp
  2147 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0) =
  2148 	      (l * a + l div i * (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0)"
  2149 	      by (rule adjustcoeff_le_corr[OF lpos ipos idvdl])
  2150 	    then 
  2151 	    have ?thesis using prems linr linr2
  2152 	      by (simp add: mult_ac nth_pos2 lin_mul_corr 
  2153 		linterm_novar0[OF linr, where x="a" and y="a*l"])
  2154 	  }
  2155 	  moreover
  2156 	  {
  2157 	    assume nz: "n=0"
  2158 	      and ineg: "i < 0"
  2159 	    from prems nz have idvdl: "i dvd l" by simp
  2160 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0) =
  2161 	      (- l * a + - (l div i) * (i' * (a # ats) ! n' + I_intterm (a # ats) r) \<le> 0)"
  2162 	      by (rule adjustcoeff_le_corr2[OF lpos ineg idvdl, where  x="a" and r="(i'* (a#ats) ! n' + I_intterm (a#ats) r )"])
  2163 	    then 
  2164 	    have ?thesis using prems linr linr2
  2165 	      by (simp add: zmult_ac nth_pos2 lin_mul_corr 
  2166 		linterm_novar0[OF linr, where x="a" and y="a*l"] )
  2167 	  }
  2168 	  ultimately show ?thesis by blast
  2169 	qed	  
  2170     qed simp_all
  2171     then show ?case by simp 
  2172   
  2173 next
  2174   case (goal2 t c)
  2175   from prems have cz: "c=0" by simp
  2176     then have ?case
  2177       using prems
  2178     proof(induct t rule: islinintterm.induct)
  2179       case (2 i n i') show ?case using prems
  2180 	proof-
  2181 	  from prems have inz: "i\<noteq>0" by simp
  2182 	  then 
  2183 	  have "n=0 \<or> n\<noteq>0" by arith
  2184 	  moreover 
  2185 	  {
  2186 	    assume "n\<noteq>0" then have ?thesis 
  2187 	      by (simp add: nth_pos2 adjustcoeff_eqnpos)
  2188 	  }
  2189 	  moreover
  2190 	  {
  2191 	    assume nz: "n=0"
  2192 	    from prems nz have idvdl: "i dvd l" by simp
  2193 	    have "(i*a + i' = 0) = (l*a+ ((l div i)*i') = 0)" 
  2194 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2195 	    then 
  2196 	    have ?thesis using prems by (simp add: mult_ac)
  2197 	  }
  2198 	  ultimately show ?thesis by blast
  2199 	qed
  2200       next
  2201 	case (3 i n i' n' r) show ?case  using prems
  2202 	proof-
  2203 	  from prems 
  2204 	  have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2205 	    by simp
  2206 	  then
  2207 	  have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2208 	    by (simp add: islinintterm_eq_islint)
  2209 	  then have linr: "islintn(Suc n',r)"
  2210 	    by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2211 	  from lininrp have linr2: "islinintterm r"
  2212 	    by (simp add: islinintterm_subt[OF lininrp])
  2213 	  from prems have "n < n'" by simp
  2214 	  then have nppos: "0 < n'" by simp
  2215 	  from prems have "i\<noteq>0" by simp
  2216 	  then 
  2217 	  have "n=0 \<or> n\<noteq>0" by arith
  2218 	  moreover 
  2219 	  {
  2220 	    assume nnz: "n\<noteq>0"
  2221 	    from linr have ?thesis using nppos nnz intterm_novar0[OF lininrp] prems
  2222 	      apply (simp add: adjustcoeff_eqnpos linterm_novar0[OF linr, where x="a" and y="a*l"])
  2223 	      by (simp add: nth_pos2)
  2224 	      
  2225 	  }
  2226 	  moreover
  2227 	  {
  2228 	    assume nz: "n=0"
  2229 	    from prems have inz: "i \<noteq> 0" by auto
  2230 	    from prems nz have idvdl: "i dvd l" by simp
  2231 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0) =
  2232 	      (l * a + l div i * (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0)"
  2233 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2234 	    then 
  2235 	    have ?thesis using prems linr linr2
  2236 	      by (simp add: mult_ac nth_pos2 lin_mul_corr 
  2237 		linterm_novar0[OF linr, where x="a" and y="a*l"])
  2238 	  }
  2239 	  ultimately show ?thesis by blast
  2240 	qed	  
  2241     qed simp_all
  2242     then show ?case by simp 
  2243   
  2244 next
  2245   case (goal3 d t) show ?case
  2246     using prems
  2247     proof (induct t rule: islinintterm.induct)
  2248       case (2 i n i') 
  2249       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2250       moreover
  2251       {
  2252 	assume "\<exists>m. n = Suc m"
  2253 	then have ?case using prems  by auto
  2254       }
  2255       moreover 
  2256       {
  2257 	assume nz: "n=0"
  2258 	from prems have inz: "i\<noteq>0" by simp
  2259 	from prems have idvdl: "i dvd l" by simp
  2260 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2261 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2262 	  
  2263 	then have ?case using prems
  2264 	  apply simp
  2265 	  apply (simp add: 
  2266 	    ac_dvd_eq[OF ldivinz, where m="d" and c="i" and n="a" and t="i'"] 
  2267 	    ldiviieql)
  2268 	  by (simp add: zmult_commute)
  2269       }
  2270       ultimately show ?case by blast
  2271 
  2272     next 
  2273       case (3 i n i' n' r)
  2274       from prems 
  2275       have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2276 	by simp
  2277       then
  2278       have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2279 	by (simp add: islinintterm_eq_islint)
  2280       then have linr: "islintn(Suc n',r)"
  2281 	by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2282       from lininrp have linr2: "islinintterm r"
  2283 	by (simp add: islinintterm_subt[OF lininrp])
  2284       from prems have "n < n'" by simp
  2285       then have nppos: "0 < n'" by simp
  2286       from prems have inz: "i\<noteq>0" by simp
  2287       
  2288       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2289       moreover
  2290       {
  2291 	assume "\<exists>m. n = Suc m"
  2292 	then have npos: "0 < n" by arith
  2293 	have ?case using nppos intterm_novar0[OF lininrp] prems
  2294 	  apply (auto simp add: linterm_novar0[OF linr, where x="a" and y="a*l"])
  2295 	  by (simp_all add: nth_pos2)
  2296       }
  2297       moreover 
  2298       {
  2299 	assume nz: "n=0"
  2300 	from prems have idvdl: "i dvd l" by simp
  2301 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2302 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2303 	  
  2304 	then have ?case using prems linr2 linr
  2305 	  apply (simp add: nth_pos2 lin_mul_corr linterm_novar0)
  2306 	  
  2307 	  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)
  2308 	  by (simp add: zmult_ac linterm_novar0[OF linr, where x="a" and y="a*l"])
  2309       }
  2310       ultimately show ?case by blast
  2311       
  2312     qed simp_all
  2313 next
  2314   case (goal4 d t) show ?case
  2315     using prems
  2316     proof (induct t rule: islinintterm.induct)
  2317       case (2 i n i') 
  2318       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2319       moreover
  2320       {
  2321 	assume "\<exists>m. n = Suc m"
  2322 	then have ?case using prems  by auto
  2323       }
  2324       moreover 
  2325       {
  2326 	assume nz: "n=0"
  2327 	from prems have inz: "i\<noteq>0" by simp
  2328 	from prems have idvdl: "i dvd l" by simp
  2329 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2330 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2331 	  
  2332 	then have ?case using prems
  2333 	  apply simp
  2334 	  apply (simp add: 
  2335 	    ac_dvd_eq[OF ldivinz, where m="d" and c="i" and n="a" and t="i'"] 
  2336 	    ldiviieql)
  2337 	  by (simp add: zmult_commute)
  2338       }
  2339       ultimately show ?case by blast
  2340 
  2341     next 
  2342       case (3 i n i' n' r)
  2343       from prems 
  2344       have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2345 	by simp
  2346       then
  2347       have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2348 	by (simp add: islinintterm_eq_islint)
  2349       then have linr: "islintn(Suc n',r)"
  2350 	by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2351       from lininrp have linr2: "islinintterm r"
  2352 	by (simp add: islinintterm_subt[OF lininrp])
  2353       from prems have "n < n'" by simp
  2354       then have nppos: "0 < n'" by simp
  2355       from prems have inz: "i\<noteq>0" by simp
  2356       
  2357       have "n=0 \<or> (\<exists>m. (n = Suc m))" by arith
  2358       moreover
  2359       {
  2360 	assume "\<exists>m. n = Suc m"
  2361 	then have npos: "0 < n" by arith
  2362 	have ?case using nppos intterm_novar0[OF lininrp] prems
  2363 	  apply (auto simp add: linterm_novar0[OF linr, where x="a" and y="a*l"])
  2364 	  by (simp_all add: nth_pos2)
  2365       }
  2366       moreover 
  2367       {
  2368 	assume nz: "n=0"
  2369 	from prems have idvdl: "i dvd l" by simp
  2370 	have ldiviieql: "l div i * i = l" by (rule dvd_div_pos[OF lpos inz idvdl])
  2371 	with lpos have ldivinz: "0 \<noteq> l div i" by auto
  2372 	  
  2373 	then have ?case using prems linr2 linr
  2374 	  apply (simp add: nth_pos2 lin_mul_corr linterm_novar0)
  2375 	  
  2376 	  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)
  2377 	  by (simp add: zmult_ac linterm_novar0[OF linr, where x="a" and y="a*l"])
  2378       }
  2379       ultimately show ?case by blast
  2380       
  2381     qed simp_all
  2382 next
  2383     case (goal5 t c)
  2384   from prems have cz: "c=0" by simp
  2385     then have ?case
  2386       using prems
  2387     proof(induct t rule: islinintterm.induct)
  2388       case (2 i n i') show ?case using prems
  2389 	proof-
  2390 	  from prems have inz: "i\<noteq>0" by simp
  2391 	  then 
  2392 	  have "n=0 \<or> n\<noteq>0" by arith
  2393 	  moreover 
  2394 	  {
  2395 	    assume "n\<noteq>0" then have ?thesis
  2396 	      using prems
  2397 	      by (cases n, simp_all)
  2398 	  }
  2399 	  moreover
  2400 	  {
  2401 	    assume nz: "n=0"
  2402 	    from prems nz have idvdl: "i dvd l" by simp
  2403 	    have "(i*a + i' = 0) = (l*a+ ((l div i)*i') = 0)" 
  2404 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2405 	    then 
  2406 	    have ?thesis using prems by (simp add: mult_ac)
  2407 	  }
  2408 	  ultimately show ?thesis by blast
  2409 	qed
  2410       next
  2411 	case (3 i n i' n' r) show ?case  using prems
  2412 	proof-
  2413 	  from prems 
  2414 	  have lininrp: "islinintterm (Add (Mult (Cst i') (Var n')) r)" 
  2415 	    by simp
  2416 	  then
  2417 	  have "islint (Add (Mult (Cst i') (Var n')) (r))" 
  2418 	    by (simp add: islinintterm_eq_islint)
  2419 	  then have linr: "islintn(Suc n',r)"
  2420 	    by (simp add: islinintterm_subt[OF lininrp] islinintterm_eq_islint islint_def)
  2421 	  from lininrp have linr2: "islinintterm r"
  2422 	    by (simp add: islinintterm_subt[OF lininrp])
  2423 	  from prems have "n < n'" by simp
  2424 	  then have nppos: "0 < n'" by simp
  2425 	  from prems have "i\<noteq>0" by simp
  2426 	  then 
  2427 	  have "n=0 \<or> n\<noteq>0" by arith
  2428 	  moreover 
  2429 	  {
  2430 	    assume nnz: "n\<noteq>0"
  2431 	    then have ?thesis using prems linr nppos nnz intterm_novar0[OF lininrp]
  2432 	      by (cases n, simp_all)
  2433 	    (simp add: nth_pos2 linterm_novar0[OF linr, where x="a" and y="a*l"])
  2434 	  }
  2435 	  moreover
  2436 	  {
  2437 	    assume nz: "n=0"
  2438 	    from prems have inz: "i \<noteq> 0" by auto
  2439 	    from prems nz have idvdl: "i dvd l" by simp
  2440 	    have "(i * a + (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0) =
  2441 	      (l * a + l div i * (i' * (a # ats) ! n' + I_intterm (a # ats) r) = 0)"
  2442 	      by (rule adjustcoeff_eq_corr[OF lpos inz idvdl])
  2443 	    then 
  2444 	    have ?thesis using prems linr linr2
  2445 	      by (simp add: mult_ac nth_pos2 lin_mul_corr 
  2446 		linterm_novar0[OF linr, where x="a" and y="a*l"])
  2447 	  }
  2448 	  ultimately show ?thesis by blast
  2449 	qed	  
  2450     qed simp_all
  2451     then show ?case by simp 
  2452   
  2453 qed
  2454 
  2455 (* unitycoeff preserves semantics *)
  2456 lemma unitycoeff_corr:
  2457   assumes linp: "islinform p"
  2458   shows "qinterp ats (QEx p) = qinterp ats (QEx (unitycoeff p))"
  2459 proof-
  2460   
  2461   have lpos: "0 < formlcm p" by (rule formlcm_pos[OF linp])
  2462   have dvd : "divideallc (formlcm p, p)" by (rule formlcm_divideallc[OF linp])
  2463   show ?thesis  using prems lpos dvd 
  2464   proof (simp add: unitycoeff_def Let_def,case_tac "formlcm p = 1",
  2465       simp_all add: adjustcoeff_corr)
  2466     show "(\<exists>x. qinterp (x * formlcm p # ats) (adjustcoeff (formlcm p, p))) =
  2467       (\<exists>x. formlcm p dvd x \<and>
  2468       qinterp (x # ats) (adjustcoeff (formlcm p, p)))"
  2469       (is "(\<exists>x. ?P(x* (formlcm p))) = (\<exists>x. formlcm p dvd x \<and> ?P x)")
  2470     proof-
  2471       have "(\<exists>x. ?P(x* (formlcm p))) = (\<exists>x. ?P((formlcm p)*x))"
  2472 	by (simp add: mult_commute)
  2473       also have "(\<exists>x. ?P((formlcm p)*x)) = (\<exists>x. (formlcm p dvd x) \<and> ?P x)"
  2474 	by (simp add: unity_coeff_ex[where P="?P"])
  2475       finally show ?thesis by simp
  2476     qed
  2477   qed
  2478 qed
  2479 
  2480 (* the resul of adjustcoeff is unified for all l with divideallc (l,p) *)
  2481 lemma adjustcoeff_unified: 
  2482   assumes linp: "islinform p"
  2483   and dvdc: "divideallc(l,p)"
  2484   and lpos: "l > 0"
  2485   shows "isunified (adjustcoeff(l, p))"
  2486   using linp dvdc lpos
  2487   proof(induct l p rule: adjustcoeff.induct,simp_all add: lin_mul_lintn islinintterm_eq_islint islint_def)
  2488     case (goal1 l d c r)
  2489     from prems have "c >0 \<or> c < 0" by auto
  2490     moreover {
  2491       assume cpos: "c > 0 "
  2492       from prems have lp: "l > 0" by simp
  2493       from prems have cdvdl: "c dvd l" by simp
  2494       have clel: "c \<le> l" by (rule zdvd_imp_le[OF cdvdl lp])
  2495       have "c div c \<le>  l div c" by (rule zdiv_mono1[OF clel cpos])
  2496       then have ?case using cpos by (simp add: zdiv_self)      
  2497     }
  2498     moreover {
  2499       assume cneg: "c < 0"
  2500       
  2501      have mcpos: "-c > 0" by simp
  2502       then have mcnz: "-c \<noteq> 0" by simp
  2503       from prems have mcdvdl: "-c dvd l" 
  2504 	by simp 
  2505       then have l1:"l mod -c = 0" by (simp add: zdvd_iff_zmod_eq_0)
  2506       from prems have lp: "l >0" by simp
  2507       have mclel: "-c \<le> l" by (rule zdvd_imp_le[OF mcdvdl lp])
  2508       have "l div c = (-l div -c)"  by simp
  2509       also have "\<dots> = - (l div -c)" using l1
  2510 	by (simp only: zdiv_zminus1_eq_if[OF mcnz, where a="l"]) simp
  2511       finally have diveq: "l div c = - (l div -c)" by simp
  2512       
  2513       have "-c div -c \<le> l div -c" by (rule zdiv_mono1[OF mclel mcpos])
  2514       then have "0 < l div -c" using cneg
  2515 	by (simp add: zdiv_self)
  2516       then have ?case using diveq by simp
  2517     }
  2518     ultimately  show ?case by blast
  2519   next
  2520     case (goal2 l p)    from prems have "c >0 \<or> c < 0" by auto
  2521     moreover {
  2522       assume cpos: "c > 0 "
  2523       from prems have lp: "l > 0" by simp
  2524       from prems have cdvdl: "c dvd l" by simp
  2525       have clel: "c \<le> l" by (rule zdvd_imp_le[OF cdvdl lp])
  2526       have "c div c \<le>  l div c" by (rule zdiv_mono1[OF clel cpos])
  2527       then have ?case using cpos by (simp add: zdiv_self)      
  2528     }
  2529     moreover {
  2530       assume cneg: "c < 0"
  2531       
  2532      have mcpos: "-c > 0" by simp
  2533       then have mcnz: "-c \<noteq> 0" by simp
  2534       from prems have mcdvdl: "-c dvd l" 
  2535 	by simp 
  2536       then have l1:"l mod -c = 0" by (simp add: zdvd_iff_zmod_eq_0)
  2537       from prems have lp: "l >0" by simp
  2538       have mclel: "-c \<le> l" by (rule zdvd_imp_le[OF mcdvdl lp])
  2539       have "l div c = (-l div -c)"  by simp
  2540       also have "\<dots> = - (l div -c)" using l1
  2541 	by (simp only: zdiv_zminus1_eq_if[OF mcnz, where a="l"]) simp
  2542       finally have diveq: "l div c = - (l div -c)" by simp
  2543       
  2544       have "-c div -c \<le> l div -c" by (rule zdiv_mono1[OF mclel mcpos])
  2545       then have "0 < l div -c" using cneg
  2546 	by (simp add: zdiv_self)
  2547       then have ?case using diveq by simp
  2548     }
  2549     ultimately  show ?case by blast
  2550   qed
  2551 
  2552 lemma adjustcoeff_lcm_unified:
  2553   assumes linp: "islinform p"
  2554   shows "isunified (adjustcoeff(formlcm p, p))"
  2555 using linp adjustcoeff_unified formlcm_pos formlcm_divideallc
  2556 by simp
  2557 
  2558 (* the result of unitycoeff is unified *)
  2559 lemma unitycoeff_unified:
  2560   assumes linp: "islinform p"
  2561   shows "isunified (unitycoeff p)"
  2562 using linp formlcm_pos[OF linp]
  2563 proof (auto simp add: unitycoeff_def Let_def adjustcoeff_lcm_unified)
  2564   assume f1: "formlcm p = 1"
  2565   have "isunified (adjustcoeff(formlcm p, p))" 
  2566     by (rule adjustcoeff_lcm_unified[OF linp])
  2567   with f1 
  2568   show "isunified (adjustcoeff(1,p))" by simp
  2569 qed
  2570 
  2571 lemma unified_isnnf: 
  2572   assumes unifp: "isunified p"
  2573   shows "isnnf p"
  2574   using unified_islinform[OF unifp] linform_isnnf
  2575   by simp
  2576 
  2577 lemma unified_isqfree: "isunified p\<Longrightarrow> isqfree p"
  2578 using unified_islinform linform_isqfree
  2579 by auto
  2580 
  2581 (* Plus/Minus infinity , B and A set definitions *)
  2582 
  2583 consts minusinf :: "QF \<Rightarrow> QF"
  2584        plusinf  :: "QF \<Rightarrow> QF"
  2585        aset     :: "QF \<Rightarrow> intterm list"
  2586        bset     :: "QF \<Rightarrow> intterm list"
  2587 
  2588 recdef minusinf "measure size"
  2589 "minusinf (Le (Add (Mult (Cst c) (Var 0)) r) z) =
  2590   (if c < 0 then F else T)"
  2591 "minusinf (Eq (Add (Mult (Cst c) (Var 0)) r) z) = F"
  2592 "minusinf (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) = T"
  2593 "minusinf (And p q) = And (minusinf p) (minusinf q)"
  2594 "minusinf (Or p q) = Or (minusinf p) (minusinf q)"
  2595 "minusinf p = p"
  2596 
  2597 recdef plusinf "measure size"
  2598 "plusinf (Le (Add (Mult (Cst c) (Var 0)) r) z) =
  2599   (if c < 0 then T else F)"
  2600 "plusinf (Eq (Add (Mult (Cst c) (Var 0)) r) z) = F"
  2601 "plusinf (NOT (Eq (Add (Mult (Cst c) (Var 0)) r) z)) = T"
  2602 "plusinf (And p q) = And (plusinf p) (plusinf q)"
  2603 "plusinf (Or p q) = Or (plusinf p) (plusinf q)"
  2604 "plusinf p = p"
  2605 
  2606 recdef bset "measure size"
  2607 "bset (Le (Add (Mult (Cst c) (Var 0)) r) z) = 
  2608  (if c < 0 then [lin_add(r,(Cst -1)), r]
  2609          else [lin_add(lin_neg r,(Cst -1))])"
  2610 "bset (Eq (Add (Mult (Cst c) (Var 0)) r) z) =  
  2611   (if c < 0 then [lin_add(r,(Cst -1))]
  2612          else [lin_add(lin_neg r,(Cst -1))])"
  2613 "bset (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) =  
  2614   (if c < 0 then [r]
  2615          else [lin_neg r])"
  2616 "bset (And p q) = (bset p) @ (bset q)"
  2617 "bset (Or p q) = (bset p) @ (bset q)"
  2618 "bset p = []"
  2619 
  2620 recdef aset "measure size"
  2621 "aset (Le (Add (Mult (Cst c) (Var 0)) r) z) = 
  2622   (if c < 0 then [lin_add (r, Cst 1)]
  2623          else [lin_add (lin_neg r, Cst 1), lin_neg r])"
  2624 "aset (Eq (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))])"
  2627 "aset (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) = 
  2628   (if c < 0 then [r] 
  2629       else [lin_neg r])"
  2630 "aset (And p q) = (aset p) @ (aset q)"
  2631 "aset (Or p q) = (aset p) @ (aset q)"
  2632 "aset p = []"
  2633 
  2634 (* divlcm computes \<delta> = lcm d , where d | x +t occurs in p *)
  2635 consts divlcm :: "QF \<Rightarrow> int"
  2636 recdef divlcm "measure size"
  2637 "divlcm (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = (abs d)"
  2638 "divlcm (NOT p) = divlcm p"
  2639 "divlcm (And p q)= ilcm (divlcm p) (divlcm q)"
  2640 "divlcm (Or p q) = ilcm (divlcm p) (divlcm q)"
  2641 "divlcm p = 1"
  2642 
  2643 (* the preoperty of \<delta> *)
  2644 consts alldivide :: "int \<times> QF \<Rightarrow> bool"
  2645 recdef alldivide "measure (%(d,p). size p)"
  2646 "alldivide (d,(Divides (Cst d') (Add (Mult (Cst c) (Var 0)) r))) = 
  2647   (d' dvd d)"
  2648 "alldivide (d,(NOT p)) = alldivide (d,p)"
  2649 "alldivide (d,(And p q)) = (alldivide (d,p) \<and> alldivide (d,q))"
  2650 "alldivide (d,(Or p q)) = ((alldivide (d,p)) \<and> (alldivide (d,q)))"
  2651 "alldivide (d,p) = True"
  2652 
  2653 (* alldivide is monotone *)
  2654 lemma alldivide_mono: "\<And> d'. \<lbrakk> alldivide (d,p) ; d dvd d'\<rbrakk> \<Longrightarrow> alldivide (d',p)"
  2655 proof(induct d p rule: alldivide.induct, simp_all add: ilcm_dvd1 ilcm_dvd2)
  2656   fix "d1" "d2" "d3"
  2657   assume th1:"d2 dvd (d1::int)"
  2658     and th2: "d1 dvd d3"
  2659   show "d2 dvd d3" by (rule zdvd_trans[OF th1 th2])
  2660 qed
  2661 
  2662 (* Some simple lemmas *)
  2663 lemma zdvd_eq_zdvd_abs: " (d::int) dvd d' = (d dvd (abs d')) "
  2664 proof-
  2665   have "d' < 0 \<or> d' \<ge> 0" by arith
  2666   moreover
  2667   {
  2668     assume dn': "d' < 0"
  2669     then have "abs d' = - d'" by simp
  2670     then 
  2671     have ?thesis by (simp)
  2672   }
  2673   moreover 
  2674   {
  2675     assume dp': "d' \<ge> 0"
  2676     then have "abs d' = d'" by simp
  2677     then have ?thesis  by simp
  2678   }
  2679     ultimately show ?thesis by blast
  2680 qed
  2681 
  2682 lemma zdvd_refl_abs: "(d::int) dvd (abs d)"
  2683 proof-
  2684   have "d dvd d" by simp
  2685   then show ?thesis by (simp add: iffD1 [OF zdvd_eq_zdvd_abs [where d = "d" and d'="d"]])
  2686 qed
  2687 
  2688 (* \<delta> > 0*)
  2689 lemma divlcm_pos: 
  2690   assumes 
  2691   linp: "islinform p"
  2692   shows "0 < divlcm p"
  2693 using linp
  2694 proof (induct p rule: divlcm.induct,simp_all add: ilcm_pos)
  2695   case (goal1 f) show ?case 
  2696     using prems 
  2697     by (cases f, auto) (case_tac "intterm1", auto)
  2698 qed
  2699 
  2700 lemma nz_le: "(x::int) > 0 \<Longrightarrow> x \<noteq> 0" by auto
  2701 (* divlcm is correct *)
  2702 lemma divlcm_corr:
  2703   assumes 
  2704   linp: "islinform p"
  2705   shows "alldivide (divlcm p,p)"
  2706   using linp divlcm_pos
  2707 proof (induct p rule: divlcm.induct,simp_all add: zdvd_refl_abs,clarsimp simp add: Nat.gr0_conv_Suc)
  2708   case (goal1 f)
  2709   have "islinform f" using prems  
  2710     by (cases f, auto) (case_tac "intterm2", auto,case_tac "intterm1", auto)
  2711   then have "alldivide (divlcm f, f)"  using prems by simp
  2712   moreover have "divlcm (NOT f) = divlcm f" by simp
  2713   moreover have "alldivide (x,f) = alldivide (x,NOT f)" by simp
  2714   ultimately show ?case by simp
  2715 next
  2716   case (goal2 f g)
  2717   have dvd1: "(divlcm f) dvd (ilcm (divlcm f) (divlcm g))" 
  2718     using prems by(simp add: ilcm_dvd1 nz_le)
  2719   have dvd2: "(divlcm g) dvd (ilcm (divlcm f) (divlcm g))" 
  2720     using prems by (simp add: ilcm_dvd2 nz_le)
  2721   from dvd1 prems 
  2722   have "alldivide (ilcm (divlcm f) (divlcm g), f)" 
  2723     by (simp add: alldivide_mono[where d= "divlcm f" and p="f" and d' ="ilcm (divlcm f) (divlcm g)"])
  2724   moreover   from dvd2 prems 
  2725    have "alldivide (ilcm (divlcm f) (divlcm g), g)" 
  2726     by (simp add: alldivide_mono[where d= "divlcm g" and p="g" and d' ="ilcm (divlcm f) (divlcm g)"])
  2727   ultimately show ?case by simp
  2728 next
  2729   case (goal3 f g)
  2730   have dvd1: "(divlcm f) dvd (ilcm (divlcm f) (divlcm g))" 
  2731     using prems by (simp add: nz_le ilcm_dvd1)
  2732   have dvd2: "(divlcm g) dvd (ilcm (divlcm f) (divlcm g))" 
  2733     using prems by (simp add: nz_le ilcm_dvd2)
  2734   from dvd1 prems 
  2735   have "alldivide (ilcm (divlcm f) (divlcm g), f)" 
  2736     by (simp add: alldivide_mono[where d= "divlcm f" and p="f" and d' ="ilcm (divlcm f) (divlcm g)"])
  2737   moreover   from dvd2 prems 
  2738    have "alldivide (ilcm (divlcm f) (divlcm g), g)" 
  2739     by (simp add: alldivide_mono[where d= "divlcm g" and p="g" and d' ="ilcm (divlcm f) (divlcm g)"])
  2740   ultimately show ?case by simp
  2741 qed
  2742 
  2743 
  2744 (* Properties of  minusinf and plusinf*)
  2745 
  2746 (* minusinf p and p are the same for minusinfity \<dots> *)
  2747 lemma minusinf_eq: 
  2748   assumes unifp: "isunified p" 
  2749   shows "\<exists> z. \<forall> x. x < z \<longrightarrow> (qinterp (x#ats) p = qinterp (x#ats) (minusinf p))"
  2750 using unifp unified_islinform[OF unifp]
  2751 proof (induct p rule: minusinf.induct)
  2752   case (1 c r z)
  2753   have "c <0 \<or> 0 \<le> c" by arith
  2754   moreover 
  2755   {
  2756     assume cneg: " c < 0"
  2757     from prems have z0: "z= Cst 0" 
  2758       by (cases z,auto)
  2759     with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2760       by simp
  2761 
  2762     from prems z0 have ?case 
  2763       proof-
  2764 	show ?thesis
  2765 	  using prems z0
  2766       apply auto
  2767       apply (rule exI[where x="I_intterm (a # ats) r"])
  2768       apply (rule allI)
  2769       proof-
  2770 	fix x
  2771 	show "x < I_intterm (a # ats) r \<longrightarrow> \<not> - x + I_intterm (x # ats) r \<le> 0"
  2772 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2773       qed
  2774     qed
  2775   }
  2776   moreover
  2777   {
  2778     assume cpos: "0 \<le> c"
  2779     from prems have z0: "z= Cst 0" 
  2780       by (cases z) auto
  2781     with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2782       by simp
  2783     
  2784     from prems z0 have ?case
  2785       proof-
  2786 	show ?thesis
  2787 	  using prems z0
  2788       apply auto
  2789       apply (rule exI[where x="-(I_intterm (a # ats) r)"])
  2790       apply (rule allI)
  2791       proof-
  2792 	fix x
  2793 	show "x < - I_intterm (a # ats) r \<longrightarrow> x + I_intterm (x # ats) r \<le> 0"
  2794 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2795       qed
  2796     qed
  2797   }
  2798     
  2799     ultimately show ?case by blast
  2800 next
  2801   case (2 c r z)
  2802   from prems have z0: "z= Cst 0" 
  2803     by (cases z,auto)
  2804   with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2805     by simp
  2806   have "c <0 \<or> 0 \<le> c" by arith
  2807   moreover 
  2808   {
  2809     assume cneg: " c < 0"
  2810     from prems z0 have ?case 
  2811       proof-
  2812 	show ?thesis
  2813 	  using prems z0
  2814       apply auto
  2815       apply (rule exI[where x="I_intterm (a # ats) r"])
  2816       apply (rule allI)
  2817       proof-
  2818 	fix x
  2819 	show "x < I_intterm (a # ats) r \<longrightarrow> \<not> - x + I_intterm (x # ats) r = 0"
  2820 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2821       qed
  2822     qed
  2823   }
  2824   moreover
  2825   {
  2826     assume cpos: "0 \<le> c"
  2827     from prems z0 have ?case
  2828       proof-
  2829 	show ?thesis
  2830 	  using prems z0
  2831       apply auto
  2832       apply (rule exI[where x="-(I_intterm (a # ats) r)"])
  2833       apply (rule allI)
  2834       proof-
  2835 	fix x
  2836 	show "x < - I_intterm (a # ats) r \<longrightarrow> x + I_intterm (x # ats) r \<noteq> 0"
  2837 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2838       qed
  2839     qed
  2840   }
  2841     
  2842     ultimately show ?case by blast
  2843 next
  2844   case (3 c r z)
  2845   from prems have z0: "z= Cst 0" 
  2846     by (cases z,auto)
  2847   with prems have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" 
  2848     by simp
  2849   have "c <0 \<or> 0 \<le> c" by arith
  2850   moreover 
  2851   {
  2852     assume cneg: " c < 0"
  2853     from prems z0 have ?case 
  2854       proof-
  2855 	show ?thesis
  2856 	  using prems z0
  2857       apply auto
  2858       apply (rule exI[where x="I_intterm (a # ats) r"])
  2859       apply (rule allI)
  2860       proof-
  2861 	fix x
  2862 	show "x < I_intterm (a # ats) r \<longrightarrow> \<not> - x + I_intterm (x # ats) r = 0"
  2863 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2864       qed
  2865     qed
  2866   }
  2867   moreover
  2868   {
  2869     assume cpos: "0 \<le> c"
  2870     from prems z0 have ?case
  2871       proof-
  2872 	show ?thesis
  2873 	  using prems z0
  2874       apply auto
  2875       apply (rule exI[where x="-(I_intterm (a # ats) r)"])
  2876       apply (rule allI)
  2877       proof-
  2878 	fix x
  2879 	show "x < - I_intterm (a # ats) r \<longrightarrow> x + I_intterm (x # ats) r \<noteq> 0"
  2880 	  by (simp add: intterm_novar0[OF lincnr, where x="a" and y="x"])
  2881       qed
  2882     qed
  2883   }
  2884     
  2885     ultimately show ?case by blast
  2886 next
  2887   
  2888   case (4 f g) 
  2889   from prems obtain "zf" where 
  2890     zf:"\<forall>x<zf. qinterp (x # ats) f = qinterp (x # ats) (minusinf f)" by auto
  2891   from prems obtain "zg" where 
  2892     zg:"\<forall>x<zg. qinterp (x # ats) g = qinterp (x # ats) (minusinf g)" by auto
  2893   from zf zg show ?case 
  2894     apply auto
  2895     apply (rule exI[where x="min zf zg"])
  2896     by simp
  2897   
  2898 next case (5 f g)  
  2899   from prems obtain "zf" where 
  2900     zf:"\<forall>x<zf. qinterp (x # ats) f = qinterp (x # ats) (minusinf f)" by auto
  2901   from prems obtain "zg" where 
  2902     zg:"\<forall>x<zg. qinterp (x # ats) g = qinterp (x # ats) (minusinf g)" by auto
  2903   from zf zg show ?case 
  2904     apply auto
  2905     apply (rule exI[where x="min zf zg"])
  2906     by simp
  2907   
  2908 qed simp_all
  2909 
  2910 (* miusinf p behaves periodically*)
  2911 lemma minusinf_repeats: 
  2912   assumes alldvd: "alldivide (d,p)"
  2913   and unity: "isunified p"
  2914   shows "qinterp (x#ats) (minusinf p) = qinterp ((x + c*d)#ats) (minusinf p)"
  2915   using alldvd unity unified_islinform[OF unity]
  2916 proof(induct p rule: islinform.induct, simp_all)
  2917   case (goal1 t a)
  2918   show ?case
  2919     using prems
  2920     apply (cases t, simp_all add: nth_pos2)
  2921     apply (case_tac "intterm1", simp_all)
  2922     apply (case_tac "intterm1a",simp_all)
  2923     by (case_tac "intterm2a",simp_all)
  2924   (case_tac "nat",simp_all add: nth_pos2 intterm_novar0[where x="x" and y="x+c*d"])
  2925 next 
  2926   case (goal2 t a)
  2927   show ?case
  2928     using prems
  2929     apply (cases t, simp_all add: nth_pos2)
  2930     apply (case_tac "intterm1", simp_all)
  2931     apply (case_tac "intterm1a",simp_all)
  2932     by (case_tac "intterm2a",simp_all)
  2933   (case_tac "nat",simp_all add: nth_pos2 intterm_novar0[where x="x" and y="x+c*d"])
  2934 next 
  2935   case (goal3 a t)
  2936   show ?case using prems
  2937 
  2938   proof(induct t rule: islinintterm.induct, simp_all add: nth_pos2)
  2939     case (goal1 i n i')
  2940     show ?case
  2941       using prems
  2942     proof(cases n, simp_all, case_tac "i=1", simp,
  2943 	simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"])
  2944       case goal1
  2945       from prems have "(abs i = 1) \<and> i \<noteq> 1" by auto 
  2946       then  have im1: "i=-1" by arith
  2947       then have "(a dvd i*x + i') = (a dvd x + (-i'))" 
  2948 	by (simp add: uminus_dvd_conv'[where d="a" and t="-x +i'"])
  2949       moreover 
  2950       from im1 have "(a dvd i*x + (i*(c * d)) + i') = (a dvd (x + c*d - i'))"
  2951 	apply simp
  2952 	apply (simp add: uminus_dvd_conv'[where d="a" and t="-x - c * d + i'"])
  2953 	by (simp add: zadd_ac)
  2954       ultimately 
  2955       have eq1:"((a dvd i*x + i') = (a dvd i*x + (i*(c * d)) + i')) = 
  2956 	((a dvd x + (-i'))  = (a dvd (x + c*d - i')))" by simp
  2957       moreover 
  2958       have dvd2: "(a dvd x + (-i')) = (a dvd x + c * d + (-i'))"
  2959 	by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  2960       ultimately show ?case by simp
  2961     qed
  2962   next
  2963     case (goal2 i n i' n' r)
  2964     have "n = 0 \<or> 0 < n" by arith
  2965     moreover 
  2966     {
  2967       assume npos: "0 < n"
  2968       from prems have "n < n'" by simp then have "0 < n'" by simp
  2969       moreover from prems
  2970       have linr: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  2971       ultimately have ?case 
  2972 	using prems npos
  2973 	by (simp add: nth_pos2 intterm_novar0[OF linr,where x="x" and y="x + c*d"])
  2974     }
  2975     moreover 
  2976     {
  2977       assume n0: "n=0"
  2978       from prems have lin2: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  2979       from prems have "n < n'" by simp then have npos': "0 < n'" by simp
  2980       with prems have ?case
  2981       proof(simp add: intterm_novar0[OF lin2, where x="x" and y="x+c*d"] 
  2982 	  nth_pos2 dvd_period,case_tac "i=1",
  2983 	  simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"], simp)
  2984 	case goal1
  2985 	from prems have "abs i = 1 \<and> i\<noteq>1" by auto
  2986 	then have mi: "i = -1" by arith
  2987 	have "(a dvd -x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)) = 
  2988 	  (a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))" 
  2989 	  by (simp add: 
  2990 	    uminus_dvd_conv'[where d="a" and 
  2991 	    t="-x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)"])
  2992 	also 
  2993 	have "(a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  2994 	  (a dvd x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))"
  2995 	  by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  2996 	also 
  2997 	have "(a dvd x +c*d + 
  2998 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  2999 	  (a dvd -(x +c*d + 
  3000 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))"
  3001 	  by (rule uminus_dvd_conv'[where d="a" and 
  3002 	    t="x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)"])
  3003 	also
  3004 	have "(a dvd -(x +c*d + 
  3005 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))
  3006 	  = (a dvd
  3007           - x - c * d + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r))" 
  3008 	  by (auto,simp_all add: zadd_ac)
  3009 	finally show ?case using mi by auto
  3010       qed
  3011     }
  3012     ultimately show ?case by blast
  3013   qed
  3014 next 
  3015   case (goal4 a t)
  3016   show ?case using prems 
  3017   proof(induct t rule: islinintterm.induct, simp_all,case_tac "n=0",
  3018       simp_all add: nth_pos2)
  3019     case (goal1 i n i')
  3020     show ?case
  3021       using prems
  3022     proof(case_tac "i=1", simp,
  3023 	simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"])
  3024       case goal1
  3025       from prems have "abs i = 1 \<and> i\<noteq>1" by auto 
  3026       then have im1: "i=-1" by arith
  3027       then have "(a dvd i*x + i') = (a dvd x + (-i'))" 
  3028 	by (simp add: uminus_dvd_conv'[where d="a" and t="-x +i'"])
  3029       moreover 
  3030       from im1 have "(a dvd i*x + (i*(c * d)) + i') = (a dvd (x + c*d - i'))"
  3031 	apply simp
  3032 	apply (simp add: uminus_dvd_conv'[where d="a" and t="-x - c * d + i'"])
  3033 	by (simp add: zadd_ac)
  3034       ultimately 
  3035       have eq1:"((a dvd i*x + i') = (a dvd i*x + (i*(c * d)) + i')) = 
  3036 	((a dvd x + (-i'))  = (a dvd (x + c*d - i')))" by simp
  3037       moreover 
  3038       have dvd2: "(a dvd x + (-i')) = (a dvd x + c * d + (-i'))"
  3039 	by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  3040       ultimately show ?thesis by simp
  3041     qed
  3042   next
  3043     case (goal2 i n i' n' r)
  3044     have "n = 0 \<or> 0 < n" by arith
  3045     moreover 
  3046     {
  3047       assume npos: "0 < n"
  3048       from prems have "n < n'" by simp then have "0 < n'" by simp
  3049       moreover from prems
  3050       have linr: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  3051       ultimately have ?case 
  3052 	using prems npos
  3053 	by (simp add: nth_pos2 intterm_novar0[OF linr,where x="x" and y="x + c*d"])
  3054     }
  3055     moreover 
  3056     {
  3057       assume n0: "n=0"
  3058       from prems have lin2: "islinintterm (Add (Mult (Cst i') (Var n')) r)" by simp
  3059       from prems have "n < n'" by simp then have npos': "0 < n'" by simp
  3060       with prems have ?case
  3061       proof(simp add: intterm_novar0[OF lin2, where x="x" and y="x+c*d"] 
  3062 	  nth_pos2 dvd_period,case_tac "i=1",
  3063 	  simp add: dvd_period[where a="a" and d="d" and x="x" and c="c"], simp)
  3064 	case goal1
  3065 	from prems have "abs i = 1 \<and> i\<noteq>1" by auto
  3066 	then have mi: "i = -1" by arith
  3067 	have "(a dvd -x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)) = 
  3068 	  (a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))" 
  3069 	  by (simp add: 
  3070 	    uminus_dvd_conv'[where d="a" and 
  3071 	    t="-x + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r)"])
  3072 	also 
  3073 	have "(a dvd x + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  3074 	  (a dvd x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r))"
  3075 	  by (rule dvd_period[where a="a" and d="d" and x="x" and c="c"], assumption)
  3076 	also 
  3077 	have "(a dvd x +c*d + 
  3078 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)) = 
  3079 	  (a dvd -(x +c*d + 
  3080 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))"
  3081 	  by (rule uminus_dvd_conv'[where d="a" and 
  3082 	    t="x +c*d + (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)"])
  3083 	also
  3084 	have "(a dvd -(x +c*d + 
  3085 	  (-i' * ats ! (n' - Suc 0) - I_intterm ((x + c * d) # ats) r)))
  3086 	  = (a dvd
  3087           - x - c * d + (i' * ats ! (n' - Suc 0) + I_intterm ((x + c * d) # ats) r))" 
  3088 	  by (auto,simp_all add: zadd_ac)
  3089 	finally show ?case using mi by auto
  3090       qed
  3091     }
  3092     ultimately show ?case by blast
  3093   qed
  3094 next 
  3095   case (goal5 t a)
  3096   show ?case
  3097     using prems
  3098     apply (cases t, simp_all add: nth_pos2)
  3099     apply (case_tac "intterm1", simp_all)
  3100     apply (case_tac "intterm1a",simp_all)
  3101     by (case_tac "intterm2a",simp_all)
  3102   (case_tac "nat",simp_all add: nth_pos2 intterm_novar0[where x="x" and y="x+c*d"])
  3103 qed
  3104 
  3105 lemma minusinf_repeats2:
  3106   assumes alldvd: "alldivide (d,p)"
  3107   and unity: "isunified p"
  3108   shows "\<forall> x k. (qinterp (x#ats) (minusinf p) = qinterp ((x - k*d)#ats) (minusinf p))" 
  3109   (is "\<forall> x k. ?P x = ?P (x - k*d)")
  3110 proof(rule allI, rule allI)
  3111   fix x k
  3112   show "?P x = ?P (x - k*d)"
  3113   proof-
  3114     have "?P x = ?P (x + (-k)*d)" by (rule minusinf_repeats[OF alldvd unity])
  3115     then have "?P x = ?P (x - (k*d))" by simp
  3116     then show ?thesis by blast 
  3117   qed
  3118 qed
  3119 
  3120 
  3121 (* existence for minusinf p is existence for p *)
  3122 lemma minusinf_lemma:
  3123   assumes unifp: "isunified p"
  3124   and exminf: "\<exists> j \<in> {1 ..d}. qinterp (j#ats) (minusinf p)" (is "\<exists> j \<in> {1 .. d}. ?P1 j")
  3125   shows "\<exists> x. qinterp (x#ats) p" (is "\<exists> x. ?P x")
  3126 proof-
  3127   from exminf obtain "j" where P1j: "?P1 j" by blast
  3128   have ePeqP1: "\<exists>z. \<forall> x. x < z \<longrightarrow> (?P x = ?P1 x)"
  3129     by (rule minusinf_eq[OF unifp])
  3130   then obtain "z" where P1eqP : "\<forall> x. x < z \<longrightarrow> (?P x = ?P1 x)" by blast
  3131   let ?d = "divlcm p"
  3132   have alldvd: "alldivide (?d,p)" using unified_islinform[OF unifp] divlcm_corr
  3133     by auto
  3134   have dpos: "0 < ?d" using unified_islinform[OF unifp] divlcm_pos
  3135     by simp
  3136   have P1eqP1 : "\<forall> x k. ?P1 x = ?P1 (x - k*(?d))"
  3137     by (rule minusinf_repeats2[OF alldvd unifp])
  3138   let ?w = "j - (abs (j-z) +1)* ?d"
  3139   show "\<exists> x. ?P x"
  3140   proof
  3141     have w: "?w < z" 
  3142       by (rule decr_lemma[OF dpos])
  3143     
  3144     have "?P1 j = ?P1 ?w" using P1eqP1 by blast
  3145     also have "\<dots> = ?P ?w"  using w P1eqP by blast
  3146     finally show "?P ?w" using P1j by blast
  3147   qed
  3148 qed
  3149 
  3150 (* limited search for the withness for minusinf p, due to peridicity *)
  3151 lemma minusinf_disj:
  3152   assumes unifp: "isunified p"
  3153   shows "(\<exists> x. qinterp (x#ats) (minusinf p)) = 
  3154   (\<exists> j \<in> { 1.. divlcm p}. qinterp (j#ats) (minusinf p))" 
  3155   (is "(\<exists> x. ?P x) = (\<exists> j \<in> { 1.. ?d}. ?P j)")
  3156 proof
  3157   have linp: "islinform p" by (rule unified_islinform[OF unifp])
  3158   have dpos: "0 < ?d" by (rule divlcm_pos[OF linp])
  3159   have alldvd: "alldivide(?d,p)" by (rule divlcm_corr[OF linp])
  3160   {
  3161     assume "\<exists> j\<in> {1 .. ?d}. ?P j"
  3162     then show "\<exists> x. ?P x" using dpos  by auto
  3163   next
  3164     assume "\<exists> x. ?P x"
  3165     then obtain "x" where P: "?P x" by blast
  3166     have modd: "\<forall>x k. ?P x = ?P (x - k*?d)"
  3167       by (rule minusinf_repeats2[OF alldvd unifp])
  3168     
  3169     have "x mod ?d = x - (x div ?d)*?d"
  3170       by(simp add:zmod_zdiv_equality mult_ac eq_diff_eq)
  3171     hence Pmod: "?P x = ?P (x mod ?d)" using modd by simp
  3172     show "\<exists> j\<in> {1 .. ?d}. ?P j"
  3173     proof (cases)
  3174       assume "x mod ?d = 0"
  3175       hence "?P 0" using P Pmod by simp
  3176       moreover have "?P 0 = ?P (0 - (-1)*?d)" using modd by blast
  3177       ultimately have "?P ?d" by simp
  3178       moreover have "?d \<in> {1 .. ?d}" using dpos 
  3179 	by (simp add:atLeastAtMost_iff)
  3180       ultimately show "\<exists> j\<in> {1 .. ?d}. ?P j" ..
  3181     next 
  3182       assume not0: "x mod ?d \<noteq> 0"
  3183       have "?P(x mod ?d)" using dpos P Pmod by(simp add:pos_mod_sign pos_mod_bound)
  3184       moreover have "x mod ?d : {1 .. ?d}"
  3185       proof -
  3186 	have "0 \<le> x mod ?d" by(rule pos_mod_sign[OF dpos])
  3187 	moreover have "x mod ?d < ?d"  by(rule pos_mod_bound[OF dpos])
  3188 	ultimately show ?thesis using not0 by(simp add:atLeastAtMost_iff)
  3189       qed
  3190       ultimately show "\<exists> j\<in> {1 .. ?d}. ?P j" ..
  3191     qed
  3192   }
  3193 qed
  3194 
  3195 lemma minusinf_qfree:
  3196   assumes linp : "islinform p"
  3197   shows "isqfree (minusinf p)"
  3198   using linp
  3199  by (induct p rule: minusinf.induct) auto 
  3200 
  3201 (* Properties of bset and a set *)
  3202 
  3203 (* The elements of a bset are linear *) 
  3204 lemma bset_lin:
  3205   assumes unifp: "isunified p"
  3206   shows "\<forall> b \<in> set (bset p). islinintterm b"
  3207 using unifp unified_islinform[OF unifp]
  3208 proof (induct p rule: bset.induct, auto)
  3209   case (goal1 c r z)
  3210   from prems have "z = Cst 0" by (cases z, simp_all)
  3211   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3212   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3213   have "islinintterm (Cst -1)" by simp
  3214   then show ?case using linr lin_add_lin by simp
  3215 next 
  3216   case (goal2 c r z)
  3217   from prems have "z = Cst 0" by (cases z, simp_all)
  3218   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3219   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3220   show ?case by (rule linr)
  3221 next
  3222   case (goal3 c r z)
  3223   from prems have "z = Cst 0" by (cases z, simp_all) 
  3224   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3225   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3226   have "islinintterm (Cst -1)" by simp
  3227   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3228 next
  3229   case (goal4 c r z)
  3230   from prems have "z = Cst 0" by (cases z, simp_all) 
  3231   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3232   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3233   have "islinintterm (Cst -1)" by simp
  3234   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3235 next
  3236   case (goal5 c r z)
  3237   from prems have "z = Cst 0" by (cases z, simp_all) 
  3238   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3239   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3240   have "islinintterm (Cst -1)" by simp
  3241   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3242 next
  3243   case (goal6 c r z)
  3244   from prems have "z = Cst 0" by (cases z, simp_all) 
  3245   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3246   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3247   have "islinintterm (Cst -1)" by simp
  3248   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3249 next
  3250   case (goal7 c r z)
  3251   from prems have "z = Cst 0" by (cases z, simp_all) 
  3252   then have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" using prems by simp
  3253   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3254   have "islinintterm (Cst -1)" by simp
  3255   then show ?case using linr lin_add_lin lin_neg_lin by simp
  3256 qed
  3257 
  3258 (* The third lemma in Norrisch's Paper *)
  3259 lemma bset_disj_repeat:
  3260   assumes unifp: "isunified p"
  3261   and alldvd: "alldivide (d,p)"
  3262   and dpos: "0 < d"
  3263   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)" 
  3264   (is "?Q x \<and> \<not>(\<exists> j\<in> {1.. d}. \<exists> b\<in> ?B. ?Q (?I a b + j)) \<and> ?P x") 
  3265     shows "?P (x -d)"  
  3266   using unifp nob alldvd unified_islinform[OF unifp]
  3267 proof (induct p rule: islinform.induct,auto)
  3268   case (goal1 t)
  3269   from prems 
  3270   have lint: "islinintterm t" by simp
  3271   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3272     by (induct t rule: islinintterm.induct) auto
  3273   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3274   moreover
  3275   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3276     then obtain "i" "n" "r" where 
  3277       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3278       by blast
  3279     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3280       by simp
  3281     have linr: "islinintterm r" 
  3282       by (rule islinintterm_subt[OF lininr])
  3283     have "n=0 \<or> n>0" by arith
  3284     moreover {assume "n>0" then have ?case 
  3285 	using prems
  3286 	by (simp add: nth_pos2 
  3287 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3288     moreover 
  3289     {assume nz: "n = 0"
  3290       from prems have "abs i = 1" by auto 
  3291       then have "i = -1 \<or> i =1" by arith
  3292       moreover
  3293       {
  3294 	assume i1: "i=1"
  3295 	have ?case  using dpos prems  
  3296 	  by (auto simp add: intterm_novar0[OF lininr, where x="x" and y="x - d"])
  3297       }
  3298       moreover 
  3299       {
  3300 	assume im1: "i = -1"
  3301 	have ?case 
  3302 	  using prems 
  3303 	proof(auto simp add: intterm_novar0[OF lininr, where x="x - d" and y="x"], cases)
  3304 	  assume "- x + d +  ?I x r \<le> 0"
  3305 	  then show "- x + d + ?I x r \<le> 0" .
  3306 	next 
  3307 	  assume np: "\<not> - x + d +  ?I x r \<le> 0"
  3308 	  then have ltd:"x - ?I x r \<le> d - 1" by simp 
  3309 	  from prems have "-x + ?I x r \<le> 0" by simp
  3310 	  then have ge0: "x - ?I x r \<ge> 0" 
  3311 	    by simp
  3312 	  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
  3313 	  moreover
  3314 	  {
  3315 	    assume "x - ?I x r = 0"
  3316 	    then have xeqr: "x = ?I x r" by simp
  3317 	    from prems have "?Q x" by simp
  3318 	    with xeqr have qr:"?Q (?I x r)" by simp
  3319 	    from prems have lininr: "islinintterm (Add (Mult (Cst i) (Var 0)) r)" by simp
  3320 	    have "islinintterm r" by (rule islinintterm_subt[OF lininr])
  3321 	    from prems 
  3322 	    have "\<forall>j\<in>{1..d}. \<not> ?Q (?I a r + -1 + j)"
  3323 	      using linr by (auto simp add: lin_add_corr)
  3324 	    moreover from dpos have "1 \<in> {1..d}" by simp
  3325 	    ultimately have " \<not> ?Q (?I a r + -1 + 1)" by blast
  3326 	    with dpos linr have "\<not> ?Q (?I x r)"
  3327 	      by (simp add: intterm_novar0[OF lininr, where x="x" and y="a"] lin_add_corr)
  3328 	    with qr have "- x + d + ?I x r \<le> 0" by simp
  3329 	  }
  3330 	  moreover
  3331 	  {
  3332 	    assume gt0: "1 \<le> x - ?I x r \<and> x - ?I x r \<le> d - 1"
  3333 	    then have "\<exists> j\<in> {1 .. d - 1}. x - ?I x r =  j" by simp
  3334 	    then have "\<exists> j\<in> {1 .. d}. x - ?I x r =  j" by auto
  3335 	    then obtain  "j" where con: "1\<le>j \<and> j \<le> d  \<and> x - ?I x r = j" by auto
  3336 	    then have xeqr: "x = ?I x r + j" by auto
  3337 	    with prems have "?Q (?I x r + j)" by simp
  3338 	    with con have qrpj: "\<exists> j\<in> {1 .. d}. ?Q (?I x r + j)" by auto
  3339 	    from prems have "\<forall>j\<in>{1..d}. \<not> ?Q (?I a r + j)" by auto
  3340 	    then have "\<not> (\<exists> j\<in>{1..d}. ?Q (?I x r + j))" 
  3341 	      by (simp add: intterm_novar0[OF lininr, where x="x" and y="a"])
  3342 	    with qrpj prems have "- x + d + ?I x r \<le> 0" by simp 
  3343 	    
  3344 	  }
  3345 	  ultimately show "- x + d + ?I x r \<le> 0" by blast
  3346 	qed
  3347       }
  3348       ultimately have ?case by blast
  3349     }
  3350     ultimately have ?case by blast
  3351   }
  3352   ultimately show ?case by blast
  3353 next  
  3354   case (goal3 a t)
  3355   from prems 
  3356   have lint: "islinintterm t" by simp
  3357   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3358     by (induct t rule: islinintterm.induct) auto
  3359   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3360   moreover
  3361   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3362     then obtain "i" "n" "r" where 
  3363       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3364       by blast
  3365     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3366       by simp
  3367     have linr: "islinintterm r" 
  3368       by (rule islinintterm_subt[OF lininr])
  3369     have "n=0 \<or> n>0" by arith
  3370     moreover {assume "n>0" then have ?case using prems 
  3371 	by (simp add: nth_pos2 
  3372 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3373     moreover {
  3374       assume nz: "n=0"
  3375       from prems have "abs i = 1" by auto
  3376       then have ipm: "i=1 \<or> i = -1" by arith
  3377       from nz prems have advdixr: "a dvd (i * x) + I_intterm (x # ats) r" 
  3378 	by simp
  3379       from prems have "a dvd d" by simp
  3380       then have advdid: "a dvd i*d" using ipm by auto  
  3381       have ?case
  3382       using prems ipm 
  3383       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"])
  3384   }
  3385   ultimately have ?case by blast
  3386   } ultimately show ?case by blast
  3387 next
  3388 
  3389   case (goal4 a t)
  3390   from prems 
  3391   have lint: "islinintterm t" by simp
  3392   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3393     by (induct t rule: islinintterm.induct) auto
  3394   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3395   moreover
  3396   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3397     then obtain "i" "n" "r" where 
  3398       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3399       by blast
  3400     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3401       by simp
  3402     have linr: "islinintterm r" 
  3403       by (rule islinintterm_subt[OF lininr])
  3404 
  3405     have "n=0 \<or> n>0" by arith
  3406     moreover {assume "n>0" then have ?case using prems 
  3407 	by (simp add: nth_pos2 
  3408 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3409     moreover {
  3410       assume nz: "n=0"
  3411       from prems have "abs i = 1" by auto
  3412       then have ipm: "i =1 \<or> i = -1" by arith
  3413       from nz prems have advdixr: "\<not> (a dvd (i * x) + I_intterm (x # ats) r)" 
  3414 	by simp
  3415       from prems have "a dvd d" by simp
  3416       then have advdid: "a dvd i*d" using ipm by auto
  3417       have ?case
  3418       using prems ipm 
  3419       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"])
  3420   }
  3421   ultimately have ?case by blast
  3422   } ultimately show ?case by blast
  3423 next 
  3424   case (goal2 t)
  3425   from prems
  3426   have lint: "islinintterm t" by simp
  3427   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3428     by (induct t rule: islinintterm.induct) auto
  3429   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3430   moreover
  3431   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3432     then obtain "i" "n" "r" where 
  3433       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3434       by blast
  3435     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3436       by simp
  3437     have linr: "islinintterm r" 
  3438       by (rule islinintterm_subt[OF lininr])
  3439     have "n=0 \<or> n>0" by arith
  3440     moreover {assume "n>0" then have ?case 
  3441 	using prems
  3442 	by (simp add: nth_pos2 
  3443 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3444     moreover 
  3445     {assume nz: "n = 0"
  3446       from prems have "abs i = 1" by auto 
  3447       then have "i = -1 \<or> i =1" by arith
  3448       moreover
  3449       {
  3450 	assume i1: "i=1"
  3451 	with prems have px: "x + ?I x r = 0" by simp
  3452 	then have "x = (- ?I x r - 1) + 1" by simp
  3453 	hence q1: "?Q ((- ?I x r - 1) + 1)" by simp
  3454 	from prems have "\<not> (?Q ((?I a (lin_add(lin_neg r, Cst -1))) + 1))"
  3455 	  by auto
  3456 	hence "\<not> (?Q ((- ?I a r - 1) + 1))" 
  3457 	  using lin_add_corr lin_neg_corr linr lin_neg_lin
  3458 	  by simp
  3459 	hence "\<not> (?Q ((- ?I x r - 1) + 1))" 
  3460 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3461 	  by simp
  3462 	with q1 have  ?case by simp
  3463       }
  3464       moreover 
  3465       {
  3466 	assume im1: "i = -1"
  3467 	with prems have px: "-x + ?I x r = 0" by simp
  3468 	then have "x = ?I x r" by simp
  3469 	hence q1: "?Q (?I x r)" by simp
  3470 	from prems have "\<not> (?Q ((?I a (lin_add(r, Cst -1))) + 1))"
  3471 	  by auto
  3472 	hence "\<not> (?Q (?I a r))" 
  3473 	  using lin_add_corr lin_neg_corr linr lin_neg_lin
  3474 	  by simp
  3475 	hence "\<not> (?Q (?I x r ))" 
  3476 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3477 	  by simp
  3478 	with q1 have  ?case by simp
  3479       }
  3480       ultimately have ?case by blast
  3481     }
  3482     ultimately have ?case by blast
  3483   }
  3484   ultimately show ?case by blast
  3485 next
  3486   case (goal5 t)
  3487   from prems
  3488   have lint: "islinintterm t" by simp
  3489   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3490     by (induct t rule: islinintterm.induct) auto
  3491   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3492   moreover
  3493   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3494     then obtain "i" "n" "r" where 
  3495       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3496       by blast
  3497     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3498       by simp
  3499     have linr: "islinintterm r" 
  3500       by (rule islinintterm_subt[OF lininr])
  3501     have "n=0 \<or> n>0" by arith
  3502     moreover {assume "n>0" then have ?case 
  3503 	using prems
  3504 	by (simp add: nth_pos2 
  3505 	  intterm_novar0[OF lininr, where x="x" and y="x-d"]) }
  3506     moreover 
  3507     {assume nz: "n = 0"
  3508       from prems have "abs i = 1" by auto 
  3509       then have "i = -1 \<or> i =1" by arith
  3510       moreover
  3511       {
  3512 	assume i1: "i=1"
  3513 	with prems have px: "x -d + ?I (x-d) r = 0" by simp
  3514 	hence "x = (- ?I x r) + d" 
  3515 	  using intterm_novar0[OF lininr, where x="x" and y="x-d"]
  3516 	  by simp
  3517 	hence q1: "?Q (- ?I x r + d)" by simp
  3518 	from prems have "\<not> (?Q ((?I a (lin_neg r)) + d))"
  3519 	  by auto
  3520 	hence "\<not> (?Q (- ?I a r + d))" 
  3521 	  using lin_neg_corr linr by simp
  3522 	hence "\<not> (?Q ((- ?I x r + d)))" 
  3523 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3524 	  by simp
  3525 	with q1 have  ?case by simp
  3526       }
  3527       moreover 
  3528       {
  3529 	assume im1: "i = -1"
  3530 	with prems have px: "- (x -d) + ?I (x - d) r = 0" by simp
  3531 	then have "x = ?I x r + d "
  3532  	  using intterm_novar0[OF lininr, where x="x" and y="x-d"]
  3533 	  by simp
  3534 	hence q1: "?Q (?I x r + d)" by simp
  3535 	from prems have "\<not> (?Q ((?I a r) + d))"
  3536 	  by auto
  3537 	hence "\<not> (?Q (?I x r + d))" 
  3538 	  using intterm_novar0[OF lininr, where x="x" and y="a"]
  3539 	  by simp
  3540 	with q1 have  ?case by simp
  3541       }
  3542       ultimately have ?case by blast
  3543     }
  3544     ultimately have ?case by blast
  3545   }
  3546   ultimately show ?case by blast
  3547   
  3548 qed
  3549   
  3550 lemma bset_disj_repeat2:
  3551   assumes unifp: "isunified p"
  3552 
  3553   shows "\<forall> x. \<not>(\<exists>j\<in> {1 .. (divlcm p)}. \<exists> b \<in> set (bset p). 
  3554   (qinterp (((I_intterm (a#ats) b) + j)#ats) p))  
  3555   \<longrightarrow> (qinterp (x#ats) p) \<longrightarrow> (qinterp ((x - (divlcm p))#ats) p)" 
  3556   (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)")
  3557 proof
  3558   fix x
  3559   have linp: "islinform p" by (rule unified_islinform[OF unifp])
  3560   have dpos: "?d > 0" by (rule divlcm_pos[OF linp])
  3561   have alldvd: "alldivide(?d,p)" by (rule divlcm_corr[OF linp])
  3562     show "\<not>(\<exists> j\<in> {1 .. ?d}. \<exists> b\<in> ?B. ?P (?I a b + j)) \<longrightarrow> ?P x \<longrightarrow> ?P (x - ?d)"
  3563     using prems bset_disj_repeat[OF unifp alldvd dpos]
  3564     by blast
  3565 qed
  3566 
  3567 (* Cooper's theorem in the minusinfinity version *)
  3568 lemma cooper_mi_eq: 
  3569   assumes unifp : "isunified p"
  3570   shows "(\<exists> x. qinterp (x#ats) p) = 
  3571   ((\<exists> j \<in> {1 .. (divlcm p)}. qinterp (j#ats) (minusinf p)) \<or> 
  3572   (\<exists> j \<in> {1 .. (divlcm p)}. \<exists> b \<in> set (bset p). 
  3573   qinterp (((I_intterm (a#ats) b) + j)#ats) p))"
  3574   (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)))")
  3575 proof-
  3576   have linp :"islinform p" by (rule unified_islinform[OF unifp])
  3577   have dpos: "?d > 0" by (rule divlcm_pos[OF linp])
  3578   have alldvd: "alldivide(?d,p)" by (rule divlcm_corr[OF linp])
  3579   have eMPimpeP: "(\<exists>j \<in> ?D. ?MP j) \<longrightarrow> (\<exists>x. ?P x)"
  3580     by (simp add: minusinf_lemma[OF unifp, where d="?d" and ats="ats"])
  3581   have ePimpeP: "(\<exists> j \<in> ?D. \<exists> b\<in> ?B. ?P (?I a b + j)) \<longrightarrow> (\<exists> x. ?P x)"
  3582     by blast
  3583   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)"
  3584     by (rule bset_disj_repeat2[OF unifp])
  3585   have MPrep: "\<forall> x k. ?MP x = ?MP (x- k*?d)"
  3586     by (rule minusinf_repeats2[OF alldvd unifp])
  3587   have MPeqP: "\<exists> z. \<forall>  x < z. ?P x = ?MP x"
  3588     by (rule minusinf_eq[OF unifp])
  3589   let ?B'= "{?I a b| b. b\<in> ?B}"
  3590   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)"
  3591     by auto
  3592   show ?thesis 
  3593   using cpmi_eq[OF dpos MPeqP bst_rep2 MPrep]
  3594   by auto
  3595 qed
  3596 
  3597 (* A formalized analogy between aset, bset, plusinfinity and minusinfinity *)
  3598 
  3599 consts mirror:: "QF \<Rightarrow> QF"
  3600 recdef mirror "measure size"
  3601 "mirror (Le (Add (Mult (Cst c) (Var 0)) r) z) =
  3602   (Le (Add (Mult (Cst (- c)) (Var 0)) r) z)"
  3603 "mirror (Eq (Add (Mult (Cst c) (Var 0)) r) z) =
  3604   (Eq (Add (Mult (Cst (- c)) (Var 0)) r) z)"
  3605 "mirror (Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r)) = 
  3606   (Divides (Cst d) (Add (Mult (Cst (- c)) (Var 0)) r))"
  3607 "mirror (NOT(Divides (Cst d) (Add (Mult (Cst c) (Var 0)) r))) = 
  3608   (NOT(Divides (Cst d) (Add (Mult (Cst (- c)) (Var 0)) r)))"
  3609 "mirror (NOT(Eq (Add (Mult (Cst c) (Var 0)) r) z)) =
  3610   (NOT(Eq (Add (Mult (Cst (- c)) (Var 0)) r) z))"
  3611 "mirror (And p q) = And (mirror p) (mirror q)"
  3612 "mirror (Or p q) = Or (mirror p) (mirror q)"
  3613 "mirror p = p"
  3614 (* mirror preserves unifiedness *)
  3615 
  3616 lemma[simp]: "(abs (i::int) = 1) = (i =1 \<or> i = -1)"  by arith
  3617 lemma mirror_unified:
  3618   assumes unif: "isunified p"
  3619   shows "isunified (mirror p)"
  3620   using unif
  3621 proof (induct p rule: mirror.induct, simp_all)
  3622   case (goal1 c r z)
  3623   from prems have zz: "z = Cst 0" by (cases z, simp_all) 
  3624   then show ?case using prems 
  3625     by (auto simp add: islinintterm_eq_islint islint_def)
  3626 next 
  3627   case (goal2 c r z)
  3628   from prems have zz: "z = Cst 0" by (cases z, simp_all) 
  3629   then show ?case using prems 
  3630     by (auto simp add: islinintterm_eq_islint islint_def)
  3631 next
  3632   case (goal3 d c r) show ?case using prems by (auto simp add: islinintterm_eq_islint islint_def) 
  3633 next 
  3634   case (goal4 d c r) show ?case using prems  by (auto simp add: islinintterm_eq_islint islint_def)
  3635 next 
  3636  case (goal5 c r z)
  3637   from prems have zz: "z = Cst 0" by (cases z, simp_all) 
  3638   then show ?case using prems 
  3639     by (auto simp add: islinintterm_eq_islint islint_def)
  3640 qed
  3641 
  3642 (* relationship between plusinf and minusinf *)
  3643 lemma plusinf_eq_minusinf_mirror:
  3644   assumes unifp: "isunified p"
  3645   shows "(qinterp (x#ats) (plusinf p)) = (qinterp ((- x)#ats) (minusinf (mirror p)))"
  3646 using unifp unified_islinform[OF unifp]
  3647 proof (induct p rule: islinform.induct, simp_all)
  3648   case (goal1 t z)
  3649   from prems 
  3650   have lint: "islinintterm t" by simp
  3651   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3652     by (induct t rule: islinintterm.induct) auto
  3653   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3654   moreover
  3655   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3656     then obtain "i" "n" "r" where 
  3657       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3658       by blast
  3659     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3660       by simp
  3661     have linr: "islinintterm r" 
  3662       by (rule islinintterm_subt[OF lininr])
  3663     have ?case using prems 
  3664       by (cases n, auto simp add: nth_pos2 
  3665 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3666   ultimately show ?case by blast
  3667     
  3668 next
  3669   case (goal2 t z)
  3670   from prems 
  3671   have lint: "islinintterm t" by simp
  3672   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3673     by (induct t rule: islinintterm.induct) auto
  3674   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3675   moreover
  3676   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3677     then obtain "i" "n" "r" where 
  3678       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3679       by blast
  3680     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3681       by simp
  3682     have linr: "islinintterm r" 
  3683       by (rule islinintterm_subt[OF lininr])
  3684     have ?case using prems 
  3685       by (cases n, auto simp add: nth_pos2 
  3686 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3687   ultimately show ?case by blast
  3688 next
  3689   case (goal3 d t)
  3690   
  3691  from prems 
  3692   have lint: "islinintterm t" by simp
  3693   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3694     by (induct t rule: islinintterm.induct) auto
  3695   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3696   moreover
  3697   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3698     then obtain "i" "n" "r" where 
  3699       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3700       by blast
  3701     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3702       by simp
  3703     have linr: "islinintterm r" 
  3704       by (rule islinintterm_subt[OF lininr])
  3705 
  3706     have ?case using prems 
  3707       by (cases n, simp_all add: nth_pos2 
  3708 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3709   ultimately show ?case by blast
  3710 next
  3711 
  3712   case (goal4 d t)
  3713   
  3714  from prems 
  3715   have lint: "islinintterm t" by simp
  3716   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3717     by (induct t rule: islinintterm.induct) auto
  3718   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3719   moreover
  3720   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3721     then obtain "i" "n" "r" where 
  3722       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3723       by blast
  3724     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3725       by simp
  3726     have linr: "islinintterm r" 
  3727       by (rule islinintterm_subt[OF lininr])
  3728 
  3729     have ?case using prems 
  3730       by (cases n, simp_all add: nth_pos2 
  3731 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3732   ultimately show ?case by blast
  3733 next
  3734   case (goal5 t z)
  3735   from prems 
  3736   have lint: "islinintterm t" by simp
  3737   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3738     by (induct t rule: islinintterm.induct) auto
  3739   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3740   moreover
  3741   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3742     then obtain "i" "n" "r" where 
  3743       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3744       by blast
  3745     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3746       by simp
  3747     have linr: "islinintterm r" 
  3748       by (rule islinintterm_subt[OF lininr])
  3749     have ?case using prems 
  3750       by (cases n, auto simp add: nth_pos2 
  3751 	  intterm_novar0[OF lininr, where x="x" and y="-x"] )}
  3752   ultimately show ?case by blast
  3753 qed
  3754 
  3755 (* relationship between aset abd bset *)
  3756 lemma aset_eq_bset_mirror: 
  3757   assumes unifp: "isunified p"
  3758   shows "set (aset p) = set (map lin_neg (bset (mirror p)))"
  3759 using unifp
  3760 proof(induct p rule: mirror.induct)
  3761   case (1 c r z) 
  3762   from prems have zz: "z = Cst 0"
  3763     by (cases z, auto)
  3764   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3765   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3766   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3767   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3768   show ?case  using prems linr zz apply (auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3769     by (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin)
  3770 next
  3771   case (2 c r z)   from prems have zz: "z = Cst 0"
  3772     by (cases z, auto)
  3773   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3774   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3775   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3776   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3777   show ?case  using prems linr zz
  3778     by (auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3779   (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin lin_neg_lin)
  3780 
  3781 next
  3782   case (5 c r z)  from prems have zz: "z = Cst 0"
  3783     by (cases z, auto)
  3784   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3785   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3786   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3787   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3788   show ?case  using prems linr zz
  3789     by(auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3790   
  3791 qed simp_all
  3792 
  3793 (* relationship between aset abd bset 2*)
  3794 lemma aset_eq_bset_mirror2: 
  3795   assumes unifp: "isunified p"
  3796   shows "aset p = map lin_neg (bset (mirror p))"
  3797 using unifp
  3798 proof(induct p rule: mirror.induct)
  3799   case (1 c r z) 
  3800   from prems have zz: "z = Cst 0"
  3801     by (cases z, auto)
  3802   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3803   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3804   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3805   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3806   show ?case  using prems linr zz
  3807     apply (simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3808     apply (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin)
  3809     by arith
  3810 next
  3811   case (2 c r z)   from prems have zz: "z = Cst 0"
  3812     by (cases z, auto)
  3813   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3814   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3815   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3816   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3817   show ?case  using prems linr zz
  3818     by(auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3819     (simp add: negm1eq1 lin_neg_idemp sym[OF lin_neg_lin_add_distrib] lin_add_lin lin_neg_lin)
  3820 
  3821 next
  3822   case (5 c r z)  from prems have zz: "z = Cst 0"
  3823     by (cases z, auto)
  3824   from prems zz have lincnr: "islinintterm (Add (Mult (Cst c) (Var 0)) r)" by simp
  3825   have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  3826   have neg1eqm1: "Cst 1 = lin_neg (Cst -1)" by (simp add: lin_neg_def)
  3827   have negm1eq1: "Cst -1 = lin_neg (Cst 1)" by (simp add: lin_neg_def)
  3828   show ?case  using prems linr zz
  3829     by(auto simp add: lin_neg_lin_add_distrib lin_neg_idemp neg1eqm1)
  3830   
  3831 qed simp_all
  3832 
  3833 (* mirror preserves divlcm *)
  3834 lemma divlcm_mirror_eq:
  3835   assumes unifp: "isunified p"
  3836   shows "divlcm p = divlcm (mirror p)"
  3837   using unifp
  3838 by (induct p rule: mirror.induct) auto
  3839 
  3840 (* mirror almost preserves semantics *)  
  3841 lemma mirror_interp: 
  3842   assumes unifp: "isunified p"
  3843   shows "(qinterp (x#ats) p) = (qinterp ((- x)#ats) (mirror p))" (is "?P x = ?MP (-x)")
  3844 using unifp unified_islinform[OF unifp]
  3845 proof (induct p rule: islinform.induct)
  3846   case (1 t z)
  3847   from prems have zz: "z = 0" by simp
  3848   from prems 
  3849   have lint: "islinintterm t" by simp
  3850   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3851     by (induct t rule: islinintterm.induct) auto
  3852   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3853   moreover
  3854   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3855     then obtain "i" "n" "r" where 
  3856       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3857       by blast
  3858     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3859       by simp
  3860     have linr: "islinintterm r" 
  3861       by (rule islinintterm_subt[OF lininr])
  3862     have ?case using prems zz
  3863       by (cases n) (simp_all add: nth_pos2 
  3864 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3865   }
  3866   ultimately show ?case by blast
  3867 next
  3868   case (2 t z)
  3869   from prems have zz: "z = 0" by simp
  3870   from prems 
  3871   have lint: "islinintterm t" by simp
  3872   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3873     by (induct t rule: islinintterm.induct) auto
  3874   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3875   moreover
  3876   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3877     then obtain "i" "n" "r" where 
  3878       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3879       by blast
  3880     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3881       by simp
  3882     have linr: "islinintterm r" 
  3883       by (rule islinintterm_subt[OF lininr])
  3884     have ?case using prems zz
  3885       by (cases n) (simp_all add: nth_pos2 
  3886 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3887   }
  3888   ultimately show ?case by blast
  3889 next
  3890   case (3 d t) 
  3891   from prems 
  3892   have lint: "islinintterm t" by simp
  3893   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3894     by (induct t rule: islinintterm.induct) auto
  3895   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3896   moreover
  3897   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3898     then obtain "i" "n" "r" where 
  3899       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3900       by blast
  3901     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3902       by simp
  3903     have linr: "islinintterm r" 
  3904       by (rule islinintterm_subt[OF lininr])
  3905     have ?case
  3906       using prems linr 
  3907       by (cases n) (simp_all add: nth_pos2
  3908 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3909   }
  3910   ultimately show ?case by blast
  3911 next
  3912 
  3913   case (6 d t) 
  3914   from prems 
  3915   have lint: "islinintterm t" by simp
  3916   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3917     by (induct t rule: islinintterm.induct) auto
  3918   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3919   moreover
  3920   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3921     then obtain "i" "n" "r" where 
  3922       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3923       by blast
  3924     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3925       by simp
  3926     have linr: "islinintterm r" 
  3927       by (rule islinintterm_subt[OF lininr])
  3928     have ?case
  3929       using prems linr 
  3930       by (cases n) (simp_all add: nth_pos2
  3931 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3932   }
  3933   ultimately show ?case by blast
  3934 next 
  3935   case (7 t z)
  3936   from prems have zz: "z = 0" by simp
  3937   from prems 
  3938   have lint: "islinintterm t" by simp
  3939   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3940     by (induct t rule: islinintterm.induct) auto
  3941   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3942   moreover
  3943   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3944     then obtain "i" "n" "r" where 
  3945       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3946       by blast
  3947     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3948       by simp
  3949     have linr: "islinintterm r" 
  3950       by (rule islinintterm_subt[OF lininr])
  3951     have ?case using prems zz
  3952       by (cases n) (simp_all add: nth_pos2 
  3953 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3954   }
  3955   ultimately show ?case by blast 
  3956 qed simp_all
  3957 
  3958 
  3959 lemma mirror_interp2: 
  3960   assumes unifp: "islinform p"
  3961   shows "(qinterp (x#ats) p) = (qinterp ((- x)#ats) (mirror p))" (is "?P x = ?MP (-x)")
  3962 using unifp 
  3963 proof (induct p rule: islinform.induct)
  3964   case (1 t z)
  3965   from prems have zz: "z = 0" by simp
  3966   from prems 
  3967   have lint: "islinintterm t" by simp
  3968   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3969     by (induct t rule: islinintterm.induct) auto
  3970   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3971   moreover
  3972   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3973     then obtain "i" "n" "r" where 
  3974       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3975       by blast
  3976     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3977       by simp
  3978     have linr: "islinintterm r" 
  3979       by (rule islinintterm_subt[OF lininr])
  3980     have ?case using prems zz
  3981       by (cases n) (simp_all add: nth_pos2 
  3982 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  3983   }
  3984   ultimately show ?case by blast
  3985 next
  3986   case (2 t z)
  3987   from prems have zz: "z = 0" by simp
  3988   from prems 
  3989   have lint: "islinintterm t" by simp
  3990   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  3991     by (induct t rule: islinintterm.induct) auto
  3992   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  3993   moreover
  3994   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  3995     then obtain "i" "n" "r" where 
  3996       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  3997       by blast
  3998     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  3999       by simp
  4000     have linr: "islinintterm r" 
  4001       by (rule islinintterm_subt[OF lininr])
  4002     have ?case using prems zz
  4003       by (cases n) (simp_all add: nth_pos2 
  4004 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4005   }
  4006   ultimately show ?case by blast
  4007 next
  4008   case (3 d t) 
  4009   from prems 
  4010   have lint: "islinintterm t" by simp
  4011   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  4012     by (induct t rule: islinintterm.induct) auto
  4013   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  4014   moreover
  4015   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  4016     then obtain "i" "n" "r" where 
  4017       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4018       by blast
  4019     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4020       by simp
  4021     have linr: "islinintterm r" 
  4022       by (rule islinintterm_subt[OF lininr])
  4023     have ?case
  4024       using prems linr 
  4025       by (cases n) (simp_all add: nth_pos2
  4026 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4027   }
  4028   ultimately show ?case by blast
  4029 next
  4030 
  4031   case (6 d t) 
  4032   from prems 
  4033   have lint: "islinintterm t" by simp
  4034   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  4035     by (induct t rule: islinintterm.induct) auto
  4036   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  4037   moreover
  4038   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  4039     then obtain "i" "n" "r" where 
  4040       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4041       by blast
  4042     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4043       by simp
  4044     have linr: "islinintterm r" 
  4045       by (rule islinintterm_subt[OF lininr])
  4046     have ?case
  4047       using prems linr 
  4048       by (cases n) (simp_all add: nth_pos2
  4049 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4050   }
  4051   ultimately show ?case by blast
  4052 next 
  4053   case (7 t z)
  4054   from prems have zz: "z = 0" by simp
  4055   from prems 
  4056   have lint: "islinintterm t" by simp
  4057   then have "(\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r) \<or> (\<exists> i. t = Cst i)"
  4058     by (induct t rule: islinintterm.induct) auto
  4059   moreover{ assume "\<exists> i. t = Cst i" then have ?case using prems by auto }
  4060   moreover
  4061   { assume "\<exists> i n r. t = Add (Mult (Cst i) (Var n) ) r"
  4062     then obtain "i" "n" "r" where 
  4063       inr_def: "t = Add (Mult (Cst i) (Var n) ) r" 
  4064       by blast
  4065     with lint have lininr: "islinintterm (Add (Mult (Cst i) (Var n) ) r)" 
  4066       by simp
  4067     have linr: "islinintterm r" 
  4068       by (rule islinintterm_subt[OF lininr])
  4069     have ?case using prems zz
  4070       by (cases n) (simp_all add: nth_pos2 
  4071 	intterm_novar0[OF lininr, where x="x" and y="-x"])
  4072   }
  4073   ultimately show ?case by blast 
  4074 qed simp_all
  4075 
  4076 (* mirror preserves existence *)
  4077 lemma mirror_ex: 
  4078   assumes unifp: "isunified p"
  4079   shows "(\<exists> x. (qinterp (x#ats) p)) = (\<exists> y. (qinterp (y#ats) (mirror p)))" 
  4080   (is "(\<exists> x. ?P x) = (\<exists> y. ?MP y)")
  4081 proof
  4082   assume "\<exists> x. ?P x"
  4083   then obtain "x" where px:"?P x" by blast
  4084   have "?MP (-x)" 
  4085     using px
  4086     by(simp add: mirror_interp[OF unifp, where x="x"])
  4087   then show "\<exists> y. ?MP y" by blast
  4088 next 
  4089   assume "\<exists> y. ?MP y"
  4090   then obtain "y" where mpy: "?MP y" by blast
  4091   have "?P (-y)"
  4092     using mpy
  4093     by (simp add: mirror_interp[OF unifp, where x="-y"])
  4094   then show "\<exists> x. ?P x" by blast
  4095 qed
  4096 
  4097 lemma mirror_ex2: 
  4098   assumes unifp: "isunified p"
  4099   shows "qinterp ats (QEx p) = qinterp ats (QEx (mirror p))"
  4100 using mirror_ex[OF unifp] by simp
  4101 
  4102   
  4103 (* Cooper's theorem in its plusinfinity version *)
  4104 lemma cooper_pi_eq:
  4105   assumes unifp : "isunified p"
  4106   shows "(\<exists> x. qinterp (x#ats) p) = 
  4107   ((\<exists> j \<in> {1 .. (divlcm p)}. qinterp (-j#ats) (plusinf p)) \<or> 
  4108   (\<exists> j \<in> {1 .. (divlcm p)}. \<exists> b \<in> set (aset p). 
  4109   qinterp (((I_intterm (a#ats) b) - j)#ats) p))"
  4110   (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)))")
  4111 proof-
  4112   have unifmp: "isunified (mirror p)" by (rule mirror_unified[OF unifp])
  4113   have th1: 
  4114     "(\<exists> j\<in> {1 .. ?d}. ?PP (-j)) = (\<exists> j\<in> {1..?d}.  qinterp (j # ats) (minusinf (mirror p)))"
  4115     by (simp add: plusinf_eq_minusinf_mirror[OF unifp])
  4116   have dth: "?d = divlcm (mirror p)"
  4117     by (rule divlcm_mirror_eq[OF unifp])
  4118   have "(\<exists> j \<in> ?D. \<exists> b\<in> ?A. ?P (?I a b - j)) = 
  4119     (\<exists> j\<in> ?D. \<exists> b \<in> set (map lin_neg (bset (mirror p))). ?P (?I a b - j))"
  4120     by (simp only: aset_eq_bset_mirror[OF unifp])
  4121   also have "\<dots> = (\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (?I a (lin_neg b) - j))"
  4122     by simp
  4123   also have "\<dots> = (\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (-(?I a b + j)))"
  4124   proof
  4125     assume "\<exists>j\<in>{1..divlcm p}.
  4126       \<exists>b\<in>set (bset (mirror p)). qinterp ((I_intterm (a # ats) (lin_neg b) - j) # ats) p"
  4127     then
  4128     obtain "j" and "b" where 
  4129       pbmj: "j\<in> ?D \<and> b\<in> set (bset (mirror p)) \<and> ?P (?I a (lin_neg b) - j)" by blast
  4130     then have linb: "islinintterm b" 
  4131       by (auto simp add:bset_lin[OF unifmp])
  4132     from linb pbmj have "?P (-(?I a b + j))" by (simp add: lin_neg_corr)
  4133     then show "\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (-(?I a b + j))"
  4134       using pbmj
  4135       by auto
  4136   next 
  4137     assume "\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (-(?I a b + j))"
  4138     then obtain "j" and "b" where 
  4139       pbmj: "j\<in> ?D \<and> b\<in> set (bset (mirror p)) \<and> ?P (-(?I a b + j))"
  4140       by blast
  4141     then have linb: "islinintterm b" 
  4142       by (auto simp add:bset_lin[OF unifmp])
  4143     from linb pbmj have "?P (?I a (lin_neg b) - j)"  
  4144       by (simp add: lin_neg_corr)
  4145     then show "\<exists> j\<in> ?D. \<exists> b \<in> set (bset (mirror p)). ?P (?I a (lin_neg b) - j)"
  4146       using pbmj by auto
  4147   qed
  4148   finally 
  4149   have bth: "(\<exists> j\<in> ?D. \<exists> b\<in> ?A. ?P (?I a b - j)) =
  4150     (\<exists>j\<in> ?D. \<exists> b\<in>set (bset (mirror p)). 
  4151     qinterp ((I_intterm (a # ats) b + j) # ats) (mirror p))"
  4152     by (simp add: mirror_interp[OF unifp] zadd_ac)
  4153   from bth dth th1
  4154   have "(\<exists> x. ?P x) = (\<exists> x. qinterp (x#ats) (mirror p))"
  4155     by (simp add: mirror_ex[OF unifp])
  4156   also have "\<dots> = ((\<exists>j\<in>{1..divlcm (mirror p)}. qinterp (j # ats) (minusinf (mirror p))) \<or>
  4157     (\<exists>j\<in>{1..divlcm (mirror p)}.
  4158     \<exists>b\<in>set (bset (mirror p)). qinterp ((I_intterm (a # ats) b + j) # ats) (mirror p)))"
  4159     (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)))")
  4160     by (rule cooper_mi_eq[OF unifmp])
  4161   also 
  4162   have "\<dots> = ((\<exists> j\<in> ?D. ?PP (-j)) \<or> (\<exists> j \<in> ?D. \<exists> b\<in> ?BM. ?MP (?I a b + j)))"
  4163     using bth th1 dth by simp
  4164   finally  show ?thesis using sym[OF bth] by simp
  4165 qed
  4166    
  4167 
  4168 (* substitution of a term into a Qfree formula, substitution of Bound 0 by i*)
  4169 
  4170 consts subst_it:: "intterm \<Rightarrow> intterm \<Rightarrow> intterm"
  4171 primrec
  4172 "subst_it i (Cst b) = Cst b"
  4173 "subst_it i (Var n) = (if n = 0 then i else Var n)"
  4174 "subst_it i (Neg it) = Neg (subst_it i it)"
  4175 "subst_it i (Add it1 it2) = Add (subst_it i it1) (subst_it i it2)" 
  4176 "subst_it i (Sub it1 it2) = Sub (subst_it i it1) (subst_it i it2)"
  4177 "subst_it i (Mult it1 it2) = Mult (subst_it i it1) (subst_it i it2)"
  4178 
  4179 
  4180 (* subst_it preserves semantics *)
  4181 lemma subst_it_corr: 
  4182 "I_intterm (a#ats) (subst_it i t) = I_intterm ((I_intterm (a#ats) i)#ats) t"
  4183 by (induct t rule: subst_it.induct, simp_all add: nth_pos2)
  4184 
  4185 consts subst_p:: "intterm \<Rightarrow> QF \<Rightarrow> QF"
  4186 primrec
  4187 "subst_p i (Le it1 it2) = Le (subst_it i it1) (subst_it i it2)"
  4188 "subst_p i (Lt it1 it2) = Lt (subst_it i it1) (subst_it i it2)"
  4189 "subst_p i (Ge it1 it2) = Ge (subst_it i it1) (subst_it i it2)"
  4190 "subst_p i (Gt it1 it2) = Gt (subst_it i it1) (subst_it i it2)"
  4191 "subst_p i (Eq it1 it2) = Eq (subst_it i it1) (subst_it i it2)"
  4192 "subst_p i (Divides d t) = Divides (subst_it i d) (subst_it i t)"
  4193 "subst_p i T = T"
  4194 "subst_p i F = F"
  4195 "subst_p i (And p q) = And (subst_p i p) (subst_p i q)"
  4196 "subst_p i (Or p q) = Or (subst_p i p) (subst_p i q)"
  4197 "subst_p i (Imp p q) = Imp (subst_p i p) (subst_p i q)"
  4198 "subst_p i (Equ p q) = Equ (subst_p i p) (subst_p i q)"
  4199 "subst_p i (NOT p) = (NOT (subst_p i p))"
  4200 
  4201 (* subs_p preserves correctness *)
  4202 lemma subst_p_corr: 
  4203   assumes qf: "isqfree p" 
  4204   shows "qinterp (a # ats) (subst_p i p) = qinterp ((I_intterm (a#ats) i)#ats) p "
  4205   using qf
  4206 by (induct p rule: subst_p.induct) (simp_all add: subst_it_corr)
  4207 
  4208 (* novar0 p is true if the fomula doese not depend on the quantified variable*)
  4209 consts novar0I:: "intterm \<Rightarrow> bool"
  4210 primrec
  4211 "novar0I (Cst i) = True"
  4212 "novar0I (Var n) = (n > 0)"
  4213 "novar0I (Neg a) = (novar0I a)"
  4214 "novar0I (Add a b) = (novar0I a \<and> novar0I b)"
  4215 "novar0I (Sub a b) = (novar0I a \<and> novar0I b)"
  4216 "novar0I (Mult a b) = (novar0I a \<and> novar0I b)"
  4217 
  4218 consts novar0:: "QF \<Rightarrow> bool"
  4219 recdef novar0 "measure size"
  4220 "novar0 (Lt a b) = (novar0I a \<and> novar0I b)"
  4221 "novar0 (Gt a b) = (novar0I a \<and> novar0I b)"
  4222 "novar0 (Le a b) = (novar0I a \<and> novar0I b)"
  4223 "novar0 (Ge a b) = (novar0I a \<and> novar0I b)"
  4224 "novar0 (Eq a b) = (novar0I a \<and> novar0I b)"
  4225 "novar0 (Divides a b) = (novar0I a \<and> novar0I b)"
  4226 "novar0 T = True" 
  4227 "novar0 F = True"
  4228 "novar0 (NOT p) = novar0 p" 
  4229 "novar0 (And p q) = (novar0 p \<and> novar0 q)"
  4230 "novar0 (Or p q)  = (novar0 p \<and> novar0 q)"
  4231 "novar0 (Imp p q) = (novar0 p \<and> novar0 q)"
  4232 "novar0 (Equ p q) = (novar0 p \<and> novar0 q)"
  4233 "novar0 p = False"
  4234 
  4235 (* Interpretation of terms, that doese not depend on Var 0 *)
  4236 lemma I_intterm_novar0:
  4237   assumes nov0: "novar0I x"
  4238   shows "I_intterm (a#ats) x = I_intterm (b#ats) x"
  4239 using nov0
  4240 by (induct x) (auto simp add: nth_pos2)
  4241 
  4242 (* substition is meaningless for term independent of Var 0*)
  4243 lemma subst_p_novar0_corr:
  4244 assumes qfp: "isqfree p"
  4245   and nov0: "novar0I i"
  4246   shows "qinterp (a#ats) (subst_p i p) = qinterp (I_intterm (b#ats) i#ats) p"
  4247 proof-
  4248   have "qinterp (a#ats) (subst_p i p) = qinterp (I_intterm (a#ats) i#ats) p"
  4249     by (rule subst_p_corr[OF qfp])
  4250   moreover have "I_intterm (a#ats) i#ats = I_intterm (b#ats) i#ats"
  4251     by (simp add: I_intterm_novar0[OF nov0, where a="a" and b="b"])
  4252   ultimately show ?thesis by simp
  4253 qed
  4254 
  4255 (* linearity and independence on Var 0*)
  4256 lemma lin_novar0: 
  4257   assumes linx: "islinintterm x"
  4258   and nov0: "novar0I x"
  4259   shows "\<exists> n > 0. islintn(n,x)"
  4260 using linx nov0
  4261 by (induct x rule: islinintterm.induct) auto
  4262 
  4263 lemma lintnpos_novar0:
  4264  assumes  npos: "n > 0"
  4265   and linx: "islintn(n,x)"
  4266   shows "novar0I x"
  4267 using npos linx
  4268 by (induct n x rule: islintn.induct) auto
  4269 
  4270 (* lin_add preserves independence on Var 0*)
  4271 lemma lin_add_novar0:
  4272   assumes nov0a: "novar0I a"
  4273   and nov0b : "novar0I b"
  4274   and lina : "islinintterm a"
  4275   and linb: "islinintterm b"
  4276   shows "novar0I (lin_add (a,b))"
  4277 proof-
  4278   have "\<exists> na > 0. islintn(na, a)" by (rule lin_novar0[OF lina nov0a]) 
  4279   then obtain "na" where na: "na > 0 \<and> islintn(na,a)" by blast
  4280   have "\<exists> nb > 0. islintn(nb, b)" by (rule lin_novar0[OF linb nov0b]) 
  4281   then obtain "nb" where nb: "nb > 0 \<and> islintn(nb,b)" by blast
  4282   from na have napos: "na > 0" by simp
  4283   from na have linna: "islintn(na,a)" by simp
  4284   from nb have nbpos: "nb > 0" by simp
  4285   from nb have linnb: "islintn(nb,b)" by simp
  4286   have "min na nb \<le> min na nb" by simp
  4287   then have "islintn (min na nb, lin_add(a,b))" by (simp add: lin_add_lint[OF linna linnb])
  4288   moreover have "min na nb > 0" using napos nbpos by (simp add: min_def)
  4289   ultimately show ?thesis by (simp only: lintnpos_novar0)
  4290 qed
  4291 
  4292 (* lin__mul preserves independence on Var 0*)
  4293 lemma lin_mul_novar0:
  4294   assumes linx: "islinintterm x"
  4295   and nov0: "novar0I x"
  4296   shows "novar0I (lin_mul(i,x))"
  4297   using linx nov0
  4298 proof (induct i x rule: lin_mul.induct, auto)
  4299   case (goal1 c c' n r)
  4300   from prems have lincnr: "islinintterm (Add (Mult (Cst c') (Var n)) r)" by simp
  4301   have "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4302   then show ?case using prems by simp
  4303 qed
  4304     
  4305 (* lin_neg preserves indepenednce on Var 0*)
  4306 lemma lin_neg_novar0:
  4307   assumes linx: "islinintterm x"
  4308   and nov0: "novar0I x"
  4309   shows "novar0I (lin_neg x)"
  4310 by (auto simp add: lin_mul_novar0 linx nov0 lin_neg_def)
  4311 
  4312 (* subterms of linear terms are independent on Var 0*)
  4313 lemma intterm_subt_novar0:
  4314   assumes lincnr: "islinintterm (Add (Mult (Cst c) (Var n)) r)"
  4315   shows "novar0I r"
  4316 proof-
  4317   have cnz: "c \<noteq> 0" by (rule islinintterm_cnz[OF lincnr])
  4318   have "islintn(0,Add (Mult (Cst c) (Var n)) r)" using lincnr
  4319     by (simp only: islinintterm_eq_islint islint_def)
  4320   then have "islintn (n+1,r)" by auto
  4321   moreover have "n+1 >0 " by arith
  4322   ultimately show ?thesis 
  4323     using lintnpos_novar0
  4324     by auto
  4325 qed
  4326 
  4327 (* decrease the De-Bruijn indices*)
  4328 consts decrvarsI:: "intterm \<Rightarrow> intterm"
  4329 primrec
  4330 "decrvarsI (Cst i) = (Cst i)"
  4331 "decrvarsI (Var n) = (Var (n - 1))"
  4332 "decrvarsI (Neg a) = (Neg (decrvarsI a))"
  4333 "decrvarsI (Add a b) = (Add (decrvarsI a) (decrvarsI b))"
  4334 "decrvarsI (Sub a b) = (Sub (decrvarsI a) (decrvarsI b))"
  4335 "decrvarsI (Mult a b) = (Mult (decrvarsI a) (decrvarsI b))"
  4336 
  4337 (* One can decrease the indics for terms and formulae independent on Var 0*)
  4338 lemma intterm_decrvarsI:
  4339   assumes nov0: "novar0I t"
  4340   shows "I_intterm (a#ats) t = I_intterm ats (decrvarsI t)"
  4341 using nov0
  4342 by (induct t) (auto simp add: nth_pos2)
  4343 
  4344 consts decrvars:: "QF \<Rightarrow> QF"
  4345 primrec
  4346 "decrvars (Lt a b) = (Lt (decrvarsI a) (decrvarsI b))"
  4347 "decrvars (Gt a b) = (Gt (decrvarsI a) (decrvarsI b))"
  4348 "decrvars (Le a b) = (Le (decrvarsI a) (decrvarsI b))"
  4349 "decrvars (Ge a b) = (Ge (decrvarsI a) (decrvarsI b))"
  4350 "decrvars (Eq a b) = (Eq (decrvarsI a) (decrvarsI b))"
  4351 "decrvars (Divides a b) = (Divides (decrvarsI a) (decrvarsI b))"
  4352 "decrvars T = T" 
  4353 "decrvars F = F"
  4354 "decrvars (NOT p) = (NOT (decrvars p))" 
  4355 "decrvars (And p q) = (And (decrvars p) (decrvars q))"
  4356 "decrvars (Or p q)  = (Or (decrvars p) (decrvars q))"
  4357 "decrvars (Imp p q) = (Imp (decrvars p) (decrvars q))"
  4358 "decrvars (Equ p q) = (Equ (decrvars p) (decrvars q))"
  4359 
  4360 (* decrvars preserves quantifier freeness*)
  4361 lemma decrvars_qfree: "isqfree p \<Longrightarrow> isqfree (decrvars p)"
  4362 by (induct p rule: isqfree.induct, auto)
  4363 
  4364 lemma novar0_qfree: "novar0 p \<Longrightarrow> isqfree p"
  4365 by (induct p) auto
  4366 
  4367 lemma qinterp_novar0:
  4368   assumes nov0: "novar0 p"
  4369   shows "qinterp (a#ats) p = qinterp ats (decrvars p)"
  4370 using nov0
  4371 by(induct p) (simp_all add: intterm_decrvarsI)
  4372 
  4373 (* All elements of bset p doese not depend on Var 0*)
  4374 lemma bset_novar0:
  4375   assumes unifp: "isunified p"
  4376   shows "\<forall> b\<in> set (bset p). novar0I b "
  4377   using unifp
  4378 proof(induct p rule: bset.induct)
  4379   case (1 c r z) 
  4380   from prems have zz: "z = Cst 0" by (cases "z", auto) 
  4381     from prems zz have lincnr: "islinintterm(Add (Mult (Cst c) (Var 0)) r)" by simp
  4382     have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4383     have novar0r: "novar0I r" by (rule intterm_subt_novar0[OF lincnr])
  4384     from prems zz have "c = 1 \<or> c = -1" by auto
  4385     moreover 
  4386     {
  4387       assume c1: "c=1"
  4388       have lin1: "islinintterm (Cst 1)" by simp
  4389       have novar01: "novar0I (Cst 1)" by simp
  4390       then have ?case 
  4391 	using prems zz novar0r lin1 novar01
  4392 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4393     }
  4394     moreover 
  4395     {
  4396       assume c1: "c= -1"
  4397       have lin1: "islinintterm (Cst -1)" by simp
  4398       have novar01: "novar0I (Cst -1)" by simp
  4399       then have ?case 
  4400 	using prems zz novar0r lin1 novar01
  4401 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4402     }
  4403     ultimately show ?case by blast
  4404 next 
  4405   case (2 c r z) 
  4406   from prems have zz: "z = Cst 0" by (cases "z", auto) 
  4407     from prems zz have lincnr: "islinintterm(Add (Mult (Cst c) (Var 0)) r)" by simp
  4408     have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4409     have novar0r: "novar0I r" by (rule intterm_subt_novar0[OF lincnr])
  4410     from prems zz have "c = 1 \<or> c = -1" by auto
  4411     moreover 
  4412     {
  4413       assume c1: "c=1"
  4414       have lin1: "islinintterm (Cst 1)" by simp
  4415       have novar01: "novar0I (Cst 1)" by simp
  4416       then have ?case 
  4417 	using prems zz novar0r lin1 novar01
  4418 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4419     }
  4420     moreover 
  4421     {
  4422       assume c1: "c= -1"
  4423       have lin1: "islinintterm (Cst -1)" by simp
  4424       have novar01: "novar0I (Cst -1)" by simp
  4425       then have ?case 
  4426 	using prems zz novar0r lin1 novar01
  4427 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4428     }
  4429     ultimately show ?case by blast
  4430 next 
  4431   case (3 c r z) 
  4432   from prems have zz: "z = Cst 0" by (cases "z", auto) 
  4433     from prems zz have lincnr: "islinintterm(Add (Mult (Cst c) (Var 0)) r)" by simp
  4434     have linr: "islinintterm r" by (rule islinintterm_subt[OF lincnr])
  4435     have novar0r: "novar0I r" by (rule intterm_subt_novar0[OF lincnr])
  4436     from prems zz have "c = 1 \<or> c = -1" by auto
  4437     moreover 
  4438     {
  4439       assume c1: "c=1"
  4440       have lin1: "islinintterm (Cst 1)" by simp
  4441       have novar01: "novar0I (Cst 1)" by simp
  4442       then have ?case 
  4443 	using prems zz novar0r lin1 novar01
  4444 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4445     }
  4446     moreover 
  4447     {
  4448       assume c1: "c= -1"
  4449       have lin1: "islinintterm (Cst -1)" by simp
  4450       have novar01: "novar0I (Cst -1)" by simp
  4451       then have ?case 
  4452 	using prems zz novar0r lin1 novar01
  4453 	by (auto simp add: lin_add_novar0 lin_neg_novar0 linr lin_neg_lin)
  4454     }
  4455     ultimately show ?case by blast
  4456 qed auto
  4457 
  4458 (* substitution preserves independence on Var 0*)
  4459 lemma subst_it_novar0:
  4460   assumes nov0x: "novar0I x"
  4461   shows "novar0I (subst_it x t)"
  4462   using nov0x
  4463   by (induct t) auto
  4464 
  4465 lemma subst_p_novar0:
  4466   assumes nov0x:"novar0I x"
  4467   and qfp: "isqfree p"
  4468   shows "novar0 (subst_p x p)"
  4469   using nov0x qfp
  4470   by (induct p rule: novar0.induct) (simp_all add: subst_it_novar0)
  4471 
  4472 (* linearize preserves independence on Var 0 *)
  4473 lemma linearize_novar0: 
  4474   assumes nov0t: "novar0I t "
  4475   shows "\<And> t'. linearize t = Some t' \<Longrightarrow> novar0I t'"
  4476 using nov0t
  4477 proof(induct t rule: novar0I.induct)
  4478   case (Neg a)
  4479   let ?la = "linearize a"
  4480   from prems have "\<exists> a'. ?la = Some a'" by (cases ?la, auto)
  4481   then obtain "a'" where "?la = Some a'" by blast
  4482   with prems have nv0a':"novar0I a'" by simp
  4483   have "islinintterm a'" using prems by (simp add: linearize_linear)
  4484   with nv0a' have "novar0I (lin_neg a')" 
  4485     by (simp add: lin_neg_novar0)
  4486   then 
  4487   show ?case using prems by simp 
  4488 next 
  4489   case (Add a b) 
  4490   let ?la = "linearize a"
  4491   let ?lb = "linearize b"
  4492   from prems have linab: "linearize (Add a b) = Some t'" by simp
  4493   then have "\<exists> a'. ?la = Some a'" by (cases ?la) auto
  4494   then obtain "a'" where "?la = Some a'" by blast
  4495   with prems have nv0a':"novar0I a'" by simp
  4496   have lina': "islinintterm a'" using prems by (simp add: linearize_linear)
  4497   from linab have "\<exists> b'. ?lb = Some b'"
  4498     by (cases ?la, auto simp add: measure_def inv_image_def) (cases ?lb, auto)
  4499   then obtain "b'" where "?lb = Some b'" by blast
  4500   with prems have nv0b':"novar0I b'" by simp
  4501   have linb': "islinintterm b'" using prems by (simp add: linearize_linear)
  4502   then show ?case using prems lina' linb' nv0a' nv0b'
  4503     by (auto simp add: measure_def inv_image_def lin_add_novar0)
  4504 next 
  4505   case (Sub a b)
  4506     let ?la = "linearize a"
  4507   let ?lb = "linearize b"
  4508   from prems have linab: "linearize (Sub a b) = Some t'" by simp
  4509   then have "\<exists> a'. ?la = Some a'" by (cases ?la) auto
  4510   then obtain "a'" where "?la = Some a'" by blast
  4511   with prems have nv0a':"novar0I a'" by simp
  4512   have lina': "islinintterm a'" using prems by (simp add: linearize_linear)
  4513   from linab have "\<exists> b'. ?lb = Some b'"
  4514     by (cases ?la, auto simp add: measure_def inv_image_def) (cases ?lb, auto)
  4515   then obtain "b'" where "?lb = Some b'" by blast
  4516   with prems have nv0b':"novar0I b'" by simp
  4517   have linb': "islinintterm b'" using prems by (simp add: linearize_linear)
  4518   then show ?case using prems lina' linb' nv0a' nv0b'
  4519     by (auto simp add: 
  4520       measure_def inv_image_def lin_add_novar0 lin_neg_novar0 lin_neg_lin)
  4521 next 
  4522   case (Mult a b)     
  4523   let ?la = "linearize a"
  4524   let ?lb = "linearize b"
  4525   from prems have linab: "linearize (Mult a b) = Some t'" by simp
  4526   then have "\<exists> a'. ?la = Some a'"
  4527     by (cases ?la, auto simp add: measure_def inv_image_def)
  4528   then obtain "a'" where "?la = Some a'" by blast
  4529   with prems have nv0a':"novar0I a'" by simp
  4530   have lina': "islinintterm a'" using prems by (simp add: linearize_linear)
  4531   from prems linab have "\<exists> b'. ?lb = Some b'"
  4532     apply (cases ?la, auto simp add: measure_def inv_image_def) 
  4533     by (cases "a'",auto simp add: measure_def inv_image_def) (cases ?lb, auto)+
  4534   then obtain "b'" where "?lb = Some b'" by blast
  4535   with prems have nv0b':"novar0I b'" by simp
  4536   have linb': "islinintterm b'" using prems by (simp add: linearize_linear)
  4537   then show ?case using prems lina' linb' nv0a' nv0b' 
  4538     by (cases "a'",auto simp add: measure_def inv_image_def lin_mul_novar0)
  4539   (cases "b'",auto simp add: measure_def inv_image_def lin_mul_novar0)
  4540 qed auto
  4541 
  4542 
  4543 (* simplification of formulae *)
  4544 consts psimpl :: "QF \<Rightarrow> QF"
  4545 recdef psimpl "measure size"
  4546 "psimpl (Le l r) = 
  4547   (case (linearize (Sub l r)) of
  4548    None \<Rightarrow> Le l r
  4549  | Some x \<Rightarrow> (case x of 
  4550        Cst i \<Rightarrow> (if i \<le> 0 then T else F)
  4551      | _ \<Rightarrow> (Le x (Cst 0))))"
  4552 "psimpl (Eq l r) = 
  4553   (case (linearize (Sub l r)) of
  4554    None \<Rightarrow> Eq l r
  4555  | Some x \<Rightarrow> (case x of 
  4556        Cst i \<Rightarrow> (if i = 0 then T else F)
  4557      | _ \<Rightarrow> (Eq x (Cst 0))))"
  4558 
  4559 "psimpl (Divides (Cst d) t) = 
  4560   (case (linearize t) of
  4561   None \<Rightarrow> (Divides (Cst d) t)
  4562   | Some c \<Rightarrow> (case c of
  4563      Cst i \<Rightarrow> (if d dvd i then T else F)
  4564    | _ \<Rightarrow>  (Divides (Cst d) c)))"
  4565 
  4566 "psimpl (And p q) = 
  4567   (let p'= psimpl p
  4568   in (case p' of 
  4569        F \<Rightarrow> F
  4570       |T \<Rightarrow> psimpl q
  4571       | _ \<Rightarrow> let q' = psimpl q
  4572              in (case q' of
  4573                      F \<Rightarrow> F
  4574                    | T \<Rightarrow> p'
  4575                    | _ \<Rightarrow> (And p' q'))))"
  4576 
  4577 "psimpl (Or p q) = 
  4578   (let p'= psimpl p
  4579   in (case p' of 
  4580         T \<Rightarrow> T
  4581       | F \<Rightarrow> psimpl q
  4582       | _ \<Rightarrow> let q' = psimpl q
  4583              in (case q' of
  4584                      T \<Rightarrow> T
  4585                    | F \<Rightarrow> p'
  4586                    | _ \<Rightarrow> (Or p' q'))))"
  4587 
  4588 "psimpl (Imp p q) = 
  4589   (let p'= psimpl p
  4590   in (case p' of 
  4591        F \<Rightarrow> T
  4592       |T \<Rightarrow> psimpl q
  4593       | NOT p1 \<Rightarrow> let q' = psimpl q
  4594              in (case q' of
  4595                      F \<Rightarrow> p1
  4596                    | T \<Rightarrow> T
  4597                    | _ \<Rightarrow> (Or p1 q'))
  4598       | _ \<Rightarrow> let q' = psimpl q
  4599              in (case q' of
  4600                      F \<Rightarrow> NOT p'
  4601                    | T \<Rightarrow> T
  4602                    | _ \<Rightarrow> (Imp p' q'))))"
  4603 
  4604 "psimpl (Equ p q) = 
  4605   (let p'= psimpl p ; q' = psimpl q
  4606   in (case p' of 
  4607         T \<Rightarrow> q'
  4608       | F \<Rightarrow> (case q' of
  4609                   T \<Rightarrow> F
  4610                 | F \<Rightarrow> T
  4611                 | NOT q1 \<Rightarrow> q1
  4612                 | _ \<Rightarrow> NOT q')
  4613       | NOT p1 \<Rightarrow>  (case q' of
  4614                   T \<Rightarrow> p'
  4615                 | F \<Rightarrow> p1
  4616                 | NOT q1 \<Rightarrow> (Equ p1 q1)
  4617                 | _ \<Rightarrow> (Equ p' q'))
  4618       | _ \<Rightarrow> (case q' of
  4619                   T \<Rightarrow> p'
  4620                 | F \<Rightarrow> NOT p'
  4621                 | _ \<Rightarrow> (Equ p' q'))))"
  4622 
  4623 "psimpl (NOT p) = 
  4624   (let p' = psimpl p
  4625   in ( case p' of 
  4626        F \<Rightarrow> T
  4627      | T \<Rightarrow> F
  4628      | NOT p1 \<Rightarrow> p1 
  4629      | _ \<Rightarrow> (NOT p')))"
  4630 "psimpl p = p"
  4631 
  4632 (* psimpl preserves semantics *)
  4633 lemma psimpl_corr: "qinterp ats p = qinterp ats (psimpl p)"
  4634 proof(induct p rule: psimpl.induct)
  4635   case (1 l r)
  4636   have "(\<exists> lx. linearize (Sub l r) = Some lx) \<or> (linearize (Sub l r) = None)" by auto
  4637   moreover
  4638   {
  4639     assume lin: "\<exists> lx. linearize (Sub l r) = Some lx"
  4640     from lin obtain "lx" where lx: "linearize (Sub l r) = Some lx" by blast
  4641     from lx have "I_intterm ats (Sub l r) = I_intterm ats lx"
  4642       by (rule linearize_corr[where t="Sub l r" and t'= "lx"])
  4643     then have feq: "qinterp ats (Le l r) = qinterp ats (Le lx (Cst 0))" by (simp , arith)
  4644     from lx have lxlin: "islinintterm lx" by (rule linearize_linear)
  4645     from lxlin feq have ?case 
  4646       proof-
  4647 	have "(\<exists> i. lx = Cst i) \<or> (\<not> (\<exists> i. lx = Cst i))" by blast
  4648 	moreover
  4649 	{
  4650 	  assume lxcst: "\<exists> i. lx = Cst i"
  4651 	  from lxcst obtain "i" where lxi: "lx = Cst i" by blast
  4652 	  with feq have "qinterp ats (Le l r) = (i \<le> 0)" by simp
  4653 	  then have ?case using prems by (simp add: measure_def inv_image_def)
  4654 	}
  4655 	moreover 
  4656 	{
  4657 	  assume "(\<not> (\<exists> i. lx = Cst i))"
  4658 	  then have "(case lx of 
  4659 	    Cst i \<Rightarrow> (if i \<le> 0 then T else F)
  4660 	    | _ \<Rightarrow> (Le lx (Cst 0))) = (Le lx (Cst 0))" 
  4661 	    by (case_tac "lx::intterm", auto)
  4662 	  with prems lxlin feq have ?case by (auto simp add: measure_def inv_image_def)
  4663 	}
  4664 	ultimately show ?thesis  by blast
  4665       qed
  4666   }
  4667   moreover
  4668   {
  4669     assume "linearize (Sub l r) = None"
  4670     then have ?case using prems by simp
  4671   }
  4672   ultimately show ?case by blast
  4673   
  4674 next 
  4675   case (2 l r)
  4676   have "(\<exists> lx. linearize (Sub l r) = Some lx) \<or> (linearize (Sub l r) = None)" by auto
  4677   moreover
  4678   {
  4679     assume lin: "\<exists> lx. linearize (Sub l r) = Some lx"
  4680     from lin obtain "lx" where lx: "linearize (Sub l r) = Some lx" by blast
  4681     from lx have "I_intterm ats (Sub l r) = I_intterm ats lx"
  4682       by (rule linearize_corr[where t="Sub l r" and t'= "lx"])
  4683     then have feq: "qinterp ats (Eq l r) = qinterp ats (Eq lx (Cst 0))" by (simp , arith)
  4684     from lx have lxlin: "islinintterm lx" by (rule linearize_linear)
  4685     from lxlin feq have ?case 
  4686       proof-
  4687 	have "(\<exists> i. lx = Cst i) \<or> (\<not> (\<exists> i. lx = Cst i))" by blast
  4688 	moreover
  4689 	{
  4690 	  assume lxcst: "\<exists> i. lx = Cst i"
  4691 	  from lxcst obtain "i" where lxi: "lx = Cst i" by blast
  4692 	  with feq have "qinterp ats (Eq l r) = (i = 0)" by simp
  4693 	  then have ?case using prems by (simp add: measure_def inv_image_def)
  4694 	}
  4695 	moreover 
  4696 	{
  4697 	  assume "(\<not> (\<exists> i. lx = Cst i))"
  4698 	  then have "(case lx of 
  4699 	    Cst i \<Rightarrow> (if i = 0 then T else F)
  4700 	    | _ \<Rightarrow> (Eq lx (Cst 0))) = (Eq lx (Cst 0))" 
  4701 	    by (case_tac "lx::intterm", auto)
  4702 	  with prems lxlin feq have ?case by (auto simp add: measure_def inv_image_def)
  4703 	}
  4704 	ultimately show ?thesis  by blast
  4705       qed
  4706   }
  4707   moreover
  4708   {
  4709     assume "linearize (Sub l r) = None"
  4710     then have ?case using prems by simp
  4711   }
  4712   ultimately show ?case by blast
  4713   
  4714 next 
  4715     
  4716   case (3 d t)  
  4717   have "(\<exists> lt. linearize t = Some lt) \<or> (linearize t = None)" by auto
  4718   moreover
  4719   {
  4720     assume lin: "\<exists> lt. linearize t  = Some lt"
  4721     from lin obtain "lt" where lt: "linearize t = Some lt" by blast
  4722     from lt have "I_intterm ats t = I_intterm ats lt"
  4723       by (rule linearize_corr[where t="t" and t'= "lt"])
  4724     then have feq: "qinterp ats (Divides (Cst d) t) = qinterp ats (Divides (Cst d) lt)" by (simp)
  4725     from lt have ltlin: "islinintterm lt" by (rule linearize_linear)
  4726     from ltlin feq have ?case using prems  apply simp by (case_tac "lt::intterm", simp_all)
  4727   }
  4728   moreover
  4729   {
  4730     assume "linearize t = None"
  4731     then have ?case using prems by simp
  4732   }
  4733   ultimately show ?case by blast
  4734   
  4735 next 
  4736   case (4 f g)
  4737 
  4738     let ?sf = "psimpl f"
  4739   let ?sg = "psimpl g"
  4740   show ?case using prems 
  4741     by (cases ?sf, simp_all add: Let_def measure_def inv_image_def) 
  4742   (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 measure_def inv_image_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 measure_def inv_image_def)
  4769     apply(cases ?sf,simp_all)
  4770     apply (simp_all add: Let_def measure_def inv_image_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 
  4824       using prems by (simp add: measure_def inv_image_def)
  4825   }
  4826   moreover {
  4827     assume "\<exists> x. ?ls = Some x"
  4828     then obtain "x" where ls_d: "?ls = Some x" by blast
  4829     from prems have "novar0I l" by simp
  4830     moreover from prems have "novar0I r" by simp
  4831     ultimately have nv0s: "novar0I (Sub l r)" by simp
  4832     from prems have "novar0I x" 
  4833       by (simp add: linearize_novar0[OF nv0s, where t'="x"])
  4834     then have ?case
  4835       using prems
  4836       by (cases "x") (auto simp add: measure_def inv_image_def)
  4837   }
  4838   ultimately show ?case by blast
  4839 next
  4840   case (2 l r)
  4841   let ?ls = "linearize (Sub l r)"
  4842   have "?ls = None \<or> (\<exists> x. ?ls = Some x)" by auto
  4843   moreover
  4844   {
  4845     assume "?ls = None" then have ?case 
  4846       using prems by (simp add: measure_def inv_image_def)
  4847   }
  4848   moreover {
  4849     assume "\<exists> x. ?ls = Some x"
  4850     then obtain "x" where ls_d: "?ls = Some x" by blast
  4851     from prems have "novar0I l" by simp
  4852     moreover from prems have "novar0I r" by simp
  4853     ultimately have nv0s: "novar0I (Sub l r)" by simp
  4854     from prems have "novar0I x" 
  4855       by (simp add: linearize_novar0[OF nv0s, where t'="x"])
  4856     then have ?case
  4857       using prems
  4858       by (cases "x") (auto simp add: measure_def inv_image_def)
  4859   }
  4860   ultimately show ?case by blast
  4861 next
  4862   case (3 d t)
  4863   let ?lt = "linearize t"
  4864   have "?lt = None \<or> (\<exists> x. ?lt = Some x)"  by auto
  4865   moreover 
  4866   { assume "?lt = None" then have ?case using prems by simp }
  4867   moreover {
  4868     assume "\<exists>x. ?lt = Some x"
  4869     then obtain "x" where x_d: "?lt = Some x" by blast
  4870     from prems have nv0t: "novar0I t" by simp
  4871     with x_d have "novar0I x" 
  4872       by (simp add: linearize_novar0[OF nv0t])
  4873     with prems have ?case 
  4874       by (cases "x") simp_all
  4875   }
  4876   ultimately show ?case by blast
  4877 next
  4878   case (4 f g)
  4879   let ?sf = "psimpl f"
  4880   let ?sg = "psimpl g"
  4881   show ?case 
  4882     using prems 
  4883     by (cases ?sf, simp_all add: Let_def measure_def inv_image_def)
  4884   (cases ?sg,simp_all)+
  4885 next
  4886   case (5 f g)
  4887   let ?sf = "psimpl f"
  4888   let ?sg = "psimpl g"
  4889   show ?case 
  4890     using prems 
  4891     by (cases ?sf, simp_all add: Let_def measure_def inv_image_def)
  4892   (cases ?sg,simp_all)+
  4893 next
  4894   case (6 f g)
  4895   let ?sf = "psimpl f"
  4896   let ?sg = "psimpl g"
  4897   show ?case 
  4898     using prems 
  4899     by (cases ?sf, simp_all add: Let_def measure_def inv_image_def)
  4900   (cases ?sg,simp_all)+
  4901 next
  4902   case (7 f g)
  4903   let ?sf = "psimpl f"
  4904   let ?sg = "psimpl g"
  4905   show ?case 
  4906     using prems 
  4907     by (cases ?sf, simp_all add: Let_def measure_def inv_image_def)
  4908   (cases ?sg,simp_all)+
  4909 
  4910 next
  4911   case (8 f)
  4912   let ?sf = "psimpl f"
  4913   from prems have nv0sf:"novar0 ?sf" by simp
  4914   show ?case using prems nv0sf 
  4915     by (cases ?sf, auto simp add: Let_def measure_def inv_image_def)
  4916 qed simp_all
  4917 
  4918 (* implements a disj of p applied to all elements of the list*)
  4919 consts explode_disj :: "(intterm list \<times> QF) \<Rightarrow> QF"
  4920 recdef explode_disj "measure (\<lambda>(is,p). length is)"
  4921 "explode_disj ([],p) = F"
  4922 "explode_disj (i#is,p) = 
  4923   (let pi = psimpl (subst_p i p)
  4924    in ( case pi of
  4925         T \<Rightarrow> T 
  4926        | F \<Rightarrow> explode_disj (is,p)
  4927        | _ \<Rightarrow> (let r = explode_disj (is,p)
  4928                in (case r of
  4929                       T \<Rightarrow> T
  4930                     | F \<Rightarrow> pi
  4931                     | _ \<Rightarrow> Or pi r))))"
  4932 
  4933 (* correctness theorem for one iteration of explode_disj *)
  4934 lemma explode_disj_disj: 
  4935   assumes qfp: "isqfree p"
  4936   shows "(qinterp (x#xs) (explode_disj(i#is,p))) = 
  4937   (qinterp (x#xs) (subst_p i p) \<or> (qinterp (x#xs) (explode_disj(is,p))))"
  4938   using qfp
  4939 proof-
  4940   let ?pi = "psimpl (subst_p i p)"
  4941   have pi: "qinterp (x#xs) ?pi = qinterp (x#xs) (subst_p i p)"
  4942     by (simp add: psimpl_corr[where p="(subst_p i p)"])
  4943   let ?dp = "explode_disj(is,p)"
  4944   show ?thesis using pi
  4945   proof (cases)
  4946     assume "?pi= T \<or> ?pi = F"
  4947     then show ?thesis using pi by (case_tac "?pi::QF", auto)
  4948     
  4949   next
  4950     assume notTF: "\<not> (?pi = T \<or> ?pi = F)" 
  4951     let ?dp = "explode_disj(is,p)"
  4952     have dp_cases: "explode_disj(i#is,p) = 
  4953       (case (explode_disj(is,p)) of
  4954       T \<Rightarrow> T
  4955       | F \<Rightarrow> psimpl (subst_p i p)
  4956       | _ \<Rightarrow> Or (psimpl (subst_p i p)) (explode_disj(is,p)))" using notTF
  4957       by (cases "?pi")
  4958     (simp_all add: Let_def cong del: QF.weak_case_cong)
  4959     show ?thesis using pi dp_cases notTF
  4960     proof(cases)
  4961       assume "?dp = T \<or> ?dp = F"
  4962       then show ?thesis 
  4963 	using pi dp_cases
  4964 	by (cases "?dp") auto
  4965     next
  4966       assume "\<not> (?dp = T \<or> ?dp = F)"
  4967       then show ?thesis using pi dp_cases notTF
  4968 	by (cases ?dp) auto 
  4969     qed
  4970   qed
  4971 qed
  4972 
  4973 (* correctness theorem for explode_disj *)
  4974 lemma explode_disj_corr: 
  4975   assumes qfp: "isqfree p"
  4976   shows "(\<exists> x \<in> set xs. qinterp (a#ats) (subst_p x p)) = 
  4977   (qinterp (a#ats) (explode_disj(xs,p)))" (is "(\<exists> x \<in> set xs. ?P x) = (?DP a xs )")
  4978   using qfp
  4979   proof (induct xs)
  4980     case Nil show ?case by simp
  4981   next 
  4982     case (Cons y ys)
  4983     have "(\<exists> x \<in> set (y#ys). ?P x) = (?P y \<or> (\<exists> x\<in> set ys. ?P x))"
  4984       by auto
  4985     also have "\<dots> = (?P y \<or> ?DP a ys)" using "Cons.hyps" qfp by auto 
  4986     also have "\<dots> = ?DP a (y#ys)" using explode_disj_disj[OF qfp] by auto
  4987     finally show ?case by simp
  4988 qed
  4989 
  4990 (* explode_disj preserves independence on Var 0*)
  4991 lemma explode_disj_novar0:
  4992   assumes nov0xs: "\<forall>x \<in> set xs. novar0I x"
  4993   and qfp: "isqfree p"
  4994   shows "novar0 (explode_disj (xs,p))"
  4995   using nov0xs qfp
  4996 proof (induct xs, auto simp add: Let_def)
  4997   case (goal1 a as)
  4998   let ?q = "subst_p a p"
  4999   let ?qs = "psimpl ?q"
  5000   have "?qs = T \<or> ?qs = F \<or> (?qs \<noteq> T \<or> ?qs \<noteq> F)" by simp
  5001   moreover
  5002   { assume "?qs = T"  then have ?case  by simp }
  5003   moreover
  5004   { assume "?qs = F"  then have ?case by simp }
  5005   moreover
  5006   {
  5007     assume qsnTF: "?qs \<noteq> T \<and> ?qs \<noteq> F"
  5008     let ?r = "explode_disj (as,p)"
  5009     have nov0qs: "novar0 ?qs"
  5010       using prems
  5011       by (auto simp add: psimpl_novar0 subst_p_novar0)
  5012     have "?r = T \<or> ?r = F \<or> (?r \<noteq> T \<or> ?r \<noteq> F)" by simp
  5013     moreover
  5014     { assume "?r = T" then have ?case by (cases ?qs) auto  }
  5015     moreover
  5016     { assume "?r = F"  then have ?case  using nov0qs by (cases ?qs, auto)  }
  5017     moreover
  5018     { assume "?r \<noteq> T \<and> ?r \<noteq> F"  then have ?case using nov0qs prems qsnTF
  5019 	by (cases ?qs, auto simp add: Let_def) (cases ?r,auto)+
  5020     }
  5021     ultimately have ?case by blast
  5022   }
  5023   ultimately show ?case by blast
  5024 qed  
  5025   
  5026 (* Some simple lemmas used for technical reasons *)
  5027 lemma eval_Or_cases: 
  5028   "qinterp (a#ats) (case f of 
  5029        T \<Rightarrow> T
  5030        | F \<Rightarrow> g
  5031        | _ \<Rightarrow> (case g of 
  5032                      T \<Rightarrow> T
  5033                    | F \<Rightarrow> f
  5034                    | _ \<Rightarrow> Or f g)) = (qinterp (a#ats) f \<or> qinterp (a#ats) g)"
  5035 proof-
  5036   let ?result = "
  5037     (case f of 
  5038     T \<Rightarrow> T
  5039     | F \<Rightarrow> g
  5040     | _ \<Rightarrow> (case g of 
  5041     T \<Rightarrow> T
  5042     | F \<Rightarrow> f
  5043     | _ \<Rightarrow> Or f g))"
  5044   have "f = T \<or> f = F \<or> (f \<noteq> T \<and> f\<noteq> F)" by auto
  5045   moreover 
  5046   {
  5047     assume fT: "f = T"
  5048     then have ?thesis by auto
  5049   }
  5050   moreover 
  5051   {
  5052     assume "f=F"
  5053     then have ?thesis by auto
  5054   }
  5055   moreover 
  5056   {
  5057     assume fnT: "f\<noteq>T"
  5058       and fnF: "f\<noteq>F"
  5059     have "g = T \<or> g = F \<or> (g \<noteq> T \<and> g\<noteq> F)" by auto
  5060     moreover 
  5061     {
  5062       assume "g=T"
  5063       then have ?thesis using fnT fnF by (cases f, auto)
  5064     }
  5065     moreover 
  5066     {
  5067       assume "g=F"
  5068       then have ?thesis using fnT fnF by (cases f, auto)
  5069     }
  5070     moreover 
  5071     {
  5072       assume gnT: "g\<noteq>T"
  5073 	and gnF: "g\<noteq>F"
  5074       then have "?result = (case g of 
  5075         T \<Rightarrow> T
  5076         | F \<Rightarrow> f
  5077         | _ \<Rightarrow> Or f g)"
  5078 	using fnT fnF
  5079 	by (cases f, auto)
  5080       also have "\<dots> = Or f g"
  5081 	using gnT gnF
  5082 	by (cases g, auto)
  5083       finally have "?result = Or f g" by simp
  5084       then
  5085       have  ?thesis by simp
  5086     }
  5087     ultimately have ?thesis by blast
  5088 	   
  5089   }
  5090   
  5091   ultimately show ?thesis by blast
  5092 qed
  5093 
  5094 lemma or_case_novar0:
  5095   assumes fnTF: "f \<noteq> T \<and> f \<noteq> F"
  5096   and gnTF: "g \<noteq> T \<and> g \<noteq> F"
  5097   and f0: "novar0 f"
  5098   and g0: "novar0 g"
  5099   shows "novar0 
  5100      (case f of T \<Rightarrow> T | F \<Rightarrow> g
  5101      | _ \<Rightarrow> (case g of T \<Rightarrow> T | F \<Rightarrow> f | _ \<Rightarrow> Or f g))"
  5102 using fnTF gnTF f0 g0
  5103 by (cases f, auto) (cases g, auto)+
  5104 
  5105 
  5106 (* An implementation of sets trough lists *)
  5107 constdefs list_insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list"
  5108   "list_insert x xs \<equiv> (if x mem xs then xs else x#xs)"
  5109 
  5110 lemma list_insert_set: "set (list_insert x xs) = set (x#xs)"
  5111 by(induct xs) (auto simp add: list_insert_def)
  5112 
  5113 consts list_union :: "('a list \<times> 'a list) \<Rightarrow> 'a list"
  5114 
  5115 recdef list_union "measure (\<lambda>(xs,ys). length xs)"
  5116 "list_union ([], ys) = ys"
  5117 "list_union (xs, []) = xs"
  5118 "list_union (x#xs,ys) = list_insert x (list_union (xs,ys))"
  5119 
  5120 lemma list_union_set: "set (list_union(xs,ys)) = set (xs@ys)"
  5121   by(induct xs ys rule: list_union.induct, auto simp add:list_insert_set)
  5122 
  5123 
  5124 consts list_set ::"'a list \<Rightarrow> 'a list"
  5125 primrec 
  5126   "list_set [] = []"
  5127   "list_set (x#xs) = list_insert x (list_set xs)"
  5128 
  5129 lemma list_set_set: "set xs = set (list_set xs)"
  5130 by (induct xs) (auto simp add: list_insert_set)
  5131 
  5132 consts iupto :: "int \<times> int \<Rightarrow> int list"
  5133 recdef iupto "measure (\<lambda> (i,j). nat (j - i +1))"
  5134 "iupto(i,j) = (if j<i then [] else (i#(iupto(i+1,j))))"
  5135 
  5136 (* correctness theorem for iupto *)
  5137 lemma iupto_set: "set (iupto(i,j)) = {i .. j}"
  5138 proof(induct rule: iupto.induct)
  5139   case (1 a b)
  5140   show ?case
  5141     using prems by (simp add: simp_from_to)
  5142 qed
  5143 
  5144 consts all_sums :: "int \<times> intterm list \<Rightarrow> intterm list"
  5145 recdef all_sums "measure (\<lambda>(i,is). length is)"
  5146 "all_sums (j,[]) = []"
  5147 "all_sums (j,i#is) = (map (\<lambda>x. lin_add (i,(Cst x))) (iupto(1,j))@(all_sums (j,is)))"
  5148 (* all_sums preserves independence on Var 0*)
  5149 lemma all_sums_novar0:
  5150   assumes nov0xs: "\<forall> x\<in> set xs. novar0I x"
  5151   and linxs: "\<forall> x\<in> set xs. islinintterm x "
  5152   shows "\<forall> x\<in> set (all_sums (d,xs)). novar0I x"
  5153   using nov0xs linxs
  5154 proof(induct d xs rule: all_sums.induct)
  5155   case 1 show ?case by simp
  5156 next 
  5157   case (2 j a as)
  5158   have lina: "islinintterm a" using "2.prems" by auto
  5159   have nov0a: "novar0I a" using "2.prems" by auto
  5160   let ?ys = "map (\<lambda>x. lin_add (a,(Cst x))) (iupto(1,j))"
  5161   have nov0ys: "\<forall> y\<in> set ?ys. novar0I y"
  5162   proof-
  5163     have linx: "\<forall> x \<in> set (iupto(1,j)). islinintterm (Cst x)" by simp
  5164     have nov0x: "\<forall> x \<in> set (iupto(1,j)). novar0I (Cst x)" by simp
  5165     with nov0a lina linx have "\<forall> x\<in> set (iupto(1,j)). novar0I (lin_add (a,Cst x))" 
  5166       by (simp add: lin_add_novar0)
  5167     then show ?thesis by auto
  5168   qed
  5169   from "2.prems"
  5170   have linas: "\<forall>u\<in>set as. islinintterm u" by auto
  5171   from "2.prems" have nov0as: "\<forall>u\<in>set as. novar0I u" by auto
  5172   from "2.hyps" linas nov0as have nov0alls: "\<forall>u\<in>set (all_sums (j, as)). novar0I u" by simp
  5173   from nov0alls nov0ys have 
  5174     cs: "(\<forall> u\<in> set (?ys@ (all_sums (j,as))). novar0I u)"
  5175     by (simp only: sym[OF list_all_iff]) auto
  5176   
  5177   have "all_sums(j,a#as) = ?ys@(all_sums(j,as))"
  5178     by simp
  5179   then 
  5180   have "?case = (\<forall> x\<in> set (?ys@ (all_sums (j,as))). novar0I x)"
  5181     by auto
  5182   with cs show ?case by blast
  5183 qed
  5184 
  5185 (* correctness theorem for all_sums*)
  5186 lemma all_sums_ex: 
  5187   "(\<exists> j\<in> {1..d}. \<exists> b\<in> (set xs). P (lin_add(b,Cst j))) = 
  5188   (\<exists> x\<in> set (all_sums (d,xs)). P x)"
  5189 proof(induct d xs rule: all_sums.induct)
  5190   case (1 a) show ?case by simp
  5191 next 
  5192   case (2 a y ys)
  5193   have "(\<exists> x\<in> set (map (\<lambda>x. lin_add (y,(Cst x))) (iupto(1,a))) . P x) = 
  5194     (\<exists> j\<in> set (iupto(1,a)). P (lin_add(y,Cst j)))" 
  5195     by auto
  5196   also have "\<dots> = (\<exists> j\<in> {1..a}. P (lin_add(y,Cst j)))" 
  5197     by (simp only : iupto_set)
  5198   finally
  5199   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
  5200   
  5201   from prems have "(\<exists> j\<in> {1..a}. \<exists> b\<in> (set (y#ys)). P (lin_add(b,Cst j))) = 
  5202     ((\<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
  5203   also
  5204   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
  5205   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
  5206   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
  5207   finally show ?case by simp
  5208 qed
  5209 
  5210 
  5211 
  5212 (* explode_minf (p,B)  assumes that p is unified and B = bset p, it computes the rhs of cooper_mi_eq*)
  5213 
  5214 consts explode_minf :: "(QF \<times> intterm list) \<Rightarrow> QF"
  5215 recdef explode_minf "measure size"
  5216 "explode_minf (q,B) = 
  5217   (let d = divlcm q;
  5218        pm = minusinf q;
  5219         dj1 = explode_disj ((map Cst (iupto (1, d))),pm)
  5220    in (case dj1 of 
  5221          T \<Rightarrow> T
  5222        | F \<Rightarrow> explode_disj (all_sums (d,B),q)
  5223         | _ \<Rightarrow> (let dj2 = explode_disj (all_sums (d,B),q)
  5224               in ( case dj2 of 
  5225                      T \<Rightarrow> T
  5226                    | F \<Rightarrow> dj1
  5227                    | _ \<Rightarrow> Or dj1 dj2))))"
  5228 
  5229 (* The result of the rhs of cooper's theorem doese not depend on Var 0*)
  5230 lemma explode_minf_novar0:
  5231   assumes unifp : "isunified p"
  5232   and bst: "set (bset p) = set B"
  5233   shows "novar0 (explode_minf (p,B))"
  5234 proof-
  5235   let ?d = "divlcm p"
  5236   let ?pm = "minusinf p"
  5237   let ?dj1 = "explode_disj (map Cst (iupto(1,?d)),?pm)"
  5238   
  5239   have qfpm: "isqfree ?pm"  using unified_islinform[OF unifp] minusinf_qfree by simp
  5240   have dpos: "?d >0" using unified_islinform[OF unifp] divlcm_pos by simp 
  5241   have "\<forall> x\<in> set (map Cst (iupto(1,?d))). novar0I x" by auto
  5242   then have dj1_nov0: "novar0 ?dj1" using qfpm explode_disj_novar0 by simp
  5243   
  5244   let ?dj2 = "explode_disj (all_sums (?d,B),p)"
  5245   have 
  5246     bstlin: "\<forall>b\<in>set B. islinintterm b"
  5247     using bset_lin[OF unifp] bst
  5248     by simp
  5249   
  5250   have bstnov0: "\<forall>b\<in>set B. novar0I b"
  5251     using bst bset_novar0[OF unifp] by simp
  5252   have allsnov0: "\<forall>x\<in>set (all_sums(?d,B)). novar0I x "
  5253     by (simp add:all_sums_novar0[OF bstnov0 bstlin] )
  5254   then have dj2_nov0: "novar0 ?dj2" 
  5255     using explode_disj_novar0 unified_isqfree[OF unifp] bst by simp
  5256   have "?dj1 = T \<or> ?dj1 = F \<or> (?dj1 \<noteq> T \<and> ?dj1 \<noteq> F)" by auto
  5257   moreover
  5258   { assume "?dj1 = T" then have ?thesis by simp }
  5259   moreover
  5260   { assume "?dj1 = F" then have ?thesis using bst dj2_nov0 by (simp add: Let_def)}
  5261   moreover
  5262   {
  5263     assume dj1nFT:"?dj1 \<noteq> T \<and> ?dj1 \<noteq> F"
  5264     
  5265     have "?dj2 = T \<or> ?dj2 = F \<or> (?dj2 \<noteq> T \<and> ?dj2 \<noteq> F)" by auto
  5266     moreover
  5267     { assume "?dj2 = T" then have ?thesis by (cases ?dj1) simp_all }
  5268     moreover
  5269     { assume "?dj2 = F" then have ?thesis using dj1_nov0 bst
  5270 	by (cases ?dj1) (simp_all add: Let_def)}
  5271     moreover
  5272     {
  5273       assume dj2_nTF:"?dj2 \<noteq> T \<and> ?dj2 \<noteq> F"
  5274       let ?res = "\<lambda>f. \<lambda>g. (case f of T \<Rightarrow> T | F \<Rightarrow> g
  5275 	| _ \<Rightarrow> (case g of T \<Rightarrow> T| F \<Rightarrow> f| _ \<Rightarrow> Or f g))"
  5276       have expth: "explode_minf (p,B) = ?res ?dj1 ?dj2"
  5277 	by (simp add: Let_def del: iupto.simps split del: split_if
  5278 	  cong del: QF.weak_case_cong)
  5279       then have ?thesis
  5280 	using prems or_case_novar0 [OF dj1nFT dj2_nTF dj1_nov0 dj2_nov0]
  5281 	by (simp add: Let_def del: iupto.simps cong del: QF.weak_case_cong)
  5282     }
  5283     ultimately have ?thesis by blast
  5284   }
  5285   ultimately show ?thesis by blast
  5286 qed
  5287   
  5288 (* explode_minf computes the rhs of cooper's thm*)
  5289 lemma explode_minf_corr:
  5290   assumes unifp : "isunified p"
  5291   and bst: "set (bset p) = set B"
  5292   shows "(\<exists> x . qinterp (x#ats) p) = (qinterp (a#ats) (explode_minf (p,B)))"
  5293   (is "(\<exists> x. ?P x) = (?EXP a p)")
  5294 proof-
  5295   let ?d = "divlcm p"
  5296   let ?pm = "minusinf p"
  5297   let ?dj1 = "explode_disj (map Cst (iupto(1,?d)),?pm)"
  5298   have qfpm: "isqfree ?pm"  using unified_islinform[OF unifp] minusinf_qfree by simp 
  5299   have nnfp: "isnnf p" by (rule unified_isnnf[OF unifp])
  5300 
  5301   have "(\<exists>j\<in>{1..?d}. qinterp (j # ats) (minusinf p))
  5302     = (\<exists>j\<in> set (iupto(1,?d)). qinterp (j#ats) (minusinf p))"
  5303     (is "(\<exists> j\<in> {1..?d}. ?QM j) = \<dots>")
  5304     by (simp add: sym[OF iupto_set] )
  5305   also
  5306   have "\<dots> =(\<exists>j\<in> set (iupto(1,?d)). qinterp ((I_intterm (a#ats) (Cst j))#ats) (minusinf p))"
  5307     by simp
  5308   also have 
  5309     "\<dots> = (\<exists>j\<in> set (map Cst (iupto(1,?d))). qinterp ((I_intterm (a#ats) j)#ats) (minusinf p))" by simp
  5310   also have 
  5311     "\<dots> = 
  5312     (\<exists>j\<in> set (map Cst (iupto(1,?d))). qinterp (a#ats) (subst_p j (minusinf p)))"
  5313     by (simp add: subst_p_corr[OF qfpm])
  5314   finally have dj1_thm: 
  5315     "(\<exists> j\<in> {1..?d}. ?QM j) = (qinterp (a#ats) ?dj1)"
  5316     by (simp only: explode_disj_corr[OF qfpm])
  5317   let ?dj2 = "explode_disj (all_sums (?d,B),p)"
  5318   have 
  5319     bstlin: "\<forall>b\<in>set B. islinintterm b" 
  5320     using bst by (simp add: bset_lin[OF unifp])
  5321   have bstnov0: "\<forall>b\<in>set B. novar0I b" 
  5322     using bst by (simp add: bset_novar0[OF unifp])
  5323   have allsnov0: "\<forall>x\<in>set (all_sums(?d,B)). novar0I x "
  5324     by (simp add:all_sums_novar0[OF bstnov0 bstlin] )
  5325   have "(\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)) = 
  5326    (\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) (lin_add(b,Cst j))))"
  5327     using bst by (auto simp add: lin_add_corr bset_lin[OF unifp])
  5328   also have "\<dots> = (\<exists> x \<in> set (all_sums (?d, B)). ?P (I_intterm (a#ats) x))"
  5329     by (simp add: all_sums_ex[where P="\<lambda> t. ?P (I_intterm (a#ats) t)"])
  5330   finally 
  5331   have "(\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)) = 
  5332     (\<exists> x \<in> set (all_sums (?d, B)). qinterp (a#ats) (subst_p x p))"
  5333     using allsnov0 prems linform_isqfree unified_islinform[OF unifp]
  5334     by (simp add: all_sums_ex subst_p_corr)
  5335   also have "\<dots> = (qinterp (a#ats) ?dj2)"
  5336     using linform_isqfree unified_islinform[OF unifp]
  5337     by (simp add: explode_disj_corr)
  5338   finally have dj2th: 
  5339     "(\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)) =  
  5340     (qinterp (a#ats) ?dj2)" by simp
  5341   let ?result = "\<lambda>f. \<lambda>g. 
  5342     (case f of 
  5343     T \<Rightarrow> T
  5344     | F \<Rightarrow> g
  5345     | _ \<Rightarrow> (case g of 
  5346     T \<Rightarrow> T
  5347     | F \<Rightarrow> f
  5348     | _ \<Rightarrow> Or f g))"
  5349   have "?EXP a p =  qinterp (a#ats) (?result ?dj1 ?dj2)"
  5350     by (simp only: explode_minf.simps Let_def)
  5351   also
  5352   have "\<dots> = (qinterp (a#ats) ?dj1 \<or> qinterp (a#ats) ?dj2)" 
  5353     by (rule eval_Or_cases[where f="?dj1" and g="?dj2" and a="a" and ats="ats"])
  5354   also 
  5355   have "\<dots> = ((\<exists> j\<in> {1..?d}. ?QM j) \<or> 
  5356     (\<exists> j\<in> {1..?d}. \<exists> b\<in> set B. ?P (I_intterm (a#ats) b + j)))"
  5357     by (simp add: dj1_thm dj2th)
  5358   also
  5359   have "\<dots> = (\<exists> x. ?P x)"
  5360     using bst sym[OF cooper_mi_eq[OF unifp]] by simp
  5361   finally show ?thesis by simp
  5362 qed
  5363 
  5364 
  5365 lemma explode_minf_corr2:
  5366   assumes unifp : "isunified p"
  5367   and bst: "set (bset p) = set B"
  5368   shows "(qinterp ats (QEx p)) = (qinterp ats (decrvars(explode_minf (p,B))))"
  5369   (is "?P = (?Qe p)")
  5370 proof-
  5371   have "?P = (\<exists>x. qinterp (x#ats) p)" by simp
  5372   also have "\<dots>  = (qinterp (a # ats) (explode_minf (p,B)))"
  5373     using unifp bst explode_minf_corr by simp
  5374   finally have ex: "?P = (qinterp (a # ats) (explode_minf (p,B)))" .
  5375   have nv0: "novar0 (explode_minf (p,B))"
  5376     by (rule explode_minf_novar0[OF unifp])
  5377   show ?thesis
  5378     using qinterp_novar0[OF nv0] ex by simp
  5379 qed
  5380 
  5381 (* An implementation of cooper's method for both plus/minus/infinity *)
  5382 
  5383 (* unify the formula *)
  5384 constdefs unify:: "QF \<Rightarrow> (QF \<times> intterm list)"
  5385   "unify p \<equiv> 
  5386   (let q = unitycoeff p;
  5387        B = list_set(bset q);
  5388        A = list_set (aset q)
  5389   in
  5390   if (length B \<le> length A)
  5391              then (q,B)
  5392              else (mirror q, map lin_neg A))"
  5393   
  5394 (* unify behaves like unitycoeff *)
  5395 lemma unify_ex:
  5396   assumes linp: "islinform p"
  5397   shows "qinterp ats (QEx p) = qinterp ats (QEx (fst (unify p)))"
  5398 proof-
  5399   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
  5400   moreover
  5401   {
  5402     assume "length (list_set(bset (unitycoeff p))) \<le> length (list_set (aset (unitycoeff p)))"
  5403     then have "fst (unify p) = unitycoeff p" using unify_def by (simp add: Let_def)
  5404     then have ?thesis using unitycoeff_corr[OF linp]
  5405       by simp
  5406   }
  5407   moreover 
  5408   {
  5409     assume "length (list_set(bset (unitycoeff p))) > length (list_set (aset (unitycoeff p)))"
  5410     then have unif: "fst(unify p) = mirror (unitycoeff p)"
  5411       using unify_def by (simp add: Let_def)
  5412     let ?q ="unitycoeff p"
  5413     have unifq: "isunified ?q" by(rule unitycoeff_unified[OF linp])
  5414     have linq: "islinform ?q" by (rule unified_islinform[OF unifq])
  5415     have "qinterp ats (QEx ?q) = qinterp ats (QEx (mirror ?q))" 
  5416       by (rule mirror_ex2[OF unifq])
  5417     moreover have "qinterp ats (QEx p) = qinterp ats (QEx ?q)"
  5418       using unitycoeff_corr linp by simp
  5419     ultimately have ?thesis using prems unif by simp
  5420   }
  5421   ultimately show ?thesis by blast
  5422 qed
  5423 
  5424 (* unify's result is a unified formula *)
  5425 lemma unify_unified: 
  5426   assumes linp: "islinform p"
  5427   shows "isunified (fst (unify p))"
  5428   using linp unitycoeff_unified mirror_unified unify_def unified_islinform
  5429   by (auto simp add: Let_def)
  5430 
  5431 
  5432 (* unify preserves quantifier-freeness*)
  5433 lemma unify_qfree:
  5434   assumes linp: "islinform p"
  5435   shows "isqfree (fst(unify p))"
  5436   using linp unify_unified unified_isqfree by simp
  5437 
  5438 lemma unify_bst: 
  5439   assumes linp: " islinform p" 
  5440   and unif: "unify p = (q,B)"
  5441   shows "set B = set (bset q)" 
  5442 proof-
  5443   let ?q = "unitycoeff p"
  5444   let ?a = "aset ?q"
  5445   let ?b = "bset ?q"
  5446   let ?la = "list_set ?a"
  5447   let ?lb = "list_set ?b"
  5448   have " length ?lb \<le> length ?la \<or> length ?lb > length ?la" by arith
  5449   moreover 
  5450   {
  5451     assume "length ?lb \<le> length ?la"
  5452     then
  5453     have "unify p = (?q,?lb)"using unify_def prems by (simp add: Let_def)
  5454     then 
  5455     have ?thesis using prems by (simp add: sym[OF list_set_set])
  5456   }
  5457   moreover
  5458   {    assume "length ?lb > length ?la"
  5459     have r: "unify p = (mirror ?q,map lin_neg ?la)"using unify_def prems by (simp add: Let_def)
  5460     have lin: "\<forall> x\<in> set (bset (mirror ?q)). islinintterm x"
  5461       using bset_lin mirror_unified unitycoeff_unified[OF linp] by auto
  5462     with r prems aset_eq_bset_mirror lin_neg_idemp unitycoeff_unified linp
  5463     have "set B = set (map lin_neg (map lin_neg (bset (mirror (unitycoeff p)))))"
  5464        by (simp add: sym[OF list_set_set])
  5465      also have "\<dots> = set (map (\<lambda>x. lin_neg (lin_neg x)) (bset (mirror (unitycoeff p))))"
  5466        by auto
  5467      also have "\<dots> = set (bset (mirror (unitycoeff p)))"
  5468        using lin lin_neg_idemp  by (auto simp add: map_idI)
  5469      finally
  5470      have ?thesis using r prems aset_eq_bset_mirror lin_neg_idemp unitycoeff_unified linp
  5471        by (simp add: sym[OF list_set_set])}
  5472   ultimately show ?thesis by blast
  5473 qed
  5474 
  5475 lemma explode_minf_unify_novar0: 
  5476   assumes linp: "islinform p"
  5477   shows "novar0 (explode_minf (unify p))"
  5478 proof-
  5479   have "\<exists> q B. unify p = (q,B)" by simp
  5480   then obtain "q" "B" where qB_def: "unify p = (q,B)" by blast
  5481   have unifq: "isunified q" using unify_unified[OF linp] qB_def by simp
  5482   have bst: "set B = set (bset q)" using unify_bst linp qB_def by simp
  5483   from unifq bst explode_minf_novar0 show ?thesis
  5484     using qB_def by simp
  5485 qed
  5486 
  5487 lemma explode_minf_unify_corr2:
  5488   assumes linp: "islinform p"
  5489   shows "qinterp ats (QEx p) = qinterp ats (decrvars(explode_minf(unify p)))"
  5490 proof-
  5491   have "\<exists> q B. unify p = (q,B)" by simp
  5492   then obtain "q" "B" where qB_def: "unify p = (q,B)" by blast
  5493   have unifq: "isunified q" using unify_unified[OF linp] qB_def by simp
  5494   have bst: "set (bset q) = set B" using unify_bst linp qB_def by simp
  5495   from explode_minf_corr2[OF unifq bst] unify_ex[OF linp] show ?thesis
  5496     using qB_def by simp
  5497 qed
  5498 (* An implementation of cooper's method *)
  5499 constdefs cooper:: "QF \<Rightarrow> QF option"
  5500 "cooper p \<equiv> lift_un (\<lambda>q. decrvars(explode_minf (unify q))) (linform (nnf p))"
  5501 
  5502 (* cooper eliminates quantifiers *)
  5503 lemma cooper_qfree: "(\<And> q q'. \<lbrakk>isqfree q ; cooper q = Some q'\<rbrakk> \<Longrightarrow>  isqfree q')"
  5504 proof-
  5505   fix "q" "q'"
  5506   assume qfq: "isqfree q"
  5507     and qeq: "cooper q = Some q'"
  5508   from qeq have "\<exists>p. linform (nnf q) = Some p"
  5509     by (cases "linform (nnf q)") (simp_all add: cooper_def)
  5510   then obtain "p" where p_def: "linform (nnf q) = Some p" by blast
  5511   have linp: "islinform p" using p_def linform_lin nnf_isnnf qfq 
  5512     by auto
  5513   have nnfq: "isnnf (nnf q)" using nnf_isnnf qfq by simp
  5514   then have nnfp: "isnnf p" using linform_nnf[OF nnfq] p_def by auto
  5515   have qfp: "isqfree p" using linp linform_isqfree by simp 
  5516   have "cooper q = Some (decrvars(explode_minf (unify p)))" using p_def 
  5517     by (simp add: cooper_def del: explode_minf.simps)
  5518   then have "q' = decrvars (explode_minf (unify p))" using qeq by simp
  5519   with linp qfp nnfp  unify_unified unify_qfree unified_islinform 
  5520   show "isqfree q'"
  5521     using novar0_qfree explode_minf_unify_novar0 decrvars_qfree
  5522     by simp
  5523 qed
  5524 
  5525 (* cooper preserves semantics *)
  5526 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')")
  5527 proof-
  5528   fix "q" "q'" "ats"
  5529   assume qfq: "isqfree q"
  5530     and qeq: "cooper q = Some q'"
  5531   from qeq have "\<exists>p. linform (nnf q) = Some p"
  5532     by (cases "linform (nnf q)") (simp_all add: cooper_def)
  5533   then obtain "p" where p_def: "linform (nnf q) = Some p" by blast
  5534   have linp: "islinform p" using p_def linform_lin nnf_isnnf qfq by auto
  5535   have qfp: "isqfree p" using linp linform_isqfree by simp 
  5536   have nnfq: "isnnf (nnf q)" using nnf_isnnf qfq by simp
  5537   then have nnfp: "isnnf p" using linform_nnf[OF nnfq] p_def by auto
  5538   have "\<forall> ats. ?P ats q = ?P ats (nnf q)" using nnf_corr qfq by auto
  5539   then have qeqp: "\<forall> ats. ?P ats q = ?P ats p"
  5540     using linform_corr p_def nnf_isnnf qfq
  5541     by auto
  5542 
  5543   have "cooper q = Some (decrvars (explode_minf (unify p)))" using p_def 
  5544     by (simp add: cooper_def del: explode_minf.simps)
  5545   then have decr: "q' = decrvars(explode_minf (unify p))" using qeq by simp
  5546   have eqq:"?P ats (QEx q) = ?P ats (QEx p)" using qeqp by auto
  5547   with decr explode_minf_unify_corr2 unified_islinform unify_unified linp 
  5548   show "?P ats (QEx q) = ?P ats q'" by simp
  5549 qed  
  5550 
  5551 (* A decision procedure for Presburger Arithmetics *)
  5552 constdefs pa:: "QF \<Rightarrow> QF option"
  5553 "pa p \<equiv> lift_un psimpl (qelim(cooper, p))"
  5554 
  5555 lemma psimpl_qfree: "isqfree p \<Longrightarrow> isqfree (psimpl p)"
  5556 apply(induct p rule: isqfree.induct)
  5557 apply(auto simp add: Let_def measure_def inv_image_def)
  5558 apply (simp_all cong del: QF.weak_case_cong add: Let_def)
  5559 apply (case_tac "psimpl p", auto)
  5560 apply (case_tac "psimpl q", 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 p", auto)
  5572 apply (case_tac "psimpl q", 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 p", auto)
  5584 apply (case_tac "psimpl q", 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 p", auto)
  5596 apply (case_tac "psimpl q", auto)
  5597 apply (case_tac "psimpl q", auto)
  5598 apply (case_tac "psimpl q", auto)
  5599 apply (case_tac "psimpl q", auto)
  5600 apply (case_tac "psimpl q", auto)
  5601 apply (case_tac "psimpl q", auto)
  5602 apply (case_tac "psimpl q", auto)
  5603 apply (case_tac "psimpl q", auto)
  5604 apply (case_tac "psimpl q", auto)
  5605 apply (case_tac "psimpl q", auto)
  5606 apply (case_tac "psimpl q", auto)
  5607 apply (case_tac "psimpl q", auto)
  5608 
  5609 apply (case_tac "psimpl p", auto)
  5610 apply (case_tac "lift_bin (\<lambda>x y. lin_add (x, lin_neg y), linearize y,
  5611                    linearize z)", auto)
  5612 apply (case_tac "a",auto)
  5613 apply (case_tac "lift_bin (\<lambda>x y. lin_add (x, lin_neg y), linearize ac,
  5614                    linearize ad)", auto)
  5615 apply (case_tac "a",auto)
  5616 apply (case_tac "ae", auto)
  5617 apply (case_tac "linearize af", auto)
  5618 by (case_tac "a", auto)
  5619 
  5620 (* pa eliminates quantifiers *)
  5621 theorem pa_qfree: "\<And> p'. pa p = Some p' \<Longrightarrow> isqfree p'"
  5622 proof(simp only: pa_def)
  5623 fix "p'"
  5624 assume qep: "lift_un psimpl (qelim (cooper, p)) = Some p'"
  5625 then have "\<exists> q. qelim (cooper, p) = Some q"
  5626   by (cases "qelim(cooper, p)") auto
  5627 then obtain "q" where q_def: "qelim (cooper, p) = Some q" by blast
  5628 have "\<And>q q'. \<lbrakk>isqfree q; cooper q = Some q'\<rbrakk> \<Longrightarrow> isqfree q'" using cooper_qfree by blast
  5629 with q_def
  5630 have "isqfree q" using qelim_qfree by blast
  5631 then have "isqfree (psimpl q)" using psimpl_qfree
  5632   by auto
  5633 then show "isqfree p'"
  5634   using prems 
  5635   by simp
  5636 
  5637 qed
  5638 
  5639 (* pa preserves semantics *)
  5640 theorem pa_corr: 
  5641   "\<And> p'. pa p = Some p' \<Longrightarrow> (qinterp ats p = qinterp ats p')"
  5642 proof(simp only: pa_def)
  5643   fix "p'"
  5644   assume qep: "lift_un psimpl (qelim(cooper, p)) = Some p'"
  5645  then have "\<exists> q. qelim (cooper, p) = Some q"
  5646   by (cases "qelim(cooper, p)") auto
  5647 then obtain "q" where q_def: "qelim (cooper, p) = Some q" by blast 
  5648   have cp1:"\<And>q q' ats. 
  5649     \<lbrakk>isqfree q; cooper q = Some q'\<rbrakk> \<Longrightarrow> qinterp ats (QEx q) = qinterp ats q'"
  5650     using cooper_corr by blast
  5651   moreover have cp2: "\<And>q q'. \<lbrakk>isqfree q; cooper q = Some q'\<rbrakk> \<Longrightarrow> isqfree q'"
  5652     using cooper_qfree by blast
  5653   ultimately have "qinterp ats p = qinterp ats q" using qelim_corr qep psimpl_corr q_def
  5654     by blast
  5655   then have "qinterp ats p = qinterp ats (psimpl q)" using psimpl_corr q_def
  5656     by auto
  5657   then show "qinterp ats p = qinterp ats p'" using prems 
  5658     by simp
  5659 qed
  5660 
  5661 lemma [code]: "linearize (Mult i j) = 
  5662   (case linearize i of
  5663   None \<Rightarrow> None
  5664   | Some li \<Rightarrow> (case li of 
  5665      Cst b \<Rightarrow> (case linearize j of
  5666       None \<Rightarrow> None
  5667      | (Some lj) \<Rightarrow> Some (lin_mul(b,lj)))
  5668   | _ \<Rightarrow> (case linearize j of
  5669       None \<Rightarrow> None
  5670     | (Some lj) \<Rightarrow> (case lj of 
  5671         Cst b \<Rightarrow> Some (lin_mul (b,li))
  5672       | _ \<Rightarrow> None))))"
  5673 by (simp add: measure_def inv_image_def)
  5674 
  5675 lemma [code]: "psimpl (And p q) = 
  5676   (let p'= psimpl p
  5677   in (case p' of 
  5678        F \<Rightarrow> F
  5679       |T \<Rightarrow> psimpl q
  5680       | _ \<Rightarrow> let q' = psimpl q
  5681              in (case q' of
  5682                      F \<Rightarrow> F
  5683                    | T \<Rightarrow> p'
  5684                    | _ \<Rightarrow> (And p' q'))))"
  5685 
  5686 by (simp add: measure_def inv_image_def)
  5687 
  5688 lemma [code]: "psimpl (Or p q) = 
  5689   (let p'= psimpl p
  5690   in (case p' of 
  5691         T \<Rightarrow> T
  5692       | F \<Rightarrow> psimpl q
  5693       | _ \<Rightarrow> let q' = psimpl q
  5694              in (case q' of
  5695                      T \<Rightarrow> T
  5696                    | F \<Rightarrow> p'
  5697                    | _ \<Rightarrow> (Or p' q'))))"
  5698 
  5699 by (simp add: measure_def inv_image_def)
  5700 
  5701 lemma [code]: "psimpl (Imp p q) = 
  5702   (let p'= psimpl p
  5703   in (case p' of 
  5704        F \<Rightarrow> T
  5705       |T \<Rightarrow> psimpl q
  5706       | NOT p1 \<Rightarrow> let q' = psimpl q
  5707              in (case q' of
  5708                      F \<Rightarrow> p1
  5709                    | T \<Rightarrow> T
  5710                    | _ \<Rightarrow> (Or p1 q'))
  5711       | _ \<Rightarrow> let q' = psimpl q
  5712              in (case q' of
  5713                      F \<Rightarrow> NOT p'
  5714                    | T \<Rightarrow> T
  5715                    | _ \<Rightarrow> (Imp p' q'))))"
  5716 by (simp add: measure_def inv_image_def)
  5717 
  5718 declare zdvd_iff_zmod_eq_0 [code]
  5719 
  5720 (*
  5721 generate_code ("presburger.ML") test = "pa"
  5722 use "rcooper.ML"
  5723 oracle rpresburger_oracle ("term") = RCooper.rpresburger_oracle
  5724 use "rpresbtac.ML"
  5725 setup RPresburger.setup
  5726 *)
  5727 
  5728 end