Theory Presburger

Up to index of Isabelle/HOL

theory Presburger
imports Arith_Tools SetInterval
uses Tools/Qelim/cooper_data.ML Tools/Qelim/generated_cooper.ML (Tools/Qelim/cooper.ML) (Tools/Qelim/presburger.ML)
begin

(* Title:      HOL/Presburger.thy
   ID:         $Id: Presburger.thy,v 1.53 2007/10/30 07:45:54 haftmann Exp $
   Author:     Amine Chaieb, TU Muenchen
*)

header {* Decision Procedure for Presburger Arithmetic *}

theory Presburger
imports Arith_Tools SetInterval
uses
  "Tools/Qelim/cooper_data.ML"
  "Tools/Qelim/generated_cooper.ML"
  ("Tools/Qelim/cooper.ML")
  ("Tools/Qelim/presburger.ML")
begin

setup CooperData.setup

subsection{* The @{text "-∞"} and @{text "+∞"} Properties *}


lemma minf:
  "[|∃(z ::'a::linorder).∀x<z. P x = P' x; ∃z.∀x<z. Q x = Q' x|] 
     ==> ∃z.∀x<z. (P x ∧ Q x) = (P' x ∧ Q' x)"
  "[|∃(z ::'a::linorder).∀x<z. P x = P' x; ∃z.∀x<z. Q x = Q' x|] 
     ==> ∃z.∀x<z. (P x ∨ Q x) = (P' x ∨ Q' x)"
  "∃(z ::'a::{linorder}).∀x<z.(x = t) = False"
  "∃(z ::'a::{linorder}).∀x<z.(x ≠ t) = True"
  "∃(z ::'a::{linorder}).∀x<z.(x < t) = True"
  "∃(z ::'a::{linorder}).∀x<z.(x ≤ t) = True"
  "∃(z ::'a::{linorder}).∀x<z.(x > t) = False"
  "∃(z ::'a::{linorder}).∀x<z.(x ≥ t) = False"
  "∃z.∀(x::'a::{linorder,plus,Divides.div})<z. (d dvd x + s) = (d dvd x + s)"
  "∃z.∀(x::'a::{linorder,plus,Divides.div})<z. (¬ d dvd x + s) = (¬ d dvd x + s)"
  "∃z.∀x<z. F = F"
  by ((erule exE, erule exE,rule_tac x="min z za" in exI,simp)+, (rule_tac x="t" in exI,fastsimp)+) simp_all

lemma pinf:
  "[|∃(z ::'a::linorder).∀x>z. P x = P' x; ∃z.∀x>z. Q x = Q' x|] 
     ==> ∃z.∀x>z. (P x ∧ Q x) = (P' x ∧ Q' x)"
  "[|∃(z ::'a::linorder).∀x>z. P x = P' x; ∃z.∀x>z. Q x = Q' x|] 
     ==> ∃z.∀x>z. (P x ∨ Q x) = (P' x ∨ Q' x)"
  "∃(z ::'a::{linorder}).∀x>z.(x = t) = False"
  "∃(z ::'a::{linorder}).∀x>z.(x ≠ t) = True"
  "∃(z ::'a::{linorder}).∀x>z.(x < t) = False"
  "∃(z ::'a::{linorder}).∀x>z.(x ≤ t) = False"
  "∃(z ::'a::{linorder}).∀x>z.(x > t) = True"
  "∃(z ::'a::{linorder}).∀x>z.(x ≥ t) = True"
  "∃z.∀(x::'a::{linorder,plus,Divides.div})>z. (d dvd x + s) = (d dvd x + s)"
  "∃z.∀(x::'a::{linorder,plus,Divides.div})>z. (¬ d dvd x + s) = (¬ d dvd x + s)"
  "∃z.∀x>z. F = F"
  by ((erule exE, erule exE,rule_tac x="max z za" in exI,simp)+,(rule_tac x="t" in exI,fastsimp)+) simp_all

lemma inf_period:
  "[|∀x k. P x = P (x - k*D); ∀x k. Q x = Q (x - k*D)|] 
    ==> ∀x k. (P x ∧ Q x) = (P (x - k*D) ∧ Q (x - k*D))"
  "[|∀x k. P x = P (x - k*D); ∀x k. Q x = Q (x - k*D)|] 
    ==> ∀x k. (P x ∨ Q x) = (P (x - k*D) ∨ Q (x - k*D))"
  "(d::'a::{comm_ring,Divides.div}) dvd D ==> ∀x k. (d dvd x + t) = (d dvd (x - k*D) + t)"
  "(d::'a::{comm_ring,Divides.div}) dvd D ==> ∀x k. (¬d dvd x + t) = (¬d dvd (x - k*D) + t)"
  "∀x k. F = F"
by simp_all
  (clarsimp simp add: dvd_def, rule iffI, clarsimp,rule_tac x = "kb - ka*k" in exI,
    simp add: ring_simps, clarsimp,rule_tac x = "kb + ka*k" in exI,simp add: ring_simps)+

subsection{* The A and B sets *}
lemma bset:
  "[|∀x.(∀j ∈ {1 .. D}. ∀b∈B. x ≠ b + j)--> P x --> P(x - D) ;
     ∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> Q x --> Q(x - D)|] ==> 
  ∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j) --> (P x ∧ Q x) --> (P(x - D) ∧ Q (x - D))"
  "[|∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> P x --> P(x - D) ;
     ∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> Q x --> Q(x - D)|] ==> 
  ∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (P x ∨ Q x) --> (P(x - D) ∨ Q (x - D))"
  "[|D>0; t - 1∈ B|] ==> (∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x = t) --> (x - D = t))"
  "[|D>0 ; t ∈ B|] ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x ≠ t) --> (x - D ≠ t))"
  "D>0 ==> (∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x < t) --> (x - D < t))"
  "D>0 ==> (∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x ≤ t) --> (x - D ≤ t))"
  "[|D>0 ; t ∈ B|] ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x > t) --> (x - D > t))"
  "[|D>0 ; t - 1 ∈ B|] ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x ≥ t) --> (x - D ≥ t))"
  "d dvd D ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (d dvd x+t) --> (d dvd (x - D) + t))"
  "d dvd D ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (¬d dvd x+t) --> (¬ d dvd (x - D) + t))"
  "∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j) --> F --> F"
proof (blast, blast)
  assume dp: "D > 0" and tB: "t - 1∈ B"
  show "(∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x = t) --> (x - D = t))" 
    apply (rule allI, rule impI,erule ballE[where x="1"],erule ballE[where x="t - 1"])
    using dp tB by simp_all
next
  assume dp: "D > 0" and tB: "t ∈ B"
  show "(∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x ≠ t) --> (x - D ≠ t))" 
    apply (rule allI, rule impI,erule ballE[where x="D"],erule ballE[where x="t"])
    using dp tB by simp_all
next
  assume dp: "D > 0" thus "(∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x < t) --> (x - D < t))" by arith
next
  assume dp: "D > 0" thus "∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x ≤ t) --> (x - D ≤ t)" by arith
next
  assume dp: "D > 0" and tB:"t ∈ B"
  {fix x assume nob: "∀j∈{1 .. D}. ∀b∈B. x ≠ b + j" and g: "x > t" and ng: "¬ (x - D) > t"
    hence "x -t ≤ D" and "1 ≤ x - t" by simp+
      hence "∃j ∈ {1 .. D}. x - t = j" by auto
      hence "∃j ∈ {1 .. D}. x = t + j" by (simp add: ring_simps)
      with nob tB have "False" by simp}
  thus "∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x > t) --> (x - D > t)" by blast
next
  assume dp: "D > 0" and tB:"t - 1∈ B"
  {fix x assume nob: "∀j∈{1 .. D}. ∀b∈B. x ≠ b + j" and g: "x ≥ t" and ng: "¬ (x - D) ≥ t"
    hence "x - (t - 1) ≤ D" and "1 ≤ x - (t - 1)" by simp+
      hence "∃j ∈ {1 .. D}. x - (t - 1) = j" by auto
      hence "∃j ∈ {1 .. D}. x = (t - 1) + j" by (simp add: ring_simps)
      with nob tB have "False" by simp}
  thus "∀x.(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (x ≥ t) --> (x - D ≥ t)" by blast
next
  assume d: "d dvd D"
  {fix x assume H: "d dvd x + t" with d have "d dvd (x - D) + t"
      by (clarsimp simp add: dvd_def,rule_tac x= "ka - k" in exI,simp add: ring_simps)}
  thus "∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (d dvd x+t) --> (d dvd (x - D) + t)" by simp
next
  assume d: "d dvd D"
  {fix x assume H: "¬(d dvd x + t)" with d have "¬d dvd (x - D) + t"
      by (clarsimp simp add: dvd_def,erule_tac x= "ka + k" in allE,simp add: ring_simps)}
  thus "∀(x::int).(∀j∈{1 .. D}. ∀b∈B. x ≠ b + j)--> (¬d dvd x+t) --> (¬d dvd (x - D) + t)" by auto
qed blast

lemma aset:
  "[|∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> P x --> P(x + D) ;
     ∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> Q x --> Q(x + D)|] ==> 
  ∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j) --> (P x ∧ Q x) --> (P(x + D) ∧ Q (x + D))"
  "[|∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> P x --> P(x + D) ;
     ∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> Q x --> Q(x + D)|] ==> 
  ∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (P x ∨ Q x) --> (P(x + D) ∨ Q (x + D))"
  "[|D>0; t + 1∈ A|] ==> (∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x = t) --> (x + D = t))"
  "[|D>0 ; t ∈ A|] ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x ≠ t) --> (x + D ≠ t))"
  "[|D>0; t∈ A|] ==>(∀(x::int). (∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x < t) --> (x + D < t))"
  "[|D>0; t + 1 ∈ A|] ==> (∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x ≤ t) --> (x + D ≤ t))"
  "D>0 ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x > t) --> (x + D > t))"
  "D>0 ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x ≥ t) --> (x + D ≥ t))"
  "d dvd D ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (d dvd x+t) --> (d dvd (x + D) + t))"
  "d dvd D ==>(∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (¬d dvd x+t) --> (¬ d dvd (x + D) + t))"
  "∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j) --> F --> F"
proof (blast, blast)
  assume dp: "D > 0" and tA: "t + 1 ∈ A"
  show "(∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x = t) --> (x + D = t))" 
    apply (rule allI, rule impI,erule ballE[where x="1"],erule ballE[where x="t + 1"])
    using dp tA by simp_all
next
  assume dp: "D > 0" and tA: "t ∈ A"
  show "(∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x ≠ t) --> (x + D ≠ t))" 
    apply (rule allI, rule impI,erule ballE[where x="D"],erule ballE[where x="t"])
    using dp tA by simp_all
next
  assume dp: "D > 0" thus "(∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x > t) --> (x + D > t))" by arith
next
  assume dp: "D > 0" thus "∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x ≥ t) --> (x + D ≥ t)" by arith
next
  assume dp: "D > 0" and tA:"t ∈ A"
  {fix x assume nob: "∀j∈{1 .. D}. ∀b∈A. x ≠ b - j" and g: "x < t" and ng: "¬ (x + D) < t"
    hence "t - x ≤ D" and "1 ≤ t - x" by simp+
      hence "∃j ∈ {1 .. D}. t - x = j" by auto
      hence "∃j ∈ {1 .. D}. x = t - j" by (auto simp add: ring_simps) 
      with nob tA have "False" by simp}
  thus "∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x < t) --> (x + D < t)" by blast
next
  assume dp: "D > 0" and tA:"t + 1∈ A"
  {fix x assume nob: "∀j∈{1 .. D}. ∀b∈A. x ≠ b - j" and g: "x ≤ t" and ng: "¬ (x + D) ≤ t"
    hence "(t + 1) - x ≤ D" and "1 ≤ (t + 1) - x" by (simp_all add: ring_simps)
      hence "∃j ∈ {1 .. D}. (t + 1) - x = j" by auto
      hence "∃j ∈ {1 .. D}. x = (t + 1) - j" by (auto simp add: ring_simps)
      with nob tA have "False" by simp}
  thus "∀x.(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (x ≤ t) --> (x + D ≤ t)" by blast
next
  assume d: "d dvd D"
  {fix x assume H: "d dvd x + t" with d have "d dvd (x + D) + t"
      by (clarsimp simp add: dvd_def,rule_tac x= "ka + k" in exI,simp add: ring_simps)}
  thus "∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (d dvd x+t) --> (d dvd (x + D) + t)" by simp
next
  assume d: "d dvd D"
  {fix x assume H: "¬(d dvd x + t)" with d have "¬d dvd (x + D) + t"
      by (clarsimp simp add: dvd_def,erule_tac x= "ka - k" in allE,simp add: ring_simps)}
  thus "∀(x::int).(∀j∈{1 .. D}. ∀b∈A. x ≠ b - j)--> (¬d dvd x+t) --> (¬d dvd (x + D) + t)" by auto
qed blast

subsection{* Cooper's Theorem @{text "-∞"} and @{text "+∞"} Version *}

subsubsection{* First some trivial facts about periodic sets or predicates *}
lemma periodic_finite_ex:
  assumes dpos: "(0::int) < d" and modd: "ALL x k. P x = P(x - k*d)"
  shows "(EX x. P x) = (EX j : {1..d}. P j)"
  (is "?LHS = ?RHS")
proof
  assume ?LHS
  then obtain x where P: "P x" ..
  have "x mod d = x - (x div d)*d" by(simp add:zmod_zdiv_equality mult_ac eq_diff_eq)
  hence Pmod: "P x = P(x mod d)" using modd by simp
  show ?RHS
  proof (cases)
    assume "x mod d = 0"
    hence "P 0" using P Pmod by simp
    moreover have "P 0 = P(0 - (-1)*d)" using modd by blast
    ultimately have "P d" by simp
    moreover have "d : {1..d}" using dpos by(simp add:atLeastAtMost_iff)
    ultimately show ?RHS ..
  next
    assume not0: "x mod d ≠ 0"
    have "P(x mod d)" using dpos P Pmod by(simp add:pos_mod_sign pos_mod_bound)
    moreover have "x mod d : {1..d}"
    proof -
      from dpos have "0 ≤ x mod d" by(rule pos_mod_sign)
      moreover from dpos have "x mod d < d" by(rule pos_mod_bound)
      ultimately show ?thesis using not0 by(simp add:atLeastAtMost_iff)
    qed
    ultimately show ?RHS ..
  qed
qed auto

subsubsection{* The @{text "-∞"} Version*}

lemma decr_lemma: "0 < (d::int) ==> x - (abs(x-z)+1) * d < z"
by(induct rule: int_gr_induct,simp_all add:int_distrib)

lemma incr_lemma: "0 < (d::int) ==> z < x + (abs(x-z)+1) * d"
by(induct rule: int_gr_induct, simp_all add:int_distrib)

theorem int_induct[case_names base step1 step2]:
  assumes 
  base: "P(k::int)" and step1: "!!i. [|k ≤ i; P i|] ==> P(i+1)" and
  step2: "!!i. [|k ≥ i; P i|] ==> P(i - 1)"
  shows "P i"
proof -
  have "i ≤ k ∨ i≥ k" by arith
  thus ?thesis using prems int_ge_induct[where P="P" and k="k" and i="i"] int_le_induct[where P="P" and k="k" and i="i"] by blast
qed

lemma decr_mult_lemma:
  assumes dpos: "(0::int) < d" and minus: "∀x. P x --> P(x - d)" and knneg: "0 <= k"
  shows "ALL x. P x --> P(x - k*d)"
using knneg
proof (induct rule:int_ge_induct)
  case base thus ?case by simp
next
  case (step i)
  {fix x
    have "P x --> P (x - i * d)" using step.hyps by blast
    also have "… --> P(x - (i + 1) * d)" using minus[THEN spec, of "x - i * d"]
      by (simp add:int_distrib OrderedGroup.diff_diff_eq[symmetric])
    ultimately have "P x --> P(x - (i + 1) * d)" by blast}
  thus ?case ..
qed

lemma  minusinfinity:
  assumes dpos: "0 < d" and
    P1eqP1: "ALL x k. P1 x = P1(x - k*d)" and ePeqP1: "EX z::int. ALL x. x < z --> (P x = P1 x)"
  shows "(EX x. P1 x) --> (EX x. P x)"
proof
  assume eP1: "EX x. P1 x"
  then obtain x where P1: "P1 x" ..
  from ePeqP1 obtain z where P1eqP: "ALL x. x < z --> (P x = P1 x)" ..
  let ?w = "x - (abs(x-z)+1) * d"
  from dpos have w: "?w < z" by(rule decr_lemma)
  have "P1 x = P1 ?w" using P1eqP1 by blast
  also have "… = P(?w)" using w P1eqP by blast
  finally have "P ?w" using P1 by blast
  thus "EX x. P x" ..
qed

lemma cpmi: 
  assumes dp: "0 < D" and p1:"∃z. ∀ x< z. P x = P' x"
  and nb:"∀x.(∀ j∈ {1..D}. ∀(b::int) ∈ B. x ≠ b+j) --> P (x) --> P (x - D)"
  and pd: "∀ x k. P' x = P' (x-k*D)"
  shows "(∃x. P x) = ((∃ j∈ {1..D} . P' j) | (∃ j ∈ {1..D}.∃ b∈ B. P (b+j)))" 
         (is "?L = (?R1 ∨ ?R2)")
proof-
 {assume "?R2" hence "?L"  by blast}
 moreover
 {assume H:"?R1" hence "?L" using minusinfinity[OF dp pd p1] periodic_finite_ex[OF dp pd] by simp}
 moreover 
 { fix x
   assume P: "P x" and H: "¬ ?R2"
   {fix y assume "¬ (∃j∈{1..D}. ∃b∈B. P (b + j))" and P: "P y"
     hence "~(EX (j::int) : {1..D}. EX (b::int) : B. y = b+j)" by auto
     with nb P  have "P (y - D)" by auto }
   hence "ALL x.~(EX (j::int) : {1..D}. EX (b::int) : B. P(b+j)) --> P (x) --> P (x - D)" by blast
   with H P have th: " ∀x. P x --> P (x - D)" by auto
   from p1 obtain z where z: "ALL x. x < z --> (P x = P' x)" by blast
   let ?y = "x - (¦x - z¦ + 1)*D"
   have zp: "0 <= (¦x - z¦ + 1)" by arith
   from dp have yz: "?y < z" using decr_lemma[OF dp] by simp   
   from z[rule_format, OF yz] decr_mult_lemma[OF dp th zp, rule_format, OF P] have th2: " P' ?y" by auto
   with periodic_finite_ex[OF dp pd]
   have "?R1" by blast}
 ultimately show ?thesis by blast
qed

subsubsection {* The @{text "+∞"} Version*}

lemma  plusinfinity:
  assumes dpos: "(0::int) < d" and
    P1eqP1: "∀x k. P' x = P'(x - k*d)" and ePeqP1: "∃ z. ∀ x>z. P x = P' x"
  shows "(∃ x. P' x) --> (∃ x. P x)"
proof
  assume eP1: "EX x. P' x"
  then obtain x where P1: "P' x" ..
  from ePeqP1 obtain z where P1eqP: "∀x>z. P x = P' x" ..
  let ?w' = "x + (abs(x-z)+1) * d"
  let ?w = "x - (-(abs(x-z) + 1))*d"
  have ww'[simp]: "?w = ?w'" by (simp add: ring_simps)
  from dpos have w: "?w > z" by(simp only: ww' incr_lemma)
  hence "P' x = P' ?w" using P1eqP1 by blast
  also have "… = P(?w)" using w P1eqP by blast
  finally have "P ?w" using P1 by blast
  thus "EX x. P x" ..
qed

lemma incr_mult_lemma:
  assumes dpos: "(0::int) < d" and plus: "ALL x::int. P x --> P(x + d)" and knneg: "0 <= k"
  shows "ALL x. P x --> P(x + k*d)"
using knneg
proof (induct rule:int_ge_induct)
  case base thus ?case by simp
next
  case (step i)
  {fix x
    have "P x --> P (x + i * d)" using step.hyps by blast
    also have "… --> P(x + (i + 1) * d)" using plus[THEN spec, of "x + i * d"]
      by (simp add:int_distrib zadd_ac)
    ultimately have "P x --> P(x + (i + 1) * d)" by blast}
  thus ?case ..
qed

lemma cppi: 
  assumes dp: "0 < D" and p1:"∃z. ∀ x> z. P x = P' x"
  and nb:"∀x.(∀ j∈ {1..D}. ∀(b::int) ∈ A. x ≠ b - j) --> P (x) --> P (x + D)"
  and pd: "∀ x k. P' x= P' (x-k*D)"
  shows "(∃x. P x) = ((∃ j∈ {1..D} . P' j) | (∃ j ∈ {1..D}.∃ b∈ A. P (b - j)))" (is "?L = (?R1 ∨ ?R2)")
proof-
 {assume "?R2" hence "?L"  by blast}
 moreover
 {assume H:"?R1" hence "?L" using plusinfinity[OF dp pd p1] periodic_finite_ex[OF dp pd] by simp}
 moreover 
 { fix x
   assume P: "P x" and H: "¬ ?R2"
   {fix y assume "¬ (∃j∈{1..D}. ∃b∈A. P (b - j))" and P: "P y"
     hence "~(EX (j::int) : {1..D}. EX (b::int) : A. y = b - j)" by auto
     with nb P  have "P (y + D)" by auto }
   hence "ALL x.~(EX (j::int) : {1..D}. EX (b::int) : A. P(b-j)) --> P (x) --> P (x + D)" by blast
   with H P have th: " ∀x. P x --> P (x + D)" by auto
   from p1 obtain z where z: "ALL x. x > z --> (P x = P' x)" by blast
   let ?y = "x + (¦x - z¦ + 1)*D"
   have zp: "0 <= (¦x - z¦ + 1)" by arith
   from dp have yz: "?y > z" using incr_lemma[OF dp] by simp
   from z[rule_format, OF yz] incr_mult_lemma[OF dp th zp, rule_format, OF P] have th2: " P' ?y" by auto
   with periodic_finite_ex[OF dp pd]
   have "?R1" by blast}
 ultimately show ?thesis by blast
qed

lemma simp_from_to: "{i..j::int} = (if j < i then {} else insert i {i+1..j})"
apply(simp add:atLeastAtMost_def atLeast_def atMost_def)
apply(fastsimp)
done

theorem unity_coeff_ex: "(∃(x::'a::{semiring_0,Divides.div}). P (l * x)) ≡ (∃x. l dvd (x + 0) ∧ P x)"
  apply (rule eq_reflection[symmetric])
  apply (rule iffI)
  defer
  apply (erule exE)
  apply (rule_tac x = "l * x" in exI)
  apply (simp add: dvd_def)
  apply (rule_tac x="x" in exI, simp)
  apply (erule exE)
  apply (erule conjE)
  apply (erule dvdE)
  apply (rule_tac x = k in exI)
  apply simp
  done

lemma zdvd_mono: assumes not0: "(k::int) ≠ 0"
shows "((m::int) dvd t) ≡ (k*m dvd k*t)" 
  using not0 by (simp add: dvd_def)

lemma uminus_dvd_conv: "(d dvd (t::int)) ≡ (-d dvd t)" "(d dvd (t::int)) ≡ (d dvd -t)"
  by simp_all
text {* \bigskip Theorems for transforming predicates on nat to predicates on @{text int}*}
lemma all_nat: "(∀x::nat. P x) = (∀x::int. 0 <= x --> P (nat x))"
  by (simp split add: split_nat)

lemma ex_nat: "(∃x::nat. P x) = (∃x::int. 0 <= x ∧ P (nat x))"
  apply (auto split add: split_nat)
  apply (rule_tac x="int x" in exI, simp)
  apply (rule_tac x = "nat x" in exI,erule_tac x = "nat x" in allE, simp)
  done

lemma zdiff_int_split: "P (int (x - y)) =
  ((y ≤ x --> P (int x - int y)) ∧ (x < y --> P 0))"
  by (case_tac "y ≤ x", simp_all add: zdiff_int)

lemma number_of1: "(0::int) <= number_of n ==> (0::int) <= number_of (n BIT b)" by simp
lemma number_of2: "(0::int) <= Numeral0" by simp
lemma Suc_plus1: "Suc n = n + 1" by simp

text {*
  \medskip Specific instances of congruence rules, to prevent
  simplifier from looping. *}

theorem imp_le_cong: "(0 <= x ==> P = P') ==> (0 <= (x::int) --> P) = (0 <= x --> P')" by simp

theorem conj_le_cong: "(0 <= x ==> P = P') ==> (0 <= (x::int) ∧ P) = (0 <= x ∧ P')" 
  by (simp cong: conj_cong)
lemma int_eq_number_of_eq:
  "(((number_of v)::int) = (number_of w)) = iszero ((number_of (v + (uminus w)))::int)"
  by simp

lemma mod_eq0_dvd_iff[presburger]: "(m::nat) mod n = 0 <-> n dvd m"
unfolding dvd_eq_mod_eq_0[symmetric] ..

lemma zmod_eq0_zdvd_iff[presburger]: "(m::int) mod n = 0 <-> n dvd m"
unfolding zdvd_iff_zmod_eq_0[symmetric] ..
declare mod_1[presburger]
declare mod_0[presburger]
declare zmod_1[presburger]
declare zmod_zero[presburger]
declare zmod_self[presburger]
declare mod_self[presburger]
declare DIVISION_BY_ZERO_MOD[presburger]
declare nat_mod_div_trivial[presburger]
declare div_mod_equality2[presburger]
declare div_mod_equality[presburger]
declare mod_div_equality2[presburger]
declare mod_div_equality[presburger]
declare mod_mult_self1[presburger]
declare mod_mult_self2[presburger]
declare zdiv_zmod_equality2[presburger]
declare zdiv_zmod_equality[presburger]
declare mod2_Suc_Suc[presburger]
lemma [presburger]: "(a::int) div 0 = 0" and [presburger]: "a mod 0 = a"
using IntDiv.DIVISION_BY_ZERO by blast+

use "Tools/Qelim/cooper.ML"
oracle linzqe_oracle ("term") = Coopereif.cooper_oracle

use "Tools/Qelim/presburger.ML"

declaration {* fn _ =>
  arith_tactic_add
    (mk_arith_tactic "presburger" (fn ctxt => fn i => fn st =>
       (warning "Trying Presburger arithmetic ...";   
    Presburger.cooper_tac true [] [] ctxt i st)))
*}

method_setup presburger = {*
let
 fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ()
 fun simple_keyword k = Scan.lift (Args.$$$ k) >> K ()
 val addN = "add"
 val delN = "del"
 val elimN = "elim"
 val any_keyword = keyword addN || keyword delN || simple_keyword elimN
 val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat;
in
  fn src => Method.syntax 
   ((Scan.optional (simple_keyword elimN >> K false) true) -- 
    (Scan.optional (keyword addN |-- thms) []) -- 
    (Scan.optional (keyword delN |-- thms) [])) src 
  #> (fn (((elim, add_ths), del_ths),ctxt) => 
         Method.SIMPLE_METHOD' (Presburger.cooper_tac elim add_ths del_ths ctxt))
end
*} "Cooper's algorithm for Presburger arithmetic"

lemma [presburger]: "m mod 2 = (1::nat) <-> ¬ 2 dvd m " by presburger
lemma [presburger]: "m mod 2 = Suc 0 <-> ¬ 2 dvd m " by presburger
lemma [presburger]: "m mod (Suc (Suc 0)) = (1::nat) <-> ¬ 2 dvd m " by presburger
lemma [presburger]: "m mod (Suc (Suc 0)) = Suc 0 <-> ¬ 2 dvd m " by presburger
lemma [presburger]: "m mod 2 = (1::int) <-> ¬ 2 dvd m " by presburger


lemma zdvd_period:
  fixes a d :: int
  assumes advdd: "a dvd d"
  shows "a dvd (x + t) <-> a dvd ((x + c * d) + t)"
proof-
  {
    fix x k
    from inf_period(3) [OF advdd, rule_format, where x=x and k="-k"]  
    have "a dvd (x + t) <-> a dvd (x + k * d + t)" by simp
  }
  hence "∀x.∀k. ((a::int) dvd (x + t)) = (a dvd (x+k*d + t))"  by simp
  then show ?thesis by simp
qed


subsection {* Code generator setup *}

text {*
  Presburger arithmetic is convenient to prove some
  of the following code lemmas on integer numerals:
*}

lemma eq_Pls_Pls:
  "Numeral.Pls = Numeral.Pls <-> True" by presburger

lemma eq_Pls_Min:
  "Numeral.Pls = Numeral.Min <-> False"
  unfolding Pls_def Numeral.Min_def by presburger

lemma eq_Pls_Bit0:
  "Numeral.Pls = Numeral.Bit k bit.B0 <-> Numeral.Pls = k"
  unfolding Pls_def Bit_def bit.cases by presburger

lemma eq_Pls_Bit1:
  "Numeral.Pls = Numeral.Bit k bit.B1 <-> False"
  unfolding Pls_def Bit_def bit.cases by presburger

lemma eq_Min_Pls:
  "Numeral.Min = Numeral.Pls <-> False"
  unfolding Pls_def Numeral.Min_def by presburger

lemma eq_Min_Min:
  "Numeral.Min = Numeral.Min <-> True" by presburger

lemma eq_Min_Bit0:
  "Numeral.Min = Numeral.Bit k bit.B0 <-> False"
  unfolding Numeral.Min_def Bit_def bit.cases by presburger

lemma eq_Min_Bit1:
  "Numeral.Min = Numeral.Bit k bit.B1 <-> Numeral.Min = k"
  unfolding Numeral.Min_def Bit_def bit.cases by presburger

lemma eq_Bit0_Pls:
  "Numeral.Bit k bit.B0 = Numeral.Pls <-> Numeral.Pls = k"
  unfolding Pls_def Bit_def bit.cases by presburger

lemma eq_Bit1_Pls:
  "Numeral.Bit k bit.B1 = Numeral.Pls <-> False"
  unfolding Pls_def Bit_def bit.cases  by presburger

lemma eq_Bit0_Min:
  "Numeral.Bit k bit.B0 = Numeral.Min <-> False"
  unfolding Numeral.Min_def Bit_def bit.cases  by presburger

lemma eq_Bit1_Min:
  "(Numeral.Bit k bit.B1) = Numeral.Min <-> Numeral.Min = k"
  unfolding Numeral.Min_def Bit_def bit.cases  by presburger

lemma eq_Bit_Bit:
  "Numeral.Bit k1 v1 = Numeral.Bit k2 v2 <->
    v1 = v2 ∧ k1 = k2" 
  unfolding Bit_def
  apply (cases v1)
  apply (cases v2)
  apply auto
  apply presburger
  apply (cases v2)
  apply auto
  apply presburger
  apply (cases v2)
  apply auto
  done

lemma eq_number_of:
  "(number_of k :: int) = number_of l <-> k = l" 
  unfolding number_of_is_id ..


lemma less_eq_Pls_Pls:
  "Numeral.Pls ≤ Numeral.Pls <-> True" by rule+

lemma less_eq_Pls_Min:
  "Numeral.Pls ≤ Numeral.Min <-> False"
  unfolding Pls_def Numeral.Min_def by presburger

lemma less_eq_Pls_Bit:
  "Numeral.Pls ≤ Numeral.Bit k v <-> Numeral.Pls ≤ k"
  unfolding Pls_def Bit_def by (cases v) auto

lemma less_eq_Min_Pls:
  "Numeral.Min ≤ Numeral.Pls <-> True"
  unfolding Pls_def Numeral.Min_def by presburger

lemma less_eq_Min_Min:
  "Numeral.Min ≤ Numeral.Min <-> True" by rule+

lemma less_eq_Min_Bit0:
  "Numeral.Min ≤ Numeral.Bit k bit.B0 <-> Numeral.Min < k"
  unfolding Numeral.Min_def Bit_def by auto

lemma less_eq_Min_Bit1:
  "Numeral.Min ≤ Numeral.Bit k bit.B1 <-> Numeral.Min ≤ k"
  unfolding Numeral.Min_def Bit_def by auto

lemma less_eq_Bit0_Pls:
  "Numeral.Bit k bit.B0 ≤ Numeral.Pls <-> k ≤ Numeral.Pls"
  unfolding Pls_def Bit_def by simp

lemma less_eq_Bit1_Pls:
  "Numeral.Bit k bit.B1 ≤ Numeral.Pls <-> k < Numeral.Pls"
  unfolding Pls_def Bit_def by auto

lemma less_eq_Bit_Min:
  "Numeral.Bit k v ≤ Numeral.Min <-> k ≤ Numeral.Min"
  unfolding Numeral.Min_def Bit_def by (cases v) auto

lemma less_eq_Bit0_Bit:
  "Numeral.Bit k1 bit.B0 ≤ Numeral.Bit k2 v <-> k1 ≤ k2"
  unfolding Bit_def bit.cases by (cases v) auto

lemma less_eq_Bit_Bit1:
  "Numeral.Bit k1 v ≤ Numeral.Bit k2 bit.B1 <-> k1 ≤ k2"
  unfolding Bit_def bit.cases by (cases v) auto

lemma less_eq_Bit1_Bit0:
  "Numeral.Bit k1 bit.B1 ≤ Numeral.Bit k2 bit.B0 <-> k1 < k2"
  unfolding Bit_def by (auto split: bit.split)

lemma less_eq_number_of:
  "(number_of k :: int) ≤ number_of l <-> k ≤ l"
  unfolding number_of_is_id ..


lemma less_Pls_Pls:
  "Numeral.Pls < Numeral.Pls <-> False" by simp 

lemma less_Pls_Min:
  "Numeral.Pls < Numeral.Min <-> False"
  unfolding Pls_def Numeral.Min_def  by presburger 

lemma less_Pls_Bit0:
  "Numeral.Pls < Numeral.Bit k bit.B0 <-> Numeral.Pls < k"
  unfolding Pls_def Bit_def by auto

lemma less_Pls_Bit1:
  "Numeral.Pls < Numeral.Bit k bit.B1 <-> Numeral.Pls ≤ k"
  unfolding Pls_def Bit_def by auto

lemma less_Min_Pls:
  "Numeral.Min < Numeral.Pls <-> True"
  unfolding Pls_def Numeral.Min_def by presburger 

lemma less_Min_Min:
  "Numeral.Min < Numeral.Min <-> False"  by simp

lemma less_Min_Bit:
  "Numeral.Min < Numeral.Bit k v <-> Numeral.Min < k"
  unfolding Numeral.Min_def Bit_def by (auto split: bit.split)

lemma less_Bit_Pls:
  "Numeral.Bit k v < Numeral.Pls <-> k < Numeral.Pls"
  unfolding Pls_def Bit_def by (auto split: bit.split)

lemma less_Bit0_Min:
  "Numeral.Bit k bit.B0 < Numeral.Min <-> k ≤ Numeral.Min"
  unfolding Numeral.Min_def Bit_def by auto

lemma less_Bit1_Min:
  "Numeral.Bit k bit.B1 < Numeral.Min <-> k < Numeral.Min"
  unfolding Numeral.Min_def Bit_def by auto

lemma less_Bit_Bit0:
  "Numeral.Bit k1 v < Numeral.Bit k2 bit.B0 <-> k1 < k2"
  unfolding Bit_def by (auto split: bit.split)

lemma less_Bit1_Bit:
  "Numeral.Bit k1 bit.B1 < Numeral.Bit k2 v <-> k1 < k2"
  unfolding Bit_def by (auto split: bit.split)

lemma less_Bit0_Bit1:
  "Numeral.Bit k1 bit.B0 < Numeral.Bit k2 bit.B1 <-> k1 ≤ k2"
  unfolding Bit_def bit.cases  by arith

lemma less_number_of:
  "(number_of k :: int) < number_of l <-> k < l"
  unfolding number_of_is_id ..

lemmas pred_succ_numeral_code [code func] =
  arith_simps(5-12)

lemmas plus_numeral_code [code func] =
  arith_simps(13-17)
  arith_simps(26-27)
  arith_extra_simps(1) [where 'a = int]

lemmas minus_numeral_code [code func] =
  arith_simps(18-21)
  arith_extra_simps(2) [where 'a = int]
  arith_extra_simps(5) [where 'a = int]

lemmas times_numeral_code [code func] =
  arith_simps(22-25)
  arith_extra_simps(4) [where 'a = int]

lemmas eq_numeral_code [code func] =
  eq_Pls_Pls eq_Pls_Min eq_Pls_Bit0 eq_Pls_Bit1
  eq_Min_Pls eq_Min_Min eq_Min_Bit0 eq_Min_Bit1
  eq_Bit0_Pls eq_Bit1_Pls eq_Bit0_Min eq_Bit1_Min eq_Bit_Bit
  eq_number_of

lemmas less_eq_numeral_code [code func] = less_eq_Pls_Pls less_eq_Pls_Min less_eq_Pls_Bit
  less_eq_Min_Pls less_eq_Min_Min less_eq_Min_Bit0 less_eq_Min_Bit1
  less_eq_Bit0_Pls less_eq_Bit1_Pls less_eq_Bit_Min less_eq_Bit0_Bit less_eq_Bit_Bit1 less_eq_Bit1_Bit0
  less_eq_number_of

lemmas less_numeral_code [code func] = less_Pls_Pls less_Pls_Min less_Pls_Bit0
  less_Pls_Bit1 less_Min_Pls less_Min_Min less_Min_Bit less_Bit_Pls
  less_Bit0_Min less_Bit1_Min less_Bit_Bit0 less_Bit1_Bit less_Bit0_Bit1
  less_number_of

context ring_1
begin

lemma of_int_num [code func]:
  "of_int k = (if k = 0 then 0 else if k < 0 then
     - of_int (- k) else let
       (l, m) = divAlg (k, 2);
       l' = of_int l
     in if m = 0 then l' + l' else l' + l' + 1)"
proof -
  have aux1: "k mod (2::int) ≠ (0::int) ==> 
    of_int k = of_int (k div 2 * 2 + 1)"
  proof -
    assume "k mod 2 ≠ 0"
    then have "k mod 2 = 1" by arith
    moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
    ultimately show ?thesis by auto
  qed
  have aux2: "!!x. of_int 2 * x = x + x"
  proof -
    fix x
    have int2: "(2::int) = 1 + 1" by arith
    show "of_int 2 * x = x + x"
    unfolding int2 of_int_add left_distrib by simp
  qed
  have aux3: "!!x. x * of_int 2 = x + x"
  proof -
    fix x
    have int2: "(2::int) = 1 + 1" by arith
    show "x * of_int 2 = x + x" 
    unfolding int2 of_int_add right_distrib by simp
  qed
  from aux1 show ?thesis by (auto simp add: divAlg_mod_div Let_def aux2 aux3)
qed

end

end

The @{text "-∞"} and @{text "+∞"} Properties

lemma minf:

  [| ∃z. ∀x<z. P x = P' x; ∃z. ∀x<z. Q x = Q' x |]
  ==> ∃z. ∀x<z. (P xQ x) = (P' xQ' x)
  [| ∃z. ∀x<z. P x = P' x; ∃z. ∀x<z. Q x = Q' x |]
  ==> ∃z. ∀x<z. (P xQ x) = (P' xQ' x)
  z. ∀x<z. (x = t) = False
  z. ∀x<z. (x  t) = True
  z. ∀x<z. (x < t) = True
  z. ∀x<z. (x  t) = True
  z. ∀x<z. (t < x) = False
  z. ∀x<z. (t  x) = False
  z. ∀x<z. (d dvd x + s) = (d dvd x + s)
  z. ∀x<z. (¬ d dvd x + s) = (¬ d dvd x + s)
  z. ∀x<z. F = F

lemma pinf:

  [| ∃z. ∀x>z. P x = P' x; ∃z. ∀x>z. Q x = Q' x |]
  ==> ∃z. ∀x>z. (P xQ x) = (P' xQ' x)
  [| ∃z. ∀x>z. P x = P' x; ∃z. ∀x>z. Q x = Q' x |]
  ==> ∃z. ∀x>z. (P xQ x) = (P' xQ' x)
  z. ∀x>z. (x = t) = False
  z. ∀x>z. (x  t) = True
  z. ∀x>z. (x < t) = False
  z. ∀x>z. (x  t) = False
  z. ∀x>z. (t < x) = True
  z. ∀x>z. (t  x) = True
  z. ∀x>z. (d dvd x + s) = (d dvd x + s)
  z. ∀x>z. (¬ d dvd x + s) = (¬ d dvd x + s)
  z. ∀x>z. F = F

lemma inf_period:

  [| ∀x k. P x = P (x - k * D); ∀x k. Q x = Q (x - k * D) |]
  ==> ∀x k. (P xQ x) = (P (x - k * D) ∧ Q (x - k * D))
  [| ∀x k. P x = P (x - k * D); ∀x k. Q x = Q (x - k * D) |]
  ==> ∀x k. (P xQ x) = (P (x - k * D) ∨ Q (x - k * D))
  d dvd D ==> ∀x k. (d dvd x + t) = (d dvd x - k * D + t)
  d dvd D ==> ∀x k. (¬ d dvd x + t) = (¬ d dvd x - k * D + t)
  x k. F = F

The A and B sets

lemma bset:

  [| ∀x. (∀j{1..D}. ∀bB. x  b + j) --> P x --> P (x - D);
     ∀x. (∀j{1..D}. ∀bB. x  b + j) --> Q x --> Q (x - D) |]
  ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> P xQ x --> P (x - D) ∧ Q (x - D)
  [| ∀x. (∀j{1..D}. ∀bB. x  b + j) --> P x --> P (x - D);
     ∀x. (∀j{1..D}. ∀bB. x  b + j) --> Q x --> Q (x - D) |]
  ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> P xQ x --> P (x - D) ∨ Q (x - D)
  [| 0 < D; t - 1B |]
  ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> x = t --> x - D = t
  [| 0 < D; tB |] ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> x  t --> x - D  t
  0 < D ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> x < t --> x - D < t
  0 < D ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> x  t --> x - D  t
  [| 0 < D; tB |] ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> t < x --> t < x - D
  [| 0 < D; t - 1B |]
  ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> t  x --> t  x - D
  d dvd D ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> d dvd x + t --> d dvd x - D + t
  d dvd D
  ==> ∀x. (∀j{1..D}. ∀bB. x  b + j) --> ¬ d dvd x + t --> ¬ d dvd x - D + t
  x. (∀j{1..D}. ∀bB. x  b + j) --> F --> F

lemma aset:

  [| ∀x. (∀j{1..D}. ∀bA. x  b - j) --> P x --> P (x + D);
     ∀x. (∀j{1..D}. ∀bA. x  b - j) --> Q x --> Q (x + D) |]
  ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> P xQ x --> P (x + D) ∧ Q (x + D)
  [| ∀x. (∀j{1..D}. ∀bA. x  b - j) --> P x --> P (x + D);
     ∀x. (∀j{1..D}. ∀bA. x  b - j) --> Q x --> Q (x + D) |]
  ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> P xQ x --> P (x + D) ∨ Q (x + D)
  [| 0 < D; t + 1A |]
  ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> x = t --> x + D = t
  [| 0 < D; tA |] ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> x  t --> x + D  t
  [| 0 < D; tA |] ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> x < t --> x + D < t
  [| 0 < D; t + 1A |]
  ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> x  t --> x + D  t
  0 < D ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> t < x --> t < x + D
  0 < D ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> t  x --> t  x + D
  d dvd D ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> d dvd x + t --> d dvd x + D + t
  d dvd D
  ==> ∀x. (∀j{1..D}. ∀bA. x  b - j) --> ¬ d dvd x + t --> ¬ d dvd x + D + t
  x. (∀j{1..D}. ∀bA. x  b - j) --> F --> F

Cooper's Theorem @{text "-∞"} and @{text "+∞"} Version

First some trivial facts about periodic sets or predicates

lemma periodic_finite_ex:

  [| 0 < d; ∀x k. P x = P (x - k * d) |] ==> (∃x. P x) = (∃j{1..d}. P j)

The @{text "-∞"} Version

lemma decr_lemma:

  0 < d ==> x - (¦x - z¦ + 1) * d < z

lemma incr_lemma:

  0 < d ==> z < x + (¦x - z¦ + 1) * d

theorem int_induct:

  [| P k; !!i. [| k  i; P i |] ==> P (i + 1);
     !!i. [| i  k; P i |] ==> P (i - 1) |]
  ==> P i

lemma decr_mult_lemma:

  [| 0 < d; ∀x. P x --> P (x - d); 0  k |] ==> ∀x. P x --> P (x - k * d)

lemma minusinfinity:

  [| 0 < d; ∀x k. P1.0 x = P1.0 (x - k * d); ∃z. ∀x<z. P x = P1.0 x |]
  ==> (∃x. P1.0 x) --> (∃x. P x)

lemma cpmi:

  [| 0 < D; ∃z. ∀x<z. P x = P' x;
     ∀x. (∀j{1..D}. ∀bB. x  b + j) --> P x --> P (x - D);
     ∀x k. P' x = P' (x - k * D) |]
  ==> (∃x. P x) = ((∃j{1..D}. P' j) ∨ (∃j{1..D}. ∃bB. P (b + j)))

The @{text "+∞"} Version

lemma plusinfinity:

  [| 0 < d; ∀x k. P' x = P' (x - k * d); ∃z. ∀x>z. P x = P' x |]
  ==> (∃x. P' x) --> (∃x. P x)

lemma incr_mult_lemma:

  [| 0 < d; ∀x. P x --> P (x + d); 0  k |] ==> ∀x. P x --> P (x + k * d)

lemma cppi:

  [| 0 < D; ∃z. ∀x>z. P x = P' x;
     ∀x. (∀j{1..D}. ∀bA. x  b - j) --> P x --> P (x + D);
     ∀x k. P' x = P' (x - k * D) |]
  ==> (∃x. P x) = ((∃j{1..D}. P' j) ∨ (∃j{1..D}. ∃bA. P (b - j)))

lemma simp_from_to:

  {i..j} = (if j < i then {} else insert i {i + 1..j})

theorem unity_coeff_ex:

  x. P (l * x) == ∃x. l dvd x + (0::'a) ∧ P x

lemma zdvd_mono:

  k  0 ==> m dvd t == k * m dvd k * t

lemma uminus_dvd_conv:

  d dvd t == - d dvd t
  d dvd t == d dvd - t

lemma all_nat:

  (∀x. P x) = (∀x0. P (nat x))

lemma ex_nat:

  (∃x. P x) = (∃x0. P (nat x))

lemma zdiff_int_split:

  P (int (x - y)) = ((y  x --> P (int x - int y)) ∧ (x < y --> P 0))

lemma number_of1:

  0  number_of n ==> 0  number_of (n BIT b)

lemma number_of2:

  0  Numeral0

lemma Suc_plus1:

  Suc n = n + 1

theorem imp_le_cong:

  (0  x ==> P = P') ==> (0  x --> P) = (0  x --> P')

theorem conj_le_cong:

  (0  x ==> P = P') ==> (0  xP) = (0  xP')

lemma int_eq_number_of_eq:

  (number_of v = number_of w) = iszero (number_of (v + - w))

lemma mod_eq0_dvd_iff:

  (m mod n = 0) = (n dvd m)

lemma zmod_eq0_zdvd_iff:

  (m mod n = 0) = (n dvd m)

lemma

  a div 0 = 0

and

  a mod 0 = a

lemma

  (m mod 2 = 1) = (¬ 2 dvd m)

lemma

  (m mod 2 = Suc 0) = (¬ 2 dvd m)

lemma

  (m mod Suc (Suc 0) = 1) = (¬ 2 dvd m)

lemma

  (m mod Suc (Suc 0) = Suc 0) = (¬ 2 dvd m)

lemma

  (m mod 2 = 1) = (¬ 2 dvd m)

lemma zdvd_period:

  a dvd d ==> (a dvd x + t) = (a dvd x + c * d + t)

Code generator setup

lemma eq_Pls_Pls:

  (Numeral.Pls = Numeral.Pls) = True

lemma eq_Pls_Min:

  (Numeral.Pls = Numeral.Min) = False

lemma eq_Pls_Bit0:

  (Numeral.Pls = k BIT bit.B0) = (Numeral.Pls = k)

lemma eq_Pls_Bit1:

  (Numeral.Pls = k BIT bit.B1) = False

lemma eq_Min_Pls:

  (Numeral.Min = Numeral.Pls) = False

lemma eq_Min_Min:

  (Numeral.Min = Numeral.Min) = True

lemma eq_Min_Bit0:

  (Numeral.Min = k BIT bit.B0) = False

lemma eq_Min_Bit1:

  (Numeral.Min = k BIT bit.B1) = (Numeral.Min = k)

lemma eq_Bit0_Pls:

  (k BIT bit.B0 = Numeral.Pls) = (Numeral.Pls = k)

lemma eq_Bit1_Pls:

  (k BIT bit.B1 = Numeral.Pls) = False

lemma eq_Bit0_Min:

  (k BIT bit.B0 = Numeral.Min) = False

lemma eq_Bit1_Min:

  (k BIT bit.B1 = Numeral.Min) = (Numeral.Min = k)

lemma eq_Bit_Bit:

  (k1.0 BIT v1.0 = k2.0 BIT v2.0) = (v1.0 = v2.0k1.0 = k2.0)

lemma eq_number_of:

  (number_of k = number_of l) = (k = l)

lemma less_eq_Pls_Pls:

  (Numeral.Pls  Numeral.Pls) = True

lemma less_eq_Pls_Min:

  (Numeral.Pls  Numeral.Min) = False

lemma less_eq_Pls_Bit:

  (Numeral.Pls  k BIT v) = (Numeral.Pls  k)

lemma less_eq_Min_Pls:

  (Numeral.Min  Numeral.Pls) = True

lemma less_eq_Min_Min:

  (Numeral.Min  Numeral.Min) = True

lemma less_eq_Min_Bit0:

  (Numeral.Min  k BIT bit.B0) = (Numeral.Min < k)

lemma less_eq_Min_Bit1:

  (Numeral.Min  k BIT bit.B1) = (Numeral.Min  k)

lemma less_eq_Bit0_Pls:

  (k BIT bit.B0  Numeral.Pls) = (k  Numeral.Pls)

lemma less_eq_Bit1_Pls:

  (k BIT bit.B1  Numeral.Pls) = (k < Numeral.Pls)

lemma less_eq_Bit_Min:

  (k BIT v  Numeral.Min) = (k  Numeral.Min)

lemma less_eq_Bit0_Bit:

  (k1.0 BIT bit.B0  k2.0 BIT v) = (k1.0  k2.0)

lemma less_eq_Bit_Bit1:

  (k1.0 BIT v  k2.0 BIT bit.B1) = (k1.0  k2.0)

lemma less_eq_Bit1_Bit0:

  (k1.0 BIT bit.B1  k2.0 BIT bit.B0) = (k1.0 < k2.0)

lemma less_eq_number_of:

  (number_of k  number_of l) = (k  l)

lemma less_Pls_Pls:

  (Numeral.Pls < Numeral.Pls) = False

lemma less_Pls_Min:

  (Numeral.Pls < Numeral.Min) = False

lemma less_Pls_Bit0:

  (Numeral.Pls < k BIT bit.B0) = (Numeral.Pls < k)

lemma less_Pls_Bit1:

  (Numeral.Pls < k BIT bit.B1) = (Numeral.Pls  k)

lemma less_Min_Pls:

  (Numeral.Min < Numeral.Pls) = True

lemma less_Min_Min:

  (Numeral.Min < Numeral.Min) = False

lemma less_Min_Bit:

  (Numeral.Min < k BIT v) = (Numeral.Min < k)

lemma less_Bit_Pls:

  (k BIT v < Numeral.Pls) = (k < Numeral.Pls)

lemma less_Bit0_Min:

  (k BIT bit.B0 < Numeral.Min) = (k  Numeral.Min)

lemma less_Bit1_Min:

  (k BIT bit.B1 < Numeral.Min) = (k < Numeral.Min)

lemma less_Bit_Bit0:

  (k1.0 BIT v < k2.0 BIT bit.B0) = (k1.0 < k2.0)

lemma less_Bit1_Bit:

  (k1.0 BIT bit.B1 < k2.0 BIT v) = (k1.0 < k2.0)

lemma less_Bit0_Bit1:

  (k1.0 BIT bit.B0 < k2.0 BIT bit.B1) = (k1.0  k2.0)

lemma less_number_of:

  (number_of k < number_of l) = (k < l)

lemma pred_succ_numeral_code:

  Numeral.pred Numeral.Pls = Numeral.Min
  Numeral.pred Numeral.Min = Numeral.Min BIT bit.B0
  Numeral.pred (k BIT bit.B1) = k BIT bit.B0
  Numeral.pred (k BIT bit.B0) = Numeral.pred k BIT bit.B1
  Numeral.succ Numeral.Pls = Numeral.Pls BIT bit.B1
  Numeral.succ Numeral.Min = Numeral.Pls
  Numeral.succ (k BIT bit.B1) = Numeral.succ k BIT bit.B0
  Numeral.succ (k BIT bit.B0) = k BIT bit.B1

lemma plus_numeral_code:

  Numeral.Pls + k = k
  Numeral.Min + k = Numeral.pred k
  k BIT bit.B0 + l BIT b = (k + l) BIT b
  k BIT bit.B1 + l BIT bit.B0 = (k + l) BIT bit.B1
  k BIT bit.B1 + l BIT bit.B1 = (k + Numeral.succ l) BIT bit.B0
  k + Numeral.Pls = k
  k + Numeral.Min = Numeral.pred k
  number_of v + number_of w = number_of (v + w)

lemma minus_numeral_code:

  - Numeral.Pls = Numeral.Pls
  - Numeral.Min = Numeral.Pls BIT bit.B1
  - k BIT bit.B1 = Numeral.pred (- k) BIT bit.B1
  - k BIT bit.B0 = (- k) BIT bit.B0
  - number_of w = number_of (- w)
  number_of v - number_of w = number_of (v + - w)

lemma times_numeral_code:

  Numeral.Pls * w = Numeral.Pls
  Numeral.Min * k = - k
  k BIT bit.B1 * l = (k * l) BIT bit.B0 + l
  k BIT bit.B0 * l = (k * l) BIT bit.B0
  number_of v * number_of w = number_of (v * w)

lemma eq_numeral_code:

  (Numeral.Pls = Numeral.Pls) = True
  (Numeral.Pls = Numeral.Min) = False
  (Numeral.Pls = k BIT bit.B0) = (Numeral.Pls = k)
  (Numeral.Pls = k BIT bit.B1) = False
  (Numeral.Min = Numeral.Pls) = False
  (Numeral.Min = Numeral.Min) = True
  (Numeral.Min = k BIT bit.B0) = False
  (Numeral.Min = k BIT bit.B1) = (Numeral.Min = k)
  (k BIT bit.B0 = Numeral.Pls) = (Numeral.Pls = k)
  (k BIT bit.B1 = Numeral.Pls) = False
  (k BIT bit.B0 = Numeral.Min) = False
  (k BIT bit.B1 = Numeral.Min) = (Numeral.Min = k)
  (k1.0 BIT v1.0 = k2.0 BIT v2.0) = (v1.0 = v2.0k1.0 = k2.0)
  (number_of k = number_of l) = (k = l)

lemma less_eq_numeral_code:

  (Numeral.Pls  Numeral.Pls) = True
  (Numeral.Pls  Numeral.Min) = False
  (Numeral.Pls  k BIT v) = (Numeral.Pls  k)
  (Numeral.Min  Numeral.Pls) = True
  (Numeral.Min  Numeral.Min) = True
  (Numeral.Min  k BIT bit.B0) = (Numeral.Min < k)
  (Numeral.Min  k BIT bit.B1) = (Numeral.Min  k)
  (k BIT bit.B0  Numeral.Pls) = (k  Numeral.Pls)
  (k BIT bit.B1  Numeral.Pls) = (k < Numeral.Pls)
  (k BIT v  Numeral.Min) = (k  Numeral.Min)
  (k1.0 BIT bit.B0  k2.0 BIT v) = (k1.0  k2.0)
  (k1.0 BIT v  k2.0 BIT bit.B1) = (k1.0  k2.0)
  (k1.0 BIT bit.B1  k2.0 BIT bit.B0) = (k1.0 < k2.0)
  (number_of k  number_of l) = (k  l)

lemma less_numeral_code:

  (Numeral.Pls < Numeral.Pls) = False
  (Numeral.Pls < Numeral.Min) = False
  (Numeral.Pls < k BIT bit.B0) = (Numeral.Pls < k)
  (Numeral.Pls < k BIT bit.B1) = (Numeral.Pls  k)
  (Numeral.Min < Numeral.Pls) = True
  (Numeral.Min < Numeral.Min) = False
  (Numeral.Min < k BIT v) = (Numeral.Min < k)
  (k BIT v < Numeral.Pls) = (k < Numeral.Pls)
  (k BIT bit.B0 < Numeral.Min) = (k  Numeral.Min)
  (k BIT bit.B1 < Numeral.Min) = (k < Numeral.Min)
  (k1.0 BIT v < k2.0 BIT bit.B0) = (k1.0 < k2.0)
  (k1.0 BIT bit.B1 < k2.0 BIT v) = (k1.0 < k2.0)
  (k1.0 BIT bit.B0 < k2.0 BIT bit.B1) = (k1.0  k2.0)
  (number_of k < number_of l) = (k < l)

lemma of_int_num:

  of_int k =
  (if k = 0 then 0::'a
   else if k < 0 then - of_int (- k)
        else let (l, m) = divAlg (k, 2); l' = of_int l
             in if m = 0 then l' + l' else l' + l' + (1::'a))