moved Integ files to canonical place;
authorwenzelm
Thu May 31 12:06:31 2007 +0200 (2007-05-31)
changeset 231460bc590051d95
parent 23145 5d8faadf3ecf
child 23147 a5db2f7d7654
moved Integ files to canonical place;
src/HOL/Integ/Presburger.thy
src/HOL/Integ/cooper_dec.ML
src/HOL/Integ/cooper_proof.ML
src/HOL/Integ/presburger.ML
src/HOL/Integ/qelim.ML
src/HOL/Integ/reflected_cooper.ML
src/HOL/Integ/reflected_presburger.ML
src/HOL/IsaMakefile
src/HOL/Presburger.thy
src/ZF/Bin.thy
src/ZF/EquivClass.thy
src/ZF/Int.thy
src/ZF/IntArith.thy
src/ZF/IntDiv.thy
src/ZF/Integ/Bin.thy
src/ZF/Integ/EquivClass.thy
src/ZF/Integ/Int.thy
src/ZF/Integ/IntArith.thy
src/ZF/Integ/IntDiv.thy
src/ZF/Integ/int_arith.ML
src/ZF/Integ/twos_compl.ML
src/ZF/IsaMakefile
src/ZF/ROOT.ML
src/ZF/Tools/numeral_syntax.ML
src/ZF/Tools/twos_compl.ML
src/ZF/int_arith.ML
     1.1 --- a/src/HOL/Integ/Presburger.thy	Thu May 31 11:00:06 2007 +0200
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,1279 +0,0 @@
     1.4 -(*  Title:      HOL/Integ/Presburger.thy
     1.5 -    ID:         $Id$
     1.6 -    Author:     Amine Chaieb, Tobias Nipkow and Stefan Berghofer, TU Muenchen
     1.7 -
     1.8 -File containing necessary theorems for the proof
     1.9 -generation for Cooper Algorithm  
    1.10 -*)
    1.11 -
    1.12 -header {* Presburger Arithmetic: Cooper's Algorithm *}
    1.13 -
    1.14 -theory Presburger
    1.15 -imports NatSimprocs "../SetInterval"
    1.16 -uses
    1.17 -  ("cooper_dec.ML") ("cooper_proof.ML") ("qelim.ML") 
    1.18 -  ("reflected_presburger.ML") ("reflected_cooper.ML") ("presburger.ML")
    1.19 -begin
    1.20 -
    1.21 -text {* Theorem for unitifying the coeffitients of @{text x} in an existential formula*}
    1.22 -
    1.23 -theorem unity_coeff_ex: "(\<exists>x::int. P (l * x)) = (\<exists>x. l dvd (1*x+0) \<and> P x)"
    1.24 -  apply (rule iffI)
    1.25 -  apply (erule exE)
    1.26 -  apply (rule_tac x = "l * x" in exI)
    1.27 -  apply simp
    1.28 -  apply (erule exE)
    1.29 -  apply (erule conjE)
    1.30 -  apply (erule dvdE)
    1.31 -  apply (rule_tac x = k in exI)
    1.32 -  apply simp
    1.33 -  done
    1.34 -
    1.35 -lemma uminus_dvd_conv: "(d dvd (t::int)) = (-d dvd t)"
    1.36 -apply(unfold dvd_def)
    1.37 -apply(rule iffI)
    1.38 -apply(clarsimp)
    1.39 -apply(rename_tac k)
    1.40 -apply(rule_tac x = "-k" in exI)
    1.41 -apply simp
    1.42 -apply(clarsimp)
    1.43 -apply(rename_tac k)
    1.44 -apply(rule_tac x = "-k" in exI)
    1.45 -apply simp
    1.46 -done
    1.47 -
    1.48 -lemma uminus_dvd_conv': "(d dvd (t::int)) = (d dvd -t)"
    1.49 -apply(unfold dvd_def)
    1.50 -apply(rule iffI)
    1.51 -apply(clarsimp)
    1.52 -apply(rule_tac x = "-k" in exI)
    1.53 -apply simp
    1.54 -apply(clarsimp)
    1.55 -apply(rule_tac x = "-k" in exI)
    1.56 -apply simp
    1.57 -done
    1.58 -
    1.59 -
    1.60 -
    1.61 -text {*Theorems for the combination of proofs of the equality of @{text P} and @{text P_m} for integers @{text x} less than some integer @{text z}.*}
    1.62 -
    1.63 -theorem eq_minf_conjI: "\<exists>z1::int. \<forall>x. x < z1 \<longrightarrow> (A1 x = A2 x) \<Longrightarrow>
    1.64 -  \<exists>z2::int. \<forall>x. x < z2 \<longrightarrow> (B1 x = B2 x) \<Longrightarrow>
    1.65 -  \<exists>z::int. \<forall>x. x < z \<longrightarrow> ((A1 x \<and> B1 x) = (A2 x \<and> B2 x))"
    1.66 -  apply (erule exE)+
    1.67 -  apply (rule_tac x = "min z1 z2" in exI)
    1.68 -  apply simp
    1.69 -  done
    1.70 -
    1.71 -
    1.72 -theorem eq_minf_disjI: "\<exists>z1::int. \<forall>x. x < z1 \<longrightarrow> (A1 x = A2 x) \<Longrightarrow>
    1.73 -  \<exists>z2::int. \<forall>x. x < z2 \<longrightarrow> (B1 x = B2 x) \<Longrightarrow>
    1.74 -  \<exists>z::int. \<forall>x. x < z \<longrightarrow> ((A1 x \<or> B1 x) = (A2 x \<or> B2 x))"
    1.75 -
    1.76 -  apply (erule exE)+
    1.77 -  apply (rule_tac x = "min z1 z2" in exI)
    1.78 -  apply simp
    1.79 -  done
    1.80 -
    1.81 -
    1.82 -text {*Theorems for the combination of proofs of the equality of @{text P} and @{text P_m} for integers @{text x} greather than some integer @{text z}.*}
    1.83 -
    1.84 -theorem eq_pinf_conjI: "\<exists>z1::int. \<forall>x. z1 < x \<longrightarrow> (A1 x = A2 x) \<Longrightarrow>
    1.85 -  \<exists>z2::int. \<forall>x. z2 < x \<longrightarrow> (B1 x = B2 x) \<Longrightarrow>
    1.86 -  \<exists>z::int. \<forall>x. z < x \<longrightarrow> ((A1 x \<and> B1 x) = (A2 x \<and> B2 x))"
    1.87 -  apply (erule exE)+
    1.88 -  apply (rule_tac x = "max z1 z2" in exI)
    1.89 -  apply simp
    1.90 -  done
    1.91 -
    1.92 -
    1.93 -theorem eq_pinf_disjI: "\<exists>z1::int. \<forall>x. z1 < x \<longrightarrow> (A1 x = A2 x) \<Longrightarrow>
    1.94 -  \<exists>z2::int. \<forall>x. z2 < x \<longrightarrow> (B1 x = B2 x) \<Longrightarrow>
    1.95 -  \<exists>z::int. \<forall>x. z < x  \<longrightarrow> ((A1 x \<or> B1 x) = (A2 x \<or> B2 x))"
    1.96 -  apply (erule exE)+
    1.97 -  apply (rule_tac x = "max z1 z2" in exI)
    1.98 -  apply simp
    1.99 -  done
   1.100 -
   1.101 -text {*
   1.102 -  \medskip Theorems for the combination of proofs of the modulo @{text
   1.103 -  D} property for @{text "P plusinfinity"}
   1.104 -
   1.105 -  FIXME: This is THE SAME theorem as for the @{text minusinf} version,
   1.106 -  but with @{text "+k.."} instead of @{text "-k.."} In the future
   1.107 -  replace these both with only one. *}
   1.108 -
   1.109 -theorem modd_pinf_conjI: "\<forall>(x::int) k. A x = A (x+k*d) \<Longrightarrow>
   1.110 -  \<forall>(x::int) k. B x = B (x+k*d) \<Longrightarrow>
   1.111 -  \<forall>(x::int) (k::int). (A x \<and> B x) = (A (x+k*d) \<and> B (x+k*d))"
   1.112 -  by simp
   1.113 -
   1.114 -theorem modd_pinf_disjI: "\<forall>(x::int) k. A x = A (x+k*d) \<Longrightarrow>
   1.115 -  \<forall>(x::int) k. B x = B (x+k*d) \<Longrightarrow>
   1.116 -  \<forall>(x::int) (k::int). (A x \<or> B x) = (A (x+k*d) \<or> B (x+k*d))"
   1.117 -  by simp
   1.118 -
   1.119 -text {*
   1.120 -  This is one of the cases where the simplifed formula is prooved to
   1.121 -  habe some property (in relation to @{text P_m}) but we need to prove
   1.122 -  the property for the original formula (@{text P_m})
   1.123 -
   1.124 -  FIXME: This is exaclty the same thm as for @{text minusinf}. *}
   1.125 -
   1.126 -lemma pinf_simp_eq: "ALL x. P(x) = Q(x) ==> (EX (x::int). P(x)) --> (EX (x::int). F(x))  ==> (EX (x::int). Q(x)) --> (EX (x::int). F(x)) "
   1.127 -  by blast
   1.128 -
   1.129 -
   1.130 -text {*
   1.131 -  \medskip Theorems for the combination of proofs of the modulo @{text D}
   1.132 -  property for @{text "P minusinfinity"} *}
   1.133 -
   1.134 -theorem modd_minf_conjI: "\<forall>(x::int) k. A x = A (x-k*d) \<Longrightarrow>
   1.135 -  \<forall>(x::int) k. B x = B (x-k*d) \<Longrightarrow>
   1.136 -  \<forall>(x::int) (k::int). (A x \<and> B x) = (A (x-k*d) \<and> B (x-k*d))"
   1.137 -  by simp
   1.138 -
   1.139 -theorem modd_minf_disjI: "\<forall>(x::int) k. A x = A (x-k*d) \<Longrightarrow>
   1.140 -  \<forall>(x::int) k. B x = B (x-k*d) \<Longrightarrow>
   1.141 -  \<forall>(x::int) (k::int). (A x \<or> B x) = (A (x-k*d) \<or> B (x-k*d))"
   1.142 -  by simp
   1.143 -
   1.144 -text {*
   1.145 -  This is one of the cases where the simplifed formula is prooved to
   1.146 -  have some property (in relation to @{text P_m}) but we need to
   1.147 -  prove the property for the original formula (@{text P_m}). *}
   1.148 -
   1.149 -lemma minf_simp_eq: "ALL x. P(x) = Q(x) ==> (EX (x::int). P(x)) --> (EX (x::int). F(x))  ==> (EX (x::int). Q(x)) --> (EX (x::int). F(x)) "
   1.150 -  by blast
   1.151 -
   1.152 -text {*
   1.153 -  Theorem needed for proving at runtime divide properties using the
   1.154 -  arithmetic tactic (which knows only about modulo = 0). *}
   1.155 -
   1.156 -lemma zdvd_iff_zmod_eq_0: "(m dvd n) = (n mod m = (0::int))"
   1.157 -  by(simp add:dvd_def zmod_eq_0_iff)
   1.158 -
   1.159 -text {*
   1.160 -  \medskip Theorems used for the combination of proof for the
   1.161 -  backwards direction of Cooper's Theorem. They rely exclusively on
   1.162 -  Predicate calculus.*}
   1.163 -
   1.164 -lemma not_ast_p_disjI: "(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> P1(x) --> P1(x + d))
   1.165 -==>
   1.166 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> P2(x) --> P2(x + d))
   1.167 -==>
   1.168 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) -->(P1(x) \<or> P2(x)) --> (P1(x + d) \<or> P2(x + d))) "
   1.169 -  by blast
   1.170 -
   1.171 -
   1.172 -lemma not_ast_p_conjI: "(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a- j)) --> P1(x) --> P1(x + d))
   1.173 -==>
   1.174 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> P2(x) --> P2(x + d))
   1.175 -==>
   1.176 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) -->(P1(x) \<and> P2(x)) --> (P1(x + d)
   1.177 -\<and> P2(x + d))) "
   1.178 -  by blast
   1.179 -
   1.180 -lemma not_ast_p_Q_elim: "
   1.181 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) -->P(x) --> P(x + d))
   1.182 -==> ( P = Q )
   1.183 -==> (ALL x. ~(EX (j::int) : {1..d}. EX (a::int) : A. P(a - j)) -->P(x) --> P(x + d))"
   1.184 -  by blast
   1.185 -
   1.186 -text {*
   1.187 -  \medskip Theorems used for the combination of proof for the
   1.188 -  backwards direction of Cooper's Theorem. They rely exclusively on
   1.189 -  Predicate calculus.*}
   1.190 -
   1.191 -lemma not_bst_p_disjI: "(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> P1(x) --> P1(x - d))
   1.192 -==>
   1.193 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> P2(x) --> P2(x - d))
   1.194 -==>
   1.195 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) -->(P1(x) \<or> P2(x)) --> (P1(x - d)
   1.196 -\<or> P2(x-d))) "
   1.197 -  by blast
   1.198 -
   1.199 -lemma not_bst_p_conjI: "(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> P1(x) --> P1(x - d))
   1.200 -==>
   1.201 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> P2(x) --> P2(x - d))
   1.202 -==>
   1.203 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) -->(P1(x) \<and> P2(x)) --> (P1(x - d)
   1.204 -\<and> P2(x-d))) "
   1.205 -  by blast
   1.206 -
   1.207 -lemma not_bst_p_Q_elim: "
   1.208 -(ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) -->P(x) --> P(x - d)) 
   1.209 -==> ( P = Q )
   1.210 -==> (ALL x. ~(EX (j::int) : {1..d}. EX (b::int) : B. P(b+j)) -->P(x) --> P(x - d))"
   1.211 -  by blast
   1.212 -
   1.213 -text {* \medskip This is the first direction of Cooper's Theorem. *}
   1.214 -lemma cooper_thm: "(R --> (EX x::int. P x))  ==> (Q -->(EX x::int.  P x )) ==> ((R|Q) --> (EX x::int. P x )) "
   1.215 -  by blast
   1.216 -
   1.217 -text {*
   1.218 -  \medskip The full Cooper's Theorem in its equivalence Form. Given
   1.219 -  the premises it is trivial too, it relies exclusively on prediacte calculus.*}
   1.220 -lemma cooper_eq_thm: "(R --> (EX x::int. P x))  ==> (Q -->(EX x::int.  P x )) ==> ((~Q)
   1.221 ---> (EX x::int. P x ) --> R) ==> (EX x::int. P x) = R|Q "
   1.222 -  by blast
   1.223 -
   1.224 -text {*
   1.225 -  \medskip Some of the atomic theorems generated each time the atom
   1.226 -  does not depend on @{text x}, they are trivial.*}
   1.227 -
   1.228 -lemma  fm_eq_minf: "EX z::int. ALL x. x < z --> (P = P) "
   1.229 -  by blast
   1.230 -
   1.231 -lemma  fm_modd_minf: "ALL (x::int). ALL (k::int). (P = P)"
   1.232 -  by blast
   1.233 -
   1.234 -lemma not_bst_p_fm: "ALL (x::int). Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> fm --> fm"
   1.235 -  by blast
   1.236 -
   1.237 -lemma  fm_eq_pinf: "EX z::int. ALL x. z < x --> (P = P) "
   1.238 -  by blast
   1.239 -
   1.240 -text {* The next two thms are the same as the @{text minusinf} version. *}
   1.241 -
   1.242 -lemma  fm_modd_pinf: "ALL (x::int). ALL (k::int). (P = P)"
   1.243 -  by blast
   1.244 -
   1.245 -lemma not_ast_p_fm: "ALL (x::int). Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> fm --> fm"
   1.246 -  by blast
   1.247 -
   1.248 -text {* Theorems to be deleted from simpset when proving simplified formulaes. *}
   1.249 -
   1.250 -lemma P_eqtrue: "(P=True) = P"
   1.251 -  by iprover
   1.252 -
   1.253 -lemma P_eqfalse: "(P=False) = (~P)"
   1.254 -  by iprover
   1.255 -
   1.256 -text {*
   1.257 -  \medskip Theorems for the generation of the bachwards direction of
   1.258 -  Cooper's Theorem.
   1.259 -
   1.260 -  These are the 6 interesting atomic cases which have to be proved relying on the
   1.261 -  properties of B-set and the arithmetic and contradiction proofs. *}
   1.262 -
   1.263 -lemma not_bst_p_lt: "0 < (d::int) ==>
   1.264 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> ( 0 < -x + a) --> (0 < -(x - d) + a )"
   1.265 -  by arith
   1.266 -
   1.267 -lemma not_bst_p_gt: "\<lbrakk> (g::int) \<in> B; g = -a \<rbrakk> \<Longrightarrow>
   1.268 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> (0 < (x) + a) --> ( 0 < (x - d) + a)"
   1.269 -apply clarsimp
   1.270 -apply(rule ccontr)
   1.271 -apply(drule_tac x = "x+a" in bspec)
   1.272 -apply(simp add:atLeastAtMost_iff)
   1.273 -apply(drule_tac x = "-a" in bspec)
   1.274 -apply assumption
   1.275 -apply(simp)
   1.276 -done
   1.277 -
   1.278 -lemma not_bst_p_eq: "\<lbrakk> 0 < d; (g::int) \<in> B; g = -a - 1 \<rbrakk> \<Longrightarrow>
   1.279 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> (0 = x + a) --> (0 = (x - d) + a )"
   1.280 -apply clarsimp
   1.281 -apply(subgoal_tac "x = -a")
   1.282 - prefer 2 apply arith
   1.283 -apply(drule_tac x = "1" in bspec)
   1.284 -apply(simp add:atLeastAtMost_iff)
   1.285 -apply(drule_tac x = "-a- 1" in bspec)
   1.286 -apply assumption
   1.287 -apply(simp)
   1.288 -done
   1.289 -
   1.290 -
   1.291 -lemma not_bst_p_ne: "\<lbrakk> 0 < d; (g::int) \<in> B; g = -a \<rbrakk> \<Longrightarrow>
   1.292 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> ~(0 = x + a) --> ~(0 = (x - d) + a)"
   1.293 -apply clarsimp
   1.294 -apply(subgoal_tac "x = -a+d")
   1.295 - prefer 2 apply arith
   1.296 -apply(drule_tac x = "d" in bspec)
   1.297 -apply(simp add:atLeastAtMost_iff)
   1.298 -apply(drule_tac x = "-a" in bspec)
   1.299 -apply assumption
   1.300 -apply(simp)
   1.301 -done
   1.302 -
   1.303 -
   1.304 -lemma not_bst_p_dvd: "(d1::int) dvd d ==>
   1.305 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> d1 dvd (x + a) --> d1 dvd ((x - d) + a )"
   1.306 -apply(clarsimp simp add:dvd_def)
   1.307 -apply(rename_tac m)
   1.308 -apply(rule_tac x = "m - k" in exI)
   1.309 -apply(simp add:int_distrib)
   1.310 -done
   1.311 -
   1.312 -lemma not_bst_p_ndvd: "(d1::int) dvd d ==>
   1.313 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (b::int) : B. Q(b+j)) --> ~(d1 dvd (x + a)) --> ~(d1 dvd ((x - d) + a ))"
   1.314 -apply(clarsimp simp add:dvd_def)
   1.315 -apply(rename_tac m)
   1.316 -apply(erule_tac x = "m + k" in allE)
   1.317 -apply(simp add:int_distrib)
   1.318 -done
   1.319 -
   1.320 -text {*
   1.321 -  \medskip Theorems for the generation of the bachwards direction of
   1.322 -  Cooper's Theorem.
   1.323 -
   1.324 -  These are the 6 interesting atomic cases which have to be proved
   1.325 -  relying on the properties of A-set ant the arithmetic and
   1.326 -  contradiction proofs. *}
   1.327 -
   1.328 -lemma not_ast_p_gt: "0 < (d::int) ==>
   1.329 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> ( 0 < x + t) --> (0 < (x + d) + t )"
   1.330 -  by arith
   1.331 -
   1.332 -lemma not_ast_p_lt: "\<lbrakk>0 < d ;(t::int) \<in> A \<rbrakk> \<Longrightarrow>
   1.333 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> (0 < -x + t) --> ( 0 < -(x + d) + t)"
   1.334 -  apply clarsimp
   1.335 -  apply (rule ccontr)
   1.336 -  apply (drule_tac x = "t-x" in bspec)
   1.337 -  apply simp
   1.338 -  apply (drule_tac x = "t" in bspec)
   1.339 -  apply assumption
   1.340 -  apply simp
   1.341 -  done
   1.342 -
   1.343 -lemma not_ast_p_eq: "\<lbrakk> 0 < d; (g::int) \<in> A; g = -t + 1 \<rbrakk> \<Longrightarrow>
   1.344 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> (0 = x + t) --> (0 = (x + d) + t )"
   1.345 -  apply clarsimp
   1.346 -  apply (drule_tac x="1" in bspec)
   1.347 -  apply simp
   1.348 -  apply (drule_tac x="- t + 1" in bspec)
   1.349 -  apply assumption
   1.350 -  apply(subgoal_tac "x = -t")
   1.351 -  prefer 2 apply arith
   1.352 -  apply simp
   1.353 -  done
   1.354 -
   1.355 -lemma not_ast_p_ne: "\<lbrakk> 0 < d; (g::int) \<in> A; g = -t \<rbrakk> \<Longrightarrow>
   1.356 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> ~(0 = x + t) --> ~(0 = (x + d) + t)"
   1.357 -  apply clarsimp
   1.358 -  apply (subgoal_tac "x = -t-d")
   1.359 -  prefer 2 apply arith
   1.360 -  apply (drule_tac x = "d" in bspec)
   1.361 -  apply simp
   1.362 -  apply (drule_tac x = "-t" in bspec)
   1.363 -  apply assumption
   1.364 -  apply simp
   1.365 -  done
   1.366 -
   1.367 -lemma not_ast_p_dvd: "(d1::int) dvd d ==>
   1.368 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> d1 dvd (x + t) --> d1 dvd ((x + d) + t )"
   1.369 -  apply(clarsimp simp add:dvd_def)
   1.370 -  apply(rename_tac m)
   1.371 -  apply(rule_tac x = "m + k" in exI)
   1.372 -  apply(simp add:int_distrib)
   1.373 -  done
   1.374 -
   1.375 -lemma not_ast_p_ndvd: "(d1::int) dvd d ==>
   1.376 - ALL x. Q(x::int) \<and> ~(EX (j::int) : {1..d}. EX (a::int) : A. Q(a - j)) --> ~(d1 dvd (x + t)) --> ~(d1 dvd ((x + d) + t ))"
   1.377 -  apply(clarsimp simp add:dvd_def)
   1.378 -  apply(rename_tac m)
   1.379 -  apply(erule_tac x = "m - k" in allE)
   1.380 -  apply(simp add:int_distrib)
   1.381 -  done
   1.382 -
   1.383 -text {*
   1.384 -  \medskip These are the atomic cases for the proof generation for the
   1.385 -  modulo @{text D} property for @{text "P plusinfinity"}
   1.386 -
   1.387 -  They are fully based on arithmetics. *}
   1.388 -
   1.389 -lemma  dvd_modd_pinf: "((d::int) dvd d1) ==>
   1.390 - (ALL (x::int). ALL (k::int). (((d::int) dvd (x + t)) = (d dvd (x+k*d1 + t))))"
   1.391 -  apply(clarsimp simp add:dvd_def)
   1.392 -  apply(rule iffI)
   1.393 -  apply(clarsimp)
   1.394 -  apply(rename_tac n m)
   1.395 -  apply(rule_tac x = "m + n*k" in exI)
   1.396 -  apply(simp add:int_distrib)
   1.397 -  apply(clarsimp)
   1.398 -  apply(rename_tac n m)
   1.399 -  apply(rule_tac x = "m - n*k" in exI)
   1.400 -  apply(simp add:int_distrib mult_ac)
   1.401 -  done
   1.402 -
   1.403 -lemma  not_dvd_modd_pinf: "((d::int) dvd d1) ==>
   1.404 - (ALL (x::int). ALL k. (~((d::int) dvd (x + t))) = (~(d dvd (x+k*d1 + t))))"
   1.405 -  apply(clarsimp simp add:dvd_def)
   1.406 -  apply(rule iffI)
   1.407 -  apply(clarsimp)
   1.408 -  apply(rename_tac n m)
   1.409 -  apply(erule_tac x = "m - n*k" in allE)
   1.410 -  apply(simp add:int_distrib mult_ac)
   1.411 -  apply(clarsimp)
   1.412 -  apply(rename_tac n m)
   1.413 -  apply(erule_tac x = "m + n*k" in allE)
   1.414 -  apply(simp add:int_distrib mult_ac)
   1.415 -  done
   1.416 -
   1.417 -text {*
   1.418 -  \medskip These are the atomic cases for the proof generation for the
   1.419 -  equivalence of @{text P} and @{text "P plusinfinity"} for integers
   1.420 -  @{text x} greater than some integer @{text z}.
   1.421 -
   1.422 -  They are fully based on arithmetics. *}
   1.423 -
   1.424 -lemma  eq_eq_pinf: "EX z::int. ALL x. z < x --> (( 0 = x +t ) = False )"
   1.425 -  apply(rule_tac x = "-t" in exI)
   1.426 -  apply simp
   1.427 -  done
   1.428 -
   1.429 -lemma  neq_eq_pinf: "EX z::int. ALL x.  z < x --> ((~( 0 = x +t )) = True )"
   1.430 -  apply(rule_tac x = "-t" in exI)
   1.431 -  apply simp
   1.432 -  done
   1.433 -
   1.434 -lemma  le_eq_pinf: "EX z::int. ALL x.  z < x --> ( 0 < x +t  = True )"
   1.435 -  apply(rule_tac x = "-t" in exI)
   1.436 -  apply simp
   1.437 -  done
   1.438 -
   1.439 -lemma  len_eq_pinf: "EX z::int. ALL x. z < x  --> (0 < -x +t  = False )"
   1.440 -  apply(rule_tac x = "t" in exI)
   1.441 -  apply simp
   1.442 -  done
   1.443 -
   1.444 -lemma  dvd_eq_pinf: "EX z::int. ALL x.  z < x --> ((d dvd (x + t)) = (d dvd (x + t))) "
   1.445 -  by simp
   1.446 -
   1.447 -lemma  not_dvd_eq_pinf: "EX z::int. ALL x. z < x  --> ((~(d dvd (x + t))) = (~(d dvd (x + t)))) "
   1.448 -  by simp
   1.449 -
   1.450 -text {*
   1.451 -  \medskip These are the atomic cases for the proof generation for the
   1.452 -  modulo @{text D} property for @{text "P minusinfinity"}.
   1.453 -
   1.454 -  They are fully based on arithmetics. *}
   1.455 -
   1.456 -lemma  dvd_modd_minf: "((d::int) dvd d1) ==>
   1.457 - (ALL (x::int). ALL (k::int). (((d::int) dvd (x + t)) = (d dvd (x-k*d1 + t))))"
   1.458 -apply(clarsimp simp add:dvd_def)
   1.459 -apply(rule iffI)
   1.460 -apply(clarsimp)
   1.461 -apply(rename_tac n m)
   1.462 -apply(rule_tac x = "m - n*k" in exI)
   1.463 -apply(simp add:int_distrib)
   1.464 -apply(clarsimp)
   1.465 -apply(rename_tac n m)
   1.466 -apply(rule_tac x = "m + n*k" in exI)
   1.467 -apply(simp add:int_distrib mult_ac)
   1.468 -done
   1.469 -
   1.470 -
   1.471 -lemma  not_dvd_modd_minf: "((d::int) dvd d1) ==>
   1.472 - (ALL (x::int). ALL k. (~((d::int) dvd (x + t))) = (~(d dvd (x-k*d1 + t))))"
   1.473 -apply(clarsimp simp add:dvd_def)
   1.474 -apply(rule iffI)
   1.475 -apply(clarsimp)
   1.476 -apply(rename_tac n m)
   1.477 -apply(erule_tac x = "m + n*k" in allE)
   1.478 -apply(simp add:int_distrib mult_ac)
   1.479 -apply(clarsimp)
   1.480 -apply(rename_tac n m)
   1.481 -apply(erule_tac x = "m - n*k" in allE)
   1.482 -apply(simp add:int_distrib mult_ac)
   1.483 -done
   1.484 -
   1.485 -text {*
   1.486 -  \medskip These are the atomic cases for the proof generation for the
   1.487 -  equivalence of @{text P} and @{text "P minusinfinity"} for integers
   1.488 -  @{text x} less than some integer @{text z}.
   1.489 -
   1.490 -  They are fully based on arithmetics. *}
   1.491 -
   1.492 -lemma  eq_eq_minf: "EX z::int. ALL x. x < z --> (( 0 = x +t ) = False )"
   1.493 -apply(rule_tac x = "-t" in exI)
   1.494 -apply simp
   1.495 -done
   1.496 -
   1.497 -lemma  neq_eq_minf: "EX z::int. ALL x. x < z --> ((~( 0 = x +t )) = True )"
   1.498 -apply(rule_tac x = "-t" in exI)
   1.499 -apply simp
   1.500 -done
   1.501 -
   1.502 -lemma  le_eq_minf: "EX z::int. ALL x. x < z --> ( 0 < x +t  = False )"
   1.503 -apply(rule_tac x = "-t" in exI)
   1.504 -apply simp
   1.505 -done
   1.506 -
   1.507 -
   1.508 -lemma  len_eq_minf: "EX z::int. ALL x. x < z --> (0 < -x +t  = True )"
   1.509 -apply(rule_tac x = "t" in exI)
   1.510 -apply simp
   1.511 -done
   1.512 -
   1.513 -lemma  dvd_eq_minf: "EX z::int. ALL x. x < z --> ((d dvd (x + t)) = (d dvd (x + t))) "
   1.514 -  by simp
   1.515 -
   1.516 -lemma  not_dvd_eq_minf: "EX z::int. ALL x. x < z --> ((~(d dvd (x + t))) = (~(d dvd (x + t)))) "
   1.517 -  by simp
   1.518 -
   1.519 -text {*
   1.520 -  \medskip This Theorem combines whithnesses about @{text "P
   1.521 -  minusinfinity"} to show one component of the equivalence proof for
   1.522 -  Cooper's Theorem.
   1.523 -
   1.524 -  FIXME: remove once they are part of the distribution. *}
   1.525 -
   1.526 -theorem int_ge_induct[consumes 1,case_names base step]:
   1.527 -  assumes ge: "k \<le> (i::int)" and
   1.528 -        base: "P(k)" and
   1.529 -        step: "\<And>i. \<lbrakk>k \<le> i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
   1.530 -  shows "P i"
   1.531 -proof -
   1.532 -  { fix n have "\<And>i::int. n = nat(i-k) \<Longrightarrow> k <= i \<Longrightarrow> P i"
   1.533 -    proof (induct n)
   1.534 -      case 0
   1.535 -      hence "i = k" by arith
   1.536 -      thus "P i" using base by simp
   1.537 -    next
   1.538 -      case (Suc n)
   1.539 -      hence "n = nat((i - 1) - k)" by arith
   1.540 -      moreover
   1.541 -      have ki1: "k \<le> i - 1" using Suc.prems by arith
   1.542 -      ultimately
   1.543 -      have "P(i - 1)" by(rule Suc.hyps)
   1.544 -      from step[OF ki1 this] show ?case by simp
   1.545 -    qed
   1.546 -  }
   1.547 -  from this ge show ?thesis by fast
   1.548 -qed
   1.549 -
   1.550 -theorem int_gr_induct[consumes 1,case_names base step]:
   1.551 -  assumes gr: "k < (i::int)" and
   1.552 -        base: "P(k+1)" and
   1.553 -        step: "\<And>i. \<lbrakk>k < i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
   1.554 -  shows "P i"
   1.555 -apply(rule int_ge_induct[of "k + 1"])
   1.556 -  using gr apply arith
   1.557 - apply(rule base)
   1.558 -apply(rule step)
   1.559 - apply simp+
   1.560 -done
   1.561 -
   1.562 -lemma decr_lemma: "0 < (d::int) \<Longrightarrow> x - (abs(x-z)+1) * d < z"
   1.563 -apply(induct rule: int_gr_induct)
   1.564 - apply simp
   1.565 -apply (simp add:int_distrib)
   1.566 -done
   1.567 -
   1.568 -lemma incr_lemma: "0 < (d::int) \<Longrightarrow> z < x + (abs(x-z)+1) * d"
   1.569 -apply(induct rule: int_gr_induct)
   1.570 - apply simp
   1.571 -apply (simp add:int_distrib)
   1.572 -done
   1.573 -
   1.574 -lemma  minusinfinity:
   1.575 -  assumes "0 < d" and
   1.576 -    P1eqP1: "ALL x k. P1 x = P1(x - k*d)" and
   1.577 -    ePeqP1: "EX z::int. ALL x. x < z \<longrightarrow> (P x = P1 x)"
   1.578 -  shows "(EX x. P1 x) \<longrightarrow> (EX x. P x)"
   1.579 -proof
   1.580 -  assume eP1: "EX x. P1 x"
   1.581 -  then obtain x where P1: "P1 x" ..
   1.582 -  from ePeqP1 obtain z where P1eqP: "ALL x. x < z \<longrightarrow> (P x = P1 x)" ..
   1.583 -  let ?w = "x - (abs(x-z)+1) * d"
   1.584 -  show "EX x. P x"
   1.585 -  proof
   1.586 -    have w: "?w < z" by(rule decr_lemma)
   1.587 -    have "P1 x = P1 ?w" using P1eqP1 by blast
   1.588 -    also have "\<dots> = P(?w)" using w P1eqP by blast
   1.589 -    finally show "P ?w" using P1 by blast
   1.590 -  qed
   1.591 -qed
   1.592 -
   1.593 -text {*
   1.594 -  \medskip This Theorem combines whithnesses about @{text "P
   1.595 -  minusinfinity"} to show one component of the equivalence proof for
   1.596 -  Cooper's Theorem. *}
   1.597 -
   1.598 -lemma plusinfinity:
   1.599 -  assumes "0 < d" and
   1.600 -    P1eqP1: "ALL (x::int) (k::int). P1 x = P1 (x + k * d)" and
   1.601 -    ePeqP1: "EX z::int. ALL x. z < x  --> (P x = P1 x)"
   1.602 -  shows "(EX x::int. P1 x) --> (EX x::int. P x)"
   1.603 -proof
   1.604 -  assume eP1: "EX x. P1 x"
   1.605 -  then obtain x where P1: "P1 x" ..
   1.606 -  from ePeqP1 obtain z where P1eqP: "ALL x. z < x \<longrightarrow> (P x = P1 x)" ..
   1.607 -  let ?w = "x + (abs(x-z)+1) * d"
   1.608 -  show "EX x. P x"
   1.609 -  proof
   1.610 -    have w: "z < ?w" by(rule incr_lemma)
   1.611 -    have "P1 x = P1 ?w" using P1eqP1 by blast
   1.612 -    also have "\<dots> = P(?w)" using w P1eqP by blast
   1.613 -    finally show "P ?w" using P1 by blast
   1.614 -  qed
   1.615 -qed
   1.616 - 
   1.617 -text {*
   1.618 -  \medskip Theorem for periodic function on discrete sets. *}
   1.619 -
   1.620 -lemma minf_vee:
   1.621 -  assumes dpos: "(0::int) < d" and modd: "ALL x k. P x = P(x - k*d)"
   1.622 -  shows "(EX x. P x) = (EX j : {1..d}. P j)"
   1.623 -  (is "?LHS = ?RHS")
   1.624 -proof
   1.625 -  assume ?LHS
   1.626 -  then obtain x where P: "P x" ..
   1.627 -  have "x mod d = x - (x div d)*d"
   1.628 -    by(simp add:zmod_zdiv_equality mult_ac eq_diff_eq)
   1.629 -  hence Pmod: "P x = P(x mod d)" using modd by simp
   1.630 -  show ?RHS
   1.631 -  proof (cases)
   1.632 -    assume "x mod d = 0"
   1.633 -    hence "P 0" using P Pmod by simp
   1.634 -    moreover have "P 0 = P(0 - (-1)*d)" using modd by blast
   1.635 -    ultimately have "P d" by simp
   1.636 -    moreover have "d : {1..d}" using dpos by(simp add:atLeastAtMost_iff)
   1.637 -    ultimately show ?RHS ..
   1.638 -  next
   1.639 -    assume not0: "x mod d \<noteq> 0"
   1.640 -    have "P(x mod d)" using dpos P Pmod by(simp add:pos_mod_sign pos_mod_bound)
   1.641 -    moreover have "x mod d : {1..d}"
   1.642 -    proof -
   1.643 -      have "0 \<le> x mod d" by(rule pos_mod_sign)
   1.644 -      moreover have "x mod d < d" by(rule pos_mod_bound)
   1.645 -      ultimately show ?thesis using not0 by(simp add:atLeastAtMost_iff)
   1.646 -    qed
   1.647 -    ultimately show ?RHS ..
   1.648 -  qed
   1.649 -next
   1.650 -  assume ?RHS thus ?LHS by blast
   1.651 -qed
   1.652 -
   1.653 -text {*
   1.654 -  \medskip Theorem for periodic function on discrete sets. *}
   1.655 -
   1.656 -lemma pinf_vee:
   1.657 -  assumes dpos: "0 < (d::int)" and modd: "ALL (x::int) (k::int). P x = P (x+k*d)"
   1.658 -  shows "(EX x::int. P x) = (EX (j::int) : {1..d} . P j)"
   1.659 -  (is "?LHS = ?RHS")
   1.660 -proof
   1.661 -  assume ?LHS
   1.662 -  then obtain x where P: "P x" ..
   1.663 -  have "x mod d = x + (-(x div d))*d"
   1.664 -    by(simp add:zmod_zdiv_equality mult_ac eq_diff_eq)
   1.665 -  hence Pmod: "P x = P(x mod d)" using modd by (simp only:)
   1.666 -  show ?RHS
   1.667 -  proof (cases)
   1.668 -    assume "x mod d = 0"
   1.669 -    hence "P 0" using P Pmod by simp
   1.670 -    moreover have "P 0 = P(0 + 1*d)" using modd by blast
   1.671 -    ultimately have "P d" by simp
   1.672 -    moreover have "d : {1..d}" using dpos by(simp add:atLeastAtMost_iff)
   1.673 -    ultimately show ?RHS ..
   1.674 -  next
   1.675 -    assume not0: "x mod d \<noteq> 0"
   1.676 -    have "P(x mod d)" using dpos P Pmod by(simp add:pos_mod_sign pos_mod_bound)
   1.677 -    moreover have "x mod d : {1..d}"
   1.678 -    proof -
   1.679 -      have "0 \<le> x mod d" by(rule pos_mod_sign)
   1.680 -      moreover have "x mod d < d" by(rule pos_mod_bound)
   1.681 -      ultimately show ?thesis using not0 by(simp add:atLeastAtMost_iff)
   1.682 -    qed
   1.683 -    ultimately show ?RHS ..
   1.684 -  qed
   1.685 -next
   1.686 -  assume ?RHS thus ?LHS by blast
   1.687 -qed
   1.688 -
   1.689 -lemma decr_mult_lemma:
   1.690 -  assumes dpos: "(0::int) < d" and
   1.691 -          minus: "ALL x::int. P x \<longrightarrow> P(x - d)" and
   1.692 -          knneg: "0 <= k"
   1.693 -  shows "ALL x. P x \<longrightarrow> P(x - k*d)"
   1.694 -using knneg
   1.695 -proof (induct rule:int_ge_induct)
   1.696 -  case base thus ?case by simp
   1.697 -next
   1.698 -  case (step i)
   1.699 -  show ?case
   1.700 -  proof
   1.701 -    fix x
   1.702 -    have "P x \<longrightarrow> P (x - i * d)" using step.hyps by blast
   1.703 -    also have "\<dots> \<longrightarrow> P(x - (i + 1) * d)"
   1.704 -      using minus[THEN spec, of "x - i * d"]
   1.705 -      by (simp add:int_distrib OrderedGroup.diff_diff_eq[symmetric])
   1.706 -    ultimately show "P x \<longrightarrow> P(x - (i + 1) * d)" by blast
   1.707 -  qed
   1.708 -qed
   1.709 -
   1.710 -lemma incr_mult_lemma:
   1.711 -  assumes dpos: "(0::int) < d" and
   1.712 -          plus: "ALL x::int. P x \<longrightarrow> P(x + d)" and
   1.713 -          knneg: "0 <= k"
   1.714 -  shows "ALL x. P x \<longrightarrow> P(x + k*d)"
   1.715 -using knneg
   1.716 -proof (induct rule:int_ge_induct)
   1.717 -  case base thus ?case by simp
   1.718 -next
   1.719 -  case (step i)
   1.720 -  show ?case
   1.721 -  proof
   1.722 -    fix x
   1.723 -    have "P x \<longrightarrow> P (x + i * d)" using step.hyps by blast
   1.724 -    also have "\<dots> \<longrightarrow> P(x + (i + 1) * d)"
   1.725 -      using plus[THEN spec, of "x + i * d"]
   1.726 -      by (simp add:int_distrib zadd_ac)
   1.727 -    ultimately show "P x \<longrightarrow> P(x + (i + 1) * d)" by blast
   1.728 -  qed
   1.729 -qed
   1.730 -
   1.731 -lemma cpmi_eq: "0 < D \<Longrightarrow> (EX z::int. ALL x. x < z --> (P x = P1 x))
   1.732 -==> ALL x.~(EX (j::int) : {1..D}. EX (b::int) : B. P(b+j)) --> P (x) --> P (x - D) 
   1.733 -==> (ALL (x::int). ALL (k::int). ((P1 x)= (P1 (x-k*D))))
   1.734 -==> (EX (x::int). P(x)) = ((EX (j::int) : {1..D} . (P1(j))) | (EX (j::int) : {1..D}. EX (b::int) : B. P (b+j)))"
   1.735 -apply(rule iffI)
   1.736 -prefer 2
   1.737 -apply(drule minusinfinity)
   1.738 -apply assumption+
   1.739 -apply(fastsimp)
   1.740 -apply clarsimp
   1.741 -apply(subgoal_tac "!!k. 0<=k \<Longrightarrow> !x. P x \<longrightarrow> P (x - k*D)")
   1.742 -apply(frule_tac x = x and z=z in decr_lemma)
   1.743 -apply(subgoal_tac "P1(x - (\<bar>x - z\<bar> + 1) * D)")
   1.744 -prefer 2
   1.745 -apply(subgoal_tac "0 <= (\<bar>x - z\<bar> + 1)")
   1.746 -prefer 2 apply arith
   1.747 - apply fastsimp
   1.748 -apply(drule (1) minf_vee)
   1.749 -apply blast
   1.750 -apply(blast dest:decr_mult_lemma)
   1.751 -done
   1.752 -
   1.753 -text {* Cooper Theorem, plus infinity version. *}
   1.754 -lemma cppi_eq: "0 < D \<Longrightarrow> (EX z::int. ALL x. z < x --> (P x = P1 x))
   1.755 -==> ALL x.~(EX (j::int) : {1..D}. EX (a::int) : A. P(a - j)) --> P (x) --> P (x + D) 
   1.756 -==> (ALL (x::int). ALL (k::int). ((P1 x)= (P1 (x+k*D))))
   1.757 -==> (EX (x::int). P(x)) = ((EX (j::int) : {1..D} . (P1(j))) | (EX (j::int) : {1..D}. EX (a::int) : A. P (a - j)))"
   1.758 -  apply(rule iffI)
   1.759 -  prefer 2
   1.760 -  apply(drule plusinfinity)
   1.761 -  apply assumption+
   1.762 -  apply(fastsimp)
   1.763 -  apply clarsimp
   1.764 -  apply(subgoal_tac "!!k. 0<=k \<Longrightarrow> !x. P x \<longrightarrow> P (x + k*D)")
   1.765 -  apply(frule_tac x = x and z=z in incr_lemma)
   1.766 -  apply(subgoal_tac "P1(x + (\<bar>x - z\<bar> + 1) * D)")
   1.767 -  prefer 2
   1.768 -  apply(subgoal_tac "0 <= (\<bar>x - z\<bar> + 1)")
   1.769 -  prefer 2 apply arith
   1.770 -  apply fastsimp
   1.771 -  apply(drule (1) pinf_vee)
   1.772 -  apply blast
   1.773 -  apply(blast dest:incr_mult_lemma)
   1.774 -  done
   1.775 -
   1.776 -
   1.777 -text {*
   1.778 -  \bigskip Theorems for the quantifier elminination Functions. *}
   1.779 -
   1.780 -lemma qe_ex_conj: "(EX (x::int). A x) = R
   1.781 -		==> (EX (x::int). P x) = (Q & (EX x::int. A x))
   1.782 -		==> (EX (x::int). P x) = (Q & R)"
   1.783 -by blast
   1.784 -
   1.785 -lemma qe_ex_nconj: "(EX (x::int). P x) = (True & Q)
   1.786 -		==> (EX (x::int). P x) = Q"
   1.787 -by blast
   1.788 -
   1.789 -lemma qe_conjI: "P1 = P2 ==> Q1 = Q2 ==> (P1 & Q1) = (P2 & Q2)"
   1.790 -by blast
   1.791 -
   1.792 -lemma qe_disjI: "P1 = P2 ==> Q1 = Q2 ==> (P1 | Q1) = (P2 | Q2)"
   1.793 -by blast
   1.794 -
   1.795 -lemma qe_impI: "P1 = P2 ==> Q1 = Q2 ==> (P1 --> Q1) = (P2 --> Q2)"
   1.796 -by blast
   1.797 -
   1.798 -lemma qe_eqI: "P1 = P2 ==> Q1 = Q2 ==> (P1 = Q1) = (P2 = Q2)"
   1.799 -by blast
   1.800 -
   1.801 -lemma qe_Not: "P = Q ==> (~P) = (~Q)"
   1.802 -by blast
   1.803 -
   1.804 -lemma qe_ALL: "(EX x. ~P x) = R ==> (ALL x. P x) = (~R)"
   1.805 -by blast
   1.806 -
   1.807 -text {* \bigskip Theorems for proving NNF *}
   1.808 -
   1.809 -lemma nnf_im: "((~P) = P1) ==> (Q=Q1) ==> ((P --> Q) = (P1 | Q1))"
   1.810 -by blast
   1.811 -
   1.812 -lemma nnf_eq: "((P & Q) = (P1 & Q1)) ==> (((~P) & (~Q)) = (P2 & Q2)) ==> ((P = Q) = ((P1 & Q1)|(P2 & Q2)))"
   1.813 -by blast
   1.814 -
   1.815 -lemma nnf_nn: "(P = Q) ==> ((~~P) = Q)"
   1.816 -  by blast
   1.817 -lemma nnf_ncj: "((~P) = P1) ==> ((~Q) = Q1) ==> ((~(P & Q)) = (P1 | Q1))"
   1.818 -by blast
   1.819 -
   1.820 -lemma nnf_ndj: "((~P) = P1) ==> ((~Q) = Q1) ==> ((~(P | Q)) = (P1 & Q1))"
   1.821 -by blast
   1.822 -lemma nnf_nim: "(P = P1) ==> ((~Q) = Q1) ==> ((~(P --> Q)) = (P1 & Q1))"
   1.823 -by blast
   1.824 -lemma nnf_neq: "((P & (~Q)) = (P1 & Q1)) ==> (((~P) & Q) = (P2 & Q2)) ==> ((~(P = Q)) = ((P1 & Q1)|(P2 & Q2)))"
   1.825 -by blast
   1.826 -lemma nnf_sdj: "((A & (~B)) = (A1 & B1)) ==> ((C & (~D)) = (C1 & D1)) ==> (A = (~C)) ==> ((~((A & B) | (C & D))) = ((A1 & B1) | (C1 & D1)))"
   1.827 -by blast
   1.828 -
   1.829 -
   1.830 -lemma qe_exI2: "A = B ==> (EX (x::int). A(x)) = (EX (x::int). B(x))"
   1.831 -  by simp
   1.832 -
   1.833 -lemma qe_exI: "(!!x::int. A x = B x) ==> (EX (x::int). A(x)) = (EX (x::int). B(x))"
   1.834 -  by iprover
   1.835 -
   1.836 -lemma qe_ALLI: "(!!x::int. A x = B x) ==> (ALL (x::int). A(x)) = (ALL (x::int). B(x))"
   1.837 -  by iprover
   1.838 -
   1.839 -lemma cp_expand: "(EX (x::int). P (x)) = (EX (j::int) : {1..d}. EX (b::int) : B. (P1 (j) | P(b+j)))
   1.840 -==>(EX (x::int). P (x)) = (EX (j::int) : {1..d}. EX (b::int) : B. (P1 (j) | P(b+j))) "
   1.841 -by blast
   1.842 -
   1.843 -lemma cppi_expand: "(EX (x::int). P (x)) = (EX (j::int) : {1..d}. EX (a::int) : A. (P1 (j) | P(a - j)))
   1.844 -==>(EX (x::int). P (x)) = (EX (j::int) : {1..d}. EX (a::int) : A. (P1 (j) | P(a - j))) "
   1.845 -by blast
   1.846 -
   1.847 -
   1.848 -lemma simp_from_to: "{i..j::int} = (if j < i then {} else insert i {i+1..j})"
   1.849 -apply(simp add:atLeastAtMost_def atLeast_def atMost_def)
   1.850 -apply(fastsimp)
   1.851 -done
   1.852 -
   1.853 -text {* \bigskip Theorems required for the @{text adjustcoeffitienteq} *}
   1.854 -
   1.855 -lemma ac_dvd_eq: assumes not0: "0 ~= (k::int)"
   1.856 -shows "((m::int) dvd (c*n+t)) = (k*m dvd ((k*c)*n+(k*t)))" (is "?P = ?Q")
   1.857 -proof
   1.858 -  assume ?P
   1.859 -  thus ?Q
   1.860 -    apply(simp add:dvd_def)
   1.861 -    apply clarify
   1.862 -    apply(rename_tac d)
   1.863 -    apply(drule_tac f = "op * k" in arg_cong)
   1.864 -    apply(simp only:int_distrib)
   1.865 -    apply(rule_tac x = "d" in exI)
   1.866 -    apply(simp only:mult_ac)
   1.867 -    done
   1.868 -next
   1.869 -  assume ?Q
   1.870 -  then obtain d where "k * c * n + k * t = (k*m)*d" by(fastsimp simp:dvd_def)
   1.871 -  hence "(c * n + t) * k = (m*d) * k" by(simp add:int_distrib mult_ac)
   1.872 -  hence "((c * n + t) * k) div k = ((m*d) * k) div k" by(rule arg_cong[of _ _ "%t. t div k"])
   1.873 -  hence "c*n+t = m*d" by(simp add: zdiv_zmult_self1[OF not0[symmetric]])
   1.874 -  thus ?P by(simp add:dvd_def)
   1.875 -qed
   1.876 -
   1.877 -lemma ac_lt_eq: assumes gr0: "0 < (k::int)"
   1.878 -shows "((m::int) < (c*n+t)) = (k*m <((k*c)*n+(k*t)))" (is "?P = ?Q")
   1.879 -proof
   1.880 -  assume P: ?P
   1.881 -  show ?Q using zmult_zless_mono2[OF P gr0] by(simp add: int_distrib mult_ac)
   1.882 -next
   1.883 -  assume ?Q
   1.884 -  hence "0 < k*(c*n + t - m)" by(simp add: int_distrib mult_ac)
   1.885 -  with gr0 have "0 < (c*n + t - m)" by(simp add: zero_less_mult_iff)
   1.886 -  thus ?P by(simp)
   1.887 -qed
   1.888 -
   1.889 -lemma ac_eq_eq : assumes not0: "0 ~= (k::int)" shows "((m::int) = (c*n+t)) = (k*m =((k*c)*n+(k*t)) )" (is "?P = ?Q")
   1.890 -proof
   1.891 -  assume ?P
   1.892 -  thus ?Q
   1.893 -    apply(drule_tac f = "op * k" in arg_cong)
   1.894 -    apply(simp only:int_distrib)
   1.895 -    done
   1.896 -next
   1.897 -  assume ?Q
   1.898 -  hence "m * k = (c*n + t) * k" by(simp add:int_distrib mult_ac)
   1.899 -  hence "((m) * k) div k = ((c*n + t) * k) div k" by(rule arg_cong[of _ _ "%t. t div k"])
   1.900 -  thus ?P by(simp add: zdiv_zmult_self1[OF not0[symmetric]])
   1.901 -qed
   1.902 -
   1.903 -lemma ac_pi_eq: assumes gr0: "0 < (k::int)" shows "(~((0::int) < (c*n + t))) = (0 < ((-k)*c)*n + ((-k)*t + k))"
   1.904 -proof -
   1.905 -  have "(~ (0::int) < (c*n + t)) = (0<1-(c*n + t))" by arith
   1.906 -  also have  "(1-(c*n + t)) = (-1*c)*n + (-t+1)" by(simp add: int_distrib mult_ac)
   1.907 -  also have "0<(-1*c)*n + (-t+1) = (0 < (k*(-1*c)*n) + (k*(-t+1)))" by(rule ac_lt_eq[of _ 0,OF gr0,simplified])
   1.908 -  also have "(k*(-1*c)*n) + (k*(-t+1)) = ((-k)*c)*n + ((-k)*t + k)" by(simp add: int_distrib mult_ac)
   1.909 -  finally show ?thesis .
   1.910 -qed
   1.911 -
   1.912 -lemma binminus_uminus_conv: "(a::int) - b = a + (-b)"
   1.913 -by arith
   1.914 -
   1.915 -lemma  linearize_dvd: "(t::int) = t1 ==> (d dvd t) = (d dvd t1)"
   1.916 -by simp
   1.917 -
   1.918 -lemma lf_lt: "(l::int) = ll ==> (r::int) = lr ==> (l < r) =(ll < lr)"
   1.919 -by simp
   1.920 -
   1.921 -lemma lf_eq: "(l::int) = ll ==> (r::int) = lr ==> (l = r) =(ll = lr)"
   1.922 -by simp
   1.923 -
   1.924 -lemma lf_dvd: "(l::int) = ll ==> (r::int) = lr ==> (l dvd r) =(ll dvd lr)"
   1.925 -by simp
   1.926 -
   1.927 -text {* \bigskip Theorems for transforming predicates on nat to predicates on @{text int}*}
   1.928 -
   1.929 -theorem all_nat: "(\<forall>x::nat. P x) = (\<forall>x::int. 0 <= x \<longrightarrow> P (nat x))"
   1.930 -  by (simp split add: split_nat)
   1.931 -
   1.932 -
   1.933 -theorem zdiff_int_split: "P (int (x - y)) =
   1.934 -  ((y \<le> x \<longrightarrow> P (int x - int y)) \<and> (x < y \<longrightarrow> P 0))"
   1.935 -  apply (case_tac "y \<le> x")
   1.936 -  apply (simp_all add: zdiff_int)
   1.937 -  done
   1.938 -
   1.939 -
   1.940 -theorem number_of1: "(0::int) <= number_of n \<Longrightarrow> (0::int) <= number_of (n BIT b)"
   1.941 -  by simp
   1.942 -
   1.943 -theorem number_of2: "(0::int) <= Numeral0" by simp
   1.944 -
   1.945 -theorem Suc_plus1: "Suc n = n + 1" by simp
   1.946 -
   1.947 -text {*
   1.948 -  \medskip Specific instances of congruence rules, to prevent
   1.949 -  simplifier from looping. *}
   1.950 -
   1.951 -theorem imp_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<longrightarrow> P) = (0 <= x \<longrightarrow> P')"
   1.952 -  by simp
   1.953 -
   1.954 -theorem conj_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<and> P) = (0 <= x \<and> P')"
   1.955 -  by (simp cong: conj_cong)
   1.956 -
   1.957 -    (* Theorems used in presburger.ML for the computation simpset*)
   1.958 -    (* FIXME: They are present in Float.thy, so may be Float.thy should be lightened.*)
   1.959 -
   1.960 -lemma lift_bool: "x \<Longrightarrow> x=True"
   1.961 -  by simp
   1.962 -
   1.963 -lemma nlift_bool: "~x \<Longrightarrow> x=False"
   1.964 -  by simp
   1.965 -
   1.966 -lemma not_false_eq_true: "(~ False) = True" by simp
   1.967 -
   1.968 -lemma not_true_eq_false: "(~ True) = False" by simp
   1.969 -
   1.970 -
   1.971 -lemma int_eq_number_of_eq:
   1.972 -  "(((number_of v)::int) = (number_of w)) = iszero ((number_of (v + (uminus w)))::int)"
   1.973 -  by simp
   1.974 -lemma int_iszero_number_of_Pls: "iszero (Numeral0::int)" 
   1.975 -  by (simp only: iszero_number_of_Pls)
   1.976 -
   1.977 -lemma int_nonzero_number_of_Min: "~(iszero ((-1)::int))"
   1.978 -  by simp
   1.979 -
   1.980 -lemma int_iszero_number_of_0: "iszero ((number_of (w BIT bit.B0))::int) = iszero ((number_of w)::int)"
   1.981 -  by simp
   1.982 -
   1.983 -lemma int_iszero_number_of_1: "\<not> iszero ((number_of (w BIT bit.B1))::int)" 
   1.984 -  by simp
   1.985 -
   1.986 -lemma int_less_number_of_eq_neg: "(((number_of x)::int) < number_of y) = neg ((number_of (x + (uminus y)))::int)"
   1.987 -  by simp
   1.988 -
   1.989 -lemma int_not_neg_number_of_Pls: "\<not> (neg (Numeral0::int))" 
   1.990 -  by simp
   1.991 -
   1.992 -lemma int_neg_number_of_Min: "neg (-1::int)"
   1.993 -  by simp
   1.994 -
   1.995 -lemma int_neg_number_of_BIT: "neg ((number_of (w BIT x))::int) = neg ((number_of w)::int)"
   1.996 -  by simp
   1.997 -
   1.998 -lemma int_le_number_of_eq: "(((number_of x)::int) \<le> number_of y) = (\<not> neg ((number_of (y + (uminus x)))::int))"
   1.999 -  by simp
  1.1000 -lemma int_number_of_add_sym: "((number_of v)::int) + number_of w = number_of (v + w)"
  1.1001 -  by simp
  1.1002 -
  1.1003 -lemma int_number_of_diff_sym:
  1.1004 -  "((number_of v)::int) - number_of w = number_of (v + (uminus w))"
  1.1005 -  by simp
  1.1006 -
  1.1007 -lemma int_number_of_mult_sym:
  1.1008 -  "((number_of v)::int) * number_of w = number_of (v * w)"
  1.1009 -  by simp
  1.1010 -
  1.1011 -lemma int_number_of_minus_sym: "- ((number_of v)::int) = number_of (uminus v)"
  1.1012 -  by simp
  1.1013 -lemma add_left_zero: "0 + a = (a::'a::comm_monoid_add)"
  1.1014 -  by simp
  1.1015 -
  1.1016 -lemma add_right_zero: "a + 0 = (a::'a::comm_monoid_add)"
  1.1017 -  by simp
  1.1018 -
  1.1019 -lemma mult_left_one: "1 * a = (a::'a::semiring_1)"
  1.1020 -  by simp
  1.1021 -
  1.1022 -lemma mult_right_one: "a * 1 = (a::'a::semiring_1)"
  1.1023 -  by simp
  1.1024 -
  1.1025 -lemma int_pow_0: "(a::int)^(Numeral0) = 1"
  1.1026 -  by simp
  1.1027 -
  1.1028 -lemma int_pow_1: "(a::int)^(Numeral1) = a"
  1.1029 -  by simp
  1.1030 -
  1.1031 -lemma zero_eq_Numeral0_nring: "(0::'a::number_ring) = Numeral0"
  1.1032 -  by simp
  1.1033 -
  1.1034 -lemma one_eq_Numeral1_nring: "(1::'a::number_ring) = Numeral1"
  1.1035 -  by simp
  1.1036 -
  1.1037 -lemma zero_eq_Numeral0_nat: "(0::nat) = Numeral0"
  1.1038 -  by simp
  1.1039 -
  1.1040 -lemma one_eq_Numeral1_nat: "(1::nat) = Numeral1"
  1.1041 -  by simp
  1.1042 -
  1.1043 -lemma zpower_Pls: "(z::int)^Numeral0 = Numeral1"
  1.1044 -  by simp
  1.1045 -
  1.1046 -lemma zpower_Min: "(z::int)^((-1)::nat) = Numeral1"
  1.1047 -proof -
  1.1048 -  have 1:"((-1)::nat) = 0"
  1.1049 -    by simp
  1.1050 -  show ?thesis by (simp add: 1)
  1.1051 -qed
  1.1052 -
  1.1053 -use "cooper_dec.ML"
  1.1054 -use "reflected_presburger.ML" 
  1.1055 -use "reflected_cooper.ML"
  1.1056 -oracle
  1.1057 -  presburger_oracle ("term") = ReflectedCooper.presburger_oracle
  1.1058 -
  1.1059 -use "cooper_proof.ML"
  1.1060 -use "qelim.ML"
  1.1061 -use "presburger.ML"
  1.1062 -
  1.1063 -setup "Presburger.setup"
  1.1064 -
  1.1065 -
  1.1066 -subsection {* Code generator setup *}
  1.1067 -
  1.1068 -text {*
  1.1069 -  Presburger arithmetic is convenient to prove some
  1.1070 -  of the following code lemmas on integer numerals:
  1.1071 -*}
  1.1072 -
  1.1073 -lemma eq_Pls_Pls:
  1.1074 -  "Numeral.Pls = Numeral.Pls \<longleftrightarrow> True" by rule+
  1.1075 -
  1.1076 -lemma eq_Pls_Min:
  1.1077 -  "Numeral.Pls = Numeral.Min \<longleftrightarrow> False"
  1.1078 -  unfolding Pls_def Min_def by auto
  1.1079 -
  1.1080 -lemma eq_Pls_Bit0:
  1.1081 -  "Numeral.Pls = Numeral.Bit k bit.B0 \<longleftrightarrow> Numeral.Pls = k"
  1.1082 -  unfolding Pls_def Bit_def bit.cases by auto
  1.1083 -
  1.1084 -lemma eq_Pls_Bit1:
  1.1085 -  "Numeral.Pls = Numeral.Bit k bit.B1 \<longleftrightarrow> False"
  1.1086 -  unfolding Pls_def Bit_def bit.cases by arith
  1.1087 -
  1.1088 -lemma eq_Min_Pls:
  1.1089 -  "Numeral.Min = Numeral.Pls \<longleftrightarrow> False"
  1.1090 -  unfolding Pls_def Min_def by auto
  1.1091 -
  1.1092 -lemma eq_Min_Min:
  1.1093 -  "Numeral.Min = Numeral.Min \<longleftrightarrow> True" by rule+
  1.1094 -
  1.1095 -lemma eq_Min_Bit0:
  1.1096 -  "Numeral.Min = Numeral.Bit k bit.B0 \<longleftrightarrow> False"
  1.1097 -  unfolding Min_def Bit_def bit.cases by arith
  1.1098 -
  1.1099 -lemma eq_Min_Bit1:
  1.1100 -  "Numeral.Min = Numeral.Bit k bit.B1 \<longleftrightarrow> Numeral.Min = k"
  1.1101 -  unfolding Min_def Bit_def bit.cases by auto
  1.1102 -
  1.1103 -lemma eq_Bit0_Pls:
  1.1104 -  "Numeral.Bit k bit.B0 = Numeral.Pls \<longleftrightarrow> Numeral.Pls = k"
  1.1105 -  unfolding Pls_def Bit_def bit.cases by auto
  1.1106 -
  1.1107 -lemma eq_Bit1_Pls:
  1.1108 -  "Numeral.Bit k bit.B1 = Numeral.Pls \<longleftrightarrow> False"
  1.1109 -  unfolding Pls_def Bit_def bit.cases by arith
  1.1110 -
  1.1111 -lemma eq_Bit0_Min:
  1.1112 -  "Numeral.Bit k bit.B0 = Numeral.Min \<longleftrightarrow> False"
  1.1113 -  unfolding Min_def Bit_def bit.cases by arith
  1.1114 -
  1.1115 -lemma eq_Bit1_Min:
  1.1116 -  "(Numeral.Bit k bit.B1) = Numeral.Min \<longleftrightarrow> Numeral.Min = k"
  1.1117 -  unfolding Min_def Bit_def bit.cases by auto
  1.1118 -
  1.1119 -lemma eq_Bit_Bit:
  1.1120 -  "Numeral.Bit k1 v1 = Numeral.Bit k2 v2 \<longleftrightarrow>
  1.1121 -    v1 = v2 \<and> k1 = k2"
  1.1122 -  unfolding Bit_def
  1.1123 -  apply (cases v1)
  1.1124 -  apply (cases v2)
  1.1125 -  apply auto
  1.1126 -  apply arith
  1.1127 -  apply (cases v2)
  1.1128 -  apply auto
  1.1129 -  apply arith
  1.1130 -  apply (cases v2)
  1.1131 -  apply auto
  1.1132 -done
  1.1133 -
  1.1134 -lemma eq_number_of:
  1.1135 -  "(number_of k \<Colon> int) = number_of l \<longleftrightarrow> k = l"
  1.1136 -  unfolding number_of_is_id ..
  1.1137 -
  1.1138 -
  1.1139 -lemma less_eq_Pls_Pls:
  1.1140 -  "Numeral.Pls \<le> Numeral.Pls \<longleftrightarrow> True" by rule+
  1.1141 -
  1.1142 -lemma less_eq_Pls_Min:
  1.1143 -  "Numeral.Pls \<le> Numeral.Min \<longleftrightarrow> False"
  1.1144 -  unfolding Pls_def Min_def by auto
  1.1145 -
  1.1146 -lemma less_eq_Pls_Bit:
  1.1147 -  "Numeral.Pls \<le> Numeral.Bit k v \<longleftrightarrow> Numeral.Pls \<le> k"
  1.1148 -  unfolding Pls_def Bit_def by (cases v) auto
  1.1149 -
  1.1150 -lemma less_eq_Min_Pls:
  1.1151 -  "Numeral.Min \<le> Numeral.Pls \<longleftrightarrow> True"
  1.1152 -  unfolding Pls_def Min_def by auto
  1.1153 -
  1.1154 -lemma less_eq_Min_Min:
  1.1155 -  "Numeral.Min \<le> Numeral.Min \<longleftrightarrow> True" by rule+
  1.1156 -
  1.1157 -lemma less_eq_Min_Bit0:
  1.1158 -  "Numeral.Min \<le> Numeral.Bit k bit.B0 \<longleftrightarrow> Numeral.Min < k"
  1.1159 -  unfolding Min_def Bit_def by auto
  1.1160 -
  1.1161 -lemma less_eq_Min_Bit1:
  1.1162 -  "Numeral.Min \<le> Numeral.Bit k bit.B1 \<longleftrightarrow> Numeral.Min \<le> k"
  1.1163 -  unfolding Min_def Bit_def by auto
  1.1164 -
  1.1165 -lemma less_eq_Bit0_Pls:
  1.1166 -  "Numeral.Bit k bit.B0 \<le> Numeral.Pls \<longleftrightarrow> k \<le> Numeral.Pls"
  1.1167 -  unfolding Pls_def Bit_def by simp
  1.1168 -
  1.1169 -lemma less_eq_Bit1_Pls:
  1.1170 -  "Numeral.Bit k bit.B1 \<le> Numeral.Pls \<longleftrightarrow> k < Numeral.Pls"
  1.1171 -  unfolding Pls_def Bit_def by auto
  1.1172 -
  1.1173 -lemma less_eq_Bit_Min:
  1.1174 -  "Numeral.Bit k v \<le> Numeral.Min \<longleftrightarrow> k \<le> Numeral.Min"
  1.1175 -  unfolding Min_def Bit_def by (cases v) auto
  1.1176 -
  1.1177 -lemma less_eq_Bit0_Bit:
  1.1178 -  "Numeral.Bit k1 bit.B0 \<le> Numeral.Bit k2 v \<longleftrightarrow> k1 \<le> k2"
  1.1179 -  unfolding Bit_def bit.cases by (cases v) auto
  1.1180 -
  1.1181 -lemma less_eq_Bit_Bit1:
  1.1182 -  "Numeral.Bit k1 v \<le> Numeral.Bit k2 bit.B1 \<longleftrightarrow> k1 \<le> k2"
  1.1183 -  unfolding Bit_def bit.cases by (cases v) auto
  1.1184 -
  1.1185 -lemma less_eq_Bit1_Bit0:
  1.1186 -  "Numeral.Bit k1 bit.B1 \<le> Numeral.Bit k2 bit.B0 \<longleftrightarrow> k1 < k2"
  1.1187 -  unfolding Bit_def by (auto split: bit.split)
  1.1188 -
  1.1189 -lemma less_eq_number_of:
  1.1190 -  "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
  1.1191 -  unfolding number_of_is_id ..
  1.1192 -
  1.1193 -
  1.1194 -lemma less_Pls_Pls:
  1.1195 -  "Numeral.Pls < Numeral.Pls \<longleftrightarrow> False" by auto
  1.1196 -
  1.1197 -lemma less_Pls_Min:
  1.1198 -  "Numeral.Pls < Numeral.Min \<longleftrightarrow> False"
  1.1199 -  unfolding Pls_def Min_def by auto
  1.1200 -
  1.1201 -lemma less_Pls_Bit0:
  1.1202 -  "Numeral.Pls < Numeral.Bit k bit.B0 \<longleftrightarrow> Numeral.Pls < k"
  1.1203 -  unfolding Pls_def Bit_def by auto
  1.1204 -
  1.1205 -lemma less_Pls_Bit1:
  1.1206 -  "Numeral.Pls < Numeral.Bit k bit.B1 \<longleftrightarrow> Numeral.Pls \<le> k"
  1.1207 -  unfolding Pls_def Bit_def by auto
  1.1208 -
  1.1209 -lemma less_Min_Pls:
  1.1210 -  "Numeral.Min < Numeral.Pls \<longleftrightarrow> True"
  1.1211 -  unfolding Pls_def Min_def by auto
  1.1212 -
  1.1213 -lemma less_Min_Min:
  1.1214 -  "Numeral.Min < Numeral.Min \<longleftrightarrow> False" by auto
  1.1215 -
  1.1216 -lemma less_Min_Bit:
  1.1217 -  "Numeral.Min < Numeral.Bit k v \<longleftrightarrow> Numeral.Min < k"
  1.1218 -  unfolding Min_def Bit_def by (auto split: bit.split)
  1.1219 -
  1.1220 -lemma less_Bit_Pls:
  1.1221 -  "Numeral.Bit k v < Numeral.Pls \<longleftrightarrow> k < Numeral.Pls"
  1.1222 -  unfolding Pls_def Bit_def by (auto split: bit.split)
  1.1223 -
  1.1224 -lemma less_Bit0_Min:
  1.1225 -  "Numeral.Bit k bit.B0 < Numeral.Min \<longleftrightarrow> k \<le> Numeral.Min"
  1.1226 -  unfolding Min_def Bit_def by auto
  1.1227 -
  1.1228 -lemma less_Bit1_Min:
  1.1229 -  "Numeral.Bit k bit.B1 < Numeral.Min \<longleftrightarrow> k < Numeral.Min"
  1.1230 -  unfolding Min_def Bit_def by auto
  1.1231 -
  1.1232 -lemma less_Bit_Bit0:
  1.1233 -  "Numeral.Bit k1 v < Numeral.Bit k2 bit.B0 \<longleftrightarrow> k1 < k2"
  1.1234 -  unfolding Bit_def by (auto split: bit.split)
  1.1235 -
  1.1236 -lemma less_Bit1_Bit:
  1.1237 -  "Numeral.Bit k1 bit.B1 < Numeral.Bit k2 v \<longleftrightarrow> k1 < k2"
  1.1238 -  unfolding Bit_def by (auto split: bit.split)
  1.1239 -
  1.1240 -lemma less_Bit0_Bit1:
  1.1241 -  "Numeral.Bit k1 bit.B0 < Numeral.Bit k2 bit.B1 \<longleftrightarrow> k1 \<le> k2"
  1.1242 -  unfolding Bit_def bit.cases by auto
  1.1243 -
  1.1244 -lemma less_number_of:
  1.1245 -  "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
  1.1246 -  unfolding number_of_is_id ..
  1.1247 -
  1.1248 -
  1.1249 -lemmas pred_succ_numeral_code [code func] =
  1.1250 -  arith_simps(5-12)
  1.1251 -
  1.1252 -lemmas plus_numeral_code [code func] =
  1.1253 -  arith_simps(13-17)
  1.1254 -  arith_simps(26-27)
  1.1255 -  arith_extra_simps(1) [where 'a = int]
  1.1256 -
  1.1257 -lemmas minus_numeral_code [code func] =
  1.1258 -  arith_simps(18-21)
  1.1259 -  arith_extra_simps(2) [where 'a = int]
  1.1260 -  arith_extra_simps(5) [where 'a = int]
  1.1261 -
  1.1262 -lemmas times_numeral_code [code func] =
  1.1263 -  arith_simps(22-25)
  1.1264 -  arith_extra_simps(4) [where 'a = int]
  1.1265 -
  1.1266 -lemmas eq_numeral_code [code func] =
  1.1267 -  eq_Pls_Pls eq_Pls_Min eq_Pls_Bit0 eq_Pls_Bit1
  1.1268 -  eq_Min_Pls eq_Min_Min eq_Min_Bit0 eq_Min_Bit1
  1.1269 -  eq_Bit0_Pls eq_Bit1_Pls eq_Bit0_Min eq_Bit1_Min eq_Bit_Bit
  1.1270 -  eq_number_of
  1.1271 -
  1.1272 -lemmas less_eq_numeral_code [code func] = less_eq_Pls_Pls less_eq_Pls_Min less_eq_Pls_Bit
  1.1273 -  less_eq_Min_Pls less_eq_Min_Min less_eq_Min_Bit0 less_eq_Min_Bit1
  1.1274 -  less_eq_Bit0_Pls less_eq_Bit1_Pls less_eq_Bit_Min less_eq_Bit0_Bit less_eq_Bit_Bit1 less_eq_Bit1_Bit0
  1.1275 -  less_eq_number_of
  1.1276 -
  1.1277 -lemmas less_numeral_code [code func] = less_Pls_Pls less_Pls_Min less_Pls_Bit0
  1.1278 -  less_Pls_Bit1 less_Min_Pls less_Min_Min less_Min_Bit less_Bit_Pls
  1.1279 -  less_Bit0_Min less_Bit1_Min less_Bit_Bit0 less_Bit1_Bit less_Bit0_Bit1
  1.1280 -  less_number_of
  1.1281 -
  1.1282 -end
     2.1 --- a/src/HOL/Integ/cooper_dec.ML	Thu May 31 11:00:06 2007 +0200
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,920 +0,0 @@
     2.4 -(*  Title:      HOL/Integ/cooper_dec.ML
     2.5 -    ID:         $Id$
     2.6 -    Author:     Amine Chaieb and Tobias Nipkow, TU Muenchen
     2.7 -
     2.8 -File containing the implementation of Cooper Algorithm
     2.9 -decision procedure (intensively inspired from J.Harrison)
    2.10 -*)
    2.11 -
    2.12 -
    2.13 -signature COOPER_DEC = 
    2.14 -sig
    2.15 -  exception COOPER
    2.16 -  val mk_number : IntInf.int -> term
    2.17 -  val zero : term
    2.18 -  val one : term
    2.19 -  val dest_number : term -> IntInf.int
    2.20 -  val is_number : term -> bool
    2.21 -  val is_arith_rel : term -> bool
    2.22 -  val linear_cmul : IntInf.int -> term -> term
    2.23 -  val linear_add : string list -> term -> term -> term 
    2.24 -  val linear_sub : string list -> term -> term -> term 
    2.25 -  val linear_neg : term -> term
    2.26 -  val lint : string list -> term -> term
    2.27 -  val linform : string list -> term -> term
    2.28 -  val formlcm : term -> term -> IntInf.int
    2.29 -  val adjustcoeff : term -> IntInf.int -> term -> term
    2.30 -  val unitycoeff : term -> term -> term
    2.31 -  val divlcm : term -> term -> IntInf.int
    2.32 -  val bset : term -> term -> term list
    2.33 -  val aset : term -> term -> term list
    2.34 -  val linrep : string list -> term -> term -> term -> term
    2.35 -  val list_disj : term list -> term
    2.36 -  val list_conj : term list -> term
    2.37 -  val simpl : term -> term
    2.38 -  val fv : term -> string list
    2.39 -  val negate : term -> term
    2.40 -  val operations : (string * (IntInf.int * IntInf.int -> bool)) list
    2.41 -  val conjuncts : term -> term list
    2.42 -  val disjuncts : term -> term list
    2.43 -  val has_bound : term -> bool
    2.44 -  val minusinf : term -> term -> term
    2.45 -  val plusinf : term -> term -> term
    2.46 -  val onatoms : (term -> term) -> term -> term
    2.47 -  val evalc : term -> term
    2.48 -  val cooper_w : string list -> term -> (term option * term)
    2.49 -  val integer_qelim : Term.term -> Term.term
    2.50 -end;
    2.51 -
    2.52 -structure CooperDec : COOPER_DEC =
    2.53 -struct
    2.54 -
    2.55 -(* ========================================================================= *) 
    2.56 -(* Cooper's algorithm for Presburger arithmetic.                             *) 
    2.57 -(* ========================================================================= *) 
    2.58 -exception COOPER;
    2.59 -
    2.60 -
    2.61 -(* ------------------------------------------------------------------------- *) 
    2.62 -(* Lift operations up to numerals.                                           *) 
    2.63 -(* ------------------------------------------------------------------------- *) 
    2.64 - 
    2.65 -(*Assumption : The construction of atomar formulas in linearl arithmetic is based on 
    2.66 -relation operations of Type : [IntInf.int,IntInf.int]---> bool *) 
    2.67 - 
    2.68 -(* ------------------------------------------------------------------------- *) 
    2.69 - 
    2.70 -(*Function is_arith_rel returns true if and only if the term is an atomar presburger 
    2.71 -formula *) 
    2.72 -fun is_arith_rel tm = case tm
    2.73 - of Const(p, Type ("fun", [Type ("IntDef.int", []), Type ("fun", [Type ("IntDef.int", []),
    2.74 -      Type ("bool", [])])])) $ _ $_ => true
    2.75 -  | _ => false;
    2.76 - 
    2.77 -(*Function is_arith_rel returns true if and only if the term is an operation of the 
    2.78 -form [int,int]---> int*) 
    2.79 - 
    2.80 -val mk_number = HOLogic.mk_number HOLogic.intT;
    2.81 -val zero = mk_number 0; 
    2.82 -val one = mk_number 1; 
    2.83 -fun dest_number t = let
    2.84 -    val (T, n) = HOLogic.dest_number t
    2.85 -  in if T = HOLogic.intT then n else error ("bad typ: " ^ Display.raw_string_of_typ T) end;
    2.86 -val is_number = can dest_number; 
    2.87 -
    2.88 -(*maps a unary natural function on a term containing an natural number*) 
    2.89 -fun numeral1 f n = mk_number (f (dest_number n)); 
    2.90 - 
    2.91 -(*maps a binary natural function on 2 term containing  natural numbers*) 
    2.92 -fun numeral2 f m n = mk_number (f (dest_number m) (dest_number n));
    2.93 - 
    2.94 -(* ------------------------------------------------------------------------- *) 
    2.95 -(* Operations on canonical linear terms c1 * x1 + ... + cn * xn + k          *) 
    2.96 -(*                                                                           *) 
    2.97 -(* Note that we're quite strict: the ci must be present even if 1            *) 
    2.98 -(* (but if 0 we expect the monomial to be omitted) and k must be there       *) 
    2.99 -(* even if it's zero. Thus, it's a constant iff not an addition term.        *) 
   2.100 -(* ------------------------------------------------------------------------- *)  
   2.101 - 
   2.102 - 
   2.103 -fun linear_cmul n tm =  if n = 0 then zero else let fun times n k = n*k in  
   2.104 -  ( case tm of  
   2.105 -     (Const(@{const_name HOL.plus},T)  $  (Const (@{const_name HOL.times},T1 ) $c1 $  x1) $ rest) => 
   2.106 -       Const(@{const_name HOL.plus},T) $ ((Const(@{const_name HOL.times},T1) $ (numeral1 (times n) c1) $ x1)) $ (linear_cmul n rest) 
   2.107 -    |_ =>  numeral1 (times n) tm) 
   2.108 -    end ; 
   2.109 - 
   2.110 - 
   2.111 - 
   2.112 - 
   2.113 -(* Whether the first of two items comes earlier in the list  *) 
   2.114 -fun earlier [] x y = false 
   2.115 -	|earlier (h::t) x y =if h = y then false 
   2.116 -              else if h = x then true 
   2.117 -              	else earlier t x y ; 
   2.118 - 
   2.119 -fun earlierv vars (Bound i) (Bound j) = i < j 
   2.120 -   |earlierv vars (Bound _) _ = true 
   2.121 -   |earlierv vars _ (Bound _)  = false 
   2.122 -   |earlierv vars (Free (x,_)) (Free (y,_)) = earlier vars x y; 
   2.123 - 
   2.124 - 
   2.125 -fun linear_add vars tm1 tm2 = 
   2.126 -  let fun addwith x y = x + y in
   2.127 - (case (tm1,tm2) of 
   2.128 -	((Const (@{const_name HOL.plus},T1) $ ( Const(@{const_name HOL.times},T2) $ c1 $  x1) $ rest1),(Const 
   2.129 -	(@{const_name HOL.plus},T3)$( Const(@{const_name HOL.times},T4) $ c2 $  x2) $ rest2)) => 
   2.130 -         if x1 = x2 then 
   2.131 -              let val c = (numeral2 (addwith) c1 c2) 
   2.132 -	      in 
   2.133 -              if c = zero then (linear_add vars rest1  rest2)  
   2.134 -	      else (Const(@{const_name HOL.plus},T1) $ (Const(@{const_name HOL.times},T2) $ c $ x1) $ (linear_add vars  rest1 rest2)) 
   2.135 -              end 
   2.136 -	   else 
   2.137 -		if earlierv vars x1 x2 then (Const(@{const_name HOL.plus},T1) $  
   2.138 -		(Const(@{const_name HOL.times},T2)$ c1 $ x1) $ (linear_add vars rest1 tm2)) 
   2.139 -    	       else (Const(@{const_name HOL.plus},T1) $ (Const(@{const_name HOL.times},T2) $ c2 $ x2) $ (linear_add vars tm1 rest2)) 
   2.140 -   	|((Const(@{const_name HOL.plus},T1) $ (Const(@{const_name HOL.times},T2) $ c1 $ x1) $ rest1) ,_) => 
   2.141 -    	  (Const(@{const_name HOL.plus},T1)$ (Const(@{const_name HOL.times},T2) $ c1 $ x1) $ (linear_add vars 
   2.142 -	  rest1 tm2)) 
   2.143 -   	|(_, (Const(@{const_name HOL.plus},T1) $(Const(@{const_name HOL.times},T2) $ c2 $ x2) $ rest2)) => 
   2.144 -      	  (Const(@{const_name HOL.plus},T1) $ (Const(@{const_name HOL.times},T2) $ c2 $ x2) $ (linear_add vars tm1 
   2.145 -	  rest2)) 
   2.146 -   	| (_,_) => numeral2 (addwith) tm1 tm2) 
   2.147 -	 
   2.148 -	end; 
   2.149 - 
   2.150 -(*To obtain the unary - applyed on a formula*) 
   2.151 - 
   2.152 -fun linear_neg tm = linear_cmul (0 - 1) tm; 
   2.153 - 
   2.154 -(*Substraction of two terms *) 
   2.155 - 
   2.156 -fun linear_sub vars tm1 tm2 = linear_add vars tm1 (linear_neg tm2); 
   2.157 - 
   2.158 - 
   2.159 -(* ------------------------------------------------------------------------- *) 
   2.160 -(* Linearize a term.                                                         *) 
   2.161 -(* ------------------------------------------------------------------------- *) 
   2.162 - 
   2.163 -(* linearises a term from the point of view of Variable Free (x,T). 
   2.164 -After this fuction the all expressions containig ths variable will have the form  
   2.165 - c*Free(x,T) + t where c is a constant ant t is a Term which is not containing 
   2.166 - Free(x,T)*) 
   2.167 -  
   2.168 -fun lint vars tm = if is_number tm then tm else case tm of 
   2.169 -   (Free (x,T)) =>  (HOLogic.mk_binop @{const_name HOL.plus} ((HOLogic.mk_binop @{const_name HOL.times} ((mk_number 1),Free (x,T))), zero)) 
   2.170 -  |(Bound i) =>  (Const(@{const_name HOL.plus},HOLogic.intT -->HOLogic.intT -->HOLogic.intT) $ 
   2.171 -  (Const(@{const_name HOL.times},HOLogic.intT -->HOLogic.intT -->HOLogic.intT) $ (mk_number 1) $ (Bound i)) $ zero) 
   2.172 -  |(Const(@{const_name HOL.uminus},_) $ t ) => (linear_neg (lint vars t)) 
   2.173 -  |(Const(@{const_name HOL.plus},_) $ s $ t) => (linear_add vars (lint vars s) (lint vars t)) 
   2.174 -  |(Const(@{const_name HOL.minus},_) $ s $ t) => (linear_sub vars (lint vars s) (lint vars t)) 
   2.175 -  |(Const (@{const_name HOL.times},_) $ s $ t) => 
   2.176 -        let val s' = lint vars s  
   2.177 -            val t' = lint vars t  
   2.178 -        in 
   2.179 -        if is_number s' then (linear_cmul (dest_number s') t') 
   2.180 -        else if is_number t' then (linear_cmul (dest_number t') s') 
   2.181 - 
   2.182 -         else raise COOPER
   2.183 -         end 
   2.184 -  |_ =>  raise COOPER;
   2.185 -   
   2.186 - 
   2.187 - 
   2.188 -(* ------------------------------------------------------------------------- *) 
   2.189 -(* Linearize the atoms in a formula, and eliminate non-strict inequalities.  *) 
   2.190 -(* ------------------------------------------------------------------------- *) 
   2.191 - 
   2.192 -fun mkatom vars p t = Const(p,HOLogic.intT --> HOLogic.intT --> HOLogic.boolT) $ zero $ (lint vars t); 
   2.193 - 
   2.194 -fun linform vars (Const ("Divides.dvd",_) $ c $ t) =
   2.195 -    if is_number c then   
   2.196 -      let val c' = (mk_number(abs(dest_number c)))  
   2.197 -      in (HOLogic.mk_binrel "Divides.dvd" (c,lint vars t)) 
   2.198 -      end 
   2.199 -    else (warning "Nonlinear term --- Non numeral leftside at dvd"
   2.200 -      ;raise COOPER)
   2.201 -  |linform vars  (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ s $ t ) = (mkatom vars "op =" (Const (@{const_name HOL.minus},HOLogic.intT --> HOLogic.intT --> HOLogic.intT) $ t $ s) ) 
   2.202 -  |linform vars  (Const(@{const_name Orderings.less},_)$ s $t ) = (mkatom vars @{const_name Orderings.less} (Const (@{const_name HOL.minus},HOLogic.intT --> HOLogic.intT --> HOLogic.intT) $ t $ s))
   2.203 -  |linform vars  (Const("op >",_) $ s $ t ) = (mkatom vars @{const_name Orderings.less} (Const (@{const_name HOL.minus},HOLogic.intT --> HOLogic.intT --> HOLogic.intT) $ s $ t)) 
   2.204 -  |linform vars  (Const(@{const_name Orderings.less_eq},_)$ s $ t ) = 
   2.205 -        (mkatom vars @{const_name Orderings.less} (Const (@{const_name HOL.minus},HOLogic.intT --> HOLogic.intT --> HOLogic.intT) $ (Const(@{const_name HOL.plus},HOLogic.intT --> HOLogic.intT --> HOLogic.intT) $t $(mk_number 1)) $ s)) 
   2.206 -  |linform vars  (Const("op >=",_)$ s $ t ) = 
   2.207 -        (mkatom vars @{const_name Orderings.less} (Const (@{const_name HOL.minus},HOLogic.intT --> HOLogic.intT --> 
   2.208 -	HOLogic.intT) $ (Const(@{const_name HOL.plus},HOLogic.intT --> HOLogic.intT --> 
   2.209 -	HOLogic.intT) $s $(mk_number 1)) $ t)) 
   2.210 - 
   2.211 -   |linform vars  fm =  fm; 
   2.212 - 
   2.213 -(* ------------------------------------------------------------------------- *) 
   2.214 -(* Post-NNF transformation eliminating negated inequalities.                 *) 
   2.215 -(* ------------------------------------------------------------------------- *) 
   2.216 - 
   2.217 -fun posineq fm = case fm of  
   2.218 - (Const ("Not",_)$(Const(@{const_name Orderings.less},_)$ c $ t)) =>
   2.219 -   (HOLogic.mk_binrel @{const_name Orderings.less}  (zero , (linear_sub [] (mk_number 1) (linear_add [] c t ) ))) 
   2.220 -  | ( Const ("op &",_) $ p $ q)  => HOLogic.mk_conj (posineq p,posineq q)
   2.221 -  | ( Const ("op |",_) $ p $ q ) => HOLogic.mk_disj (posineq p,posineq q)
   2.222 -  | _ => fm; 
   2.223 -  
   2.224 -
   2.225 -(* ------------------------------------------------------------------------- *) 
   2.226 -(* Find the LCM of the coefficients of x.                                    *) 
   2.227 -(* ------------------------------------------------------------------------- *) 
   2.228 -(*gcd calculates gcd (a,b) and helps lcm_num calculating lcm (a,b)*) 
   2.229 - 
   2.230 -(*BEWARE: replaces Library.gcd!! There is also Library.lcm!*)
   2.231 -fun gcd (a:IntInf.int) b = if a=0 then b else gcd (b mod a) a ; 
   2.232 -fun lcm_num a b = (abs a*b) div (gcd (abs a) (abs b)); 
   2.233 - 
   2.234 -fun formlcm x fm = case fm of 
   2.235 -    (Const (p,_)$ _ $(Const (@{const_name HOL.plus}, _)$(Const (@{const_name HOL.times},_)$ c $ y ) $z ) ) =>  if 
   2.236 -    (is_arith_rel fm) andalso (x = y) then  (abs(dest_number c)) else 1 
   2.237 -  | ( Const ("Not", _) $p) => formlcm x p 
   2.238 -  | ( Const ("op &",_) $ p $ q) => lcm_num (formlcm x p) (formlcm x q) 
   2.239 -  | ( Const ("op |",_) $ p $ q )=> lcm_num (formlcm x p) (formlcm x q) 
   2.240 -  |  _ => 1; 
   2.241 - 
   2.242 -(* ------------------------------------------------------------------------- *) 
   2.243 -(* Adjust all coefficients of x in formula; fold in reduction to +/- 1.      *) 
   2.244 -(* ------------------------------------------------------------------------- *) 
   2.245 - 
   2.246 -fun adjustcoeff x l fm = 
   2.247 -     case fm of  
   2.248 -      (Const(p,_) $d $( Const (@{const_name HOL.plus}, _)$(Const (@{const_name HOL.times},_) $ 
   2.249 -      c $ y ) $z )) => if (is_arith_rel fm) andalso (x = y) then  
   2.250 -        let val m = l div (dest_number c) 
   2.251 -            val n = (if p = @{const_name Orderings.less} then abs(m) else m) 
   2.252 -            val xtm = HOLogic.mk_binop @{const_name HOL.times} ((mk_number (m div n)), x) 
   2.253 -	in
   2.254 -        (HOLogic.mk_binrel p ((linear_cmul n d),(HOLogic.mk_binop @{const_name HOL.plus} ( xtm ,( linear_cmul n z) )))) 
   2.255 -	end 
   2.256 -	else fm 
   2.257 -  |( Const ("Not", _) $ p) => HOLogic.Not $ (adjustcoeff x l p) 
   2.258 -  |( Const ("op &",_) $ p $ q) => HOLogic.conj$(adjustcoeff x l p) $(adjustcoeff x l q) 
   2.259 -  |( Const ("op |",_) $ p $ q) => HOLogic.disj $(adjustcoeff x l p)$ (adjustcoeff x l q) 
   2.260 -  |_ => fm; 
   2.261 - 
   2.262 -(* ------------------------------------------------------------------------- *) 
   2.263 -(* Hence make coefficient of x one in existential formula.                   *) 
   2.264 -(* ------------------------------------------------------------------------- *) 
   2.265 - 
   2.266 -fun unitycoeff x fm = 
   2.267 -  let val l = formlcm x fm
   2.268 -      val fm' = adjustcoeff x l fm in
   2.269 -      if l = 1 then fm' 
   2.270 -	 else 
   2.271 -     let val xp = (HOLogic.mk_binop @{const_name HOL.plus}  
   2.272 -     		((HOLogic.mk_binop @{const_name HOL.times} ((mk_number 1), x )), zero))
   2.273 -	in 
   2.274 -      HOLogic.conj $(HOLogic.mk_binrel "Divides.dvd" ((mk_number l) , xp )) $ (adjustcoeff x l fm) 
   2.275 -      end 
   2.276 -  end; 
   2.277 - 
   2.278 -(* adjustcoeffeq l fm adjusts the coeffitients c_i of x  overall in fm to l*)
   2.279 -(* Here l must be a multiple of all c_i otherwise the obtained formula is not equivalent*)
   2.280 -(*
   2.281 -fun adjustcoeffeq x l fm = 
   2.282 -    case fm of  
   2.283 -      (Const(p,_) $d $( Const (@{const_name HOL.plus}, _)$(Const (@{const_name HOL.times},_) $ 
   2.284 -      c $ y ) $z )) => if (is_arith_rel fm) andalso (x = y) then  
   2.285 -        let val m = l div (dest_number c) 
   2.286 -            val n = (if p = @{const_name Orderings.less} then abs(m) else m)  
   2.287 -            val xtm = (HOLogic.mk_binop @{const_name HOL.times} ((mk_number ((m div n)*l) ), x))
   2.288 -            in (HOLogic.mk_binrel p ((linear_cmul n d),(HOLogic.mk_binop @{const_name HOL.plus} ( xtm ,( linear_cmul n z) )))) 
   2.289 -	    end 
   2.290 -	else fm 
   2.291 -  |( Const ("Not", _) $ p) => HOLogic.Not $ (adjustcoeffeq x l p) 
   2.292 -  |( Const ("op &",_) $ p $ q) => HOLogic.conj$(adjustcoeffeq x l p) $(adjustcoeffeq x l q) 
   2.293 -  |( Const ("op |",_) $ p $ q) => HOLogic.disj $(adjustcoeffeq x l p)$ (adjustcoeffeq x l q) 
   2.294 -  |_ => fm;
   2.295 - 
   2.296 -
   2.297 -*)
   2.298 -
   2.299 -(* ------------------------------------------------------------------------- *) 
   2.300 -(* The "minus infinity" version.                                             *) 
   2.301 -(* ------------------------------------------------------------------------- *) 
   2.302 - 
   2.303 -fun minusinf x fm = case fm of  
   2.304 -    (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ (c1 ) $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) => 
   2.305 -  	 if (is_arith_rel fm) andalso (x=y) andalso (c2 = one) andalso (c1 =zero) then HOLogic.false_const  
   2.306 -	 				 else fm 
   2.307 - 
   2.308 -  |(Const(@{const_name Orderings.less},_) $ c $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z 
   2.309 -  )) => if (x = y) 
   2.310 -	then if (pm1 = one) andalso (c = zero) then HOLogic.false_const 
   2.311 -	     else if (dest_number pm1 = ~1) andalso (c = zero) then HOLogic.true_const 
   2.312 -	          else error "minusinf : term not in normal form!!!"
   2.313 -	else fm
   2.314 -	 
   2.315 -  |(Const ("Not", _) $ p) => HOLogic.Not $ (minusinf x p) 
   2.316 -  |(Const ("op &",_) $ p $ q) => HOLogic.conj $ (minusinf x p) $ (minusinf x q) 
   2.317 -  |(Const ("op |",_) $ p $ q) => HOLogic.disj $ (minusinf x p) $ (minusinf x q) 
   2.318 -  |_ => fm; 
   2.319 -
   2.320 -(* ------------------------------------------------------------------------- *)
   2.321 -(* The "Plus infinity" version.                                             *)
   2.322 -(* ------------------------------------------------------------------------- *)
   2.323 -
   2.324 -fun plusinf x fm = case fm of
   2.325 -    (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ (c1 ) $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   2.326 -  	 if (is_arith_rel fm) andalso (x=y) andalso (c2 = one) andalso (c1 =zero) then HOLogic.false_const
   2.327 -	 				 else fm
   2.328 -
   2.329 -  |(Const(@{const_name Orderings.less},_) $ c $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z
   2.330 -  )) => if (x = y) 
   2.331 -	then if (pm1 = one) andalso (c = zero) then HOLogic.true_const 
   2.332 -	     else if (dest_number pm1 = ~1) andalso (c = zero) then HOLogic.false_const
   2.333 -	     else error "plusinf : term not in normal form!!!"
   2.334 -	else fm 
   2.335 -
   2.336 -  |(Const ("Not", _) $ p) => HOLogic.Not $ (plusinf x p)
   2.337 -  |(Const ("op &",_) $ p $ q) => HOLogic.conj $ (plusinf x p) $ (plusinf x q)
   2.338 -  |(Const ("op |",_) $ p $ q) => HOLogic.disj $ (plusinf x p) $ (plusinf x q)
   2.339 -  |_ => fm;
   2.340 - 
   2.341 -(* ------------------------------------------------------------------------- *) 
   2.342 -(* The LCM of all the divisors that involve x.                               *) 
   2.343 -(* ------------------------------------------------------------------------- *) 
   2.344 - 
   2.345 -fun divlcm x (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z ) ) =  
   2.346 -        if x = y then abs(dest_number d) else 1 
   2.347 -  |divlcm x ( Const ("Not", _) $ p) = divlcm x p 
   2.348 -  |divlcm x ( Const ("op &",_) $ p $ q) = lcm_num (divlcm x p) (divlcm x q) 
   2.349 -  |divlcm x ( Const ("op |",_) $ p $ q ) = lcm_num (divlcm x p) (divlcm x q) 
   2.350 -  |divlcm x  _ = 1; 
   2.351 - 
   2.352 -(* ------------------------------------------------------------------------- *) 
   2.353 -(* Construct the B-set.                                                      *) 
   2.354 -(* ------------------------------------------------------------------------- *) 
   2.355 - 
   2.356 -fun bset x fm = case fm of 
   2.357 -   (Const ("Not", _) $ p) => if (is_arith_rel p) then  
   2.358 -          (case p of  
   2.359 -	      (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $c2 $y) $a ) )  
   2.360 -	             => if (is_arith_rel p) andalso (x=	y) andalso (c2 = one) andalso (c1 = zero)  
   2.361 -	                then [linear_neg a] 
   2.362 -			else  bset x p 
   2.363 -   	  |_ =>[]) 
   2.364 -			 
   2.365 -			else bset x p 
   2.366 -  |(Const ("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $c2 $ x) $ a)) =>  if (c1 =zero) andalso (c2 = one) then [linear_neg(linear_add [] a (mk_number 1))]  else [] 
   2.367 -  |(Const (@{const_name Orderings.less},_) $ c1$ (Const (@{const_name HOL.plus},_) $(Const (@{const_name HOL.times},_)$ c2 $ x) $ a)) => if (c1 =zero) andalso (c2 = one) then [linear_neg a] else [] 
   2.368 -  |(Const ("op &",_) $ p $ q) => (bset x p) union (bset x q) 
   2.369 -  |(Const ("op |",_) $ p $ q) => (bset x p) union (bset x q) 
   2.370 -  |_ => []; 
   2.371 - 
   2.372 -(* ------------------------------------------------------------------------- *)
   2.373 -(* Construct the A-set.                                                      *)
   2.374 -(* ------------------------------------------------------------------------- *)
   2.375 -
   2.376 -fun aset x fm = case fm of
   2.377 -   (Const ("Not", _) $ p) => if (is_arith_rel p) then
   2.378 -          (case p of
   2.379 -	      (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $c2 $y) $a ) )
   2.380 -	             => if (x=	y) andalso (c2 = one) andalso (c1 = zero)
   2.381 -	                then [linear_neg a]
   2.382 -			else  []
   2.383 -   	  |_ =>[])
   2.384 -
   2.385 -			else aset x p
   2.386 -  |(Const ("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $c2 $ x) $ a)) =>  if (c1 =zero) andalso (c2 = one) then [linear_sub [] (mk_number 1) a]  else []
   2.387 -  |(Const (@{const_name Orderings.less},_) $ c1$ (Const (@{const_name HOL.plus},_) $(Const (@{const_name HOL.times},_)$ c2 $ x) $ a)) => if (c1 =zero) andalso (c2 = (mk_number (~1))) then [a] else []
   2.388 -  |(Const ("op &",_) $ p $ q) => (aset x p) union (aset x q)
   2.389 -  |(Const ("op |",_) $ p $ q) => (aset x p) union (aset x q)
   2.390 -  |_ => [];
   2.391 -
   2.392 -
   2.393 -(* ------------------------------------------------------------------------- *) 
   2.394 -(* Replace top variable with another linear form, retaining canonicality.    *) 
   2.395 -(* ------------------------------------------------------------------------- *) 
   2.396 - 
   2.397 -fun linrep vars x t fm = case fm of  
   2.398 -   ((Const(p,_)$ d $ (Const(@{const_name HOL.plus},_)$(Const(@{const_name HOL.times},_)$ c $ y) $ z))) => 
   2.399 -      if (x = y) andalso (is_arith_rel fm)  
   2.400 -      then  
   2.401 -        let val ct = linear_cmul (dest_number c) t  
   2.402 -	in (HOLogic.mk_binrel p (d, linear_add vars ct z)) 
   2.403 -	end 
   2.404 -	else fm 
   2.405 -  |(Const ("Not", _) $ p) => HOLogic.Not $ (linrep vars x t p) 
   2.406 -  |(Const ("op &",_) $ p $ q) => HOLogic.conj $ (linrep vars x t p) $ (linrep vars x t q) 
   2.407 -  |(Const ("op |",_) $ p $ q) => HOLogic.disj $ (linrep vars x t p) $ (linrep vars x t q) 
   2.408 -  |_ => fm;
   2.409 - 
   2.410 -(* ------------------------------------------------------------------------- *) 
   2.411 -(* Evaluation of constant expressions.                                       *) 
   2.412 -(* ------------------------------------------------------------------------- *) 
   2.413 -
   2.414 -(* An other implementation of divides, that covers more cases*) 
   2.415 -
   2.416 -exception DVD_UNKNOWN
   2.417 -
   2.418 -fun dvd_op (d, t) = 
   2.419 - if not(is_number d) then raise DVD_UNKNOWN
   2.420 - else let 
   2.421 -   val dn = dest_number d
   2.422 -   fun coeffs_of x = case x of 
   2.423 -     Const(p,_) $ tl $ tr => 
   2.424 -       if p = @{const_name HOL.plus} then (coeffs_of tl) union (coeffs_of tr)
   2.425 -          else if p = @{const_name HOL.times} 
   2.426 -	        then if (is_number tr) 
   2.427 -		 then [(dest_number tr) * (dest_number tl)] 
   2.428 -		 else [dest_number tl]
   2.429 -	        else []
   2.430 -    |_ => if (is_number t) then [dest_number t]  else []
   2.431 -   val ts = coeffs_of t
   2.432 -   in case ts of
   2.433 -     [] => raise DVD_UNKNOWN
   2.434 -    |_  => fold_rev (fn k => fn r => r andalso (k mod dn = 0)) ts true
   2.435 -   end;
   2.436 -
   2.437 -
   2.438 -val operations = 
   2.439 -  [("op =",op=), (@{const_name Orderings.less},IntInf.<), ("op >",IntInf.>), (@{const_name Orderings.less_eq},IntInf.<=) , 
   2.440 -   ("op >=",IntInf.>=), 
   2.441 -   ("Divides.dvd",fn (x,y) =>((IntInf.mod(y, x)) = 0))]; 
   2.442 - 
   2.443 -fun applyoperation (SOME f) (a,b) = f (a, b) 
   2.444 -    |applyoperation _ (_, _) = false; 
   2.445 - 
   2.446 -(*Evaluation of constant atomic formulas*) 
   2.447 - (*FIXME : This is an optimation but still incorrect !! *)
   2.448 -(*
   2.449 -fun evalc_atom at = case at of  
   2.450 -  (Const (p,_) $ s $ t) =>
   2.451 -   (if p="Divides.dvd" then 
   2.452 -     ((if dvd_op(s,t) then HOLogic.true_const
   2.453 -     else HOLogic.false_const)
   2.454 -      handle _ => at)
   2.455 -    else
   2.456 -  case AList.lookup (op =) operations p of 
   2.457 -    SOME f => ((if (f ((dest_number s),(dest_number t))) then HOLogic.true_const else HOLogic.false_const)  
   2.458 -    handle _ => at) 
   2.459 -      | _ =>  at) 
   2.460 -      |Const("Not",_)$(Const (p,_) $ s $ t) =>(  
   2.461 -  case AList.lookup (op =) operations p of 
   2.462 -    SOME f => ((if (f ((dest_number s),(dest_number t))) then 
   2.463 -    HOLogic.false_const else HOLogic.true_const)  
   2.464 -    handle _ => at) 
   2.465 -      | _ =>  at) 
   2.466 -      | _ =>  at; 
   2.467 -
   2.468 -*)
   2.469 -
   2.470 -fun evalc_atom at = case at of  
   2.471 -  (Const (p,_) $ s $ t) =>
   2.472 -   ( case AList.lookup (op =) operations p of 
   2.473 -    SOME f => ((if (f ((dest_number s),(dest_number t))) then HOLogic.true_const 
   2.474 -                else HOLogic.false_const)  
   2.475 -    handle _ => at) 
   2.476 -      | _ =>  at) 
   2.477 -      |Const("Not",_)$(Const (p,_) $ s $ t) =>(  
   2.478 -  case AList.lookup (op =) operations p of 
   2.479 -    SOME f => ((if (f ((dest_number s),(dest_number t))) 
   2.480 -               then HOLogic.false_const else HOLogic.true_const)  
   2.481 -    handle _ => at) 
   2.482 -      | _ =>  at) 
   2.483 -      | _ =>  at; 
   2.484 -
   2.485 - (*Function onatoms apllys function f on the atomic formulas involved in a.*) 
   2.486 - 
   2.487 -fun onatoms f a = if (is_arith_rel a) then f a else case a of 
   2.488 - 
   2.489 -  	(Const ("Not",_) $ p) => if is_arith_rel p then HOLogic.Not $ (f p) 
   2.490 -				 
   2.491 -				else HOLogic.Not $ (onatoms f p) 
   2.492 -  	|(Const ("op &",_) $ p $ q) => HOLogic.conj $ (onatoms f p) $ (onatoms f q) 
   2.493 -  	|(Const ("op |",_) $ p $ q) => HOLogic.disj $ (onatoms f p) $ (onatoms f q) 
   2.494 -  	|(Const ("op -->",_) $ p $ q) => HOLogic.imp $ (onatoms f p) $ (onatoms f q) 
   2.495 -  	|((Const ("op =", Type ("fun",[Type ("bool", []),_]))) $ p $ q) => (Const ("op =", [HOLogic.boolT, HOLogic.boolT] ---> HOLogic.boolT)) $ (onatoms f p) $ (onatoms f q) 
   2.496 -  	|(Const("All",_) $ Abs(x,T,p)) => Const("All", [HOLogic.intT --> 
   2.497 -	HOLogic.boolT] ---> HOLogic.boolT)$ Abs (x ,T, (onatoms f p)) 
   2.498 -  	|(Const("Ex",_) $ Abs(x,T,p)) => Const("Ex", [HOLogic.intT --> HOLogic.boolT]---> HOLogic.boolT) $ Abs( x ,T, (onatoms f p)) 
   2.499 -  	|_ => a; 
   2.500 - 
   2.501 -val evalc = onatoms evalc_atom; 
   2.502 - 
   2.503 -(* ------------------------------------------------------------------------- *) 
   2.504 -(* Hence overall quantifier elimination.                                     *) 
   2.505 -(* ------------------------------------------------------------------------- *) 
   2.506 - 
   2.507 - 
   2.508 -(*list_disj[conj] makes a disj[conj] of a given list. used with conjucts or disjuncts 
   2.509 -it liearises iterated conj[disj]unctions. *) 
   2.510 - 
   2.511 -fun list_disj [] = HOLogic.false_const
   2.512 -  | list_disj ps = foldr1 (fn (p, q) => HOLogic.disj $ p $ q) ps;
   2.513 -
   2.514 -fun list_conj [] = HOLogic.true_const
   2.515 -  | list_conj ps = foldr1 (fn (p, q) => HOLogic.conj $ p $ q) ps;
   2.516 -
   2.517 -
   2.518 -(*Simplification of Formulas *) 
   2.519 - 
   2.520 -(*Function q_bnd_chk checks if a quantified Formula makes sens : Means if in 
   2.521 -the body of the existential quantifier there are bound variables to the 
   2.522 -existential quantifier.*) 
   2.523 - 
   2.524 -fun has_bound fm =let fun has_boundh fm i = case fm of 
   2.525 -		 Bound n => (i = n) 
   2.526 -		 |Abs (_,_,p) => has_boundh p (i+1) 
   2.527 -		 |t1 $ t2 => (has_boundh t1 i) orelse (has_boundh t2 i) 
   2.528 -		 |_ =>false
   2.529 -
   2.530 -in  case fm of 
   2.531 -	Bound _ => true 
   2.532 -       |Abs (_,_,p) => has_boundh p 0 
   2.533 -       |t1 $ t2 => (has_bound t1 ) orelse (has_bound t2 ) 
   2.534 -       |_ =>false
   2.535 -end;
   2.536 - 
   2.537 -(*has_sub_abs checks if in a given Formula there are subformulas which are quantifed 
   2.538 -too. Is no used no more.*) 
   2.539 - 
   2.540 -fun has_sub_abs fm = case fm of  
   2.541 -		 Abs (_,_,_) => true 
   2.542 -		 |t1 $ t2 => (has_bound t1 ) orelse (has_bound t2 ) 
   2.543 -		 |_ =>false ; 
   2.544 -		  
   2.545 -(*update_bounds called with i=0 udates the numeration of bounded variables because the 
   2.546 -formula will not be quantified any more.*) 
   2.547 - 
   2.548 -fun update_bounds fm i = case fm of 
   2.549 -		 Bound n => if n >= i then Bound (n-1) else fm 
   2.550 -		 |Abs (x,T,p) => Abs(x,T,(update_bounds p (i+1))) 
   2.551 -		 |t1 $ t2 => (update_bounds t1 i) $ (update_bounds t2 i) 
   2.552 -		 |_ => fm ; 
   2.553 - 
   2.554 -(*psimpl : Simplification of propositions (general purpose)*) 
   2.555 -fun psimpl1 fm = case fm of 
   2.556 -    Const("Not",_) $ Const ("False",_) => HOLogic.true_const 
   2.557 -  | Const("Not",_) $ Const ("True",_) => HOLogic.false_const 
   2.558 -  | Const("op &",_) $ Const ("False",_) $ q => HOLogic.false_const 
   2.559 -  | Const("op &",_) $ p $ Const ("False",_)  => HOLogic.false_const 
   2.560 -  | Const("op &",_) $ Const ("True",_) $ q => q 
   2.561 -  | Const("op &",_) $ p $ Const ("True",_) => p 
   2.562 -  | Const("op |",_) $ Const ("False",_) $ q => q 
   2.563 -  | Const("op |",_) $ p $ Const ("False",_)  => p 
   2.564 -  | Const("op |",_) $ Const ("True",_) $ q => HOLogic.true_const 
   2.565 -  | Const("op |",_) $ p $ Const ("True",_)  => HOLogic.true_const 
   2.566 -  | Const("op -->",_) $ Const ("False",_) $ q => HOLogic.true_const 
   2.567 -  | Const("op -->",_) $ Const ("True",_) $  q => q 
   2.568 -  | Const("op -->",_) $ p $ Const ("True",_)  => HOLogic.true_const 
   2.569 -  | Const("op -->",_) $ p $ Const ("False",_)  => HOLogic.Not $  p 
   2.570 -  | Const("op =", Type ("fun",[Type ("bool", []),_])) $ Const ("True",_) $ q => q 
   2.571 -  | Const("op =", Type ("fun",[Type ("bool", []),_])) $ p $ Const ("True",_) => p 
   2.572 -  | Const("op =", Type ("fun",[Type ("bool", []),_])) $ Const ("False",_) $ q => HOLogic.Not $  q 
   2.573 -  | Const("op =", Type ("fun",[Type ("bool", []),_])) $ p $ Const ("False",_)  => HOLogic.Not $  p 
   2.574 -  | _ => fm; 
   2.575 - 
   2.576 -fun psimpl fm = case fm of 
   2.577 -   Const ("Not",_) $ p => psimpl1 (HOLogic.Not $ (psimpl p)) 
   2.578 -  | Const("op &",_) $ p $ q => psimpl1 (HOLogic.mk_conj (psimpl p,psimpl q)) 
   2.579 -  | Const("op |",_) $ p $ q => psimpl1 (HOLogic.mk_disj (psimpl p,psimpl q)) 
   2.580 -  | Const("op -->",_) $ p $ q => psimpl1 (HOLogic.mk_imp(psimpl p,psimpl q)) 
   2.581 -  | Const("op =", Type ("fun",[Type ("bool", []),_])) $ p $ q => psimpl1 (HOLogic.mk_eq(psimpl p,psimpl q))
   2.582 -  | _ => fm; 
   2.583 - 
   2.584 - 
   2.585 -(*simpl : Simplification of Terms involving quantifiers too. 
   2.586 - This function is able to drop out some quantified expressions where there are no 
   2.587 - bound varaibles.*) 
   2.588 -  
   2.589 -fun simpl1 fm  = 
   2.590 -  case fm of 
   2.591 -    Const("All",_) $Abs(x,_,p) => if (has_bound fm ) then fm  
   2.592 -    				else (update_bounds p 0) 
   2.593 -  | Const("Ex",_) $ Abs (x,_,p) => if has_bound fm then fm  
   2.594 -    				else (update_bounds p 0) 
   2.595 -  | _ => psimpl fm; 
   2.596 - 
   2.597 -fun simpl fm = case fm of 
   2.598 -    Const ("Not",_) $ p => simpl1 (HOLogic.Not $(simpl p))  
   2.599 -  | Const ("op &",_) $ p $ q => simpl1 (HOLogic.mk_conj (simpl p ,simpl q))  
   2.600 -  | Const ("op |",_) $ p $ q => simpl1 (HOLogic.mk_disj (simpl p ,simpl q ))  
   2.601 -  | Const ("op -->",_) $ p $ q => simpl1 (HOLogic.mk_imp(simpl p ,simpl q ))  
   2.602 -  | Const("op =", Type ("fun",[Type ("bool", []),_]))$ p $ q => simpl1 
   2.603 -  (HOLogic.mk_eq(simpl p ,simpl q ))  
   2.604 -(*  | Const ("All",Ta) $ Abs(Vn,VT,p) => simpl1(Const("All",Ta) $ 
   2.605 -  Abs(Vn,VT,simpl p ))  
   2.606 -  | Const ("Ex",Ta)  $ Abs(Vn,VT,p) => simpl1(Const("Ex",Ta)  $ 
   2.607 -  Abs(Vn,VT,simpl p ))  
   2.608 -*)
   2.609 -  | _ => fm; 
   2.610 - 
   2.611 -(* ------------------------------------------------------------------------- *) 
   2.612 - 
   2.613 -(* Puts fm into NNF*) 
   2.614 - 
   2.615 -fun  nnf fm = if (is_arith_rel fm) then fm  
   2.616 -else (case fm of 
   2.617 -  ( Const ("op &",_) $ p $ q)  => HOLogic.conj $ (nnf p) $(nnf q) 
   2.618 -  | (Const("op |",_) $ p $q) => HOLogic.disj $ (nnf p)$(nnf q) 
   2.619 -  | (Const ("op -->",_)  $ p $ q) => HOLogic.disj $ (nnf (HOLogic.Not $ p)) $ (nnf q) 
   2.620 -  | ((Const ("op =", Type ("fun",[Type ("bool", []),_]))) $ p $ q) =>(HOLogic.disj $ (HOLogic.conj $ (nnf p) $ (nnf q)) $ (HOLogic.conj $ (nnf (HOLogic.Not $ p) ) $ (nnf(HOLogic.Not $ q)))) 
   2.621 -  | (Const ("Not",_)) $ ((Const ("Not",_)) $ p) => (nnf p) 
   2.622 -  | (Const ("Not",_)) $ (( Const ("op &",_)) $ p $ q) =>HOLogic.disj $ (nnf(HOLogic.Not $ p)) $ (nnf(HOLogic.Not $q)) 
   2.623 -  | (Const ("Not",_)) $ (( Const ("op |",_)) $ p $ q) =>HOLogic.conj $ (nnf(HOLogic.Not $ p)) $ (nnf(HOLogic.Not $ q)) 
   2.624 -  | (Const ("Not",_)) $ (( Const ("op -->",_)) $ p $ q ) =>HOLogic.conj $ (nnf p) $(nnf(HOLogic.Not $ q)) 
   2.625 -  | (Const ("Not",_)) $ ((Const ("op =", Type ("fun",[Type ("bool", []),_]))) $ p $ q ) =>(HOLogic.disj $ (HOLogic.conj $(nnf p) $ (nnf(HOLogic.Not $ q))) $ (HOLogic.conj $(nnf(HOLogic.Not $ p)) $ (nnf q))) 
   2.626 -  | _ => fm); 
   2.627 - 
   2.628 - 
   2.629 -(* Function remred to remove redundancy in a list while keeping the order of appearance of the 
   2.630 -elements. but VERY INEFFICIENT!! *) 
   2.631 - 
   2.632 -fun remred1 el [] = [] 
   2.633 -    |remred1 el (h::t) = if el=h then (remred1 el t) else h::(remred1 el t); 
   2.634 -     
   2.635 -fun remred [] = [] 
   2.636 -    |remred (x::l) =  x::(remred1 x (remred l)); 
   2.637 - 
   2.638 -(*Makes sure that all free Variables are of the type integer but this function is only 
   2.639 -used temporarily, this job must be done by the parser later on.*) 
   2.640 - 
   2.641 -fun mk_uni_vars T  (node $ rest) = (case node of 
   2.642 -    Free (name,_) => Free (name,T) $ (mk_uni_vars T rest) 
   2.643 -    |_=> (mk_uni_vars T node) $ (mk_uni_vars T rest )  ) 
   2.644 -    |mk_uni_vars T (Free (v,_)) = Free (v,T) 
   2.645 -    |mk_uni_vars T tm = tm; 
   2.646 - 
   2.647 -fun mk_uni_int T (Const (@{const_name HOL.zero},T2)) = if T = T2 then (mk_number 0) else (Const (@{const_name HOL.zero},T2)) 
   2.648 -    |mk_uni_int T (Const (@{const_name HOL.one},T2)) = if T = T2 then (mk_number 1) else (Const (@{const_name HOL.one},T2)) 
   2.649 -    |mk_uni_int T (node $ rest) = (mk_uni_int T node) $ (mk_uni_int T rest )  
   2.650 -    |mk_uni_int T (Abs(AV,AT,p)) = Abs(AV,AT,mk_uni_int T p) 
   2.651 -    |mk_uni_int T tm = tm; 
   2.652 - 
   2.653 -
   2.654 -(* Minusinfinity Version*)    
   2.655 -fun myupto (m:IntInf.int) n = if m > n then [] else m::(myupto (m+1) n)
   2.656 -
   2.657 -fun coopermi vars1 fm = 
   2.658 -  case fm of 
   2.659 -   Const ("Ex",_) $ Abs(x0,T,p0) => 
   2.660 -   let 
   2.661 -    val (xn,p1) = Syntax.variant_abs (x0,T,p0) 
   2.662 -    val x = Free (xn,T)  
   2.663 -    val vars = (xn::vars1) 
   2.664 -    val p = unitycoeff x  (posineq (simpl p1))
   2.665 -    val p_inf = simpl (minusinf x p) 
   2.666 -    val bset = bset x p 
   2.667 -    val js = myupto 1 (divlcm x p)
   2.668 -    fun p_element j b = linrep vars x (linear_add vars b (mk_number j)) p  
   2.669 -    fun stage j = list_disj (linrep vars x (mk_number j) p_inf :: map (p_element j) bset)  
   2.670 -   in (list_disj (map stage js))
   2.671 -    end 
   2.672 -  | _ => error "cooper: not an existential formula"; 
   2.673 - 
   2.674 -
   2.675 -
   2.676 -(* The plusinfinity version of cooper*)
   2.677 -fun cooperpi vars1 fm =
   2.678 -  case fm of
   2.679 -   Const ("Ex",_) $ Abs(x0,T,p0) => let 
   2.680 -    val (xn,p1) = Syntax.variant_abs (x0,T,p0)
   2.681 -    val x = Free (xn,T)
   2.682 -    val vars = (xn::vars1)
   2.683 -    val p = unitycoeff x  (posineq (simpl p1))
   2.684 -    val p_inf = simpl (plusinf x p)
   2.685 -    val aset = aset x p
   2.686 -    val js = myupto 1 (divlcm x p)
   2.687 -    fun p_element j a = linrep vars x (linear_sub vars a (mk_number j)) p
   2.688 -    fun stage j = list_disj (linrep vars x (mk_number j) p_inf :: map (p_element j) aset)
   2.689 -   in (list_disj (map stage js))
   2.690 -   end
   2.691 -  | _ => error "cooper: not an existential formula";
   2.692 -  
   2.693 -
   2.694 -(* Try to find a withness for the formula *)
   2.695 -
   2.696 -fun inf_w mi d vars x p = 
   2.697 -  let val f = if mi then minusinf else plusinf in
   2.698 -   case (simpl (minusinf x p)) of
   2.699 -   Const("True",_)  => (SOME (mk_number 1), HOLogic.true_const)
   2.700 -  |Const("False",_) => (NONE,HOLogic.false_const)
   2.701 -  |F => 
   2.702 -      let 
   2.703 -      fun h n =
   2.704 -       case ((simpl o evalc) (linrep vars x (mk_number n) F)) of 
   2.705 -	Const("True",_) => (SOME (mk_number n),HOLogic.true_const)
   2.706 -       |F' => if n=1 then (NONE,F')
   2.707 -	     else let val (rw,rf) = h (n-1) in 
   2.708 -	       (rw,HOLogic.mk_disj(F',rf))
   2.709 -	     end
   2.710 -
   2.711 -      in (h d)
   2.712 -      end
   2.713 -  end;
   2.714 -
   2.715 -fun set_w d b st vars x p = let 
   2.716 -    fun h ns = case ns of 
   2.717 -    [] => (NONE,HOLogic.false_const)
   2.718 -   |n::nl => ( case ((simpl o evalc) (linrep vars x n p)) of
   2.719 -      Const("True",_) => (SOME n,HOLogic.true_const)
   2.720 -      |F' => let val (rw,rf) = h nl 
   2.721 -             in (rw,HOLogic.mk_disj(F',rf)) 
   2.722 -	     end)
   2.723 -    val f = if b then linear_add else linear_sub
   2.724 -    val p_elements = fold_rev (fn i => fn l => l union (map (fn e => f [] e (mk_number i)) st)) (myupto 1 d) []
   2.725 -    in h p_elements
   2.726 -    end;
   2.727 -
   2.728 -fun withness d b st vars x p = case (inf_w b d vars x p) of 
   2.729 -   (SOME n,_) => (SOME n,HOLogic.true_const)
   2.730 -  |(NONE,Pinf) => (case (set_w d b st vars x p) of 
   2.731 -    (SOME n,_) => (SOME n,HOLogic.true_const)
   2.732 -    |(_,Pst) => (NONE,HOLogic.mk_disj(Pinf,Pst)));
   2.733 -
   2.734 -
   2.735 -
   2.736 -
   2.737 -(*Cooper main procedure*) 
   2.738 -
   2.739 -exception STAGE_TRUE;
   2.740 -
   2.741 -  
   2.742 -fun cooper vars1 fm =
   2.743 -  case fm of
   2.744 -   Const ("Ex",_) $ Abs(x0,T,p0) => let 
   2.745 -    val (xn,p1) = Syntax.variant_abs (x0,T,p0)
   2.746 -    val x = Free (xn,T)
   2.747 -    val vars = (xn::vars1)
   2.748 -(*     val p = unitycoeff x  (posineq (simpl p1)) *)
   2.749 -    val p = unitycoeff x  p1 
   2.750 -    val ast = aset x p
   2.751 -    val bst = bset x p
   2.752 -    val js = myupto 1 (divlcm x p)
   2.753 -    val (p_inf,f,S ) = 
   2.754 -    if (length bst) <= (length ast) 
   2.755 -     then (simpl (minusinf x p),linear_add,bst)
   2.756 -     else (simpl (plusinf x p), linear_sub,ast)
   2.757 -    fun p_element j a = linrep vars x (f vars a (mk_number j)) p
   2.758 -    fun stage j = list_disj (linrep vars x (mk_number j) p_inf :: map (p_element j) S)
   2.759 -    fun stageh n = ((if n = 0 then []
   2.760 -	else 
   2.761 -	let 
   2.762 -	val nth_stage = simpl (evalc (stage n))
   2.763 -	in 
   2.764 -	if (nth_stage = HOLogic.true_const) 
   2.765 -	  then raise STAGE_TRUE 
   2.766 -	  else if (nth_stage = HOLogic.false_const) then stageh (n-1)
   2.767 -	    else nth_stage::(stageh (n-1))
   2.768 -	end )
   2.769 -        handle STAGE_TRUE => [HOLogic.true_const])
   2.770 -    val slist = stageh (divlcm x p)
   2.771 -   in (list_disj slist)
   2.772 -   end
   2.773 -  | _ => error "cooper: not an existential formula";
   2.774 -
   2.775 -
   2.776 -(* A Version of cooper that returns a withness *)
   2.777 -fun cooper_w vars1 fm =
   2.778 -  case fm of
   2.779 -   Const ("Ex",_) $ Abs(x0,T,p0) => let 
   2.780 -    val (xn,p1) = Syntax.variant_abs (x0,T,p0)
   2.781 -    val x = Free (xn,T)
   2.782 -    val vars = (xn::vars1)
   2.783 -(*     val p = unitycoeff x  (posineq (simpl p1)) *)
   2.784 -    val p = unitycoeff x  p1 
   2.785 -    val ast = aset x p
   2.786 -    val bst = bset x p
   2.787 -    val d = divlcm x p
   2.788 -    val (p_inf,S ) = 
   2.789 -    if (length bst) <= (length ast) 
   2.790 -     then (true,bst)
   2.791 -     else (false,ast)
   2.792 -    in withness d p_inf S vars x p 
   2.793 -(*    fun p_element j a = linrep vars x (f vars a (mk_number j)) p
   2.794 -    fun stage j = list_disj (linrep vars x (mk_number j) p_inf :: map (p_element j) S)
   2.795 -   in (list_disj (map stage js))
   2.796 -*)
   2.797 -   end
   2.798 -  | _ => error "cooper: not an existential formula";
   2.799 -
   2.800 - 
   2.801 -(* ------------------------------------------------------------------------- *) 
   2.802 -(* Free variables in terms and formulas.	                             *) 
   2.803 -(* ------------------------------------------------------------------------- *) 
   2.804 - 
   2.805 -fun fvt tml = case tml of 
   2.806 -    [] => [] 
   2.807 -  | Free(x,_)::r => x::(fvt r) 
   2.808 - 
   2.809 -fun fv fm = fvt (term_frees fm); 
   2.810 - 
   2.811 - 
   2.812 -(* ========================================================================= *) 
   2.813 -(* Quantifier elimination.                                                   *) 
   2.814 -(* ========================================================================= *) 
   2.815 -(*conj[/disj]uncts lists iterated conj[disj]unctions*) 
   2.816 - 
   2.817 -fun disjuncts fm = case fm of 
   2.818 -    Const ("op |",_) $ p $ q => (disjuncts p) @ (disjuncts q) 
   2.819 -  | _ => [fm]; 
   2.820 - 
   2.821 -fun conjuncts fm = case fm of 
   2.822 -    Const ("op &",_) $p $ q => (conjuncts p) @ (conjuncts q) 
   2.823 -  | _ => [fm]; 
   2.824 - 
   2.825 - 
   2.826 - 
   2.827 -(* ------------------------------------------------------------------------- *) 
   2.828 -(* Lift procedure given literal modifier, formula normalizer & basic quelim. *) 
   2.829 -(* ------------------------------------------------------------------------- *)
   2.830 -
   2.831 -fun lift_qelim afn nfn qfn isat = 
   2.832 -let 
   2.833 -fun qelift vars fm = if (isat fm) then afn vars fm 
   2.834 -else  
   2.835 -case fm of 
   2.836 -  Const ("Not",_) $ p => HOLogic.Not $ (qelift vars p) 
   2.837 -  | Const ("op &",_) $ p $q => HOLogic.conj $ (qelift vars p) $ (qelift vars q) 
   2.838 -  | Const ("op |",_) $ p $ q => HOLogic.disj $ (qelift vars p) $ (qelift vars q) 
   2.839 -  | Const ("op -->",_) $ p $ q => HOLogic.imp $ (qelift vars p) $ (qelift vars q) 
   2.840 -  | Const ("op =",Type ("fun",[Type ("bool", []),_])) $ p $ q => HOLogic.mk_eq ((qelift vars p),(qelift vars q)) 
   2.841 -  | Const ("All",QT) $ Abs(x,T,p) => HOLogic.Not $(qelift vars (Const ("Ex",QT) $ Abs(x,T,(HOLogic.Not $ p)))) 
   2.842 -  | (e as Const ("Ex",_)) $ Abs (x,T,p)  =>  qfn vars (e$Abs (x,T,(nfn(qelift (x::vars) p))))
   2.843 -  | _ => fm 
   2.844 - 
   2.845 -in (fn fm => qelift (fv fm) fm)
   2.846 -end; 
   2.847 -
   2.848 - 
   2.849 -(*   
   2.850 -fun lift_qelim afn nfn qfn isat = 
   2.851 - let   fun qelim x vars p = 
   2.852 -  let val cjs = conjuncts p 
   2.853 -      val (ycjs,ncjs) = List.partition (has_bound) cjs in 
   2.854 -      (if ycjs = [] then p else 
   2.855 -                          let val q = (qfn vars ((HOLogic.exists_const HOLogic.intT 
   2.856 -			  ) $ Abs(x,HOLogic.intT,(list_conj ycjs)))) in 
   2.857 -                          (fold_rev conj_help ncjs q)  
   2.858 -			  end) 
   2.859 -       end 
   2.860 -    
   2.861 -  fun qelift vars fm = if (isat fm) then afn vars fm 
   2.862 -    else  
   2.863 -    case fm of 
   2.864 -      Const ("Not",_) $ p => HOLogic.Not $ (qelift vars p) 
   2.865 -    | Const ("op &",_) $ p $q => HOLogic.conj $ (qelift vars p) $ (qelift vars q) 
   2.866 -    | Const ("op |",_) $ p $ q => HOLogic.disj $ (qelift vars p) $ (qelift vars q) 
   2.867 -    | Const ("op -->",_) $ p $ q => HOLogic.imp $ (qelift vars p) $ (qelift vars q) 
   2.868 -    | Const ("op =",Type ("fun",[Type ("bool", []),_])) $ p $ q => HOLogic.mk_eq ((qelift vars p),(qelift vars q)) 
   2.869 -    | Const ("All",QT) $ Abs(x,T,p) => HOLogic.Not $(qelift vars (Const ("Ex",QT) $ Abs(x,T,(HOLogic.Not $ p)))) 
   2.870 -    | Const ("Ex",_) $ Abs (x,T,p)  => let  val djs = disjuncts(nfn(qelift (x::vars) p)) in 
   2.871 -    			list_disj(map (qelim x vars) djs) end 
   2.872 -    | _ => fm 
   2.873 - 
   2.874 -  in (fn fm => simpl(qelift (fv fm) fm)) 
   2.875 -  end; 
   2.876 -*)
   2.877 - 
   2.878 -(* ------------------------------------------------------------------------- *) 
   2.879 -(* Cleverer (proposisional) NNF with conditional and literal modification.   *) 
   2.880 -(* ------------------------------------------------------------------------- *) 
   2.881 - 
   2.882 -(*Function Negate used by cnnf, negates a formula p*) 
   2.883 - 
   2.884 -fun negate (Const ("Not",_) $ p) = p 
   2.885 -    |negate p = (HOLogic.Not $ p); 
   2.886 - 
   2.887 -fun cnnf lfn = 
   2.888 -  let fun cnnfh fm = case  fm of 
   2.889 -      (Const ("op &",_) $ p $ q) => HOLogic.mk_conj(cnnfh p,cnnfh q) 
   2.890 -    | (Const ("op |",_) $ p $ q) => HOLogic.mk_disj(cnnfh p,cnnfh q) 
   2.891 -    | (Const ("op -->",_) $ p $q) => HOLogic.mk_disj(cnnfh(HOLogic.Not $ p),cnnfh q) 
   2.892 -    | (Const ("op =",Type ("fun",[Type ("bool", []),_])) $ p $ q) => HOLogic.mk_disj( 
   2.893 -    		HOLogic.mk_conj(cnnfh p,cnnfh q), 
   2.894 -		HOLogic.mk_conj(cnnfh(HOLogic.Not $ p),cnnfh(HOLogic.Not $q))) 
   2.895 -
   2.896 -    | (Const ("Not",_) $ (Const("Not",_) $ p)) => cnnfh p 
   2.897 -    | (Const ("Not",_) $ (Const ("op &",_) $ p $ q)) => HOLogic.mk_disj(cnnfh(HOLogic.Not $ p),cnnfh(HOLogic.Not $ q)) 
   2.898 -    | (Const ("Not",_) $(Const ("op |",_) $ (Const ("op &",_) $ p $ q) $  
   2.899 -    			(Const ("op &",_) $ p1 $ r))) => if p1 = negate p then 
   2.900 -		         HOLogic.mk_disj(  
   2.901 -			   cnnfh (HOLogic.mk_conj(p,cnnfh(HOLogic.Not $ q))), 
   2.902 -			   cnnfh (HOLogic.mk_conj(p1,cnnfh(HOLogic.Not $ r)))) 
   2.903 -			 else  HOLogic.mk_conj(
   2.904 -			  cnnfh (HOLogic.mk_disj(cnnfh (HOLogic.Not $ p),cnnfh(HOLogic.Not $ q))), 
   2.905 -			   cnnfh (HOLogic.mk_disj(cnnfh (HOLogic.Not $ p1),cnnfh(HOLogic.Not $ r)))
   2.906 -			 ) 
   2.907 -    | (Const ("Not",_) $ (Const ("op |",_) $ p $ q)) => HOLogic.mk_conj(cnnfh(HOLogic.Not $ p),cnnfh(HOLogic.Not $ q)) 
   2.908 -    | (Const ("Not",_) $ (Const ("op -->",_) $ p $q)) => HOLogic.mk_conj(cnnfh p,cnnfh(HOLogic.Not $ q)) 
   2.909 -    | (Const ("Not",_) $ (Const ("op =",Type ("fun",[Type ("bool", []),_]))  $ p $ q)) => HOLogic.mk_disj(HOLogic.mk_conj(cnnfh p,cnnfh(HOLogic.Not $ q)),HOLogic.mk_conj(cnnfh(HOLogic.Not $ p),cnnfh q)) 
   2.910 -    | _ => lfn fm  
   2.911 -in cnnfh
   2.912 - end; 
   2.913 - 
   2.914 -(*End- function the quantifierelimination an decion procedure of presburger formulas.*)   
   2.915 -
   2.916 -(*
   2.917 -val integer_qelim = simpl o evalc o (lift_qelim linform (simpl o (cnnf posineq o evalc)) cooper is_arith_rel) ; 
   2.918 -*)
   2.919 -
   2.920 -
   2.921 -val integer_qelim = simpl o evalc o (lift_qelim linform (cnnf posineq o evalc) cooper is_arith_rel) ; 
   2.922 -
   2.923 -end;
     3.1 --- a/src/HOL/Integ/cooper_proof.ML	Thu May 31 11:00:06 2007 +0200
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,988 +0,0 @@
     3.4 -(*  Title:      HOL/Integ/cooper_proof.ML
     3.5 -    ID:         $Id$
     3.6 -    Author:     Amine Chaieb and Tobias Nipkow, TU Muenchen
     3.7 -
     3.8 -File containing the implementation of the proof
     3.9 -generation for Cooper Algorithm
    3.10 -*)
    3.11 -
    3.12 -
    3.13 -signature COOPER_PROOF =
    3.14 -sig
    3.15 -  val qe_Not : thm
    3.16 -  val qe_conjI : thm
    3.17 -  val qe_disjI : thm
    3.18 -  val qe_impI : thm
    3.19 -  val qe_eqI : thm
    3.20 -  val qe_exI : thm
    3.21 -  val list_to_set : typ -> term list -> term
    3.22 -  val qe_get_terms : thm -> term * term
    3.23 -  val cooper_prv  : theory -> term -> term -> thm
    3.24 -  val proof_of_evalc : theory -> term -> thm
    3.25 -  val proof_of_cnnf : theory -> term -> (term -> thm) -> thm
    3.26 -  val proof_of_linform : theory -> string list -> term -> thm
    3.27 -  val proof_of_adjustcoeffeq : theory -> term -> IntInf.int -> term -> thm
    3.28 -  val prove_elementar : theory -> string -> term -> thm
    3.29 -  val thm_of : theory -> (term -> (term list * (thm list -> thm))) -> term -> thm
    3.30 -end;
    3.31 -
    3.32 -structure CooperProof : COOPER_PROOF =
    3.33 -struct
    3.34 -open CooperDec;
    3.35 -
    3.36 -val presburger_ss = simpset ()
    3.37 -  addsimps [diff_int_def] delsimps [thm "diff_int_def_symmetric"];
    3.38 -
    3.39 -val cboolT = ctyp_of HOL.thy HOLogic.boolT;
    3.40 -
    3.41 -(*Theorems that will be used later for the proofgeneration*)
    3.42 -
    3.43 -val zdvd_iff_zmod_eq_0 = thm "zdvd_iff_zmod_eq_0";
    3.44 -val unity_coeff_ex = thm "unity_coeff_ex";
    3.45 -
    3.46 -(* Theorems for proving the adjustment of the coefficients*)
    3.47 -
    3.48 -val ac_lt_eq =  thm "ac_lt_eq";
    3.49 -val ac_eq_eq = thm "ac_eq_eq";
    3.50 -val ac_dvd_eq = thm "ac_dvd_eq";
    3.51 -val ac_pi_eq = thm "ac_pi_eq";
    3.52 -
    3.53 -(* The logical compination of the sythetised properties*)
    3.54 -val qe_Not = thm "qe_Not";
    3.55 -val qe_conjI = thm "qe_conjI";
    3.56 -val qe_disjI = thm "qe_disjI";
    3.57 -val qe_impI = thm "qe_impI";
    3.58 -val qe_eqI = thm "qe_eqI";
    3.59 -val qe_exI = thm "qe_exI";
    3.60 -val qe_ALLI = thm "qe_ALLI";
    3.61 -
    3.62 -(*Modulo D property for Pminusinf an Plusinf *)
    3.63 -val fm_modd_minf = thm "fm_modd_minf";
    3.64 -val not_dvd_modd_minf = thm "not_dvd_modd_minf";
    3.65 -val dvd_modd_minf = thm "dvd_modd_minf";
    3.66 -
    3.67 -val fm_modd_pinf = thm "fm_modd_pinf";
    3.68 -val not_dvd_modd_pinf = thm "not_dvd_modd_pinf";
    3.69 -val dvd_modd_pinf = thm "dvd_modd_pinf";
    3.70 -
    3.71 -(* the minusinfinity proprty*)
    3.72 -
    3.73 -val fm_eq_minf = thm "fm_eq_minf";
    3.74 -val neq_eq_minf = thm "neq_eq_minf";
    3.75 -val eq_eq_minf = thm "eq_eq_minf";
    3.76 -val le_eq_minf = thm "le_eq_minf";
    3.77 -val len_eq_minf = thm "len_eq_minf";
    3.78 -val not_dvd_eq_minf = thm "not_dvd_eq_minf";
    3.79 -val dvd_eq_minf = thm "dvd_eq_minf";
    3.80 -
    3.81 -(* the Plusinfinity proprty*)
    3.82 -
    3.83 -val fm_eq_pinf = thm "fm_eq_pinf";
    3.84 -val neq_eq_pinf = thm "neq_eq_pinf";
    3.85 -val eq_eq_pinf = thm "eq_eq_pinf";
    3.86 -val le_eq_pinf = thm "le_eq_pinf";
    3.87 -val len_eq_pinf = thm "len_eq_pinf";
    3.88 -val not_dvd_eq_pinf = thm "not_dvd_eq_pinf";
    3.89 -val dvd_eq_pinf = thm "dvd_eq_pinf";
    3.90 -
    3.91 -(*Logical construction of the Property*)
    3.92 -val eq_minf_conjI = thm "eq_minf_conjI";
    3.93 -val eq_minf_disjI = thm "eq_minf_disjI";
    3.94 -val modd_minf_disjI = thm "modd_minf_disjI";
    3.95 -val modd_minf_conjI = thm "modd_minf_conjI";
    3.96 -
    3.97 -val eq_pinf_conjI = thm "eq_pinf_conjI";
    3.98 -val eq_pinf_disjI = thm "eq_pinf_disjI";
    3.99 -val modd_pinf_disjI = thm "modd_pinf_disjI";
   3.100 -val modd_pinf_conjI = thm "modd_pinf_conjI";
   3.101 -
   3.102 -(*Cooper Backwards...*)
   3.103 -(*Bset*)
   3.104 -val not_bst_p_fm = thm "not_bst_p_fm";
   3.105 -val not_bst_p_ne = thm "not_bst_p_ne";
   3.106 -val not_bst_p_eq = thm "not_bst_p_eq";
   3.107 -val not_bst_p_gt = thm "not_bst_p_gt";
   3.108 -val not_bst_p_lt = thm "not_bst_p_lt";
   3.109 -val not_bst_p_ndvd = thm "not_bst_p_ndvd";
   3.110 -val not_bst_p_dvd = thm "not_bst_p_dvd";
   3.111 -
   3.112 -(*Aset*)
   3.113 -val not_ast_p_fm = thm "not_ast_p_fm";
   3.114 -val not_ast_p_ne = thm "not_ast_p_ne";
   3.115 -val not_ast_p_eq = thm "not_ast_p_eq";
   3.116 -val not_ast_p_gt = thm "not_ast_p_gt";
   3.117 -val not_ast_p_lt = thm "not_ast_p_lt";
   3.118 -val not_ast_p_ndvd = thm "not_ast_p_ndvd";
   3.119 -val not_ast_p_dvd = thm "not_ast_p_dvd";
   3.120 -
   3.121 -(*Logical construction of the prop*)
   3.122 -(*Bset*)
   3.123 -val not_bst_p_conjI = thm "not_bst_p_conjI";
   3.124 -val not_bst_p_disjI = thm "not_bst_p_disjI";
   3.125 -val not_bst_p_Q_elim = thm "not_bst_p_Q_elim";
   3.126 -
   3.127 -(*Aset*)
   3.128 -val not_ast_p_conjI = thm "not_ast_p_conjI";
   3.129 -val not_ast_p_disjI = thm "not_ast_p_disjI";
   3.130 -val not_ast_p_Q_elim = thm "not_ast_p_Q_elim";
   3.131 -
   3.132 -(*Cooper*)
   3.133 -val cppi_eq = thm "cppi_eq";
   3.134 -val cpmi_eq = thm "cpmi_eq";
   3.135 -
   3.136 -(*Others*)
   3.137 -val simp_from_to = thm "simp_from_to";
   3.138 -val P_eqtrue = thm "P_eqtrue";
   3.139 -val P_eqfalse = thm "P_eqfalse";
   3.140 -
   3.141 -(*For Proving NNF*)
   3.142 -
   3.143 -val nnf_nn = thm "nnf_nn";
   3.144 -val nnf_im = thm "nnf_im";
   3.145 -val nnf_eq = thm "nnf_eq";
   3.146 -val nnf_sdj = thm "nnf_sdj";
   3.147 -val nnf_ncj = thm "nnf_ncj";
   3.148 -val nnf_nim = thm "nnf_nim";
   3.149 -val nnf_neq = thm "nnf_neq";
   3.150 -val nnf_ndj = thm "nnf_ndj";
   3.151 -
   3.152 -(*For Proving term linearizition*)
   3.153 -val linearize_dvd = thm "linearize_dvd";
   3.154 -val lf_lt = thm "lf_lt";
   3.155 -val lf_eq = thm "lf_eq";
   3.156 -val lf_dvd = thm "lf_dvd";
   3.157 -
   3.158 -
   3.159 -(* ------------------------------------------------------------------------- *)
   3.160 -(*This function norm_zero_one  replaces the occurences of Numeral1 and Numeral0*)
   3.161 -(*Respectively by their abstract representation Const(@{const_name HOL.one},..) and Const(@{const_name HOL.zero},..)*)
   3.162 -(*this is necessary because the theorems use this representation.*)
   3.163 -(* This function should be elminated in next versions...*)
   3.164 -(* ------------------------------------------------------------------------- *)
   3.165 -
   3.166 -fun norm_zero_one fm = case fm of
   3.167 -  (Const (@{const_name HOL.times},_) $ c $ t) => 
   3.168 -    if c = one then (norm_zero_one t)
   3.169 -    else if (dest_number c = ~1) 
   3.170 -         then (Const(@{const_name HOL.uminus},HOLogic.intT --> HOLogic.intT) $ (norm_zero_one t))
   3.171 -         else (HOLogic.mk_binop @{const_name HOL.times} (norm_zero_one c,norm_zero_one t))
   3.172 -  |(node $ rest) => ((norm_zero_one node)$(norm_zero_one rest))
   3.173 -  |(Abs(x,T,p)) => (Abs(x,T,(norm_zero_one p)))
   3.174 -  |_ => fm;
   3.175 -
   3.176 -(* ------------------------------------------------------------------------- *)
   3.177 -(*function list to Set, constructs a set containing all elements of a given list.*)
   3.178 -(* ------------------------------------------------------------------------- *)
   3.179 -fun list_to_set T1 l = let val T = (HOLogic.mk_setT T1) in 
   3.180 -	case l of 
   3.181 -		[] => Const ("{}",T)
   3.182 -		|(h::t) => Const("insert", T1 --> (T --> T)) $ h $(list_to_set T1 t)
   3.183 -		end;
   3.184 -		
   3.185 -(* ------------------------------------------------------------------------- *)
   3.186 -(* Returns both sides of an equvalence in the theorem*)
   3.187 -(* ------------------------------------------------------------------------- *)
   3.188 -fun qe_get_terms th = let val (_$(Const("op =",Type ("fun",[Type ("bool", []),_])) $ A $ B )) = prop_of th in (A,B) end;
   3.189 -
   3.190 -(* ------------------------------------------------------------------------- *)
   3.191 -(*This function proove elementar will be used to generate proofs at
   3.192 -  runtime*) (*It is thought to prove properties such as a dvd b
   3.193 -  (essentially) that are only to make at runtime.*)
   3.194 -(* ------------------------------------------------------------------------- *)
   3.195 -fun prove_elementar thy s fm2 =
   3.196 -  Goal.prove (ProofContext.init thy) [] [] (HOLogic.mk_Trueprop fm2) (fn _ => EVERY
   3.197 -  (case s of
   3.198 -  (*"ss" like simplification with simpset*)
   3.199 -  "ss" =>
   3.200 -    let val ss = presburger_ss addsimps [zdvd_iff_zmod_eq_0,unity_coeff_ex]
   3.201 -    in [simp_tac ss 1, TRY (simple_arith_tac 1)] end
   3.202 -
   3.203 -  (*"bl" like blast tactic*)
   3.204 -  (* Is only used in the harrisons like proof procedure *)
   3.205 -  | "bl" => [blast_tac HOL_cs 1]
   3.206 -
   3.207 -  (*"ed" like Existence disjunctions ...*)
   3.208 -  (* Is only used in the harrisons like proof procedure *)
   3.209 -  | "ed" =>
   3.210 -    let
   3.211 -      val ex_disj_tacs =
   3.212 -        let
   3.213 -          val tac1 = EVERY[REPEAT(resolve_tac [disjI1,disjI2] 1), etac exI 1]
   3.214 -          val tac2 = EVERY[etac exE 1, rtac exI 1,
   3.215 -            REPEAT(resolve_tac [disjI1,disjI2] 1), assumption 1]
   3.216 -	in [rtac iffI 1,
   3.217 -          etac exE 1, REPEAT(EVERY[etac disjE 1, tac1]), tac1,
   3.218 -          REPEAT(EVERY[etac disjE 1, tac2]), tac2]
   3.219 -        end
   3.220 -    in ex_disj_tacs end
   3.221 -
   3.222 -  | "fa" => [simple_arith_tac 1]
   3.223 -
   3.224 -  | "sa" =>
   3.225 -    let val ss = presburger_ss addsimps zadd_ac
   3.226 -    in [simp_tac ss 1, TRY (simple_arith_tac 1)] end
   3.227 -
   3.228 -  (* like Existance Conjunction *)
   3.229 -  | "ec" =>
   3.230 -    let val ss = presburger_ss addsimps zadd_ac
   3.231 -    in [simp_tac ss 1, TRY (blast_tac HOL_cs 1)] end
   3.232 -
   3.233 -  | "ac" =>
   3.234 -    let val ss = HOL_basic_ss addsimps zadd_ac
   3.235 -    in [simp_tac ss 1] end
   3.236 -
   3.237 -  | "lf" =>
   3.238 -    let val ss = presburger_ss addsimps zadd_ac
   3.239 -    in [simp_tac ss 1, TRY (simple_arith_tac 1)] end));
   3.240 -
   3.241 -(*=============================================================*)
   3.242 -(*-------------------------------------------------------------*)
   3.243 -(*              The new compact model                          *)
   3.244 -(*-------------------------------------------------------------*)
   3.245 -(*=============================================================*)
   3.246 -
   3.247 -fun thm_of sg decomp t = 
   3.248 -    let val (ts,recomb) = decomp t 
   3.249 -    in recomb (map (thm_of sg decomp) ts) 
   3.250 -    end;
   3.251 -
   3.252 -(*==================================================*)
   3.253 -(*     Compact Version for adjustcoeffeq            *)
   3.254 -(*==================================================*)
   3.255 -
   3.256 -fun decomp_adjustcoeffeq sg x l fm = case fm of
   3.257 -    (Const("Not",_)$(Const(@{const_name Orderings.less},_) $ zero $(rt as (Const (@{const_name HOL.plus}, _)$(Const (@{const_name HOL.times},_) $    c $ y ) $z )))) => 
   3.258 -     let  
   3.259 -        val m = l div (dest_number c) 
   3.260 -        val n = if (x = y) then abs (m) else 1
   3.261 -        val xtm = (HOLogic.mk_binop @{const_name HOL.times} ((mk_number ((m div n)*l) ), x)) 
   3.262 -        val rs = if (x = y) 
   3.263 -                 then (HOLogic.mk_binrel @{const_name Orderings.less} (zero,linear_sub [] (mk_number n) (HOLogic.mk_binop @{const_name HOL.plus} ( xtm ,( linear_cmul n z) )))) 
   3.264 -                 else HOLogic.mk_binrel @{const_name Orderings.less} (zero,linear_sub [] one rt )
   3.265 -        val ck = cterm_of sg (mk_number n)
   3.266 -        val cc = cterm_of sg c
   3.267 -        val ct = cterm_of sg z
   3.268 -        val cx = cterm_of sg y
   3.269 -        val pre = prove_elementar sg "lf" 
   3.270 -            (HOLogic.mk_binrel @{const_name Orderings.less} (zero, mk_number n))
   3.271 -        val th1 = (pre RS (instantiate' [] [SOME ck,SOME cc, SOME cx, SOME ct] (ac_pi_eq)))
   3.272 -        in ([], fn [] => [th1,(prove_elementar sg "sa" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
   3.273 -        end
   3.274 -
   3.275 -  |(Const(p,_) $a $( Const (@{const_name HOL.plus}, _)$(Const (@{const_name HOL.times},_) $ 
   3.276 -      c $ y ) $t )) => 
   3.277 -   if (is_arith_rel fm) andalso (x = y) 
   3.278 -   then  
   3.279 -        let val m = l div (dest_number c) 
   3.280 -           val k = (if p = @{const_name Orderings.less} then abs(m) else m)  
   3.281 -           val xtm = (HOLogic.mk_binop @{const_name HOL.times} ((mk_number ((m div k)*l) ), x))
   3.282 -           val rs = (HOLogic.mk_binrel p ((linear_cmul k a),(HOLogic.mk_binop @{const_name HOL.plus} ( xtm ,( linear_cmul k t) )))) 
   3.283 -
   3.284 -           val ck = cterm_of sg (mk_number k)
   3.285 -           val cc = cterm_of sg c
   3.286 -           val ct = cterm_of sg t
   3.287 -           val cx = cterm_of sg x
   3.288 -           val ca = cterm_of sg a
   3.289 -
   3.290 -	   in 
   3.291 -	case p of
   3.292 -	  @{const_name Orderings.less} => 
   3.293 -	let val pre = prove_elementar sg "lf" 
   3.294 -	    (HOLogic.mk_binrel @{const_name Orderings.less} (zero, mk_number k))
   3.295 -            val th1 = (pre RS (instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct] (ac_lt_eq)))
   3.296 -	in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
   3.297 -         end
   3.298 -
   3.299 -           |"op =" =>
   3.300 -	     let val pre = prove_elementar sg "lf" 
   3.301 -	    (HOLogic.Not $ (HOLogic.mk_binrel "op =" (zero, mk_number k)))
   3.302 -	         val th1 = (pre RS(instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct] (ac_eq_eq)))
   3.303 -	     in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
   3.304 -             end
   3.305 -
   3.306 -             |"Divides.dvd" =>
   3.307 -	       let val pre = prove_elementar sg "lf" 
   3.308 -	   (HOLogic.Not $ (HOLogic.mk_binrel "op =" (zero, mk_number k)))
   3.309 -                   val th1 = (pre RS (instantiate' [] [SOME ck,SOME ca,SOME cc, SOME cx, SOME ct]) (ac_dvd_eq))
   3.310 -               in ([], fn [] => [th1,(prove_elementar sg "lf" (HOLogic.mk_eq (snd (qe_get_terms th1) ,rs)))] MRS trans)
   3.311 -                        
   3.312 -               end
   3.313 -              end
   3.314 -  else ([], fn [] => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] refl)
   3.315 -
   3.316 - |( Const ("Not", _) $ p) => ([p], fn [th] => th RS qe_Not)
   3.317 -  |( Const ("op &",_) $ p $ q) => ([p,q], fn [th1,th2] => [th1,th2] MRS qe_conjI)
   3.318 -  |( Const ("op |",_) $ p $ q) =>([p,q], fn [th1,th2] => [th1,th2] MRS qe_disjI)
   3.319 -
   3.320 -  |_ => ([], fn [] => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] refl);
   3.321 -
   3.322 -fun proof_of_adjustcoeffeq sg x l = thm_of sg (decomp_adjustcoeffeq sg x l);
   3.323 -
   3.324 -
   3.325 -
   3.326 -(*==================================================*)
   3.327 -(*   Finding rho for modd_minusinfinity             *)
   3.328 -(*==================================================*)
   3.329 -fun rho_for_modd_minf x dlcm sg fm1 =
   3.330 -let
   3.331 -    (*Some certified Terms*)
   3.332 -    
   3.333 -   val ctrue = cterm_of sg HOLogic.true_const
   3.334 -   val cfalse = cterm_of sg HOLogic.false_const
   3.335 -   val fm = norm_zero_one fm1
   3.336 -  in  case fm1 of 
   3.337 -      (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z))) => 
   3.338 -         if (x=y) andalso (c1= zero) andalso (c2= one) then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_minf))
   3.339 -           else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
   3.340 -
   3.341 -      |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   3.342 -  	   if (is_arith_rel fm) andalso (x=y) andalso (c1= zero) andalso (c2= one) 
   3.343 -	   then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_minf))
   3.344 -	 	 else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf)) 
   3.345 -
   3.346 -      |(Const(@{const_name Orderings.less},_) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z )) =>
   3.347 -           if (y=x) andalso (c1 = zero) then 
   3.348 -            if (pm1 = one) then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_minf)) else
   3.349 -	     (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_minf))
   3.350 -	    else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
   3.351 -  
   3.352 -      |Const ("Not",_) $ (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.353 -         if y=x then  let val cz = cterm_of sg (norm_zero_one z)
   3.354 -			  val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero)
   3.355 -	 	      in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_minf)))
   3.356 -		      end
   3.357 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
   3.358 -      |(Const("Divides.dvd",_)$ d $ (db as (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $
   3.359 -      c $ y ) $ z))) => 
   3.360 -         if y=x then  let val cz = cterm_of sg (norm_zero_one z)
   3.361 -			  val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero)
   3.362 -	 	      in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_minf)))
   3.363 -		      end
   3.364 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf))
   3.365 -		
   3.366 -    
   3.367 -   |_ => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_minf)
   3.368 -   end;	 
   3.369 -(*=========================================================================*)
   3.370 -(*=========================================================================*)
   3.371 -fun rho_for_eq_minf x dlcm  sg fm1 =  
   3.372 -   let
   3.373 -   val fm = norm_zero_one fm1
   3.374 -    in  case fm1 of 
   3.375 -      (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z))) => 
   3.376 -         if  (x=y) andalso (c1=zero) andalso (c2=one) 
   3.377 -	   then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (neq_eq_minf))
   3.378 -           else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
   3.379 -
   3.380 -      |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   3.381 -  	   if (is_arith_rel fm) andalso (x=y) andalso ((c1=zero) orelse (c1 = norm_zero_one zero)) andalso ((c2=one) orelse (c1 = norm_zero_one one))
   3.382 -	     then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (eq_eq_minf))
   3.383 -	     else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf)) 
   3.384 -
   3.385 -      |(Const(@{const_name Orderings.less},_) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z )) =>
   3.386 -           if (y=x) andalso (c1 =zero) then 
   3.387 -            if pm1 = one then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (le_eq_minf)) else
   3.388 -	     (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (len_eq_minf))
   3.389 -	    else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
   3.390 -      |Const ("Not",_) $ (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.391 -         if y=x then  let val cd = cterm_of sg (norm_zero_one d)
   3.392 -	 		  val cz = cterm_of sg (norm_zero_one z)
   3.393 -	 	      in(instantiate' [] [SOME cd,  SOME cz] (not_dvd_eq_minf)) 
   3.394 -		      end
   3.395 -
   3.396 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
   3.397 -		
   3.398 -      |(Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.399 -         if y=x then  let val cd = cterm_of sg (norm_zero_one d)
   3.400 -	 		  val cz = cterm_of sg (norm_zero_one z)
   3.401 -	 	      in(instantiate' [] [SOME cd, SOME cz ] (dvd_eq_minf))
   3.402 -		      end
   3.403 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
   3.404 -
   3.405 -      		
   3.406 -    |_ => (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_minf))
   3.407 - end;
   3.408 -
   3.409 -(*=====================================================*)
   3.410 -(*=====================================================*)
   3.411 -(*=========== minf proofs with the compact version==========*)
   3.412 -fun decomp_minf_eq x dlcm sg t =  case t of
   3.413 -   Const ("op &",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS eq_minf_conjI)
   3.414 -   |Const ("op |",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS eq_minf_disjI)
   3.415 -   |_ => ([],fn [] => rho_for_eq_minf x dlcm sg t);
   3.416 -
   3.417 -fun decomp_minf_modd x dlcm sg t = case t of
   3.418 -   Const ("op &",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS modd_minf_conjI)
   3.419 -   |Const ("op |",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS modd_minf_disjI)
   3.420 -   |_ => ([],fn [] => rho_for_modd_minf x dlcm sg t);
   3.421 -
   3.422 -(* -------------------------------------------------------------*)
   3.423 -(*                    Finding rho for pinf_modd                 *)
   3.424 -(* -------------------------------------------------------------*)
   3.425 -fun rho_for_modd_pinf x dlcm sg fm1 = 
   3.426 -let
   3.427 -    (*Some certified Terms*)
   3.428 -    
   3.429 -  val ctrue = cterm_of sg HOLogic.true_const
   3.430 -  val cfalse = cterm_of sg HOLogic.false_const
   3.431 -  val fm = norm_zero_one fm1
   3.432 - in  case fm1 of 
   3.433 -      (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z))) => 
   3.434 -         if ((x=y) andalso (c1= zero) andalso (c2= one))
   3.435 -	 then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_pinf))
   3.436 -         else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
   3.437 -
   3.438 -      |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   3.439 -  	if ((is_arith_rel fm) andalso (x = y) andalso (c1 = zero)  andalso (c2 = one)) 
   3.440 -	then (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_pinf))
   3.441 -	else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
   3.442 -
   3.443 -      |(Const(@{const_name Orderings.less},_) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z )) =>
   3.444 -        if ((y=x) andalso (c1 = zero)) then 
   3.445 -          if (pm1 = one) 
   3.446 -	  then (instantiate' [SOME cboolT] [SOME ctrue] (fm_modd_pinf)) 
   3.447 -	  else (instantiate' [SOME cboolT] [SOME cfalse] (fm_modd_pinf))
   3.448 -	else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
   3.449 -  
   3.450 -      |Const ("Not",_) $ (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.451 -         if y=x then  let val cz = cterm_of sg (norm_zero_one z)
   3.452 -			  val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero)
   3.453 -	 	      in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS(((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (not_dvd_modd_pinf)))
   3.454 -		      end
   3.455 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
   3.456 -      |(Const("Divides.dvd",_)$ d $ (db as (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $
   3.457 -      c $ y ) $ z))) => 
   3.458 -         if y=x then  let val cz = cterm_of sg (norm_zero_one z)
   3.459 -			  val fm2 = HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero)
   3.460 -	 	      in(instantiate' [] [SOME cz ] ((((prove_elementar sg "ss" fm2)) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1) ) RS (dvd_modd_pinf)))
   3.461 -		      end
   3.462 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf))
   3.463 -		
   3.464 -    
   3.465 -   |_ => instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_modd_pinf)
   3.466 -   end;	
   3.467 -(* -------------------------------------------------------------*)
   3.468 -(*                    Finding rho for pinf_eq                 *)
   3.469 -(* -------------------------------------------------------------*)
   3.470 -fun rho_for_eq_pinf x dlcm sg fm1 = 
   3.471 -  let
   3.472 -					val fm = norm_zero_one fm1
   3.473 -    in  case fm1 of 
   3.474 -      (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z))) => 
   3.475 -         if  (x=y) andalso (c1=zero) andalso (c2=one) 
   3.476 -	   then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (neq_eq_pinf))
   3.477 -           else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
   3.478 -
   3.479 -      |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   3.480 -  	   if (is_arith_rel fm) andalso (x=y) andalso ((c1=zero) orelse (c1 = norm_zero_one zero)) andalso ((c2=one) orelse (c1 = norm_zero_one one))
   3.481 -	     then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (eq_eq_pinf))
   3.482 -	     else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf)) 
   3.483 -
   3.484 -      |(Const(@{const_name Orderings.less},_) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z )) =>
   3.485 -           if (y=x) andalso (c1 =zero) then 
   3.486 -            if pm1 = one then (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (le_eq_pinf)) else
   3.487 -	     (instantiate' [] [SOME (cterm_of sg (norm_zero_one z))] (len_eq_pinf))
   3.488 -	    else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
   3.489 -      |Const ("Not",_) $ (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.490 -         if y=x then  let val cd = cterm_of sg (norm_zero_one d)
   3.491 -	 		  val cz = cterm_of sg (norm_zero_one z)
   3.492 -	 	      in(instantiate' [] [SOME cd,  SOME cz] (not_dvd_eq_pinf)) 
   3.493 -		      end
   3.494 -
   3.495 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
   3.496 -		
   3.497 -      |(Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.498 -         if y=x then  let val cd = cterm_of sg (norm_zero_one d)
   3.499 -	 		  val cz = cterm_of sg (norm_zero_one z)
   3.500 -	 	      in(instantiate' [] [SOME cd, SOME cz ] (dvd_eq_pinf))
   3.501 -		      end
   3.502 -		else (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
   3.503 -
   3.504 -      		
   3.505 -    |_ => (instantiate' [SOME cboolT] [SOME (cterm_of sg fm)] (fm_eq_pinf))
   3.506 - end;
   3.507 -
   3.508 -
   3.509 -
   3.510 -fun  minf_proof_of_c sg x dlcm t =
   3.511 -  let val minf_eqth   = thm_of sg (decomp_minf_eq x dlcm sg) t
   3.512 -      val minf_moddth = thm_of sg (decomp_minf_modd x dlcm sg) t
   3.513 -  in (minf_eqth, minf_moddth)
   3.514 -end;
   3.515 -
   3.516 -(*=========== pinf proofs with the compact version==========*)
   3.517 -fun decomp_pinf_eq x dlcm sg t = case t of
   3.518 -   Const ("op &",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS eq_pinf_conjI)
   3.519 -   |Const ("op |",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS eq_pinf_disjI)
   3.520 -   |_ =>([],fn [] => rho_for_eq_pinf x dlcm sg t) ;
   3.521 -
   3.522 -fun decomp_pinf_modd x dlcm sg t =  case t of
   3.523 -   Const ("op &",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS modd_pinf_conjI)
   3.524 -   |Const ("op |",_) $ p $q => ([p,q],fn [th1,th2] => [th1,th2] MRS modd_pinf_disjI)
   3.525 -   |_ => ([],fn [] => rho_for_modd_pinf x dlcm sg t);
   3.526 -
   3.527 -fun  pinf_proof_of_c sg x dlcm t =
   3.528 -  let val pinf_eqth   = thm_of sg (decomp_pinf_eq x dlcm sg) t
   3.529 -      val pinf_moddth = thm_of sg (decomp_pinf_modd x dlcm sg) t
   3.530 -  in (pinf_eqth,pinf_moddth)
   3.531 -end;
   3.532 -
   3.533 -
   3.534 -(* ------------------------------------------------------------------------- *)
   3.535 -(* Here we generate the theorem for the Bset Property in the simple direction*)
   3.536 -(* It is just an instantiation*)
   3.537 -(* ------------------------------------------------------------------------- *)
   3.538 -(*
   3.539 -fun bsetproof_of sg (x as Free(xn,xT)) fm bs dlcm   = 
   3.540 -  let
   3.541 -    val cp = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
   3.542 -    val cdlcm = cterm_of sg dlcm
   3.543 -    val cB = cterm_of sg (list_to_set HOLogic.intT (map norm_zero_one bs))
   3.544 -  in instantiate' [] [SOME cdlcm,SOME cB, SOME cp] (bst_thm)
   3.545 -end;
   3.546 -
   3.547 -fun asetproof_of sg (x as Free(xn,xT)) fm ast dlcm = 
   3.548 -  let
   3.549 -    val cp = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
   3.550 -    val cdlcm = cterm_of sg dlcm
   3.551 -    val cA = cterm_of sg (list_to_set HOLogic.intT (map norm_zero_one ast))
   3.552 -  in instantiate' [] [SOME cdlcm,SOME cA, SOME cp] (ast_thm)
   3.553 -end;
   3.554 -*)
   3.555 -
   3.556 -(* For the generation of atomic Theorems*)
   3.557 -(* Prove the premisses on runtime and then make RS*)
   3.558 -(* ------------------------------------------------------------------------- *)
   3.559 -
   3.560 -(*========= this is rho ============*)
   3.561 -fun generate_atomic_not_bst_p sg (x as Free(xn,xT)) fm dlcm B at = 
   3.562 -  let
   3.563 -    val cdlcm = cterm_of sg dlcm
   3.564 -    val cB = cterm_of sg B
   3.565 -    val cfma = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
   3.566 -    val cat = cterm_of sg (norm_zero_one at)
   3.567 -  in
   3.568 -  case at of 
   3.569 -   (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z))) => 
   3.570 -      if  (x=y) andalso (c1=zero) andalso (c2=one) 
   3.571 -	 then let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ B)
   3.572 -	          val th2 =  prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const(@{const_name HOL.uminus},HOLogic.intT --> HOLogic.intT) $(norm_zero_one  z)))
   3.573 -        val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero ,dlcm))
   3.574 -	 in  (instantiate' [] [SOME cfma]([th3,th1,th2] MRS (not_bst_p_ne)))
   3.575 -	 end
   3.576 -         else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
   3.577 -
   3.578 -   |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const (@{const_name HOL.plus}, T) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   3.579 -     if (is_arith_rel at) andalso (x=y)
   3.580 -    then let
   3.581 -      val bst_z = norm_zero_one (linear_neg (linear_add [] z (mk_number 1)))
   3.582 -    in
   3.583 -      let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ bst_z $ B)
   3.584 -	          val th2 =  prove_elementar sg "ss" (HOLogic.mk_eq (bst_z,Const(@{const_name HOL.minus},T) $ (Const(@{const_name HOL.uminus},HOLogic.intT --> HOLogic.intT) $ norm_zero_one z) $ HOLogic.mk_number HOLogic.intT 1))
   3.585 -		  val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero, dlcm))
   3.586 -	 in  (instantiate' [] [SOME cfma] ([th3,th1,th2] MRS (not_bst_p_eq)))
   3.587 -	 end
   3.588 -       end
   3.589 -         else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
   3.590 -
   3.591 -   |(Const(@{const_name Orderings.less},_) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z )) =>
   3.592 -        if (y=x) andalso (c1 =zero) then 
   3.593 -        if pm1 = one then 
   3.594 -	  let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ B)
   3.595 -              val th2 =  prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const(@{const_name HOL.uminus},HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)))
   3.596 -	  in  (instantiate' [] [SOME cfma,  SOME cdlcm]([th1,th2] MRS (not_bst_p_gt)))
   3.597 -	    end
   3.598 -	 else let val th1 = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero, dlcm))
   3.599 -	      in (instantiate' [] [SOME cfma, SOME cB,SOME (cterm_of sg (norm_zero_one z))] (th1 RS (not_bst_p_lt)))
   3.600 -	      end
   3.601 -      else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
   3.602 -
   3.603 -   |Const ("Not",_) $ (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.604 -      if y=x then  
   3.605 -           let val cz = cterm_of sg (norm_zero_one z)
   3.606 -	       val th1 = (prove_elementar sg "ss"  (HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
   3.607 - 	     in (instantiate' []  [SOME cfma, SOME cB,SOME cz] (th1 RS (not_bst_p_ndvd)))
   3.608 -	     end
   3.609 -      else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
   3.610 -
   3.611 -   |(Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.612 -       if y=x then  
   3.613 -	 let val cz = cterm_of sg (norm_zero_one z)
   3.614 -	     val th1 = (prove_elementar sg "ss"  (HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
   3.615 - 	    in (instantiate' []  [SOME cfma,SOME cB,SOME cz] (th1 RS (not_bst_p_dvd)))
   3.616 -	  end
   3.617 -      else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
   3.618 -      		
   3.619 -   |_ => (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cB,SOME cat] (not_bst_p_fm))
   3.620 -      		
   3.621 -    end;
   3.622 -    
   3.623 -
   3.624 -(* ------------------------------------------------------------------------- *)    
   3.625 -(* Main interpretation function for this backwards dirction*)
   3.626 -(* if atomic do generate atomis formulae else Construct theorems and then make RS with the construction theorems*)
   3.627 -(*Help Function*)
   3.628 -(* ------------------------------------------------------------------------- *)
   3.629 -
   3.630 -(*==================== Proof with the compact version   *)
   3.631 -
   3.632 -fun decomp_nbstp sg x dlcm B fm t = case t of 
   3.633 -   Const("op &",_) $ ls $ rs => ([ls,rs],fn [th1,th2] => [th1,th2] MRS not_bst_p_conjI )
   3.634 -  |Const("op |",_) $ ls $ rs => ([ls,rs],fn [th1,th2] => [th1,th2] MRS not_bst_p_disjI)
   3.635 -  |_ => ([], fn [] => generate_atomic_not_bst_p sg x fm dlcm B t);
   3.636 -
   3.637 -fun not_bst_p_proof_of_c sg (x as Free(xn,xT)) fm dlcm B t =
   3.638 -  let 
   3.639 -       val th =  thm_of sg (decomp_nbstp sg x dlcm (list_to_set xT (map norm_zero_one B)) fm) t
   3.640 -      val fma = absfree (xn,xT, norm_zero_one fm)
   3.641 -  in let val th1 =  prove_elementar sg "ss"  (HOLogic.mk_eq (fma,fma))
   3.642 -     in [th,th1] MRS (not_bst_p_Q_elim)
   3.643 -     end
   3.644 -  end;
   3.645 -
   3.646 -
   3.647 -(* ------------------------------------------------------------------------- *)    
   3.648 -(* Protokol interpretation function for the backwards direction for cooper's Theorem*)
   3.649 -
   3.650 -(* For the generation of atomic Theorems*)
   3.651 -(* Prove the premisses on runtime and then make RS*)
   3.652 -(* ------------------------------------------------------------------------- *)
   3.653 -(*========= this is rho ============*)
   3.654 -fun generate_atomic_not_ast_p sg (x as Free(xn,xT)) fm dlcm A at = 
   3.655 -  let
   3.656 -    val cdlcm = cterm_of sg dlcm
   3.657 -    val cA = cterm_of sg A
   3.658 -    val cfma = cterm_of sg (absfree (xn,xT,(norm_zero_one fm)))
   3.659 -    val cat = cterm_of sg (norm_zero_one at)
   3.660 -  in
   3.661 -  case at of 
   3.662 -   (Const ("Not", _) $ (Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $ (Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z))) => 
   3.663 -      if  (x=y) andalso (c1=zero) andalso (c2=one) 
   3.664 -	 then let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one (linear_cmul ~1 z)) $ A)
   3.665 -	          val th2 =  prove_elementar sg "ss" (HOLogic.mk_eq ((norm_zero_one (linear_cmul ~1 z)),Const(@{const_name HOL.uminus},HOLogic.intT --> HOLogic.intT) $(norm_zero_one  z)))
   3.666 -		  val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero, dlcm))
   3.667 -	 in  (instantiate' [] [SOME cfma]([th3,th1,th2] MRS (not_ast_p_ne)))
   3.668 -	 end
   3.669 -         else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
   3.670 -
   3.671 -   |(Const("op =",Type ("fun",[Type ("IntDef.int", []),_])) $ c1 $(Const (@{const_name HOL.plus}, T) $(Const (@{const_name HOL.times},_) $ c2 $ y) $z)) =>
   3.672 -     if (is_arith_rel at) andalso (x=y)
   3.673 -	then let val ast_z = norm_zero_one (linear_sub [] one z )
   3.674 -	         val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ ast_z $ A)
   3.675 -	         val th2 =  prove_elementar sg "ss" (HOLogic.mk_eq (ast_z,Const(@{const_name HOL.plus},T) $ (Const(@{const_name HOL.uminus},HOLogic.intT --> HOLogic.intT) $(norm_zero_one z)) $ one))
   3.676 -		 val th3 = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero, dlcm))
   3.677 -	 in  (instantiate' [] [SOME cfma] ([th3,th1,th2] MRS (not_ast_p_eq)))
   3.678 -       end
   3.679 -         else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
   3.680 -
   3.681 -   |(Const(@{const_name Orderings.less},_) $ c1 $(Const (@{const_name HOL.plus}, _) $(Const (@{const_name HOL.times},_) $ pm1 $ y ) $ z )) =>
   3.682 -        if (y=x) andalso (c1 =zero) then 
   3.683 -        if pm1 = (mk_number ~1) then 
   3.684 -	  let val th1 = prove_elementar sg "ss" (Const ("op :",HOLogic.intT --> (HOLogic.mk_setT HOLogic.intT) --> HOLogic.boolT) $ (norm_zero_one z) $ A)
   3.685 -              val th2 =  prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero,dlcm))
   3.686 -	  in  (instantiate' [] [SOME cfma]([th2,th1] MRS (not_ast_p_lt)))
   3.687 -	    end
   3.688 -	 else let val th1 = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero, dlcm))
   3.689 -	      in (instantiate' [] [SOME cfma, SOME cA,SOME (cterm_of sg (norm_zero_one z))] (th1 RS (not_ast_p_gt)))
   3.690 -	      end
   3.691 -      else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
   3.692 -
   3.693 -   |Const ("Not",_) $ (Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.694 -      if y=x then  
   3.695 -           let val cz = cterm_of sg (norm_zero_one z)
   3.696 -	       val th1 = (prove_elementar sg "ss"  (HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
   3.697 - 	     in (instantiate' []  [SOME cfma, SOME cA,SOME cz] (th1 RS (not_ast_p_ndvd)))
   3.698 -	     end
   3.699 -      else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
   3.700 -
   3.701 -   |(Const("Divides.dvd",_)$ d $ (Const (@{const_name HOL.plus},_) $ (Const (@{const_name HOL.times},_) $ c $ y ) $ z)) => 
   3.702 -       if y=x then  
   3.703 -	 let val cz = cterm_of sg (norm_zero_one z)
   3.704 -	     val th1 = (prove_elementar sg "ss"  (HOLogic.mk_binrel "op =" (HOLogic.mk_binop @{const_name Divides.mod} (dlcm,d),norm_zero_one zero))) RS (((zdvd_iff_zmod_eq_0)RS sym) RS iffD1)
   3.705 - 	    in (instantiate' []  [SOME cfma,SOME cA,SOME cz] (th1 RS (not_ast_p_dvd)))
   3.706 -	  end
   3.707 -      else (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
   3.708 -      		
   3.709 -   |_ => (instantiate' [] [SOME cfma,  SOME cdlcm, SOME cA,SOME cat] (not_ast_p_fm))
   3.710 -      		
   3.711 -    end;
   3.712 -
   3.713 -(* ------------------------------------------------------------------------ *)
   3.714 -(* Main interpretation function for this backwards dirction*)
   3.715 -(* if atomic do generate atomis formulae else Construct theorems and then make RS with the construction theorems*)
   3.716 -(*Help Function*)
   3.717 -(* ------------------------------------------------------------------------- *)
   3.718 -
   3.719 -fun decomp_nastp sg x dlcm A fm t = case t of 
   3.720 -   Const("op &",_) $ ls $ rs => ([ls,rs],fn [th1,th2] => [th1,th2] MRS not_ast_p_conjI )
   3.721 -  |Const("op |",_) $ ls $ rs => ([ls,rs],fn [th1,th2] => [th1,th2] MRS not_ast_p_disjI)
   3.722 -  |_ => ([], fn [] => generate_atomic_not_ast_p sg x fm dlcm A t);
   3.723 -
   3.724 -fun not_ast_p_proof_of_c sg (x as Free(xn,xT)) fm dlcm A t =
   3.725 -  let 
   3.726 -       val th =  thm_of sg (decomp_nastp sg x dlcm (list_to_set xT (map norm_zero_one A)) fm) t
   3.727 -      val fma = absfree (xn,xT, norm_zero_one fm)
   3.728 -  in let val th1 =  prove_elementar sg "ss"  (HOLogic.mk_eq (fma,fma))
   3.729 -     in [th,th1] MRS (not_ast_p_Q_elim)
   3.730 -     end
   3.731 -  end;
   3.732 -
   3.733 -
   3.734 -(* -------------------------------*)
   3.735 -(* Finding rho and beta for evalc *)
   3.736 -(* -------------------------------*)
   3.737 -
   3.738 -fun rho_for_evalc sg at = case at of  
   3.739 -    (Const (p,_) $ s $ t) =>(  
   3.740 -    case AList.lookup (op =) operations p of 
   3.741 -        SOME f => 
   3.742 -           ((if (f ((dest_number s),(dest_number t))) 
   3.743 -             then prove_elementar sg "ss" (HOLogic.mk_eq(at,HOLogic.true_const)) 
   3.744 -             else prove_elementar sg "ss" (HOLogic.mk_eq(at, HOLogic.false_const)))  
   3.745 -		   handle _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl)
   3.746 -        | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl )
   3.747 -     |Const("Not",_)$(Const (p,_) $ s $ t) =>(  
   3.748 -       case AList.lookup (op =) operations p of 
   3.749 -         SOME f => 
   3.750 -           ((if (f ((dest_number s),(dest_number t))) 
   3.751 -             then prove_elementar sg "ss" (HOLogic.mk_eq(at, HOLogic.false_const))  
   3.752 -             else prove_elementar sg "ss" (HOLogic.mk_eq(at,HOLogic.true_const)))  
   3.753 -		      handle _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl) 
   3.754 -         | _ => instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl ) 
   3.755 -     | _ =>   instantiate' [SOME cboolT] [SOME (cterm_of sg at)] refl;
   3.756 -
   3.757 -
   3.758 -(*=========================================================*)
   3.759 -fun decomp_evalc sg t = case t of
   3.760 -   (Const("op &",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_conjI)
   3.761 -   |(Const("op |",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_disjI)
   3.762 -   |(Const("op -->",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_impI)
   3.763 -   |(Const("op =", Type ("fun",[Type ("bool", []),_]))$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_eqI)
   3.764 -   |_ => ([], fn [] => rho_for_evalc sg t);
   3.765 -
   3.766 -
   3.767 -fun proof_of_evalc sg fm = thm_of sg (decomp_evalc sg) fm;
   3.768 -
   3.769 -(*==================================================*)
   3.770 -(*     Proof of linform with the compact model      *)
   3.771 -(*==================================================*)
   3.772 -
   3.773 -
   3.774 -fun decomp_linform sg vars t = case t of
   3.775 -   (Const("op &",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_conjI)
   3.776 -   |(Const("op |",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_disjI)
   3.777 -   |(Const("op -->",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_impI)
   3.778 -   |(Const("op =", Type ("fun",[Type ("bool", []),_]))$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_eqI)
   3.779 -   |(Const("Not",_)$p) => ([p],fn [th] => th RS qe_Not)
   3.780 -   |(Const("Divides.dvd",_)$d$r) => 
   3.781 -     if is_number d then ([], fn [] => (prove_elementar sg "lf" (HOLogic.mk_eq (r, lint vars r))) RS (instantiate' [] [NONE , NONE, SOME (cterm_of sg d)](linearize_dvd)))
   3.782 -     else (warning "Nonlinear Term --- Non numeral leftside at dvd";
   3.783 -       raise COOPER)
   3.784 -   |_ => ([], fn [] => prove_elementar sg "lf" (HOLogic.mk_eq (t, linform vars t)));
   3.785 -
   3.786 -fun proof_of_linform sg vars f = thm_of sg (decomp_linform sg vars) f;
   3.787 -
   3.788 -(* ------------------------------------------------------------------------- *)
   3.789 -(* Interpretaion of Protocols of the cooper procedure : minusinfinity version*)
   3.790 -(* ------------------------------------------------------------------------- *)
   3.791 -fun coopermi_proof_of sg (x as Free(xn,xT)) fm B dlcm =
   3.792 -  (* Get the Bset thm*)
   3.793 -  let val (minf_eqth, minf_moddth) = minf_proof_of_c sg x dlcm fm 
   3.794 -      val dpos = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero,dlcm));
   3.795 -      val nbstpthm = not_bst_p_proof_of_c sg x fm dlcm B fm
   3.796 -  in (dpos,minf_eqth,nbstpthm,minf_moddth)
   3.797 -end;
   3.798 -
   3.799 -(* ------------------------------------------------------------------------- *)
   3.800 -(* Interpretaion of Protocols of the cooper procedure : plusinfinity version *)
   3.801 -(* ------------------------------------------------------------------------- *)
   3.802 -fun cooperpi_proof_of sg (x as Free(xn,xT)) fm A dlcm =
   3.803 -  let val (pinf_eqth,pinf_moddth) = pinf_proof_of_c sg x dlcm fm
   3.804 -      val dpos = prove_elementar sg "ss" (HOLogic.mk_binrel @{const_name Orderings.less} (zero,dlcm));
   3.805 -      val nastpthm = not_ast_p_proof_of_c sg x fm dlcm A fm
   3.806 -  in (dpos,pinf_eqth,nastpthm,pinf_moddth)
   3.807 -end;
   3.808 -
   3.809 -(* ------------------------------------------------------------------------- *)
   3.810 -(* Interpretaion of Protocols of the cooper procedure : full version*)
   3.811 -(* ------------------------------------------------------------------------- *)
   3.812 -fun cooper_thm sg s (x as Free(xn,xT)) cfm dlcm ast bst= case s of
   3.813 -  "pi" => let val (dpsthm,pinf_eqth,nbpth,pinf_moddth) = cooperpi_proof_of sg x cfm ast dlcm 
   3.814 -	      in [dpsthm,pinf_eqth,nbpth,pinf_moddth] MRS (cppi_eq)
   3.815 -           end
   3.816 -  |"mi" => let val (dpsthm,minf_eqth,nbpth,minf_moddth) = coopermi_proof_of sg x cfm bst dlcm
   3.817 -	       in [dpsthm,minf_eqth,nbpth,minf_moddth] MRS (cpmi_eq)
   3.818 -                end
   3.819 - |_ => error "parameter error";
   3.820 -
   3.821 -(* ------------------------------------------------------------------------- *)
   3.822 -(* This function should evoluate to the end prove Procedure for one quantifier elimination for Presburger arithmetic*)
   3.823 -(* It shoud be plugged in the qfnp argument of the quantifier elimination proof function*)
   3.824 -(* ------------------------------------------------------------------------- *)
   3.825 -
   3.826 -(* val (timef:(unit->thm) -> thm,prtime,time_reset) = gen_timer();*)
   3.827 -(* val (timef2:(unit->thm) -> thm,prtime2,time_reset2) = gen_timer(); *)
   3.828 -
   3.829 -fun cooper_prv sg (x as Free(xn,xT)) efm = let 
   3.830 -   (* lfm_thm : efm = linearized form of efm*)
   3.831 -   val lfm_thm = proof_of_linform sg [xn] efm
   3.832 -   (*efm2 is the linearized form of efm *) 
   3.833 -   val efm2 = snd(qe_get_terms lfm_thm)
   3.834 -   (* l is the lcm of all coefficients of x *)
   3.835 -   val l = formlcm x efm2
   3.836 -   (*ac_thm: efm = efm2 with adjusted coefficients of x *)
   3.837 -   val ac_thm = [lfm_thm , (proof_of_adjustcoeffeq sg x l efm2)] MRS trans
   3.838 -   (* fm is efm2 with adjusted coefficients of x *)
   3.839 -   val fm = snd (qe_get_terms ac_thm)
   3.840 -  (* cfm is l dvd x & fm' where fm' is fm where l*x is replaced by x*)
   3.841 -   val  cfm = unitycoeff x fm
   3.842 -   (*afm is fm where c*x is replaced by 1*x or -1*x *)
   3.843 -   val afm = adjustcoeff x l fm
   3.844 -   (* P = %x.afm*)
   3.845 -   val P = absfree(xn,xT,afm)
   3.846 -   (* This simpset allows the elimination of the sets in bex {1..d} *)
   3.847 -   val ss = presburger_ss addsimps
   3.848 -     [simp_from_to] delsimps [P_eqtrue, P_eqfalse, bex_triv, insert_iff]
   3.849 -   (* uth : EX x.P(l*x) = EX x. l dvd x & P x*)
   3.850 -   val uth = instantiate' [] [SOME (cterm_of sg P) , SOME (cterm_of sg (mk_number l))] (unity_coeff_ex)
   3.851 -   (* e_ac_thm : Ex x. efm = EX x. fm*)
   3.852 -   val e_ac_thm = (forall_intr (cterm_of sg x) ac_thm) COMP (qe_exI)
   3.853 -   (* A and B set of the formula*)
   3.854 -   val A = aset x cfm
   3.855 -   val B = bset x cfm
   3.856 -   (* the divlcm (delta) of the formula*)
   3.857 -   val dlcm = mk_number (divlcm x cfm)
   3.858 -   (* Which set is smaller to generate the (hoepfully) shorter proof*)
   3.859 -   val cms = if ((length A) < (length B )) then "pi" else "mi"
   3.860 -(*   val _ = if cms = "pi" then writeln "Plusinfinity" else writeln "Minusinfinity"*)
   3.861 -   (* synthesize the proof of cooper's theorem*)
   3.862 -    (* cp_thm: EX x. cfm = Q*)
   3.863 -   val cp_thm =  cooper_thm sg cms x cfm dlcm A B
   3.864 -   (* Exxpand the right hand side to get rid of EX j : {1..d} to get a huge disjunction*)
   3.865 -   (* exp_cp_thm: EX x.cfm = Q' , where Q' is a simplified version of Q*)
   3.866 -(*
   3.867 -   val _ = prth cp_thm
   3.868 -   val _ = writeln "Expanding the bounded EX..."
   3.869 -*)
   3.870 -   val exp_cp_thm = refl RS (simplify ss (cp_thm RSN (2,trans)))
   3.871 -(*
   3.872 -   val _ = writeln "Expanded" *)
   3.873 -   (* lsuth = EX.P(l*x) ; rsuth = EX x. l dvd x & P x*)
   3.874 -   val (lsuth,rsuth) = qe_get_terms (uth)
   3.875 -   (* lseacth = EX x. efm; rseacth = EX x. fm*)
   3.876 -   val (lseacth,rseacth) = qe_get_terms(e_ac_thm)
   3.877 -   (* lscth = EX x. cfm; rscth = Q' *)
   3.878 -   val (lscth,rscth) = qe_get_terms (exp_cp_thm)
   3.879 -   (* u_c_thm: EX x. P(l*x) = Q'*)
   3.880 -   val  u_c_thm = [([uth,prove_elementar sg "ss" (HOLogic.mk_eq (rsuth,lscth))] MRS trans),exp_cp_thm] MRS trans
   3.881 -   (* result: EX x. efm = Q'*)
   3.882 - in  ([e_ac_thm,[(prove_elementar sg "ss" (HOLogic.mk_eq (rseacth,lsuth))),u_c_thm] MRS trans] MRS trans)
   3.883 -   end
   3.884 -|cooper_prv _ _ _ =  error "Parameters format";
   3.885 -
   3.886 -(* **************************************** *)
   3.887 -(*    An Other Version of cooper proving    *)
   3.888 -(*     by giving a withness for EX          *)
   3.889 -(* **************************************** *)
   3.890 -
   3.891 -
   3.892 -
   3.893 -fun cooper_prv_w sg (x as Free(xn,xT)) efm = let 
   3.894 -   (* lfm_thm : efm = linearized form of efm*)
   3.895 -   val lfm_thm = proof_of_linform sg [xn] efm
   3.896 -   (*efm2 is the linearized form of efm *) 
   3.897 -   val efm2 = snd(qe_get_terms lfm_thm)
   3.898 -   (* l is the lcm of all coefficients of x *)
   3.899 -   val l = formlcm x efm2
   3.900 -   (*ac_thm: efm = efm2 with adjusted coefficients of x *)
   3.901 -   val ac_thm = [lfm_thm , (proof_of_adjustcoeffeq sg x l efm2)] MRS trans
   3.902 -   (* fm is efm2 with adjusted coefficients of x *)
   3.903 -   val fm = snd (qe_get_terms ac_thm)
   3.904 -  (* cfm is l dvd x & fm' where fm' is fm where l*x is replaced by x*)
   3.905 -   val  cfm = unitycoeff x fm
   3.906 -   (*afm is fm where c*x is replaced by 1*x or -1*x *)
   3.907 -   val afm = adjustcoeff x l fm
   3.908 -   (* P = %x.afm*)
   3.909 -   val P = absfree(xn,xT,afm)
   3.910 -   (* This simpset allows the elimination of the sets in bex {1..d} *)
   3.911 -   val ss = presburger_ss addsimps
   3.912 -     [simp_from_to] delsimps [P_eqtrue, P_eqfalse, bex_triv, insert_iff]
   3.913 -   (* uth : EX x.P(l*x) = EX x. l dvd x & P x*)
   3.914 -   val uth = instantiate' [] [SOME (cterm_of sg P) , SOME (cterm_of sg (mk_number l))] (unity_coeff_ex)
   3.915 -   (* e_ac_thm : Ex x. efm = EX x. fm*)
   3.916 -   val e_ac_thm = (forall_intr (cterm_of sg x) ac_thm) COMP (qe_exI)
   3.917 -   (* lsuth = EX.P(l*x) ; rsuth = EX x. l dvd x & P x*)
   3.918 -   val (lsuth,rsuth) = qe_get_terms (uth)
   3.919 -   (* lseacth = EX x. efm; rseacth = EX x. fm*)
   3.920 -   val (lseacth,rseacth) = qe_get_terms(e_ac_thm)
   3.921 -
   3.922 -   val (w,rs) = cooper_w [] cfm
   3.923 -   val exp_cp_thm =  case w of 
   3.924 -     (* FIXME - e_ac_thm just tipped to test syntactical correctness of the program!!!!*)
   3.925 -    SOME n =>  e_ac_thm (* Prove cfm (n) and use exI and then Eq_TrueI*)
   3.926 -   |_ => let 
   3.927 -    (* A and B set of the formula*)
   3.928 -    val A = aset x cfm
   3.929 -    val B = bset x cfm
   3.930 -    (* the divlcm (delta) of the formula*)
   3.931 -    val dlcm = mk_number (divlcm x cfm)
   3.932 -    (* Which set is smaller to generate the (hoepfully) shorter proof*)
   3.933 -    val cms = if ((length A) < (length B )) then "pi" else "mi"
   3.934 -    (* synthesize the proof of cooper's theorem*)
   3.935 -     (* cp_thm: EX x. cfm = Q*)
   3.936 -    val cp_thm = cooper_thm sg cms x cfm dlcm A B
   3.937 -     (* Exxpand the right hand side to get rid of EX j : {1..d} to get a huge disjunction*)
   3.938 -    (* exp_cp_thm: EX x.cfm = Q' , where Q' is a simplified version of Q*)
   3.939 -    in refl RS (simplify ss (cp_thm RSN (2,trans)))
   3.940 -    end
   3.941 -   (* lscth = EX x. cfm; rscth = Q' *)
   3.942 -   val (lscth,rscth) = qe_get_terms (exp_cp_thm)
   3.943 -   (* u_c_thm: EX x. P(l*x) = Q'*)
   3.944 -   val  u_c_thm = [([uth,prove_elementar sg "ss" (HOLogic.mk_eq (rsuth,lscth))] MRS trans),exp_cp_thm] MRS trans
   3.945 -   (* result: EX x. efm = Q'*)
   3.946 - in  ([e_ac_thm,[(prove_elementar sg "ss" (HOLogic.mk_eq (rseacth,lsuth))),u_c_thm] MRS trans] MRS trans)
   3.947 -   end
   3.948 -|cooper_prv_w _ _ _ =  error "Parameters format";
   3.949 -
   3.950 -
   3.951 -
   3.952 -fun decomp_cnnf sg lfnp P = case P of 
   3.953 -     Const ("op &",_) $ p $q => ([p,q] , fn [th1,th2] => [th1,th2] MRS qe_conjI )
   3.954 -   |Const ("op |",_) $ p $q => ([p,q] , fn [th1,th2] => [th1,th2] MRS  qe_disjI)
   3.955 -   |Const ("Not",_) $ (Const("Not",_) $ p) => ([p], fn [th] => th RS nnf_nn)
   3.956 -   |Const("Not",_) $ (Const(opn,T) $ p $ q) => 
   3.957 -     if opn = "op |" 
   3.958 -      then case (p,q) of 
   3.959 -         (A as (Const ("op &",_) $ r $ s),B as (Const ("op &",_) $ r1 $ t)) =>
   3.960 -          if r1 = negate r 
   3.961 -          then  ([r,HOLogic.Not$s,r1,HOLogic.Not$t],fn [th1_1,th1_2,th2_1,th2_2] => [[th1_1,th1_1] MRS qe_conjI,[th2_1,th2_2] MRS qe_conjI] MRS nnf_sdj)
   3.962 -
   3.963 -          else ([HOLogic.Not $ p,HOLogic.Not $ q ], fn [th1,th2] => [th1,th2] MRS nnf_ndj)
   3.964 -        |(_,_) => ([HOLogic.Not $ p,HOLogic.Not $ q ], fn [th1,th2] => [th1,th2] MRS nnf_ndj)
   3.965 -      else (
   3.966 -         case (opn,T) of 
   3.967 -           ("op &",_) => ([HOLogic.Not $ p,HOLogic.Not $ q ], fn [th1,th2] =>[th1,th2] MRS nnf_ncj )
   3.968 -           |("op -->",_) => ([p,HOLogic.Not $ q ], fn [th1,th2] =>[th1,th2] MRS nnf_nim )
   3.969 -           |("op =",Type ("fun",[Type ("bool", []),_])) => 
   3.970 -           ([HOLogic.conj $ p $ (HOLogic.Not $ q),HOLogic.conj $ (HOLogic.Not $ p) $ q], fn [th1,th2] => [th1,th2] MRS nnf_neq)
   3.971 -            |(_,_) => ([], fn [] => lfnp P)
   3.972 -)
   3.973 -
   3.974 -   |(Const ("op -->",_) $ p $ q) => ([HOLogic.Not$p,q], fn [th1,th2] => [th1,th2] MRS nnf_im)
   3.975 -
   3.976 -   |(Const ("op =", Type ("fun",[Type ("bool", []),_])) $ p $ q) =>
   3.977 -     ([HOLogic.conj $ p $ q,HOLogic.conj $ (HOLogic.Not $ p) $ (HOLogic.Not $ q) ], fn [th1,th2] =>[th1,th2] MRS nnf_eq )
   3.978 -   |_ => ([], fn [] => lfnp P);
   3.979 -
   3.980 -
   3.981 -
   3.982 -
   3.983 -fun proof_of_cnnf sg p lfnp = 
   3.984 - let val th1 = thm_of sg (decomp_cnnf sg lfnp) p
   3.985 -     val rs = snd(qe_get_terms th1)
   3.986 -     val th2 = prove_elementar sg "ss" (HOLogic.mk_eq(rs,simpl rs))
   3.987 -  in [th1,th2] MRS trans
   3.988 -  end;
   3.989 -
   3.990 -end;
   3.991 -
     4.1 --- a/src/HOL/Integ/presburger.ML	Thu May 31 11:00:06 2007 +0200
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,372 +0,0 @@
     4.4 -(*  Title:      HOL/Integ/presburger.ML
     4.5 -    ID:         $Id$
     4.6 -    Author:     Amine Chaieb and Stefan Berghofer, TU Muenchen
     4.7 -
     4.8 -Tactic for solving arithmetical Goals in Presburger Arithmetic.
     4.9 -
    4.10 -This version of presburger deals with occurences of functional symbols
    4.11 -in the subgoal and abstract over them to try to prove the more general
    4.12 -formula. It then resolves with the subgoal. To enable this feature
    4.13 -call the procedure with the parameter abs.
    4.14 -*)
    4.15 -
    4.16 -signature PRESBURGER =
    4.17 -sig
    4.18 - val presburger_tac : bool -> bool -> int -> tactic
    4.19 - val setup : theory -> theory
    4.20 - val trace : bool ref
    4.21 -end;
    4.22 -
    4.23 -structure Presburger: PRESBURGER =
    4.24 -struct
    4.25 -
    4.26 -val trace = ref false;
    4.27 -fun trace_msg s = if !trace then tracing s else ();
    4.28 -
    4.29 -(*-----------------------------------------------------------------*)
    4.30 -(*cooper_pp: provefunction for the one-existance quantifier elimination*)
    4.31 -(* Here still only one problem : The proof for the arithmetical transformations done on the dvd atomic formulae*)
    4.32 -(*-----------------------------------------------------------------*)
    4.33 -
    4.34 -
    4.35 -val presburger_ss = simpset ();
    4.36 -val binarith = map thm
    4.37 -  ["Pls_0_eq", "Min_1_eq",
    4.38 - "pred_Pls","pred_Min","pred_1","pred_0",
    4.39 -  "succ_Pls", "succ_Min", "succ_1", "succ_0",
    4.40 -  "add_Pls", "add_Min", "add_BIT_0", "add_BIT_10",
    4.41 -  "add_BIT_11", "minus_Pls", "minus_Min", "minus_1",
    4.42 -  "minus_0", "mult_Pls", "mult_Min", "mult_num1", "mult_num0",
    4.43 -  "add_Pls_right", "add_Min_right"];
    4.44 - val intarithrel =
    4.45 -     (map thm ["int_eq_number_of_eq","int_neg_number_of_BIT",
    4.46 -                "int_le_number_of_eq","int_iszero_number_of_0",
    4.47 -                "int_less_number_of_eq_neg"]) @
    4.48 -     (map (fn s => thm s RS thm "lift_bool")
    4.49 -          ["int_iszero_number_of_Pls","int_iszero_number_of_1",
    4.50 -           "int_neg_number_of_Min"])@
    4.51 -     (map (fn s => thm s RS thm "nlift_bool")
    4.52 -          ["int_nonzero_number_of_Min","int_not_neg_number_of_Pls"]);
    4.53 -
    4.54 -val intarith = map thm ["int_number_of_add_sym", "int_number_of_minus_sym",
    4.55 -                        "int_number_of_diff_sym", "int_number_of_mult_sym"];
    4.56 -val natarith = map thm ["add_nat_number_of", "diff_nat_number_of",
    4.57 -                        "mult_nat_number_of", "eq_nat_number_of",
    4.58 -                        "less_nat_number_of"]
    4.59 -val powerarith =
    4.60 -    (map thm ["nat_number_of", "zpower_number_of_even",
    4.61 -              "zpower_Pls", "zpower_Min"]) @
    4.62 -    [(MetaSimplifier.simplify true [thm "zero_eq_Numeral0_nring",
    4.63 -                           thm "one_eq_Numeral1_nring"]
    4.64 -  (thm "zpower_number_of_odd"))]
    4.65 -
    4.66 -val comp_arith = binarith @ intarith @ intarithrel @ natarith
    4.67 -            @ powerarith @[thm"not_false_eq_true", thm "not_true_eq_false"];
    4.68 -
    4.69 -fun cooper_pp sg (fm as e$Abs(xn,xT,p)) =
    4.70 -  let val (xn1,p1) = Syntax.variant_abs (xn,xT,p)
    4.71 -  in (CooperProof.cooper_prv sg (Free (xn1, xT)) p1) end;
    4.72 -
    4.73 -fun mnnf_pp sg fm = CooperProof.proof_of_cnnf sg fm
    4.74 -  (CooperProof.proof_of_evalc sg);
    4.75 -
    4.76 -fun tmproof_of_int_qelim sg fm =
    4.77 -  Qelim.tproof_of_mlift_qelim sg CooperDec.is_arith_rel
    4.78 -    (CooperProof.proof_of_linform sg) (mnnf_pp sg) (cooper_pp sg) fm;
    4.79 -
    4.80 -
    4.81 -(* Theorems to be used in this tactic*)
    4.82 -
    4.83 -val zdvd_int = thm "zdvd_int";
    4.84 -val zdiff_int_split = thm "zdiff_int_split";
    4.85 -val all_nat = thm "all_nat";
    4.86 -val ex_nat = thm "ex_nat";
    4.87 -val number_of1 = thm "number_of1";
    4.88 -val number_of2 = thm "number_of2";
    4.89 -val split_zdiv = thm "split_zdiv";
    4.90 -val split_zmod = thm "split_zmod";
    4.91 -val mod_div_equality' = thm "mod_div_equality'";
    4.92 -val split_div' = thm "split_div'";
    4.93 -val Suc_plus1 = thm "Suc_plus1";
    4.94 -val imp_le_cong = thm "imp_le_cong";
    4.95 -val conj_le_cong = thm "conj_le_cong";
    4.96 -val nat_mod_add_eq = mod_add1_eq RS sym;
    4.97 -val nat_mod_add_left_eq = mod_add_left_eq RS sym;
    4.98 -val nat_mod_add_right_eq = mod_add_right_eq RS sym;
    4.99 -val int_mod_add_eq = @{thm zmod_zadd1_eq} RS sym;
   4.100 -val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
   4.101 -val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
   4.102 -val nat_div_add_eq = @{thm div_add1_eq} RS sym;
   4.103 -val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
   4.104 -val ZDIVISION_BY_ZERO_MOD = @{thm DIVISION_BY_ZERO} RS conjunct2;
   4.105 -val ZDIVISION_BY_ZERO_DIV = @{thm DIVISION_BY_ZERO} RS conjunct1;
   4.106 -
   4.107 -
   4.108 -(* extract all the constants in a term*)
   4.109 -fun add_term_typed_consts (Const (c, T), cs) = insert (op =) (c, T) cs
   4.110 -  | add_term_typed_consts (t $ u, cs) =
   4.111 -      add_term_typed_consts (t, add_term_typed_consts (u, cs))
   4.112 -  | add_term_typed_consts (Abs (_, _, t), cs) = add_term_typed_consts (t, cs)
   4.113 -  | add_term_typed_consts (_, cs) = cs;
   4.114 -
   4.115 -fun term_typed_consts t = add_term_typed_consts(t,[]);
   4.116 -
   4.117 -(* Some Types*)
   4.118 -val bT = HOLogic.boolT;
   4.119 -val bitT = HOLogic.bitT;
   4.120 -val iT = HOLogic.intT;
   4.121 -val nT = HOLogic.natT;
   4.122 -
   4.123 -(* Allowed Consts in formulae for presburger tactic*)
   4.124 -
   4.125 -val allowed_consts =
   4.126 -  [("All", (iT --> bT) --> bT),
   4.127 -   ("Ex", (iT --> bT) --> bT),
   4.128 -   ("All", (nT --> bT) --> bT),
   4.129 -   ("Ex", (nT --> bT) --> bT),
   4.130 -
   4.131 -   ("op &", bT --> bT --> bT),
   4.132 -   ("op |", bT --> bT --> bT),
   4.133 -   ("op -->", bT --> bT --> bT),
   4.134 -   ("op =", bT --> bT --> bT),
   4.135 -   ("Not", bT --> bT),
   4.136 -
   4.137 -   (@{const_name Orderings.less_eq}, iT --> iT --> bT),
   4.138 -   ("op =", iT --> iT --> bT),
   4.139 -   (@{const_name Orderings.less}, iT --> iT --> bT),
   4.140 -   (@{const_name Divides.dvd}, iT --> iT --> bT),
   4.141 -   (@{const_name Divides.div}, iT --> iT --> iT),
   4.142 -   (@{const_name Divides.mod}, iT --> iT --> iT),
   4.143 -   (@{const_name HOL.plus}, iT --> iT --> iT),
   4.144 -   (@{const_name HOL.minus}, iT --> iT --> iT),
   4.145 -   (@{const_name HOL.times}, iT --> iT --> iT),
   4.146 -   (@{const_name HOL.abs}, iT --> iT),
   4.147 -   (@{const_name HOL.uminus}, iT --> iT),
   4.148 -   (@{const_name Orderings.max}, iT --> iT --> iT),
   4.149 -   (@{const_name Orderings.min}, iT --> iT --> iT),
   4.150 -
   4.151 -   (@{const_name Orderings.less_eq}, nT --> nT --> bT),
   4.152 -   ("op =", nT --> nT --> bT),
   4.153 -   (@{const_name Orderings.less}, nT --> nT --> bT),
   4.154 -   (@{const_name Divides.dvd}, nT --> nT --> bT),
   4.155 -   (@{const_name Divides.div}, nT --> nT --> nT),
   4.156 -   (@{const_name Divides.mod}, nT --> nT --> nT),
   4.157 -   (@{const_name HOL.plus}, nT --> nT --> nT),
   4.158 -   (@{const_name HOL.minus}, nT --> nT --> nT),
   4.159 -   (@{const_name HOL.times}, nT --> nT --> nT),
   4.160 -   (@{const_name Suc}, nT --> nT),
   4.161 -   (@{const_name Orderings.max}, nT --> nT --> nT),
   4.162 -   (@{const_name Orderings.min}, nT --> nT --> nT),
   4.163 -
   4.164 -   (@{const_name Numeral.bit.B0}, bitT),
   4.165 -   (@{const_name Numeral.bit.B1}, bitT),
   4.166 -   (@{const_name Numeral.Bit}, iT --> bitT --> iT),
   4.167 -   (@{const_name Numeral.Pls}, iT),
   4.168 -   (@{const_name Numeral.Min}, iT),
   4.169 -   (@{const_name Numeral.number_of}, iT --> iT),
   4.170 -   (@{const_name Numeral.number_of}, iT --> nT),
   4.171 -   (@{const_name HOL.zero}, nT),
   4.172 -   (@{const_name HOL.zero}, iT),
   4.173 -   (@{const_name HOL.one}, nT),
   4.174 -   (@{const_name HOL.one}, iT),
   4.175 -   (@{const_name False}, bT),
   4.176 -   (@{const_name True}, bT)];
   4.177 -
   4.178 -(* Preparation of the formula to be sent to the Integer quantifier *)
   4.179 -(* elimination procedure                                           *)
   4.180 -(* Transforms meta implications and meta quantifiers to object     *)
   4.181 -(* implications and object quantifiers                             *)
   4.182 -
   4.183 -
   4.184 -(*==================================*)
   4.185 -(* Abstracting on subterms  ========*)
   4.186 -(*==================================*)
   4.187 -(* Returns occurences of terms that are function application of type int or nat*)
   4.188 -
   4.189 -fun getfuncs fm = case strip_comb fm of
   4.190 -    (Free (_, T), ts as _ :: _) =>
   4.191 -      if body_type T mem [iT, nT]
   4.192 -         andalso not (ts = []) andalso forall (null o loose_bnos) ts
   4.193 -      then [fm]
   4.194 -      else Library.foldl op union ([], map getfuncs ts)
   4.195 -  | (Var (_, T), ts as _ :: _) =>
   4.196 -      if body_type T mem [iT, nT]
   4.197 -         andalso not (ts = []) andalso forall (null o loose_bnos) ts then [fm]
   4.198 -      else Library.foldl op union ([], map getfuncs ts)
   4.199 -  | (Const (s, T), ts) =>
   4.200 -      if (s, T) mem allowed_consts orelse not (body_type T mem [iT, nT])
   4.201 -      then Library.foldl op union ([], map getfuncs ts)
   4.202 -      else [fm]
   4.203 -  | (Abs (s, T, t), _) => getfuncs t
   4.204 -  | _ => [];
   4.205 -
   4.206 -
   4.207 -fun abstract_pres sg fm =
   4.208 -  foldr (fn (t, u) =>
   4.209 -      let val T = fastype_of t
   4.210 -      in all T $ Abs ("x", T, abstract_over (t, u)) end)
   4.211 -         fm (getfuncs fm);
   4.212 -
   4.213 -
   4.214 -
   4.215 -(* hasfuncs_on_bounds dont care of the type of the functions applied!
   4.216 - It returns true if there is a subterm coresponding to the application of
   4.217 - a function on a bounded variable.
   4.218 -
   4.219 - Function applications are allowed only for well predefined functions a
   4.220 - consts*)
   4.221 -
   4.222 -fun has_free_funcs fm  = case strip_comb fm of
   4.223 -    (Free (_, T), ts as _ :: _) =>
   4.224 -      if (body_type T mem [iT,nT]) andalso (not (T mem [iT,nT]))
   4.225 -      then true
   4.226 -      else exists (fn x => x) (map has_free_funcs ts)
   4.227 -  | (Var (_, T), ts as _ :: _) =>
   4.228 -      if (body_type T mem [iT,nT]) andalso not (T mem [iT,nT])
   4.229 -      then true
   4.230 -      else exists (fn x => x) (map has_free_funcs ts)
   4.231 -  | (Const (s, T), ts) =>  exists (fn x => x) (map has_free_funcs ts)
   4.232 -  | (Abs (s, T, t), _) => has_free_funcs t
   4.233 -  |_ => false;
   4.234 -
   4.235 -
   4.236 -(*returns true if the formula is relevant for presburger arithmetic tactic
   4.237 -The constants occuring in term t should be a subset of the allowed_consts
   4.238 - There also should be no occurences of application of functions on bounded
   4.239 - variables. Whenever this function will be used, it will be ensured that t
   4.240 - will not contain subterms with function symbols that could have been
   4.241 - abstracted over.*)
   4.242 -
   4.243 -fun relevant ps t = (term_typed_consts t) subset allowed_consts andalso
   4.244 -  map (fn i => snd (List.nth (ps, i))) (loose_bnos t) @
   4.245 -  map (snd o dest_Free) (term_frees t) @ map (snd o dest_Var) (term_vars t)
   4.246 -  subset [iT, nT]
   4.247 -  andalso not (has_free_funcs t);
   4.248 -
   4.249 -
   4.250 -fun prepare_for_presburger sg q fm =
   4.251 -  let
   4.252 -    val ps = Logic.strip_params fm
   4.253 -    val hs = map HOLogic.dest_Trueprop (Logic.strip_assums_hyp fm)
   4.254 -    val c = HOLogic.dest_Trueprop (Logic.strip_assums_concl fm)
   4.255 -    val _ = if relevant (rev ps) c then ()
   4.256 -               else  (trace_msg ("Conclusion is not a presburger term:\n" ^
   4.257 -             Sign.string_of_term sg c); raise CooperDec.COOPER)
   4.258 -    fun mk_all ((s, T), (P,n)) =
   4.259 -      if 0 mem loose_bnos P then
   4.260 -        (HOLogic.all_const T $ Abs (s, T, P), n)
   4.261 -      else (incr_boundvars ~1 P, n-1)
   4.262 -    fun mk_all2 (v, t) = HOLogic.all_const (fastype_of v) $ lambda v t;
   4.263 -    val (rhs,irhs) = List.partition (relevant (rev ps)) hs
   4.264 -    val np = length ps
   4.265 -    val (fm',np) =  foldr (fn ((x, T), (fm,n)) => mk_all ((x, T), (fm,n)))
   4.266 -      (foldr HOLogic.mk_imp c rhs, np) ps
   4.267 -    val (vs, _) = List.partition (fn t => q orelse (type_of t) = nT)
   4.268 -      (term_frees fm' @ term_vars fm');
   4.269 -    val fm2 = foldr mk_all2 fm' vs
   4.270 -  in (fm2, np + length vs, length rhs) end;
   4.271 -
   4.272 -(*Object quantifier to meta --*)
   4.273 -fun spec_step n th = if (n=0) then th else (spec_step (n-1) th) RS spec ;
   4.274 -
   4.275 -(* object implication to meta---*)
   4.276 -fun mp_step n th = if (n=0) then th else (mp_step (n-1) th) RS mp;
   4.277 -
   4.278 -(* the presburger tactic*)
   4.279 -
   4.280 -(* Parameters : q = flag for quantify ofer free variables ;
   4.281 -                a = flag for abstracting over function occurences
   4.282 -                i = subgoal  *)
   4.283 -
   4.284 -fun presburger_tac q a i = ObjectLogic.atomize_tac i THEN (fn st =>
   4.285 -  let
   4.286 -    val g = List.nth (prems_of st, i - 1)
   4.287 -    val sg = Thm.theory_of_thm st
   4.288 -    (* The Abstraction step *)
   4.289 -    val g' = if a then abstract_pres sg g else g
   4.290 -    (* Transform the term*)
   4.291 -    val (t,np,nh) = prepare_for_presburger sg q g'
   4.292 -    (* Some simpsets for dealing with mod div abs and nat*)
   4.293 -    val mod_div_simpset = Simplifier.theory_context sg HOL_basic_ss
   4.294 -                        addsimps [refl,nat_mod_add_eq, nat_mod_add_left_eq,
   4.295 -                                  nat_mod_add_right_eq, int_mod_add_eq,
   4.296 -                                  int_mod_add_right_eq, int_mod_add_left_eq,
   4.297 -                                  nat_div_add_eq, int_div_add_eq,
   4.298 -                                  mod_self, @{thm zmod_self},
   4.299 -                                  DIVISION_BY_ZERO_MOD,DIVISION_BY_ZERO_DIV,
   4.300 -                                  ZDIVISION_BY_ZERO_MOD,ZDIVISION_BY_ZERO_DIV,
   4.301 -                                  @{thm zdiv_zero}, @{thm zmod_zero}, div_0,mod_0,
   4.302 -                                  @{thm zdiv_1}, @{thm zmod_1}, @{thm div_1}, @{thm mod_1},
   4.303 -                                  Suc_plus1]
   4.304 -                        addsimps add_ac
   4.305 -                        addsimprocs [cancel_div_mod_proc]
   4.306 -    val simpset0 = HOL_basic_ss
   4.307 -      addsimps [@{thm mod_div_equality'}, @{thm Suc_plus1}]
   4.308 -      addsimps comp_arith
   4.309 -      addsplits [split_zdiv, split_zmod, split_div', @{thm split_min}, @{thm split_max}]
   4.310 -    (* Simp rules for changing (n::int) to int n *)
   4.311 -    val simpset1 = HOL_basic_ss
   4.312 -      addsimps [nat_number_of_def, zdvd_int] @ map (fn r => r RS sym)
   4.313 -        [int_int_eq, zle_int, zless_int, zadd_int, zmult_int]
   4.314 -      addsplits [zdiff_int_split]
   4.315 -    (*simp rules for elimination of int n*)
   4.316 -
   4.317 -    val simpset2 = HOL_basic_ss
   4.318 -      addsimps [nat_0_le, all_nat, ex_nat, number_of1, number_of2, int_0, int_1]
   4.319 -      addcongs [conj_le_cong, imp_le_cong]
   4.320 -    (* simp rules for elimination of abs *)
   4.321 -    val simpset3 = HOL_basic_ss addsplits [abs_split]
   4.322 -    val ct = cterm_of sg (HOLogic.mk_Trueprop t)
   4.323 -    (* Theorem for the nat --> int transformation *)
   4.324 -    val pre_thm = Seq.hd (EVERY
   4.325 -      [simp_tac mod_div_simpset 1, simp_tac simpset0 1,
   4.326 -       TRY (simp_tac simpset1 1), TRY (simp_tac simpset2 1),
   4.327 -       TRY (simp_tac simpset3 1), TRY (simp_tac presburger_ss 1)]
   4.328 -      (trivial ct))
   4.329 -    fun assm_tac i = REPEAT_DETERM_N nh (assume_tac i)
   4.330 -    (* The result of the quantifier elimination *)
   4.331 -    val (th, tac) = case (prop_of pre_thm) of
   4.332 -        Const ("==>", _) $ (Const ("Trueprop", _) $ t1) $ _ =>
   4.333 -    let val pth =
   4.334 -          (* If quick_and_dirty then run without proof generation as oracle*)
   4.335 -             if !quick_and_dirty
   4.336 -             then presburger_oracle sg (Pattern.eta_long [] t1)
   4.337 -(*
   4.338 -assume (cterm_of sg
   4.339 -               (HOLogic.mk_Trueprop(HOLogic.mk_eq(t1,CooperDec.integer_qelim (Pattern.eta_long [] t1)))))
   4.340 -*)
   4.341 -             else tmproof_of_int_qelim sg (Pattern.eta_long [] t1)
   4.342 -    in
   4.343 -          (trace_msg ("calling procedure with term:\n" ^
   4.344 -             Sign.string_of_term sg t1);
   4.345 -           ((pth RS iffD2) RS pre_thm,
   4.346 -            assm_tac (i + 1) THEN (if q then I else TRY) (rtac TrueI i)))
   4.347 -    end
   4.348 -      | _ => (pre_thm, assm_tac i)
   4.349 -  in (rtac (((mp_step nh) o (spec_step np)) th) i
   4.350 -      THEN tac) st
   4.351 -  end handle Subscript => no_tac st | CooperDec.COOPER => no_tac st);
   4.352 -
   4.353 -val presburger_meth =
   4.354 - let val parse_flag =
   4.355 -         Args.$$$ "no_quantify" >> K (apfst (K false))
   4.356 -      || Args.$$$ "no_abs" >> K (apsnd (K false));
   4.357 - in
   4.358 -   Method.simple_args
   4.359 -     (Scan.optional (Args.$$$ "(" |-- Scan.repeat1 parse_flag --| Args.$$$ ")") [] >>
   4.360 -      curry (Library.foldl op |>) (true, true))
   4.361 -     (fn (q,a) => K (Method.SIMPLE_METHOD' (presburger_tac q a)))
   4.362 -  end;
   4.363 -
   4.364 -val presburger_arith_tac = mk_arith_tactic "presburger" (fn i => fn st =>
   4.365 -  (warning "Trying full Presburger arithmetic ...";
   4.366 -   presburger_tac true true i st));
   4.367 -
   4.368 -val setup =
   4.369 -  Method.add_method ("presburger", presburger_meth,
   4.370 -    "decision procedure for Presburger arithmetic") #>
   4.371 -  arith_tactic_add presburger_arith_tac;
   4.372 -
   4.373 -end;
   4.374 -
   4.375 -val presburger_tac = Presburger.presburger_tac true true;
     5.1 --- a/src/HOL/Integ/qelim.ML	Thu May 31 11:00:06 2007 +0200
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,110 +0,0 @@
     5.4 -(*  Title:      HOL/Integ/qelim.ML
     5.5 -    ID:         $Id$
     5.6 -    Author:     Amine Chaieb and Tobias Nipkow, TU Muenchen
     5.7 -
     5.8 -File containing the implementation of the proof protocoling
     5.9 -and proof generation for multiple quantified formulae.
    5.10 -*)
    5.11 -
    5.12 -signature QELIM =
    5.13 - sig
    5.14 - val tproof_of_mlift_qelim: theory -> (term -> bool) ->
    5.15 -   (string list -> term -> thm) -> (term -> thm) ->
    5.16 -   (term -> thm) -> term -> thm
    5.17 - val standard_qelim_conv: (cterm list -> cterm -> thm) ->
    5.18 -   (cterm list -> Conv.conv) -> (cterm list -> cterm -> thm) -> cterm -> thm
    5.19 - val gen_qelim_conv: Conv.conv -> Conv.conv -> Conv.conv ->
    5.20 -   (cterm -> 'a -> 'a) -> 'a -> ('a -> cterm -> thm) ->
    5.21 -   ('a -> Conv.conv) -> ('a -> cterm -> thm) -> Conv.conv
    5.22 -
    5.23 -end;
    5.24 -
    5.25 -structure Qelim : QELIM =
    5.26 -struct
    5.27 -open CooperDec;
    5.28 -open CooperProof;
    5.29 -open Conv;
    5.30 -
    5.31 -val cboolT = ctyp_of HOL.thy HOLogic.boolT;
    5.32 -
    5.33 -(* List of the theorems to be used in the following*)
    5.34 -
    5.35 -val qe_ex_conj = thm "qe_ex_conj";
    5.36 -val qe_ex_nconj = thm "qe_ex_nconj";
    5.37 -val qe_ALL = thm "qe_ALL";
    5.38 -
    5.39 -
    5.40 -(*============= Compact version =====*)
    5.41 -
    5.42 -
    5.43 -fun decomp_qe is_at afnp nfnp qfnp sg P = 
    5.44 -   if is_at P then ([], fn [] => afnp [] P) else 
    5.45 -   case P of
    5.46 -   (Const("op &",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_conjI)
    5.47 -   |(Const("op |",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_disjI)
    5.48 -   |(Const("op -->",_)$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_impI)
    5.49 -   |(Const("op =", Type ("fun",[Type ("bool", []),_]))$A$B) => ([A,B], fn [th1,th2] => [th1,th2] MRS qe_eqI)
    5.50 -   |(Const("Not",_)$p) => ([p],fn [th] => th RS qe_Not)
    5.51 -   |(Const("Ex",_)$Abs(xn,xT,p)) => 
    5.52 -      let val (xn1,p1) = Syntax.variant_abs(xn,xT,p) 
    5.53 -      in ([p1],
    5.54 -        fn [th1_1] => 
    5.55 -          let val th2 = [th1_1,nfnp (snd (qe_get_terms th1_1))] MRS trans
    5.56 -              val eth1 = (forall_intr (cterm_of sg (Free(xn1,xT))) th2) COMP  qe_exI
    5.57 -              val th3 = qfnp (snd(qe_get_terms eth1))
    5.58 -          in [eth1,th3] MRS trans
    5.59 -          end )
    5.60 -      end
    5.61 -
    5.62 -   |(Const("All",_)$Abs(xn,xT,p)) => ([(HOLogic.exists_const xT)$Abs(xn,xT,HOLogic.Not $ p)], fn [th] => th RS qe_ALL)
    5.63 -   | _ => ([],fn [] => instantiate' [SOME (ctyp_of sg (type_of P))] [SOME (cterm_of sg P)] refl);
    5.64 - 
    5.65 -
    5.66 -fun tproof_of_mlift_qelim sg isat afnp nfnp qfnp p = 
    5.67 -   let val th1 = thm_of sg (decomp_qe isat afnp nfnp qfnp sg) p
    5.68 -       val th2 = nfnp (snd (qe_get_terms th1))
    5.69 -    in [th1,th2] MRS trans
    5.70 -    end;
    5.71 -
    5.72 -val is_refl = op aconv o Logic.dest_equals o Thm.prop_of;
    5.73 -
    5.74 -fun gen_qelim_conv precv postcv simpex_conv ins env atcv ncv qcv  = 
    5.75 - let fun conv p =
    5.76 -  case (term_of p) of 
    5.77 -   Const(s,T)$_$_ => if domain_type T = HOLogic.boolT 
    5.78 -                        andalso s mem ["op &","op |","op -->","op ="]
    5.79 -                    then binop_conv conv p else atcv env p
    5.80 - | Const("Not",_)$_ => arg_conv conv p
    5.81 - | Const("Ex",_)$Abs(s,_,_) => 
    5.82 -   let 
    5.83 -    val (e,p0) = Thm.dest_comb p
    5.84 -    val (x,p') = Thm.dest_abs (SOME s) p0
    5.85 -    val th = Thm.abstract_rule s x 
    5.86 -                  (((gen_qelim_conv precv postcv simpex_conv ins (ins x env) atcv ncv qcv) 
    5.87 -                      then_conv (ncv (ins x env))) p')
    5.88 -                  |> Drule.arg_cong_rule e
    5.89 -    val th' = simpex_conv (Thm.rhs_of th)
    5.90 -    val (l,r) = Thm.dest_equals (cprop_of th')
    5.91 -   in if is_refl th' then Thm.transitive th (qcv env (Thm.rhs_of th))
    5.92 -      else Thm.transitive (Thm.transitive th th') (conv r) end
    5.93 - | _ => atcv env p
    5.94 - in precv then_conv conv then_conv postcv end;
    5.95 -
    5.96 -fun cterm_frees ct = 
    5.97 - let fun h acc t = 
    5.98 -   case (term_of t) of 
    5.99 -    _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
   5.100 -  | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
   5.101 -  | Free _ => insert (op aconvc) t acc
   5.102 -  | _ => acc
   5.103 - in h [] ct end;
   5.104 -
   5.105 -val standard_qelim_conv = 
   5.106 - let val pcv = Simplifier.rewrite 
   5.107 -                 (HOL_basic_ss addsimps (simp_thms @ (List.take(ex_simps,4)) 
   5.108 -                     @ [not_all,ex_disj_distrib]))
   5.109 - in fn atcv => fn ncv => fn qcv => fn p => 
   5.110 -       gen_qelim_conv pcv pcv pcv (curry (op ::)) (cterm_frees p) atcv ncv qcv p 
   5.111 - end;
   5.112 -
   5.113 -end;
     6.1 --- a/src/HOL/Integ/reflected_cooper.ML	Thu May 31 11:00:06 2007 +0200
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,119 +0,0 @@
     6.4 -(* $Id$ *)
     6.5 -(* The oracle for Presburger arithmetic based on the verified Code *)
     6.6 -    (* in HOL/ex/Reflected_Presburger.thy *)
     6.7 -
     6.8 -structure ReflectedCooper =
     6.9 -struct
    6.10 -
    6.11 -open Generated;
    6.12 -(* pseudo reification : term -> intterm *)
    6.13 -
    6.14 -fun i_of_term vs t =  case t of
    6.15 -    Free(xn,xT) => (case AList.lookup (op =) vs t of 
    6.16 -        NONE   => error "Variable not found in the list!!"
    6.17 -      | SOME n => Var n)
    6.18 -  | Const(@{const_name HOL.zero},iT) => Cst 0
    6.19 -  | Const(@{const_name HOL.one},iT) => Cst 1
    6.20 -  | Bound i => Var (nat (IntInf.fromInt i))
    6.21 -  | Const(@{const_name HOL.uminus},_)$t' => Neg (i_of_term vs t')
    6.22 -  | Const (@{const_name HOL.plus},_)$t1$t2 => Add (i_of_term vs t1,i_of_term vs t2)
    6.23 -  | Const (@{const_name HOL.minus},_)$t1$t2 => Sub (i_of_term vs t1,i_of_term vs t2)
    6.24 -  | Const (@{const_name HOL.times},_)$t1$t2 => Mult (i_of_term vs t1,i_of_term vs t2)
    6.25 -  | Const (@{const_name Numeral.number_of},_)$t' => Cst (HOLogic.dest_numeral t')
    6.26 -  | _ => error "i_of_term: unknown term";
    6.27 -
    6.28 -(* pseudo reification : term -> QF *)
    6.29 -fun qf_of_term vs t = case t of 
    6.30 -	Const("True",_) => T
    6.31 -      | Const("False",_) => F
    6.32 -      | Const(@{const_name Orderings.less},_)$t1$t2 => Lt (i_of_term vs t1,i_of_term vs t2)
    6.33 -      | Const(@{const_name Orderings.less_eq},_)$t1$t2 => Le (i_of_term vs t1,i_of_term vs t2)
    6.34 -      | Const ("Divides.dvd",_)$t1$t2 => 
    6.35 -	Divides(i_of_term vs t1,i_of_term vs t2)
    6.36 -      | Const("op =",eqT)$t1$t2 => 
    6.37 -	if (domain_type eqT = HOLogic.intT)
    6.38 -	then let val i1 = i_of_term vs t1
    6.39 -		 val i2 = i_of_term vs t2
    6.40 -	     in	Eq (i1,i2)
    6.41 -	     end 
    6.42 -	else Equ(qf_of_term vs t1,qf_of_term vs t2)
    6.43 -      | Const("op &",_)$t1$t2 => And(qf_of_term vs t1,qf_of_term vs t2)
    6.44 -      | Const("op |",_)$t1$t2 => Or(qf_of_term vs t1,qf_of_term vs t2)
    6.45 -      | Const("op -->",_)$t1$t2 => Imp(qf_of_term vs t1,qf_of_term vs t2)
    6.46 -      | Const("Not",_)$t' => NOT(qf_of_term vs t')
    6.47 -      | Const("Ex",_)$Abs(xn,xT,p) => 
    6.48 -	QEx(qf_of_term (map (fn(v,n) => (v,n + 1)) vs) p)
    6.49 -      | Const("All",_)$Abs(xn,xT,p) => 
    6.50 -	QAll(qf_of_term (map (fn(v,n) => (v,n + 1)) vs) p)
    6.51 -      | _ => error "qf_of_term : unknown term!";
    6.52 -
    6.53 -(*
    6.54 -fun parse thy s = term_of (Thm.read_cterm thy (s, HOLogic.boolT));
    6.55 -
    6.56 -val t = parse "ALL (i::int) (j::int). i < 8* j --> (i - 1 = j + 3 + 2*j) & (j <= -i + k ) | 4 = i | 5 dvd i";
    6.57 -*)
    6.58 -fun zip [] [] = []
    6.59 -  | zip (x::xs) (y::ys) = (x,y)::(zip xs ys);
    6.60 -
    6.61 -
    6.62 -fun start_vs t =
    6.63 -    let val fs = term_frees t
    6.64 -    in zip fs (map (nat o IntInf.fromInt) (0 upto  (length fs - 1)))
    6.65 -    end ;
    6.66 -
    6.67 -(* transform intterm and QF back to terms *)
    6.68 -val iT = HOLogic.intT;
    6.69 -val bT = HOLogic.boolT;
    6.70 -fun myassoc2 l v =
    6.71 -    case l of
    6.72 -	[] => NONE
    6.73 -      | (x,v')::xs => if v = v' then SOME x
    6.74 -		      else myassoc2 xs v;
    6.75 -
    6.76 -fun term_of_i vs t =
    6.77 -    case t of 
    6.78 -	Cst i => CooperDec.mk_number i
    6.79 -      | Var n => valOf (myassoc2 vs n)
    6.80 -      | Neg t' => Const(@{const_name HOL.uminus},iT --> iT)$(term_of_i vs t')
    6.81 -      | Add(t1,t2) => Const(@{const_name HOL.plus},[iT,iT] ---> iT)$
    6.82 -			   (term_of_i vs t1)$(term_of_i vs t2)
    6.83 -      | Sub(t1,t2) => Const(@{const_name HOL.minus},[iT,iT] ---> iT)$
    6.84 -			   (term_of_i vs t1)$(term_of_i vs t2)
    6.85 -      | Mult(t1,t2) => Const(@{const_name HOL.times},[iT,iT] ---> iT)$
    6.86 -			   (term_of_i vs t1)$(term_of_i vs t2);
    6.87 -
    6.88 -fun term_of_qf vs t = 
    6.89 -    case t of 
    6.90 -	T => HOLogic.true_const 
    6.91 -      | F => HOLogic.false_const
    6.92 -      | Lt(t1,t2) => Const(@{const_name Orderings.less},[iT,iT] ---> bT)$
    6.93 -			   (term_of_i vs t1)$(term_of_i vs t2)
    6.94 -      | Le(t1,t2) => Const(@{const_name Orderings.less_eq},[iT,iT] ---> bT)$
    6.95 -			  (term_of_i vs t1)$(term_of_i vs t2)
    6.96 -      | Gt(t1,t2) => Const(@{const_name Orderings.less},[iT,iT] ---> bT)$
    6.97 -			   (term_of_i vs t2)$(term_of_i vs t1)
    6.98 -      | Ge(t1,t2) => Const(@{const_name Orderings.less_eq},[iT,iT] ---> bT)$
    6.99 -			  (term_of_i vs t2)$(term_of_i vs t1)
   6.100 -      | Eq(t1,t2) => Const("op =",[iT,iT] ---> bT)$
   6.101 -			   (term_of_i vs t1)$(term_of_i vs t2)
   6.102 -      | Divides(t1,t2) => Const("Divides.dvd",[iT,iT] ---> bT)$
   6.103 -			       (term_of_i vs t1)$(term_of_i vs t2)
   6.104 -      | NOT t' => HOLogic.Not$(term_of_qf vs t')
   6.105 -      | And(t1,t2) => HOLogic.conj$(term_of_qf vs t1)$(term_of_qf vs t2)
   6.106 -      | Or(t1,t2) => HOLogic.disj$(term_of_qf vs t1)$(term_of_qf vs t2)
   6.107 -      | Imp(t1,t2) => HOLogic.imp$(term_of_qf vs t1)$(term_of_qf vs t2)
   6.108 -      | Equ(t1,t2) => (HOLogic.eq_const bT)$(term_of_qf vs t1)$
   6.109 -					   (term_of_qf vs t2)
   6.110 -      | _ => error "If this is raised, Isabelle/HOL or generate_code is inconsistent!";
   6.111 -
   6.112 -(* The oracle *)
   6.113 -fun presburger_oracle thy t =
   6.114 -    let val vs = start_vs t
   6.115 -	val result = lift_un (term_of_qf vs) (pa (qf_of_term vs t))
   6.116 -    in 
   6.117 -    case result of 
   6.118 -	None => raise CooperDec.COOPER
   6.119 -      | Some t' => HOLogic.mk_Trueprop (HOLogic.mk_eq(t,t'))
   6.120 -    end ;
   6.121 - 
   6.122 -end;
     7.1 --- a/src/HOL/Integ/reflected_presburger.ML	Thu May 31 11:00:06 2007 +0200
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,2172 +0,0 @@
     7.4 -(* $Id$ *)
     7.5 -
     7.6 -    (* Caution: This file should not be modified. *)
     7.7 -    (* It is autmatically generated from HOL/ex/Reflected_Presburger.thy *)
     7.8 -fun nat (i:IntInf.int) = if i < 0 then 0 else i : IntInf.int;
     7.9 -structure Generated =
    7.10 -struct
    7.11 -
    7.12 -datatype intterm = Cst of IntInf.int | Var of IntInf.int | Neg of intterm
    7.13 -  | Add of intterm * intterm | Sub of intterm * intterm
    7.14 -  | Mult of intterm * intterm;
    7.15 -
    7.16 -datatype QF = Lt of intterm * intterm | Gt of intterm * intterm
    7.17 -  | Le of intterm * intterm | Ge of intterm * intterm | Eq of intterm * intterm
    7.18 -  | Divides of intterm * intterm | T | F | NOT of QF | And of QF * QF
    7.19 -  | Or of QF * QF | Imp of QF * QF | Equ of QF * QF | QAll of QF | QEx of QF;
    7.20 -
    7.21 -datatype 'a option = None | Some of 'a;
    7.22 -
    7.23 -fun lift_un c None = None
    7.24 -  | lift_un c (Some p) = Some (c p);
    7.25 -
    7.26 -fun lift_bin (c, (Some a, Some b)) = Some (c a b)
    7.27 -  | lift_bin (c, (None, y)) = None
    7.28 -  | lift_bin (c, (Some y, None)) = None;
    7.29 -
    7.30 -fun lift_qe qe None = None
    7.31 -  | lift_qe qe (Some p) = qe p;
    7.32 -
    7.33 -fun qelim (qe, QAll p) = lift_un NOT (lift_qe qe (lift_un NOT (qelim (qe, p))))
    7.34 -  | qelim (qe, QEx p) = lift_qe qe (qelim (qe, p))
    7.35 -  | qelim (qe, And (p, q)) =
    7.36 -    lift_bin ((fn x => fn xa => And (x, xa)), (qelim (qe, p), qelim (qe, q)))
    7.37 -  | qelim (qe, Or (p, q)) =
    7.38 -    lift_bin ((fn x => fn xa => Or (x, xa)), (qelim (qe, p), qelim (qe, q)))
    7.39 -  | qelim (qe, Imp (p, q)) =
    7.40 -    lift_bin ((fn x => fn xa => Imp (x, xa)), (qelim (qe, p), qelim (qe, q)))
    7.41 -  | qelim (qe, Equ (p, q)) =
    7.42 -    lift_bin ((fn x => fn xa => Equ (x, xa)), (qelim (qe, p), qelim (qe, q)))
    7.43 -  | qelim (qe, NOT p) = lift_un NOT (qelim (qe, p))
    7.44 -  | qelim (qe, Lt (w, x)) = Some (Lt (w, x))
    7.45 -  | qelim (qe, Gt (y, z)) = Some (Gt (y, z))
    7.46 -  | qelim (qe, Le (aa, ab)) = Some (Le (aa, ab))
    7.47 -  | qelim (qe, Ge (ac, ad)) = Some (Ge (ac, ad))
    7.48 -  | qelim (qe, Eq (ae, af)) = Some (Eq (ae, af))
    7.49 -  | qelim (qe, Divides (ag, ah)) = Some (Divides (ag, ah))
    7.50 -  | qelim (qe, T) = Some T
    7.51 -  | qelim (qe, F) = Some F;
    7.52 -
    7.53 -fun lin_mul (c, Cst i) = Cst (c * i)
    7.54 -  | lin_mul (c, Add (Mult (Cst c', Var n), r)) =
    7.55 -    (if (c = 0) then Cst 0
    7.56 -      else Add (Mult (Cst (c * c'), Var n), lin_mul (c, r)));
    7.57 -
    7.58 -fun op_60_def0 m n = IntInf.< (m,n);
    7.59 -
    7.60 -fun op_60_61_def0 m n = not (op_60_def0 n m);
    7.61 -
    7.62 -fun lin_add (Add (Mult (Cst c1, Var n1), r1), Add (Mult (Cst c2, Var n2), r2)) =
    7.63 -    (if (n1 = n2)
    7.64 -      then let val c = Cst (c1 + c2)
    7.65 -           in (if ((c1 + c2) = 0) then lin_add (r1, r2)
    7.66 -                else Add (Mult (c, Var n1), lin_add (r1, r2)))
    7.67 -           end
    7.68 -      else (if op_60_61_def0 n1 n2
    7.69 -             then Add (Mult (Cst c1, Var n1),
    7.70 -                        lin_add (r1, Add (Mult (Cst c2, Var n2), r2)))
    7.71 -             else Add (Mult (Cst c2, Var n2),
    7.72 -                        lin_add (Add (Mult (Cst c1, Var n1), r1), r2))))
    7.73 -  | lin_add (Add (Mult (Cst c1, Var n1), r1), Cst b) =
    7.74 -    Add (Mult (Cst c1, Var n1), lin_add (r1, Cst b))
    7.75 -  | lin_add (Cst x, Add (Mult (Cst c2, Var n2), r2)) =
    7.76 -    Add (Mult (Cst c2, Var n2), lin_add (Cst x, r2))
    7.77 -  | lin_add (Cst b1, Cst b2) = Cst (b1 + b2);
    7.78 -
    7.79 -fun lin_neg i = lin_mul (~1, i);
    7.80 -
    7.81 -fun linearize (Cst b) = Some (Cst b)
    7.82 -  | linearize (Var n) = Some (Add (Mult (Cst 1, Var n), Cst 0))
    7.83 -  | linearize (Neg i) = lift_un lin_neg (linearize i)
    7.84 -  | linearize (Add (i, j)) =
    7.85 -    lift_bin ((fn x => fn y => lin_add (x, y)), (linearize i, linearize j))
    7.86 -  | linearize (Sub (i, j)) =
    7.87 -    lift_bin
    7.88 -      ((fn x => fn y => lin_add (x, lin_neg y)), (linearize i, linearize j))
    7.89 -  | linearize (Mult (i, j)) =
    7.90 -    (case linearize i of None => None
    7.91 -      | Some x =>
    7.92 -          (case x of
    7.93 -            Cst xa =>
    7.94 -              (case linearize j of None => None
    7.95 -                | Some x => Some (lin_mul (xa, x)))
    7.96 -            | Var xa =>
    7.97 -                (case linearize j of None => None
    7.98 -                  | Some xa =>
    7.99 -                      (case xa of Cst xa => Some (lin_mul (xa, x))
   7.100 -                        | Var xa => None | Neg xa => None | Add (xa, xb) => None
   7.101 -                        | Sub (xa, xb) => None | Mult (xa, xb) => None))
   7.102 -            | Neg xa =>
   7.103 -                (case linearize j of None => None
   7.104 -                  | Some xa =>
   7.105 -                      (case xa of Cst xa => Some (lin_mul (xa, x))
   7.106 -                        | Var xa => None | Neg xa => None | Add (xa, xb) => None
   7.107 -                        | Sub (xa, xb) => None | Mult (xa, xb) => None))
   7.108 -            | Add (xa, xb) =>
   7.109 -                (case linearize j of None => None
   7.110 -                  | Some xa =>
   7.111 -                      (case xa of Cst xa => Some (lin_mul (xa, x))
   7.112 -                        | Var xa => None | Neg xa => None | Add (xa, xb) => None
   7.113 -                        | Sub (xa, xb) => None | Mult (xa, xb) => None))
   7.114 -            | Sub (xa, xb) =>
   7.115 -                (case linearize j of None => None
   7.116 -                  | Some xa =>
   7.117 -                      (case xa of Cst xa => Some (lin_mul (xa, x))
   7.118 -                        | Var xa => None | Neg xa => None | Add (xa, xb) => None
   7.119 -                        | Sub (xa, xb) => None | Mult (xa, xb) => None))
   7.120 -            | Mult (xa, xb) =>
   7.121 -                (case linearize j of None => None
   7.122 -                  | Some xa =>
   7.123 -                      (case xa of Cst xa => Some (lin_mul (xa, x))
   7.124 -                        | Var xa => None | Neg xa => None | Add (xa, xb) => None
   7.125 -                        | Sub (xa, xb) => None | Mult (xa, xb) => None))));
   7.126 -
   7.127 -fun linform (Le (it1, it2)) =
   7.128 -    lift_bin
   7.129 -      ((fn x => fn y => Le (lin_add (x, lin_neg y), Cst 0)),
   7.130 -        (linearize it1, linearize it2))
   7.131 -  | linform (Eq (it1, it2)) =
   7.132 -    lift_bin
   7.133 -      ((fn x => fn y => Eq (lin_add (x, lin_neg y), Cst 0)),
   7.134 -        (linearize it1, linearize it2))
   7.135 -  | linform (Divides (d, t)) =
   7.136 -    (case linearize d of None => None
   7.137 -      | Some x =>
   7.138 -          (case x of
   7.139 -            Cst xa =>
   7.140 -              (if (xa = 0) then None
   7.141 -                else (case linearize t of None => None
   7.142 -                       | Some xa => Some (Divides (x, xa))))
   7.143 -            | Var xa => None | Neg xa => None | Add (xa, xb) => None
   7.144 -            | Sub (xa, xb) => None | Mult (xa, xb) => None))
   7.145 -  | linform T = Some T
   7.146 -  | linform F = Some F
   7.147 -  | linform (NOT p) = lift_un NOT (linform p)
   7.148 -  | linform (And (p, q)) =
   7.149 -    lift_bin ((fn f => fn g => And (f, g)), (linform p, linform q))
   7.150 -  | linform (Or (p, q)) =
   7.151 -    lift_bin ((fn f => fn g => Or (f, g)), (linform p, linform q));
   7.152 -
   7.153 -fun nnf (Lt (it1, it2)) = Le (Sub (it1, it2), Cst (~ 1))
   7.154 -  | nnf (Gt (it1, it2)) = Le (Sub (it2, it1), Cst (~ 1))
   7.155 -  | nnf (Le (it1, it2)) = Le (it1, it2)
   7.156 -  | nnf (Ge (it1, it2)) = Le (it2, it1)
   7.157 -  | nnf (Eq (it1, it2)) = Eq (it2, it1)
   7.158 -  | nnf (Divides (d, t)) = Divides (d, t)
   7.159 -  | nnf T = T
   7.160 -  | nnf F = F
   7.161 -  | nnf (And (p, q)) = And (nnf p, nnf q)
   7.162 -  | nnf (Or (p, q)) = Or (nnf p, nnf q)
   7.163 -  | nnf (Imp (p, q)) = Or (nnf (NOT p), nnf q)
   7.164 -  | nnf (Equ (p, q)) = Or (And (nnf p, nnf q), And (nnf (NOT p), nnf (NOT q)))
   7.165 -  | nnf (NOT (Lt (it1, it2))) = Le (it2, it1)
   7.166 -  | nnf (NOT (Gt (it1, it2))) = Le (it1, it2)
   7.167 -  | nnf (NOT (Le (it1, it2))) = Le (Sub (it2, it1), Cst (~ 1))
   7.168 -  | nnf (NOT (Ge (it1, it2))) = Le (Sub (it1, it2), Cst (~ 1))
   7.169 -  | nnf (NOT (Eq (it1, it2))) = NOT (Eq (it1, it2))
   7.170 -  | nnf (NOT (Divides (d, t))) = NOT (Divides (d, t))
   7.171 -  | nnf (NOT T) = F
   7.172 -  | nnf (NOT F) = T
   7.173 -  | nnf (NOT (NOT p)) = nnf p
   7.174 -  | nnf (NOT (And (p, q))) = Or (nnf (NOT p), nnf (NOT q))
   7.175 -  | nnf (NOT (Or (p, q))) = And (nnf (NOT p), nnf (NOT q))
   7.176 -  | nnf (NOT (Imp (p, q))) = And (nnf p, nnf (NOT q))
   7.177 -  | nnf (NOT (Equ (p, q))) =
   7.178 -    Or (And (nnf p, nnf (NOT q)), And (nnf (NOT p), nnf q));
   7.179 -
   7.180 -fun op_45_def2 z w =  IntInf.+ (z,~ w);
   7.181 -
   7.182 -fun op_45_def0 m n = nat (op_45_def2 (m) (n));
   7.183 -
   7.184 -val id_1_def0 : IntInf.int = (0 + 1);
   7.185 -
   7.186 -fun decrvarsI (Cst i) = Cst i
   7.187 -  | decrvarsI (Var n) = Var (op_45_def0 n id_1_def0)
   7.188 -  | decrvarsI (Neg a) = Neg (decrvarsI a)
   7.189 -  | decrvarsI (Add (a, b)) = Add (decrvarsI a, decrvarsI b)
   7.190 -  | decrvarsI (Sub (a, b)) = Sub (decrvarsI a, decrvarsI b)
   7.191 -  | decrvarsI (Mult (a, b)) = Mult (decrvarsI a, decrvarsI b);
   7.192 -
   7.193 -fun decrvars (Lt (a, b)) = Lt (decrvarsI a, decrvarsI b)
   7.194 -  | decrvars (Gt (a, b)) = Gt (decrvarsI a, decrvarsI b)
   7.195 -  | decrvars (Le (a, b)) = Le (decrvarsI a, decrvarsI b)
   7.196 -  | decrvars (Ge (a, b)) = Ge (decrvarsI a, decrvarsI b)
   7.197 -  | decrvars (Eq (a, b)) = Eq (decrvarsI a, decrvarsI b)
   7.198 -  | decrvars (Divides (a, b)) = Divides (decrvarsI a, decrvarsI b)
   7.199 -  | decrvars T = T
   7.200 -  | decrvars F = F
   7.201 -  | decrvars (NOT p) = NOT (decrvars p)
   7.202 -  | decrvars (And (p, q)) = And (decrvars p, decrvars q)
   7.203 -  | decrvars (Or (p, q)) = Or (decrvars p, decrvars q)
   7.204 -  | decrvars (Imp (p, q)) = Imp (decrvars p, decrvars q)
   7.205 -  | decrvars (Equ (p, q)) = Equ (decrvars p, decrvars q);
   7.206 -
   7.207 -fun op_64 [] ys = ys
   7.208 -  | op_64 (x :: xs) ys = (x :: op_64 xs ys);
   7.209 -
   7.210 -fun map f [] = []
   7.211 -  | map f (x :: xs) = (f x :: map f xs);
   7.212 -
   7.213 -fun iupto (i:IntInf.int, j:IntInf.int) = (if (j < i) then [] else (i :: iupto ((i + 1), j)));
   7.214 -
   7.215 -fun all_sums (j:IntInf.int, []) = []
   7.216 -  | all_sums (j, (i :: is)) =
   7.217 -    op_64 (map (fn x => lin_add (i, Cst x)) (iupto (1, j))) (all_sums (j, is));
   7.218 -
   7.219 -fun split x = (fn p => x (fst p) (snd p));
   7.220 -
   7.221 -fun negateSnd x = split (fn q => fn r => (q, IntInf.~ r)) x;
   7.222 -
   7.223 -fun adjust b =
   7.224 -  (fn (q:IntInf.int, r:IntInf.int) =>
   7.225 -    (if (0 <= op_45_def2 r b) then ((((2:IntInf.int) * q) + (1:IntInf.int)), op_45_def2 r b)
   7.226 -      else (((2:IntInf.int) * q), r)));
   7.227 -
   7.228 -fun negDivAlg (a:IntInf.int, b:IntInf.int) =
   7.229 -    (if ((0 <= (a + b)) orelse (b <= 0)) then (~1, (a + b))
   7.230 -      else adjust b (negDivAlg (a, (2 * b))));
   7.231 -
   7.232 -fun posDivAlg (a:IntInf.int, b:IntInf.int) =
   7.233 -    (if ((a < b) orelse (b <= 0)) then (0, a)
   7.234 -      else adjust b (posDivAlg (a, (2 * b))));
   7.235 -
   7.236 -fun divAlg x =
   7.237 -  split (fn a:IntInf.int => fn b:IntInf.int =>
   7.238 -          (if (0 <= a)
   7.239 -            then (if (0 <= b) then posDivAlg (a, b)
   7.240 -                   else (if (a = 0) then (0, 0)
   7.241 -                          else negateSnd (negDivAlg (~ a, ~ b))))
   7.242 -            else (if (0 < b) then negDivAlg (a, b)
   7.243 -                   else negateSnd (posDivAlg (~ a, ~ b)))))
   7.244 -    x;
   7.245 -
   7.246 -fun op_mod_def1 a b = snd (divAlg (a, b));
   7.247 -
   7.248 -fun op_dvd m n = (op_mod_def1 n m = 0);
   7.249 -
   7.250 -fun psimpl (Le (l, r)) =
   7.251 -    (case lift_bin
   7.252 -            ((fn x => fn y => lin_add (x, lin_neg y)),
   7.253 -              (linearize l, linearize r)) of
   7.254 -      None => Le (l, r)
   7.255 -      | Some x =>
   7.256 -          (case x of Cst xa => (if (xa <= 0) then T else F)
   7.257 -            | Var xa => Le (x, Cst 0) | Neg xa => Le (x, Cst 0)
   7.258 -            | Add (xa, xb) => Le (x, Cst 0) | Sub (xa, xb) => Le (x, Cst 0)
   7.259 -            | Mult (xa, xb) => Le (x, Cst 0)))
   7.260 -  | psimpl (Eq (l, r)) =
   7.261 -    (case lift_bin
   7.262 -            ((fn x => fn y => lin_add (x, lin_neg y)),
   7.263 -              (linearize l, linearize r)) of
   7.264 -      None => Eq (l, r)
   7.265 -      | Some x =>
   7.266 -          (case x of Cst xa => (if (xa = 0) then T else F)
   7.267 -            | Var xa => Eq (x, Cst 0) | Neg xa => Eq (x, Cst 0)
   7.268 -            | Add (xa, xb) => Eq (x, Cst 0) | Sub (xa, xb) => Eq (x, Cst 0)
   7.269 -            | Mult (xa, xb) => Eq (x, Cst 0)))
   7.270 -  | psimpl (Divides (Cst d, t)) =
   7.271 -    (case linearize t of None => Divides (Cst d, t)
   7.272 -      | Some x =>
   7.273 -          (case x of Cst xa => (if op_dvd d xa then T else F)
   7.274 -            | Var xa => Divides (Cst d, x) | Neg xa => Divides (Cst d, x)
   7.275 -            | Add (xa, xb) => Divides (Cst d, x)
   7.276 -            | Sub (xa, xb) => Divides (Cst d, x)
   7.277 -            | Mult (xa, xb) => Divides (Cst d, x)))
   7.278 -  | psimpl (Equ (p, q)) =
   7.279 -    let val p' = psimpl p; val q' = psimpl q
   7.280 -    in (case p' of
   7.281 -         Lt (x, xa) =>
   7.282 -           (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.283 -             | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.284 -             | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.285 -             | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.286 -             | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.287 -             | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.288 -             | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.289 -         | Gt (x, xa) =>
   7.290 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.291 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.292 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.293 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.294 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.295 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.296 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.297 -         | Le (x, xa) =>
   7.298 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.299 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.300 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.301 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.302 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.303 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.304 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.305 -         | Ge (x, xa) =>
   7.306 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.307 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.308 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.309 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.310 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.311 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.312 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.313 -         | Eq (x, xa) =>
   7.314 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.315 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.316 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.317 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.318 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.319 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.320 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.321 -         | Divides (x, xa) =>
   7.322 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.323 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.324 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.325 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.326 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.327 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.328 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.329 -         | T => q'
   7.330 -         | F => (case q' of Lt (x, xa) => NOT q' | Gt (x, xa) => NOT q'
   7.331 -                  | Le (x, xa) => NOT q' | Ge (x, xa) => NOT q'
   7.332 -                  | Eq (x, xa) => NOT q' | Divides (x, xa) => NOT q' | T => F
   7.333 -                  | F => T | NOT x => x | And (x, xa) => NOT q'
   7.334 -                  | Or (x, xa) => NOT q' | Imp (x, xa) => NOT q'
   7.335 -                  | Equ (x, xa) => NOT q' | QAll x => NOT q' | QEx x => NOT q')
   7.336 -         | NOT x =>
   7.337 -             (case q' of Lt (xa, xb) => Equ (p', q')
   7.338 -               | Gt (xa, xb) => Equ (p', q') | Le (xa, xb) => Equ (p', q')
   7.339 -               | Ge (xa, xb) => Equ (p', q') | Eq (xa, xb) => Equ (p', q')
   7.340 -               | Divides (xa, xb) => Equ (p', q') | T => p' | F => x
   7.341 -               | NOT xa => Equ (x, xa) | And (xa, xb) => Equ (p', q')
   7.342 -               | Or (xa, xb) => Equ (p', q') | Imp (xa, xb) => Equ (p', q')
   7.343 -               | Equ (xa, xb) => Equ (p', q') | QAll xa => Equ (p', q')
   7.344 -               | QEx xa => Equ (p', q'))
   7.345 -         | And (x, xa) =>
   7.346 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.347 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.348 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.349 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.350 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.351 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.352 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.353 -         | Or (x, xa) =>
   7.354 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.355 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.356 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.357 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.358 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.359 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.360 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.361 -         | Imp (x, xa) =>
   7.362 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.363 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.364 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.365 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.366 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.367 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.368 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.369 -         | Equ (x, xa) =>
   7.370 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.371 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.372 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.373 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.374 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.375 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.376 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.377 -         | QAll x =>
   7.378 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.379 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.380 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.381 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.382 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.383 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.384 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q'))
   7.385 -         | QEx x =>
   7.386 -             (case q' of Lt (x, xa) => Equ (p', q') | Gt (x, xa) => Equ (p', q')
   7.387 -               | Le (x, xa) => Equ (p', q') | Ge (x, xa) => Equ (p', q')
   7.388 -               | Eq (x, xa) => Equ (p', q') | Divides (x, xa) => Equ (p', q')
   7.389 -               | T => p' | F => NOT p' | NOT x => Equ (p', q')
   7.390 -               | And (x, xa) => Equ (p', q') | Or (x, xa) => Equ (p', q')
   7.391 -               | Imp (x, xa) => Equ (p', q') | Equ (x, xa) => Equ (p', q')
   7.392 -               | QAll x => Equ (p', q') | QEx x => Equ (p', q')))
   7.393 -    end
   7.394 -  | psimpl (NOT p) =
   7.395 -    let val p' = psimpl p
   7.396 -    in (case p' of Lt (x, xa) => NOT p' | Gt (x, xa) => NOT p'
   7.397 -         | Le (x, xa) => NOT p' | Ge (x, xa) => NOT p' | Eq (x, xa) => NOT p'
   7.398 -         | Divides (x, xa) => NOT p' | T => F | F => T | NOT x => x
   7.399 -         | And (x, xa) => NOT p' | Or (x, xa) => NOT p' | Imp (x, xa) => NOT p'
   7.400 -         | Equ (x, xa) => NOT p' | QAll x => NOT p' | QEx x => NOT p')
   7.401 -    end
   7.402 -  | psimpl (Lt (u, v)) = Lt (u, v)
   7.403 -  | psimpl (Gt (w, x)) = Gt (w, x)
   7.404 -  | psimpl (Ge (aa, ab)) = Ge (aa, ab)
   7.405 -  | psimpl (Divides (Var bp, af)) = Divides (Var bp, af)
   7.406 -  | psimpl (Divides (Neg bq, af)) = Divides (Neg bq, af)
   7.407 -  | psimpl (Divides (Add (br, bs), af)) = Divides (Add (br, bs), af)
   7.408 -  | psimpl (Divides (Sub (bt, bu), af)) = Divides (Sub (bt, bu), af)
   7.409 -  | psimpl (Divides (Mult (bv, bw), af)) = Divides (Mult (bv, bw), af)
   7.410 -  | psimpl T = T
   7.411 -  | psimpl F = F
   7.412 -  | psimpl (QAll ap) = QAll ap
   7.413 -  | psimpl (QEx aq) = QEx aq
   7.414 -  | psimpl (And (p, q)) =
   7.415 -    let val p' = psimpl p
   7.416 -    in (case p' of
   7.417 -         Lt (x, xa) =>
   7.418 -           let val q' = psimpl q
   7.419 -           in (case q' of Lt (x, xa) => And (p', q')
   7.420 -                | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.421 -                | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.422 -                | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.423 -                | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.424 -                | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.425 -                | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.426 -                | QEx x => And (p', q'))
   7.427 -           end
   7.428 -         | Gt (x, xa) =>
   7.429 -             let val q' = psimpl q
   7.430 -             in (case q' of Lt (x, xa) => And (p', q')
   7.431 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.432 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.433 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.434 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.435 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.436 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.437 -                  | QEx x => And (p', q'))
   7.438 -             end
   7.439 -         | Le (x, xa) =>
   7.440 -             let val q' = psimpl q
   7.441 -             in (case q' of Lt (x, xa) => And (p', q')
   7.442 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.443 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.444 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.445 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.446 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.447 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.448 -                  | QEx x => And (p', q'))
   7.449 -             end
   7.450 -         | Ge (x, xa) =>
   7.451 -             let val q' = psimpl q
   7.452 -             in (case q' of Lt (x, xa) => And (p', q')
   7.453 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.454 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.455 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.456 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.457 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.458 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.459 -                  | QEx x => And (p', q'))
   7.460 -             end
   7.461 -         | Eq (x, xa) =>
   7.462 -             let val q' = psimpl q
   7.463 -             in (case q' of Lt (x, xa) => And (p', q')
   7.464 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.465 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.466 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.467 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.468 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.469 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.470 -                  | QEx x => And (p', q'))
   7.471 -             end
   7.472 -         | Divides (x, xa) =>
   7.473 -             let val q' = psimpl q
   7.474 -             in (case q' of Lt (x, xa) => And (p', q')
   7.475 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.476 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.477 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.478 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.479 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.480 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.481 -                  | QEx x => And (p', q'))
   7.482 -             end
   7.483 -         | T => psimpl q | F => F
   7.484 -         | NOT x =>
   7.485 -             let val q' = psimpl q
   7.486 -             in (case q' of Lt (x, xa) => And (p', q')
   7.487 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.488 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.489 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.490 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.491 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.492 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.493 -                  | QEx x => And (p', q'))
   7.494 -             end
   7.495 -         | And (x, xa) =>
   7.496 -             let val q' = psimpl q
   7.497 -             in (case q' of Lt (x, xa) => And (p', q')
   7.498 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.499 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.500 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.501 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.502 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.503 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.504 -                  | QEx x => And (p', q'))
   7.505 -             end
   7.506 -         | Or (x, xa) =>
   7.507 -             let val q' = psimpl q
   7.508 -             in (case q' of Lt (x, xa) => And (p', q')
   7.509 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.510 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.511 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.512 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.513 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.514 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.515 -                  | QEx x => And (p', q'))
   7.516 -             end
   7.517 -         | Imp (x, xa) =>
   7.518 -             let val q' = psimpl q
   7.519 -             in (case q' of Lt (x, xa) => And (p', q')
   7.520 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.521 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.522 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.523 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.524 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.525 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.526 -                  | QEx x => And (p', q'))
   7.527 -             end
   7.528 -         | Equ (x, xa) =>
   7.529 -             let val q' = psimpl q
   7.530 -             in (case q' of Lt (x, xa) => And (p', q')
   7.531 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.532 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.533 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.534 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.535 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.536 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.537 -                  | QEx x => And (p', q'))
   7.538 -             end
   7.539 -         | QAll x =>
   7.540 -             let val q' = psimpl q
   7.541 -             in (case q' of Lt (x, xa) => And (p', q')
   7.542 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.543 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.544 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.545 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.546 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.547 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.548 -                  | QEx x => And (p', q'))
   7.549 -             end
   7.550 -         | QEx x =>
   7.551 -             let val q' = psimpl q
   7.552 -             in (case q' of Lt (x, xa) => And (p', q')
   7.553 -                  | Gt (x, xa) => And (p', q') | Le (x, xa) => And (p', q')
   7.554 -                  | Ge (x, xa) => And (p', q') | Eq (x, xa) => And (p', q')
   7.555 -                  | Divides (x, xa) => And (p', q') | T => p' | F => F
   7.556 -                  | NOT x => And (p', q') | And (x, xa) => And (p', q')
   7.557 -                  | Or (x, xa) => And (p', q') | Imp (x, xa) => And (p', q')
   7.558 -                  | Equ (x, xa) => And (p', q') | QAll x => And (p', q')
   7.559 -                  | QEx x => And (p', q'))
   7.560 -             end)
   7.561 -    end
   7.562 -  | psimpl (Or (p, q)) =
   7.563 -    let val p' = psimpl p
   7.564 -    in (case p' of
   7.565 -         Lt (x, xa) =>
   7.566 -           let val q' = psimpl q
   7.567 -           in (case q' of Lt (x, xa) => Or (p', q') | Gt (x, xa) => Or (p', q')
   7.568 -                | Le (x, xa) => Or (p', q') | Ge (x, xa) => Or (p', q')
   7.569 -                | Eq (x, xa) => Or (p', q') | Divides (x, xa) => Or (p', q')
   7.570 -                | T => T | F => p' | NOT x => Or (p', q')
   7.571 -                | And (x, xa) => Or (p', q') | Or (x, xa) => Or (p', q')
   7.572 -                | Imp (x, xa) => Or (p', q') | Equ (x, xa) => Or (p', q')
   7.573 -                | QAll x => Or (p', q') | QEx x => Or (p', q'))
   7.574 -           end
   7.575 -         | Gt (x, xa) =>
   7.576 -             let val q' = psimpl q
   7.577 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.578 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.579 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.580 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.581 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.582 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.583 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.584 -                  | QEx x => Or (p', q'))
   7.585 -             end
   7.586 -         | Le (x, xa) =>
   7.587 -             let val q' = psimpl q
   7.588 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.589 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.590 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.591 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.592 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.593 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.594 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.595 -                  | QEx x => Or (p', q'))
   7.596 -             end
   7.597 -         | Ge (x, xa) =>
   7.598 -             let val q' = psimpl q
   7.599 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.600 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.601 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.602 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.603 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.604 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.605 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.606 -                  | QEx x => Or (p', q'))
   7.607 -             end
   7.608 -         | Eq (x, xa) =>
   7.609 -             let val q' = psimpl q
   7.610 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.611 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.612 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.613 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.614 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.615 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.616 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.617 -                  | QEx x => Or (p', q'))
   7.618 -             end
   7.619 -         | Divides (x, xa) =>
   7.620 -             let val q' = psimpl q
   7.621 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.622 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.623 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.624 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.625 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.626 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.627 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.628 -                  | QEx x => Or (p', q'))
   7.629 -             end
   7.630 -         | T => T | F => psimpl q
   7.631 -         | NOT x =>
   7.632 -             let val q' = psimpl q
   7.633 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.634 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.635 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.636 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.637 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.638 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.639 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.640 -                  | QEx x => Or (p', q'))
   7.641 -             end
   7.642 -         | And (x, xa) =>
   7.643 -             let val q' = psimpl q
   7.644 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.645 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.646 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.647 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.648 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.649 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.650 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.651 -                  | QEx x => Or (p', q'))
   7.652 -             end
   7.653 -         | Or (x, xa) =>
   7.654 -             let val q' = psimpl q
   7.655 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.656 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.657 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.658 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.659 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.660 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.661 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.662 -                  | QEx x => Or (p', q'))
   7.663 -             end
   7.664 -         | Imp (x, xa) =>
   7.665 -             let val q' = psimpl q
   7.666 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.667 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.668 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.669 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.670 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.671 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.672 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.673 -                  | QEx x => Or (p', q'))
   7.674 -             end
   7.675 -         | Equ (x, xa) =>
   7.676 -             let val q' = psimpl q
   7.677 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.678 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.679 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.680 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.681 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.682 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.683 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.684 -                  | QEx x => Or (p', q'))
   7.685 -             end
   7.686 -         | QAll x =>
   7.687 -             let val q' = psimpl q
   7.688 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.689 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.690 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.691 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.692 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.693 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.694 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.695 -                  | QEx x => Or (p', q'))
   7.696 -             end
   7.697 -         | QEx x =>
   7.698 -             let val q' = psimpl q
   7.699 -             in (case q' of Lt (x, xa) => Or (p', q')
   7.700 -                  | Gt (x, xa) => Or (p', q') | Le (x, xa) => Or (p', q')
   7.701 -                  | Ge (x, xa) => Or (p', q') | Eq (x, xa) => Or (p', q')
   7.702 -                  | Divides (x, xa) => Or (p', q') | T => T | F => p'
   7.703 -                  | NOT x => Or (p', q') | And (x, xa) => Or (p', q')
   7.704 -                  | Or (x, xa) => Or (p', q') | Imp (x, xa) => Or (p', q')
   7.705 -                  | Equ (x, xa) => Or (p', q') | QAll x => Or (p', q')
   7.706 -                  | QEx x => Or (p', q'))
   7.707 -             end)
   7.708 -    end
   7.709 -  | psimpl (Imp (p, q)) =
   7.710 -    let val p' = psimpl p
   7.711 -    in (case p' of
   7.712 -         Lt (x, xa) =>
   7.713 -           let val q' = psimpl q
   7.714 -           in (case q' of Lt (x, xa) => Imp (p', q')
   7.715 -                | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.716 -                | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.717 -                | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.718 -                | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.719 -                | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.720 -                | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.721 -                | QEx x => Imp (p', q'))
   7.722 -           end
   7.723 -         | Gt (x, xa) =>
   7.724 -             let val q' = psimpl q
   7.725 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.726 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.727 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.728 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.729 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.730 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.731 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.732 -                  | QEx x => Imp (p', q'))
   7.733 -             end
   7.734 -         | Le (x, xa) =>
   7.735 -             let val q' = psimpl q
   7.736 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.737 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.738 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.739 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.740 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.741 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.742 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.743 -                  | QEx x => Imp (p', q'))
   7.744 -             end
   7.745 -         | Ge (x, xa) =>
   7.746 -             let val q' = psimpl q
   7.747 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.748 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.749 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.750 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.751 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.752 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.753 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.754 -                  | QEx x => Imp (p', q'))
   7.755 -             end
   7.756 -         | Eq (x, xa) =>
   7.757 -             let val q' = psimpl q
   7.758 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.759 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.760 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.761 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.762 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.763 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.764 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.765 -                  | QEx x => Imp (p', q'))
   7.766 -             end
   7.767 -         | Divides (x, xa) =>
   7.768 -             let val q' = psimpl q
   7.769 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.770 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.771 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.772 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.773 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.774 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.775 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.776 -                  | QEx x => Imp (p', q'))
   7.777 -             end
   7.778 -         | T => psimpl q | F => T
   7.779 -         | NOT x =>
   7.780 -             let val q' = psimpl q
   7.781 -             in (case q' of Lt (xa, xb) => Or (x, q')
   7.782 -                  | Gt (xa, xb) => Or (x, q') | Le (xa, xb) => Or (x, q')
   7.783 -                  | Ge (xa, xb) => Or (x, q') | Eq (xa, xb) => Or (x, q')
   7.784 -                  | Divides (xa, xb) => Or (x, q') | T => T | F => x
   7.785 -                  | NOT xa => Or (x, q') | And (xa, xb) => Or (x, q')
   7.786 -                  | Or (xa, xb) => Or (x, q') | Imp (xa, xb) => Or (x, q')
   7.787 -                  | Equ (xa, xb) => Or (x, q') | QAll xa => Or (x, q')
   7.788 -                  | QEx xa => Or (x, q'))
   7.789 -             end
   7.790 -         | And (x, xa) =>
   7.791 -             let val q' = psimpl q
   7.792 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.793 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.794 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.795 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.796 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.797 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.798 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.799 -                  | QEx x => Imp (p', q'))
   7.800 -             end
   7.801 -         | Or (x, xa) =>
   7.802 -             let val q' = psimpl q
   7.803 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.804 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.805 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.806 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.807 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.808 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.809 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.810 -                  | QEx x => Imp (p', q'))
   7.811 -             end
   7.812 -         | Imp (x, xa) =>
   7.813 -             let val q' = psimpl q
   7.814 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.815 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.816 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.817 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.818 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.819 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.820 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.821 -                  | QEx x => Imp (p', q'))
   7.822 -             end
   7.823 -         | Equ (x, xa) =>
   7.824 -             let val q' = psimpl q
   7.825 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.826 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.827 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.828 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.829 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.830 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.831 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.832 -                  | QEx x => Imp (p', q'))
   7.833 -             end
   7.834 -         | QAll x =>
   7.835 -             let val q' = psimpl q
   7.836 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.837 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.838 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.839 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.840 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.841 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.842 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.843 -                  | QEx x => Imp (p', q'))
   7.844 -             end
   7.845 -         | QEx x =>
   7.846 -             let val q' = psimpl q
   7.847 -             in (case q' of Lt (x, xa) => Imp (p', q')
   7.848 -                  | Gt (x, xa) => Imp (p', q') | Le (x, xa) => Imp (p', q')
   7.849 -                  | Ge (x, xa) => Imp (p', q') | Eq (x, xa) => Imp (p', q')
   7.850 -                  | Divides (x, xa) => Imp (p', q') | T => T | F => NOT p'
   7.851 -                  | NOT x => Imp (p', q') | And (x, xa) => Imp (p', q')
   7.852 -                  | Or (x, xa) => Imp (p', q') | Imp (x, xa) => Imp (p', q')
   7.853 -                  | Equ (x, xa) => Imp (p', q') | QAll x => Imp (p', q')
   7.854 -                  | QEx x => Imp (p', q'))
   7.855 -             end)
   7.856 -    end;
   7.857 -
   7.858 -fun subst_it i (Cst b) = Cst b
   7.859 -  | subst_it i (Var n) = (if (n = 0) then i else Var n)
   7.860 -  | subst_it i (Neg it) = Neg (subst_it i it)
   7.861 -  | subst_it i (Add (it1, it2)) = Add (subst_it i it1, subst_it i it2)
   7.862 -  | subst_it i (Sub (it1, it2)) = Sub (subst_it i it1, subst_it i it2)
   7.863 -  | subst_it i (Mult (it1, it2)) = Mult (subst_it i it1, subst_it i it2);
   7.864 -
   7.865 -fun subst_p i (Le (it1, it2)) = Le (subst_it i it1, subst_it i it2)
   7.866 -  | subst_p i (Lt (it1, it2)) = Lt (subst_it i it1, subst_it i it2)
   7.867 -  | subst_p i (Ge (it1, it2)) = Ge (subst_it i it1, subst_it i it2)
   7.868 -  | subst_p i (Gt (it1, it2)) = Gt (subst_it i it1, subst_it i it2)
   7.869 -  | subst_p i (Eq (it1, it2)) = Eq (subst_it i it1, subst_it i it2)
   7.870 -  | subst_p i (Divides (d, t)) = Divides (subst_it i d, subst_it i t)
   7.871 -  | subst_p i T = T
   7.872 -  | subst_p i F = F
   7.873 -  | subst_p i (And (p, q)) = And (subst_p i p, subst_p i q)
   7.874 -  | subst_p i (Or (p, q)) = Or (subst_p i p, subst_p i q)
   7.875 -  | subst_p i (Imp (p, q)) = Imp (subst_p i p, subst_p i q)
   7.876 -  | subst_p i (Equ (p, q)) = Equ (subst_p i p, subst_p i q)
   7.877 -  | subst_p i (NOT p) = NOT (subst_p i p);
   7.878 -
   7.879 -fun explode_disj ([], p) = F
   7.880 -  | explode_disj ((i :: is), p) =
   7.881 -    let val pi = psimpl (subst_p i p)
   7.882 -    in (case pi of
   7.883 -         Lt (x, xa) =>
   7.884 -           let val r = explode_disj (is, p)
   7.885 -           in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.886 -                | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.887 -                | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.888 -                | T => T | F => pi | NOT x => Or (pi, r)
   7.889 -                | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.890 -                | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.891 -                | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.892 -           end
   7.893 -         | Gt (x, xa) =>
   7.894 -             let val r = explode_disj (is, p)
   7.895 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.896 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.897 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.898 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.899 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.900 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.901 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.902 -             end
   7.903 -         | Le (x, xa) =>
   7.904 -             let val r = explode_disj (is, p)
   7.905 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.906 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.907 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.908 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.909 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.910 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.911 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.912 -             end
   7.913 -         | Ge (x, xa) =>
   7.914 -             let val r = explode_disj (is, p)
   7.915 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.916 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.917 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.918 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.919 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.920 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.921 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.922 -             end
   7.923 -         | Eq (x, xa) =>
   7.924 -             let val r = explode_disj (is, p)
   7.925 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.926 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.927 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.928 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.929 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.930 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.931 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.932 -             end
   7.933 -         | Divides (x, xa) =>
   7.934 -             let val r = explode_disj (is, p)
   7.935 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.936 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.937 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.938 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.939 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.940 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.941 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.942 -             end
   7.943 -         | T => T | F => explode_disj (is, p)
   7.944 -         | NOT x =>
   7.945 -             let val r = explode_disj (is, p)
   7.946 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.947 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.948 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.949 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.950 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.951 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.952 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.953 -             end
   7.954 -         | And (x, xa) =>
   7.955 -             let val r = explode_disj (is, p)
   7.956 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.957 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.958 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.959 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.960 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.961 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.962 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.963 -             end
   7.964 -         | Or (x, xa) =>
   7.965 -             let val r = explode_disj (is, p)
   7.966 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.967 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.968 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.969 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.970 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.971 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.972 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.973 -             end
   7.974 -         | Imp (x, xa) =>
   7.975 -             let val r = explode_disj (is, p)
   7.976 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.977 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.978 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.979 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.980 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.981 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.982 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.983 -             end
   7.984 -         | Equ (x, xa) =>
   7.985 -             let val r = explode_disj (is, p)
   7.986 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.987 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.988 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.989 -                  | T => T | F => pi | NOT x => Or (pi, r)
   7.990 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
   7.991 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
   7.992 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
   7.993 -             end
   7.994 -         | QAll x =>
   7.995 -             let val r = explode_disj (is, p)
   7.996 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
   7.997 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
   7.998 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
   7.999 -                  | T => T | F => pi | NOT x => Or (pi, r)
  7.1000 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
  7.1001 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
  7.1002 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
  7.1003 -             end
  7.1004 -         | QEx x =>
  7.1005 -             let val r = explode_disj (is, p)
  7.1006 -             in (case r of Lt (x, xa) => Or (pi, r) | Gt (x, xa) => Or (pi, r)
  7.1007 -                  | Le (x, xa) => Or (pi, r) | Ge (x, xa) => Or (pi, r)
  7.1008 -                  | Eq (x, xa) => Or (pi, r) | Divides (x, xa) => Or (pi, r)
  7.1009 -                  | T => T | F => pi | NOT x => Or (pi, r)
  7.1010 -                  | And (x, xa) => Or (pi, r) | Or (x, xa) => Or (pi, r)
  7.1011 -                  | Imp (x, xa) => Or (pi, r) | Equ (x, xa) => Or (pi, r)
  7.1012 -                  | QAll x => Or (pi, r) | QEx x => Or (pi, r))
  7.1013 -             end)
  7.1014 -    end;
  7.1015 -
  7.1016 -fun minusinf (And (p, q)) = And (minusinf p, minusinf q)
  7.1017 -  | minusinf (Or (p, q)) = Or (minusinf p, minusinf q)
  7.1018 -  | minusinf (Lt (u, v)) = Lt (u, v)
  7.1019 -  | minusinf (Gt (w, x)) = Gt (w, x)
  7.1020 -  | minusinf (Le (Cst bo, z)) = Le (Cst bo, z)
  7.1021 -  | minusinf (Le (Var bp, z)) = Le (Var bp, z)
  7.1022 -  | minusinf (Le (Neg bq, z)) = Le (Neg bq, z)
  7.1023 -  | minusinf (Le (Add (Cst cg, bs), z)) = Le (Add (Cst cg, bs), z)
  7.1024 -  | minusinf (Le (Add (Var ch, bs), z)) = Le (Add (Var ch, bs), z)
  7.1025 -  | minusinf (Le (Add (Neg ci, bs), z)) = Le (Add (Neg ci, bs), z)
  7.1026 -  | minusinf (Le (Add (Add (cj, ck), bs), z)) = Le (Add (Add (cj, ck), bs), z)
  7.1027 -  | minusinf (Le (Add (Sub (cl, cm), bs), z)) = Le (Add (Sub (cl, cm), bs), z)
  7.1028 -  | minusinf (Le (Add (Mult (Cst cy, Cst dq), bs), z)) =
  7.1029 -    Le (Add (Mult (Cst cy, Cst dq), bs), z)
  7.1030 -  | minusinf (Le (Add (Mult (Cst cy, Var ei), bs), z)) =
  7.1031 -    (if (ei = 0) then (if (cy < 0) then F else T)
  7.1032 -      else Le (Add (Mult (Cst cy, Var (op_45_def0 ei id_1_def0 + 1)), bs), z))
  7.1033 -  | minusinf (Le (Add (Mult (Cst cy, Neg ds), bs), z)) =
  7.1034 -    Le (Add (Mult (Cst cy, Neg ds), bs), z)
  7.1035 -  | minusinf (Le (Add (Mult (Cst cy, Add (dt, du)), bs), z)) =
  7.1036 -    Le (Add (Mult (Cst cy, Add (dt, du)), bs), z)
  7.1037 -  | minusinf (Le (Add (Mult (Cst cy, Sub (dv, dw)), bs), z)) =
  7.1038 -    Le (Add (Mult (Cst cy, Sub (dv, dw)), bs), z)
  7.1039 -  | minusinf (Le (Add (Mult (Cst cy, Mult (dx, dy)), bs), z)) =
  7.1040 -    Le (Add (Mult (Cst cy, Mult (dx, dy)), bs), z)
  7.1041 -  | minusinf (Le (Add (Mult (Var cz, co), bs), z)) =
  7.1042 -    Le (Add (Mult (Var cz, co), bs), z)
  7.1043 -  | minusinf (Le (Add (Mult (Neg da, co), bs), z)) =
  7.1044 -    Le (Add (Mult (Neg da, co), bs), z)
  7.1045 -  | minusinf (Le (Add (Mult (Add (db, dc), co), bs), z)) =
  7.1046 -    Le (Add (Mult (Add (db, dc), co), bs), z)
  7.1047 -  | minusinf (Le (Add (Mult (Sub (dd, de), co), bs), z)) =
  7.1048 -    Le (Add (Mult (Sub (dd, de), co), bs), z)
  7.1049 -  | minusinf (Le (Add (Mult (Mult (df, dg), co), bs), z)) =
  7.1050 -    Le (Add (Mult (Mult (df, dg), co), bs), z)
  7.1051 -  | minusinf (Le (Sub (bt, bu), z)) = Le (Sub (bt, bu), z)
  7.1052 -  | minusinf (Le (Mult (bv, bw), z)) = Le (Mult (bv, bw), z)
  7.1053 -  | minusinf (Ge (aa, ab)) = Ge (aa, ab)
  7.1054 -  | minusinf (Eq (Cst ek, ad)) = Eq (Cst ek, ad)
  7.1055 -  | minusinf (Eq (Var el, ad)) = Eq (Var el, ad)
  7.1056 -  | minusinf (Eq (Neg em, ad)) = Eq (Neg em, ad)
  7.1057 -  | minusinf (Eq (Add (Cst fc, eo), ad)) = Eq (Add (Cst fc, eo), ad)
  7.1058 -  | minusinf (Eq (Add (Var fd, eo), ad)) = Eq (Add (Var fd, eo), ad)
  7.1059 -  | minusinf (Eq (Add (Neg fe, eo), ad)) = Eq (Add (Neg fe, eo), ad)
  7.1060 -  | minusinf (Eq (Add (Add (ff, fg), eo), ad)) = Eq (Add (Add (ff, fg), eo), ad)
  7.1061 -  | minusinf (Eq (Add (Sub (fh, fi), eo), ad)) = Eq (Add (Sub (fh, fi), eo), ad)
  7.1062 -  | minusinf (Eq (Add (Mult (Cst fu, Cst gm), eo), ad)) =
  7.1063 -    Eq (Add (Mult (Cst fu, Cst gm), eo), ad)
  7.1064 -  | minusinf (Eq (Add (Mult (Cst fu, Var he), eo), ad)) =
  7.1065 -    (if (he = 0) then F
  7.1066 -      else Eq (Add (Mult (Cst fu, Var (op_45_def0 he id_1_def0 + 1)), eo), ad))
  7.1067 -  | minusinf (Eq (Add (Mult (Cst fu, Neg go), eo), ad)) =
  7.1068 -    Eq (Add (Mult (Cst fu, Neg go), eo), ad)
  7.1069 -  | minusinf (Eq (Add (Mult (Cst fu, Add (gp, gq)), eo), ad)) =
  7.1070 -    Eq (Add (Mult (Cst fu, Add (gp, gq)), eo), ad)
  7.1071 -  | minusinf (Eq (Add (Mult (Cst fu, Sub (gr, gs)), eo), ad)) =
  7.1072 -    Eq (Add (Mult (Cst fu, Sub (gr, gs)), eo), ad)
  7.1073 -  | minusinf (Eq (Add (Mult (Cst fu, Mult (gt, gu)), eo), ad)) =
  7.1074 -    Eq (Add (Mult (Cst fu, Mult (gt, gu)), eo), ad)
  7.1075 -  | minusinf (Eq (Add (Mult (Var fv, fk), eo), ad)) =
  7.1076 -    Eq (Add (Mult (Var fv, fk), eo), ad)
  7.1077 -  | minusinf (Eq (Add (Mult (Neg fw, fk), eo), ad)) =
  7.1078 -    Eq (Add (Mult (Neg fw, fk), eo), ad)
  7.1079 -  | minusinf (Eq (Add (Mult (Add (fx, fy), fk), eo), ad)) =
  7.1080 -    Eq (Add (Mult (Add (fx, fy), fk), eo), ad)
  7.1081 -  | minusinf (Eq (Add (Mult (Sub (fz, ga), fk), eo), ad)) =
  7.1082 -    Eq (Add (Mult (Sub (fz, ga), fk), eo), ad)
  7.1083 -  | minusinf (Eq (Add (Mult (Mult (gb, gc), fk), eo), ad)) =
  7.1084 -    Eq (Add (Mult (Mult (gb, gc), fk), eo), ad)
  7.1085 -  | minusinf (Eq (Sub (ep, eq), ad)) = Eq (Sub (ep, eq), ad)
  7.1086 -  | minusinf (Eq (Mult (er, es), ad)) = Eq (Mult (er, es), ad)
  7.1087 -  | minusinf (Divides (ae, af)) = Divides (ae, af)
  7.1088 -  | minusinf T = T
  7.1089 -  | minusinf F = F
  7.1090 -  | minusinf (NOT (Lt (hg, hh))) = NOT (Lt (hg, hh))
  7.1091 -  | minusinf (NOT (Gt (hi, hj))) = NOT (Gt (hi, hj))
  7.1092 -  | minusinf (NOT (Le (hk, hl))) = NOT (Le (hk, hl))
  7.1093 -  | minusinf (NOT (Ge (hm, hn))) = NOT (Ge (hm, hn))
  7.1094 -  | minusinf (NOT (Eq (Cst ja, hp))) = NOT (Eq (Cst ja, hp))
  7.1095 -  | minusinf (NOT (Eq (Var jb, hp))) = NOT (Eq (Var jb, hp))
  7.1096 -  | minusinf (NOT (Eq (Neg jc, hp))) = NOT (Eq (Neg jc, hp))
  7.1097 -  | minusinf (NOT (Eq (Add (Cst js, je), hp))) = NOT (Eq (Add (Cst js, je), hp))
  7.1098 -  | minusinf (NOT (Eq (Add (Var jt, je), hp))) = NOT (Eq (Add (Var jt, je), hp))
  7.1099 -  | minusinf (NOT (Eq (Add (Neg ju, je), hp))) = NOT (Eq (Add (Neg ju, je), hp))
  7.1100 -  | minusinf (NOT (Eq (Add (Add (jv, jw), je), hp))) =
  7.1101 -    NOT (Eq (Add (Add (jv, jw), je), hp))
  7.1102 -  | minusinf (NOT (Eq (Add (Sub (jx, jy), je), hp))) =
  7.1103 -    NOT (Eq (Add (Sub (jx, jy), je), hp))
  7.1104 -  | minusinf (NOT (Eq (Add (Mult (Cst kk, Cst lc), je), hp))) =
  7.1105 -    NOT (Eq (Add (Mult (Cst kk, Cst lc), je), hp))
  7.1106 -  | minusinf (NOT (Eq (Add (Mult (Cst kk, Var lu), je), hp))) =
  7.1107 -    (if (lu = 0) then T
  7.1108 -      else NOT (Eq (Add (Mult (Cst kk, Var (op_45_def0 lu id_1_def0 + 1)), je),
  7.1109 -                     hp)))
  7.1110 -  | minusinf (NOT (Eq (Add (Mult (Cst kk, Neg le), je), hp))) =
  7.1111 -    NOT (Eq (Add (Mult (Cst kk, Neg le), je), hp))
  7.1112 -  | minusinf (NOT (Eq (Add (Mult (Cst kk, Add (lf, lg)), je), hp))) =
  7.1113 -    NOT (Eq (Add (Mult (Cst kk, Add (lf, lg)), je), hp))
  7.1114 -  | minusinf (NOT (Eq (Add (Mult (Cst kk, Sub (lh, li)), je), hp))) =
  7.1115 -    NOT (Eq (Add (Mult (Cst kk, Sub (lh, li)), je), hp))
  7.1116 -  | minusinf (NOT (Eq (Add (Mult (Cst kk, Mult (lj, lk)), je), hp))) =
  7.1117 -    NOT (Eq (Add (Mult (Cst kk, Mult (lj, lk)), je), hp))
  7.1118 -  | minusinf (NOT (Eq (Add (Mult (Var kl, ka), je), hp))) =
  7.1119 -    NOT (Eq (Add (Mult (Var kl, ka), je), hp))
  7.1120 -  | minusinf (NOT (Eq (Add (Mult (Neg km, ka), je), hp))) =
  7.1121 -    NOT (Eq (Add (Mult (Neg km, ka), je), hp))
  7.1122 -  | minusinf (NOT (Eq (Add (Mult (Add (kn, ko), ka), je), hp))) =
  7.1123 -    NOT (Eq (Add (Mult (Add (kn, ko), ka), je), hp))
  7.1124 -  | minusinf (NOT (Eq (Add (Mult (Sub (kp, kq), ka), je), hp))) =
  7.1125 -    NOT (Eq (Add (Mult (Sub (kp, kq), ka), je), hp))
  7.1126 -  | minusinf (NOT (Eq (Add (Mult (Mult (kr, ks), ka), je), hp))) =
  7.1127 -    NOT (Eq (Add (Mult (Mult (kr, ks), ka), je), hp))
  7.1128 -  | minusinf (NOT (Eq (Sub (jf, jg), hp))) = NOT (Eq (Sub (jf, jg), hp))
  7.1129 -  | minusinf (NOT (Eq (Mult (jh, ji), hp))) = NOT (Eq (Mult (jh, ji), hp))
  7.1130 -  | minusinf (NOT (Divides (hq, hr))) = NOT (Divides (hq, hr))
  7.1131 -  | minusinf (NOT T) = NOT T
  7.1132 -  | minusinf (NOT F) = NOT F
  7.1133 -  | minusinf (NOT (NOT hs)) = NOT (NOT hs)
  7.1134 -  | minusinf (NOT (And (ht, hu))) = NOT (And (ht, hu))
  7.1135 -  | minusinf (NOT (Or (hv, hw))) = NOT (Or (hv, hw))
  7.1136 -  | minusinf (NOT (Imp (hx, hy))) = NOT (Imp (hx, hy))
  7.1137 -  | minusinf (NOT (Equ (hz, ia))) = NOT (Equ (hz, ia))
  7.1138 -  | minusinf (NOT (QAll ib)) = NOT (QAll ib)
  7.1139 -  | minusinf (NOT (QEx ic)) = NOT (QEx ic)
  7.1140 -  | minusinf (Imp (al, am)) = Imp (al, am)
  7.1141 -  | minusinf (Equ (an, ao)) = Equ (an, ao)
  7.1142 -  | minusinf (QAll ap) = QAll ap
  7.1143 -  | minusinf (QEx aq) = QEx aq;
  7.1144 -
  7.1145 -fun abs (i:IntInf.int) = (if (i < 0) then IntInf.~ i else i);
  7.1146 -
  7.1147 -fun op_div_def1 a b = fst (divAlg (a, b));
  7.1148 -
  7.1149 -fun op_mod_def0 m n = nat (op_mod_def1 (m) (n));
  7.1150 -
  7.1151 -fun ngcd (m:IntInf.int, n:IntInf.int) = (if (n = 0) then m else ngcd (n, op_mod_def0 m n));
  7.1152 -
  7.1153 -fun igcd x = split (fn a => fn b => (ngcd (nat (abs a), nat (abs b)))) x;
  7.1154 -
  7.1155 -fun ilcm (a:IntInf.int) (b:IntInf.int) = op_div_def1 (a * b) (igcd (a, b));
  7.1156 -
  7.1157 -fun divlcm (NOT p) = divlcm p
  7.1158 -  | divlcm (And (p, q)) = ilcm (divlcm p) (divlcm q)
  7.1159 -  | divlcm (Or (p, q)) = ilcm (divlcm p) (divlcm q)
  7.1160 -  | divlcm (Lt (u, v)) = 1
  7.1161 -  | divlcm (Gt (w, x)) = 1
  7.1162 -  | divlcm (Le (y, z)) = 1
  7.1163 -  | divlcm (Ge (aa, ab)) = 1
  7.1164 -  | divlcm (Eq (ac, ad)) = 1
  7.1165 -  | divlcm (Divides (Cst bo, Cst cg)) = 1
  7.1166 -  | divlcm (Divides (Cst bo, Var ch)) = 1
  7.1167 -  | divlcm (Divides (Cst bo, Neg ci)) = 1
  7.1168 -  | divlcm (Divides (Cst bo, Add (Cst cy, ck))) = 1
  7.1169 -  | divlcm (Divides (Cst bo, Add (Var cz, ck))) = 1
  7.1170 -  | divlcm (Divides (Cst bo, Add (Neg da, ck))) = 1
  7.1171 -  | divlcm (Divides (Cst bo, Add (Add (db, dc), ck))) = 1
  7.1172 -  | divlcm (Divides (Cst bo, Add (Sub (dd, de), ck))) = 1
  7.1173 -  | divlcm (Divides (Cst bo, Add (Mult (Cst dq, Cst ei), ck))) = 1
  7.1174 -  | divlcm (Divides (Cst bo, Add (Mult (Cst dq, Var fa), ck))) =
  7.1175 -    (if (fa = 0) then abs bo else 1)
  7.1176 -  | divlcm (Divides (Cst bo, Add (Mult (Cst dq, Neg ek), ck))) = 1
  7.1177 -  | divlcm (Divides (Cst bo, Add (Mult (Cst dq, Add (el, em)), ck))) = 1
  7.1178 -  | divlcm (Divides (Cst bo, Add (Mult (Cst dq, Sub (en, eo)), ck))) = 1
  7.1179 -  | divlcm (Divides (Cst bo, Add (Mult (Cst dq, Mult (ep, eq)), ck))) = 1
  7.1180 -  | divlcm (Divides (Cst bo, Add (Mult (Var dr, dg), ck))) = 1
  7.1181 -  | divlcm (Divides (Cst bo, Add (Mult (Neg ds, dg), ck))) = 1
  7.1182 -  | divlcm (Divides (Cst bo, Add (Mult (Add (dt, du), dg), ck))) = 1
  7.1183 -  | divlcm (Divides (Cst bo, Add (Mult (Sub (dv, dw), dg), ck))) = 1
  7.1184 -  | divlcm (Divides (Cst bo, Add (Mult (Mult (dx, dy), dg), ck))) = 1
  7.1185 -  | divlcm (Divides (Cst bo, Sub (cl, cm))) = 1
  7.1186 -  | divlcm (Divides (Cst bo, Mult (cn, co))) = 1
  7.1187 -  | divlcm (Divides (Var bp, af)) = 1
  7.1188 -  | divlcm (Divides (Neg bq, af)) = 1
  7.1189 -  | divlcm (Divides (Add (br, bs), af)) = 1
  7.1190 -  | divlcm (Divides (Sub (bt, bu), af)) = 1
  7.1191 -  | divlcm (Divides (Mult (bv, bw), af)) = 1
  7.1192 -  | divlcm T = 1
  7.1193 -  | divlcm F = 1
  7.1194 -  | divlcm (Imp (al, am)) = 1
  7.1195 -  | divlcm (Equ (an, ao)) = 1
  7.1196 -  | divlcm (QAll ap) = 1
  7.1197 -  | divlcm (QEx aq) = 1;
  7.1198 -
  7.1199 -fun explode_minf (q, B) =
  7.1200 -    let val d = divlcm q; val pm = minusinf q;
  7.1201 -        val dj1 = explode_disj (map (fn x => Cst x) (iupto (1, d)), pm)
  7.1202 -    in (case dj1 of
  7.1203 -         Lt (x, xa) =>
  7.1204 -           let val dj2 = explode_disj (all_sums (d, B), q)
  7.1205 -           in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1206 -                | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1207 -                | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1208 -                | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1209 -                | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1210 -                | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1211 -                | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1212 -                | QEx x => Or (dj1, dj2))
  7.1213 -           end
  7.1214 -         | Gt (x, xa) =>
  7.1215 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1216 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1217 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1218 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1219 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1220 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1221 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1222 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1223 -                  | QEx x => Or (dj1, dj2))
  7.1224 -             end
  7.1225 -         | Le (x, xa) =>
  7.1226 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1227 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1228 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1229 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1230 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1231 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1232 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1233 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1234 -                  | QEx x => Or (dj1, dj2))
  7.1235 -             end
  7.1236 -         | Ge (x, xa) =>
  7.1237 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1238 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1239 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1240 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1241 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1242 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1243 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1244 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1245 -                  | QEx x => Or (dj1, dj2))
  7.1246 -             end
  7.1247 -         | Eq (x, xa) =>
  7.1248 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1249 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1250 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1251 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1252 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1253 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1254 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1255 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1256 -                  | QEx x => Or (dj1, dj2))
  7.1257 -             end
  7.1258 -         | Divides (x, xa) =>
  7.1259 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1260 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1261 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1262 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1263 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1264 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1265 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1266 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1267 -                  | QEx x => Or (dj1, dj2))
  7.1268 -             end
  7.1269 -         | T => T | F => explode_disj (all_sums (d, B), q)
  7.1270 -         | NOT x =>
  7.1271 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1272 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1273 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1274 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1275 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1276 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1277 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1278 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1279 -                  | QEx x => Or (dj1, dj2))
  7.1280 -             end
  7.1281 -         | And (x, xa) =>
  7.1282 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1283 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1284 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1285 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1286 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1287 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1288 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1289 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1290 -                  | QEx x => Or (dj1, dj2))
  7.1291 -             end
  7.1292 -         | Or (x, xa) =>
  7.1293 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1294 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1295 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1296 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1297 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1298 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1299 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1300 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1301 -                  | QEx x => Or (dj1, dj2))
  7.1302 -             end
  7.1303 -         | Imp (x, xa) =>
  7.1304 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1305 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1306 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1307 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1308 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1309 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1310 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1311 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1312 -                  | QEx x => Or (dj1, dj2))
  7.1313 -             end
  7.1314 -         | Equ (x, xa) =>
  7.1315 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1316 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1317 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1318 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1319 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1320 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1321 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1322 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1323 -                  | QEx x => Or (dj1, dj2))
  7.1324 -             end
  7.1325 -         | QAll x =>
  7.1326 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1327 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1328 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1329 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1330 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1331 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1332 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1333 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1334 -                  | QEx x => Or (dj1, dj2))
  7.1335 -             end
  7.1336 -         | QEx x =>
  7.1337 -             let val dj2 = explode_disj (all_sums (d, B), q)
  7.1338 -             in (case dj2 of Lt (x, xa) => Or (dj1, dj2)
  7.1339 -                  | Gt (x, xa) => Or (dj1, dj2) | Le (x, xa) => Or (dj1, dj2)
  7.1340 -                  | Ge (x, xa) => Or (dj1, dj2) | Eq (x, xa) => Or (dj1, dj2)
  7.1341 -                  | Divides (x, xa) => Or (dj1, dj2) | T => T | F => dj1
  7.1342 -                  | NOT x => Or (dj1, dj2) | And (x, xa) => Or (dj1, dj2)
  7.1343 -                  | Or (x, xa) => Or (dj1, dj2) | Imp (x, xa) => Or (dj1, dj2)
  7.1344 -                  | Equ (x, xa) => Or (dj1, dj2) | QAll x => Or (dj1, dj2)
  7.1345 -                  | QEx x => Or (dj1, dj2))
  7.1346 -             end)
  7.1347 -    end;
  7.1348 -
  7.1349 -fun mirror (And (p, q)) = And (mirror p, mirror q)
  7.1350 -  | mirror (Or (p, q)) = Or (mirror p, mirror q)
  7.1351 -  | mirror (Lt (u, v)) = Lt (u, v)
  7.1352 -  | mirror (Gt (w, x)) = Gt (w, x)
  7.1353 -  | mirror (Le (Cst bp, aa)) = Le (Cst bp, aa)
  7.1354 -  | mirror (Le (Var bq, aa)) = Le (Var bq, aa)
  7.1355 -  | mirror (Le (Neg br, aa)) = Le (Neg br, aa)
  7.1356 -  | mirror (Le (Add (Cst ch, bt), aa)) = Le (Add (Cst ch, bt), aa)
  7.1357 -  | mirror (Le (Add (Var ci, bt), aa)) = Le (Add (Var ci, bt), aa)
  7.1358 -  | mirror (Le (Add (Neg cj, bt), aa)) = Le (Add (Neg cj, bt), aa)
  7.1359 -  | mirror (Le (Add (Add (ck, cl), bt), aa)) = Le (Add (Add (ck, cl), bt), aa)
  7.1360 -  | mirror (Le (Add (Sub (cm, cn), bt), aa)) = Le (Add (Sub (cm, cn), bt), aa)
  7.1361 -  | mirror (Le (Add (Mult (Cst cz, Cst dr), bt), aa)) =
  7.1362 -    Le (Add (Mult (Cst cz, Cst dr), bt), aa)
  7.1363 -  | mirror (Le (Add (Mult (Cst cz, Var ej), bt), aa)) =
  7.1364 -    (if (ej = 0) then Le (Add (Mult (Cst (~ cz), Var 0), bt), aa)
  7.1365 -      else Le (Add (Mult (Cst cz, Var (op_45_def0 ej id_1_def0 + 1)), bt), aa))
  7.1366 -  | mirror (Le (Add (Mult (Cst cz, Neg dt), bt), aa)) =
  7.1367 -    Le (Add (Mult (Cst cz, Neg dt), bt), aa)
  7.1368 -  | mirror (Le (Add (Mult (Cst cz, Add (du, dv)), bt), aa)) =
  7.1369 -    Le (Add (Mult (Cst cz, Add (du, dv)), bt), aa)
  7.1370 -  | mirror (Le (Add (Mult (Cst cz, Sub (dw, dx)), bt), aa)) =
  7.1371 -    Le (Add (Mult (Cst cz, Sub (dw, dx)), bt), aa)
  7.1372 -  | mirror (Le (Add (Mult (Cst cz, Mult (dy, dz)), bt), aa)) =
  7.1373 -    Le (Add (Mult (Cst cz, Mult (dy, dz)), bt), aa)
  7.1374 -  | mirror (Le (Add (Mult (Var da, cp), bt), aa)) =
  7.1375 -    Le (Add (Mult (Var da, cp), bt), aa)
  7.1376 -  | mirror (Le (Add (Mult (Neg db, cp), bt), aa)) =
  7.1377 -    Le (Add (Mult (Neg db, cp), bt), aa)
  7.1378 -  | mirror (Le (Add (Mult (Add (dc, dd), cp), bt), aa)) =
  7.1379 -    Le (Add (Mult (Add (dc, dd), cp), bt), aa)
  7.1380 -  | mirror (Le (Add (Mult (Sub (de, df), cp), bt), aa)) =
  7.1381 -    Le (Add (Mult (Sub (de, df), cp), bt), aa)
  7.1382 -  | mirror (Le (Add (Mult (Mult (dg, dh), cp), bt), aa)) =
  7.1383 -    Le (Add (Mult (Mult (dg, dh), cp), bt), aa)
  7.1384 -  | mirror (Le (Sub (bu, bv), aa)) = Le (Sub (bu, bv), aa)
  7.1385 -  | mirror (Le (Mult (bw, bx), aa)) = Le (Mult (bw, bx), aa)
  7.1386 -  | mirror (Ge (ab, ac)) = Ge (ab, ac)
  7.1387 -  | mirror (Eq (Cst el, ae)) = Eq (Cst el, ae)
  7.1388 -  | mirror (Eq (Var em, ae)) = Eq (Var em, ae)
  7.1389 -  | mirror (Eq (Neg en, ae)) = Eq (Neg en, ae)
  7.1390 -  | mirror (Eq (Add (Cst fd, ep), ae)) = Eq (Add (Cst fd, ep), ae)
  7.1391 -  | mirror (Eq (Add (Var fe, ep), ae)) = Eq (Add (Var fe, ep), ae)
  7.1392 -  | mirror (Eq (Add (Neg ff, ep), ae)) = Eq (Add (Neg ff, ep), ae)
  7.1393 -  | mirror (Eq (Add (Add (fg, fh), ep), ae)) = Eq (Add (Add (fg, fh), ep), ae)
  7.1394 -  | mirror (Eq (Add (Sub (fi, fj), ep), ae)) = Eq (Add (Sub (fi, fj), ep), ae)
  7.1395 -  | mirror (Eq (Add (Mult (Cst fv, Cst gn), ep), ae)) =
  7.1396 -    Eq (Add (Mult (Cst fv, Cst gn), ep), ae)
  7.1397 -  | mirror (Eq (Add (Mult (Cst fv, Var hf), ep), ae)) =
  7.1398 -    (if (hf = 0) then Eq (Add (Mult (Cst (~ fv), Var 0), ep), ae)
  7.1399 -      else Eq (Add (Mult (Cst fv, Var (op_45_def0 hf id_1_def0 + 1)), ep), ae))
  7.1400 -  | mirror (Eq (Add (Mult (Cst fv, Neg gp), ep), ae)) =
  7.1401 -    Eq (Add (Mult (Cst fv, Neg gp), ep), ae)
  7.1402 -  | mirror (Eq (Add (Mult (Cst fv, Add (gq, gr)), ep), ae)) =
  7.1403 -    Eq (Add (Mult (Cst fv, Add (gq, gr)), ep), ae)
  7.1404 -  | mirror (Eq (Add (Mult (Cst fv, Sub (gs, gt)), ep), ae)) =
  7.1405 -    Eq (Add (Mult (Cst fv, Sub (gs, gt)), ep), ae)
  7.1406 -  | mirror (Eq (Add (Mult (Cst fv, Mult (gu, gv)), ep), ae)) =
  7.1407 -    Eq (Add (Mult (Cst fv, Mult (gu, gv)), ep), ae)
  7.1408 -  | mirror (Eq (Add (Mult (Var fw, fl), ep), ae)) =
  7.1409 -    Eq (Add (Mult (Var fw, fl), ep), ae)
  7.1410 -  | mirror (Eq (Add (Mult (Neg fx, fl), ep), ae)) =
  7.1411 -    Eq (Add (Mult (Neg fx, fl), ep), ae)
  7.1412 -  | mirror (Eq (Add (Mult (Add (fy, fz), fl), ep), ae)) =
  7.1413 -    Eq (Add (Mult (Add (fy, fz), fl), ep), ae)
  7.1414 -  | mirror (Eq (Add (Mult (Sub (ga, gb), fl), ep), ae)) =
  7.1415 -    Eq (Add (Mult (Sub (ga, gb), fl), ep), ae)
  7.1416 -  | mirror (Eq (Add (Mult (Mult (gc, gd), fl), ep), ae)) =
  7.1417 -    Eq (Add (Mult (Mult (gc, gd), fl), ep), ae)
  7.1418 -  | mirror (Eq (Sub (eq, er), ae)) = Eq (Sub (eq, er), ae)
  7.1419 -  | mirror (Eq (Mult (es, et), ae)) = Eq (Mult (es, et), ae)
  7.1420 -  | mirror (Divides (Cst hh, Cst hz)) = Divides (Cst hh, Cst hz)
  7.1421 -  | mirror (Divides (Cst hh, Var ia)) = Divides (Cst hh, Var ia)
  7.1422 -  | mirror (Divides (Cst hh, Neg ib)) = Divides (Cst hh, Neg ib)
  7.1423 -  | mirror (Divides (Cst hh, Add (Cst ir, id))) =
  7.1424 -    Divides (Cst hh, Add (Cst ir, id))
  7.1425 -  | mirror (Divides (Cst hh, Add (Var is, id))) =
  7.1426 -    Divides (Cst hh, Add (Var is, id))
  7.1427 -  | mirror (Divides (Cst hh, Add (Neg it, id))) =
  7.1428 -    Divides (Cst hh, Add (Neg it, id))
  7.1429 -  | mirror (Divides (Cst hh, Add (Add (iu, iv), id))) =
  7.1430 -    Divides (Cst hh, Add (Add (iu, iv), id))
  7.1431 -  | mirror (Divides (Cst hh, Add (Sub (iw, ix), id))) =
  7.1432 -    Divides (Cst hh, Add (Sub (iw, ix), id))
  7.1433 -  | mirror (Divides (Cst hh, Add (Mult (Cst jj, Cst kb), id))) =
  7.1434 -    Divides (Cst hh, Add (Mult (Cst jj, Cst kb), id))
  7.1435 -  | mirror (Divides (Cst hh, Add (Mult (Cst jj, Var kt), id))) =
  7.1436 -    (if (kt = 0) then Divides (Cst hh, Add (Mult (Cst (~ jj), Var 0), id))
  7.1437 -      else Divides
  7.1438 -             (Cst hh,
  7.1439 -               Add (Mult (Cst jj, Var (op_45_def0 kt id_1_def0 + 1)), id)))
  7.1440 -  | mirror (Divides (Cst hh, Add (Mult (Cst jj, Neg kd), id))) =
  7.1441 -    Divides (Cst hh, Add (Mult (Cst jj, Neg kd), id))
  7.1442 -  | mirror (Divides (Cst hh, Add (Mult (Cst jj, Add (ke, kf)), id))) =
  7.1443 -    Divides (Cst hh, Add (Mult (Cst jj, Add (ke, kf)), id))
  7.1444 -  | mirror (Divides (Cst hh, Add (Mult (Cst jj, Sub (kg, kh)), id))) =
  7.1445 -    Divides (Cst hh, Add (Mult (Cst jj, Sub (kg, kh)), id))
  7.1446 -  | mirror (Divides (Cst hh, Add (Mult (Cst jj, Mult (ki, kj)), id))) =
  7.1447 -    Divides (Cst hh, Add (Mult (Cst jj, Mult (ki, kj)), id))
  7.1448 -  | mirror (Divides (Cst hh, Add (Mult (Var jk, iz), id))) =
  7.1449 -    Divides (Cst hh, Add (Mult (Var jk, iz), id))
  7.1450 -  | mirror (Divides (Cst hh, Add (Mult (Neg jl, iz), id))) =
  7.1451 -    Divides (Cst hh, Add (Mult (Neg jl, iz), id))
  7.1452 -  | mirror (Divides (Cst hh, Add (Mult (Add (jm, jn), iz), id))) =
  7.1453 -    Divides (Cst hh, Add (Mult (Add (jm, jn), iz), id))
  7.1454 -  | mirror (Divides (Cst hh, Add (Mult (Sub (jo, jp), iz), id))) =
  7.1455 -    Divides (Cst hh, Add (Mult (Sub (jo, jp), iz), id))
  7.1456 -  | mirror (Divides (Cst hh, Add (Mult (Mult (jq, jr), iz), id))) =
  7.1457 -    Divides (Cst hh, Add (Mult (Mult (jq, jr), iz), id))
  7.1458 -  | mirror (Divides (Cst hh, Sub (ie, if'))) = Divides (Cst hh, Sub (ie, if'))
  7.1459 -  | mirror (Divides (Cst hh, Mult (ig, ih))) = Divides (Cst hh, Mult (ig, ih))
  7.1460 -  | mirror (Divides (Var hi, ag)) = Divides (Var hi, ag)
  7.1461 -  | mirror (Divides (Neg hj, ag)) = Divides (Neg hj, ag)
  7.1462 -  | mirror (Divides (Add (hk, hl), ag)) = Divides (Add (hk, hl), ag)
  7.1463 -  | mirror (Divides (Sub (hm, hn), ag)) = Divides (Sub (hm, hn), ag)
  7.1464 -  | mirror (Divides (Mult (ho, hp), ag)) = Divides (Mult (ho, hp), ag)
  7.1465 -  | mirror T = T
  7.1466 -  | mirror F = F
  7.1467 -  | mirror (NOT (Lt (kv, kw))) = NOT (Lt (kv, kw))
  7.1468 -  | mirror (NOT (Gt (kx, ky))) = NOT (Gt (kx, ky))
  7.1469 -  | mirror (NOT (Le (kz, la))) = NOT (Le (kz, la))
  7.1470 -  | mirror (NOT (Ge (lb, lc))) = NOT (Ge (lb, lc))
  7.1471 -  | mirror (NOT (Eq (Cst mp, le))) = NOT (Eq (Cst mp, le))
  7.1472 -  | mirror (NOT (Eq (Var mq, le))) = NOT (Eq (Var mq, le))
  7.1473 -  | mirror (NOT (Eq (Neg mr, le))) = NOT (Eq (Neg mr, le))
  7.1474 -  | mirror (NOT (Eq (Add (Cst nh, mt), le))) = NOT (Eq (Add (Cst nh, mt), le))
  7.1475 -  | mirror (NOT (Eq (Add (Var ni, mt), le))) = NOT (Eq (Add (Var ni, mt), le))
  7.1476 -  | mirror (NOT (Eq (Add (Neg nj, mt), le))) = NOT (Eq (Add (Neg nj, mt), le))
  7.1477 -  | mirror (NOT (Eq (Add (Add (nk, nl), mt), le))) =
  7.1478 -    NOT (Eq (Add (Add (nk, nl), mt), le))
  7.1479 -  | mirror (NOT (Eq (Add (Sub (nm, nn), mt), le))) =
  7.1480 -    NOT (Eq (Add (Sub (nm, nn), mt), le))
  7.1481 -  | mirror (NOT (Eq (Add (Mult (Cst nz, Cst or), mt), le))) =
  7.1482 -    NOT (Eq (Add (Mult (Cst nz, Cst or), mt), le))
  7.1483 -  | mirror (NOT (Eq (Add (Mult (Cst nz, Var pj), mt), le))) =
  7.1484 -    (if (pj = 0) then NOT (Eq (Add (Mult (Cst (~ nz), Var 0), mt), le))
  7.1485 -      else NOT (Eq (Add (Mult (Cst nz, Var (op_45_def0 pj id_1_def0 + 1)), mt),
  7.1486 -                     le)))
  7.1487 -  | mirror (NOT (Eq (Add (Mult (Cst nz, Neg ot), mt), le))) =
  7.1488 -    NOT (Eq (Add (Mult (Cst nz, Neg ot), mt), le))
  7.1489 -  | mirror (NOT (Eq (Add (Mult (Cst nz, Add (ou, ov)), mt), le))) =
  7.1490 -    NOT (Eq (Add (Mult (Cst nz, Add (ou, ov)), mt), le))
  7.1491 -  | mirror (NOT (Eq (Add (Mult (Cst nz, Sub (ow, ox)), mt), le))) =
  7.1492 -    NOT (Eq (Add (Mult (Cst nz, Sub (ow, ox)), mt), le))
  7.1493 -  | mirror (NOT (Eq (Add (Mult (Cst nz, Mult (oy, oz)), mt), le))) =
  7.1494 -    NOT (Eq (Add (Mult (Cst nz, Mult (oy, oz)), mt), le))
  7.1495 -  | mirror (NOT (Eq (Add (Mult (Var oa, np), mt), le))) =
  7.1496 -    NOT (Eq (Add (Mult (Var oa, np), mt), le))
  7.1497 -  | mirror (NOT (Eq (Add (Mult (Neg ob, np), mt), le))) =
  7.1498 -    NOT (Eq (Add (Mult (Neg ob, np), mt), le))
  7.1499 -  | mirror (NOT (Eq (Add (Mult (Add (oc, od), np), mt), le))) =
  7.1500 -    NOT (Eq (Add (Mult (Add (oc, od), np), mt), le))
  7.1501 -  | mirror (NOT (Eq (Add (Mult (Sub (oe, of'), np), mt), le))) =
  7.1502 -    NOT (Eq (Add (Mult (Sub (oe, of'), np), mt), le))
  7.1503 -  | mirror (NOT (Eq (Add (Mult (Mult (og, oh), np), mt), le))) =
  7.1504 -    NOT (Eq (Add (Mult (Mult (og, oh), np), mt), le))
  7.1505 -  | mirror (NOT (Eq (Sub (mu, mv), le))) = NOT (Eq (Sub (mu, mv), le))
  7.1506 -  | mirror (NOT (Eq (Mult (mw, mx), le))) = NOT (Eq (Mult (mw, mx), le))
  7.1507 -  | mirror (NOT (Divides (Cst pl, Cst qd))) = NOT (Divides (Cst pl, Cst qd))
  7.1508 -  | mirror (NOT (Divides (Cst pl, Var qe))) = NOT (Divides (Cst pl, Var qe))
  7.1509 -  | mirror (NOT (Divides (Cst pl, Neg qf))) = NOT (Divides (Cst pl, Neg qf))
  7.1510 -  | mirror (NOT (Divides (Cst pl, Add (Cst qv, qh)))) =
  7.1511 -    NOT (Divides (Cst pl, Add (Cst qv, qh)))
  7.1512 -  | mirror (NOT (Divides (Cst pl, Add (Var qw, qh)))) =
  7.1513 -    NOT (Divides (Cst pl, Add (Var qw, qh)))
  7.1514 -  | mirror (NOT (Divides (Cst pl, Add (Neg qx, qh)))) =
  7.1515 -    NOT (Divides (Cst pl, Add (Neg qx, qh)))
  7.1516 -  | mirror (NOT (Divides (Cst pl, Add (Add (qy, qz), qh)))) =
  7.1517 -    NOT (Divides (Cst pl, Add (Add (qy, qz), qh)))
  7.1518 -  | mirror (NOT (Divides (Cst pl, Add (Sub (ra, rb), qh)))) =
  7.1519 -    NOT (Divides (Cst pl, Add (Sub (ra, rb), qh)))
  7.1520 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Cst rn, Cst sf), qh)))) =
  7.1521 -    NOT (Divides (Cst pl, Add (Mult (Cst rn, Cst sf), qh)))
  7.1522 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Cst rn, Var sx), qh)))) =
  7.1523 -    (if (sx = 0)
  7.1524 -      then NOT (Divides (Cst pl, Add (Mult (Cst (~ rn), Var 0), qh)))
  7.1525 -      else NOT (Divides
  7.1526 -                  (Cst pl,
  7.1527 -                    Add (Mult (Cst rn, Var (op_45_def0 sx id_1_def0 + 1)),
  7.1528 -                          qh))))
  7.1529 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Cst rn, Neg sh), qh)))) =
  7.1530 -    NOT (Divides (Cst pl, Add (Mult (Cst rn, Neg sh), qh)))
  7.1531 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Cst rn, Add (si, sj)), qh)))) =
  7.1532 -    NOT (Divides (Cst pl, Add (Mult (Cst rn, Add (si, sj)), qh)))
  7.1533 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Cst rn, Sub (sk, sl)), qh)))) =
  7.1534 -    NOT (Divides (Cst pl, Add (Mult (Cst rn, Sub (sk, sl)), qh)))
  7.1535 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Cst rn, Mult (sm, sn)), qh)))) =
  7.1536 -    NOT (Divides (Cst pl, Add (Mult (Cst rn, Mult (sm, sn)), qh)))
  7.1537 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Var ro, rd), qh)))) =
  7.1538 -    NOT (Divides (Cst pl, Add (Mult (Var ro, rd), qh)))
  7.1539 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Neg rp, rd), qh)))) =
  7.1540 -    NOT (Divides (Cst pl, Add (Mult (Neg rp, rd), qh)))
  7.1541 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Add (rq, rr), rd), qh)))) =
  7.1542 -    NOT (Divides (Cst pl, Add (Mult (Add (rq, rr), rd), qh)))
  7.1543 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Sub (rs, rt), rd), qh)))) =
  7.1544 -    NOT (Divides (Cst pl, Add (Mult (Sub (rs, rt), rd), qh)))
  7.1545 -  | mirror (NOT (Divides (Cst pl, Add (Mult (Mult (ru, rv), rd), qh)))) =
  7.1546 -    NOT (Divides (Cst pl, Add (Mult (Mult (ru, rv), rd), qh)))
  7.1547 -  | mirror (NOT (Divides (Cst pl, Sub (qi, qj)))) =
  7.1548 -    NOT (Divides (Cst pl, Sub (qi, qj)))
  7.1549 -  | mirror (NOT (Divides (Cst pl, Mult (qk, ql)))) =
  7.1550 -    NOT (Divides (Cst pl, Mult (qk, ql)))
  7.1551 -  | mirror (NOT (Divides (Var pm, lg))) = NOT (Divides (Var pm, lg))
  7.1552 -  | mirror (NOT (Divides (Neg pn, lg))) = NOT (Divides (Neg pn, lg))
  7.1553 -  | mirror (NOT (Divides (Add (po, pp), lg))) = NOT (Divides (Add (po, pp), lg))
  7.1554 -  | mirror (NOT (Divides (Sub (pq, pr), lg))) = NOT (Divides (Sub (pq, pr), lg))
  7.1555 -  | mirror (NOT (Divides (Mult (ps, pt), lg))) =
  7.1556 -    NOT (Divides (Mult (ps, pt), lg))
  7.1557 -  | mirror (NOT T) = NOT T
  7.1558 -  | mirror (NOT F) = NOT F
  7.1559 -  | mirror (NOT (NOT lh)) = NOT (NOT lh)
  7.1560 -  | mirror (NOT (And (li, lj))) = NOT (And (li, lj))
  7.1561 -  | mirror (NOT (Or (lk, ll))) = NOT (Or (lk, ll))
  7.1562 -  | mirror (NOT (Imp (lm, ln))) = NOT (Imp (lm, ln))
  7.1563 -  | mirror (NOT (Equ (lo, lp))) = NOT (Equ (lo, lp))
  7.1564 -  | mirror (NOT (QAll lq)) = NOT (QAll lq)
  7.1565 -  | mirror (NOT (QEx lr)) = NOT (QEx lr)
  7.1566 -  | mirror (Imp (am, an)) = Imp (am, an)
  7.1567 -  | mirror (Equ (ao, ap)) = Equ (ao, ap)
  7.1568 -  | mirror (QAll aq) = QAll aq
  7.1569 -  | mirror (QEx ar) = QEx ar;
  7.1570 -
  7.1571 -fun op_43_def0 m n = nat ((m) + (n));
  7.1572 -
  7.1573 -fun size_def1 [] = (0:IntInf.int)
  7.1574 -  | size_def1 (a :: list) = op_43_def0 (size_def1 list) (0 + 1);
  7.1575 -
  7.1576 -fun aset (And (p, q)) = op_64 (aset p) (aset q)
  7.1577 -  | aset (Or (p, q)) = op_64 (aset p) (aset q)
  7.1578 -  | aset (Lt (u, v)) = []
  7.1579 -  | aset (Gt (w, x)) = []
  7.1580 -  | aset (Le (Cst bo, z)) = []
  7.1581 -  | aset (Le (Var bp, z)) = []
  7.1582 -  | aset (Le (Neg bq, z)) = []
  7.1583 -  | aset (Le (Add (Cst cg, bs), z)) = []
  7.1584 -  | aset (Le (Add (Var ch, bs), z)) = []
  7.1585 -  | aset (Le (Add (Neg ci, bs), z)) = []
  7.1586 -  | aset (Le (Add (Add (cj, ck), bs), z)) = []
  7.1587 -  | aset (Le (Add (Sub (cl, cm), bs), z)) = []
  7.1588 -  | aset (Le (Add (Mult (Cst cy, Cst dq), bs), z)) = []
  7.1589 -  | aset (Le (Add (Mult (Cst cy, Var ei), bs), z)) =
  7.1590 -    (if (ei = 0)
  7.1591 -      then (if (cy < 0) then [lin_add (bs, Cst 1)]
  7.1592 -             else [lin_neg bs, lin_add (lin_neg bs, Cst 1)])
  7.1593 -      else [])
  7.1594 -  | aset (Le (Add (Mult (Cst cy, Neg ds), bs), z)) = []
  7.1595 -  | aset (Le (Add (Mult (Cst cy, Add (dt, du)), bs), z)) = []
  7.1596 -  | aset (Le (Add (Mult (Cst cy, Sub (dv, dw)), bs), z)) = []
  7.1597 -  | aset (Le (Add (Mult (Cst cy, Mult (dx, dy)), bs), z)) = []
  7.1598 -  | aset (Le (Add (Mult (Var cz, co), bs), z)) = []
  7.1599 -  | aset (Le (Add (Mult (Neg da, co), bs), z)) = []
  7.1600 -  | aset (Le (Add (Mult (Add (db, dc), co), bs), z)) = []
  7.1601 -  | aset (Le (Add (Mult (Sub (dd, de), co), bs), z)) = []
  7.1602 -  | aset (Le (Add (Mult (Mult (df, dg), co), bs), z)) = []
  7.1603 -  | aset (Le (Sub (bt, bu), z)) = []
  7.1604 -  | aset (Le (Mult (bv, bw), z)) = []
  7.1605 -  | aset (Ge (aa, ab)) = []
  7.1606 -  | aset (Eq (Cst ek, ad)) = []
  7.1607 -  | aset (Eq (Var el, ad)) = []
  7.1608 -  | aset (Eq (Neg em, ad)) = []
  7.1609 -  | aset (Eq (Add (Cst fc, eo), ad)) = []
  7.1610 -  | aset (Eq (Add (Var fd, eo), ad)) = []
  7.1611 -  | aset (Eq (Add (Neg fe, eo), ad)) = []
  7.1612 -  | aset (Eq (Add (Add (ff, fg), eo), ad)) = []
  7.1613 -  | aset (Eq (Add (Sub (fh, fi), eo), ad)) = []
  7.1614 -  | aset (Eq (Add (Mult (Cst fu, Cst gm), eo), ad)) = []
  7.1615 -  | aset (Eq (Add (Mult (Cst fu, Var he), eo), ad)) =
  7.1616 -    (if (he = 0)
  7.1617 -      then (if (fu < 0) then [lin_add (eo, Cst 1)]
  7.1618 -             else [lin_add (lin_neg eo, Cst 1)])
  7.1619 -      else [])
  7.1620 -  | aset (Eq (Add (Mult (Cst fu, Neg go), eo), ad)) = []
  7.1621 -  | aset (Eq (Add (Mult (Cst fu, Add (gp, gq)), eo), ad)) = []
  7.1622 -  | aset (Eq (Add (Mult (Cst fu, Sub (gr, gs)), eo), ad)) = []
  7.1623 -  | aset (Eq (Add (Mult (Cst fu, Mult (gt, gu)), eo), ad)) = []
  7.1624 -  | aset (Eq (Add (Mult (Var fv, fk), eo), ad)) = []
  7.1625 -  | aset (Eq (Add (Mult (Neg fw, fk), eo), ad)) = []
  7.1626 -  | aset (Eq (Add (Mult (Add (fx, fy), fk), eo), ad)) = []
  7.1627 -  | aset (Eq (Add (Mult (Sub (fz, ga), fk), eo), ad)) = []
  7.1628 -  | aset (Eq (Add (Mult (Mult (gb, gc), fk), eo), ad)) = []
  7.1629 -  | aset (Eq (Sub (ep, eq), ad)) = []
  7.1630 -  | aset (Eq (Mult (er, es), ad)) = []
  7.1631 -  | aset (Divides (ae, af)) = []
  7.1632 -  | aset T = []
  7.1633 -  | aset F = []
  7.1634 -  | aset (NOT (Lt (hg, hh))) = []
  7.1635 -  | aset (NOT (Gt (hi, hj))) = []
  7.1636 -  | aset (NOT (Le (hk, hl))) = []
  7.1637 -  | aset (NOT (Ge (hm, hn))) = []
  7.1638 -  | aset (NOT (Eq (Cst ja, hp))) = []
  7.1639 -  | aset (NOT (Eq (Var jb, hp))) = []
  7.1640 -  | aset (NOT (Eq (Neg jc, hp))) = []
  7.1641 -  | aset (NOT (Eq (Add (Cst js, je), hp))) = []
  7.1642 -  | aset (NOT (Eq (Add (Var jt, je), hp))) = []
  7.1643 -  | aset (NOT (Eq (Add (Neg ju, je), hp))) = []
  7.1644 -  | aset (NOT (Eq (Add (Add (jv, jw), je), hp))) = []
  7.1645 -  | aset (NOT (Eq (Add (Sub (jx, jy), je), hp))) = []
  7.1646 -  | aset (NOT (Eq (Add (Mult (Cst kk, Cst lc), je), hp))) = []
  7.1647 -  | aset (NOT (Eq (Add (Mult (Cst kk, Var lu), je), hp))) =
  7.1648 -    (if (lu = 0) then (if (kk < 0) then [je] else [lin_neg je]) else [])
  7.1649 -  | aset (NOT (Eq (Add (Mult (Cst kk, Neg le), je), hp))) = []
  7.1650 -  | aset (NOT (Eq (Add (Mult (Cst kk, Add (lf, lg)), je), hp))) = []
  7.1651 -  | aset (NOT (Eq (Add (Mult (Cst kk, Sub (lh, li)), je), hp))) = []
  7.1652 -  | aset (NOT (Eq (Add (Mult (Cst kk, Mult (lj, lk)), je), hp))) = []
  7.1653 -  | aset (NOT (Eq (Add (Mult (Var kl, ka), je), hp))) = []
  7.1654 -  | aset (NOT (Eq (Add (Mult (Neg km, ka), je), hp))) = []
  7.1655 -  | aset (NOT (Eq (Add (Mult (Add (kn, ko), ka), je), hp))) = []
  7.1656 -  | aset (NOT (Eq (Add (Mult (Sub (kp, kq), ka), je), hp))) = []
  7.1657 -  | aset (NOT (Eq (Add (Mult (Mult (kr, ks), ka), je), hp))) = []
  7.1658 -  | aset (NOT (Eq (Sub (jf, jg), hp))) = []
  7.1659 -  | aset (NOT (Eq (Mult (jh, ji), hp))) = []
  7.1660 -  | aset (NOT (Divides (hq, hr))) = []
  7.1661 -  | aset (NOT T) = []
  7.1662 -  | aset (NOT F) = []
  7.1663 -  | aset (NOT (NOT hs)) = []
  7.1664 -  | aset (NOT (And (ht, hu))) = []
  7.1665 -  | aset (NOT (Or (hv, hw))) = []
  7.1666 -  | aset (NOT (Imp (hx, hy))) = []
  7.1667 -  | aset (NOT (Equ (hz, ia))) = []
  7.1668 -  | aset (NOT (QAll ib)) = []
  7.1669 -  | aset (NOT (QEx ic)) = []
  7.1670 -  | aset (Imp (al, am)) = []
  7.1671 -  | aset (Equ (an, ao)) = []
  7.1672 -  | aset (QAll ap) = []
  7.1673 -  | aset (QEx aq) = [];
  7.1674 -
  7.1675 -fun op_mem x [] = false
  7.1676 -  | op_mem x (y :: ys) = (if (y = x) then true else op_mem x ys);
  7.1677 -
  7.1678 -fun list_insert x xs = (if op_mem x xs then xs else (x :: xs));
  7.1679 -
  7.1680 -fun list_set [] = []
  7.1681 -  | list_set (x :: xs) = list_insert x (list_set xs);
  7.1682 -
  7.1683 -fun bset (And (p, q)) = op_64 (bset p) (bset q)
  7.1684 -  | bset (Or (p, q)) = op_64 (bset p) (bset q)
  7.1685 -  | bset (Lt (u, v)) = []
  7.1686 -  | bset (Gt (w, x)) = []
  7.1687 -  | bset (Le (Cst bo, z)) = []
  7.1688 -  | bset (Le (Var bp, z)) = []
  7.1689 -  | bset (Le (Neg bq, z)) = []
  7.1690 -  | bset (Le (Add (Cst cg, bs), z)) = []
  7.1691 -  | bset (Le (Add (Var ch, bs), z)) = []
  7.1692 -  | bset (Le (Add (Neg ci, bs), z)) = []
  7.1693 -  | bset (Le (Add (Add (cj, ck), bs), z)) = []
  7.1694 -  | bset (Le (Add (Sub (cl, cm), bs), z)) = []
  7.1695 -  | bset (Le (Add (Mult (Cst cy, Cst dq), bs), z)) = []
  7.1696 -  | bset (Le (Add (Mult (Cst cy, Var ei), bs), z)) =
  7.1697 -    (if (ei = 0)
  7.1698 -      then (if (cy < 0) then [lin_add (bs, Cst ~1), bs]
  7.1699 -             else [lin_add (lin_neg bs, Cst ~1)])
  7.1700 -      else [])
  7.1701 -  | bset (Le (Add (Mult (Cst cy, Neg ds), bs), z)) = []
  7.1702 -  | bset (Le (Add (Mult (Cst cy, Add (dt, du)), bs), z)) = []
  7.1703 -  | bset (Le (Add (Mult (Cst cy, Sub (dv, dw)), bs), z)) = []
  7.1704 -  | bset (Le (Add (Mult (Cst cy, Mult (dx, dy)), bs), z)) = []
  7.1705 -  | bset (Le (Add (Mult (Var cz, co), bs), z)) = []
  7.1706 -  | bset (Le (Add (Mult (Neg da, co), bs), z)) = []
  7.1707 -  | bset (Le (Add (Mult (Add (db, dc), co), bs), z)) = []
  7.1708 -  | bset (Le (Add (Mult (Sub (dd, de), co), bs), z)) = []
  7.1709 -  | bset (Le (Add (Mult (Mult (df, dg), co), bs), z)) = []
  7.1710 -  | bset (Le (Sub (bt, bu), z)) = []
  7.1711 -  | bset (Le (Mult (bv, bw), z)) = []
  7.1712 -  | bset (Ge (aa, ab)) = []
  7.1713 -  | bset (Eq (Cst ek, ad)) = []
  7.1714 -  | bset (Eq (Var el, ad)) = []
  7.1715 -  | bset (Eq (Neg em, ad)) = []
  7.1716 -  | bset (Eq (Add (Cst fc, eo), ad)) = []
  7.1717 -  | bset (Eq (Add (Var fd, eo), ad)) = []
  7.1718 -  | bset (Eq (Add (Neg fe, eo), ad)) = []
  7.1719 -  | bset (Eq (Add (Add (ff, fg), eo), ad)) = []
  7.1720 -  | bset (Eq (Add (Sub (fh, fi), eo), ad)) = []
  7.1721 -  | bset (Eq (Add (Mult (Cst fu, Cst gm), eo), ad)) = []
  7.1722 -  | bset (Eq (Add (Mult (Cst fu, Var he), eo), ad)) =
  7.1723 -    (if (he = 0)
  7.1724 -      then (if (fu < 0) then [lin_add (eo, Cst ~1)]
  7.1725 -             else [lin_add (lin_neg eo, Cst ~1)])
  7.1726 -      else [])
  7.1727 -  | bset (Eq (Add (Mult (Cst fu, Neg go), eo), ad)) = []
  7.1728 -  | bset (Eq (Add (Mult (Cst fu, Add (gp, gq)), eo), ad)) = []
  7.1729 -  | bset (Eq (Add (Mult (Cst fu, Sub (gr, gs)), eo), ad)) = []
  7.1730 -  | bset (Eq (Add (Mult (Cst fu, Mult (gt, gu)), eo), ad)) = []
  7.1731 -  | bset (Eq (Add (Mult (Var fv, fk), eo), ad)) = []
  7.1732 -  | bset (Eq (Add (Mult (Neg fw, fk), eo), ad)) = []
  7.1733 -  | bset (Eq (Add (Mult (Add (fx, fy), fk), eo), ad)) = []
  7.1734 -  | bset (Eq (Add (Mult (Sub (fz, ga), fk), eo), ad)) = []
  7.1735 -  | bset (Eq (Add (Mult (Mult (gb, gc), fk), eo), ad)) = []
  7.1736 -  | bset (Eq (Sub (ep, eq), ad)) = []
  7.1737 -  | bset (Eq (Mult (er, es), ad)) = []
  7.1738 -  | bset (Divides (ae, af)) = []
  7.1739 -  | bset T = []
  7.1740 -  | bset F = []
  7.1741 -  | bset (NOT (Lt (hg, hh))) = []
  7.1742 -  | bset (NOT (Gt (hi, hj))) = []
  7.1743 -  | bset (NOT (Le (hk, hl))) = []
  7.1744 -  | bset (NOT (Ge (hm, hn))) = []
  7.1745 -  | bset (NOT (Eq (Cst ja, hp))) = []
  7.1746 -  | bset (NOT (Eq (Var jb, hp))) = []
  7.1747 -  | bset (NOT (Eq (Neg jc, hp))) = []
  7.1748 -  | bset (NOT (Eq (Add (Cst js, je), hp))) = []
  7.1749 -  | bset (NOT (Eq (Add (Var jt, je), hp))) = []
  7.1750 -  | bset (NOT (Eq (Add (Neg ju, je), hp))) = []
  7.1751 -  | bset (NOT (Eq (Add (Add (jv, jw), je), hp))) = []
  7.1752 -  | bset (NOT (Eq (Add (Sub (jx, jy), je), hp))) = []
  7.1753 -  | bset (NOT (Eq (Add (Mult (Cst kk, Cst lc), je), hp))) = []
  7.1754 -  | bset (NOT (Eq (Add (Mult (Cst kk, Var lu), je), hp))) =
  7.1755 -    (if (lu = 0) then (if (kk < 0) then [je] else [lin_neg je]) else [])
  7.1756 -  | bset (NOT (Eq (Add (Mult (Cst kk, Neg le), je), hp))) = []
  7.1757 -  | bset (NOT (Eq (Add (Mult (Cst kk, Add (lf, lg)), je), hp))) = []
  7.1758 -  | bset (NOT (Eq (Add (Mult (Cst kk, Sub (lh, li)), je), hp))) = []
  7.1759 -  | bset (NOT (Eq (Add (Mult (Cst kk, Mult (lj, lk)), je), hp))) = []
  7.1760 -  | bset (NOT (Eq (Add (Mult (Var kl, ka), je), hp))) = []
  7.1761 -  | bset (NOT (Eq (Add (Mult (Neg km, ka), je), hp))) = []
  7.1762 -  | bset (NOT (Eq (Add (Mult (Add (kn, ko), ka), je), hp))) = []
  7.1763 -  | bset (NOT (Eq (Add (Mult (Sub (kp, kq), ka), je), hp))) = []
  7.1764 -  | bset (NOT (Eq (Add (Mult (Mult (kr, ks), ka), je), hp))) = []
  7.1765 -  | bset (NOT (Eq (Sub (jf, jg), hp))) = []
  7.1766 -  | bset (NOT (Eq (Mult (jh, ji), hp))) = []
  7.1767 -  | bset (NOT (Divides (hq, hr))) = []
  7.1768 -  | bset (NOT T) = []
  7.1769 -  | bset (NOT F) = []
  7.1770 -  | bset (NOT (NOT hs)) = []
  7.1771 -  | bset (NOT (And (ht, hu))) = []
  7.1772 -  | bset (NOT (Or (hv, hw))) = []
  7.1773 -  | bset (NOT (Imp (hx, hy))) = []
  7.1774 -  | bset (NOT (Equ (hz, ia))) = []
  7.1775 -  | bset (NOT (QAll ib)) = []
  7.1776 -  | bset (NOT (QEx ic)) = []
  7.1777 -  | bset (Imp (al, am)) = []
  7.1778 -  | bset (Equ (an, ao)) = []
  7.1779 -  | bset (QAll ap) = []
  7.1780 -  | bset (QEx aq) = [];
  7.1781 -
  7.1782 -fun adjustcoeff (l:IntInf.int, Le (Add (Mult (Cst c, Var 0), r), Cst i)) =
  7.1783 -    (if (c <= 0)
  7.1784 -      then Le (Add (Mult (Cst ~1, Var 0), lin_mul (~ (op_div_def1 l c), r)),
  7.1785 -                Cst 0)
  7.1786 -      else Le (Add (Mult (Cst 1, Var 0), lin_mul (op_div_def1 l c, r)), Cst 0))
  7.1787 -  | adjustcoeff (l, Eq (Add (Mult (Cst c, Var 0), r), Cst i)) =
  7.1788 -    Eq (Add (Mult (Cst 1, Var 0), lin_mul (op_div_def1 l c, r)), Cst 0)
  7.1789 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst c, Var 0), r), Cst i))) =
  7.1790 -    NOT (Eq (Add (Mult (Cst 1, Var 0), lin_mul (op_div_def1 l c, r)), Cst 0))
  7.1791 -  | adjustcoeff (l, And (p, q)) = And (adjustcoeff (l, p), adjustcoeff (l, q))
  7.1792 -  | adjustcoeff (l, Or (p, q)) = Or (adjustcoeff (l, p), adjustcoeff (l, q))
  7.1793 -  | adjustcoeff (l, Lt (w, x)) = Lt (w, x)
  7.1794 -  | adjustcoeff (l, Gt (y, z)) = Gt (y, z)
  7.1795 -  | adjustcoeff (l, Le (Cst bq, ab)) = Le (Cst bq, ab)
  7.1796 -  | adjustcoeff (l, Le (Var br, ab)) = Le (Var br, ab)
  7.1797 -  | adjustcoeff (l, Le (Neg bs, ab)) = Le (Neg bs, ab)
  7.1798 -  | adjustcoeff (l, Le (Add (Cst ci, bu), ab)) = Le (Add (Cst ci, bu), ab)
  7.1799 -  | adjustcoeff (l, Le (Add (Var cj, bu), ab)) = Le (Add (Var cj, bu), ab)
  7.1800 -  | adjustcoeff (l, Le (Add (Neg ck, bu), ab)) = Le (Add (Neg ck, bu), ab)
  7.1801 -  | adjustcoeff (l, Le (Add (Add (cl, cm), bu), ab)) =
  7.1802 -    Le (Add (Add (cl, cm), bu), ab)
  7.1803 -  | adjustcoeff (l, Le (Add (Sub (cn, co), bu), ab)) =
  7.1804 -    Le (Add (Sub (cn, co), bu), ab)
  7.1805 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Cst ds), bu), ab)) =
  7.1806 -    Le (Add (Mult (Cst da, Cst ds), bu), ab)
  7.1807 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Var 0), bu), Var en)) =
  7.1808 -    Le (Add (Mult (Cst da, Var 0), bu), Var en)
  7.1809 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Var 0), bu), Neg eo)) =
  7.1810 -    Le (Add (Mult (Cst da, Var 0), bu), Neg eo)
  7.1811 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Var 0), bu), Add (ep, eq))) =
  7.1812 -    Le (Add (Mult (Cst da, Var 0), bu), Add (ep, eq))
  7.1813 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Var 0), bu), Sub (er, es))) =
  7.1814 -    Le (Add (Mult (Cst da, Var 0), bu), Sub (er, es))
  7.1815 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Var 0), bu), Mult (et, eu))) =
  7.1816 -    Le (Add (Mult (Cst da, Var 0), bu), Mult (et, eu))
  7.1817 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Var ek), bu), ab)) =
  7.1818 -    Le (Add (Mult (Cst da, Var ek), bu), ab)
  7.1819 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Neg du), bu), ab)) =
  7.1820 -    Le (Add (Mult (Cst da, Neg du), bu), ab)
  7.1821 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Add (dv, dw)), bu), ab)) =
  7.1822 -    Le (Add (Mult (Cst da, Add (dv, dw)), bu), ab)
  7.1823 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Sub (dx, dy)), bu), ab)) =
  7.1824 -    Le (Add (Mult (Cst da, Sub (dx, dy)), bu), ab)
  7.1825 -  | adjustcoeff (l, Le (Add (Mult (Cst da, Mult (dz, ea)), bu), ab)) =
  7.1826 -    Le (Add (Mult (Cst da, Mult (dz, ea)), bu), ab)
  7.1827 -  | adjustcoeff (l, Le (Add (Mult (Var db, cq), bu), ab)) =
  7.1828 -    Le (Add (Mult (Var db, cq), bu), ab)
  7.1829 -  | adjustcoeff (l, Le (Add (Mult (Neg dc, cq), bu), ab)) =
  7.1830 -    Le (Add (Mult (Neg dc, cq), bu), ab)
  7.1831 -  | adjustcoeff (l, Le (Add (Mult (Add (dd, de), cq), bu), ab)) =
  7.1832 -    Le (Add (Mult (Add (dd, de), cq), bu), ab)
  7.1833 -  | adjustcoeff (l, Le (Add (Mult (Sub (df, dg), cq), bu), ab)) =
  7.1834 -    Le (Add (Mult (Sub (df, dg), cq), bu), ab)
  7.1835 -  | adjustcoeff (l, Le (Add (Mult (Mult (dh, di), cq), bu), ab)) =
  7.1836 -    Le (Add (Mult (Mult (dh, di), cq), bu), ab)
  7.1837 -  | adjustcoeff (l, Le (Sub (bv, bw), ab)) = Le (Sub (bv, bw), ab)
  7.1838 -  | adjustcoeff (l, Le (Mult (bx, by), ab)) = Le (Mult (bx, by), ab)
  7.1839 -  | adjustcoeff (l, Ge (ac, ad)) = Ge (ac, ad)
  7.1840 -  | adjustcoeff (l, Eq (Cst fe, af)) = Eq (Cst fe, af)
  7.1841 -  | adjustcoeff (l, Eq (Var ff, af)) = Eq (Var ff, af)
  7.1842 -  | adjustcoeff (l, Eq (Neg fg, af)) = Eq (Neg fg, af)
  7.1843 -  | adjustcoeff (l, Eq (Add (Cst fw, fi), af)) = Eq (Add (Cst fw, fi), af)
  7.1844 -  | adjustcoeff (l, Eq (Add (Var fx, fi), af)) = Eq (Add (Var fx, fi), af)
  7.1845 -  | adjustcoeff (l, Eq (Add (Neg fy, fi), af)) = Eq (Add (Neg fy, fi), af)
  7.1846 -  | adjustcoeff (l, Eq (Add (Add (fz, ga), fi), af)) =
  7.1847 -    Eq (Add (Add (fz, ga), fi), af)
  7.1848 -  | adjustcoeff (l, Eq (Add (Sub (gb, gc), fi), af)) =
  7.1849 -    Eq (Add (Sub (gb, gc), fi), af)
  7.1850 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Cst hg), fi), af)) =
  7.1851 -    Eq (Add (Mult (Cst go, Cst hg), fi), af)
  7.1852 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Var 0), fi), Var ib)) =
  7.1853 -    Eq (Add (Mult (Cst go, Var 0), fi), Var ib)
  7.1854 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Var 0), fi), Neg ic)) =
  7.1855 -    Eq (Add (Mult (Cst go, Var 0), fi), Neg ic)
  7.1856 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Var 0), fi), Add (id, ie))) =
  7.1857 -    Eq (Add (Mult (Cst go, Var 0), fi), Add (id, ie))
  7.1858 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Var 0), fi), Sub (if', ig))) =
  7.1859 -    Eq (Add (Mult (Cst go, Var 0), fi), Sub (if', ig))
  7.1860 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Var 0), fi), Mult (ih, ii))) =
  7.1861 -    Eq (Add (Mult (Cst go, Var 0), fi), Mult (ih, ii))
  7.1862 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Var hy), fi), af)) =
  7.1863 -    Eq (Add (Mult (Cst go, Var hy), fi), af)
  7.1864 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Neg hi), fi), af)) =
  7.1865 -    Eq (Add (Mult (Cst go, Neg hi), fi), af)
  7.1866 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Add (hj, hk)), fi), af)) =
  7.1867 -    Eq (Add (Mult (Cst go, Add (hj, hk)), fi), af)
  7.1868 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Sub (hl, hm)), fi), af)) =
  7.1869 -    Eq (Add (Mult (Cst go, Sub (hl, hm)), fi), af)
  7.1870 -  | adjustcoeff (l, Eq (Add (Mult (Cst go, Mult (hn, ho)), fi), af)) =
  7.1871 -    Eq (Add (Mult (Cst go, Mult (hn, ho)), fi), af)
  7.1872 -  | adjustcoeff (l, Eq (Add (Mult (Var gp, ge), fi), af)) =
  7.1873 -    Eq (Add (Mult (Var gp, ge), fi), af)
  7.1874 -  | adjustcoeff (l, Eq (Add (Mult (Neg gq, ge), fi), af)) =
  7.1875 -    Eq (Add (Mult (Neg gq, ge), fi), af)
  7.1876 -  | adjustcoeff (l, Eq (Add (Mult (Add (gr, gs), ge), fi), af)) =
  7.1877 -    Eq (Add (Mult (Add (gr, gs), ge), fi), af)
  7.1878 -  | adjustcoeff (l, Eq (Add (Mult (Sub (gt, gu), ge), fi), af)) =
  7.1879 -    Eq (Add (Mult (Sub (gt, gu), ge), fi), af)
  7.1880 -  | adjustcoeff (l, Eq (Add (Mult (Mult (gv, gw), ge), fi), af)) =
  7.1881 -    Eq (Add (Mult (Mult (gv, gw), ge), fi), af)
  7.1882 -  | adjustcoeff (l, Eq (Sub (fj, fk), af)) = Eq (Sub (fj, fk), af)
  7.1883 -  | adjustcoeff (l, Eq (Mult (fl, fm), af)) = Eq (Mult (fl, fm), af)
  7.1884 -  | adjustcoeff (l, Divides (Cst is, Cst jk)) = Divides (Cst is, Cst jk)
  7.1885 -  | adjustcoeff (l, Divides (Cst is, Var jl)) = Divides (Cst is, Var jl)
  7.1886 -  | adjustcoeff (l, Divides (Cst is, Neg jm)) = Divides (Cst is, Neg jm)
  7.1887 -  | adjustcoeff (l, Divides (Cst is, Add (Cst kc, jo))) =
  7.1888 -    Divides (Cst is, Add (Cst kc, jo))
  7.1889 -  | adjustcoeff (l, Divides (Cst is, Add (Var kd, jo))) =
  7.1890 -    Divides (Cst is, Add (Var kd, jo))
  7.1891 -  | adjustcoeff (l, Divides (Cst is, Add (Neg ke, jo))) =
  7.1892 -    Divides (Cst is, Add (Neg ke, jo))
  7.1893 -  | adjustcoeff (l, Divides (Cst is, Add (Add (kf, kg), jo))) =
  7.1894 -    Divides (Cst is, Add (Add (kf, kg), jo))
  7.1895 -  | adjustcoeff (l, Divides (Cst is, Add (Sub (kh, ki), jo))) =
  7.1896 -    Divides (Cst is, Add (Sub (kh, ki), jo))
  7.1897 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Cst ku, Cst lm), jo))) =
  7.1898 -    Divides (Cst is, Add (Mult (Cst ku, Cst lm), jo))
  7.1899 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Cst ku, Var me), jo))) =
  7.1900 -    (if (me = 0)
  7.1901 -      then Divides
  7.1902 -             (Cst (op_div_def1 l ku * is),
  7.1903 -               Add (Mult (Cst 1, Var 0), lin_mul (op_div_def1 l ku, jo)))
  7.1904 -      else Divides
  7.1905 -             (Cst is,
  7.1906 -               Add (Mult (Cst ku, Var (op_45_def0 me id_1_def0 + 1)), jo)))
  7.1907 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Cst ku, Neg lo), jo))) =
  7.1908 -    Divides (Cst is, Add (Mult (Cst ku, Neg lo), jo))
  7.1909 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Cst ku, Add (lp, lq)), jo))) =
  7.1910 -    Divides (Cst is, Add (Mult (Cst ku, Add (lp, lq)), jo))
  7.1911 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Cst ku, Sub (lr, ls)), jo))) =
  7.1912 -    Divides (Cst is, Add (Mult (Cst ku, Sub (lr, ls)), jo))
  7.1913 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Cst ku, Mult (lt, lu)), jo))) =
  7.1914 -    Divides (Cst is, Add (Mult (Cst ku, Mult (lt, lu)), jo))
  7.1915 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Var kv, kk), jo))) =
  7.1916 -    Divides (Cst is, Add (Mult (Var kv, kk), jo))
  7.1917 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Neg kw, kk), jo))) =
  7.1918 -    Divides (Cst is, Add (Mult (Neg kw, kk), jo))
  7.1919 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Add (kx, ky), kk), jo))) =
  7.1920 -    Divides (Cst is, Add (Mult (Add (kx, ky), kk), jo))
  7.1921 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Sub (kz, la), kk), jo))) =
  7.1922 -    Divides (Cst is, Add (Mult (Sub (kz, la), kk), jo))
  7.1923 -  | adjustcoeff (l, Divides (Cst is, Add (Mult (Mult (lb, lc), kk), jo))) =
  7.1924 -    Divides (Cst is, Add (Mult (Mult (lb, lc), kk), jo))
  7.1925 -  | adjustcoeff (l, Divides (Cst is, Sub (jp, jq))) =
  7.1926 -    Divides (Cst is, Sub (jp, jq))
  7.1927 -  | adjustcoeff (l, Divides (Cst is, Mult (jr, js))) =
  7.1928 -    Divides (Cst is, Mult (jr, js))
  7.1929 -  | adjustcoeff (l, Divides (Var it, ah)) = Divides (Var it, ah)
  7.1930 -  | adjustcoeff (l, Divides (Neg iu, ah)) = Divides (Neg iu, ah)
  7.1931 -  | adjustcoeff (l, Divides (Add (iv, iw), ah)) = Divides (Add (iv, iw), ah)
  7.1932 -  | adjustcoeff (l, Divides (Sub (ix, iy), ah)) = Divides (Sub (ix, iy), ah)
  7.1933 -  | adjustcoeff (l, Divides (Mult (iz, ja), ah)) = Divides (Mult (iz, ja), ah)
  7.1934 -  | adjustcoeff (l, T) = T
  7.1935 -  | adjustcoeff (l, F) = F
  7.1936 -  | adjustcoeff (l, NOT (Lt (mg, mh))) = NOT (Lt (mg, mh))
  7.1937 -  | adjustcoeff (l, NOT (Gt (mi, mj))) = NOT (Gt (mi, mj))
  7.1938 -  | adjustcoeff (l, NOT (Le (mk, ml))) = NOT (Le (mk, ml))
  7.1939 -  | adjustcoeff (l, NOT (Ge (mm, mn))) = NOT (Ge (mm, mn))
  7.1940 -  | adjustcoeff (l, NOT (Eq (Cst oa, mp))) = NOT (Eq (Cst oa, mp))
  7.1941 -  | adjustcoeff (l, NOT (Eq (Var ob, mp))) = NOT (Eq (Var ob, mp))
  7.1942 -  | adjustcoeff (l, NOT (Eq (Neg oc, mp))) = NOT (Eq (Neg oc, mp))
  7.1943 -  | adjustcoeff (l, NOT (Eq (Add (Cst os, oe), mp))) =
  7.1944 -    NOT (Eq (Add (Cst os, oe), mp))
  7.1945 -  | adjustcoeff (l, NOT (Eq (Add (Var ot, oe), mp))) =
  7.1946 -    NOT (Eq (Add (Var ot, oe), mp))
  7.1947 -  | adjustcoeff (l, NOT (Eq (Add (Neg ou, oe), mp))) =
  7.1948 -    NOT (Eq (Add (Neg ou, oe), mp))
  7.1949 -  | adjustcoeff (l, NOT (Eq (Add (Add (ov, ow), oe), mp))) =
  7.1950 -    NOT (Eq (Add (Add (ov, ow), oe), mp))
  7.1951 -  | adjustcoeff (l, NOT (Eq (Add (Sub (ox, oy), oe), mp))) =
  7.1952 -    NOT (Eq (Add (Sub (ox, oy), oe), mp))
  7.1953 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Cst qc), oe), mp))) =
  7.1954 -    NOT (Eq (Add (Mult (Cst pk, Cst qc), oe), mp))
  7.1955 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Var qx))) =
  7.1956 -    NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Var qx))
  7.1957 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Neg qy))) =
  7.1958 -    NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Neg qy))
  7.1959 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Add (qz, ra)))) =
  7.1960 -    NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Add (qz, ra)))
  7.1961 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Sub (rb, rc)))) =
  7.1962 -    NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Sub (rb, rc)))
  7.1963 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Mult (rd, re)))) =
  7.1964 -    NOT (Eq (Add (Mult (Cst pk, Var 0), oe), Mult (rd, re)))
  7.1965 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Var qu), oe), mp))) =
  7.1966 -    NOT (Eq (Add (Mult (Cst pk, Var qu), oe), mp))
  7.1967 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Neg qe), oe), mp))) =
  7.1968 -    NOT (Eq (Add (Mult (Cst pk, Neg qe), oe), mp))
  7.1969 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Add (qf, qg)), oe), mp))) =
  7.1970 -    NOT (Eq (Add (Mult (Cst pk, Add (qf, qg)), oe), mp))
  7.1971 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Sub (qh, qi)), oe), mp))) =
  7.1972 -    NOT (Eq (Add (Mult (Cst pk, Sub (qh, qi)), oe), mp))
  7.1973 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Cst pk, Mult (qj, qk)), oe), mp))) =
  7.1974 -    NOT (Eq (Add (Mult (Cst pk, Mult (qj, qk)), oe), mp))
  7.1975 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Var pl, pa), oe), mp))) =
  7.1976 -    NOT (Eq (Add (Mult (Var pl, pa), oe), mp))
  7.1977 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Neg pm, pa), oe), mp))) =
  7.1978 -    NOT (Eq (Add (Mult (Neg pm, pa), oe), mp))
  7.1979 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Add (pn, po), pa), oe), mp))) =
  7.1980 -    NOT (Eq (Add (Mult (Add (pn, po), pa), oe), mp))
  7.1981 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Sub (pp, pq), pa), oe), mp))) =
  7.1982 -    NOT (Eq (Add (Mult (Sub (pp, pq), pa), oe), mp))
  7.1983 -  | adjustcoeff (l, NOT (Eq (Add (Mult (Mult (pr, ps), pa), oe), mp))) =
  7.1984 -    NOT (Eq (Add (Mult (Mult (pr, ps), pa), oe), mp))
  7.1985 -  | adjustcoeff (l, NOT (Eq (Sub (of', og), mp))) = NOT (Eq (Sub (of', og), mp))
  7.1986 -  | adjustcoeff (l, NOT (Eq (Mult (oh, oi), mp))) = NOT (Eq (Mult (oh, oi), mp))
  7.1987 -  | adjustcoeff (l, NOT (Divides (Cst ro, Cst sg))) =
  7.1988 -    NOT (Divides (Cst ro, Cst sg))
  7.1989 -  | adjustcoeff (l, NOT (Divides (Cst ro, Var sh))) =
  7.1990 -    NOT (Divides (Cst ro, Var sh))
  7.1991 -  | adjustcoeff (l, NOT (Divides (Cst ro, Neg si))) =
  7.1992 -    NOT (Divides (Cst ro, Neg si))
  7.1993 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Cst sy, sk)))) =
  7.1994 -    NOT (Divides (Cst ro, Add (Cst sy, sk)))
  7.1995 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Var sz, sk)))) =
  7.1996 -    NOT (Divides (Cst ro, Add (Var sz, sk)))
  7.1997 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Neg ta, sk)))) =
  7.1998 -    NOT (Divides (Cst ro, Add (Neg ta, sk)))
  7.1999 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Add (tb, tc), sk)))) =
  7.2000 -    NOT (Divides (Cst ro, Add (Add (tb, tc), sk)))
  7.2001 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Sub (td, te), sk)))) =
  7.2002 -    NOT (Divides (Cst ro, Add (Sub (td, te), sk)))
  7.2003 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Cst tq, Cst ui), sk)))) =
  7.2004 -    NOT (Divides (Cst ro, Add (Mult (Cst tq, Cst ui), sk)))
  7.2005 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Cst tq, Var va), sk)))) =
  7.2006 -    (if (va = 0)
  7.2007 -      then NOT (Divides
  7.2008 -                  (Cst (op_div_def1 l tq * ro),
  7.2009 -                    Add (Mult (Cst 1, Var 0), lin_mul (op_div_def1 l tq, sk))))
  7.2010 -      else NOT (Divides
  7.2011 -                  (Cst ro,
  7.2012 -                    Add (Mult (Cst tq, Var (op_45_def0 va id_1_def0 + 1)),
  7.2013 -                          sk))))
  7.2014 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Cst tq, Neg uk), sk)))) =
  7.2015 -    NOT (Divides (Cst ro, Add (Mult (Cst tq, Neg uk), sk)))
  7.2016 -  | adjustcoeff
  7.2017 -      (l, NOT (Divides (Cst ro, Add (Mult (Cst tq, Add (ul, um)), sk)))) =
  7.2018 -    NOT (Divides (Cst ro, Add (Mult (Cst tq, Add (ul, um)), sk)))
  7.2019 -  | adjustcoeff
  7.2020 -      (l, NOT (Divides (Cst ro, Add (Mult (Cst tq, Sub (un, uo)), sk)))) =
  7.2021 -    NOT (Divides (Cst ro, Add (Mult (Cst tq, Sub (un, uo)), sk)))
  7.2022 -  | adjustcoeff
  7.2023 -      (l, NOT (Divides (Cst ro, Add (Mult (Cst tq, Mult (up, uq)), sk)))) =
  7.2024 -    NOT (Divides (Cst ro, Add (Mult (Cst tq, Mult (up, uq)), sk)))
  7.2025 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Var tr, tg), sk)))) =
  7.2026 -    NOT (Divides (Cst ro, Add (Mult (Var tr, tg), sk)))
  7.2027 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Neg ts, tg), sk)))) =
  7.2028 -    NOT (Divides (Cst ro, Add (Mult (Neg ts, tg), sk)))
  7.2029 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Add (tt, tu), tg), sk)))) =
  7.2030 -    NOT (Divides (Cst ro, Add (Mult (Add (tt, tu), tg), sk)))
  7.2031 -  | adjustcoeff (l, NOT (Divides (Cst ro, Add (Mult (Sub (tv, tw), tg), sk)))) =
  7.2032 -    NOT (Divides (Cst ro, Add (Mult (Sub (tv, tw), tg), sk)))
  7.2033 -  | adjustcoeff
  7.2034 -      (l, NOT (Divides (Cst ro, Add (Mult (Mult (tx, ty), tg), sk)))) =
  7.2035 -    NOT (Divides (Cst ro, Add (Mult (Mult (tx, ty), tg), sk)))
  7.2036 -  | adjustcoeff (l, NOT (Divides (Cst ro, Sub (sl, sm)))) =
  7.2037 -    NOT (Divides (Cst ro, Sub (sl, sm)))
  7.2038 -  | adjustcoeff (l, NOT (Divides (Cst ro, Mult (sn, so)))) =
  7.2039 -    NOT (Divides (Cst ro, Mult (sn, so)))
  7.2040 -  | adjustcoeff (l, NOT (Divides (Var rp, mr))) = NOT (Divides (Var rp, mr))
  7.2041 -  | adjustcoeff (l, NOT (Divides (Neg rq, mr))) = NOT (Divides (Neg rq, mr))
  7.2042 -  | adjustcoeff (l, NOT (Divides (Add (rr, rs), mr))) =
  7.2043 -    NOT (Divides (Add (rr, rs), mr))
  7.2044 -  | adjustcoeff (l, NOT (Divides (Sub (rt, ru), mr))) =
  7.2045 -    NOT (Divides (Sub (rt, ru), mr))
  7.2046 -  | adjustcoeff (l, NOT (Divides (Mult (rv, rw), mr))) =
  7.2047 -    NOT (Divides (Mult (rv, rw), mr))
  7.2048 -  | adjustcoeff (l, NOT T) = NOT T
  7.2049 -  | adjustcoeff (l, NOT F) = NOT F
  7.2050 -  | adjustcoeff (l, NOT (NOT ms)) = NOT (NOT ms)
  7.2051 -  | adjustcoeff (l, NOT (And (mt, mu))) = NOT (And (mt, mu))
  7.2052 -  | adjustcoeff (l, NOT (Or (mv, mw))) = NOT (Or (mv, mw))
  7.2053 -  | adjustcoeff (l, NOT (Imp (mx, my))) = NOT (Imp (mx, my))
  7.2054 -  | adjustcoeff (l, NOT (Equ (mz, na))) = NOT (Equ (mz, na))
  7.2055 -  | adjustcoeff (l, NOT (QAll nb)) = NOT (QAll nb)
  7.2056 -  | adjustcoeff (l, NOT (QEx nc)) = NOT (QEx nc)
  7.2057 -  | adjustcoeff (l, Imp (an, ao)) = Imp (an, ao)
  7.2058 -  | adjustcoeff (l, Equ (ap, aq)) = Equ (ap, aq)
  7.2059 -  | adjustcoeff (l, QAll ar) = QAll ar
  7.2060 -  | adjustcoeff (l, QEx as') = QEx as';
  7.2061 -
  7.2062 -fun formlcm (Le (Add (Mult (Cst c, Var 0), r), Cst i)) = abs c
  7.2063 -  | formlcm (Eq (Add (Mult (Cst c, Var 0), r), Cst i)) = abs c
  7.2064 -  | formlcm (NOT p) = formlcm p
  7.2065 -  | formlcm (And (p, q)) = ilcm (formlcm p) (formlcm q)
  7.2066 -  | formlcm (Or (p, q)) = ilcm (formlcm p) (formlcm q)
  7.2067 -  | formlcm (Lt (u, v)) = 1
  7.2068 -  | formlcm (Gt (w, x)) = 1
  7.2069 -  | formlcm (Le (Cst bo, z)) = 1
  7.2070 -  | formlcm (Le (Var bp, z)) = 1
  7.2071 -  | formlcm (Le (Neg bq, z)) = 1
  7.2072 -  | formlcm (Le (Add (Cst cg, bs), z)) = 1
  7.2073 -  | formlcm (Le (Add (Var ch, bs), z)) = 1
  7.2074 -  | formlcm (Le (Add (Neg ci, bs), z)) = 1
  7.2075 -  | formlcm (Le (Add (Add (cj, ck), bs), z)) = 1
  7.2076 -  | formlcm (Le (Add (Sub (cl, cm), bs), z)) = 1
  7.2077 -  | formlcm (Le (Add (Mult (Cst cy, Cst dq), bs), z)) = 1
  7.2078 -  | formlcm (Le (Add (Mult (Cst cy, Var 0), bs), Var el)) = 1
  7.2079 -  | formlcm (Le (Add (Mult (Cst cy, Var 0), bs), Neg em)) = 1
  7.2080 -  | formlcm (Le (Add (Mult (Cst cy, Var 0), bs), Add (en, eo))) = 1
  7.2081 -  | formlcm (Le (Add (Mult (Cst cy, Var 0), bs), Sub (ep, eq))) = 1
  7.2082 -  | formlcm (Le (Add (Mult (Cst cy, Var 0), bs), Mult (er, es))) = 1
  7.2083 -  | formlcm (Le (Add (Mult (Cst cy, Var ei ), bs), z)) = 1
  7.2084 -  | formlcm (Le (Add (Mult (Cst cy, Neg ds), bs), z)) = 1
  7.2085 -  | formlcm (Le (Add (Mult (Cst cy, Add (dt, du)), bs), z)) = 1
  7.2086 -  | formlcm (Le (Add (Mult (Cst cy, Sub (dv, dw)), bs), z)) = 1
  7.2087 -  | formlcm (Le (Add (Mult (Cst cy, Mult (dx, dy)), bs), z)) = 1
  7.2088 -  | formlcm (Le (Add (Mult (Var cz, co), bs), z)) = 1
  7.2089 -  | formlcm (Le (Add (Mult (Neg da, co), bs), z)) = 1
  7.2090 -  | formlcm (Le (Add (Mult (Add (db, dc), co), bs), z)) = 1
  7.2091 -  | formlcm (Le (Add (Mult (Sub (dd, de), co), bs), z)) = 1
  7.2092 -  | formlcm (Le (Add (Mult (Mult (df, dg), co), bs), z)) = 1
  7.2093 -  | formlcm (Le (Sub (bt, bu), z)) = 1
  7.2094 -  | formlcm (Le (Mult (bv, bw), z)) = 1
  7.2095 -  | formlcm (Ge (aa, ab)) = 1
  7.2096 -  | formlcm (Eq (Cst fc, ad)) = 1
  7.2097 -  | formlcm (Eq (Var fd, ad)) = 1
  7.2098 -  | formlcm (Eq (Neg fe, ad)) = 1
  7.2099 -  | formlcm (Eq (Add (Cst fu, fg), ad)) = 1
  7.2100 -  | formlcm (Eq (Add (Var fv, fg), ad)) = 1
  7.2101 -  | formlcm (Eq (Add (Neg fw, fg), ad)) = 1
  7.2102 -  | formlcm (Eq (Add (Add (fx, fy), fg), ad)) = 1
  7.2103 -  | formlcm (Eq (Add (Sub (fz, ga), fg), ad)) = 1
  7.2104 -  | formlcm (Eq (Add (Mult (Cst gm, Cst he), fg), ad)) = 1
  7.2105 -  | formlcm (Eq (Add (Mult (Cst gm, Var 0), fg), Var hz)) = 1
  7.2106 -  | formlcm (Eq (Add (Mult (Cst gm, Var 0), fg), Neg ia)) = 1
  7.2107 -  | formlcm (Eq (Add (Mult (Cst gm, Var 0), fg), Add (ib, ic))) = 1
  7.2108 -  | formlcm (Eq (Add (Mult (Cst gm, Var 0), fg), Sub (id, ie))) = 1
  7.2109 -  | formlcm (Eq (Add (Mult (Cst gm, Var 0), fg), Mult (if', ig))) = 1
  7.2110 -  | formlcm (Eq (Add (Mult (Cst gm, Var hw), fg), ad)) = 1
  7.2111 -  | formlcm (Eq (Add (Mult (Cst gm, Neg hg), fg), ad)) = 1
  7.2112 -  | formlcm (Eq (Add (Mult (Cst gm, Add (hh, hi)), fg), ad)) = 1
  7.2113 -  | formlcm (Eq (Add (Mult (Cst gm, Sub (hj, hk)), fg), ad)) = 1
  7.2114 -  | formlcm (Eq (Add (Mult (Cst gm, Mult (hl, hm)), fg), ad)) = 1
  7.2115 -  | formlcm (Eq (Add (Mult (Var gn, gc), fg), ad)) = 1
  7.2116 -  | formlcm (Eq (Add (Mult (Neg go, gc), fg), ad)) = 1
  7.2117 -  | formlcm (Eq (Add (Mult (Add (gp, gq), gc), fg), ad)) = 1
  7.2118 -  | formlcm (Eq (Add (Mult (Sub (gr, gs), gc), fg), ad)) = 1
  7.2119 -  | formlcm (Eq (Add (Mult (Mult (gt, gu), gc), fg), ad)) = 1
  7.2120 -  | formlcm (Eq (Sub (fh, fi), ad)) = 1
  7.2121 -  | formlcm (Eq (Mult (fj, fk), ad)) = 1
  7.2122 -  | formlcm (Divides (Cst iq, Cst ji)) = 1
  7.2123 -  | formlcm (Divides (Cst iq, Var jj)) = 1
  7.2124 -  | formlcm (Divides (Cst iq, Neg jk)) = 1
  7.2125 -  | formlcm (Divides (Cst iq, Add (Cst ka, jm))) = 1
  7.2126 -  | formlcm (Divides (Cst iq, Add (Var kb, jm))) = 1
  7.2127 -  | formlcm (Divides (Cst iq, Add (Neg kc, jm))) = 1
  7.2128 -  | formlcm (Divides (Cst iq, Add (Add (kd, ke), jm))) = 1
  7.2129 -  | formlcm (Divides (Cst iq, Add (Sub (kf, kg), jm))) = 1
  7.2130 -  | formlcm (Divides (Cst iq, Add (Mult (Cst ks, Cst lk), jm))) = 1
  7.2131 -  | formlcm (Divides (Cst iq, Add (Mult (Cst ks, Var mc), jm))) =
  7.2132 -    (if (mc = 0) then abs ks else 1)
  7.2133 -  | formlcm (Divides (Cst iq, Add (Mult (Cst ks, Neg lm), jm))) = 1
  7.2134 -  | formlcm (Divides (Cst iq, Add (Mult (Cst ks, Add (ln, lo)), jm))) = 1
  7.2135 -  | formlcm (Divides (Cst iq, Add (Mult (Cst ks, Sub (lp, lq)), jm))) = 1
  7.2136 -  | formlcm (Divides (Cst iq, Add (Mult (Cst ks, Mult (lr, ls)), jm))) = 1
  7.2137 -  | formlcm (Divides (Cst iq, Add (Mult (Var kt, ki), jm))) = 1
  7.2138 -  | formlcm (Divides (Cst iq, Add (Mult (Neg ku, ki), jm))) = 1
  7.2139 -  | formlcm (Divides (Cst iq, Add (Mult (Add (kv, kw), ki), jm))) = 1
  7.2140 -  | formlcm (Divides (Cst iq, Add (Mult (Sub (kx, ky), ki), jm))) = 1
  7.2141 -  | formlcm (Divides (Cst iq, Add (Mult (Mult (kz, la), ki), jm))) = 1
  7.2142 -  | formlcm (Divides (Cst iq, Sub (jn, jo))) = 1
  7.2143 -  | formlcm (Divides (Cst iq, Mult (jp, jq))) = 1
  7.2144 -  | formlcm (Divides (Var ir, af)) = 1
  7.2145 -  | formlcm (Divides (Neg is, af)) = 1
  7.2146 -  | formlcm (Divides (Add (it, iu), af)) = 1
  7.2147 -  | formlcm (Divides (Sub (iv, iw), af)) = 1
  7.2148 -  | formlcm (Divides (Mult (ix, iy), af)) = 1
  7.2149 -  | formlcm T = 1
  7.2150 -  | formlcm F = 1
  7.2151 -  | formlcm (Imp (al, am)) = 1
  7.2152 -  | formlcm (Equ (an, ao)) = 1
  7.2153 -  | formlcm (QAll ap) = 1
  7.2154 -  | formlcm (QEx aq) = 1;
  7.2155 -
  7.2156 -fun unitycoeff p =
  7.2157 -  let val l = formlcm p; val p' = adjustcoeff (l, p)
  7.2158 -  in (if (l = 1) then p'
  7.2159 -       else And (Divides (Cst l, Add (Mult (Cst 1, Var 0), Cst 0)), p'))
  7.2160 -  end;
  7.2161 -
  7.2162 -fun unify p =
  7.2163 -  let val q = unitycoeff p; val B = list_set (bset q); val A = list_set (aset q)
  7.2164 -  in (if op_60_61_def0 (size_def1 B) (size_def1 A) then (q, B)
  7.2165 -       else (mirror q, map lin_neg A))
  7.2166 -  end;
  7.2167 -
  7.2168 -fun cooper p =
  7.2169 -  lift_un (fn q => decrvars (explode_minf (unify q))) (linform (nnf p));
  7.2170 -
  7.2171 -fun pa p = lift_un psimpl (qelim (cooper, p));
  7.2172 -
  7.2173 -val test = pa;
  7.2174 -
  7.2175 -end;
     8.1 --- a/src/HOL/IsaMakefile	Thu May 31 11:00:06 2007 +0200
     8.2 +++ b/src/HOL/IsaMakefile	Thu May 31 12:06:31 2007 +0200
     8.3 @@ -62,8 +62,7 @@
     8.4  Pure:
     8.5  	@cd $(SRC)/Pure; $(ISATOOL) make Pure
     8.6  
     8.7 -$(OUT)/HOL: $(OUT)/Pure $(SRC)/Pure/General/int.ML $(SRC)/Pure/General/rat.ML   \
     8.8 -  $(SRC)/Provers/Arith/abel_cancel.ML			                        \
     8.9 +$(OUT)/HOL: $(OUT)/Pure $(SRC)/Provers/Arith/abel_cancel.ML			\
    8.10    $(SRC)/Provers/Arith/assoc_fold.ML						\
    8.11    $(SRC)/Provers/Arith/cancel_div_mod.ML					\
    8.12    $(SRC)/Provers/Arith/cancel_numeral_factor.ML					\
    8.13 @@ -81,40 +80,42 @@
    8.14    $(SRC)/Provers/induct_method.ML $(SRC)/Provers/order.ML			\
    8.15    $(SRC)/Provers/project_rule.ML $(SRC)/Provers/quantifier1.ML			\
    8.16    $(SRC)/Provers/quasi.ML $(SRC)/Provers/splitter.ML				\
    8.17 -  $(SRC)/Provers/trancl.ML $(SRC)/TFL/casesplit.ML $(SRC)/TFL/dcterm.ML		\
    8.18 -  $(SRC)/TFL/post.ML $(SRC)/TFL/rules.ML $(SRC)/TFL/tfl.ML			\
    8.19 -  $(SRC)/TFL/thms.ML $(SRC)/TFL/thry.ML $(SRC)/TFL/usyntax.ML			\
    8.20 -  $(SRC)/TFL/utils.ML ATP_Linkup.thy Accessible_Part.thy			\
    8.21 -  Code_Generator.thy Datatype.thy Divides.thy Equiv_Relations.thy		\
    8.22 -  Extraction.thy Finite_Set.thy FixedPoint.thy Fun.thy FunDef.thy	\
    8.23 -  HOL.thy Hilbert_Choice.thy Inductive.thy Integ/IntArith.thy			\
    8.24 -  Integ/IntDef.thy Integ/IntDiv.thy Integ/NatBin.thy				\
    8.25 -  Integ/NatSimprocs.thy Integ/Numeral.thy Integ/Presburger.thy			\
    8.26 -  Integ/cooper_dec.ML Integ/cooper_proof.ML Integ/int_arith1.ML			\
    8.27 -  Integ/int_factor_simprocs.ML Integ/nat_simprocs.ML Integ/presburger.ML	\
    8.28 -  Integ/qelim.ML Integ/reflected_cooper.ML Integ/reflected_presburger.ML	\
    8.29 -  Lattices.thy List.thy Main.thy Map.thy Nat.ML Nat.thy		\
    8.30 -  OrderedGroup.thy Orderings.thy Power.thy Predicate.thy PreList.thy	\
    8.31 +  $(SRC)/Provers/trancl.ML $(SRC)/Pure/General/int.ML				\
    8.32 +  $(SRC)/Pure/General/rat.ML $(SRC)/TFL/casesplit.ML				\
    8.33 +  $(SRC)/TFL/dcterm.ML $(SRC)/TFL/post.ML $(SRC)/TFL/rules.ML			\
    8.34 +  $(SRC)/TFL/tfl.ML $(SRC)/TFL/thms.ML $(SRC)/TFL/thry.ML			\
    8.35 +  $(SRC)/TFL/usyntax.ML $(SRC)/TFL/utils.ML ATP_Linkup.thy			\
    8.36 +  Accessible_Part.thy Code_Generator.thy Datatype.thy Divides.thy		\
    8.37 +  Equiv_Relations.thy Extraction.thy Finite_Set.thy FixedPoint.thy		\
    8.38 +  Fun.thy FunDef.thy HOL.thy Hilbert_Choice.thy Inductive.thy			\
    8.39 +  Integ/IntArith.thy Integ/IntDef.thy Integ/IntDiv.thy Integ/NatBin.thy		\
    8.40 +  Integ/NatSimprocs.thy Integ/Numeral.thy Integ/int_arith1.ML			\
    8.41 +  Integ/int_factor_simprocs.ML Integ/nat_simprocs.ML Lattices.thy		\
    8.42 +  List.thy Main.thy Map.thy Nat.ML Nat.thy OrderedGroup.thy			\
    8.43 +  Orderings.thy Power.thy PreList.thy Predicate.thy Presburger.thy		\
    8.44    Product_Type.thy ROOT.ML Recdef.thy Record.thy Refute.thy Relation.thy	\
    8.45    Relation_Power.thy Ring_and_Field.thy SAT.thy Set.thy SetInterval.thy		\
    8.46 -  Sum_Type.thy Tools/res_reconstruct.ML Tools/ATP/reduce_axiomsN.ML	\
    8.47 -  Tools/ATP/watcher.ML Tools/cnf_funcs.ML Tools/datatype_abs_proofs.ML		\
    8.48 -  Tools/datatype_aux.ML Tools/datatype_case.ML Tools/datatype_codegen.ML	\
    8.49 +  Sum_Type.thy Tools/ATP/reduce_axiomsN.ML Tools/ATP/watcher.ML			\
    8.50 +  Tools/Presburger/cooper_dec.ML Tools/Presburger/cooper_proof.ML		\
    8.51 +  Tools/Presburger/presburger.ML Tools/Presburger/qelim.ML			\
    8.52 +  Tools/Presburger/reflected_cooper.ML						\
    8.53 +  Tools/Presburger/reflected_presburger.ML Tools/cnf_funcs.ML			\
    8.54 +  Tools/datatype_abs_proofs.ML Tools/datatype_aux.ML				\
    8.55 +  Tools/datatype_case.ML Tools/datatype_codegen.ML				\
    8.56    Tools/datatype_hooks.ML Tools/datatype_package.ML				\
    8.57    Tools/datatype_prop.ML Tools/datatype_realizer.ML				\
    8.58    Tools/datatype_rep_proofs.ML Tools/function_package/auto_term.ML		\
    8.59    Tools/function_package/context_tree.ML					\
    8.60    Tools/function_package/fundef_common.ML					\
    8.61 +  Tools/function_package/fundef_core.ML						\
    8.62    Tools/function_package/fundef_datatype.ML					\
    8.63    Tools/function_package/fundef_lib.ML						\
    8.64    Tools/function_package/fundef_package.ML					\
    8.65 -  Tools/function_package/fundef_core.ML						\
    8.66    Tools/function_package/inductive_wrap.ML					\
    8.67    Tools/function_package/lexicographic_order.ML					\
    8.68    Tools/function_package/mutual.ML						\
    8.69    Tools/function_package/pattern_split.ML					\
    8.70 -  Tools/function_package/sum_tools.ML						\
    8.71 -  Tools/inductive_codegen.ML		\
    8.72 +  Tools/function_package/sum_tools.ML Tools/inductive_codegen.ML		\
    8.73    Tools/inductive_package.ML Tools/inductive_realizer.ML Tools/meson.ML		\
    8.74    Tools/numeral_syntax.ML Tools/old_inductive_package.ML			\
    8.75    Tools/polyhash.ML Tools/primrec_package.ML Tools/prop_logic.ML		\
    8.76 @@ -122,8 +123,9 @@
    8.77    Tools/record_package.ML Tools/refute.ML Tools/refute_isar.ML			\
    8.78    Tools/res_atp.ML Tools/res_atp_methods.ML Tools/res_atp_provers.ML		\
    8.79    Tools/res_atpset.ML Tools/res_axioms.ML Tools/res_clause.ML			\
    8.80 -  Tools/res_hol_clause.ML Tools/rewrite_hol_proof.ML Tools/sat_funcs.ML		\
    8.81 -  Tools/sat_solver.ML Tools/specification_package.ML Tools/split_rule.ML	\
    8.82 +  Tools/res_hol_clause.ML Tools/res_reconstruct.ML				\
    8.83 +  Tools/rewrite_hol_proof.ML Tools/sat_funcs.ML Tools/sat_solver.ML		\
    8.84 +  Tools/specification_package.ML Tools/split_rule.ML				\
    8.85    Tools/string_syntax.ML Tools/typecopy_package.ML				\
    8.86    Tools/typedef_codegen.ML Tools/typedef_package.ML				\
    8.87    Transitive_Closure.thy Typedef.thy Wellfounded_Recursion.thy			\
     9.1 --- a/src/HOL/Presburger.thy	Thu May 31 11:00:06 2007 +0200
     9.2 +++ b/src/HOL/Presburger.thy	Thu May 31 12:06:31 2007 +0200
     9.3 @@ -9,10 +9,14 @@
     9.4  header {* Presburger Arithmetic: Cooper's Algorithm *}
     9.5  
     9.6  theory Presburger
     9.7 -imports NatSimprocs "../SetInterval"
     9.8 +imports "Integ/NatSimprocs" SetInterval
     9.9  uses
    9.10 -  ("cooper_dec.ML") ("cooper_proof.ML") ("qelim.ML") 
    9.11 -  ("reflected_presburger.ML") ("reflected_cooper.ML") ("presburger.ML")
    9.12 +  ("Tools/Presburger/cooper_dec.ML")
    9.13 +  ("Tools/Presburger/cooper_proof.ML")
    9.14 +  ("Tools/Presburger/qelim.ML") 
    9.15 +  ("Tools/Presburger/reflected_presburger.ML")
    9.16 +  ("Tools/Presburger/reflected_cooper.ML")
    9.17 +  ("Tools/Presburger/presburger.ML")
    9.18  begin
    9.19  
    9.20  text {* Theorem for unitifying the coeffitients of @{text x} in an existential formula*}
    9.21 @@ -1047,15 +1051,15 @@
    9.22    show ?thesis by (simp add: 1)
    9.23  qed
    9.24  
    9.25 -use "cooper_dec.ML"
    9.26 -use "reflected_presburger.ML" 
    9.27 -use "reflected_cooper.ML"
    9.28 +use "Tools/Presburger/cooper_dec.ML"
    9.29 +use "Tools/Presburger/reflected_presburger.ML" 
    9.30 +use "Tools/Presburger/reflected_cooper.ML"
    9.31  oracle
    9.32    presburger_oracle ("term") = ReflectedCooper.presburger_oracle
    9.33  
    9.34 -use "cooper_proof.ML"
    9.35 -use "qelim.ML"
    9.36 -use "presburger.ML"
    9.37 +use "Tools/Presburger/cooper_proof.ML"
    9.38 +use "Tools/Presburger/qelim.ML"
    9.39 +use "Tools/Presburger/presburger.ML"
    9.40  
    9.41  setup "Presburger.setup"
    9.42  
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/ZF/Bin.thy	Thu May 31 12:06:31 2007 +0200
    10.3 @@ -0,0 +1,692 @@
    10.4 +(*  Title:      ZF/Bin.thy
    10.5 +    ID:         $Id$
    10.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    10.7 +    Copyright   1994  University of Cambridge
    10.8 +
    10.9 +   The sign Pls stands for an infinite string of leading 0's.
   10.10 +   The sign Min stands for an infinite string of leading 1's.
   10.11 +
   10.12 +A number can have multiple representations, namely leading 0's with sign
   10.13 +Pls and leading 1's with sign Min.  See twos-compl.ML/int_of_binary for
   10.14 +the numerical interpretation.
   10.15 +
   10.16 +The representation expects that (m mod 2) is 0 or 1, even if m is negative;
   10.17 +For instance, ~5 div 2 = ~3 and ~5 mod 2 = 1; thus ~5 = (~3)*2 + 1
   10.18 +*)
   10.19 +
   10.20 +header{*Arithmetic on Binary Integers*}
   10.21 +
   10.22 +theory Bin
   10.23 +imports Int Datatype
   10.24 +uses "Tools/numeral_syntax.ML"
   10.25 +begin
   10.26 +
   10.27 +consts  bin :: i
   10.28 +datatype
   10.29 +  "bin" = Pls
   10.30 +        | Min
   10.31 +        | Bit ("w: bin", "b: bool")	(infixl "BIT" 90)
   10.32 +
   10.33 +syntax
   10.34 +  "_Int"    :: "xnum => i"        ("_")
   10.35 +
   10.36 +consts
   10.37 +  integ_of  :: "i=>i"
   10.38 +  NCons     :: "[i,i]=>i"
   10.39 +  bin_succ  :: "i=>i"
   10.40 +  bin_pred  :: "i=>i"
   10.41 +  bin_minus :: "i=>i"
   10.42 +  bin_adder :: "i=>i"
   10.43 +  bin_mult  :: "[i,i]=>i"
   10.44 +
   10.45 +primrec
   10.46 +  integ_of_Pls:  "integ_of (Pls)     = $# 0"
   10.47 +  integ_of_Min:  "integ_of (Min)     = $-($#1)"
   10.48 +  integ_of_BIT:  "integ_of (w BIT b) = $#b $+ integ_of(w) $+ integ_of(w)"
   10.49 +
   10.50 +    (** recall that cond(1,b,c)=b and cond(0,b,c)=0 **)
   10.51 +
   10.52 +primrec (*NCons adds a bit, suppressing leading 0s and 1s*)
   10.53 +  NCons_Pls: "NCons (Pls,b)     = cond(b,Pls BIT b,Pls)"
   10.54 +  NCons_Min: "NCons (Min,b)     = cond(b,Min,Min BIT b)"
   10.55 +  NCons_BIT: "NCons (w BIT c,b) = w BIT c BIT b"
   10.56 +
   10.57 +primrec (*successor.  If a BIT, can change a 0 to a 1 without recursion.*)
   10.58 +  bin_succ_Pls:  "bin_succ (Pls)     = Pls BIT 1"
   10.59 +  bin_succ_Min:  "bin_succ (Min)     = Pls"
   10.60 +  bin_succ_BIT:  "bin_succ (w BIT b) = cond(b, bin_succ(w) BIT 0, NCons(w,1))"
   10.61 +
   10.62 +primrec (*predecessor*)
   10.63 +  bin_pred_Pls:  "bin_pred (Pls)     = Min"
   10.64 +  bin_pred_Min:  "bin_pred (Min)     = Min BIT 0"
   10.65 +  bin_pred_BIT:  "bin_pred (w BIT b) = cond(b, NCons(w,0), bin_pred(w) BIT 1)"
   10.66 +
   10.67 +primrec (*unary negation*)
   10.68 +  bin_minus_Pls:
   10.69 +    "bin_minus (Pls)       = Pls"
   10.70 +  bin_minus_Min:
   10.71 +    "bin_minus (Min)       = Pls BIT 1"
   10.72 +  bin_minus_BIT:
   10.73 +    "bin_minus (w BIT b) = cond(b, bin_pred(NCons(bin_minus(w),0)),
   10.74 +				bin_minus(w) BIT 0)"
   10.75 +
   10.76 +primrec (*sum*)
   10.77 +  bin_adder_Pls:
   10.78 +    "bin_adder (Pls)     = (lam w:bin. w)"
   10.79 +  bin_adder_Min:
   10.80 +    "bin_adder (Min)     = (lam w:bin. bin_pred(w))"
   10.81 +  bin_adder_BIT:
   10.82 +    "bin_adder (v BIT x) = 
   10.83 +       (lam w:bin. 
   10.84 +         bin_case (v BIT x, bin_pred(v BIT x), 
   10.85 +                   %w y. NCons(bin_adder (v) ` cond(x and y, bin_succ(w), w),  
   10.86 +                               x xor y),
   10.87 +                   w))"
   10.88 +
   10.89 +(*The bin_case above replaces the following mutually recursive function:
   10.90 +primrec
   10.91 +  "adding (v,x,Pls)     = v BIT x"
   10.92 +  "adding (v,x,Min)     = bin_pred(v BIT x)"
   10.93 +  "adding (v,x,w BIT y) = NCons(bin_adder (v, cond(x and y, bin_succ(w), w)), 
   10.94 +				x xor y)"
   10.95 +*)
   10.96 +
   10.97 +constdefs
   10.98 +  bin_add   :: "[i,i]=>i"
   10.99 +    "bin_add(v,w) == bin_adder(v)`w"
  10.100 +
  10.101 +
  10.102 +primrec
  10.103 +  bin_mult_Pls:
  10.104 +    "bin_mult (Pls,w)     = Pls"
  10.105 +  bin_mult_Min:
  10.106 +    "bin_mult (Min,w)     = bin_minus(w)"
  10.107 +  bin_mult_BIT:
  10.108 +    "bin_mult (v BIT b,w) = cond(b, bin_add(NCons(bin_mult(v,w),0),w),
  10.109 +				 NCons(bin_mult(v,w),0))"
  10.110 +
  10.111 +setup NumeralSyntax.setup
  10.112 +
  10.113 +
  10.114 +declare bin.intros [simp,TC]
  10.115 +
  10.116 +lemma NCons_Pls_0: "NCons(Pls,0) = Pls"
  10.117 +by simp
  10.118 +
  10.119 +lemma NCons_Pls_1: "NCons(Pls,1) = Pls BIT 1"
  10.120 +by simp
  10.121 +
  10.122 +lemma NCons_Min_0: "NCons(Min,0) = Min BIT 0"
  10.123 +by simp
  10.124 +
  10.125 +lemma NCons_Min_1: "NCons(Min,1) = Min"
  10.126 +by simp
  10.127 +
  10.128 +lemma NCons_BIT: "NCons(w BIT x,b) = w BIT x BIT b"
  10.129 +by (simp add: bin.case_eqns)
  10.130 +
  10.131 +lemmas NCons_simps [simp] = 
  10.132 +    NCons_Pls_0 NCons_Pls_1 NCons_Min_0 NCons_Min_1 NCons_BIT
  10.133 +
  10.134 +
  10.135 +
  10.136 +(** Type checking **)
  10.137 +
  10.138 +lemma integ_of_type [TC]: "w: bin ==> integ_of(w) : int"
  10.139 +apply (induct_tac "w")
  10.140 +apply (simp_all add: bool_into_nat)
  10.141 +done
  10.142 +
  10.143 +lemma NCons_type [TC]: "[| w: bin; b: bool |] ==> NCons(w,b) : bin"
  10.144 +by (induct_tac "w", auto)
  10.145 +
  10.146 +lemma bin_succ_type [TC]: "w: bin ==> bin_succ(w) : bin"
  10.147 +by (induct_tac "w", auto)
  10.148 +
  10.149 +lemma bin_pred_type [TC]: "w: bin ==> bin_pred(w) : bin"
  10.150 +by (induct_tac "w", auto)
  10.151 +
  10.152 +lemma bin_minus_type [TC]: "w: bin ==> bin_minus(w) : bin"
  10.153 +by (induct_tac "w", auto)
  10.154 +
  10.155 +(*This proof is complicated by the mutual recursion*)
  10.156 +lemma bin_add_type [rule_format,TC]:
  10.157 +     "v: bin ==> ALL w: bin. bin_add(v,w) : bin"
  10.158 +apply (unfold bin_add_def)
  10.159 +apply (induct_tac "v")
  10.160 +apply (rule_tac [3] ballI)
  10.161 +apply (rename_tac [3] "w'")
  10.162 +apply (induct_tac [3] "w'")
  10.163 +apply (simp_all add: NCons_type)
  10.164 +done
  10.165 +
  10.166 +lemma bin_mult_type [TC]: "[| v: bin; w: bin |] ==> bin_mult(v,w) : bin"
  10.167 +by (induct_tac "v", auto)
  10.168 +
  10.169 +
  10.170 +subsubsection{*The Carry and Borrow Functions, 
  10.171 +            @{term bin_succ} and @{term bin_pred}*}
  10.172 +
  10.173 +(*NCons preserves the integer value of its argument*)
  10.174 +lemma integ_of_NCons [simp]:
  10.175 +     "[| w: bin; b: bool |] ==> integ_of(NCons(w,b)) = integ_of(w BIT b)"
  10.176 +apply (erule bin.cases)
  10.177 +apply (auto elim!: boolE) 
  10.178 +done
  10.179 +
  10.180 +lemma integ_of_succ [simp]:
  10.181 +     "w: bin ==> integ_of(bin_succ(w)) = $#1 $+ integ_of(w)"
  10.182 +apply (erule bin.induct)
  10.183 +apply (auto simp add: zadd_ac elim!: boolE) 
  10.184 +done
  10.185 +
  10.186 +lemma integ_of_pred [simp]:
  10.187 +     "w: bin ==> integ_of(bin_pred(w)) = $- ($#1) $+ integ_of(w)"
  10.188 +apply (erule bin.induct)
  10.189 +apply (auto simp add: zadd_ac elim!: boolE) 
  10.190 +done
  10.191 +
  10.192 +
  10.193 +subsubsection{*@{term bin_minus}: Unary Negation of Binary Integers*}
  10.194 +
  10.195 +lemma integ_of_minus: "w: bin ==> integ_of(bin_minus(w)) = $- integ_of(w)"
  10.196 +apply (erule bin.induct)
  10.197 +apply (auto simp add: zadd_ac zminus_zadd_distrib  elim!: boolE) 
  10.198 +done
  10.199 +
  10.200 +
  10.201 +subsubsection{*@{term bin_add}: Binary Addition*}
  10.202 +
  10.203 +lemma bin_add_Pls [simp]: "w: bin ==> bin_add(Pls,w) = w"
  10.204 +by (unfold bin_add_def, simp)
  10.205 +
  10.206 +lemma bin_add_Pls_right: "w: bin ==> bin_add(w,Pls) = w"
  10.207 +apply (unfold bin_add_def)
  10.208 +apply (erule bin.induct, auto)
  10.209 +done
  10.210 +
  10.211 +lemma bin_add_Min [simp]: "w: bin ==> bin_add(Min,w) = bin_pred(w)"
  10.212 +by (unfold bin_add_def, simp)
  10.213 +
  10.214 +lemma bin_add_Min_right: "w: bin ==> bin_add(w,Min) = bin_pred(w)"
  10.215 +apply (unfold bin_add_def)
  10.216 +apply (erule bin.induct, auto)
  10.217 +done
  10.218 +
  10.219 +lemma bin_add_BIT_Pls [simp]: "bin_add(v BIT x,Pls) = v BIT x"
  10.220 +by (unfold bin_add_def, simp)
  10.221 +
  10.222 +lemma bin_add_BIT_Min [simp]: "bin_add(v BIT x,Min) = bin_pred(v BIT x)"
  10.223 +by (unfold bin_add_def, simp)
  10.224 +
  10.225 +lemma bin_add_BIT_BIT [simp]:
  10.226 +     "[| w: bin;  y: bool |]               
  10.227 +      ==> bin_add(v BIT x, w BIT y) =  
  10.228 +          NCons(bin_add(v, cond(x and y, bin_succ(w), w)), x xor y)"
  10.229 +by (unfold bin_add_def, simp)
  10.230 +
  10.231 +lemma integ_of_add [rule_format]:
  10.232 +     "v: bin ==>  
  10.233 +          ALL w: bin. integ_of(bin_add(v,w)) = integ_of(v) $+ integ_of(w)"
  10.234 +apply (erule bin.induct, simp, simp)
  10.235 +apply (rule ballI)
  10.236 +apply (induct_tac "wa")
  10.237 +apply (auto simp add: zadd_ac elim!: boolE) 
  10.238 +done
  10.239 +
  10.240 +(*Subtraction*)
  10.241 +lemma diff_integ_of_eq: 
  10.242 +     "[| v: bin;  w: bin |]    
  10.243 +      ==> integ_of(v) $- integ_of(w) = integ_of(bin_add (v, bin_minus(w)))"
  10.244 +apply (unfold zdiff_def)
  10.245 +apply (simp add: integ_of_add integ_of_minus)
  10.246 +done
  10.247 +
  10.248 +
  10.249 +subsubsection{*@{term bin_mult}: Binary Multiplication*}
  10.250 +
  10.251 +lemma integ_of_mult:
  10.252 +     "[| v: bin;  w: bin |]    
  10.253 +      ==> integ_of(bin_mult(v,w)) = integ_of(v) $* integ_of(w)"
  10.254 +apply (induct_tac "v", simp)
  10.255 +apply (simp add: integ_of_minus)
  10.256 +apply (auto simp add: zadd_ac integ_of_add zadd_zmult_distrib  elim!: boolE) 
  10.257 +done
  10.258 +
  10.259 +
  10.260 +subsection{*Computations*}
  10.261 +
  10.262 +(** extra rules for bin_succ, bin_pred **)
  10.263 +
  10.264 +lemma bin_succ_1: "bin_succ(w BIT 1) = bin_succ(w) BIT 0"
  10.265 +by simp
  10.266 +
  10.267 +lemma bin_succ_0: "bin_succ(w BIT 0) = NCons(w,1)"
  10.268 +by simp
  10.269 +
  10.270 +lemma bin_pred_1: "bin_pred(w BIT 1) = NCons(w,0)"
  10.271 +by simp
  10.272 +
  10.273 +lemma bin_pred_0: "bin_pred(w BIT 0) = bin_pred(w) BIT 1"
  10.274 +by simp
  10.275 +
  10.276 +(** extra rules for bin_minus **)
  10.277 +
  10.278 +lemma bin_minus_1: "bin_minus(w BIT 1) = bin_pred(NCons(bin_minus(w), 0))"
  10.279 +by simp
  10.280 +
  10.281 +lemma bin_minus_0: "bin_minus(w BIT 0) = bin_minus(w) BIT 0"
  10.282 +by simp
  10.283 +
  10.284 +(** extra rules for bin_add **)
  10.285 +
  10.286 +lemma bin_add_BIT_11: "w: bin ==> bin_add(v BIT 1, w BIT 1) =  
  10.287 +                     NCons(bin_add(v, bin_succ(w)), 0)"
  10.288 +by simp
  10.289 +
  10.290 +lemma bin_add_BIT_10: "w: bin ==> bin_add(v BIT 1, w BIT 0) =   
  10.291 +                     NCons(bin_add(v,w), 1)"
  10.292 +by simp
  10.293 +
  10.294 +lemma bin_add_BIT_0: "[| w: bin;  y: bool |]  
  10.295 +      ==> bin_add(v BIT 0, w BIT y) = NCons(bin_add(v,w), y)"
  10.296 +by simp
  10.297 +
  10.298 +(** extra rules for bin_mult **)
  10.299 +
  10.300 +lemma bin_mult_1: "bin_mult(v BIT 1, w) = bin_add(NCons(bin_mult(v,w),0), w)"
  10.301 +by simp
  10.302 +
  10.303 +lemma bin_mult_0: "bin_mult(v BIT 0, w) = NCons(bin_mult(v,w),0)"
  10.304 +by simp
  10.305 +
  10.306 +
  10.307 +(** Simplification rules with integer constants **)
  10.308 +
  10.309 +lemma int_of_0: "$#0 = #0"
  10.310 +by simp
  10.311 +
  10.312 +lemma int_of_succ: "$# succ(n) = #1 $+ $#n"
  10.313 +by (simp add: int_of_add [symmetric] natify_succ)
  10.314 +
  10.315 +lemma zminus_0 [simp]: "$- #0 = #0"
  10.316 +by simp
  10.317 +
  10.318 +lemma zadd_0_intify [simp]: "#0 $+ z = intify(z)"
  10.319 +by simp
  10.320 +
  10.321 +lemma zadd_0_right_intify [simp]: "z $+ #0 = intify(z)"
  10.322 +by simp
  10.323 +
  10.324 +lemma zmult_1_intify [simp]: "#1 $* z = intify(z)"
  10.325 +by simp
  10.326 +
  10.327 +lemma zmult_1_right_intify [simp]: "z $* #1 = intify(z)"
  10.328 +by (subst zmult_commute, simp)
  10.329 +
  10.330 +lemma zmult_0 [simp]: "#0 $* z = #0"
  10.331 +by simp
  10.332 +
  10.333 +lemma zmult_0_right [simp]: "z $* #0 = #0"
  10.334 +by (subst zmult_commute, simp)
  10.335 +
  10.336 +lemma zmult_minus1 [simp]: "#-1 $* z = $-z"
  10.337 +by (simp add: zcompare_rls)
  10.338 +
  10.339 +lemma zmult_minus1_right [simp]: "z $* #-1 = $-z"
  10.340 +apply (subst zmult_commute)
  10.341 +apply (rule zmult_minus1)
  10.342 +done
  10.343 +
  10.344 +
  10.345 +subsection{*Simplification Rules for Comparison of Binary Numbers*}
  10.346 +text{*Thanks to Norbert Voelker*}
  10.347 +
  10.348 +(** Equals (=) **)
  10.349 +
  10.350 +lemma eq_integ_of_eq: 
  10.351 +     "[| v: bin;  w: bin |]    
  10.352 +      ==> ((integ_of(v)) = integ_of(w)) <->  
  10.353 +          iszero (integ_of (bin_add (v, bin_minus(w))))"
  10.354 +apply (unfold iszero_def)
  10.355 +apply (simp add: zcompare_rls integ_of_add integ_of_minus)
  10.356 +done
  10.357 +
  10.358 +lemma iszero_integ_of_Pls: "iszero (integ_of(Pls))"
  10.359 +by (unfold iszero_def, simp)
  10.360 +
  10.361 +
  10.362 +lemma nonzero_integ_of_Min: "~ iszero (integ_of(Min))"
  10.363 +apply (unfold iszero_def)
  10.364 +apply (simp add: zminus_equation)
  10.365 +done
  10.366 +
  10.367 +lemma iszero_integ_of_BIT: 
  10.368 +     "[| w: bin; x: bool |]  
  10.369 +      ==> iszero (integ_of (w BIT x)) <-> (x=0 & iszero (integ_of(w)))"
  10.370 +apply (unfold iszero_def, simp)
  10.371 +apply (subgoal_tac "integ_of (w) : int")
  10.372 +apply typecheck
  10.373 +apply (drule int_cases)
  10.374 +apply (safe elim!: boolE)
  10.375 +apply (simp_all (asm_lr) add: zcompare_rls zminus_zadd_distrib [symmetric]
  10.376 +                     int_of_add [symmetric])
  10.377 +done
  10.378 +
  10.379 +lemma iszero_integ_of_0:
  10.380 +     "w: bin ==> iszero (integ_of (w BIT 0)) <-> iszero (integ_of(w))"
  10.381 +by (simp only: iszero_integ_of_BIT, blast) 
  10.382 +
  10.383 +lemma iszero_integ_of_1: "w: bin ==> ~ iszero (integ_of (w BIT 1))"
  10.384 +by (simp only: iszero_integ_of_BIT, blast)
  10.385 +
  10.386 +
  10.387 +
  10.388 +(** Less-than (<) **)
  10.389 +
  10.390 +lemma less_integ_of_eq_neg: 
  10.391 +     "[| v: bin;  w: bin |]    
  10.392 +      ==> integ_of(v) $< integ_of(w)  
  10.393 +          <-> znegative (integ_of (bin_add (v, bin_minus(w))))"
  10.394 +apply (unfold zless_def zdiff_def)
  10.395 +apply (simp add: integ_of_minus integ_of_add)
  10.396 +done
  10.397 +
  10.398 +lemma not_neg_integ_of_Pls: "~ znegative (integ_of(Pls))"
  10.399 +by simp
  10.400 +
  10.401 +lemma neg_integ_of_Min: "znegative (integ_of(Min))"
  10.402 +by simp
  10.403 +
  10.404 +lemma neg_integ_of_BIT:
  10.405 +     "[| w: bin; x: bool |]  
  10.406 +      ==> znegative (integ_of (w BIT x)) <-> znegative (integ_of(w))"
  10.407 +apply simp
  10.408 +apply (subgoal_tac "integ_of (w) : int")
  10.409 +apply typecheck
  10.410 +apply (drule int_cases)
  10.411 +apply (auto elim!: boolE simp add: int_of_add [symmetric]  zcompare_rls)
  10.412 +apply (simp_all add: zminus_zadd_distrib [symmetric] zdiff_def 
  10.413 +                     int_of_add [symmetric])
  10.414 +apply (subgoal_tac "$#1 $- $# succ (succ (n #+ n)) = $- $# succ (n #+ n) ")
  10.415 + apply (simp add: zdiff_def)
  10.416 +apply (simp add: equation_zminus int_of_diff [symmetric])
  10.417 +done
  10.418 +
  10.419 +(** Less-than-or-equals (<=) **)
  10.420 +
  10.421 +lemma le_integ_of_eq_not_less:
  10.422 +     "(integ_of(x) $<= (integ_of(w))) <-> ~ (integ_of(w) $< (integ_of(x)))"
  10.423 +by (simp add: not_zless_iff_zle [THEN iff_sym])
  10.424 +
  10.425 +
  10.426 +(*Delete the original rewrites, with their clumsy conditional expressions*)
  10.427 +declare bin_succ_BIT [simp del] 
  10.428 +        bin_pred_BIT [simp del] 
  10.429 +        bin_minus_BIT [simp del]
  10.430 +        NCons_Pls [simp del]
  10.431 +        NCons_Min [simp del]
  10.432 +        bin_adder_BIT [simp del]
  10.433 +        bin_mult_BIT [simp del]
  10.434 +
  10.435 +(*Hide the binary representation of integer constants*)
  10.436 +declare integ_of_Pls [simp del] integ_of_Min [simp del] integ_of_BIT [simp del]
  10.437 +
  10.438 +
  10.439 +lemmas bin_arith_extra_simps =
  10.440 +     integ_of_add [symmetric]   
  10.441 +     integ_of_minus [symmetric] 
  10.442 +     integ_of_mult [symmetric]  
  10.443 +     bin_succ_1 bin_succ_0 
  10.444 +     bin_pred_1 bin_pred_0 
  10.445 +     bin_minus_1 bin_minus_0  
  10.446 +     bin_add_Pls_right bin_add_Min_right
  10.447 +     bin_add_BIT_0 bin_add_BIT_10 bin_add_BIT_11
  10.448 +     diff_integ_of_eq
  10.449 +     bin_mult_1 bin_mult_0 NCons_simps
  10.450 +
  10.451 +
  10.452 +(*For making a minimal simpset, one must include these default simprules
  10.453 +  of thy.  Also include simp_thms, or at least (~False)=True*)
  10.454 +lemmas bin_arith_simps =
  10.455 +     bin_pred_Pls bin_pred_Min
  10.456 +     bin_succ_Pls bin_succ_Min
  10.457 +     bin_add_Pls bin_add_Min
  10.458 +     bin_minus_Pls bin_minus_Min
  10.459 +     bin_mult_Pls bin_mult_Min 
  10.460 +     bin_arith_extra_simps
  10.461 +
  10.462 +(*Simplification of relational operations*)
  10.463 +lemmas bin_rel_simps =
  10.464 +     eq_integ_of_eq iszero_integ_of_Pls nonzero_integ_of_Min
  10.465 +     iszero_integ_of_0 iszero_integ_of_1
  10.466 +     less_integ_of_eq_neg
  10.467 +     not_neg_integ_of_Pls neg_integ_of_Min neg_integ_of_BIT
  10.468 +     le_integ_of_eq_not_less
  10.469 +
  10.470 +declare bin_arith_simps [simp]
  10.471 +declare bin_rel_simps [simp]
  10.472 +
  10.473 +
  10.474 +(** Simplification of arithmetic when nested to the right **)
  10.475 +
  10.476 +lemma add_integ_of_left [simp]:
  10.477 +     "[| v: bin;  w: bin |]    
  10.478 +      ==> integ_of(v) $+ (integ_of(w) $+ z) = (integ_of(bin_add(v,w)) $+ z)"
  10.479 +by (simp add: zadd_assoc [symmetric])
  10.480 +
  10.481 +lemma mult_integ_of_left [simp]:
  10.482 +     "[| v: bin;  w: bin |]    
  10.483 +      ==> integ_of(v) $* (integ_of(w) $* z) = (integ_of(bin_mult(v,w)) $* z)"
  10.484 +by (simp add: zmult_assoc [symmetric])
  10.485 +
  10.486 +lemma add_integ_of_diff1 [simp]: 
  10.487 +    "[| v: bin;  w: bin |]    
  10.488 +      ==> integ_of(v) $+ (integ_of(w) $- c) = integ_of(bin_add(v,w)) $- (c)"
  10.489 +apply (unfold zdiff_def)
  10.490 +apply (rule add_integ_of_left, auto)
  10.491 +done
  10.492 +
  10.493 +lemma add_integ_of_diff2 [simp]:
  10.494 +     "[| v: bin;  w: bin |]    
  10.495 +      ==> integ_of(v) $+ (c $- integ_of(w)) =  
  10.496 +          integ_of (bin_add (v, bin_minus(w))) $+ (c)"
  10.497 +apply (subst diff_integ_of_eq [symmetric])
  10.498 +apply (simp_all add: zdiff_def zadd_ac)
  10.499 +done
  10.500 +
  10.501 +
  10.502 +(** More for integer constants **)
  10.503 +
  10.504 +declare int_of_0 [simp] int_of_succ [simp]
  10.505 +
  10.506 +lemma zdiff0 [simp]: "#0 $- x = $-x"
  10.507 +by (simp add: zdiff_def)
  10.508 +
  10.509 +lemma zdiff0_right [simp]: "x $- #0 = intify(x)"
  10.510 +by (simp add: zdiff_def)
  10.511 +
  10.512 +lemma zdiff_self [simp]: "x $- x = #0"
  10.513 +by (simp add: zdiff_def)
  10.514 +
  10.515 +lemma znegative_iff_zless_0: "k: int ==> znegative(k) <-> k $< #0"
  10.516 +by (simp add: zless_def)
  10.517 +
  10.518 +lemma zero_zless_imp_znegative_zminus: "[|#0 $< k; k: int|] ==> znegative($-k)"
  10.519 +by (simp add: zless_def)
  10.520 +
  10.521 +lemma zero_zle_int_of [simp]: "#0 $<= $# n"
  10.522 +by (simp add: not_zless_iff_zle [THEN iff_sym] znegative_iff_zless_0 [THEN iff_sym])
  10.523 +
  10.524 +lemma nat_of_0 [simp]: "nat_of(#0) = 0"
  10.525 +by (simp only: natify_0 int_of_0 [symmetric] nat_of_int_of)
  10.526 +
  10.527 +lemma nat_le_int0_lemma: "[| z $<= $#0; z: int |] ==> nat_of(z) = 0"
  10.528 +by (auto simp add: znegative_iff_zless_0 [THEN iff_sym] zle_def zneg_nat_of)
  10.529 +
  10.530 +lemma nat_le_int0: "z $<= $#0 ==> nat_of(z) = 0"
  10.531 +apply (subgoal_tac "nat_of (intify (z)) = 0")
  10.532 +apply (rule_tac [2] nat_le_int0_lemma, auto)
  10.533 +done
  10.534 +
  10.535 +lemma int_of_eq_0_imp_natify_eq_0: "$# n = #0 ==> natify(n) = 0"
  10.536 +by (rule not_znegative_imp_zero, auto)
  10.537 +
  10.538 +lemma nat_of_zminus_int_of: "nat_of($- $# n) = 0"
  10.539 +by (simp add: nat_of_def int_of_def raw_nat_of zminus image_intrel_int)
  10.540 +
  10.541 +lemma int_of_nat_of: "#0 $<= z ==> $# nat_of(z) = intify(z)"
  10.542 +apply (rule not_zneg_nat_of_intify)
  10.543 +apply (simp add: znegative_iff_zless_0 not_zless_iff_zle)
  10.544 +done
  10.545 +
  10.546 +declare int_of_nat_of [simp] nat_of_zminus_int_of [simp]
  10.547 +
  10.548 +lemma int_of_nat_of_if: "$# nat_of(z) = (if #0 $<= z then intify(z) else #0)"
  10.549 +by (simp add: int_of_nat_of znegative_iff_zless_0 not_zle_iff_zless)
  10.550 +
  10.551 +lemma zless_nat_iff_int_zless: "[| m: nat; z: int |] ==> (m < nat_of(z)) <-> ($#m $< z)"
  10.552 +apply (case_tac "znegative (z) ")
  10.553 +apply (erule_tac [2] not_zneg_nat_of [THEN subst])
  10.554 +apply (auto dest: zless_trans dest!: zero_zle_int_of [THEN zle_zless_trans]
  10.555 +            simp add: znegative_iff_zless_0)
  10.556 +done
  10.557 +
  10.558 +
  10.559 +(** nat_of and zless **)
  10.560 +
  10.561 +(*An alternative condition is  $#0 <= w  *)
  10.562 +lemma zless_nat_conj_lemma: "$#0 $< z ==> (nat_of(w) < nat_of(z)) <-> (w $< z)"
  10.563 +apply (rule iff_trans)
  10.564 +apply (rule zless_int_of [THEN iff_sym])
  10.565 +apply (auto simp add: int_of_nat_of_if simp del: zless_int_of)
  10.566 +apply (auto elim: zless_asym simp add: not_zle_iff_zless)
  10.567 +apply (blast intro: zless_zle_trans)
  10.568 +done
  10.569 +
  10.570 +lemma zless_nat_conj: "(nat_of(w) < nat_of(z)) <-> ($#0 $< z & w $< z)"
  10.571 +apply (case_tac "$#0 $< z")
  10.572 +apply (auto simp add: zless_nat_conj_lemma nat_le_int0 not_zless_iff_zle)
  10.573 +done
  10.574 +
  10.575 +(*This simprule cannot be added unless we can find a way to make eq_integ_of_eq
  10.576 +  unconditional!
  10.577 +  [The condition "True" is a hack to prevent looping.
  10.578 +    Conditional rewrite rules are tried after unconditional ones, so a rule
  10.579 +    like eq_nat_number_of will be tried first to eliminate #mm=#nn.]
  10.580 +  lemma integ_of_reorient [simp]:
  10.581 +       "True ==> (integ_of(w) = x) <-> (x = integ_of(w))"
  10.582 +  by auto
  10.583 +*)
  10.584 +
  10.585 +lemma integ_of_minus_reorient [simp]:
  10.586 +     "(integ_of(w) = $- x) <-> ($- x = integ_of(w))"
  10.587 +by auto
  10.588 +
  10.589 +lemma integ_of_add_reorient [simp]:
  10.590 +     "(integ_of(w) = x $+ y) <-> (x $+ y = integ_of(w))"
  10.591 +by auto
  10.592 +
  10.593 +lemma integ_of_diff_reorient [simp]:
  10.594 +     "(integ_of(w) = x $- y) <-> (x $- y = integ_of(w))"
  10.595 +by auto
  10.596 +
  10.597 +lemma integ_of_mult_reorient [simp]:
  10.598 +     "(integ_of(w) = x $* y) <-> (x $* y = integ_of(w))"
  10.599 +by auto
  10.600 +
  10.601 +ML
  10.602 +{*
  10.603 +val bin_pred_Pls = thm "bin_pred_Pls";
  10.604 +val bin_pred_Min = thm "bin_pred_Min";
  10.605 +val bin_minus_Pls = thm "bin_minus_Pls";
  10.606 +val bin_minus_Min = thm "bin_minus_Min";
  10.607 +
  10.608 +val NCons_Pls_0 = thm "NCons_Pls_0";
  10.609 +val NCons_Pls_1 = thm "NCons_Pls_1";
  10.610 +val NCons_Min_0 = thm "NCons_Min_0";
  10.611 +val NCons_Min_1 = thm "NCons_Min_1";
  10.612 +val NCons_BIT = thm "NCons_BIT";
  10.613 +val NCons_simps = thms "NCons_simps";
  10.614 +val integ_of_type = thm "integ_of_type";
  10.615 +val NCons_type = thm "NCons_type";
  10.616 +val bin_succ_type = thm "bin_succ_type";
  10.617 +val bin_pred_type = thm "bin_pred_type";
  10.618 +val bin_minus_type = thm "bin_minus_type";
  10.619 +val bin_add_type = thm "bin_add_type";
  10.620 +val bin_mult_type = thm "bin_mult_type";
  10.621 +val integ_of_NCons = thm "integ_of_NCons";
  10.622 +val integ_of_succ = thm "integ_of_succ";
  10.623 +val integ_of_pred = thm "integ_of_pred";
  10.624 +val integ_of_minus = thm "integ_of_minus";
  10.625 +val bin_add_Pls = thm "bin_add_Pls";
  10.626 +val bin_add_Pls_right = thm "bin_add_Pls_right";
  10.627 +val bin_add_Min = thm "bin_add_Min";
  10.628 +val bin_add_Min_right = thm "bin_add_Min_right";
  10.629 +val bin_add_BIT_Pls = thm "bin_add_BIT_Pls";
  10.630 +val bin_add_BIT_Min = thm "bin_add_BIT_Min";
  10.631 +val bin_add_BIT_BIT = thm "bin_add_BIT_BIT";
  10.632 +val integ_of_add = thm "integ_of_add";
  10.633 +val diff_integ_of_eq = thm "diff_integ_of_eq";
  10.634 +val integ_of_mult = thm "integ_of_mult";
  10.635 +val bin_succ_1 = thm "bin_succ_1";
  10.636 +val bin_succ_0 = thm "bin_succ_0";
  10.637 +val bin_pred_1 = thm "bin_pred_1";
  10.638 +val bin_pred_0 = thm "bin_pred_0";
  10.639 +val bin_minus_1 = thm "bin_minus_1";
  10.640 +val bin_minus_0 = thm "bin_minus_0";
  10.641 +val bin_add_BIT_11 = thm "bin_add_BIT_11";
  10.642 +val bin_add_BIT_10 = thm "bin_add_BIT_10";
  10.643 +val bin_add_BIT_0 = thm "bin_add_BIT_0";
  10.644 +val bin_mult_1 = thm "bin_mult_1";
  10.645 +val bin_mult_0 = thm "bin_mult_0";
  10.646 +val int_of_0 = thm "int_of_0";
  10.647 +val int_of_succ = thm "int_of_succ";
  10.648 +val zminus_0 = thm "zminus_0";
  10.649 +val zadd_0_intify = thm "zadd_0_intify";
  10.650 +val zadd_0_right_intify = thm "zadd_0_right_intify";
  10.651 +val zmult_1_intify = thm "zmult_1_intify";
  10.652 +val zmult_1_right_intify = thm "zmult_1_right_intify";
  10.653 +val zmult_0 = thm "zmult_0";
  10.654 +val zmult_0_right = thm "zmult_0_right";
  10.655 +val zmult_minus1 = thm "zmult_minus1";
  10.656 +val zmult_minus1_right = thm "zmult_minus1_right";
  10.657 +val eq_integ_of_eq = thm "eq_integ_of_eq";
  10.658 +val iszero_integ_of_Pls = thm "iszero_integ_of_Pls";
  10.659 +val nonzero_integ_of_Min = thm "nonzero_integ_of_Min";
  10.660 +val iszero_integ_of_BIT = thm "iszero_integ_of_BIT";
  10.661 +val iszero_integ_of_0 = thm "iszero_integ_of_0";
  10.662 +val iszero_integ_of_1 = thm "iszero_integ_of_1";
  10.663 +val less_integ_of_eq_neg = thm "less_integ_of_eq_neg";
  10.664 +val not_neg_integ_of_Pls = thm "not_neg_integ_of_Pls";
  10.665 +val neg_integ_of_Min = thm "neg_integ_of_Min";
  10.666 +val neg_integ_of_BIT = thm "neg_integ_of_BIT";
  10.667 +val le_integ_of_eq_not_less = thm "le_integ_of_eq_not_less";
  10.668 +val bin_arith_extra_simps = thms "bin_arith_extra_simps";
  10.669 +val bin_arith_simps = thms "bin_arith_simps";
  10.670 +val bin_rel_simps = thms "bin_rel_simps";
  10.671 +val add_integ_of_left = thm "add_integ_of_left";
  10.672 +val mult_integ_of_left = thm "mult_integ_of_left";
  10.673 +val add_integ_of_diff1 = thm "add_integ_of_diff1";
  10.674 +val add_integ_of_diff2 = thm "add_integ_of_diff2";
  10.675 +val zdiff0 = thm "zdiff0";
  10.676 +val zdiff0_right = thm "zdiff0_right";
  10.677 +val zdiff_self = thm "zdiff_self";
  10.678 +val znegative_iff_zless_0 = thm "znegative_iff_zless_0";
  10.679 +val zero_zless_imp_znegative_zminus = thm "zero_zless_imp_znegative_zminus";
  10.680 +val zero_zle_int_of = thm "zero_zle_int_of";
  10.681 +val nat_of_0 = thm "nat_of_0";
  10.682 +val nat_le_int0 = thm "nat_le_int0";
  10.683 +val int_of_eq_0_imp_natify_eq_0 = thm "int_of_eq_0_imp_natify_eq_0";
  10.684 +val nat_of_zminus_int_of = thm "nat_of_zminus_int_of";
  10.685 +val int_of_nat_of = thm "int_of_nat_of";
  10.686 +val int_of_nat_of_if = thm "int_of_nat_of_if";
  10.687 +val zless_nat_iff_int_zless = thm "zless_nat_iff_int_zless";
  10.688 +val zless_nat_conj = thm "zless_nat_conj";
  10.689 +val integ_of_minus_reorient = thm "integ_of_minus_reorient";
  10.690 +val integ_of_add_reorient = thm "integ_of_add_reorient";
  10.691 +val integ_of_diff_reorient = thm "integ_of_diff_reorient";
  10.692 +val integ_of_mult_reorient = thm "integ_of_mult_reorient";
  10.693 +*}
  10.694 +
  10.695 +end
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/ZF/EquivClass.thy	Thu May 31 12:06:31 2007 +0200
    11.3 @@ -0,0 +1,265 @@
    11.4 +(*  Title:      ZF/EquivClass.thy
    11.5 +    ID:         $Id$
    11.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    11.7 +    Copyright   1994  University of Cambridge
    11.8 +
    11.9 +*)
   11.10 +
   11.11 +header{*Equivalence Relations*}
   11.12 +
   11.13 +theory EquivClass imports Trancl Perm begin
   11.14 +
   11.15 +constdefs
   11.16 +
   11.17 +  quotient   :: "[i,i]=>i"    (infixl "'/'/" 90)  (*set of equiv classes*)
   11.18 +      "A//r == {r``{x} . x:A}"
   11.19 +
   11.20 +  congruent  :: "[i,i=>i]=>o"
   11.21 +      "congruent(r,b) == ALL y z. <y,z>:r --> b(y)=b(z)"
   11.22 +
   11.23 +  congruent2 :: "[i,i,[i,i]=>i]=>o"
   11.24 +      "congruent2(r1,r2,b) == ALL y1 z1 y2 z2.
   11.25 +           <y1,z1>:r1 --> <y2,z2>:r2 --> b(y1,y2) = b(z1,z2)"
   11.26 +
   11.27 +syntax
   11.28 +  RESPECTS ::"[i=>i, i] => o"  (infixr "respects" 80)
   11.29 +  RESPECTS2 ::"[i=>i, i] => o"  (infixr "respects2 " 80)
   11.30 +    --{*Abbreviation for the common case where the relations are identical*}
   11.31 +
   11.32 +translations
   11.33 +  "f respects r" == "congruent(r,f)"
   11.34 +  "f respects2 r" => "congruent2(r,r,f)"
   11.35 +
   11.36 +subsection{*Suppes, Theorem 70:
   11.37 +    @{term r} is an equiv relation iff @{term "converse(r) O r = r"}*}
   11.38 +
   11.39 +(** first half: equiv(A,r) ==> converse(r) O r = r **)
   11.40 +
   11.41 +lemma sym_trans_comp_subset:
   11.42 +    "[| sym(r); trans(r) |] ==> converse(r) O r <= r"
   11.43 +by (unfold trans_def sym_def, blast)
   11.44 +
   11.45 +lemma refl_comp_subset:
   11.46 +    "[| refl(A,r); r <= A*A |] ==> r <= converse(r) O r"
   11.47 +by (unfold refl_def, blast)
   11.48 +
   11.49 +lemma equiv_comp_eq:
   11.50 +    "equiv(A,r) ==> converse(r) O r = r"
   11.51 +apply (unfold equiv_def)
   11.52 +apply (blast del: subsetI intro!: sym_trans_comp_subset refl_comp_subset)
   11.53 +done
   11.54 +
   11.55 +(*second half*)
   11.56 +lemma comp_equivI:
   11.57 +    "[| converse(r) O r = r;  domain(r) = A |] ==> equiv(A,r)"
   11.58 +apply (unfold equiv_def refl_def sym_def trans_def)
   11.59 +apply (erule equalityE)
   11.60 +apply (subgoal_tac "ALL x y. <x,y> : r --> <y,x> : r", blast+)
   11.61 +done
   11.62 +
   11.63 +(** Equivalence classes **)
   11.64 +
   11.65 +(*Lemma for the next result*)
   11.66 +lemma equiv_class_subset:
   11.67 +    "[| sym(r);  trans(r);  <a,b>: r |] ==> r``{a} <= r``{b}"
   11.68 +by (unfold trans_def sym_def, blast)
   11.69 +
   11.70 +lemma equiv_class_eq:
   11.71 +    "[| equiv(A,r);  <a,b>: r |] ==> r``{a} = r``{b}"
   11.72 +apply (unfold equiv_def)
   11.73 +apply (safe del: subsetI intro!: equalityI equiv_class_subset)
   11.74 +apply (unfold sym_def, blast)
   11.75 +done
   11.76 +
   11.77 +lemma equiv_class_self:
   11.78 +    "[| equiv(A,r);  a: A |] ==> a: r``{a}"
   11.79 +by (unfold equiv_def refl_def, blast)
   11.80 +
   11.81 +(*Lemma for the next result*)
   11.82 +lemma subset_equiv_class:
   11.83 +    "[| equiv(A,r);  r``{b} <= r``{a};  b: A |] ==> <a,b>: r"
   11.84 +by (unfold equiv_def refl_def, blast)
   11.85 +
   11.86 +lemma eq_equiv_class: "[| r``{a} = r``{b};  equiv(A,r);  b: A |] ==> <a,b>: r"
   11.87 +by (assumption | rule equalityD2 subset_equiv_class)+
   11.88 +
   11.89 +(*thus r``{a} = r``{b} as well*)
   11.90 +lemma equiv_class_nondisjoint:
   11.91 +    "[| equiv(A,r);  x: (r``{a} Int r``{b}) |] ==> <a,b>: r"
   11.92 +by (unfold equiv_def trans_def sym_def, blast)
   11.93 +
   11.94 +lemma equiv_type: "equiv(A,r) ==> r <= A*A"
   11.95 +by (unfold equiv_def, blast)
   11.96 +
   11.97 +lemma equiv_class_eq_iff:
   11.98 +     "equiv(A,r) ==> <x,y>: r <-> r``{x} = r``{y} & x:A & y:A"
   11.99 +by (blast intro: eq_equiv_class equiv_class_eq dest: equiv_type)
  11.100 +
  11.101 +lemma eq_equiv_class_iff:
  11.102 +     "[| equiv(A,r);  x: A;  y: A |] ==> r``{x} = r``{y} <-> <x,y>: r"
  11.103 +by (blast intro: eq_equiv_class equiv_class_eq dest: equiv_type)
  11.104 +
  11.105 +(*** Quotients ***)
  11.106 +
  11.107 +(** Introduction/elimination rules -- needed? **)
  11.108 +
  11.109 +lemma quotientI [TC]: "x:A ==> r``{x}: A//r"
  11.110 +apply (unfold quotient_def)
  11.111 +apply (erule RepFunI)
  11.112 +done
  11.113 +
  11.114 +lemma quotientE:
  11.115 +    "[| X: A//r;  !!x. [| X = r``{x};  x:A |] ==> P |] ==> P"
  11.116 +by (unfold quotient_def, blast)
  11.117 +
  11.118 +lemma Union_quotient:
  11.119 +    "equiv(A,r) ==> Union(A//r) = A"
  11.120 +by (unfold equiv_def refl_def quotient_def, blast)
  11.121 +
  11.122 +lemma quotient_disj:
  11.123 +    "[| equiv(A,r);  X: A//r;  Y: A//r |] ==> X=Y | (X Int Y <= 0)"
  11.124 +apply (unfold quotient_def)
  11.125 +apply (safe intro!: equiv_class_eq, assumption)
  11.126 +apply (unfold equiv_def trans_def sym_def, blast)
  11.127 +done
  11.128 +
  11.129 +subsection{*Defining Unary Operations upon Equivalence Classes*}
  11.130 +
  11.131 +(** Could have a locale with the premises equiv(A,r)  and  congruent(r,b)
  11.132 +**)
  11.133 +
  11.134 +(*Conversion rule*)
  11.135 +lemma UN_equiv_class:
  11.136 +    "[| equiv(A,r);  b respects r;  a: A |] ==> (UN x:r``{a}. b(x)) = b(a)"
  11.137 +apply (subgoal_tac "\<forall>x \<in> r``{a}. b(x) = b(a)") 
  11.138 + apply simp
  11.139 + apply (blast intro: equiv_class_self)  
  11.140 +apply (unfold equiv_def sym_def congruent_def, blast)
  11.141 +done
  11.142 +
  11.143 +(*type checking of  UN x:r``{a}. b(x) *)
  11.144 +lemma UN_equiv_class_type:
  11.145 +    "[| equiv(A,r);  b respects r;  X: A//r;  !!x.  x : A ==> b(x) : B |]
  11.146 +     ==> (UN x:X. b(x)) : B"
  11.147 +apply (unfold quotient_def, safe)
  11.148 +apply (simp (no_asm_simp) add: UN_equiv_class)
  11.149 +done
  11.150 +
  11.151 +(*Sufficient conditions for injectiveness.  Could weaken premises!
  11.152 +  major premise could be an inclusion; bcong could be !!y. y:A ==> b(y):B
  11.153 +*)
  11.154 +lemma UN_equiv_class_inject:
  11.155 +    "[| equiv(A,r);   b respects r;
  11.156 +        (UN x:X. b(x))=(UN y:Y. b(y));  X: A//r;  Y: A//r;
  11.157 +        !!x y. [| x:A; y:A; b(x)=b(y) |] ==> <x,y>:r |]
  11.158 +     ==> X=Y"
  11.159 +apply (unfold quotient_def, safe)
  11.160 +apply (rule equiv_class_eq, assumption)
  11.161 +apply (simp add: UN_equiv_class [of A r b])  
  11.162 +done
  11.163 +
  11.164 +
  11.165 +subsection{*Defining Binary Operations upon Equivalence Classes*}
  11.166 +
  11.167 +lemma congruent2_implies_congruent:
  11.168 +    "[| equiv(A,r1);  congruent2(r1,r2,b);  a: A |] ==> congruent(r2,b(a))"
  11.169 +by (unfold congruent_def congruent2_def equiv_def refl_def, blast)
  11.170 +
  11.171 +lemma congruent2_implies_congruent_UN:
  11.172 +    "[| equiv(A1,r1);  equiv(A2,r2);  congruent2(r1,r2,b);  a: A2 |] ==>
  11.173 +     congruent(r1, %x1. \<Union>x2 \<in> r2``{a}. b(x1,x2))"
  11.174 +apply (unfold congruent_def, safe)
  11.175 +apply (frule equiv_type [THEN subsetD], assumption)
  11.176 +apply clarify 
  11.177 +apply (simp add: UN_equiv_class congruent2_implies_congruent)
  11.178 +apply (unfold congruent2_def equiv_def refl_def, blast)
  11.179 +done
  11.180 +
  11.181 +lemma UN_equiv_class2:
  11.182 +    "[| equiv(A1,r1);  equiv(A2,r2);  congruent2(r1,r2,b);  a1: A1;  a2: A2 |]
  11.183 +     ==> (\<Union>x1 \<in> r1``{a1}. \<Union>x2 \<in> r2``{a2}. b(x1,x2)) = b(a1,a2)"
  11.184 +by (simp add: UN_equiv_class congruent2_implies_congruent
  11.185 +              congruent2_implies_congruent_UN)
  11.186 +
  11.187 +(*type checking*)
  11.188 +lemma UN_equiv_class_type2:
  11.189 +    "[| equiv(A,r);  b respects2 r;
  11.190 +        X1: A//r;  X2: A//r;
  11.191 +        !!x1 x2.  [| x1: A; x2: A |] ==> b(x1,x2) : B
  11.192 +     |] ==> (UN x1:X1. UN x2:X2. b(x1,x2)) : B"
  11.193 +apply (unfold quotient_def, safe)
  11.194 +apply (blast intro: UN_equiv_class_type congruent2_implies_congruent_UN 
  11.195 +                    congruent2_implies_congruent quotientI)
  11.196 +done
  11.197 +
  11.198 +
  11.199 +(*Suggested by John Harrison -- the two subproofs may be MUCH simpler
  11.200 +  than the direct proof*)
  11.201 +lemma congruent2I:
  11.202 +    "[|  equiv(A1,r1);  equiv(A2,r2);  
  11.203 +        !! y z w. [| w \<in> A2;  <y,z> \<in> r1 |] ==> b(y,w) = b(z,w);
  11.204 +        !! y z w. [| w \<in> A1;  <y,z> \<in> r2 |] ==> b(w,y) = b(w,z)
  11.205 +     |] ==> congruent2(r1,r2,b)"
  11.206 +apply (unfold congruent2_def equiv_def refl_def, safe)
  11.207 +apply (blast intro: trans) 
  11.208 +done
  11.209 +
  11.210 +lemma congruent2_commuteI:
  11.211 + assumes equivA: "equiv(A,r)"
  11.212 +     and commute: "!! y z. [| y: A;  z: A |] ==> b(y,z) = b(z,y)"
  11.213 +     and congt:   "!! y z w. [| w: A;  <y,z>: r |] ==> b(w,y) = b(w,z)"
  11.214 + shows "b respects2 r"
  11.215 +apply (insert equivA [THEN equiv_type, THEN subsetD]) 
  11.216 +apply (rule congruent2I [OF equivA equivA])
  11.217 +apply (rule commute [THEN trans])
  11.218 +apply (rule_tac [3] commute [THEN trans, symmetric])
  11.219 +apply (rule_tac [5] sym) 
  11.220 +apply (blast intro: congt)+
  11.221 +done
  11.222 +
  11.223 +(*Obsolete?*)
  11.224 +lemma congruent_commuteI:
  11.225 +    "[| equiv(A,r);  Z: A//r;
  11.226 +        !!w. [| w: A |] ==> congruent(r, %z. b(w,z));
  11.227 +        !!x y. [| x: A;  y: A |] ==> b(y,x) = b(x,y)
  11.228 +     |] ==> congruent(r, %w. UN z: Z. b(w,z))"
  11.229 +apply (simp (no_asm) add: congruent_def)
  11.230 +apply (safe elim!: quotientE)
  11.231 +apply (frule equiv_type [THEN subsetD], assumption)
  11.232 +apply (simp add: UN_equiv_class [of A r]) 
  11.233 +apply (simp add: congruent_def) 
  11.234 +done
  11.235 +
  11.236 +ML
  11.237 +{*
  11.238 +val sym_trans_comp_subset = thm "sym_trans_comp_subset";
  11.239 +val refl_comp_subset = thm "refl_comp_subset";
  11.240 +val equiv_comp_eq = thm "equiv_comp_eq";
  11.241 +val comp_equivI = thm "comp_equivI";
  11.242 +val equiv_class_subset = thm "equiv_class_subset";
  11.243 +val equiv_class_eq = thm "equiv_class_eq";
  11.244 +val equiv_class_self = thm "equiv_class_self";
  11.245 +val subset_equiv_class = thm "subset_equiv_class";
  11.246 +val eq_equiv_class = thm "eq_equiv_class";
  11.247 +val equiv_class_nondisjoint = thm "equiv_class_nondisjoint";
  11.248 +val equiv_type = thm "equiv_type";
  11.249 +val equiv_class_eq_iff = thm "equiv_class_eq_iff";
  11.250 +val eq_equiv_class_iff = thm "eq_equiv_class_iff";
  11.251 +val quotientI = thm "quotientI";
  11.252 +val quotientE = thm "quotientE";
  11.253 +val Union_quotient = thm "Union_quotient";
  11.254 +val quotient_disj = thm "quotient_disj";
  11.255 +val UN_equiv_class = thm "UN_equiv_class";
  11.256 +val UN_equiv_class_type = thm "UN_equiv_class_type";
  11.257 +val UN_equiv_class_inject = thm "UN_equiv_class_inject";
  11.258 +val congruent2_implies_congruent = thm "congruent2_implies_congruent";
  11.259 +val congruent2_implies_congruent_UN = thm "congruent2_implies_congruent_UN";
  11.260 +val congruent_commuteI = thm "congruent_commuteI";
  11.261 +val UN_equiv_class2 = thm "UN_equiv_class2";
  11.262 +val UN_equiv_class_type2 = thm "UN_equiv_class_type2";
  11.263 +val congruent2I = thm "congruent2I";
  11.264 +val congruent2_commuteI = thm "congruent2_commuteI";
  11.265 +val congruent_commuteI = thm "congruent_commuteI";
  11.266 +*}
  11.267 +
  11.268 +end
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/ZF/Int.thy	Thu May 31 12:06:31 2007 +0200
    12.3 @@ -0,0 +1,1057 @@
    12.4 +(*  Title:      ZF/Int.thy
    12.5 +    ID:         $Id$
    12.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    12.7 +    Copyright   1993  University of Cambridge
    12.8 +
    12.9 +*)
   12.10 +
   12.11 +header{*The Integers as Equivalence Classes Over Pairs of Natural Numbers*}
   12.12 +
   12.13 +theory Int imports EquivClass ArithSimp begin
   12.14 +
   12.15 +constdefs
   12.16 +  intrel :: i
   12.17 +    "intrel == {p : (nat*nat)*(nat*nat).                 
   12.18 +                \<exists>x1 y1 x2 y2. p=<<x1,y1>,<x2,y2>> & x1#+y2 = x2#+y1}"
   12.19 +
   12.20 +  int :: i
   12.21 +    "int == (nat*nat)//intrel"  
   12.22 +
   12.23 +  int_of :: "i=>i" --{*coercion from nat to int*}    ("$# _" [80] 80)
   12.24 +    "$# m == intrel `` {<natify(m), 0>}"
   12.25 +
   12.26 +  intify :: "i=>i" --{*coercion from ANYTHING to int*}
   12.27 +    "intify(m) == if m : int then m else $#0"
   12.28 +
   12.29 +  raw_zminus :: "i=>i"
   12.30 +    "raw_zminus(z) == \<Union><x,y>\<in>z. intrel``{<y,x>}"
   12.31 +
   12.32 +  zminus :: "i=>i"                                 ("$- _" [80] 80)
   12.33 +    "$- z == raw_zminus (intify(z))"
   12.34 +
   12.35 +  znegative   ::      "i=>o"
   12.36 +    "znegative(z) == \<exists>x y. x<y & y\<in>nat & <x,y>\<in>z"
   12.37 +
   12.38 +  iszero      ::      "i=>o"
   12.39 +    "iszero(z) == z = $# 0"
   12.40 +    
   12.41 +  raw_nat_of  :: "i=>i"
   12.42 +  "raw_nat_of(z) == natify (\<Union><x,y>\<in>z. x#-y)"
   12.43 +
   12.44 +  nat_of  :: "i=>i"
   12.45 +  "nat_of(z) == raw_nat_of (intify(z))"
   12.46 +
   12.47 +  zmagnitude  ::      "i=>i"
   12.48 +  --{*could be replaced by an absolute value function from int to int?*}
   12.49 +    "zmagnitude(z) ==
   12.50 +     THE m. m\<in>nat & ((~ znegative(z) & z = $# m) |
   12.51 +		       (znegative(z) & $- z = $# m))"
   12.52 +
   12.53 +  raw_zmult   ::      "[i,i]=>i"
   12.54 +    (*Cannot use UN<x1,y2> here or in zadd because of the form of congruent2.
   12.55 +      Perhaps a "curried" or even polymorphic congruent predicate would be
   12.56 +      better.*)
   12.57 +     "raw_zmult(z1,z2) == 
   12.58 +       \<Union>p1\<in>z1. \<Union>p2\<in>z2.  split(%x1 y1. split(%x2 y2.        
   12.59 +                   intrel``{<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}, p2), p1)"
   12.60 +
   12.61 +  zmult       ::      "[i,i]=>i"      (infixl "$*" 70)
   12.62 +     "z1 $* z2 == raw_zmult (intify(z1),intify(z2))"
   12.63 +
   12.64 +  raw_zadd    ::      "[i,i]=>i"
   12.65 +     "raw_zadd (z1, z2) == 
   12.66 +       \<Union>z1\<in>z1. \<Union>z2\<in>z2. let <x1,y1>=z1; <x2,y2>=z2                 
   12.67 +                           in intrel``{<x1#+x2, y1#+y2>}"
   12.68 +
   12.69 +  zadd        ::      "[i,i]=>i"      (infixl "$+" 65)
   12.70 +     "z1 $+ z2 == raw_zadd (intify(z1),intify(z2))"
   12.71 +
   12.72 +  zdiff        ::      "[i,i]=>i"      (infixl "$-" 65)
   12.73 +     "z1 $- z2 == z1 $+ zminus(z2)"
   12.74 +
   12.75 +  zless        ::      "[i,i]=>o"      (infixl "$<" 50)
   12.76 +     "z1 $< z2 == znegative(z1 $- z2)"
   12.77 +  
   12.78 +  zle          ::      "[i,i]=>o"      (infixl "$<=" 50)
   12.79 +     "z1 $<= z2 == z1 $< z2 | intify(z1)=intify(z2)"
   12.80 +  
   12.81 +
   12.82 +syntax (xsymbols)
   12.83 +  zmult :: "[i,i]=>i"          (infixl "$\<times>" 70)
   12.84 +  zle   :: "[i,i]=>o"          (infixl "$\<le>" 50)  --{*less than or equals*}
   12.85 +
   12.86 +syntax (HTML output)
   12.87 +  zmult :: "[i,i]=>i"          (infixl "$\<times>" 70)
   12.88 +  zle   :: "[i,i]=>o"          (infixl "$\<le>" 50)
   12.89 +
   12.90 +
   12.91 +declare quotientE [elim!]
   12.92 +
   12.93 +subsection{*Proving that @{term intrel} is an equivalence relation*}
   12.94 +
   12.95 +(** Natural deduction for intrel **)
   12.96 +
   12.97 +lemma intrel_iff [simp]: 
   12.98 +    "<<x1,y1>,<x2,y2>>: intrel <->  
   12.99 +     x1\<in>nat & y1\<in>nat & x2\<in>nat & y2\<in>nat & x1#+y2 = x2#+y1"
  12.100 +by (simp add: intrel_def)
  12.101 +
  12.102 +lemma intrelI [intro!]: 
  12.103 +    "[| x1#+y2 = x2#+y1; x1\<in>nat; y1\<in>nat; x2\<in>nat; y2\<in>nat |]   
  12.104 +     ==> <<x1,y1>,<x2,y2>>: intrel"
  12.105 +by (simp add: intrel_def)
  12.106 +
  12.107 +lemma intrelE [elim!]:
  12.108 +  "[| p: intrel;   
  12.109 +      !!x1 y1 x2 y2. [| p = <<x1,y1>,<x2,y2>>;  x1#+y2 = x2#+y1;  
  12.110 +                        x1\<in>nat; y1\<in>nat; x2\<in>nat; y2\<in>nat |] ==> Q |]  
  12.111 +   ==> Q"
  12.112 +by (simp add: intrel_def, blast) 
  12.113 +
  12.114 +lemma int_trans_lemma:
  12.115 +     "[| x1 #+ y2 = x2 #+ y1; x2 #+ y3 = x3 #+ y2 |] ==> x1 #+ y3 = x3 #+ y1"
  12.116 +apply (rule sym)
  12.117 +apply (erule add_left_cancel)+
  12.118 +apply (simp_all (no_asm_simp))
  12.119 +done
  12.120 +
  12.121 +lemma equiv_intrel: "equiv(nat*nat, intrel)"
  12.122 +apply (simp add: equiv_def refl_def sym_def trans_def)
  12.123 +apply (fast elim!: sym int_trans_lemma)
  12.124 +done
  12.125 +
  12.126 +lemma image_intrel_int: "[| m\<in>nat; n\<in>nat |] ==> intrel `` {<m,n>} : int"
  12.127 +by (simp add: int_def)
  12.128 +
  12.129 +declare equiv_intrel [THEN eq_equiv_class_iff, simp]
  12.130 +declare conj_cong [cong]
  12.131 +
  12.132 +lemmas eq_intrelD = eq_equiv_class [OF _ equiv_intrel]
  12.133 +
  12.134 +(** int_of: the injection from nat to int **)
  12.135 +
  12.136 +lemma int_of_type [simp,TC]: "$#m : int"
  12.137 +by (simp add: int_def quotient_def int_of_def, auto)
  12.138 +
  12.139 +lemma int_of_eq [iff]: "($# m = $# n) <-> natify(m)=natify(n)"
  12.140 +by (simp add: int_of_def)
  12.141 +
  12.142 +lemma int_of_inject: "[| $#m = $#n;  m\<in>nat;  n\<in>nat |] ==> m=n"
  12.143 +by (drule int_of_eq [THEN iffD1], auto)
  12.144 +
  12.145 +
  12.146 +(** intify: coercion from anything to int **)
  12.147 +
  12.148 +lemma intify_in_int [iff,TC]: "intify(x) : int"
  12.149 +by (simp add: intify_def)
  12.150 +
  12.151 +lemma intify_ident [simp]: "n : int ==> intify(n) = n"
  12.152 +by (simp add: intify_def)
  12.153 +
  12.154 +
  12.155 +subsection{*Collapsing rules: to remove @{term intify}
  12.156 +            from arithmetic expressions*}
  12.157 +
  12.158 +lemma intify_idem [simp]: "intify(intify(x)) = intify(x)"
  12.159 +by simp
  12.160 +
  12.161 +lemma int_of_natify [simp]: "$# (natify(m)) = $# m"
  12.162 +by (simp add: int_of_def)
  12.163 +
  12.164 +lemma zminus_intify [simp]: "$- (intify(m)) = $- m"
  12.165 +by (simp add: zminus_def)
  12.166 +
  12.167 +(** Addition **)
  12.168 +
  12.169 +lemma zadd_intify1 [simp]: "intify(x) $+ y = x $+ y"
  12.170 +by (simp add: zadd_def)
  12.171 +
  12.172 +lemma zadd_intify2 [simp]: "x $+ intify(y) = x $+ y"
  12.173 +by (simp add: zadd_def)
  12.174 +
  12.175 +(** Subtraction **)
  12.176 +
  12.177 +lemma zdiff_intify1 [simp]:"intify(x) $- y = x $- y"
  12.178 +by (simp add: zdiff_def)
  12.179 +
  12.180 +lemma zdiff_intify2 [simp]:"x $- intify(y) = x $- y"
  12.181 +by (simp add: zdiff_def)
  12.182 +
  12.183 +(** Multiplication **)
  12.184 +
  12.185 +lemma zmult_intify1 [simp]:"intify(x) $* y = x $* y"
  12.186 +by (simp add: zmult_def)
  12.187 +
  12.188 +lemma zmult_intify2 [simp]:"x $* intify(y) = x $* y"
  12.189 +by (simp add: zmult_def)
  12.190 +
  12.191 +(** Orderings **)
  12.192 +
  12.193 +lemma zless_intify1 [simp]:"intify(x) $< y <-> x $< y"
  12.194 +by (simp add: zless_def)
  12.195 +
  12.196 +lemma zless_intify2 [simp]:"x $< intify(y) <-> x $< y"
  12.197 +by (simp add: zless_def)
  12.198 +
  12.199 +lemma zle_intify1 [simp]:"intify(x) $<= y <-> x $<= y"
  12.200 +by (simp add: zle_def)
  12.201 +
  12.202 +lemma zle_intify2 [simp]:"x $<= intify(y) <-> x $<= y"
  12.203 +by (simp add: zle_def)
  12.204 +
  12.205 +
  12.206 +subsection{*@{term zminus}: unary negation on @{term int}*}
  12.207 +
  12.208 +lemma zminus_congruent: "(%<x,y>. intrel``{<y,x>}) respects intrel"
  12.209 +by (auto simp add: congruent_def add_ac)
  12.210 +
  12.211 +lemma raw_zminus_type: "z : int ==> raw_zminus(z) : int"
  12.212 +apply (simp add: int_def raw_zminus_def)
  12.213 +apply (typecheck add: UN_equiv_class_type [OF equiv_intrel zminus_congruent])
  12.214 +done
  12.215 +
  12.216 +lemma zminus_type [TC,iff]: "$-z : int"
  12.217 +by (simp add: zminus_def raw_zminus_type)
  12.218 +
  12.219 +lemma raw_zminus_inject: 
  12.220 +     "[| raw_zminus(z) = raw_zminus(w);  z: int;  w: int |] ==> z=w"
  12.221 +apply (simp add: int_def raw_zminus_def)
  12.222 +apply (erule UN_equiv_class_inject [OF equiv_intrel zminus_congruent], safe)
  12.223 +apply (auto dest: eq_intrelD simp add: add_ac)
  12.224 +done
  12.225 +
  12.226 +lemma zminus_inject_intify [dest!]: "$-z = $-w ==> intify(z) = intify(w)"
  12.227 +apply (simp add: zminus_def)
  12.228 +apply (blast dest!: raw_zminus_inject)
  12.229 +done
  12.230 +
  12.231 +lemma zminus_inject: "[| $-z = $-w;  z: int;  w: int |] ==> z=w"
  12.232 +by auto
  12.233 +
  12.234 +lemma raw_zminus: 
  12.235 +    "[| x\<in>nat;  y\<in>nat |] ==> raw_zminus(intrel``{<x,y>}) = intrel `` {<y,x>}"
  12.236 +apply (simp add: raw_zminus_def UN_equiv_class [OF equiv_intrel zminus_congruent])
  12.237 +done
  12.238 +
  12.239 +lemma zminus: 
  12.240 +    "[| x\<in>nat;  y\<in>nat |]  
  12.241 +     ==> $- (intrel``{<x,y>}) = intrel `