1.1 --- a/src/HOL/Dense_Linear_Order.thy Thu Jun 21 20:48:47 2007 +0200
1.2 +++ b/src/HOL/Dense_Linear_Order.thy Thu Jun 21 20:48:48 2007 +0200
1.3 @@ -9,9 +9,9 @@
1.4 theory Dense_Linear_Order
1.5 imports Finite_Set
1.6 uses
1.7 - "Tools/qelim.ML"
1.8 - "Tools/Ferrante_Rackoff/ferrante_rackoff_data.ML"
1.9 - ("Tools/Ferrante_Rackoff/ferrante_rackoff.ML")
1.10 + "Tools/Qelim/qelim.ML"
1.11 + "Tools/Qelim/ferrante_rackoff_data.ML"
1.12 + ("Tools/Qelim/ferrante_rackoff.ML")
1.13 begin
1.14
1.15 setup Ferrante_Rackoff_Data.setup
1.16 @@ -415,7 +415,7 @@
1.17
1.18 end
1.19
1.20 -use "Tools/Ferrante_Rackoff/ferrante_rackoff.ML"
1.21 +use "Tools/Qelim/ferrante_rackoff.ML"
1.22
1.23 method_setup dlo = {*
1.24 Method.ctxt_args (Method.SIMPLE_METHOD' o FerranteRackoff.dlo_tac)
2.1 --- a/src/HOL/IsaMakefile Thu Jun 21 20:48:47 2007 +0200
2.2 +++ b/src/HOL/IsaMakefile Thu Jun 21 20:48:48 2007 +0200
2.3 @@ -92,14 +92,13 @@
2.4 Predicate.thy Product_Type.thy ROOT.ML Recdef.thy \
2.5 Record.thy Refute.thy Relation.thy Relation_Power.thy \
2.6 Ring_and_Field.thy SAT.thy Set.thy SetInterval.thy Sum_Type.thy \
2.7 - Tools/ATP/reduce_axiomsN.ML Tools/ATP/watcher.ML \
2.8 - Tools/Ferrante_Rackoff/ferrante_rackoff_data.ML \
2.9 - Tools/Ferrante_Rackoff/ferrante_rackoff.ML \
2.10 + Groebner_Basis.thy Tools/ATP/reduce_axiomsN.ML Tools/ATP/watcher.ML \
2.11 Tools/Groebner_Basis/groebner.ML Tools/Groebner_Basis/misc.ML \
2.12 - Tools/Groebner_Basis/normalizer.ML Groebner_Basis.thy \
2.13 - Tools/Groebner_Basis/normalizer_data.ML \
2.14 - Tools/Presburger/cooper.ML Tools/Presburger/presburger.ML \
2.15 - Tools/Presburger/generated_cooper.ML Tools/Presburger/cooper_data.ML \
2.16 + Tools/Groebner_Basis/normalizer.ML \
2.17 + Tools/Groebner_Basis/normalizer_data.ML Tools/Qelim/cooper.ML \
2.18 + Tools/Qelim/cooper_data.ML Tools/Qelim/ferrante_rackoff.ML \
2.19 + Tools/Qelim/ferrante_rackoff_data.ML Tools/Qelim/generated_cooper.ML \
2.20 + Tools/Qelim/presburger.ML Tools/Qelim/qelim.ML \
2.21 Tools/TFL/dcterm.ML Tools/TFL/post.ML Tools/TFL/rules.ML \
2.22 Tools/TFL/tfl.ML Tools/TFL/thms.ML Tools/TFL/thry.ML \
2.23 Tools/TFL/usyntax.ML Tools/TFL/utils.ML Tools/cnf_funcs.ML \
2.24 @@ -122,7 +121,7 @@
2.25 Tools/inductive_package.ML Tools/inductive_realizer.ML Tools/meson.ML \
2.26 Tools/metis_tools.ML Tools/numeral_syntax.ML \
2.27 Tools/old_inductive_package.ML Tools/polyhash.ML \
2.28 - Tools/primrec_package.ML Tools/prop_logic.ML Tools/qelim.ML \
2.29 + Tools/primrec_package.ML Tools/prop_logic.ML \
2.30 Tools/recdef_package.ML Tools/recfun_codegen.ML \
2.31 Tools/record_package.ML Tools/refute.ML Tools/refute_isar.ML \
2.32 Tools/res_atp.ML Tools/res_atp_methods.ML Tools/res_atp_provers.ML \
3.1 --- a/src/HOL/Tools/Ferrante_Rackoff/ferrante_rackoff.ML Thu Jun 21 20:48:47 2007 +0200
3.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
3.3 @@ -1,263 +0,0 @@
3.4 -(* Title: HOL/Tools/ferrante_rackoff.ML
3.5 - ID: $Id$
3.6 - Author: Amine Chaieb, TU Muenchen
3.7 -
3.8 -Ferrante and Rackoff's algorithm for quantifier elimination in dense
3.9 -linear orders. Proof-synthesis and tactic.
3.10 -*)
3.11 -
3.12 -signature FERRANTE_RACKOFF =
3.13 -sig
3.14 - val dlo_tac: Proof.context -> int -> tactic
3.15 -end;
3.16 -
3.17 -structure FerranteRackoff: FERRANTE_RACKOFF =
3.18 -struct
3.19 -
3.20 -open Ferrante_Rackoff_Data;
3.21 -open Conv;
3.22 -
3.23 -type entry = {minf: thm list, pinf: thm list, nmi: thm list, npi: thm list,
3.24 - ld: thm list, qe: thm, atoms : cterm list} *
3.25 - {isolate_conv: cterm list -> cterm -> thm,
3.26 - whatis : cterm -> cterm -> ord,
3.27 - simpset : simpset};
3.28 -
3.29 -fun binop_cong b th1 th2 = Thm.combination (Drule.arg_cong_rule b th1) th2;
3.30 -val is_refl = op aconv o Logic.dest_equals o Thm.prop_of;
3.31 -fun C f x y = f y x
3.32 -
3.33 -fun get_p1 th =
3.34 - let
3.35 - fun appair f (x,y) = (f x, f y)
3.36 - in funpow 2 (Thm.dest_arg o snd o Thm.dest_abs NONE)
3.37 - (funpow 2 Thm.dest_arg (cprop_of th)) |> Thm.dest_arg
3.38 -end;
3.39 -
3.40 -fun ferrack_conv
3.41 - (entr as ({minf = minf, pinf = pinf, nmi = nmi, npi = npi,
3.42 - ld = ld, qe = qe, atoms = atoms},
3.43 - {isolate_conv = icv, whatis = wi, simpset = simpset}):entry) =
3.44 -let
3.45 - fun uset (vars as (x::vs)) p = case term_of p of
3.46 - Const("op &", _)$ _ $ _ =>
3.47 - let
3.48 - val ((b,l),r) = Thm.dest_comb p |>> Thm.dest_comb
3.49 - val (lS,lth) = uset vars l val (rS, rth) = uset vars r
3.50 - in (lS@rS, binop_cong b lth rth) end
3.51 - | Const("op |", _)$ _ $ _ =>
3.52 - let
3.53 - val ((b,l),r) = Thm.dest_comb p |>> Thm.dest_comb
3.54 - val (lS,lth) = uset vars l val (rS, rth) = uset vars r
3.55 - in (lS@rS, binop_cong b lth rth) end
3.56 - | _ =>
3.57 - let
3.58 - val th = icv vars p
3.59 - val p' = Thm.rhs_of th
3.60 - val c = wi x p'
3.61 - val S = (if c mem [Lt, Le, Eq] then single o Thm.dest_arg
3.62 - else if c mem [Gt, Ge] then single o Thm.dest_arg1
3.63 - else if c = NEq then single o Thm.dest_arg o Thm.dest_arg
3.64 - else K []) p'
3.65 - in (S,th) end
3.66 -
3.67 - val ((p1_v,p2_v),(mp1_v,mp2_v)) =
3.68 - let
3.69 - fun appair f (x,y) = (f x, f y)
3.70 - in funpow 2 (Thm.dest_arg o snd o Thm.dest_abs NONE)
3.71 - (funpow 4 Thm.dest_arg (cprop_of (hd minf)))
3.72 - |> Thm.dest_binop |> appair Thm.dest_binop |> apfst (appair Thm.dest_fun)
3.73 - end
3.74 -
3.75 - fun myfwd (th1, th2, th3, th4, th5) p1 p2
3.76 - [(th_1,th_2,th_3,th_4,th_5), (th_1',th_2',th_3',th_4',th_5')] =
3.77 - let
3.78 - val (mp1, mp2) = (get_p1 th_1, get_p1 th_1')
3.79 - val (pp1, pp2) = (get_p1 th_2, get_p1 th_2')
3.80 - fun fw mi th th' th'' =
3.81 - let
3.82 - val th0 = if mi then
3.83 - instantiate ([],[(p1_v, p1),(p2_v, p2),(mp1_v, mp1), (mp2_v, mp2)]) th
3.84 - else instantiate ([],[(p1_v, p1),(p2_v, p2),(mp1_v, pp1), (mp2_v, pp2)]) th
3.85 - in implies_elim (implies_elim th0 th') th'' end
3.86 - in (fw true th1 th_1 th_1', fw false th2 th_2 th_2',
3.87 - fw true th3 th_3 th_3', fw false th4 th_4 th_4', fw true th5 th_5 th_5')
3.88 - end
3.89 - val U_v = (Thm.dest_arg o Thm.dest_arg o Thm.dest_arg1) (cprop_of qe)
3.90 - fun main vs p =
3.91 - let
3.92 - val ((xn,ce),(x,fm)) = (case term_of p of
3.93 - Const("Ex",_)$Abs(xn,xT,_) =>
3.94 - Thm.dest_comb p ||> Thm.dest_abs (SOME xn) |>> pair xn
3.95 - | _ => error "main QE only trats existential quantifiers!")
3.96 - val cT = ctyp_of_term x
3.97 - val (u,nth) = uset (x::vs) fm |>> distinct (op aconvc)
3.98 - val nthx = Thm.abstract_rule xn x nth
3.99 - val q = Thm.rhs_of nth
3.100 - val qx = Thm.rhs_of nthx
3.101 - val enth = Drule.arg_cong_rule ce nthx
3.102 - val [th0,th1] = map (instantiate' [SOME cT] []) @{thms "finite.intros"}
3.103 - fun ins x th =
3.104 - implies_elim (instantiate' [] [(SOME o Thm.dest_arg o Thm.dest_arg)
3.105 - (Thm.cprop_of th), SOME x] th1) th
3.106 - val fU = fold ins u th0
3.107 - val cU = funpow 2 Thm.dest_arg (Thm.cprop_of fU)
3.108 - local
3.109 - val insI1 = instantiate' [SOME cT] [] @{thm "insertI1"}
3.110 - val insI2 = instantiate' [SOME cT] [] @{thm "insertI2"}
3.111 - in
3.112 - fun provein x S =
3.113 - case term_of S of
3.114 - Const("{}",_) => error "provein : not a member!"
3.115 - | Const("insert",_)$y$_ =>
3.116 - let val (cy,S') = Thm.dest_binop S
3.117 - in if term_of x aconv y then instantiate' [] [SOME x, SOME S'] insI1
3.118 - else implies_elim (instantiate' [] [SOME x, SOME S', SOME cy] insI2)
3.119 - (provein x S')
3.120 - end
3.121 - end
3.122 - val tabU = fold (fn t => fn tab => Termtab.update (term_of t, provein t cU) tab)
3.123 - u Termtab.empty
3.124 - val U = valOf o Termtab.lookup tabU o term_of
3.125 - val [minf_conj, minf_disj, minf_eq, minf_neq, minf_lt,
3.126 - minf_le, minf_gt, minf_ge, minf_P] = minf
3.127 - val [pinf_conj, pinf_disj, pinf_eq, pinf_neq, pinf_lt,
3.128 - pinf_le, pinf_gt, pinf_ge, pinf_P] = pinf
3.129 - val [nmi_conj, nmi_disj, nmi_eq, nmi_neq, nmi_lt,
3.130 - nmi_le, nmi_gt, nmi_ge, nmi_P] = map (instantiate ([],[(U_v,cU)])) nmi
3.131 - val [npi_conj, npi_disj, npi_eq, npi_neq, npi_lt,
3.132 - npi_le, npi_gt, npi_ge, npi_P] = map (instantiate ([],[(U_v,cU)])) npi
3.133 - val [ld_conj, ld_disj, ld_eq, ld_neq, ld_lt,
3.134 - ld_le, ld_gt, ld_ge, ld_P] = map (instantiate ([],[(U_v,cU)])) ld
3.135 -
3.136 - fun decomp_mpinf fm =
3.137 - case term_of fm of
3.138 - Const("op &",_)$_$_ =>
3.139 - let val (p,q) = Thm.dest_binop fm
3.140 - in ([p,q], myfwd (minf_conj,pinf_conj, nmi_conj, npi_conj,ld_conj)
3.141 - (Thm.cabs x p) (Thm.cabs x q))
3.142 - end
3.143 - | Const("op |",_)$_$_ =>
3.144 - let val (p,q) = Thm.dest_binop fm
3.145 - in ([p,q],myfwd (minf_disj, pinf_disj, nmi_disj, npi_disj,ld_disj)
3.146 - (Thm.cabs x p) (Thm.cabs x q))
3.147 - end
3.148 - | _ =>
3.149 - (let val c = wi x fm
3.150 - val t = (if c=Nox then I
3.151 - else if c mem [Lt, Le, Eq] then Thm.dest_arg
3.152 - else if c mem [Gt,Ge] then Thm.dest_arg1
3.153 - else if c = NEq then (Thm.dest_arg o Thm.dest_arg)
3.154 - else error "decomp_mpinf: Impossible case!!") fm
3.155 - val [mi_th, pi_th, nmi_th, npi_th, ld_th] =
3.156 - if c = Nox then map (instantiate' [] [SOME fm])
3.157 - [minf_P, pinf_P, nmi_P, npi_P, ld_P]
3.158 - else
3.159 - let val [mi_th,pi_th,nmi_th,npi_th,ld_th] =
3.160 - map (instantiate' [] [SOME t])
3.161 - (case c of Lt => [minf_lt, pinf_lt, nmi_lt, npi_lt, ld_lt]
3.162 - | Le => [minf_le, pinf_le, nmi_le, npi_le, ld_le]
3.163 - | Gt => [minf_gt, pinf_gt, nmi_gt, npi_gt, ld_gt]
3.164 - | Ge => [minf_ge, pinf_ge, nmi_ge, npi_ge, ld_ge]
3.165 - | Eq => [minf_eq, pinf_eq, nmi_eq, npi_eq, ld_eq]
3.166 - | NEq => [minf_neq, pinf_neq, nmi_neq, npi_neq, ld_neq])
3.167 - val tU = U t
3.168 - fun Ufw th = implies_elim th tU
3.169 - in [mi_th, pi_th, Ufw nmi_th, Ufw npi_th, Ufw ld_th]
3.170 - end
3.171 - in ([], K (mi_th, pi_th, nmi_th, npi_th, ld_th)) end)
3.172 - val (minf_th, pinf_th, nmi_th, npi_th, ld_th) = divide_and_conquer decomp_mpinf q
3.173 - val qe_th = fold (C implies_elim) [fU, ld_th, nmi_th, npi_th, minf_th, pinf_th]
3.174 - ((fconv_rule (Thm.beta_conversion true))
3.175 - (instantiate' [] (map SOME [cU, qx, get_p1 minf_th, get_p1 pinf_th])
3.176 - qe))
3.177 - val bex_conv =
3.178 - Simplifier.rewrite (HOL_basic_ss addsimps simp_thms@(@{thms "bex_simps" (1-5)}))
3.179 - val result_th = fconv_rule (arg_conv bex_conv) (transitive enth qe_th)
3.180 - in result_th
3.181 - end
3.182 -
3.183 -in main
3.184 -end;
3.185 -
3.186 -val grab_atom_bop =
3.187 - let
3.188 - fun h bounds tm =
3.189 - (case term_of tm of
3.190 - Const ("op =", T) $ _ $ _ =>
3.191 - if domain_type T = HOLogic.boolT then find_args bounds tm
3.192 - else Thm.dest_fun2 tm
3.193 - | Const ("Not", _) $ _ => h bounds (Thm.dest_arg tm)
3.194 - | Const ("All", _) $ _ => find_body bounds (Thm.dest_arg tm)
3.195 - | Const ("Ex", _) $ _ => find_body bounds (Thm.dest_arg tm)
3.196 - | Const ("op &", _) $ _ $ _ => find_args bounds tm
3.197 - | Const ("op |", _) $ _ $ _ => find_args bounds tm
3.198 - | Const ("op -->", _) $ _ $ _ => find_args bounds tm
3.199 - | Const ("==>", _) $ _ $ _ => find_args bounds tm
3.200 - | Const ("==", _) $ _ $ _ => find_args bounds tm
3.201 - | Const ("Trueprop", _) $ _ => h bounds (Thm.dest_arg tm)
3.202 - | _ => Thm.dest_fun2 tm)
3.203 - and find_args bounds tm =
3.204 - (h bounds (Thm.dest_arg tm) handle CTERM _ => Thm.dest_arg1 tm)
3.205 - and find_body bounds b =
3.206 - let val (_, b') = Thm.dest_abs (SOME (Name.bound bounds)) b
3.207 - in h (bounds + 1) b' end;
3.208 -in h end;
3.209 -
3.210 -local
3.211 -fun cterm_frees ct =
3.212 - let fun h acc t =
3.213 - case (term_of t) of
3.214 - _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
3.215 - | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
3.216 - | Free _ => insert (op aconvc) t acc
3.217 - | _ => acc
3.218 - in h [] ct end;
3.219 -in
3.220 -
3.221 -fun raw_ferrack_qe_conv ctxt (thy, {isolate_conv, whatis, simpset}) tm =
3.222 - let
3.223 - val ss = simpset
3.224 - val pcv = Simplifier.rewrite
3.225 - (merge_ss (HOL_basic_ss addsimps (simp_thms @ ex_simps @ all_simps)
3.226 - @ [not_all,@{thm "all_not_ex"}, ex_disj_distrib], ss))
3.227 - val postcv = Simplifier.rewrite ss
3.228 - val nnf = K (nnf_conv then_conv postcv)
3.229 - val qe_conv = Qelim.gen_qelim_conv ctxt pcv postcv pcv cons (cterm_frees tm)
3.230 - (isolate_conv ctxt) nnf
3.231 - (fn vs => ferrack_conv (thy,{isolate_conv = isolate_conv ctxt,
3.232 - whatis = whatis, simpset = simpset}) vs
3.233 - then_conv postcv)
3.234 - in (Simplifier.rewrite ss then_conv qe_conv) tm
3.235 - end
3.236 -
3.237 -fun ferrackqe_conv ctxt tm =
3.238 - case Ferrante_Rackoff_Data.match ctxt (grab_atom_bop 0 tm) of
3.239 - NONE => error "ferrackqe_conv : no corresponding instance in context!"
3.240 -| SOME res => raw_ferrack_qe_conv ctxt res tm
3.241 -end;
3.242 -
3.243 -fun core_ferrack_tac ctxt res i st =
3.244 - let val p = nth (cprems_of st) (i - 1)
3.245 - val th = symmetric (arg_conv (raw_ferrack_qe_conv ctxt res) p)
3.246 - val p' = Thm.lhs_of th
3.247 - val th' = implies_intr p' (equal_elim th (assume p'))
3.248 - val _ = print_thm th
3.249 - in (rtac th' i) st
3.250 - end
3.251 -
3.252 -fun dlo_tac ctxt i st =
3.253 - let
3.254 - val instance = (case Ferrante_Rackoff_Data.match ctxt
3.255 - (grab_atom_bop 0 (nth (cprems_of st) (i - 1))) of
3.256 - NONE => error "ferrackqe_conv : no corresponding instance in context!"
3.257 - | SOME r => r)
3.258 - val ss = #simpset (snd instance)
3.259 - in
3.260 - (ObjectLogic.full_atomize_tac i THEN
3.261 - simp_tac ss i THEN
3.262 - core_ferrack_tac ctxt instance i THEN
3.263 - (TRY (simp_tac (Simplifier.local_simpset_of ctxt) i))) st
3.264 - end;
3.265 -
3.266 -end;
4.1 --- a/src/HOL/Tools/Ferrante_Rackoff/ferrante_rackoff_data.ML Thu Jun 21 20:48:47 2007 +0200
4.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
4.3 @@ -1,149 +0,0 @@
4.4 -(* Title: HOL/Tools/ferrante_rackoff_data.ML
4.5 - ID: $Id$
4.6 - Author: Amine Chaieb, TU Muenchen
4.7 -
4.8 -Context data for Ferrante and Rackoff's algorithm for quantifier
4.9 -elimination in dense linear orders.
4.10 -*)
4.11 -
4.12 -signature FERRANTE_RACKOF_DATA =
4.13 -sig
4.14 - datatype ord = Lt | Le | Gt | Ge | Eq | NEq | Nox
4.15 - type entry
4.16 - val get: Proof.context -> (thm * entry) list
4.17 - val del: attribute
4.18 - val add: entry -> attribute
4.19 - val funs: thm ->
4.20 - {isolate_conv: morphism -> Proof.context -> cterm list -> cterm -> thm,
4.21 - whatis: morphism -> cterm -> cterm -> ord,
4.22 - simpset: morphism -> simpset}
4.23 - -> morphism -> Context.generic -> Context.generic
4.24 - val match: Proof.context -> cterm -> entry option
4.25 - val setup: theory -> theory
4.26 -end;
4.27 -
4.28 -structure Ferrante_Rackoff_Data: FERRANTE_RACKOF_DATA =
4.29 -struct
4.30 -
4.31 -(* data *)
4.32 -
4.33 -datatype ord = Lt | Le | Gt | Ge | Eq | NEq | Nox
4.34 -
4.35 -type entry =
4.36 - {minf: thm list, pinf: thm list, nmi: thm list, npi: thm list,
4.37 - ld: thm list, qe: thm, atoms : cterm list} *
4.38 - {isolate_conv: Proof.context -> cterm list -> cterm -> thm,
4.39 - whatis : cterm -> cterm -> ord,
4.40 - simpset : simpset};
4.41 -
4.42 -val eq_key = Thm.eq_thm;
4.43 -fun eq_data arg = eq_fst eq_key arg;
4.44 -
4.45 -structure Data = GenericDataFun
4.46 -(
4.47 - type T = (thm * entry) list;
4.48 - val empty = [];
4.49 - val extend = I;
4.50 - fun merge _ = AList.merge eq_key (K true);
4.51 -);
4.52 -
4.53 -val get = Data.get o Context.Proof;
4.54 -
4.55 -fun del_data key = remove eq_data (key, []);
4.56 -
4.57 -val del = Thm.declaration_attribute (Data.map o del_data);
4.58 -
4.59 -fun undefined x = error "undefined";
4.60 -
4.61 -fun add entry =
4.62 - Thm.declaration_attribute (fn key => fn context => context |> Data.map
4.63 - (del_data key #> cons (key, entry)));
4.64 -
4.65 -
4.66 -(* extra-logical functions *)
4.67 -
4.68 -fun funs raw_key {isolate_conv = icv, whatis = wi, simpset = ss} phi = Data.map (fn data =>
4.69 - let
4.70 - val key = Morphism.thm phi raw_key;
4.71 - val _ = AList.defined eq_key data key orelse
4.72 - raise THM ("No data entry for structure key", 0, [key]);
4.73 - val fns = {isolate_conv = icv phi, whatis = wi phi, simpset = ss phi};
4.74 - in AList.map_entry eq_key key (apsnd (K fns)) data end);
4.75 -
4.76 -fun match ctxt tm =
4.77 - let
4.78 - fun match_inst
4.79 - ({minf, pinf, nmi, npi, ld, qe, atoms},
4.80 - fns as {isolate_conv, whatis, simpset}) pat =
4.81 - let
4.82 - fun h instT =
4.83 - let
4.84 - val substT = Thm.instantiate (instT, []);
4.85 - val substT_cterm = Drule.cterm_rule substT;
4.86 -
4.87 - val minf' = map substT minf
4.88 - val pinf' = map substT pinf
4.89 - val nmi' = map substT nmi
4.90 - val npi' = map substT npi
4.91 - val ld' = map substT ld
4.92 - val qe' = substT qe
4.93 - val atoms' = map substT_cterm atoms
4.94 - val result = ({minf = minf', pinf = pinf', nmi = nmi', npi = npi',
4.95 - ld = ld', qe = qe', atoms = atoms'}, fns)
4.96 - in SOME result end
4.97 - in (case try Thm.match (pat, tm) of
4.98 - NONE => NONE
4.99 - | SOME (instT, _) => h instT)
4.100 - end;
4.101 -
4.102 - fun match_struct (_,
4.103 - entry as ({atoms = atoms, ...}, _): entry) =
4.104 - get_first (match_inst entry) atoms;
4.105 - in get_first match_struct (get ctxt) end;
4.106 -
4.107 -
4.108 -(* concrete syntax *)
4.109 -
4.110 -local
4.111 -val minfN = "minf";
4.112 -val pinfN = "pinf";
4.113 -val nmiN = "nmi";
4.114 -val npiN = "npi";
4.115 -val lin_denseN = "lindense";
4.116 -val qeN = "qe"
4.117 -val atomsN = "atoms"
4.118 -val simpsN = "simps"
4.119 -fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ();
4.120 -val any_keyword =
4.121 - keyword minfN || keyword pinfN || keyword nmiN
4.122 -|| keyword npiN || keyword lin_denseN || keyword qeN
4.123 -|| keyword atomsN || keyword simpsN;
4.124 -
4.125 -val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat;
4.126 -val terms = thms >> map Drule.dest_term;
4.127 -in
4.128 -
4.129 -fun att_syntax src = src |> Attrib.syntax
4.130 - ((keyword minfN |-- thms)
4.131 - -- (keyword pinfN |-- thms)
4.132 - -- (keyword nmiN |-- thms)
4.133 - -- (keyword npiN |-- thms)
4.134 - -- (keyword lin_denseN |-- thms)
4.135 - -- (keyword qeN |-- thms)
4.136 - -- (keyword atomsN |-- terms) >>
4.137 - (fn ((((((minf,pinf),nmi),npi),lin_dense),qe), atoms)=>
4.138 - if length qe = 1 then
4.139 - add ({minf = minf, pinf = pinf, nmi = nmi, npi = npi, ld = lin_dense,
4.140 - qe = hd qe, atoms = atoms},
4.141 - {isolate_conv = undefined, whatis = undefined, simpset = HOL_ss})
4.142 - else error "only one theorem for qe!"))
4.143 -
4.144 -end;
4.145 -
4.146 -
4.147 -(* theory setup *)
4.148 -
4.149 -val setup =
4.150 - Attrib.add_attributes [("dlo", att_syntax, "Ferrante Rackoff data")];
4.151 -
4.152 -end;
5.1 --- a/src/HOL/Tools/Presburger/cooper.ML Thu Jun 21 20:48:47 2007 +0200
5.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
5.3 @@ -1,661 +0,0 @@
5.4 -(* Title: HOL/Tools/Presburger/cooper.ML
5.5 - ID: $Id$
5.6 - Author: Amine Chaieb, TU Muenchen
5.7 -*)
5.8 -
5.9 -signature COOPER =
5.10 - sig
5.11 - val cooper_conv : Proof.context -> Conv.conv
5.12 - exception COOPER of string * exn
5.13 -end;
5.14 -
5.15 -structure Cooper: COOPER =
5.16 -struct
5.17 -open Conv;
5.18 -open Normalizer;
5.19 -structure Integertab = TableFun(type key = integer val ord = Integer.cmp);
5.20 -exception COOPER of string * exn;
5.21 -val simp_thms_conv = Simplifier.rewrite (HOL_basic_ss addsimps simp_thms);
5.22 -
5.23 -fun C f x y = f y x;
5.24 -
5.25 -val FWD = C (fold (C implies_elim));
5.26 -
5.27 -val true_tm = @{cterm "True"};
5.28 -val false_tm = @{cterm "False"};
5.29 -val zdvd1_eq = @{thm "zdvd1_eq"};
5.30 -val presburger_ss = @{simpset} addsimps [zdvd1_eq];
5.31 -val lin_ss = presburger_ss addsimps (@{thm "dvd_eq_mod_eq_0"}::zdvd1_eq::@{thms zadd_ac});
5.32 -(* Some types and constants *)
5.33 -val iT = HOLogic.intT
5.34 -val bT = HOLogic.boolT;
5.35 -val dest_numeral = HOLogic.dest_number #> snd;
5.36 -
5.37 -val [miconj, midisj, mieq, mineq, milt, mile, migt, mige, midvd, mindvd, miP] =
5.38 - map(instantiate' [SOME @{ctyp "int"}] []) @{thms "minf"};
5.39 -
5.40 -val [infDconj, infDdisj, infDdvd,infDndvd,infDP] =
5.41 - map(instantiate' [SOME @{ctyp "int"}] []) @{thms "inf_period"};
5.42 -
5.43 -val [piconj, pidisj, pieq,pineq,pilt,pile,pigt,pige,pidvd,pindvd,piP] =
5.44 - map (instantiate' [SOME @{ctyp "int"}] []) @{thms "pinf"};
5.45 -
5.46 -val [miP, piP] = map (instantiate' [SOME @{ctyp "bool"}] []) [miP, piP];
5.47 -
5.48 -val infDP = instantiate' (map SOME [@{ctyp "int"}, @{ctyp "bool"}]) [] infDP;
5.49 -
5.50 -val [[asetconj, asetdisj, aseteq, asetneq, asetlt, asetle,
5.51 - asetgt, asetge, asetdvd, asetndvd,asetP],
5.52 - [bsetconj, bsetdisj, bseteq, bsetneq, bsetlt, bsetle,
5.53 - bsetgt, bsetge, bsetdvd, bsetndvd,bsetP]] = [@{thms "aset"}, @{thms "bset"}];
5.54 -
5.55 -val [miex, cpmi, piex, cppi] = [@{thm "minusinfinity"}, @{thm "cpmi"},
5.56 - @{thm "plusinfinity"}, @{thm "cppi"}];
5.57 -
5.58 -val unity_coeff_ex = instantiate' [SOME @{ctyp "int"}] [] @{thm "unity_coeff_ex"};
5.59 -
5.60 -val [zdvd_mono,simp_from_to,all_not_ex] =
5.61 - [@{thm "zdvd_mono"}, @{thm "simp_from_to"}, @{thm "all_not_ex"}];
5.62 -
5.63 -val [dvd_uminus, dvd_uminus'] = @{thms "uminus_dvd_conv"};
5.64 -
5.65 -val eval_ss = presburger_ss addsimps [simp_from_to] delsimps [insert_iff,bex_triv];
5.66 -val eval_conv = Simplifier.rewrite eval_ss;
5.67 -
5.68 -(* recongnising cterm without moving to terms *)
5.69 -
5.70 -datatype fm = And of cterm*cterm| Or of cterm*cterm| Eq of cterm | NEq of cterm
5.71 - | Lt of cterm | Le of cterm | Gt of cterm | Ge of cterm
5.72 - | Dvd of cterm*cterm | NDvd of cterm*cterm | Nox
5.73 -
5.74 -fun whatis x ct =
5.75 -( case (term_of ct) of
5.76 - Const("op &",_)$_$_ => And (Thm.dest_binop ct)
5.77 -| Const ("op |",_)$_$_ => Or (Thm.dest_binop ct)
5.78 -| Const ("op =",ty)$y$_ => if term_of x aconv y then Eq (Thm.dest_arg ct) else Nox
5.79 -| Const("Not",_) $ (Const ("op =",_)$y$_) =>
5.80 - if term_of x aconv y then NEq (funpow 2 Thm.dest_arg ct) else Nox
5.81 -| Const ("Orderings.ord_class.less",_)$y$z =>
5.82 - if term_of x aconv y then Lt (Thm.dest_arg ct)
5.83 - else if term_of x aconv z then Gt (Thm.dest_arg1 ct) else Nox
5.84 -| Const ("Orderings.ord_class.less_eq",_)$y$z =>
5.85 - if term_of x aconv y then Le (Thm.dest_arg ct)
5.86 - else if term_of x aconv z then Ge (Thm.dest_arg1 ct) else Nox
5.87 -| Const ("Divides.dvd",_)$_$(Const(@{const_name "HOL.plus"},_)$y$_) =>
5.88 - if term_of x aconv y then Dvd (Thm.dest_binop ct ||> Thm.dest_arg) else Nox
5.89 -| Const("Not",_) $ (Const ("Divides.dvd",_)$_$(Const(@{const_name "HOL.plus"},_)$y$_)) =>
5.90 - if term_of x aconv y then
5.91 - NDvd (Thm.dest_binop (Thm.dest_arg ct) ||> Thm.dest_arg) else Nox
5.92 -| _ => Nox)
5.93 - handle CTERM _ => Nox;
5.94 -
5.95 -fun get_pmi_term t =
5.96 - let val (x,eq) =
5.97 - (Thm.dest_abs NONE o Thm.dest_arg o snd o Thm.dest_abs NONE o Thm.dest_arg)
5.98 - (Thm.dest_arg t)
5.99 -in (Thm.cabs x o Thm.dest_arg o Thm.dest_arg) eq end;
5.100 -
5.101 -val get_pmi = get_pmi_term o cprop_of;
5.102 -
5.103 -val p_v' = @{cpat "?P' :: int => bool"};
5.104 -val q_v' = @{cpat "?Q' :: int => bool"};
5.105 -val p_v = @{cpat "?P:: int => bool"};
5.106 -val q_v = @{cpat "?Q:: int => bool"};
5.107 -
5.108 -fun myfwd (th1, th2, th3) p q
5.109 - [(th_1,th_2,th_3), (th_1',th_2',th_3')] =
5.110 - let
5.111 - val (mp', mq') = (get_pmi th_1, get_pmi th_1')
5.112 - val mi_th = FWD (instantiate ([],[(p_v,p),(q_v,q), (p_v',mp'),(q_v',mq')]) th1)
5.113 - [th_1, th_1']
5.114 - val infD_th = FWD (instantiate ([],[(p_v,mp'), (q_v, mq')]) th3) [th_3,th_3']
5.115 - val set_th = FWD (instantiate ([],[(p_v,p), (q_v,q)]) th2) [th_2, th_2']
5.116 - in (mi_th, set_th, infD_th)
5.117 - end;
5.118 -
5.119 -val inst' = fn cts => instantiate' [] (map SOME cts);
5.120 -val infDTrue = instantiate' [] [SOME true_tm] infDP;
5.121 -val infDFalse = instantiate' [] [SOME false_tm] infDP;
5.122 -
5.123 -val cadd = @{cterm "op + :: int => _"}
5.124 -val cmulC = @{cterm "op * :: int => _"}
5.125 -val cminus = @{cterm "op - :: int => _"}
5.126 -val cone = @{cterm "1:: int"}
5.127 -val cneg = @{cterm "uminus :: int => _"}
5.128 -val [addC, mulC, subC, negC] = map term_of [cadd, cmulC, cminus, cneg]
5.129 -val [zero, one] = [@{term "0::int"}, @{term "1::int"}];
5.130 -
5.131 -val is_numeral = can dest_numeral;
5.132 -
5.133 -fun numeral1 f n = HOLogic.mk_number iT (f (dest_numeral n));
5.134 -fun numeral2 f m n = HOLogic.mk_number iT (f (dest_numeral m) (dest_numeral n));
5.135 -
5.136 -val [minus1,plus1] =
5.137 - map (fn c => fn t => Thm.capply (Thm.capply c t) cone) [cminus,cadd];
5.138 -
5.139 -fun decomp_pinf x dvd inS [aseteq, asetneq, asetlt, asetle,
5.140 - asetgt, asetge,asetdvd,asetndvd,asetP,
5.141 - infDdvd, infDndvd, asetconj,
5.142 - asetdisj, infDconj, infDdisj] cp =
5.143 - case (whatis x cp) of
5.144 - And (p,q) => ([p,q], myfwd (piconj, asetconj, infDconj) (Thm.cabs x p) (Thm.cabs x q))
5.145 -| Or (p,q) => ([p,q], myfwd (pidisj, asetdisj, infDdisj) (Thm.cabs x p) (Thm.cabs x q))
5.146 -| Eq t => ([], K (inst' [t] pieq, FWD (inst' [t] aseteq) [inS (plus1 t)], infDFalse))
5.147 -| NEq t => ([], K (inst' [t] pineq, FWD (inst' [t] asetneq) [inS t], infDTrue))
5.148 -| Lt t => ([], K (inst' [t] pilt, FWD (inst' [t] asetlt) [inS t], infDFalse))
5.149 -| Le t => ([], K (inst' [t] pile, FWD (inst' [t] asetle) [inS (plus1 t)], infDFalse))
5.150 -| Gt t => ([], K (inst' [t] pigt, (inst' [t] asetgt), infDTrue))
5.151 -| Ge t => ([], K (inst' [t] pige, (inst' [t] asetge), infDTrue))
5.152 -| Dvd (d,s) =>
5.153 - ([],let val dd = dvd d
5.154 - in K (inst' [d,s] pidvd, FWD (inst' [d,s] asetdvd) [dd],FWD (inst' [d,s] infDdvd) [dd]) end)
5.155 -| NDvd(d,s) => ([],let val dd = dvd d
5.156 - in K (inst' [d,s] pindvd, FWD (inst' [d,s] asetndvd) [dd], FWD (inst' [d,s] infDndvd) [dd]) end)
5.157 -| _ => ([], K (inst' [cp] piP, inst' [cp] asetP, inst' [cp] infDP));
5.158 -
5.159 -fun decomp_minf x dvd inS [bseteq,bsetneq,bsetlt, bsetle, bsetgt,
5.160 - bsetge,bsetdvd,bsetndvd,bsetP,
5.161 - infDdvd, infDndvd, bsetconj,
5.162 - bsetdisj, infDconj, infDdisj] cp =
5.163 - case (whatis x cp) of
5.164 - And (p,q) => ([p,q], myfwd (miconj, bsetconj, infDconj) (Thm.cabs x p) (Thm.cabs x q))
5.165 -| Or (p,q) => ([p,q], myfwd (midisj, bsetdisj, infDdisj) (Thm.cabs x p) (Thm.cabs x q))
5.166 -| Eq t => ([], K (inst' [t] mieq, FWD (inst' [t] bseteq) [inS (minus1 t)], infDFalse))
5.167 -| NEq t => ([], K (inst' [t] mineq, FWD (inst' [t] bsetneq) [inS t], infDTrue))
5.168 -| Lt t => ([], K (inst' [t] milt, (inst' [t] bsetlt), infDTrue))
5.169 -| Le t => ([], K (inst' [t] mile, (inst' [t] bsetle), infDTrue))
5.170 -| Gt t => ([], K (inst' [t] migt, FWD (inst' [t] bsetgt) [inS t], infDFalse))
5.171 -| Ge t => ([], K (inst' [t] mige,FWD (inst' [t] bsetge) [inS (minus1 t)], infDFalse))
5.172 -| Dvd (d,s) => ([],let val dd = dvd d
5.173 - in K (inst' [d,s] midvd, FWD (inst' [d,s] bsetdvd) [dd] , FWD (inst' [d,s] infDdvd) [dd]) end)
5.174 -| NDvd (d,s) => ([],let val dd = dvd d
5.175 - in K (inst' [d,s] mindvd, FWD (inst' [d,s] bsetndvd) [dd], FWD (inst' [d,s] infDndvd) [dd]) end)
5.176 -| _ => ([], K (inst' [cp] miP, inst' [cp] bsetP, inst' [cp] infDP))
5.177 -
5.178 - (* Canonical linear form for terms, formulae etc.. *)
5.179 -fun provelin ctxt t = Goal.prove ctxt [] [] t
5.180 - (fn _ => EVERY [simp_tac lin_ss 1, TRY (simple_arith_tac 1)]);
5.181 -fun linear_cmul 0 tm = zero
5.182 - | linear_cmul n tm =
5.183 - case tm of
5.184 - Const("HOL.plus_class.plus",_)$a$b => addC$(linear_cmul n a)$(linear_cmul n b)
5.185 - | Const ("HOL.times_class.times",_)$c$x => mulC$(numeral1 (Integer.mult n) c)$x
5.186 - | Const("HOL.minus_class.minus",_)$a$b => subC$(linear_cmul n a)$(linear_cmul n b)
5.187 - | (m as Const("HOL.minus_class.uminus",_))$a => m$(linear_cmul n a)
5.188 - | _ => numeral1 (Integer.mult n) tm;
5.189 -fun earlier [] x y = false
5.190 - | earlier (h::t) x y =
5.191 - if h aconv y then false else if h aconv x then true else earlier t x y;
5.192 -
5.193 -fun linear_add vars tm1 tm2 =
5.194 - case (tm1,tm2) of
5.195 - (Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c1$x1)$r1,
5.196 - Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c2$x2)$r2) =>
5.197 - if x1 = x2 then
5.198 - let val c = numeral2 Integer.add c1 c2
5.199 - in if c = zero then linear_add vars r1 r2
5.200 - else addC$(mulC$c$x1)$(linear_add vars r1 r2)
5.201 - end
5.202 - else if earlier vars x1 x2 then addC$(mulC$ c1 $ x1)$(linear_add vars r1 tm2)
5.203 - else addC$(mulC$c2$x2)$(linear_add vars tm1 r2)
5.204 - | (Const("HOL.plus_class.plus",_) $ (Const("HOL.times_class.times",_)$c1$x1)$r1 ,_) =>
5.205 - addC$(mulC$c1$x1)$(linear_add vars r1 tm2)
5.206 - | (_, Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c2$x2)$r2) =>
5.207 - addC$(mulC$c2$x2)$(linear_add vars tm1 r2)
5.208 - | (_,_) => numeral2 Integer.add tm1 tm2;
5.209 -
5.210 -fun linear_neg tm = linear_cmul ~1 tm;
5.211 -fun linear_sub vars tm1 tm2 = linear_add vars tm1 (linear_neg tm2);
5.212 -
5.213 -
5.214 -fun lint vars tm =
5.215 -if is_numeral tm then tm
5.216 -else case tm of
5.217 - Const("HOL.minus_class.uminus",_)$t => linear_neg (lint vars t)
5.218 -| Const("HOL.plus_class.plus",_) $ s $ t => linear_add vars (lint vars s) (lint vars t)
5.219 -| Const("HOL.minus_class.minus",_) $ s $ t => linear_sub vars (lint vars s) (lint vars t)
5.220 -| Const ("HOL.times_class.times",_) $ s $ t =>
5.221 - let val s' = lint vars s
5.222 - val t' = lint vars t
5.223 - in if is_numeral s' then (linear_cmul (dest_numeral s') t')
5.224 - else if is_numeral t' then (linear_cmul (dest_numeral t') s')
5.225 - else raise COOPER ("Cooper Failed", TERM ("lint: not linear",[tm]))
5.226 - end
5.227 - | _ => addC$(mulC$one$tm)$zero;
5.228 -
5.229 -fun lin (vs as x::_) (Const("Not",_)$(Const("Orderings.ord_class.less",T)$s$t)) =
5.230 - lin vs (Const("Orderings.ord_class.less_eq",T)$t$s)
5.231 - | lin (vs as x::_) (Const("Not",_)$(Const("Orderings.ord_class.less_eq",T)$s$t)) =
5.232 - lin vs (Const("Orderings.ord_class.less",T)$t$s)
5.233 - | lin vs (Const ("Not",T)$t) = Const ("Not",T)$ (lin vs t)
5.234 - | lin (vs as x::_) (Const("Divides.dvd",_)$d$t) =
5.235 - HOLogic.mk_binrel "Divides.dvd" (numeral1 abs d, lint vs t)
5.236 - | lin (vs as x::_) ((b as Const("op =",_))$s$t) =
5.237 - (case lint vs (subC$t$s) of
5.238 - (t as a$(m$c$y)$r) =>
5.239 - if x <> y then b$zero$t
5.240 - else if dest_numeral c < 0 then b$(m$(numeral1 ~ c)$y)$r
5.241 - else b$(m$c$y)$(linear_neg r)
5.242 - | t => b$zero$t)
5.243 - | lin (vs as x::_) (b$s$t) =
5.244 - (case lint vs (subC$t$s) of
5.245 - (t as a$(m$c$y)$r) =>
5.246 - if x <> y then b$zero$t
5.247 - else if dest_numeral c < 0 then b$(m$(numeral1 ~ c)$y)$r
5.248 - else b$(linear_neg r)$(m$c$y)
5.249 - | t => b$zero$t)
5.250 - | lin vs fm = fm;
5.251 -
5.252 -fun lint_conv ctxt vs ct =
5.253 -let val t = term_of ct
5.254 -in (provelin ctxt ((HOLogic.eq_const iT)$t$(lint vs t) |> HOLogic.mk_Trueprop))
5.255 - RS eq_reflection
5.256 -end;
5.257 -
5.258 -fun is_intrel (b$_$_) = domain_type (fastype_of b) = HOLogic.intT
5.259 - | is_intrel (@{term "Not"}$(b$_$_)) = domain_type (fastype_of b) = HOLogic.intT
5.260 - | is_intrel _ = false;
5.261 -
5.262 -fun linearize_conv ctxt vs ct =
5.263 - case (term_of ct) of
5.264 - Const("Divides.dvd",_)$d$t =>
5.265 - let
5.266 - val th = binop_conv (lint_conv ctxt vs) ct
5.267 - val (d',t') = Thm.dest_binop (Thm.rhs_of th)
5.268 - val (dt',tt') = (term_of d', term_of t')
5.269 - in if is_numeral dt' andalso is_numeral tt'
5.270 - then Conv.fconv_rule (arg_conv (Simplifier.rewrite presburger_ss)) th
5.271 - else
5.272 - let
5.273 - val dth =
5.274 - ((if dest_numeral (term_of d') < 0 then
5.275 - Conv.fconv_rule (arg_conv (arg1_conv (lint_conv ctxt vs)))
5.276 - (Thm.transitive th (inst' [d',t'] dvd_uminus))
5.277 - else th) handle TERM _ => th)
5.278 - val d'' = Thm.rhs_of dth |> Thm.dest_arg1
5.279 - in
5.280 - case tt' of
5.281 - Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c$_)$_ =>
5.282 - let val x = dest_numeral c
5.283 - in if x < 0 then Conv.fconv_rule (arg_conv (arg_conv (lint_conv ctxt vs)))
5.284 - (Thm.transitive dth (inst' [d'',t'] dvd_uminus'))
5.285 - else dth end
5.286 - | _ => dth
5.287 - end
5.288 - end
5.289 -| Const("Not",_)$(Const("Divides.dvd",_)$_$_) => arg_conv (linearize_conv ctxt vs) ct
5.290 -| t => if is_intrel t
5.291 - then (provelin ctxt ((HOLogic.eq_const bT)$t$(lin vs t) |> HOLogic.mk_Trueprop))
5.292 - RS eq_reflection
5.293 - else reflexive ct;
5.294 -
5.295 -val dvdc = @{cterm "op dvd :: int => _"};
5.296 -
5.297 -fun unify ctxt q =
5.298 - let
5.299 - val (e,(cx,p)) = q |> Thm.dest_comb ||> Thm.dest_abs NONE
5.300 - val x = term_of cx
5.301 - val ins = insert (op = : integer*integer -> bool)
5.302 - fun h (acc,dacc) t =
5.303 - case (term_of t) of
5.304 - Const(s,_)$(Const("HOL.times_class.times",_)$c$y)$ _ =>
5.305 - if x aconv y
5.306 - andalso s mem ["op =", "Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
5.307 - then (ins (dest_numeral c) acc,dacc) else (acc,dacc)
5.308 - | Const(s,_)$_$(Const("HOL.times_class.times",_)$c$y) =>
5.309 - if x aconv y
5.310 - andalso s mem ["Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
5.311 - then (ins (dest_numeral c) acc, dacc) else (acc,dacc)
5.312 - | Const("Divides.dvd",_)$_$(Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c$y)$_) =>
5.313 - if x aconv y then (acc,ins (dest_numeral c) dacc) else (acc,dacc)
5.314 - | Const("op &",_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
5.315 - | Const("op |",_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
5.316 - | Const("Not",_)$_ => h (acc,dacc) (Thm.dest_arg t)
5.317 - | _ => (acc, dacc)
5.318 - val (cs,ds) = h ([],[]) p
5.319 - val l = fold (curry lcm) (cs union ds) 1
5.320 - fun cv k ct =
5.321 - let val (tm as b$s$t) = term_of ct
5.322 - in ((HOLogic.eq_const bT)$tm$(b$(linear_cmul k s)$(linear_cmul k t))
5.323 - |> HOLogic.mk_Trueprop |> provelin ctxt) RS eq_reflection end
5.324 - fun nzprop x =
5.325 - let
5.326 - val th =
5.327 - Simplifier.rewrite lin_ss
5.328 - (Thm.capply @{cterm Trueprop} (Thm.capply @{cterm "Not"}
5.329 - (Thm.capply (Thm.capply @{cterm "op = :: int => _"} (mk_cnumber @{ctyp "int"} x))
5.330 - @{cterm "0::int"})))
5.331 - in equal_elim (Thm.symmetric th) TrueI end;
5.332 - val notz = let val tab = fold Integertab.update
5.333 - (ds ~~ (map (fn x => nzprop (Integer.div l x)) ds)) Integertab.empty
5.334 - in
5.335 - (fn ct => (valOf (Integertab.lookup tab (ct |> term_of |> dest_numeral))
5.336 - handle Option => (writeln "noz: Theorems-Table contains no entry for";
5.337 - print_cterm ct ; raise Option)))
5.338 - end
5.339 - fun unit_conv t =
5.340 - case (term_of t) of
5.341 - Const("op &",_)$_$_ => binop_conv unit_conv t
5.342 - | Const("op |",_)$_$_ => binop_conv unit_conv t
5.343 - | Const("Not",_)$_ => arg_conv unit_conv t
5.344 - | Const(s,_)$(Const("HOL.times_class.times",_)$c$y)$ _ =>
5.345 - if x=y andalso s mem ["op =", "Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
5.346 - then cv (Integer.div l (dest_numeral c)) t else Thm.reflexive t
5.347 - | Const(s,_)$_$(Const("HOL.times_class.times",_)$c$y) =>
5.348 - if x=y andalso s mem ["Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
5.349 - then cv (Integer.div l (dest_numeral c)) t else Thm.reflexive t
5.350 - | Const("Divides.dvd",_)$d$(r as (Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c$y)$_)) =>
5.351 - if x=y then
5.352 - let
5.353 - val k = Integer.div l (dest_numeral c)
5.354 - val kt = HOLogic.mk_number iT k
5.355 - val th1 = inst' [Thm.dest_arg1 t, Thm.dest_arg t]
5.356 - ((Thm.dest_arg t |> funpow 2 Thm.dest_arg1 |> notz) RS zdvd_mono)
5.357 - val (d',t') = (mulC$kt$d, mulC$kt$r)
5.358 - val thc = (provelin ctxt ((HOLogic.eq_const iT)$d'$(lint [] d') |> HOLogic.mk_Trueprop))
5.359 - RS eq_reflection
5.360 - val tht = (provelin ctxt ((HOLogic.eq_const iT)$t'$(linear_cmul k r) |> HOLogic.mk_Trueprop))
5.361 - RS eq_reflection
5.362 - in Thm.transitive th1 (Thm.combination (Drule.arg_cong_rule dvdc thc) tht) end
5.363 - else Thm.reflexive t
5.364 - | _ => Thm.reflexive t
5.365 - val uth = unit_conv p
5.366 - val clt = mk_cnumber @{ctyp "int"} l
5.367 - val ltx = Thm.capply (Thm.capply cmulC clt) cx
5.368 - val th = Drule.arg_cong_rule e (Thm.abstract_rule (fst (dest_Free x )) cx uth)
5.369 - val th' = inst' [Thm.cabs ltx (Thm.rhs_of uth), clt] unity_coeff_ex
5.370 - val thf = transitive th
5.371 - (transitive (symmetric (beta_conversion true (cprop_of th' |> Thm.dest_arg1))) th')
5.372 - val (lth,rth) = Thm.dest_comb (cprop_of thf) |>> Thm.dest_arg |>> Thm.beta_conversion true
5.373 - ||> beta_conversion true |>> Thm.symmetric
5.374 - in transitive (transitive lth thf) rth end;
5.375 -
5.376 -
5.377 -val emptyIS = @{cterm "{}::int set"};
5.378 -val insert_tm = @{cterm "insert :: int => _"};
5.379 -val mem_tm = Const("op :",[iT , HOLogic.mk_setT iT] ---> bT);
5.380 -fun mkISet cts = fold_rev (Thm.capply insert_tm #> Thm.capply) cts emptyIS;
5.381 -val cTrp = @{cterm "Trueprop"};
5.382 -val eqelem_imp_imp = (thm"eqelem_imp_iff") RS iffD1;
5.383 -val [A_tm,B_tm] = map (fn th => cprop_of th |> funpow 2 Thm.dest_arg |> Thm.dest_abs NONE |> snd |> Thm.dest_arg1 |> Thm.dest_arg
5.384 - |> Thm.dest_abs NONE |> snd |> Thm.dest_fun |> Thm.dest_arg)
5.385 - [asetP,bsetP];
5.386 -
5.387 -val D_tm = @{cpat "?D::int"};
5.388 -
5.389 -val int_eq = (op =):integer*integer -> bool;
5.390 -fun cooperex_conv ctxt vs q =
5.391 -let
5.392 -
5.393 - val uth = unify ctxt q
5.394 - val (x,p) = Thm.dest_abs NONE (Thm.dest_arg (Thm.rhs_of uth))
5.395 - val ins = insert (op aconvc)
5.396 - fun h t (bacc,aacc,dacc) =
5.397 - case (whatis x t) of
5.398 - And (p,q) => h q (h p (bacc,aacc,dacc))
5.399 - | Or (p,q) => h q (h p (bacc,aacc,dacc))
5.400 - | Eq t => (ins (minus1 t) bacc,
5.401 - ins (plus1 t) aacc,dacc)
5.402 - | NEq t => (ins t bacc,
5.403 - ins t aacc, dacc)
5.404 - | Lt t => (bacc, ins t aacc, dacc)
5.405 - | Le t => (bacc, ins (plus1 t) aacc,dacc)
5.406 - | Gt t => (ins t bacc, aacc,dacc)
5.407 - | Ge t => (ins (minus1 t) bacc, aacc,dacc)
5.408 - | Dvd (d,s) => (bacc,aacc,insert int_eq (term_of d |> dest_numeral) dacc)
5.409 - | NDvd (d,s) => (bacc,aacc,insert int_eq (term_of d|> dest_numeral) dacc)
5.410 - | _ => (bacc, aacc, dacc)
5.411 - val (b0,a0,ds) = h p ([],[],[])
5.412 - val d = fold (curry lcm) ds 1
5.413 - val cd = mk_cnumber @{ctyp "int"} d
5.414 - val dt = term_of cd
5.415 - fun divprop x =
5.416 - let
5.417 - val th =
5.418 - Simplifier.rewrite lin_ss
5.419 - (Thm.capply @{cterm Trueprop}
5.420 - (Thm.capply (Thm.capply dvdc (mk_cnumber @{ctyp "int"} x)) cd))
5.421 - in equal_elim (Thm.symmetric th) TrueI end;
5.422 - val dvd = let val tab = fold Integertab.update
5.423 - (ds ~~ (map divprop ds)) Integertab.empty in
5.424 - (fn ct => (valOf (Integertab.lookup tab (term_of ct |> dest_numeral))
5.425 - handle Option => (writeln "dvd: Theorems-Table contains no entry for";
5.426 - print_cterm ct ; raise Option)))
5.427 - end
5.428 - val dp =
5.429 - let val th = Simplifier.rewrite lin_ss
5.430 - (Thm.capply @{cterm Trueprop}
5.431 - (Thm.capply (Thm.capply @{cterm "op < :: int => _"} @{cterm "0::int"}) cd))
5.432 - in equal_elim (Thm.symmetric th) TrueI end;
5.433 - (* A and B set *)
5.434 - local
5.435 - val insI1 = instantiate' [SOME @{ctyp "int"}] [] @{thm "insertI1"}
5.436 - val insI2 = instantiate' [SOME @{ctyp "int"}] [] @{thm "insertI2"}
5.437 - in
5.438 - fun provein x S =
5.439 - case term_of S of
5.440 - Const("{}",_) => error "Unexpected error in Cooper please email Amine Chaieb"
5.441 - | Const("insert",_)$y$_ =>
5.442 - let val (cy,S') = Thm.dest_binop S
5.443 - in if term_of x aconv y then instantiate' [] [SOME x, SOME S'] insI1
5.444 - else implies_elim (instantiate' [] [SOME x, SOME S', SOME cy] insI2)
5.445 - (provein x S')
5.446 - end
5.447 - end
5.448 -
5.449 - val al = map (lint vs o term_of) a0
5.450 - val bl = map (lint vs o term_of) b0
5.451 - val (sl,s0,f,abths,cpth) =
5.452 - if length (distinct (op aconv) bl) <= length (distinct (op aconv) al)
5.453 - then
5.454 - (bl,b0,decomp_minf,
5.455 - fn B => (map (fn th => implies_elim (Thm.instantiate ([],[(B_tm,B), (D_tm,cd)]) th) dp)
5.456 - [bseteq,bsetneq,bsetlt, bsetle, bsetgt,bsetge])@
5.457 - (map (Thm.instantiate ([],[(B_tm,B), (D_tm,cd)]))
5.458 - [bsetdvd,bsetndvd,bsetP,infDdvd, infDndvd,bsetconj,
5.459 - bsetdisj,infDconj, infDdisj]),
5.460 - cpmi)
5.461 - else (al,a0,decomp_pinf,fn A =>
5.462 - (map (fn th => implies_elim (Thm.instantiate ([],[(A_tm,A), (D_tm,cd)]) th) dp)
5.463 - [aseteq,asetneq,asetlt, asetle, asetgt,asetge])@
5.464 - (map (Thm.instantiate ([],[(A_tm,A), (D_tm,cd)]))
5.465 - [asetdvd,asetndvd, asetP, infDdvd, infDndvd,asetconj,
5.466 - asetdisj,infDconj, infDdisj]),cppi)
5.467 - val cpth =
5.468 - let
5.469 - val sths = map (fn (tl,t0) =>
5.470 - if tl = term_of t0
5.471 - then instantiate' [SOME @{ctyp "int"}] [SOME t0] refl
5.472 - else provelin ctxt ((HOLogic.eq_const iT)$tl$(term_of t0)
5.473 - |> HOLogic.mk_Trueprop))
5.474 - (sl ~~ s0)
5.475 - val csl = distinct (op aconvc) (map (cprop_of #> Thm.dest_arg #> Thm.dest_arg1) sths)
5.476 - val S = mkISet csl
5.477 - val inStab = fold (fn ct => fn tab => Termtab.update (term_of ct, provein ct S) tab)
5.478 - csl Termtab.empty
5.479 - val eqelem_th = instantiate' [SOME @{ctyp "int"}] [NONE,NONE, SOME S] eqelem_imp_imp
5.480 - val inS =
5.481 - let
5.482 - fun transmem th0 th1 =
5.483 - Thm.equal_elim
5.484 - (Drule.arg_cong_rule cTrp (Drule.fun_cong_rule (Drule.arg_cong_rule
5.485 - ((Thm.dest_fun o Thm.dest_fun o Thm.dest_arg o cprop_of) th1) th0) S)) th1
5.486 - val tab = fold Termtab.update
5.487 - (map (fn eq =>
5.488 - let val (s,t) = cprop_of eq |> Thm.dest_arg |> Thm.dest_binop
5.489 - val th = if term_of s = term_of t
5.490 - then valOf(Termtab.lookup inStab (term_of s))
5.491 - else FWD (instantiate' [] [SOME s, SOME t] eqelem_th)
5.492 - [eq, valOf(Termtab.lookup inStab (term_of s))]
5.493 - in (term_of t, th) end)
5.494 - sths) Termtab.empty
5.495 - in fn ct =>
5.496 - (valOf (Termtab.lookup tab (term_of ct))
5.497 - handle Option => (writeln "inS: No theorem for " ; print_cterm ct ; raise Option))
5.498 - end
5.499 - val (inf, nb, pd) = divide_and_conquer (f x dvd inS (abths S)) p
5.500 - in [dp, inf, nb, pd] MRS cpth
5.501 - end
5.502 - val cpth' = Thm.transitive uth (cpth RS eq_reflection)
5.503 -in Thm.transitive cpth' ((simp_thms_conv then_conv eval_conv) (Thm.rhs_of cpth'))
5.504 -end;
5.505 -
5.506 -fun literals_conv bops uops env cv =
5.507 - let fun h t =
5.508 - case (term_of t) of
5.509 - b$_$_ => if member (op aconv) bops b then binop_conv h t else cv env t
5.510 - | u$_ => if member (op aconv) uops u then arg_conv h t else cv env t
5.511 - | _ => cv env t
5.512 - in h end;
5.513 -
5.514 -fun integer_nnf_conv ctxt env =
5.515 - nnf_conv then_conv literals_conv [HOLogic.conj, HOLogic.disj] [] env (linearize_conv ctxt);
5.516 -
5.517 -(* val my_term = ref (@{cterm "NOTHING"}); *)
5.518 -local
5.519 - val pcv = Simplifier.rewrite
5.520 - (HOL_basic_ss addsimps (simp_thms @ (List.take(ex_simps,4))
5.521 - @ [not_all,all_not_ex, ex_disj_distrib]))
5.522 - val postcv = Simplifier.rewrite presburger_ss
5.523 - fun conv ctxt p =
5.524 - let val _ = () (* my_term := p *)
5.525 - in
5.526 - Qelim.gen_qelim_conv ctxt pcv postcv pcv (cons o term_of)
5.527 - (term_frees (term_of p)) (linearize_conv ctxt) (integer_nnf_conv ctxt)
5.528 - (cooperex_conv ctxt) p
5.529 - end
5.530 - handle CTERM s => raise COOPER ("Cooper Failed", CTERM s)
5.531 - | THM s => raise COOPER ("Cooper Failed", THM s)
5.532 -in val cooper_conv = conv
5.533 -end;
5.534 -end;
5.535 -
5.536 -
5.537 -
5.538 -structure Coopereif =
5.539 -struct
5.540 -
5.541 -open GeneratedCooper;
5.542 -fun cooper s = raise Cooper.COOPER ("Cooper Oracle Failed", ERROR s);
5.543 -fun i_of_term vs t =
5.544 - case t of
5.545 - Free(xn,xT) => (case AList.lookup (op aconv) vs t of
5.546 - NONE => cooper "Variable not found in the list!!"
5.547 - | SOME n => Bound n)
5.548 - | @{term "0::int"} => C 0
5.549 - | @{term "1::int"} => C 1
5.550 - | Term.Bound i => Bound i
5.551 - | Const(@{const_name "HOL.uminus"},_)$t' => Neg (i_of_term vs t')
5.552 - | Const(@{const_name "HOL.plus"},_)$t1$t2 => Add (i_of_term vs t1,i_of_term vs t2)
5.553 - | Const(@{const_name "HOL.minus"},_)$t1$t2 => Sub (i_of_term vs t1,i_of_term vs t2)
5.554 - | Const(@{const_name "HOL.times"},_)$t1$t2 =>
5.555 - (Mul (HOLogic.dest_number t1 |> snd |> Integer.machine_int,i_of_term vs t2)
5.556 - handle TERM _ =>
5.557 - (Mul (HOLogic.dest_number t2 |> snd |> Integer.machine_int,i_of_term vs t1)
5.558 - handle TERM _ => cooper "Reification: Unsupported kind of multiplication"))
5.559 - | _ => (C (HOLogic.dest_number t |> snd |> Integer.machine_int)
5.560 - handle TERM _ => cooper "Reification: unknown term");
5.561 -
5.562 -fun qf_of_term ps vs t =
5.563 - case t of
5.564 - Const("True",_) => T
5.565 - | Const("False",_) => F
5.566 - | Const(@{const_name "Orderings.less"},_)$t1$t2 => Lt (Sub (i_of_term vs t1,i_of_term vs t2))
5.567 - | Const(@{const_name "Orderings.less_eq"},_)$t1$t2 => Le (Sub(i_of_term vs t1,i_of_term vs t2))
5.568 - | Const(@{const_name "Divides.dvd"},_)$t1$t2 =>
5.569 - (Dvd(HOLogic.dest_number t1 |> snd |> Integer.machine_int, i_of_term vs t2) handle _ => cooper "Reification: unsupported dvd")
5.570 - | @{term "op = :: int => _"}$t1$t2 => Eq (Sub (i_of_term vs t1,i_of_term vs t2))
5.571 - | @{term "op = :: bool => _ "}$t1$t2 => Iff(qf_of_term ps vs t1,qf_of_term ps vs t2)
5.572 - | Const("op &",_)$t1$t2 => And(qf_of_term ps vs t1,qf_of_term ps vs t2)
5.573 - | Const("op |",_)$t1$t2 => Or(qf_of_term ps vs t1,qf_of_term ps vs t2)
5.574 - | Const("op -->",_)$t1$t2 => Imp(qf_of_term ps vs t1,qf_of_term ps vs t2)
5.575 - | Const("Not",_)$t' => NOT(qf_of_term ps vs t')
5.576 - | Const("Ex",_)$Abs(xn,xT,p) =>
5.577 - let val (xn',p') = variant_abs (xn,xT,p)
5.578 - val vs' = (Free (xn',xT), nat 0) :: (map (fn(v,n) => (v,1+ n)) vs)
5.579 - in E (qf_of_term ps vs' p')
5.580 - end
5.581 - | Const("All",_)$Abs(xn,xT,p) =>
5.582 - let val (xn',p') = variant_abs (xn,xT,p)
5.583 - val vs' = (Free (xn',xT), nat 0) :: (map (fn(v,n) => (v,1+ n)) vs)
5.584 - in A (qf_of_term ps vs' p')
5.585 - end
5.586 - | _ =>(case AList.lookup (op aconv) ps t of
5.587 - NONE => cooper "Reification: unknown term!"
5.588 - | SOME n => Closed n);
5.589 -
5.590 -local
5.591 - val ops = [@{term "op &"}, @{term "op |"}, @{term "op -->"}, @{term "op = :: bool => _"},
5.592 - @{term "op = :: int => _"}, @{term "op < :: int => _"},
5.593 - @{term "op <= :: int => _"}, @{term "Not"}, @{term "All:: (int => _) => _"},
5.594 - @{term "Ex:: (int => _) => _"}, @{term "True"}, @{term "False"}]
5.595 -fun ty t = Bool.not (fastype_of t = HOLogic.boolT)
5.596 -in
5.597 -fun term_bools acc t =
5.598 -case t of
5.599 - (l as f $ a) $ b => if ty t orelse f mem ops then term_bools (term_bools acc l)b
5.600 - else insert (op aconv) t acc
5.601 - | f $ a => if ty t orelse f mem ops then term_bools (term_bools acc f) a
5.602 - else insert (op aconv) t acc
5.603 - | Abs p => term_bools acc (snd (variant_abs p))
5.604 - | _ => if ty t orelse t mem ops then acc else insert (op aconv) t acc
5.605 -end;
5.606 -
5.607 -
5.608 -fun start_vs t =
5.609 -let
5.610 - val fs = term_frees t
5.611 - val ps = term_bools [] t
5.612 -in (fs ~~ (0 upto (length fs - 1)), ps ~~ (0 upto (length ps - 1)))
5.613 -end ;
5.614 -
5.615 -val iT = HOLogic.intT;
5.616 -val bT = HOLogic.boolT;
5.617 -fun myassoc2 l v =
5.618 - case l of
5.619 - [] => NONE
5.620 - | (x,v')::xs => if v = v' then SOME x
5.621 - else myassoc2 xs v;
5.622 -
5.623 -fun term_of_i vs t =
5.624 - case t of
5.625 - C i => HOLogic.mk_number HOLogic.intT (Integer.int i)
5.626 - | Bound n => valOf (myassoc2 vs n)
5.627 - | Neg t' => @{term "uminus :: int => _"}$(term_of_i vs t')
5.628 - | Add(t1,t2) => @{term "op +:: int => _"}$ (term_of_i vs t1)$(term_of_i vs t2)
5.629 - | Sub(t1,t2) => Const(@{const_name "HOL.minus"},[iT,iT] ---> iT)$
5.630 - (term_of_i vs t1)$(term_of_i vs t2)
5.631 - | Mul(i,t2) => Const(@{const_name "HOL.times"},[iT,iT] ---> iT)$
5.632 - (HOLogic.mk_number HOLogic.intT (Integer.int i))$(term_of_i vs t2)
5.633 - | CX(i,t')=> term_of_i vs (Add(Mul (i,Bound (nat 0)),t'));
5.634 -
5.635 -fun term_of_qf ps vs t =
5.636 - case t of
5.637 - T => HOLogic.true_const
5.638 - | F => HOLogic.false_const
5.639 - | Lt t' => @{term "op < :: int => _ "}$ term_of_i vs t'$ @{term "0::int"}
5.640 - | Le t' => @{term "op <= :: int => _ "}$ term_of_i vs t' $ @{term "0::int"}
5.641 - | Gt t' => @{term "op < :: int => _ "}$ @{term "0::int"}$ term_of_i vs t'
5.642 - | Ge t' => @{term "op <= :: int => _ "}$ @{term "0::int"}$ term_of_i vs t'
5.643 - | Eq t' => @{term "op = :: int => _ "}$ term_of_i vs t'$ @{term "0::int"}
5.644 - | NEq t' => term_of_qf ps vs (NOT(Eq t'))
5.645 - | Dvd(i,t') => @{term "op dvd :: int => _ "}$
5.646 - (HOLogic.mk_number HOLogic.intT (Integer.int i))$(term_of_i vs t')
5.647 - | NDvd(i,t')=> term_of_qf ps vs (NOT(Dvd(i,t')))
5.648 - | NOT t' => HOLogic.Not$(term_of_qf ps vs t')
5.649 - | And(t1,t2) => HOLogic.conj$(term_of_qf ps vs t1)$(term_of_qf ps vs t2)
5.650 - | Or(t1,t2) => HOLogic.disj$(term_of_qf ps vs t1)$(term_of_qf ps vs t2)
5.651 - | Imp(t1,t2) => HOLogic.imp$(term_of_qf ps vs t1)$(term_of_qf ps vs t2)
5.652 - | Iff(t1,t2) => (HOLogic.eq_const bT)$(term_of_qf ps vs t1)$ (term_of_qf ps vs t2)
5.653 - | Closed n => valOf (myassoc2 ps n)
5.654 - | NClosed n => term_of_qf ps vs (NOT (Closed n))
5.655 - | _ => cooper "If this is raised, Isabelle/HOL or generate_code is inconsistent!";
5.656 -
5.657 -(* The oracle *)
5.658 -fun cooper_oracle thy t =
5.659 - let val (vs,ps) = start_vs t
5.660 - in (equals propT) $ (HOLogic.mk_Trueprop t) $
5.661 - (HOLogic.mk_Trueprop (term_of_qf ps vs (pa (qf_of_term ps vs t))))
5.662 - end;
5.663 -
5.664 -end;
6.1 --- a/src/HOL/Tools/Presburger/cooper_data.ML Thu Jun 21 20:48:47 2007 +0200
6.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
6.3 @@ -1,91 +0,0 @@
6.4 -(* Title: HOL/Tools/Presburger/cooper_data.ML
6.5 - ID: $Id$
6.6 - Author: Amine Chaieb, TU Muenchen
6.7 -*)
6.8 -
6.9 -signature COOPER_DATA =
6.10 -sig
6.11 - type entry
6.12 - val get: Proof.context -> entry
6.13 - val del: term list -> attribute
6.14 - val add: term list -> attribute
6.15 - val setup: theory -> theory
6.16 -end;
6.17 -
6.18 -structure CooperData : COOPER_DATA =
6.19 -struct
6.20 -
6.21 -type entry = simpset * (term list);
6.22 -val start_ss = HOL_ss (* addsimps @{thms "Groebner_Basis.comp_arith"}
6.23 - addcongs [if_weak_cong, @{thm "let_weak_cong"}];*)
6.24 -val allowed_consts =
6.25 - [@{term "op + :: int => _"}, @{term "op + :: nat => _"},
6.26 - @{term "op - :: int => _"}, @{term "op - :: nat => _"},
6.27 - @{term "op * :: int => _"}, @{term "op * :: nat => _"},
6.28 - @{term "op div :: int => _"}, @{term "op div :: nat => _"},
6.29 - @{term "op mod :: int => _"}, @{term "op mod :: nat => _"},
6.30 - @{term "Numeral.Bit"},
6.31 - @{term "op &"}, @{term "op |"}, @{term "op -->"},
6.32 - @{term "op = :: int => _"}, @{term "op = :: nat => _"}, @{term "op = :: bool => _"},
6.33 - @{term "op < :: int => _"}, @{term "op < :: nat => _"},
6.34 - @{term "op <= :: int => _"}, @{term "op <= :: nat => _"},
6.35 - @{term "op dvd :: int => _"}, @{term "op dvd :: nat => _"},
6.36 - @{term "abs :: int => _"}, @{term "abs :: nat => _"},
6.37 - @{term "max :: int => _"}, @{term "max :: nat => _"},
6.38 - @{term "min :: int => _"}, @{term "min :: nat => _"},
6.39 - @{term "HOL.uminus :: int => _"}, @{term "HOL.uminus :: nat => _"},
6.40 - @{term "Not"}, @{term "Suc"},
6.41 - @{term "Ex :: (int => _) => _"}, @{term "Ex :: (nat => _) => _"},
6.42 - @{term "All :: (int => _) => _"}, @{term "All :: (nat => _) => _"},
6.43 - @{term "nat"}, @{term "int"},
6.44 - @{term "Numeral.bit.B0"},@{term "Numeral.bit.B1"},
6.45 - @{term "Numeral.Bit"}, @{term "Numeral.Pls"}, @{term "Numeral.Min"},
6.46 - @{term "Numeral.number_of :: int => int"}, @{term "Numeral.number_of :: int => nat"},
6.47 - @{term "0::int"}, @{term "1::int"}, @{term "0::nat"}, @{term "1::nat"},
6.48 - @{term "True"}, @{term "False"}];
6.49 -
6.50 -structure Data = GenericDataFun
6.51 -(
6.52 - type T = simpset * (term list);
6.53 - val empty = (start_ss, allowed_consts);
6.54 - fun extend (ss, ts) = (MetaSimplifier.inherit_context empty_ss ss, ts);
6.55 - fun merge _ ((ss1, ts1), (ss2, ts2)) =
6.56 - (merge_ss (ss1, ss2), Library.merge (op aconv) (ts1, ts2));
6.57 -);
6.58 -
6.59 -val get = Data.get o Context.Proof;
6.60 -
6.61 -fun add ts = Thm.declaration_attribute (fn th => fn context =>
6.62 - context |> Data.map (fn (ss,ts') =>
6.63 - (ss addsimps [th], merge (op aconv) (ts',ts) )))
6.64 -
6.65 -fun del ts = Thm.declaration_attribute (fn th => fn context =>
6.66 - context |> Data.map (fn (ss,ts') =>
6.67 - (ss delsimps [th], subtract (op aconv) ts' ts )))
6.68 -
6.69 -
6.70 -(* concrete syntax *)
6.71 -
6.72 -local
6.73 -fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ();
6.74 -
6.75 -val constsN = "consts";
6.76 -val any_keyword = keyword constsN
6.77 -val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat;
6.78 -val terms = thms >> map (term_of o Drule.dest_term);
6.79 -
6.80 -fun optional scan = Scan.optional scan [];
6.81 -
6.82 -in
6.83 -fun att_syntax src = src |> Attrib.syntax
6.84 - ((Scan.lift (Args.$$$ "del") |-- optional (keyword constsN |-- terms)) >> del ||
6.85 - optional (keyword constsN |-- terms) >> add)
6.86 -end;
6.87 -
6.88 -
6.89 -(* theory setup *)
6.90 -
6.91 -val setup =
6.92 - Attrib.add_attributes [("presburger", att_syntax, "Cooper data")];
6.93 -
6.94 -end;
7.1 --- a/src/HOL/Tools/Presburger/generated_cooper.ML Thu Jun 21 20:48:47 2007 +0200
7.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
7.3 @@ -1,1693 +0,0 @@
7.4 -structure GeneratedCooper =
7.5 -struct
7.6 -nonfix oo;
7.7 -fun nat i = if i < 0 then 0 else i;
7.8 -
7.9 -val one_def0 : int = (0 + 1);
7.10 -
7.11 -datatype num = C of int | Bound of int | CX of int * num | Neg of num
7.12 - | Add of num * num | Sub of num * num | Mul of int * num;
7.13 -
7.14 -fun snd (a, b) = b;
7.15 -
7.16 -fun negateSnd x = (fn (q, r) => (q, ~ r)) x;
7.17 -
7.18 -fun minus_def2 z w = (z + ~ w);
7.19 -
7.20 -fun adjust b =
7.21 - (fn (q, r) =>
7.22 - (if (0 <= minus_def2 r b) then (((2 * q) + 1), minus_def2 r b)
7.23 - else ((2 * q), r)));
7.24 -
7.25 -fun negDivAlg a b =
7.26 - (if ((0 <= (a + b)) orelse (b <= 0)) then (~1, (a + b))
7.27 - else adjust b (negDivAlg a (2 * b)));
7.28 -
7.29 -fun posDivAlg a b =
7.30 - (if ((a < b) orelse (b <= 0)) then (0, a)
7.31 - else adjust b (posDivAlg a (2 * b)));
7.32 -
7.33 -fun divAlg x =
7.34 - (fn (a, b) =>
7.35 - (if (0 <= a)
7.36 - then (if (0 <= b) then posDivAlg a b
7.37 - else (if (a = 0) then (0, 0)
7.38 - else negateSnd (negDivAlg (~ a) (~ b))))
7.39 - else (if (0 < b) then negDivAlg a b
7.40 - else negateSnd (posDivAlg (~ a) (~ b)))))
7.41 - x;
7.42 -
7.43 -fun mod_def1 a b = snd (divAlg (a, b));
7.44 -
7.45 -fun dvd m n = (mod_def1 n m = 0);
7.46 -
7.47 -fun abs i = (if (i < 0) then ~ i else i);
7.48 -
7.49 -fun less_def3 m n = ((m) < (n));
7.50 -
7.51 -fun less_eq_def3 m n = Bool.not (less_def3 n m);
7.52 -
7.53 -fun numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (c2, Bound n2), r2)) =
7.54 - (if (n1 = n2)
7.55 - then let val c = (c1 + c2)
7.56 - in (if (c = 0) then numadd (r1, r2)
7.57 - else Add (Mul (c, Bound n1), numadd (r1, r2)))
7.58 - end
7.59 - else (if less_eq_def3 n1 n2
7.60 - then Add (Mul (c1, Bound n1),
7.61 - numadd (r1, Add (Mul (c2, Bound n2), r2)))
7.62 - else Add (Mul (c2, Bound n2),
7.63 - numadd (Add (Mul (c1, Bound n1), r1), r2))))
7.64 - | numadd (Add (Mul (c1, Bound n1), r1), C afq) =
7.65 - Add (Mul (c1, Bound n1), numadd (r1, C afq))
7.66 - | numadd (Add (Mul (c1, Bound n1), r1), Bound afr) =
7.67 - Add (Mul (c1, Bound n1), numadd (r1, Bound afr))
7.68 - | numadd (Add (Mul (c1, Bound n1), r1), CX (afs, aft)) =
7.69 - Add (Mul (c1, Bound n1), numadd (r1, CX (afs, aft)))
7.70 - | numadd (Add (Mul (c1, Bound n1), r1), Neg afu) =
7.71 - Add (Mul (c1, Bound n1), numadd (r1, Neg afu))
7.72 - | numadd (Add (Mul (c1, Bound n1), r1), Add (C agx, afw)) =
7.73 - Add (Mul (c1, Bound n1), numadd (r1, Add (C agx, afw)))
7.74 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Bound agy, afw)) =
7.75 - Add (Mul (c1, Bound n1), numadd (r1, Add (Bound agy, afw)))
7.76 - | numadd (Add (Mul (c1, Bound n1), r1), Add (CX (agz, aha), afw)) =
7.77 - Add (Mul (c1, Bound n1), numadd (r1, Add (CX (agz, aha), afw)))
7.78 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Neg ahb, afw)) =
7.79 - Add (Mul (c1, Bound n1), numadd (r1, Add (Neg ahb, afw)))
7.80 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Add (ahc, ahd), afw)) =
7.81 - Add (Mul (c1, Bound n1), numadd (r1, Add (Add (ahc, ahd), afw)))
7.82 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Sub (ahe, ahf), afw)) =
7.83 - Add (Mul (c1, Bound n1), numadd (r1, Add (Sub (ahe, ahf), afw)))
7.84 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, C aie), afw)) =
7.85 - Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, C aie), afw)))
7.86 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, CX (aig, aih)), afw)) =
7.87 - Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, CX (aig, aih)), afw)))
7.88 - | numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Neg aii), afw)) =
7.89 - Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Neg aii), afw)))
7.90 - | numadd
7.91 - (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Add (aij, aik)), afw)) =
7.92 - Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Add (aij, aik)), afw)))
7.93 - | numadd
7.94 - (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Sub (ail, aim)), afw)) =
7.95 - Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Sub (ail, aim)), afw)))
7.96 - | numadd
7.97 - (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Mul (ain, aio)), afw)) =
7.98 - Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Mul (ain, aio)), afw)))
7.99 - | numadd (Add (Mul (c1, Bound n1), r1), Sub (afx, afy)) =
7.100 - Add (Mul (c1, Bound n1), numadd (r1, Sub (afx, afy)))
7.101 - | numadd (Add (Mul (c1, Bound n1), r1), Mul (afz, aga)) =
7.102 - Add (Mul (c1, Bound n1), numadd (r1, Mul (afz, aga)))
7.103 - | numadd (C w, Add (Mul (c2, Bound n2), r2)) =
7.104 - Add (Mul (c2, Bound n2), numadd (C w, r2))
7.105 - | numadd (Bound x, Add (Mul (c2, Bound n2), r2)) =
7.106 - Add (Mul (c2, Bound n2), numadd (Bound x, r2))
7.107 - | numadd (CX (y, z), Add (Mul (c2, Bound n2), r2)) =
7.108 - Add (Mul (c2, Bound n2), numadd (CX (y, z), r2))
7.109 - | numadd (Neg ab, Add (Mul (c2, Bound n2), r2)) =
7.110 - Add (Mul (c2, Bound n2), numadd (Neg ab, r2))
7.111 - | numadd (Add (C li, ad), Add (Mul (c2, Bound n2), r2)) =
7.112 - Add (Mul (c2, Bound n2), numadd (Add (C li, ad), r2))
7.113 - | numadd (Add (Bound lj, ad), Add (Mul (c2, Bound n2), r2)) =
7.114 - Add (Mul (c2, Bound n2), numadd (Add (Bound lj, ad), r2))
7.115 - | numadd (Add (CX (lk, ll), ad), Add (Mul (c2, Bound n2), r2)) =
7.116 - Add (Mul (c2, Bound n2), numadd (Add (CX (lk, ll), ad), r2))
7.117 - | numadd (Add (Neg lm, ad), Add (Mul (c2, Bound n2), r2)) =
7.118 - Add (Mul (c2, Bound n2), numadd (Add (Neg lm, ad), r2))
7.119 - | numadd (Add (Add (ln, lo), ad), Add (Mul (c2, Bound n2), r2)) =
7.120 - Add (Mul (c2, Bound n2), numadd (Add (Add (ln, lo), ad), r2))
7.121 - | numadd (Add (Sub (lp, lq), ad), Add (Mul (c2, Bound n2), r2)) =
7.122 - Add (Mul (c2, Bound n2), numadd (Add (Sub (lp, lq), ad), r2))
7.123 - | numadd (Add (Mul (lr, C abv), ad), Add (Mul (c2, Bound n2), r2)) =
7.124 - Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, C abv), ad), r2))
7.125 - | numadd (Add (Mul (lr, CX (abx, aby)), ad), Add (Mul (c2, Bound n2), r2)) =
7.126 - Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, CX (abx, aby)), ad), r2))
7.127 - | numadd (Add (Mul (lr, Neg abz), ad), Add (Mul (c2, Bound n2), r2)) =
7.128 - Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Neg abz), ad), r2))
7.129 - | numadd (Add (Mul (lr, Add (aca, acb)), ad), Add (Mul (c2, Bound n2), r2)) =
7.130 - Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Add (aca, acb)), ad), r2))
7.131 - | numadd (Add (Mul (lr, Sub (acc, acd)), ad), Add (Mul (c2, Bound n2), r2)) =
7.132 - Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Sub (acc, acd)), ad), r2))
7.133 - | numadd (Add (Mul (lr, Mul (ace, acf)), ad), Add (Mul (c2, Bound n2), r2)) =
7.134 - Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Mul (ace, acf)), ad), r2))
7.135 - | numadd (Sub (ae, af), Add (Mul (c2, Bound n2), r2)) =
7.136 - Add (Mul (c2, Bound n2), numadd (Sub (ae, af), r2))
7.137 - | numadd (Mul (ag, ah), Add (Mul (c2, Bound n2), r2)) =
7.138 - Add (Mul (c2, Bound n2), numadd (Mul (ag, ah), r2))
7.139 - | numadd (C b1, C b2) = C (b1 + b2)
7.140 - | numadd (C ai, Bound bf) = Add (C ai, Bound bf)
7.141 - | numadd (C ai, CX (bg, bh)) = Add (C ai, CX (bg, bh))
7.142 - | numadd (C ai, Neg bi) = Add (C ai, Neg bi)
7.143 - | numadd (C ai, Add (C ca, bk)) = Add (C ai, Add (C ca, bk))
7.144 - | numadd (C ai, Add (Bound cb, bk)) = Add (C ai, Add (Bound cb, bk))
7.145 - | numadd (C ai, Add (CX (cc, cd), bk)) = Add (C ai, Add (CX (cc, cd), bk))
7.146 - | numadd (C ai, Add (Neg ce, bk)) = Add (C ai, Add (Neg ce, bk))
7.147 - | numadd (C ai, Add (Add (cf, cg), bk)) = Add (C ai, Add (Add (cf, cg), bk))
7.148 - | numadd (C ai, Add (Sub (ch, ci), bk)) = Add (C ai, Add (Sub (ch, ci), bk))
7.149 - | numadd (C ai, Add (Mul (cj, C cw), bk)) =
7.150 - Add (C ai, Add (Mul (cj, C cw), bk))
7.151 - | numadd (C ai, Add (Mul (cj, CX (cy, cz)), bk)) =
7.152 - Add (C ai, Add (Mul (cj, CX (cy, cz)), bk))
7.153 - | numadd (C ai, Add (Mul (cj, Neg da), bk)) =
7.154 - Add (C ai, Add (Mul (cj, Neg da), bk))
7.155 - | numadd (C ai, Add (Mul (cj, Add (db, dc)), bk)) =
7.156 - Add (C ai, Add (Mul (cj, Add (db, dc)), bk))
7.157 - | numadd (C ai, Add (Mul (cj, Sub (dd, de)), bk)) =
7.158 - Add (C ai, Add (Mul (cj, Sub (dd, de)), bk))
7.159 - | numadd (C ai, Add (Mul (cj, Mul (df, dg)), bk)) =
7.160 - Add (C ai, Add (Mul (cj, Mul (df, dg)), bk))
7.161 - | numadd (C ai, Sub (bl, bm)) = Add (C ai, Sub (bl, bm))
7.162 - | numadd (C ai, Mul (bn, bo)) = Add (C ai, Mul (bn, bo))
7.163 - | numadd (Bound aj, C ds) = Add (Bound aj, C ds)
7.164 - | numadd (Bound aj, Bound dt) = Add (Bound aj, Bound dt)
7.165 - | numadd (Bound aj, CX (du, dv)) = Add (Bound aj, CX (du, dv))
7.166 - | numadd (Bound aj, Neg dw) = Add (Bound aj, Neg dw)
7.167 - | numadd (Bound aj, Add (C eo, dy)) = Add (Bound aj, Add (C eo, dy))
7.168 - | numadd (Bound aj, Add (Bound ep, dy)) = Add (Bound aj, Add (Bound ep, dy))
7.169 - | numadd (Bound aj, Add (CX (eq, er), dy)) =
7.170 - Add (Bound aj, Add (CX (eq, er), dy))
7.171 - | numadd (Bound aj, Add (Neg es, dy)) = Add (Bound aj, Add (Neg es, dy))
7.172 - | numadd (Bound aj, Add (Add (et, eu), dy)) =
7.173 - Add (Bound aj, Add (Add (et, eu), dy))
7.174 - | numadd (Bound aj, Add (Sub (ev, ew), dy)) =
7.175 - Add (Bound aj, Add (Sub (ev, ew), dy))
7.176 - | numadd (Bound aj, Add (Mul (ex, C fk), dy)) =
7.177 - Add (Bound aj, Add (Mul (ex, C fk), dy))
7.178 - | numadd (Bound aj, Add (Mul (ex, CX (fm, fn')), dy)) =
7.179 - Add (Bound aj, Add (Mul (ex, CX (fm, fn')), dy))
7.180 - | numadd (Bound aj, Add (Mul (ex, Neg fo), dy)) =
7.181 - Add (Bound aj, Add (Mul (ex, Neg fo), dy))
7.182 - | numadd (Bound aj, Add (Mul (ex, Add (fp, fq)), dy)) =
7.183 - Add (Bound aj, Add (Mul (ex, Add (fp, fq)), dy))
7.184 - | numadd (Bound aj, Add (Mul (ex, Sub (fr, fs)), dy)) =
7.185 - Add (Bound aj, Add (Mul (ex, Sub (fr, fs)), dy))
7.186 - | numadd (Bound aj, Add (Mul (ex, Mul (ft, fu)), dy)) =
7.187 - Add (Bound aj, Add (Mul (ex, Mul (ft, fu)), dy))
7.188 - | numadd (Bound aj, Sub (dz, ea)) = Add (Bound aj, Sub (dz, ea))
7.189 - | numadd (Bound aj, Mul (eb, ec)) = Add (Bound aj, Mul (eb, ec))
7.190 - | numadd (CX (ak, al), C gg) = Add (CX (ak, al), C gg)
7.191 - | numadd (CX (ak, al), Bound gh) = Add (CX (ak, al), Bound gh)
7.192 - | numadd (CX (ak, al), CX (gi, gj)) = Add (CX (ak, al), CX (gi, gj))
7.193 - | numadd (CX (ak, al), Neg gk) = Add (CX (ak, al), Neg gk)
7.194 - | numadd (CX (ak, al), Add (C hc, gm)) = Add (CX (ak, al), Add (C hc, gm))
7.195 - | numadd (CX (ak, al), Add (Bound hd, gm)) =
7.196 - Add (CX (ak, al), Add (Bound hd, gm))
7.197 - | numadd (CX (ak, al), Add (CX (he, hf), gm)) =
7.198 - Add (CX (ak, al), Add (CX (he, hf), gm))
7.199 - | numadd (CX (ak, al), Add (Neg hg, gm)) = Add (CX (ak, al), Add (Neg hg, gm))
7.200 - | numadd (CX (ak, al), Add (Add (hh, hi), gm)) =
7.201 - Add (CX (ak, al), Add (Add (hh, hi), gm))
7.202 - | numadd (CX (ak, al), Add (Sub (hj, hk), gm)) =
7.203 - Add (CX (ak, al), Add (Sub (hj, hk), gm))
7.204 - | numadd (CX (ak, al), Add (Mul (hl, C hy), gm)) =
7.205 - Add (CX (ak, al), Add (Mul (hl, C hy), gm))
7.206 - | numadd (CX (ak, al), Add (Mul (hl, CX (ia, ib)), gm)) =
7.207 - Add (CX (ak, al), Add (Mul (hl, CX (ia, ib)), gm))
7.208 - | numadd (CX (ak, al), Add (Mul (hl, Neg ic), gm)) =
7.209 - Add (CX (ak, al), Add (Mul (hl, Neg ic), gm))
7.210 - | numadd (CX (ak, al), Add (Mul (hl, Add (id, ie)), gm)) =
7.211 - Add (CX (ak, al), Add (Mul (hl, Add (id, ie)), gm))
7.212 - | numadd (CX (ak, al), Add (Mul (hl, Sub (if', ig)), gm)) =
7.213 - Add (CX (ak, al), Add (Mul (hl, Sub (if', ig)), gm))
7.214 - | numadd (CX (ak, al), Add (Mul (hl, Mul (ih, ii)), gm)) =
7.215 - Add (CX (ak, al), Add (Mul (hl, Mul (ih, ii)), gm))
7.216 - | numadd (CX (ak, al), Sub (gn, go)) = Add (CX (ak, al), Sub (gn, go))
7.217 - | numadd (CX (ak, al), Mul (gp, gq)) = Add (CX (ak, al), Mul (gp, gq))
7.218 - | numadd (Neg am, C iu) = Add (Neg am, C iu)
7.219 - | numadd (Neg am, Bound iv) = Add (Neg am, Bound iv)
7.220 - | numadd (Neg am, CX (iw, ix)) = Add (Neg am, CX (iw, ix))
7.221 - | numadd (Neg am, Neg iy) = Add (Neg am, Neg iy)
7.222 - | numadd (Neg am, Add (C jq, ja)) = Add (Neg am, Add (C jq, ja))
7.223 - | numadd (Neg am, Add (Bound jr, ja)) = Add (Neg am, Add (Bound jr, ja))
7.224 - | numadd (Neg am, Add (CX (js, jt), ja)) = Add (Neg am, Add (CX (js, jt), ja))
7.225 - | numadd (Neg am, Add (Neg ju, ja)) = Add (Neg am, Add (Neg ju, ja))
7.226 - | numadd (Neg am, Add (Add (jv, jw), ja)) =
7.227 - Add (Neg am, Add (Add (jv, jw), ja))
7.228 - | numadd (Neg am, Add (Sub (jx, jy), ja)) =
7.229 - Add (Neg am, Add (Sub (jx, jy), ja))
7.230 - | numadd (Neg am, Add (Mul (jz, C km), ja)) =
7.231 - Add (Neg am, Add (Mul (jz, C km), ja))
7.232 - | numadd (Neg am, Add (Mul (jz, CX (ko, kp)), ja)) =
7.233 - Add (Neg am, Add (Mul (jz, CX (ko, kp)), ja))
7.234 - | numadd (Neg am, Add (Mul (jz, Neg kq), ja)) =
7.235 - Add (Neg am, Add (Mul (jz, Neg kq), ja))
7.236 - | numadd (Neg am, Add (Mul (jz, Add (kr, ks)), ja)) =
7.237 - Add (Neg am, Add (Mul (jz, Add (kr, ks)), ja))
7.238 - | numadd (Neg am, Add (Mul (jz, Sub (kt, ku)), ja)) =
7.239 - Add (Neg am, Add (Mul (jz, Sub (kt, ku)), ja))
7.240 - | numadd (Neg am, Add (Mul (jz, Mul (kv, kw)), ja)) =
7.241 - Add (Neg am, Add (Mul (jz, Mul (kv, kw)), ja))
7.242 - | numadd (Neg am, Sub (jb, jc)) = Add (Neg am, Sub (jb, jc))
7.243 - | numadd (Neg am, Mul (jd, je)) = Add (Neg am, Mul (jd, je))
7.244 - | numadd (Add (C lt, ao), C mp) = Add (Add (C lt, ao), C mp)
7.245 - | numadd (Add (C lt, ao), Bound mq) = Add (Add (C lt, ao), Bound mq)
7.246 - | numadd (Add (C lt, ao), CX (mr, ms)) = Add (Add (C lt, ao), CX (mr, ms))
7.247 - | numadd (Add (C lt, ao), Neg mt) = Add (Add (C lt, ao), Neg mt)
7.248 - | numadd (Add (C lt, ao), Add (C nl, mv)) =
7.249 - Add (Add (C lt, ao), Add (C nl, mv))
7.250 - | numadd (Add (C lt, ao), Add (Bound nm, mv)) =
7.251 - Add (Add (C lt, ao), Add (Bound nm, mv))
7.252 - | numadd (Add (C lt, ao), Add (CX (nn, no), mv)) =
7.253 - Add (Add (C lt, ao), Add (CX (nn, no), mv))
7.254 - | numadd (Add (C lt, ao), Add (Neg np, mv)) =
7.255 - Add (Add (C lt, ao), Add (Neg np, mv))
7.256 - | numadd (Add (C lt, ao), Add (Add (nq, nr), mv)) =
7.257 - Add (Add (C lt, ao), Add (Add (nq, nr), mv))
7.258 - | numadd (Add (C lt, ao), Add (Sub (ns, nt), mv)) =
7.259 - Add (Add (C lt, ao), Add (Sub (ns, nt), mv))
7.260 - | numadd (Add (C lt, ao), Add (Mul (nu, C oh), mv)) =
7.261 - Add (Add (C lt, ao), Add (Mul (nu, C oh), mv))
7.262 - | numadd (Add (C lt, ao), Add (Mul (nu, CX (oj, ok)), mv)) =
7.263 - Add (Add (C lt, ao), Add (Mul (nu, CX (oj, ok)), mv))
7.264 - | numadd (Add (C lt, ao), Add (Mul (nu, Neg ol), mv)) =
7.265 - Add (Add (C lt, ao), Add (Mul (nu, Neg ol), mv))
7.266 - | numadd (Add (C lt, ao), Add (Mul (nu, Add (om, on)), mv)) =
7.267 - Add (Add (C lt, ao), Add (Mul (nu, Add (om, on)), mv))
7.268 - | numadd (Add (C lt, ao), Add (Mul (nu, Sub (oo, op')), mv)) =
7.269 - Add (Add (C lt, ao), Add (Mul (nu, Sub (oo, op')), mv))
7.270 - | numadd (Add (C lt, ao), Add (Mul (nu, Mul (oq, or)), mv)) =
7.271 - Add (Add (C lt, ao), Add (Mul (nu, Mul (oq, or)), mv))
7.272 - | numadd (Add (C lt, ao), Sub (mw, mx)) = Add (Add (C lt, ao), Sub (mw, mx))
7.273 - | numadd (Add (C lt, ao), Mul (my, mz)) = Add (Add (C lt, ao), Mul (my, mz))
7.274 - | numadd (Add (Bound lu, ao), C pd) = Add (Add (Bound lu, ao), C pd)
7.275 - | numadd (Add (Bound lu, ao), Bound pe) = Add (Add (Bound lu, ao), Bound pe)
7.276 - | numadd (Add (Bound lu, ao), CX (pf, pg)) =
7.277 - Add (Add (Bound lu, ao), CX (pf, pg))
7.278 - | numadd (Add (Bound lu, ao), Neg ph) = Add (Add (Bound lu, ao), Neg ph)
7.279 - | numadd (Add (Bound lu, ao), Add (C pz, pj)) =
7.280 - Add (Add (Bound lu, ao), Add (C pz, pj))
7.281 - | numadd (Add (Bound lu, ao), Add (Bound qa, pj)) =
7.282 - Add (Add (Bound lu, ao), Add (Bound qa, pj))
7.283 - | numadd (Add (Bound lu, ao), Add (CX (qb, qc), pj)) =
7.284 - Add (Add (Bound lu, ao), Add (CX (qb, qc), pj))
7.285 - | numadd (Add (Bound lu, ao), Add (Neg qd, pj)) =
7.286 - Add (Add (Bound lu, ao), Add (Neg qd, pj))
7.287 - | numadd (Add (Bound lu, ao), Add (Add (qe, qf), pj)) =
7.288 - Add (Add (Bound lu, ao), Add (Add (qe, qf), pj))
7.289 - | numadd (Add (Bound lu, ao), Add (Sub (qg, qh), pj)) =
7.290 - Add (Add (Bound lu, ao), Add (Sub (qg, qh), pj))
7.291 - | numadd (Add (Bound lu, ao), Add (Mul (qi, C qv), pj)) =
7.292 - Add (Add (Bound lu, ao), Add (Mul (qi, C qv), pj))
7.293 - | numadd (Add (Bound lu, ao), Add (Mul (qi, CX (qx, qy)), pj)) =
7.294 - Add (Add (Bound lu, ao), Add (Mul (qi, CX (qx, qy)), pj))
7.295 - | numadd (Add (Bound lu, ao), Add (Mul (qi, Neg qz), pj)) =
7.296 - Add (Add (Bound lu, ao), Add (Mul (qi, Neg qz), pj))
7.297 - | numadd (Add (Bound lu, ao), Add (Mul (qi, Add (ra, rb)), pj)) =
7.298 - Add (Add (Bound lu, ao), Add (Mul (qi, Add (ra, rb)), pj))
7.299 - | numadd (Add (Bound lu, ao), Add (Mul (qi, Sub (rc, rd)), pj)) =
7.300 - Add (Add (Bound lu, ao), Add (Mul (qi, Sub (rc, rd)), pj))
7.301 - | numadd (Add (Bound lu, ao), Add (Mul (qi, Mul (re, rf)), pj)) =
7.302 - Add (Add (Bound lu, ao), Add (Mul (qi, Mul (re, rf)), pj))
7.303 - | numadd (Add (Bound lu, ao), Sub (pk, pl)) =
7.304 - Add (Add (Bound lu, ao), Sub (pk, pl))
7.305 - | numadd (Add (Bound lu, ao), Mul (pm, pn)) =
7.306 - Add (Add (Bound lu, ao), Mul (pm, pn))
7.307 - | numadd (Add (CX (lv, lw), ao), C rr) = Add (Add (CX (lv, lw), ao), C rr)
7.308 - | numadd (Add (CX (lv, lw), ao), Bound rs) =
7.309 - Add (Add (CX (lv, lw), ao), Bound rs)
7.310 - | numadd (Add (CX (lv, lw), ao), CX (rt, ru)) =
7.311 - Add (Add (CX (lv, lw), ao), CX (rt, ru))
7.312 - | numadd (Add (CX (lv, lw), ao), Neg rv) = Add (Add (CX (lv, lw), ao), Neg rv)
7.313 - | numadd (Add (CX (lv, lw), ao), Add (C sn, rx)) =
7.314 - Add (Add (CX (lv, lw), ao), Add (C sn, rx))
7.315 - | numadd (Add (CX (lv, lw), ao), Add (Bound so, rx)) =
7.316 - Add (Add (CX (lv, lw), ao), Add (Bound so, rx))
7.317 - | numadd (Add (CX (lv, lw), ao), Add (CX (sp, sq), rx)) =
7.318 - Add (Add (CX (lv, lw), ao), Add (CX (sp, sq), rx))
7.319 - | numadd (Add (CX (lv, lw), ao), Add (Neg sr, rx)) =
7.320 - Add (Add (CX (lv, lw), ao), Add (Neg sr, rx))
7.321 - | numadd (Add (CX (lv, lw), ao), Add (Add (ss, st), rx)) =
7.322 - Add (Add (CX (lv, lw), ao), Add (Add (ss, st), rx))
7.323 - | numadd (Add (CX (lv, lw), ao), Add (Sub (su, sv), rx)) =
7.324 - Add (Add (CX (lv, lw), ao), Add (Sub (su, sv), rx))
7.325 - | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, C tj), rx)) =
7.326 - Add (Add (CX (lv, lw), ao), Add (Mul (sw, C tj), rx))
7.327 - | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, CX (tl, tm)), rx)) =
7.328 - Add (Add (CX (lv, lw), ao), Add (Mul (sw, CX (tl, tm)), rx))
7.329 - | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Neg tn), rx)) =
7.330 - Add (Add (CX (lv, lw), ao), Add (Mul (sw, Neg tn), rx))
7.331 - | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Add (to, tp)), rx)) =
7.332 - Add (Add (CX (lv, lw), ao), Add (Mul (sw, Add (to, tp)), rx))
7.333 - | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Sub (tq, tr)), rx)) =
7.334 - Add (Add (CX (lv, lw), ao), Add (Mul (sw, Sub (tq, tr)), rx))
7.335 - | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Mul (ts, tt)), rx)) =
7.336 - Add (Add (CX (lv, lw), ao), Add (Mul (sw, Mul (ts, tt)), rx))
7.337 - | numadd (Add (CX (lv, lw), ao), Sub (ry, rz)) =
7.338 - Add (Add (CX (lv, lw), ao), Sub (ry, rz))
7.339 - | numadd (Add (CX (lv, lw), ao), Mul (sa, sb)) =
7.340 - Add (Add (CX (lv, lw), ao), Mul (sa, sb))
7.341 - | numadd (Add (Neg lx, ao), C uf) = Add (Add (Neg lx, ao), C uf)
7.342 - | numadd (Add (Neg lx, ao), Bound ug) = Add (Add (Neg lx, ao), Bound ug)
7.343 - | numadd (Add (Neg lx, ao), CX (uh, ui)) = Add (Add (Neg lx, ao), CX (uh, ui))
7.344 - | numadd (Add (Neg lx, ao), Neg uj) = Add (Add (Neg lx, ao), Neg uj)
7.345 - | numadd (Add (Neg lx, ao), Add (C vb, ul)) =
7.346 - Add (Add (Neg lx, ao), Add (C vb, ul))
7.347 - | numadd (Add (Neg lx, ao), Add (Bound vc, ul)) =
7.348 - Add (Add (Neg lx, ao), Add (Bound vc, ul))
7.349 - | numadd (Add (Neg lx, ao), Add (CX (vd, ve), ul)) =
7.350 - Add (Add (Neg lx, ao), Add (CX (vd, ve), ul))
7.351 - | numadd (Add (Neg lx, ao), Add (Neg vf, ul)) =
7.352 - Add (Add (Neg lx, ao), Add (Neg vf, ul))
7.353 - | numadd (Add (Neg lx, ao), Add (Add (vg, vh), ul)) =
7.354 - Add (Add (Neg lx, ao), Add (Add (vg, vh), ul))
7.355 - | numadd (Add (Neg lx, ao), Add (Sub (vi, vj), ul)) =
7.356 - Add (Add (Neg lx, ao), Add (Sub (vi, vj), ul))
7.357 - | numadd (Add (Neg lx, ao), Add (Mul (vk, C vx), ul)) =
7.358 - Add (Add (Neg lx, ao), Add (Mul (vk, C vx), ul))
7.359 - | numadd (Add (Neg lx, ao), Add (Mul (vk, CX (vz, wa)), ul)) =
7.360 - Add (Add (Neg lx, ao), Add (Mul (vk, CX (vz, wa)), ul))
7.361 - | numadd (Add (Neg lx, ao), Add (Mul (vk, Neg wb), ul)) =
7.362 - Add (Add (Neg lx, ao), Add (Mul (vk, Neg wb), ul))
7.363 - | numadd (Add (Neg lx, ao), Add (Mul (vk, Add (wc, wd)), ul)) =
7.364 - Add (Add (Neg lx, ao), Add (Mul (vk, Add (wc, wd)), ul))
7.365 - | numadd (Add (Neg lx, ao), Add (Mul (vk, Sub (we, wf)), ul)) =
7.366 - Add (Add (Neg lx, ao), Add (Mul (vk, Sub (we, wf)), ul))
7.367 - | numadd (Add (Neg lx, ao), Add (Mul (vk, Mul (wg, wh)), ul)) =
7.368 - Add (Add (Neg lx, ao), Add (Mul (vk, Mul (wg, wh)), ul))
7.369 - | numadd (Add (Neg lx, ao), Sub (um, un)) =
7.370 - Add (Add (Neg lx, ao), Sub (um, un))
7.371 - | numadd (Add (Neg lx, ao), Mul (uo, up)) =
7.372 - Add (Add (Neg lx, ao), Mul (uo, up))
7.373 - | numadd (Add (Add (ly, lz), ao), C wt) = Add (Add (Add (ly, lz), ao), C wt)
7.374 - | numadd (Add (Add (ly, lz), ao), Bound wu) =
7.375 - Add (Add (Add (ly, lz), ao), Bound wu)
7.376 - | numadd (Add (Add (ly, lz), ao), CX (wv, ww)) =
7.377 - Add (Add (Add (ly, lz), ao), CX (wv, ww))
7.378 - | numadd (Add (Add (ly, lz), ao), Neg wx) =
7.379 - Add (Add (Add (ly, lz), ao), Neg wx)
7.380 - | numadd (Add (Add (ly, lz), ao), Add (C xp, wz)) =
7.381 - Add (Add (Add (ly, lz), ao), Add (C xp, wz))
7.382 - | numadd (Add (Add (ly, lz), ao), Add (Bound xq, wz)) =
7.383 - Add (Add (Add (ly, lz), ao), Add (Bound xq, wz))
7.384 - | numadd (Add (Add (ly, lz), ao), Add (CX (xr, xs), wz)) =
7.385 - Add (Add (Add (ly, lz), ao), Add (CX (xr, xs), wz))
7.386 - | numadd (Add (Add (ly, lz), ao), Add (Neg xt, wz)) =
7.387 - Add (Add (Add (ly, lz), ao), Add (Neg xt, wz))
7.388 - | numadd (Add (Add (ly, lz), ao), Add (Add (xu, xv), wz)) =
7.389 - Add (Add (Add (ly, lz), ao), Add (Add (xu, xv), wz))
7.390 - | numadd (Add (Add (ly, lz), ao), Add (Sub (xw, xx), wz)) =
7.391 - Add (Add (Add (ly, lz), ao), Add (Sub (xw, xx), wz))
7.392 - | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, C yl), wz)) =
7.393 - Add (Add (Add (ly, lz), ao), Add (Mul (xy, C yl), wz))
7.394 - | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, CX (yn, yo)), wz)) =
7.395 - Add (Add (Add (ly, lz), ao), Add (Mul (xy, CX (yn, yo)), wz))
7.396 - | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Neg yp), wz)) =
7.397 - Add (Add (Add (ly, lz), ao), Add (Mul (xy, Neg yp), wz))
7.398 - | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Add (yq, yr)), wz)) =
7.399 - Add (Add (Add (ly, lz), ao), Add (Mul (xy, Add (yq, yr)), wz))
7.400 - | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Sub (ys, yt)), wz)) =
7.401 - Add (Add (Add (ly, lz), ao), Add (Mul (xy, Sub (ys, yt)), wz))
7.402 - | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Mul (yu, yv)), wz)) =
7.403 - Add (Add (Add (ly, lz), ao), Add (Mul (xy, Mul (yu, yv)), wz))
7.404 - | numadd (Add (Add (ly, lz), ao), Sub (xa, xb)) =
7.405 - Add (Add (Add (ly, lz), ao), Sub (xa, xb))
7.406 - | numadd (Add (Add (ly, lz), ao), Mul (xc, xd)) =
7.407 - Add (Add (Add (ly, lz), ao), Mul (xc, xd))
7.408 - | numadd (Add (Sub (ma, mb), ao), C zh) = Add (Add (Sub (ma, mb), ao), C zh)
7.409 - | numadd (Add (Sub (ma, mb), ao), Bound zi) =
7.410 - Add (Add (Sub (ma, mb), ao), Bound zi)
7.411 - | numadd (Add (Sub (ma, mb), ao), CX (zj, zk)) =
7.412 - Add (Add (Sub (ma, mb), ao), CX (zj, zk))
7.413 - | numadd (Add (Sub (ma, mb), ao), Neg zl) =
7.414 - Add (Add (Sub (ma, mb), ao), Neg zl)
7.415 - | numadd (Add (Sub (ma, mb), ao), Add (C aad, zn)) =
7.416 - Add (Add (Sub (ma, mb), ao), Add (C aad, zn))
7.417 - | numadd (Add (Sub (ma, mb), ao), Add (Bound aae, zn)) =
7.418 - Add (Add (Sub (ma, mb), ao), Add (Bound aae, zn))
7.419 - | numadd (Add (Sub (ma, mb), ao), Add (CX (aaf, aag), zn)) =
7.420 - Add (Add (Sub (ma, mb), ao), Add (CX (aaf, aag), zn))
7.421 - | numadd (Add (Sub (ma, mb), ao), Add (Neg aah, zn)) =
7.422 - Add (Add (Sub (ma, mb), ao), Add (Neg aah, zn))
7.423 - | numadd (Add (Sub (ma, mb), ao), Add (Add (aai, aaj), zn)) =
7.424 - Add (Add (Sub (ma, mb), ao), Add (Add (aai, aaj), zn))
7.425 - | numadd (Add (Sub (ma, mb), ao), Add (Sub (aak, aal), zn)) =
7.426 - Add (Add (Sub (ma, mb), ao), Add (Sub (aak, aal), zn))
7.427 - | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, C aaz), zn)) =
7.428 - Add (Add (Sub (ma, mb), ao), Add (Mul (aam, C aaz), zn))
7.429 - | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, CX (abb, abc)), zn)) =
7.430 - Add (Add (Sub (ma, mb), ao), Add (Mul (aam, CX (abb, abc)), zn))
7.431 - | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Neg abd), zn)) =
7.432 - Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Neg abd), zn))
7.433 - | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Add (abe, abf)), zn)) =
7.434 - Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Add (abe, abf)), zn))
7.435 - | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Sub (abg, abh)), zn)) =
7.436 - Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Sub (abg, abh)), zn))
7.437 - | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Mul (abi, abj)), zn)) =
7.438 - Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Mul (abi, abj)), zn))
7.439 - | numadd (Add (Sub (ma, mb), ao), Sub (zo, zp)) =
7.440 - Add (Add (Sub (ma, mb), ao), Sub (zo, zp))
7.441 - | numadd (Add (Sub (ma, mb), ao), Mul (zq, zr)) =
7.442 - Add (Add (Sub (ma, mb), ao), Mul (zq, zr))
7.443 - | numadd (Add (Mul (mc, C acg), ao), C adc) =
7.444 - Add (Add (Mul (mc, C acg), ao), C adc)
7.445 - | numadd (Add (Mul (mc, C acg), ao), Bound add) =
7.446 - Add (Add (Mul (mc, C acg), ao), Bound add)
7.447 - | numadd (Add (Mul (mc, C acg), ao), CX (ade, adf)) =
7.448 - Add (Add (Mul (mc, C acg), ao), CX (ade, adf))
7.449 - | numadd (Add (Mul (mc, C acg), ao), Neg adg) =
7.450 - Add (Add (Mul (mc, C acg), ao), Neg adg)
7.451 - | numadd (Add (Mul (mc, C acg), ao), Add (C ady, adi)) =
7.452 - Add (Add (Mul (mc, C acg), ao), Add (C ady, adi))
7.453 - | numadd (Add (Mul (mc, C acg), ao), Add (Bound adz, adi)) =
7.454 - Add (Add (Mul (mc, C acg), ao), Add (Bound adz, adi))
7.455 - | numadd (Add (Mul (mc, C acg), ao), Add (CX (aea, aeb), adi)) =
7.456 - Add (Add (Mul (mc, C acg), ao), Add (CX (aea, aeb), adi))
7.457 - | numadd (Add (Mul (mc, C acg), ao), Add (Neg aec, adi)) =
7.458 - Add (Add (Mul (mc, C acg), ao), Add (Neg aec, adi))
7.459 - | numadd (Add (Mul (mc, C acg), ao), Add (Add (aed, aee), adi)) =
7.460 - Add (Add (Mul (mc, C acg), ao), Add (Add (aed, aee), adi))
7.461 - | numadd (Add (Mul (mc, C acg), ao), Add (Sub (aef, aeg), adi)) =
7.462 - Add (Add (Mul (mc, C acg), ao), Add (Sub (aef, aeg), adi))
7.463 - | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, C aeu), adi)) =
7.464 - Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, C aeu), adi))
7.465 - | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, CX (aew, aex)), adi)) =
7.466 - Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, CX (aew, aex)), adi))
7.467 - | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Neg aey), adi)) =
7.468 - Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Neg aey), adi))
7.469 - | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Add (aez, afa)), adi)) =
7.470 - Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Add (aez, afa)), adi))
7.471 - | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Sub (afb, afc)), adi)) =
7.472 - Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Sub (afb, afc)), adi))
7.473 - | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Mul (afd, afe)), adi)) =
7.474 - Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Mul (afd, afe)), adi))
7.475 - | numadd (Add (Mul (mc, C acg), ao), Sub (adj, adk)) =
7.476 - Add (Add (Mul (mc, C acg), ao), Sub (adj, adk))
7.477 - | numadd (Add (Mul (mc, C acg), ao), Mul (adl, adm)) =
7.478 - Add (Add (Mul (mc, C acg), ao), Mul (adl, adm))
7.479 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), C ajl) =
7.480 - Add (Add (Mul (mc, CX (aci, acj)), ao), C ajl)
7.481 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Bound ajm) =
7.482 - Add (Add (Mul (mc, CX (aci, acj)), ao), Bound ajm)
7.483 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), CX (ajn, ajo)) =
7.484 - Add (Add (Mul (mc, CX (aci, acj)), ao), CX (ajn, ajo))
7.485 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Neg ajp) =
7.486 - Add (Add (Mul (mc, CX (aci, acj)), ao), Neg ajp)
7.487 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (C akh, ajr)) =
7.488 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (C akh, ajr))
7.489 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Bound aki, ajr)) =
7.490 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Bound aki, ajr))
7.491 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (CX (akj, akk), ajr)) =
7.492 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (CX (akj, akk), ajr))
7.493 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Neg akl, ajr)) =
7.494 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Neg akl, ajr))
7.495 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Add (akm, akn), ajr)) =
7.496 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Add (akm, akn), ajr))
7.497 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Sub (ako, akp), ajr)) =
7.498 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Sub (ako, akp), ajr))
7.499 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, C ald), ajr)) =
7.500 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, C ald), ajr))
7.501 - | numadd
7.502 - (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, CX (alf, alg)), ajr)) =
7.503 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, CX (alf, alg)), ajr))
7.504 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, Neg alh), ajr)) =
7.505 - Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, Neg alh), ajr))
7.506 - | numadd
7.507 - (Add (Mul (mc, CX (aci, acj)), ao),
7.508 - Add (Mul (akq, Add (ali, alj)), ajr)) =
7.509 - Add (Add (Mul (mc, CX (aci, acj)), ao),
7.510 - Add (Mul (akq, Add (ali, alj)), ajr))
7.511 - | numadd
7.512 - (Add (Mul (mc, CX (aci, acj)), ao),
7.513 - Add (Mul (akq, Sub (alk, all)), ajr)) =
7.514 - Add (Add (Mul (mc, CX (aci, acj)), ao),
7.515 - Add (Mul (akq, Sub (alk, all)), ajr))
7.516 - | numadd
7.517 - (Add (Mul (mc, CX (aci, acj)), ao),
7.518 - Add (Mul (akq, Mul (alm, aln)), ajr)) =
7.519 - Add (Add (Mul (mc, CX (aci, acj)), ao),
7.520 - Add (Mul (akq, Mul (alm, aln)), ajr))
7.521 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Sub (ajs, ajt)) =
7.522 - Add (Add (Mul (mc, CX (aci, acj)), ao), Sub (ajs, ajt))
7.523 - | numadd (Add (Mul (mc, CX (aci, acj)), ao), Mul (aju, ajv)) =
7.524 - Add (Add (Mul (mc, CX (aci, acj)), ao), Mul (aju, ajv))
7.525 - | numadd (Add (Mul (mc, Neg ack), ao), C alz) =
7.526 - Add (Add (Mul (mc, Neg ack), ao), C alz)
7.527 - | numadd (Add (Mul (mc, Neg ack), ao), Bound ama) =
7.528 - Add (Add (Mul (mc, Neg ack), ao), Bound ama)
7.529 - | numadd (Add (Mul (mc, Neg ack), ao), CX (amb, amc)) =
7.530 - Add (Add (Mul (mc, Neg ack), ao), CX (amb, amc))
7.531 - | numadd (Add (Mul (mc, Neg ack), ao), Neg amd) =
7.532 - Add (Add (Mul (mc, Neg ack), ao), Neg amd)
7.533 - | numadd (Add (Mul (mc, Neg ack), ao), Add (C amv, amf)) =
7.534 - Add (Add (Mul (mc, Neg ack), ao), Add (C amv, amf))
7.535 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Bound amw, amf)) =
7.536 - Add (Add (Mul (mc, Neg ack), ao), Add (Bound amw, amf))
7.537 - | numadd (Add (Mul (mc, Neg ack), ao), Add (CX (amx, amy), amf)) =
7.538 - Add (Add (Mul (mc, Neg ack), ao), Add (CX (amx, amy), amf))
7.539 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Neg amz, amf)) =
7.540 - Add (Add (Mul (mc, Neg ack), ao), Add (Neg amz, amf))
7.541 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Add (ana, anb), amf)) =
7.542 - Add (Add (Mul (mc, Neg ack), ao), Add (Add (ana, anb), amf))
7.543 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Sub (anc, and'), amf)) =
7.544 - Add (Add (Mul (mc, Neg ack), ao), Add (Sub (anc, and'), amf))
7.545 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, C anr), amf)) =
7.546 - Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, C anr), amf))
7.547 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, CX (ant, anu)), amf)) =
7.548 - Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, CX (ant, anu)), amf))
7.549 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Neg anv), amf)) =
7.550 - Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Neg anv), amf))
7.551 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Add (anw, anx)), amf)) =
7.552 - Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Add (anw, anx)), amf))
7.553 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Sub (any, anz)), amf)) =
7.554 - Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Sub (any, anz)), amf))
7.555 - | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Mul (aoa, aob)), amf)) =
7.556 - Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Mul (aoa, aob)), amf))
7.557 - | numadd (Add (Mul (mc, Neg ack), ao), Sub (amg, amh)) =
7.558 - Add (Add (Mul (mc, Neg ack), ao), Sub (amg, amh))
7.559 - | numadd (Add (Mul (mc, Neg ack), ao), Mul (ami, amj)) =
7.560 - Add (Add (Mul (mc, Neg ack), ao), Mul (ami, amj))
7.561 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), C aon) =
7.562 - Add (Add (Mul (mc, Add (acl, acm)), ao), C aon)
7.563 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Bound aoo) =
7.564 - Add (Add (Mul (mc, Add (acl, acm)), ao), Bound aoo)
7.565 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), CX (aop, aoq)) =
7.566 - Add (Add (Mul (mc, Add (acl, acm)), ao), CX (aop, aoq))
7.567 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Neg aor) =
7.568 - Add (Add (Mul (mc, Add (acl, acm)), ao), Neg aor)
7.569 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (C apj, aot)) =
7.570 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (C apj, aot))
7.571 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Bound apk, aot)) =
7.572 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Bound apk, aot))
7.573 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (CX (apl, apm), aot)) =
7.574 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (CX (apl, apm), aot))
7.575 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Neg apn, aot)) =
7.576 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Neg apn, aot))
7.577 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Add (apo, app), aot)) =
7.578 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Add (apo, app), aot))
7.579 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Sub (apq, apr), aot)) =
7.580 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Sub (apq, apr), aot))
7.581 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, C aqf), aot)) =
7.582 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, C aqf), aot))
7.583 - | numadd
7.584 - (Add (Mul (mc, Add (acl, acm)), ao),
7.585 - Add (Mul (aps, CX (aqh, aqi)), aot)) =
7.586 - Add (Add (Mul (mc, Add (acl, acm)), ao),
7.587 - Add (Mul (aps, CX (aqh, aqi)), aot))
7.588 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, Neg aqj), aot)) =
7.589 - Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, Neg aqj), aot))
7.590 - | numadd
7.591 - (Add (Mul (mc, Add (acl, acm)), ao),
7.592 - Add (Mul (aps, Add (aqk, aql)), aot)) =
7.593 - Add (Add (Mul (mc, Add (acl, acm)), ao),
7.594 - Add (Mul (aps, Add (aqk, aql)), aot))
7.595 - | numadd
7.596 - (Add (Mul (mc, Add (acl, acm)), ao),
7.597 - Add (Mul (aps, Sub (aqm, aqn)), aot)) =
7.598 - Add (Add (Mul (mc, Add (acl, acm)), ao),
7.599 - Add (Mul (aps, Sub (aqm, aqn)), aot))
7.600 - | numadd
7.601 - (Add (Mul (mc, Add (acl, acm)), ao),
7.602 - Add (Mul (aps, Mul (aqo, aqp)), aot)) =
7.603 - Add (Add (Mul (mc, Add (acl, acm)), ao),
7.604 - Add (Mul (aps, Mul (aqo, aqp)), aot))
7.605 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Sub (aou, aov)) =
7.606 - Add (Add (Mul (mc, Add (acl, acm)), ao), Sub (aou, aov))
7.607 - | numadd (Add (Mul (mc, Add (acl, acm)), ao), Mul (aow, aox)) =
7.608 - Add (Add (Mul (mc, Add (acl, acm)), ao), Mul (aow, aox))
7.609 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), C arb) =
7.610 - Add (Add (Mul (mc, Sub (acn, aco)), ao), C arb)
7.611 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Bound arc) =
7.612 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Bound arc)
7.613 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), CX (ard, are)) =
7.614 - Add (Add (Mul (mc, Sub (acn, aco)), ao), CX (ard, are))
7.615 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Neg arf) =
7.616 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Neg arf)
7.617 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (C arx, arh)) =
7.618 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (C arx, arh))
7.619 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Bound ary, arh)) =
7.620 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Bound ary, arh))
7.621 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (CX (arz, asa), arh)) =
7.622 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (CX (arz, asa), arh))
7.623 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Neg asb, arh)) =
7.624 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Neg asb, arh))
7.625 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Add (asc, asd), arh)) =
7.626 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Add (asc, asd), arh))
7.627 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Sub (ase, asf), arh)) =
7.628 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Sub (ase, asf), arh))
7.629 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, C ast), arh)) =
7.630 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, C ast), arh))
7.631 - | numadd
7.632 - (Add (Mul (mc, Sub (acn, aco)), ao),
7.633 - Add (Mul (asg, CX (asv, asw)), arh)) =
7.634 - Add (Add (Mul (mc, Sub (acn, aco)), ao),
7.635 - Add (Mul (asg, CX (asv, asw)), arh))
7.636 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, Neg asx), arh)) =
7.637 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, Neg asx), arh))
7.638 - | numadd
7.639 - (Add (Mul (mc, Sub (acn, aco)), ao),
7.640 - Add (Mul (asg, Add (asy, asz)), arh)) =
7.641 - Add (Add (Mul (mc, Sub (acn, aco)), ao),
7.642 - Add (Mul (asg, Add (asy, asz)), arh))
7.643 - | numadd
7.644 - (Add (Mul (mc, Sub (acn, aco)), ao),
7.645 - Add (Mul (asg, Sub (ata, atb)), arh)) =
7.646 - Add (Add (Mul (mc, Sub (acn, aco)), ao),
7.647 - Add (Mul (asg, Sub (ata, atb)), arh))
7.648 - | numadd
7.649 - (Add (Mul (mc, Sub (acn, aco)), ao),
7.650 - Add (Mul (asg, Mul (atc, atd)), arh)) =
7.651 - Add (Add (Mul (mc, Sub (acn, aco)), ao),
7.652 - Add (Mul (asg, Mul (atc, atd)), arh))
7.653 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Sub (ari, arj)) =
7.654 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Sub (ari, arj))
7.655 - | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Mul (ark, arl)) =
7.656 - Add (Add (Mul (mc, Sub (acn, aco)), ao), Mul (ark, arl))
7.657 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), C atp) =
7.658 - Add (Add (Mul (mc, Mul (acp, acq)), ao), C atp)
7.659 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Bound atq) =
7.660 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Bound atq)
7.661 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), CX (atr, ats)) =
7.662 - Add (Add (Mul (mc, Mul (acp, acq)), ao), CX (atr, ats))
7.663 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Neg att) =
7.664 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Neg att)
7.665 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (C aul, atv)) =
7.666 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (C aul, atv))
7.667 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Bound aum, atv)) =
7.668 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Bound aum, atv))
7.669 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (CX (aun, auo), atv)) =
7.670 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (CX (aun, auo), atv))
7.671 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Neg aup, atv)) =
7.672 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Neg aup, atv))
7.673 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Add (auq, aur), atv)) =
7.674 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Add (auq, aur), atv))
7.675 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Sub (aus, aut), atv)) =
7.676 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Sub (aus, aut), atv))
7.677 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, C avh), atv)) =
7.678 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, C avh), atv))
7.679 - | numadd
7.680 - (Add (Mul (mc, Mul (acp, acq)), ao),
7.681 - Add (Mul (auu, CX (avj, avk)), atv)) =
7.682 - Add (Add (Mul (mc, Mul (acp, acq)), ao),
7.683 - Add (Mul (auu, CX (avj, avk)), atv))
7.684 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, Neg avl), atv)) =
7.685 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, Neg avl), atv))
7.686 - | numadd
7.687 - (Add (Mul (mc, Mul (acp, acq)), ao),
7.688 - Add (Mul (auu, Add (avm, avn)), atv)) =
7.689 - Add (Add (Mul (mc, Mul (acp, acq)), ao),
7.690 - Add (Mul (auu, Add (avm, avn)), atv))
7.691 - | numadd
7.692 - (Add (Mul (mc, Mul (acp, acq)), ao),
7.693 - Add (Mul (auu, Sub (avo, avp)), atv)) =
7.694 - Add (Add (Mul (mc, Mul (acp, acq)), ao),
7.695 - Add (Mul (auu, Sub (avo, avp)), atv))
7.696 - | numadd
7.697 - (Add (Mul (mc, Mul (acp, acq)), ao),
7.698 - Add (Mul (auu, Mul (avq, avr)), atv)) =
7.699 - Add (Add (Mul (mc, Mul (acp, acq)), ao),
7.700 - Add (Mul (auu, Mul (avq, avr)), atv))
7.701 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Sub (atw, atx)) =
7.702 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Sub (atw, atx))
7.703 - | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Mul (aty, atz)) =
7.704 - Add (Add (Mul (mc, Mul (acp, acq)), ao), Mul (aty, atz))
7.705 - | numadd (Sub (ap, aq), C awd) = Add (Sub (ap, aq), C awd)
7.706 - | numadd (Sub (ap, aq), Bound awe) = Add (Sub (ap, aq), Bound awe)
7.707 - | numadd (Sub (ap, aq), CX (awf, awg)) = Add (Sub (ap, aq), CX (awf, awg))
7.708 - | numadd (Sub (ap, aq), Neg awh) = Add (Sub (ap, aq), Neg awh)
7.709 - | numadd (Sub (ap, aq), Add (C awz, awj)) =
7.710 - Add (Sub (ap, aq), Add (C awz, awj))
7.711 - | numadd (Sub (ap, aq), Add (Bound axa, awj)) =
7.712 - Add (Sub (ap, aq), Add (Bound axa, awj))
7.713 - | numadd (Sub (ap, aq), Add (CX (axb, axc), awj)) =
7.714 - Add (Sub (ap, aq), Add (CX (axb, axc), awj))
7.715 - | numadd (Sub (ap, aq), Add (Neg axd, awj)) =
7.716 - Add (Sub (ap, aq), Add (Neg axd, awj))
7.717 - | numadd (Sub (ap, aq), Add (Add (axe, axf), awj)) =
7.718 - Add (Sub (ap, aq), Add (Add (axe, axf), awj))
7.719 - | numadd (Sub (ap, aq), Add (Sub (axg, axh), awj)) =
7.720 - Add (Sub (ap, aq), Add (Sub (axg, axh), awj))
7.721 - | numadd (Sub (ap, aq), Add (Mul (axi, C axv), awj)) =
7.722 - Add (Sub (ap, aq), Add (Mul (axi, C axv), awj))
7.723 - | numadd (Sub (ap, aq), Add (Mul (axi, CX (axx, axy)), awj)) =
7.724 - Add (Sub (ap, aq), Add (Mul (axi, CX (axx, axy)), awj))
7.725 - | numadd (Sub (ap, aq), Add (Mul (axi, Neg axz), awj)) =
7.726 - Add (Sub (ap, aq), Add (Mul (axi, Neg axz), awj))
7.727 - | numadd (Sub (ap, aq), Add (Mul (axi, Add (aya, ayb)), awj)) =
7.728 - Add (Sub (ap, aq), Add (Mul (axi, Add (aya, ayb)), awj))
7.729 - | numadd (Sub (ap, aq), Add (Mul (axi, Sub (ayc, ayd)), awj)) =
7.730 - Add (Sub (ap, aq), Add (Mul (axi, Sub (ayc, ayd)), awj))
7.731 - | numadd (Sub (ap, aq), Add (Mul (axi, Mul (aye, ayf)), awj)) =
7.732 - Add (Sub (ap, aq), Add (Mul (axi, Mul (aye, ayf)), awj))
7.733 - | numadd (Sub (ap, aq), Sub (awk, awl)) = Add (Sub (ap, aq), Sub (awk, awl))
7.734 - | numadd (Sub (ap, aq), Mul (awm, awn)) = Add (Sub (ap, aq), Mul (awm, awn))
7.735 - | numadd (Mul (ar, as'), C ayr) = Add (Mul (ar, as'), C ayr)
7.736 - | numadd (Mul (ar, as'), Bound ays) = Add (Mul (ar, as'), Bound ays)
7.737 - | numadd (Mul (ar, as'), CX (ayt, ayu)) = Add (Mul (ar, as'), CX (ayt, ayu))
7.738 - | numadd (Mul (ar, as'), Neg ayv) = Add (Mul (ar, as'), Neg ayv)
7.739 - | numadd (Mul (ar, as'), Add (C azn, ayx)) =
7.740 - Add (Mul (ar, as'), Add (C azn, ayx))
7.741 - | numadd (Mul (ar, as'), Add (Bound azo, ayx)) =
7.742 - Add (Mul (ar, as'), Add (Bound azo, ayx))
7.743 - | numadd (Mul (ar, as'), Add (CX (azp, azq), ayx)) =
7.744 - Add (Mul (ar, as'), Add (CX (azp, azq), ayx))
7.745 - | numadd (Mul (ar, as'), Add (Neg azr, ayx)) =
7.746 - Add (Mul (ar, as'), Add (Neg azr, ayx))
7.747 - | numadd (Mul (ar, as'), Add (Add (azs, azt), ayx)) =
7.748 - Add (Mul (ar, as'), Add (Add (azs, azt), ayx))
7.749 - | numadd (Mul (ar, as'), Add (Sub (azu, azv), ayx)) =
7.750 - Add (Mul (ar, as'), Add (Sub (azu, azv), ayx))
7.751 - | numadd (Mul (ar, as'), Add (Mul (azw, C baj), ayx)) =
7.752 - Add (Mul (ar, as'), Add (Mul (azw, C baj), ayx))
7.753 - | numadd (Mul (ar, as'), Add (Mul (azw, CX (bal, bam)), ayx)) =
7.754 - Add (Mul (ar, as'), Add (Mul (azw, CX (bal, bam)), ayx))
7.755 - | numadd (Mul (ar, as'), Add (Mul (azw, Neg ban), ayx)) =
7.756 - Add (Mul (ar, as'), Add (Mul (azw, Neg ban), ayx))
7.757 - | numadd (Mul (ar, as'), Add (Mul (azw, Add (bao, bap)), ayx)) =
7.758 - Add (Mul (ar, as'), Add (Mul (azw, Add (bao, bap)), ayx))
7.759 - | numadd (Mul (ar, as'), Add (Mul (azw, Sub (baq, bar)), ayx)) =
7.760 - Add (Mul (ar, as'), Add (Mul (azw, Sub (baq, bar)), ayx))
7.761 - | numadd (Mul (ar, as'), Add (Mul (azw, Mul (bas, bat)), ayx)) =
7.762 - Add (Mul (ar, as'), Add (Mul (azw, Mul (bas, bat)), ayx))
7.763 - | numadd (Mul (ar, as'), Sub (ayy, ayz)) = Add (Mul (ar, as'), Sub (ayy, ayz))
7.764 - | numadd (Mul (ar, as'), Mul (aza, azb)) =
7.765 - Add (Mul (ar, as'), Mul (aza, azb));
7.766 -
7.767 -fun nummul (C j) = (fn i => C (i * j))
7.768 - | nummul (Add (a, b)) = (fn i => numadd (nummul a i, nummul b i))
7.769 - | nummul (Mul (c, t)) = (fn i => nummul t (i * c))
7.770 - | nummul (Bound v) = (fn i => Mul (i, Bound v))
7.771 - | nummul (CX (w, x)) = (fn i => Mul (i, CX (w, x)))
7.772 - | nummul (Neg y) = (fn i => Mul (i, Neg y))
7.773 - | nummul (Sub (ac, ad)) = (fn i => Mul (i, Sub (ac, ad)));
7.774 -
7.775 -fun numneg t = nummul t (~ 1);
7.776 -
7.777 -fun numsub s t = (if (s = t) then C 0 else numadd (s, numneg t));
7.778 -
7.779 -fun simpnum (C j) = C j
7.780 - | simpnum (Bound n) = Add (Mul (1, Bound n), C 0)
7.781 - | simpnum (Neg t) = numneg (simpnum t)
7.782 - | simpnum (Add (t, s)) = numadd (simpnum t, simpnum s)
7.783 - | simpnum (Sub (t, s)) = numsub (simpnum t) (simpnum s)
7.784 - | simpnum (Mul (i, t)) = (if (i = 0) then C 0 else nummul (simpnum t) i)
7.785 - | simpnum (CX (w, x)) = CX (w, x);
7.786 -
7.787 -datatype fm = T | F | Lt of num | Le of num | Gt of num | Ge of num | Eq of num
7.788 - | NEq of num | Dvd of int * num | NDvd of int * num | NOT of fm
7.789 - | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm | E of fm
7.790 - | A of fm | Closed of int | NClosed of int;
7.791 -
7.792 -fun not (NOT p) = p
7.793 - | not T = F
7.794 - | not F = T
7.795 - | not (Lt u) = NOT (Lt u)
7.796 - | not (Le v) = NOT (Le v)
7.797 - | not (Gt w) = NOT (Gt w)
7.798 - | not (Ge x) = NOT (Ge x)
7.799 - | not (Eq y) = NOT (Eq y)
7.800 - | not (NEq z) = NOT (NEq z)
7.801 - | not (Dvd (aa, ab)) = NOT (Dvd (aa, ab))
7.802 - | not (NDvd (ac, ad)) = NOT (NDvd (ac, ad))
7.803 - | not (And (af, ag)) = NOT (And (af, ag))
7.804 - | not (Or (ah, ai)) = NOT (Or (ah, ai))
7.805 - | not (Imp (aj, ak)) = NOT (Imp (aj, ak))
7.806 - | not (Iff (al, am)) = NOT (Iff (al, am))
7.807 - | not (E an) = NOT (E an)
7.808 - | not (A ao) = NOT (A ao)
7.809 - | not (Closed ap) = NOT (Closed ap)
7.810 - | not (NClosed aq) = NOT (NClosed aq);
7.811 -
7.812 -fun iff p q =
7.813 - (if (p = q) then T
7.814 - else (if ((p = not q) orelse (not p = q)) then F
7.815 - else (if (p = F) then not q
7.816 - else (if (q = F) then not p
7.817 - else (if (p = T) then q
7.818 - else (if (q = T) then p else Iff (p, q)))))));
7.819 -
7.820 -fun imp p q =
7.821 - (if ((p = F) orelse (q = T)) then T
7.822 - else (if (p = T) then q else (if (q = F) then not p else Imp (p, q))));
7.823 -
7.824 -fun disj p q =
7.825 - (if ((p = T) orelse (q = T)) then T
7.826 - else (if (p = F) then q else (if (q = F) then p else Or (p, q))));
7.827 -
7.828 -fun conj p q =
7.829 - (if ((p = F) orelse (q = F)) then F
7.830 - else (if (p = T) then q else (if (q = T) then p else And (p, q))));
7.831 -
7.832 -fun simpfm (And (p, q)) = conj (simpfm p) (simpfm q)
7.833 - | simpfm (Or (p, q)) = disj (simpfm p) (simpfm q)
7.834 - | simpfm (Imp (p, q)) = imp (simpfm p) (simpfm q)
7.835 - | simpfm (Iff (p, q)) = iff (simpfm p) (simpfm q)
7.836 - | simpfm (NOT p) = not (simpfm p)
7.837 - | simpfm (Lt a) =
7.838 - let val a' = simpnum a
7.839 - in (case a' of C x => (if (x < 0) then T else F) | Bound x => Lt a'
7.840 - | CX (x, xa) => Lt a' | Neg x => Lt a' | Add (x, xa) => Lt a'
7.841 - | Sub (x, xa) => Lt a' | Mul (x, xa) => Lt a')
7.842 - end
7.843 - | simpfm (Le a) =
7.844 - let val a' = simpnum a
7.845 - in (case a' of C x => (if (x <= 0) then T else F) | Bound x => Le a'
7.846 - | CX (x, xa) => Le a' | Neg x => Le a' | Add (x, xa) => Le a'
7.847 - | Sub (x, xa) => Le a' | Mul (x, xa) => Le a')
7.848 - end
7.849 - | simpfm (Gt a) =
7.850 - let val a' = simpnum a
7.851 - in (case a' of C x => (if (0 < x) then T else F) | Bound x => Gt a'
7.852 - | CX (x, xa) => Gt a' | Neg x => Gt a' | Add (x, xa) => Gt a'
7.853 - | Sub (x, xa) => Gt a' | Mul (x, xa) => Gt a')
7.854 - end
7.855 - | simpfm (Ge a) =
7.856 - let val a' = simpnum a
7.857 - in (case a' of C x => (if (0 <= x) then T else F) | Bound x => Ge a'
7.858 - | CX (x, xa) => Ge a' | Neg x => Ge a' | Add (x, xa) => Ge a'
7.859 - | Sub (x, xa) => Ge a' | Mul (x, xa) => Ge a')
7.860 - end
7.861 - | simpfm (Eq a) =
7.862 - let val a' = simpnum a
7.863 - in (case a' of C x => (if (x = 0) then T else F) | Bound x => Eq a'
7.864 - | CX (x, xa) => Eq a' | Neg x => Eq a' | Add (x, xa) => Eq a'
7.865 - | Sub (x, xa) => Eq a' | Mul (x, xa) => Eq a')
7.866 - end
7.867 - | simpfm (NEq a) =
7.868 - let val a' = simpnum a
7.869 - in (case a' of C x => (if Bool.not (x = 0) then T else F)
7.870 - | Bound x => NEq a' | CX (x, xa) => NEq a' | Neg x => NEq a'
7.871 - | Add (x, xa) => NEq a' | Sub (x, xa) => NEq a'
7.872 - | Mul (x, xa) => NEq a')
7.873 - end
7.874 - | simpfm (Dvd (i, a)) =
7.875 - (if (i = 0) then simpfm (Eq a)
7.876 - else (if (abs i = 1) then T
7.877 - else let val a' = simpnum a
7.878 - in (case a' of C x => (if dvd i x then T else F)
7.879 - | Bound x => Dvd (i, a') | CX (x, xa) => Dvd (i, a')
7.880 - | Neg x => Dvd (i, a') | Add (x, xa) => Dvd (i, a')
7.881 - | Sub (x, xa) => Dvd (i, a')
7.882 - | Mul (x, xa) => Dvd (i, a'))
7.883 - end))
7.884 - | simpfm (NDvd (i, a)) =
7.885 - (if (i = 0) then simpfm (NEq a)
7.886 - else (if (abs i = 1) then F
7.887 - else let val a' = simpnum a
7.888 - in (case a' of C x => (if Bool.not (dvd i x) then T else F)
7.889 - | Bound x => NDvd (i, a') | CX (x, xa) => NDvd (i, a')
7.890 - | Neg x => NDvd (i, a') | Add (x, xa) => NDvd (i, a')
7.891 - | Sub (x, xa) => NDvd (i, a')
7.892 - | Mul (x, xa) => NDvd (i, a'))
7.893 - end))
7.894 - | simpfm T = T
7.895 - | simpfm F = F
7.896 - | simpfm (E ao) = E ao
7.897 - | simpfm (A ap) = A ap
7.898 - | simpfm (Closed aq) = Closed aq
7.899 - | simpfm (NClosed ar) = NClosed ar;
7.900 -
7.901 -fun foldr f [] a = a
7.902 - | foldr f (x :: xs) a = f x (foldr f xs a);
7.903 -
7.904 -fun djf f p q =
7.905 - (if (q = T) then T
7.906 - else (if (q = F) then f p
7.907 - else let val fp = f p
7.908 - in (case fp of T => T | F => q | Lt x => Or (f p, q)
7.909 - | Le x => Or (f p, q) | Gt x => Or (f p, q)
7.910 - | Ge x => Or (f p, q) | Eq x => Or (f p, q)
7.911 - | NEq x => Or (f p, q) | Dvd (x, xa) => Or (f p, q)
7.912 - | NDvd (x, xa) => Or (f p, q) | NOT x => Or (f p, q)
7.913 - | And (x, xa) => Or (f p, q) | Or (x, xa) => Or (f p, q)
7.914 - | Imp (x, xa) => Or (f p, q) | Iff (x, xa) => Or (f p, q)
7.915 - | E x => Or (f p, q) | A x => Or (f p, q)
7.916 - | Closed x => Or (f p, q) | NClosed x => Or (f p, q))
7.917 - end));
7.918 -
7.919 -fun evaldjf f ps = foldr (djf f) ps F;
7.920 -
7.921 -fun append [] ys = ys
7.922 - | append (x :: xs) ys = (x :: append xs ys);
7.923 -
7.924 -fun disjuncts (Or (p, q)) = append (disjuncts p) (disjuncts q)
7.925 - | disjuncts F = []
7.926 - | disjuncts T = [T]
7.927 - | disjuncts (Lt u) = [Lt u]
7.928 - | disjuncts (Le v) = [Le v]
7.929 - | disjuncts (Gt w) = [Gt w]
7.930 - | disjuncts (Ge x) = [Ge x]
7.931 - | disjuncts (Eq y) = [Eq y]
7.932 - | disjuncts (NEq z) = [NEq z]
7.933 - | disjuncts (Dvd (aa, ab)) = [Dvd (aa, ab)]
7.934 - | disjuncts (NDvd (ac, ad)) = [NDvd (ac, ad)]
7.935 - | disjuncts (NOT ae) = [NOT ae]
7.936 - | disjuncts (And (af, ag)) = [And (af, ag)]
7.937 - | disjuncts (Imp (aj, ak)) = [Imp (aj, ak)]
7.938 - | disjuncts (Iff (al, am)) = [Iff (al, am)]
7.939 - | disjuncts (E an) = [E an]
7.940 - | disjuncts (A ao) = [A ao]
7.941 - | disjuncts (Closed ap) = [Closed ap]
7.942 - | disjuncts (NClosed aq) = [NClosed aq];
7.943 -
7.944 -fun DJ f p = evaldjf f (disjuncts p);
7.945 -
7.946 -fun qelim (E p) = (fn qe => DJ qe (qelim p qe))
7.947 - | qelim (A p) = (fn qe => not (qe (qelim (NOT p) qe)))
7.948 - | qelim (NOT p) = (fn qe => not (qelim p qe))
7.949 - | qelim (And (p, q)) = (fn qe => conj (qelim p qe) (qelim q qe))
7.950 - | qelim (Or (p, q)) = (fn qe => disj (qelim p qe) (qelim q qe))
7.951 - | qelim (Imp (p, q)) = (fn qe => imp (qelim p qe) (qelim q qe))
7.952 - | qelim (Iff (p, q)) = (fn qe => iff (qelim p qe) (qelim q qe))
7.953 - | qelim T = (fn y => simpfm T)
7.954 - | qelim F = (fn y => simpfm F)
7.955 - | qelim (Lt u) = (fn y => simpfm (Lt u))
7.956 - | qelim (Le v) = (fn y => simpfm (Le v))
7.957 - | qelim (Gt w) = (fn y => simpfm (Gt w))
7.958 - | qelim (Ge x) = (fn y => simpfm (Ge x))
7.959 - | qelim (Eq y) = (fn ya => simpfm (Eq y))
7.960 - | qelim (NEq z) = (fn y => simpfm (NEq z))
7.961 - | qelim (Dvd (aa, ab)) = (fn y => simpfm (Dvd (aa, ab)))
7.962 - | qelim (NDvd (ac, ad)) = (fn y => simpfm (NDvd (ac, ad)))
7.963 - | qelim (Closed ap) = (fn y => simpfm (Closed ap))
7.964 - | qelim (NClosed aq) = (fn y => simpfm (NClosed aq));
7.965 -
7.966 -fun minus_def1 m n = nat (minus_def2 (m) (n));
7.967 -
7.968 -fun decrnum (Bound n) = Bound (minus_def1 n one_def0)
7.969 - | decrnum (Neg a) = Neg (decrnum a)
7.970 - | decrnum (Add (a, b)) = Add (decrnum a, decrnum b)
7.971 - | decrnum (Sub (a, b)) = Sub (decrnum a, decrnum b)
7.972 - | decrnum (Mul (c, a)) = Mul (c, decrnum a)
7.973 - | decrnum (C u) = C u
7.974 - | decrnum (CX (w, x)) = CX (w, x);
7.975 -
7.976 -fun decr (Lt a) = Lt (decrnum a)
7.977 - | decr (Le a) = Le (decrnum a)
7.978 - | decr (Gt a) = Gt (decrnum a)
7.979 - | decr (Ge a) = Ge (decrnum a)
7.980 - | decr (Eq a) = Eq (decrnum a)
7.981 - | decr (NEq a) = NEq (decrnum a)
7.982 - | decr (Dvd (i, a)) = Dvd (i, decrnum a)
7.983 - | decr (NDvd (i, a)) = NDvd (i, decrnum a)
7.984 - | decr (NOT p) = NOT (decr p)
7.985 - | decr (And (p, q)) = And (decr p, decr q)
7.986 - | decr (Or (p, q)) = Or (decr p, decr q)
7.987 - | decr (Imp (p, q)) = Imp (decr p, decr q)
7.988 - | decr (Iff (p, q)) = Iff (decr p, decr q)
7.989 - | decr T = T
7.990 - | decr F = F
7.991 - | decr (E ao) = E ao
7.992 - | decr (A ap) = A ap
7.993 - | decr (Closed aq) = Closed aq
7.994 - | decr (NClosed ar) = NClosed ar;
7.995 -
7.996 -fun map f [] = []
7.997 - | map f (x :: xs) = (f x :: map f xs);
7.998 -
7.999 -fun allpairs f [] ys = []
7.1000 - | allpairs f (x :: xs) ys = append (map (f x) ys) (allpairs f xs ys);
7.1001 -
7.1002 -fun numsubst0 t (C c) = C c
7.1003 - | numsubst0 t (Bound n) = (if (n = 0) then t else Bound n)
7.1004 - | numsubst0 t (CX (i, a)) = Add (Mul (i, t), numsubst0 t a)
7.1005 - | numsubst0 t (Neg a) = Neg (numsubst0 t a)
7.1006 - | numsubst0 t (Add (a, b)) = Add (numsubst0 t a, numsubst0 t b)
7.1007 - | numsubst0 t (Sub (a, b)) = Sub (numsubst0 t a, numsubst0 t b)
7.1008 - | numsubst0 t (Mul (i, a)) = Mul (i, numsubst0 t a);
7.1009 -
7.1010 -fun subst0 t T = T
7.1011 - | subst0 t F = F
7.1012 - | subst0 t (Lt a) = Lt (numsubst0 t a)
7.1013 - | subst0 t (Le a) = Le (numsubst0 t a)
7.1014 - | subst0 t (Gt a) = Gt (numsubst0 t a)
7.1015 - | subst0 t (Ge a) = Ge (numsubst0 t a)
7.1016 - | subst0 t (Eq a) = Eq (numsubst0 t a)
7.1017 - | subst0 t (NEq a) = NEq (numsubst0 t a)
7.1018 - | subst0 t (Dvd (i, a)) = Dvd (i, numsubst0 t a)
7.1019 - | subst0 t (NDvd (i, a)) = NDvd (i, numsubst0 t a)
7.1020 - | subst0 t (NOT p) = NOT (subst0 t p)
7.1021 - | subst0 t (And (p, q)) = And (subst0 t p, subst0 t q)
7.1022 - | subst0 t (Or (p, q)) = Or (subst0 t p, subst0 t q)
7.1023 - | subst0 t (Imp (p, q)) = Imp (subst0 t p, subst0 t q)
7.1024 - | subst0 t (Iff (p, q)) = Iff (subst0 t p, subst0 t q)
7.1025 - | subst0 t (Closed P) = Closed P
7.1026 - | subst0 t (NClosed P) = NClosed P;
7.1027 -
7.1028 -fun minusinf (And (p, q)) = And (minusinf p, minusinf q)
7.1029 - | minusinf (Or (p, q)) = Or (minusinf p, minusinf q)
7.1030 - | minusinf (Eq (CX (c, e))) = F
7.1031 - | minusinf (NEq (CX (c, e))) = T
7.1032 - | minusinf (Lt (CX (c, e))) = T
7.1033 - | minusinf (Le (CX (c, e))) = T
7.1034 - | minusinf (Gt (CX (c, e))) = F
7.1035 - | minusinf (Ge (CX (c, e))) = F
7.1036 - | minusinf T = T
7.1037 - | minusinf F = F
7.1038 - | minusinf (Lt (C bo)) = Lt (C bo)
7.1039 - | minusinf (Lt (Bound bp)) = Lt (Bound bp)
7.1040 - | minusinf (Lt (Neg bs)) = Lt (Neg bs)
7.1041 - | minusinf (Lt (Add (bt, bu))) = Lt (Add (bt, bu))
7.1042 - | minusinf (Lt (Sub (bv, bw))) = Lt (Sub (bv, bw))
7.1043 - | minusinf (Lt (Mul (bx, by))) = Lt (Mul (bx, by))
7.1044 - | minusinf (Le (C ck)) = Le (C ck)
7.1045 - | minusinf (Le (Bound cl)) = Le (Bound cl)
7.1046 - | minusinf (Le (Neg co)) = Le (Neg co)
7.1047 - | minusinf (Le (Add (cp, cq))) = Le (Add (cp, cq))
7.1048 - | minusinf (Le (Sub (cr, cs))) = Le (Sub (cr, cs))
7.1049 - | minusinf (Le (Mul (ct, cu))) = Le (Mul (ct, cu))
7.1050 - | minusinf (Gt (C dg)) = Gt (C dg)
7.1051 - | minusinf (Gt (Bound dh)) = Gt (Bound dh)
7.1052 - | minusinf (Gt (Neg dk)) = Gt (Neg dk)
7.1053 - | minusinf (Gt (Add (dl, dm))) = Gt (Add (dl, dm))
7.1054 - | minusinf (Gt (Sub (dn, do'))) = Gt (Sub (dn, do'))
7.1055 - | minusinf (Gt (Mul (dp, dq))) = Gt (Mul (dp, dq))
7.1056 - | minusinf (Ge (C ec)) = Ge (C ec)
7.1057 - | minusinf (Ge (Bound ed)) = Ge (Bound ed)
7.1058 - | minusinf (Ge (Neg eg)) = Ge (Neg eg)
7.1059 - | minusinf (Ge (Add (eh, ei))) = Ge (Add (eh, ei))
7.1060 - | minusinf (Ge (Sub (ej, ek))) = Ge (Sub (ej, ek))
7.1061 - | minusinf (Ge (Mul (el, em))) = Ge (Mul (el, em))
7.1062 - | minusinf (Eq (C ey)) = Eq (C ey)
7.1063 - | minusinf (Eq (Bound ez)) = Eq (Bound ez)
7.1064 - | minusinf (Eq (Neg fc)) = Eq (Neg fc)
7.1065 - | minusinf (Eq (Add (fd, fe))) = Eq (Add (fd, fe))
7.1066 - | minusinf (Eq (Sub (ff, fg))) = Eq (Sub (ff, fg))
7.1067 - | minusinf (Eq (Mul (fh, fi))) = Eq (Mul (fh, fi))
7.1068 - | minusinf (NEq (C fu)) = NEq (C fu)
7.1069 - | minusinf (NEq (Bound fv)) = NEq (Bound fv)
7.1070 - | minusinf (NEq (Neg fy)) = NEq (Neg fy)
7.1071 - | minusinf (NEq (Add (fz, ga))) = NEq (Add (fz, ga))
7.1072 - | minusinf (NEq (Sub (gb, gc))) = NEq (Sub (gb, gc))
7.1073 - | minusinf (NEq (Mul (gd, ge))) = NEq (Mul (gd, ge))
7.1074 - | minusinf (Dvd (aa, ab)) = Dvd (aa, ab)
7.1075 - | minusinf (NDvd (ac, ad)) = NDvd (ac, ad)
7.1076 - | minusinf (NOT ae) = NOT ae
7.1077 - | minusinf (Imp (aj, ak)) = Imp (aj, ak)
7.1078 - | minusinf (Iff (al, am)) = Iff (al, am)
7.1079 - | minusinf (E an) = E an
7.1080 - | minusinf (A ao) = A ao
7.1081 - | minusinf (Closed ap) = Closed ap
7.1082 - | minusinf (NClosed aq) = NClosed aq;
7.1083 -
7.1084 -fun iupt (i, j) = (if (j < i) then [] else (i :: iupt ((i + 1), j)));
7.1085 -
7.1086 -fun mirror (And (p, q)) = And (mirror p, mirror q)
7.1087 - | mirror (Or (p, q)) = Or (mirror p, mirror q)
7.1088 - | mirror (Eq (CX (c, e))) = Eq (CX (c, Neg e))
7.1089 - | mirror (NEq (CX (c, e))) = NEq (CX (c, Neg e))
7.1090 - | mirror (Lt (CX (c, e))) = Gt (CX (c, Neg e))
7.1091 - | mirror (Le (CX (c, e))) = Ge (CX (c, Neg e))
7.1092 - | mirror (Gt (CX (c, e))) = Lt (CX (c, Neg e))
7.1093 - | mirror (Ge (CX (c, e))) = Le (CX (c, Neg e))
7.1094 - | mirror (Dvd (i, CX (c, e))) = Dvd (i, CX (c, Neg e))
7.1095 - | mirror (NDvd (i, CX (c, e))) = NDvd (i, CX (c, Neg e))
7.1096 - | mirror T = T
7.1097 - | mirror F = F
7.1098 - | mirror (Lt (C bo)) = Lt (C bo)
7.1099 - | mirror (Lt (Bound bp)) = Lt (Bound bp)
7.1100 - | mirror (Lt (Neg bs)) = Lt (Neg bs)
7.1101 - | mirror (Lt (Add (bt, bu))) = Lt (Add (bt, bu))
7.1102 - | mirror (Lt (Sub (bv, bw))) = Lt (Sub (bv, bw))
7.1103 - | mirror (Lt (Mul (bx, by))) = Lt (Mul (bx, by))
7.1104 - | mirror (Le (C ck)) = Le (C ck)
7.1105 - | mirror (Le (Bound cl)) = Le (Bound cl)
7.1106 - | mirror (Le (Neg co)) = Le (Neg co)
7.1107 - | mirror (Le (Add (cp, cq))) = Le (Add (cp, cq))
7.1108 - | mirror (Le (Sub (cr, cs))) = Le (Sub (cr, cs))
7.1109 - | mirror (Le (Mul (ct, cu))) = Le (Mul (ct, cu))
7.1110 - | mirror (Gt (C dg)) = Gt (C dg)
7.1111 - | mirror (Gt (Bound dh)) = Gt (Bound dh)
7.1112 - | mirror (Gt (Neg dk)) = Gt (Neg dk)
7.1113 - | mirror (Gt (Add (dl, dm))) = Gt (Add (dl, dm))
7.1114 - | mirror (Gt (Sub (dn, do'))) = Gt (Sub (dn, do'))
7.1115 - | mirror (Gt (Mul (dp, dq))) = Gt (Mul (dp, dq))
7.1116 - | mirror (Ge (C ec)) = Ge (C ec)
7.1117 - | mirror (Ge (Bound ed)) = Ge (Bound ed)
7.1118 - | mirror (Ge (Neg eg)) = Ge (Neg eg)
7.1119 - | mirror (Ge (Add (eh, ei))) = Ge (Add (eh, ei))
7.1120 - | mirror (Ge (Sub (ej, ek))) = Ge (Sub (ej, ek))
7.1121 - | mirror (Ge (Mul (el, em))) = Ge (Mul (el, em))
7.1122 - | mirror (Eq (C ey)) = Eq (C ey)
7.1123 - | mirror (Eq (Bound ez)) = Eq (Bound ez)
7.1124 - | mirror (Eq (Neg fc)) = Eq (Neg fc)
7.1125 - | mirror (Eq (Add (fd, fe))) = Eq (Add (fd, fe))
7.1126 - | mirror (Eq (Sub (ff, fg))) = Eq (Sub (ff, fg))
7.1127 - | mirror (Eq (Mul (fh, fi))) = Eq (Mul (fh, fi))
7.1128 - | mirror (NEq (C fu)) = NEq (C fu)
7.1129 - | mirror (NEq (Bound fv)) = NEq (Bound fv)
7.1130 - | mirror (NEq (Neg fy)) = NEq (Neg fy)
7.1131 - | mirror (NEq (Add (fz, ga))) = NEq (Add (fz, ga))
7.1132 - | mirror (NEq (Sub (gb, gc))) = NEq (Sub (gb, gc))
7.1133 - | mirror (NEq (Mul (gd, ge))) = NEq (Mul (gd, ge))
7.1134 - | mirror (Dvd (aa, C gq)) = Dvd (aa, C gq)
7.1135 - | mirror (Dvd (aa, Bound gr)) = Dvd (aa, Bound gr)
7.1136 - | mirror (Dvd (aa, Neg gu)) = Dvd (aa, Neg gu)
7.1137 - | mirror (Dvd (aa, Add (gv, gw))) = Dvd (aa, Add (gv, gw))
7.1138 - | mirror (Dvd (aa, Sub (gx, gy))) = Dvd (aa, Sub (gx, gy))
7.1139 - | mirror (Dvd (aa, Mul (gz, ha))) = Dvd (aa, Mul (gz, ha))
7.1140 - | mirror (NDvd (ac, C hm)) = NDvd (ac, C hm)
7.1141 - | mirror (NDvd (ac, Bound hn)) = NDvd (ac, Bound hn)
7.1142 - | mirror (NDvd (ac, Neg hq)) = NDvd (ac, Neg hq)
7.1143 - | mirror (NDvd (ac, Add (hr, hs))) = NDvd (ac, Add (hr, hs))
7.1144 - | mirror (NDvd (ac, Sub (ht, hu))) = NDvd (ac, Sub (ht, hu))
7.1145 - | mirror (NDvd (ac, Mul (hv, hw))) = NDvd (ac, Mul (hv, hw))
7.1146 - | mirror (NOT ae) = NOT ae
7.1147 - | mirror (Imp (aj, ak)) = Imp (aj, ak)
7.1148 - | mirror (Iff (al, am)) = Iff (al, am)
7.1149 - | mirror (E an) = E an
7.1150 - | mirror (A ao) = A ao
7.1151 - | mirror (Closed ap) = Closed ap
7.1152 - | mirror (NClosed aq) = NClosed aq;
7.1153 -
7.1154 -fun plus_def0 m n = nat ((m) + (n));
7.1155 -
7.1156 -fun size_def9 [] = 0
7.1157 - | size_def9 (a :: list) = plus_def0 (size_def9 list) (0 + 1);
7.1158 -
7.1159 -fun alpha (And (p, q)) = append (alpha p) (alpha q)
7.1160 - | alpha (Or (p, q)) = append (alpha p) (alpha q)
7.1161 - | alpha (Eq (CX (c, e))) = [Add (C ~1, e)]
7.1162 - | alpha (NEq (CX (c, e))) = [e]
7.1163 - | alpha (Lt (CX (c, e))) = [e]
7.1164 - | alpha (Le (CX (c, e))) = [Add (C ~1, e)]
7.1165 - | alpha (Gt (CX (c, e))) = []
7.1166 - | alpha (Ge (CX (c, e))) = []
7.1167 - | alpha T = []
7.1168 - | alpha F = []
7.1169 - | alpha (Lt (C bo)) = []
7.1170 - | alpha (Lt (Bound bp)) = []
7.1171 - | alpha (Lt (Neg bs)) = []
7.1172 - | alpha (Lt (Add (bt, bu))) = []
7.1173 - | alpha (Lt (Sub (bv, bw))) = []
7.1174 - | alpha (Lt (Mul (bx, by))) = []
7.1175 - | alpha (Le (C ck)) = []
7.1176 - | alpha (Le (Bound cl)) = []
7.1177 - | alpha (Le (Neg co)) = []
7.1178 - | alpha (Le (Add (cp, cq))) = []
7.1179 - | alpha (Le (Sub (cr, cs))) = []
7.1180 - | alpha (Le (Mul (ct, cu))) = []
7.1181 - | alpha (Gt (C dg)) = []
7.1182 - | alpha (Gt (Bound dh)) = []
7.1183 - | alpha (Gt (Neg dk)) = []
7.1184 - | alpha (Gt (Add (dl, dm))) = []
7.1185 - | alpha (Gt (Sub (dn, do'))) = []
7.1186 - | alpha (Gt (Mul (dp, dq))) = []
7.1187 - | alpha (Ge (C ec)) = []
7.1188 - | alpha (Ge (Bound ed)) = []
7.1189 - | alpha (Ge (Neg eg)) = []
7.1190 - | alpha (Ge (Add (eh, ei))) = []
7.1191 - | alpha (Ge (Sub (ej, ek))) = []
7.1192 - | alpha (Ge (Mul (el, em))) = []
7.1193 - | alpha (Eq (C ey)) = []
7.1194 - | alpha (Eq (Bound ez)) = []
7.1195 - | alpha (Eq (Neg fc)) = []
7.1196 - | alpha (Eq (Add (fd, fe))) = []
7.1197 - | alpha (Eq (Sub (ff, fg))) = []
7.1198 - | alpha (Eq (Mul (fh, fi))) = []
7.1199 - | alpha (NEq (C fu)) = []
7.1200 - | alpha (NEq (Bound fv)) = []
7.1201 - | alpha (NEq (Neg fy)) = []
7.1202 - | alpha (NEq (Add (fz, ga))) = []
7.1203 - | alpha (NEq (Sub (gb, gc))) = []
7.1204 - | alpha (NEq (Mul (gd, ge))) = []
7.1205 - | alpha (Dvd (aa, ab)) = []
7.1206 - | alpha (NDvd (ac, ad)) = []
7.1207 - | alpha (NOT ae) = []
7.1208 - | alpha (Imp (aj, ak)) = []
7.1209 - | alpha (Iff (al, am)) = []
7.1210 - | alpha (E an) = []
7.1211 - | alpha (A ao) = []
7.1212 - | alpha (Closed ap) = []
7.1213 - | alpha (NClosed aq) = [];
7.1214 -
7.1215 -fun memberl x [] = false
7.1216 - | memberl x (y :: ys) = ((x = y) orelse memberl x ys);
7.1217 -
7.1218 -fun remdups [] = []
7.1219 - | remdups (x :: xs) =
7.1220 - (if memberl x xs then remdups xs else (x :: remdups xs));
7.1221 -
7.1222 -fun beta (And (p, q)) = append (beta p) (beta q)
7.1223 - | beta (Or (p, q)) = append (beta p) (beta q)
7.1224 - | beta (Eq (CX (c, e))) = [Sub (C ~1, e)]
7.1225 - | beta (NEq (CX (c, e))) = [Neg e]
7.1226 - | beta (Lt (CX (c, e))) = []
7.1227 - | beta (Le (CX (c, e))) = []
7.1228 - | beta (Gt (CX (c, e))) = [Neg e]
7.1229 - | beta (Ge (CX (c, e))) = [Sub (C ~1, e)]
7.1230 - | beta T = []
7.1231 - | beta F = []
7.1232 - | beta (Lt (C bo)) = []
7.1233 - | beta (Lt (Bound bp)) = []
7.1234 - | beta (Lt (Neg bs)) = []
7.1235 - | beta (Lt (Add (bt, bu))) = []
7.1236 - | beta (Lt (Sub (bv, bw))) = []
7.1237 - | beta (Lt (Mul (bx, by))) = []
7.1238 - | beta (Le (C ck)) = []
7.1239 - | beta (Le (Bound cl)) = []
7.1240 - | beta (Le (Neg co)) = []
7.1241 - | beta (Le (Add (cp, cq))) = []
7.1242 - | beta (Le (Sub (cr, cs))) = []
7.1243 - | beta (Le (Mul (ct, cu))) = []
7.1244 - | beta (Gt (C dg)) = []
7.1245 - | beta (Gt (Bound dh)) = []
7.1246 - | beta (Gt (Neg dk)) = []
7.1247 - | beta (Gt (Add (dl, dm))) = []
7.1248 - | beta (Gt (Sub (dn, do'))) = []
7.1249 - | beta (Gt (Mul (dp, dq))) = []
7.1250 - | beta (Ge (C ec)) = []
7.1251 - | beta (Ge (Bound ed)) = []
7.1252 - | beta (Ge (Neg eg)) = []
7.1253 - | beta (Ge (Add (eh, ei))) = []
7.1254 - | beta (Ge (Sub (ej, ek))) = []
7.1255 - | beta (Ge (Mul (el, em))) = []
7.1256 - | beta (Eq (C ey)) = []
7.1257 - | beta (Eq (Bound ez)) = []
7.1258 - | beta (Eq (Neg fc)) = []
7.1259 - | beta (Eq (Add (fd, fe))) = []
7.1260 - | beta (Eq (Sub (ff, fg))) = []
7.1261 - | beta (Eq (Mul (fh, fi))) = []
7.1262 - | beta (NEq (C fu)) = []
7.1263 - | beta (NEq (Bound fv)) = []
7.1264 - | beta (NEq (Neg fy)) = []
7.1265 - | beta (NEq (Add (fz, ga))) = []
7.1266 - | beta (NEq (Sub (gb, gc))) = []
7.1267 - | beta (NEq (Mul (gd, ge))) = []
7.1268 - | beta (Dvd (aa, ab)) = []
7.1269 - | beta (NDvd (ac, ad)) = []
7.1270 - | beta (NOT ae) = []
7.1271 - | beta (Imp (aj, ak)) = []
7.1272 - | beta (Iff (al, am)) = []
7.1273 - | beta (E an) = []
7.1274 - | beta (A ao) = []
7.1275 - | beta (Closed ap) = []
7.1276 - | beta (NClosed aq) = [];
7.1277 -
7.1278 -fun fst (a, b) = a;
7.1279 -
7.1280 -fun div_def1 a b = fst (divAlg (a, b));
7.1281 -
7.1282 -fun div_def0 m n = nat (div_def1 (m) (n));
7.1283 -
7.1284 -fun mod_def0 m n = nat (mod_def1 (m) (n));
7.1285 -
7.1286 -fun gcd (m, n) = (if (n = 0) then m else gcd (n, mod_def0 m n));
7.1287 -
7.1288 -fun times_def0 m n = nat ((m) * (n));
7.1289 -
7.1290 -fun lcm x = (fn (m, n) => div_def0 (times_def0 m n) (gcd (m, n))) x;
7.1291 -
7.1292 -fun ilcm x = (fn j => (lcm (nat (abs x), nat (abs j))));
7.1293 -
7.1294 -fun delta (And (p, q)) = ilcm (delta p) (delta q)
7.1295 - | delta (Or (p, q)) = ilcm (delta p) (delta q)
7.1296 - | delta (Dvd (i, CX (c, e))) = i
7.1297 - | delta (NDvd (i, CX (c, e))) = i
7.1298 - | delta T = 1
7.1299 - | delta F = 1
7.1300 - | delta (Lt u) = 1
7.1301 - | delta (Le v) = 1
7.1302 - | delta (Gt w) = 1
7.1303 - | delta (Ge x) = 1
7.1304 - | delta (Eq y) = 1
7.1305 - | delta (NEq z) = 1
7.1306 - | delta (Dvd (aa, C bo)) = 1
7.1307 - | delta (Dvd (aa, Bound bp)) = 1
7.1308 - | delta (Dvd (aa, Neg bs)) = 1
7.1309 - | delta (Dvd (aa, Add (bt, bu))) = 1
7.1310 - | delta (Dvd (aa, Sub (bv, bw))) = 1
7.1311 - | delta (Dvd (aa, Mul (bx, by))) = 1
7.1312 - | delta (NDvd (ac, C ck)) = 1
7.1313 - | delta (NDvd (ac, Bound cl)) = 1
7.1314 - | delta (NDvd (ac, Neg co)) = 1
7.1315 - | delta (NDvd (ac, Add (cp, cq))) = 1
7.1316 - | delta (NDvd (ac, Sub (cr, cs))) = 1
7.1317 - | delta (NDvd (ac, Mul (ct, cu))) = 1
7.1318 - | delta (NOT ae) = 1
7.1319 - | delta (Imp (aj, ak)) = 1
7.1320 - | delta (Iff (al, am)) = 1
7.1321 - | delta (E an) = 1
7.1322 - | delta (A ao) = 1
7.1323 - | delta (Closed ap) = 1
7.1324 - | delta (NClosed aq) = 1;
7.1325 -
7.1326 -fun a_beta (And (p, q)) = (fn k => And (a_beta p k, a_beta q k))
7.1327 - | a_beta (Or (p, q)) = (fn k => Or (a_beta p k, a_beta q k))
7.1328 - | a_beta (Eq (CX (c, e))) = (fn k => Eq (CX (1, Mul (div_def1 k c, e))))
7.1329 - | a_beta (NEq (CX (c, e))) = (fn k => NEq (CX (1, Mul (div_def1 k c, e))))
7.1330 - | a_beta (Lt (CX (c, e))) = (fn k => Lt (CX (1, Mul (div_def1 k c, e))))
7.1331 - | a_beta (Le (CX (c, e))) = (fn k => Le (CX (1, Mul (div_def1 k c, e))))
7.1332 - | a_beta (Gt (CX (c, e))) = (fn k => Gt (CX (1, Mul (div_def1 k c, e))))
7.1333 - | a_beta (Ge (CX (c, e))) = (fn k => Ge (CX (1, Mul (div_def1 k c, e))))
7.1334 - | a_beta (Dvd (i, CX (c, e))) =
7.1335 - (fn k => Dvd ((div_def1 k c * i), CX (1, Mul (div_def1 k c, e))))
7.1336 - | a_beta (NDvd (i, CX (c, e))) =
7.1337 - (fn k => NDvd ((div_def1 k c * i), CX (1, Mul (div_def1 k c, e))))
7.1338 - | a_beta T = (fn k => T)
7.1339 - | a_beta F = (fn k => F)
7.1340 - | a_beta (Lt (C bo)) = (fn k => Lt (C bo))
7.1341 - | a_beta (Lt (Bound bp)) = (fn k => Lt (Bound bp))
7.1342 - | a_beta (Lt (Neg bs)) = (fn k => Lt (Neg bs))
7.1343 - | a_beta (Lt (Add (bt, bu))) = (fn k => Lt (Add (bt, bu)))
7.1344 - | a_beta (Lt (Sub (bv, bw))) = (fn k => Lt (Sub (bv, bw)))
7.1345 - | a_beta (Lt (Mul (bx, by))) = (fn k => Lt (Mul (bx, by)))
7.1346 - | a_beta (Le (C ck)) = (fn k => Le (C ck))
7.1347 - | a_beta (Le (Bound cl)) = (fn k => Le (Bound cl))
7.1348 - | a_beta (Le (Neg co)) = (fn k => Le (Neg co))
7.1349 - | a_beta (Le (Add (cp, cq))) = (fn k => Le (Add (cp, cq)))
7.1350 - | a_beta (Le (Sub (cr, cs))) = (fn k => Le (Sub (cr, cs)))
7.1351 - | a_beta (Le (Mul (ct, cu))) = (fn k => Le (Mul (ct, cu)))
7.1352 - | a_beta (Gt (C dg)) = (fn k => Gt (C dg))
7.1353 - | a_beta (Gt (Bound dh)) = (fn k => Gt (Bound dh))
7.1354 - | a_beta (Gt (Neg dk)) = (fn k => Gt (Neg dk))
7.1355 - | a_beta (Gt (Add (dl, dm))) = (fn k => Gt (Add (dl, dm)))
7.1356 - | a_beta (Gt (Sub (dn, do'))) = (fn k => Gt (Sub (dn, do')))
7.1357 - | a_beta (Gt (Mul (dp, dq))) = (fn k => Gt (Mul (dp, dq)))
7.1358 - | a_beta (Ge (C ec)) = (fn k => Ge (C ec))
7.1359 - | a_beta (Ge (Bound ed)) = (fn k => Ge (Bound ed))
7.1360 - | a_beta (Ge (Neg eg)) = (fn k => Ge (Neg eg))
7.1361 - | a_beta (Ge (Add (eh, ei))) = (fn k => Ge (Add (eh, ei)))
7.1362 - | a_beta (Ge (Sub (ej, ek))) = (fn k => Ge (Sub (ej, ek)))
7.1363 - | a_beta (Ge (Mul (el, em))) = (fn k => Ge (Mul (el, em)))
7.1364 - | a_beta (Eq (C ey)) = (fn k => Eq (C ey))
7.1365 - | a_beta (Eq (Bound ez)) = (fn k => Eq (Bound ez))
7.1366 - | a_beta (Eq (Neg fc)) = (fn k => Eq (Neg fc))
7.1367 - | a_beta (Eq (Add (fd, fe))) = (fn k => Eq (Add (fd, fe)))
7.1368 - | a_beta (Eq (Sub (ff, fg))) = (fn k => Eq (Sub (ff, fg)))
7.1369 - | a_beta (Eq (Mul (fh, fi))) = (fn k => Eq (Mul (fh, fi)))
7.1370 - | a_beta (NEq (C fu)) = (fn k => NEq (C fu))
7.1371 - | a_beta (NEq (Bound fv)) = (fn k => NEq (Bound fv))
7.1372 - | a_beta (NEq (Neg fy)) = (fn k => NEq (Neg fy))
7.1373 - | a_beta (NEq (Add (fz, ga))) = (fn k => NEq (Add (fz, ga)))
7.1374 - | a_beta (NEq (Sub (gb, gc))) = (fn k => NEq (Sub (gb, gc)))
7.1375 - | a_beta (NEq (Mul (gd, ge))) = (fn k => NEq (Mul (gd, ge)))
7.1376 - | a_beta (Dvd (aa, C gq)) = (fn k => Dvd (aa, C gq))
7.1377 - | a_beta (Dvd (aa, Bound gr)) = (fn k => Dvd (aa, Bound gr))
7.1378 - | a_beta (Dvd (aa, Neg gu)) = (fn k => Dvd (aa, Neg gu))
7.1379 - | a_beta (Dvd (aa, Add (gv, gw))) = (fn k => Dvd (aa, Add (gv, gw)))
7.1380 - | a_beta (Dvd (aa, Sub (gx, gy))) = (fn k => Dvd (aa, Sub (gx, gy)))
7.1381 - | a_beta (Dvd (aa, Mul (gz, ha))) = (fn k => Dvd (aa, Mul (gz, ha)))
7.1382 - | a_beta (NDvd (ac, C hm)) = (fn k => NDvd (ac, C hm))
7.1383 - | a_beta (NDvd (ac, Bound hn)) = (fn k => NDvd (ac, Bound hn))
7.1384 - | a_beta (NDvd (ac, Neg hq)) = (fn k => NDvd (ac, Neg hq))
7.1385 - | a_beta (NDvd (ac, Add (hr, hs))) = (fn k => NDvd (ac, Add (hr, hs)))
7.1386 - | a_beta (NDvd (ac, Sub (ht, hu))) = (fn k => NDvd (ac, Sub (ht, hu)))
7.1387 - | a_beta (NDvd (ac, Mul (hv, hw))) = (fn k => NDvd (ac, Mul (hv, hw)))
7.1388 - | a_beta (NOT ae) = (fn k => NOT ae)
7.1389 - | a_beta (Imp (aj, ak)) = (fn k => Imp (aj, ak))
7.1390 - | a_beta (Iff (al, am)) = (fn k => Iff (al, am))
7.1391 - | a_beta (E an) = (fn k => E an)
7.1392 - | a_beta (A ao) = (fn k => A ao)
7.1393 - | a_beta (Closed ap) = (fn k => Closed ap)
7.1394 - | a_beta (NClosed aq) = (fn k => NClosed aq);
7.1395 -
7.1396 -fun zeta (And (p, q)) = ilcm (zeta p) (zeta q)
7.1397 - | zeta (Or (p, q)) = ilcm (zeta p) (zeta q)
7.1398 - | zeta (Eq (CX (c, e))) = c
7.1399 - | zeta (NEq (CX (c, e))) = c
7.1400 - | zeta (Lt (CX (c, e))) = c
7.1401 - | zeta (Le (CX (c, e))) = c
7.1402 - | zeta (Gt (CX (c, e))) = c
7.1403 - | zeta (Ge (CX (c, e))) = c
7.1404 - | zeta (Dvd (i, CX (c, e))) = c
7.1405 - | zeta (NDvd (i, CX (c, e))) = c
7.1406 - | zeta T = 1
7.1407 - | zeta F = 1
7.1408 - | zeta (Lt (C bo)) = 1
7.1409 - | zeta (Lt (Bound bp)) = 1
7.1410 - | zeta (Lt (Neg bs)) = 1
7.1411 - | zeta (Lt (Add (bt, bu))) = 1
7.1412 - | zeta (Lt (Sub (bv, bw))) = 1
7.1413 - | zeta (Lt (Mul (bx, by))) = 1
7.1414 - | zeta (Le (C ck)) = 1
7.1415 - | zeta (Le (Bound cl)) = 1
7.1416 - | zeta (Le (Neg co)) = 1
7.1417 - | zeta (Le (Add (cp, cq))) = 1
7.1418 - | zeta (Le (Sub (cr, cs))) = 1
7.1419 - | zeta (Le (Mul (ct, cu))) = 1
7.1420 - | zeta (Gt (C dg)) = 1
7.1421 - | zeta (Gt (Bound dh)) = 1
7.1422 - | zeta (Gt (Neg dk)) = 1
7.1423 - | zeta (Gt (Add (dl, dm))) = 1
7.1424 - | zeta (Gt (Sub (dn, do'))) = 1
7.1425 - | zeta (Gt (Mul (dp, dq))) = 1
7.1426 - | zeta (Ge (C ec)) = 1
7.1427 - | zeta (Ge (Bound ed)) = 1
7.1428 - | zeta (Ge (Neg eg)) = 1
7.1429 - | zeta (Ge (Add (eh, ei))) = 1
7.1430 - | zeta (Ge (Sub (ej, ek))) = 1
7.1431 - | zeta (Ge (Mul (el, em))) = 1
7.1432 - | zeta (Eq (C ey)) = 1
7.1433 - | zeta (Eq (Bound ez)) = 1
7.1434 - | zeta (Eq (Neg fc)) = 1
7.1435 - | zeta (Eq (Add (fd, fe))) = 1
7.1436 - | zeta (Eq (Sub (ff, fg))) = 1
7.1437 - | zeta (Eq (Mul (fh, fi))) = 1
7.1438 - | zeta (NEq (C fu)) = 1
7.1439 - | zeta (NEq (Bound fv)) = 1
7.1440 - | zeta (NEq (Neg fy)) = 1
7.1441 - | zeta (NEq (Add (fz, ga))) = 1
7.1442 - | zeta (NEq (Sub (gb, gc))) = 1
7.1443 - | zeta (NEq (Mul (gd, ge))) = 1
7.1444 - | zeta (Dvd (aa, C gq)) = 1
7.1445 - | zeta (Dvd (aa, Bound gr)) = 1
7.1446 - | zeta (Dvd (aa, Neg gu)) = 1
7.1447 - | zeta (Dvd (aa, Add (gv, gw))) = 1
7.1448 - | zeta (Dvd (aa, Sub (gx, gy))) = 1
7.1449 - | zeta (Dvd (aa, Mul (gz, ha))) = 1
7.1450 - | zeta (NDvd (ac, C hm)) = 1
7.1451 - | zeta (NDvd (ac, Bound hn)) = 1
7.1452 - | zeta (NDvd (ac, Neg hq)) = 1
7.1453 - | zeta (NDvd (ac, Add (hr, hs))) = 1
7.1454 - | zeta (NDvd (ac, Sub (ht, hu))) = 1
7.1455 - | zeta (NDvd (ac, Mul (hv, hw))) = 1
7.1456 - | zeta (NOT ae) = 1
7.1457 - | zeta (Imp (aj, ak)) = 1
7.1458 - | zeta (Iff (al, am)) = 1
7.1459 - | zeta (E an) = 1
7.1460 - | zeta (A ao) = 1
7.1461 - | zeta (Closed ap) = 1
7.1462 - | zeta (NClosed aq) = 1;
7.1463 -
7.1464 -fun split x = (fn p => x (fst p) (snd p));
7.1465 -
7.1466 -fun zsplit0 (C c) = (0, C c)
7.1467 - | zsplit0 (Bound n) = (if (n = 0) then (1, C 0) else (0, Bound n))
7.1468 - | zsplit0 (CX (i, a)) = split (fn i' => (fn x => ((i + i'), x))) (zsplit0 a)
7.1469 - | zsplit0 (Neg a) = (fn (i', a') => (~ i', Neg a')) (zsplit0 a)
7.1470 - | zsplit0 (Add (a, b)) =
7.1471 - (fn (ia, a') => (fn (ib, b') => ((ia + ib), Add (a', b'))) (zsplit0 b))
7.1472 - (zsplit0 a)
7.1473 - | zsplit0 (Sub (a, b)) =
7.1474 - (fn (ia, a') =>
7.1475 - (fn (ib, b') => (minus_def2 ia ib, Sub (a', b'))) (zsplit0 b))
7.1476 - (zsplit0 a)
7.1477 - | zsplit0 (Mul (i, a)) = (fn (i', a') => ((i * i'), Mul (i, a'))) (zsplit0 a);
7.1478 -
7.1479 -fun zlfm (And (p, q)) = And (zlfm p, zlfm q)
7.1480 - | zlfm (Or (p, q)) = Or (zlfm p, zlfm q)
7.1481 - | zlfm (Imp (p, q)) = Or (zlfm (NOT p), zlfm q)
7.1482 - | zlfm (Iff (p, q)) =
7.1483 - Or (And (zlfm p, zlfm q), And (zlfm (NOT p), zlfm (NOT q)))
7.1484 - | zlfm (Lt a) =
7.1485 - let val x = zsplit0 a
7.1486 - in (fn (c, r) =>
7.1487 - (if (c = 0) then Lt r
7.1488 - else (if (0 < c) then Lt (CX (c, r)) else Gt (CX (~ c, Neg r)))))
7.1489 - x
7.1490 - end
7.1491 - | zlfm (Le a) =
7.1492 - let val x = zsplit0 a
7.1493 - in (fn (c, r) =>
7.1494 - (if (c = 0) then Le r
7.1495 - else (if (0 < c) then Le (CX (c, r)) else Ge (CX (~ c, Neg r)))))
7.1496 - x
7.1497 - end
7.1498 - | zlfm (Gt a) =
7.1499 - let val x = zsplit0 a
7.1500 - in (fn (c, r) =>
7.1501 - (if (c = 0) then Gt r
7.1502 - else (if (0 < c) then Gt (CX (c, r)) else Lt (CX (~ c, Neg r)))))
7.1503 - x
7.1504 - end
7.1505 - | zlfm (Ge a) =
7.1506 - let val x = zsplit0 a
7.1507 - in (fn (c, r) =>
7.1508 - (if (c = 0) then Ge r
7.1509 - else (if (0 < c) then Ge (CX (c, r)) else Le (CX (~ c, Neg r)))))
7.1510 - x
7.1511 - end
7.1512 - | zlfm (Eq a) =
7.1513 - let val x = zsplit0 a
7.1514 - in (fn (c, r) =>
7.1515 - (if (c = 0) then Eq r
7.1516 - else (if (0 < c) then Eq (CX (c, r)) else Eq (CX (~ c, Neg r)))))
7.1517 - x
7.1518 - end
7.1519 - | zlfm (NEq a) =
7.1520 - let val x = zsplit0 a
7.1521 - in (fn (c, r) =>
7.1522 - (if (c = 0) then NEq r
7.1523 - else (if (0 < c) then NEq (CX (c, r)) else NEq (CX (~ c, Neg r)))))
7.1524 - x
7.1525 - end
7.1526 - | zlfm (Dvd (i, a)) =
7.1527 - (if (i = 0) then zlfm (Eq a)
7.1528 - else let val x = zsplit0 a
7.1529 - in (fn (c, r) =>
7.1530 - (if (c = 0) then Dvd (abs i, r)
7.1531 - else (if (0 < c) then Dvd (abs i, CX (c, r))
7.1532 - else Dvd (abs i, CX (~ c, Neg r)))))
7.1533 - x
7.1534 - end)
7.1535 - | zlfm (NDvd (i, a)) =
7.1536 - (if (i = 0) then zlfm (NEq a)
7.1537 - else let val x = zsplit0 a
7.1538 - in (fn (c, r) =>
7.1539 - (if (c = 0) then NDvd (abs i, r)
7.1540 - else (if (0 < c) then NDvd (abs i, CX (c, r))
7.1541 - else NDvd (abs i, CX (~ c, Neg r)))))
7.1542 - x
7.1543 - end)
7.1544 - | zlfm (NOT (And (p, q))) = Or (zlfm (NOT p), zlfm (NOT q))
7.1545 - | zlfm (NOT (Or (p, q))) = And (zlfm (NOT p), zlfm (NOT q))
7.1546 - | zlfm (NOT (Imp (p, q))) = And (zlfm p, zlfm (NOT q))
7.1547 - | zlfm (NOT (Iff (p, q))) =
7.1548 - Or (And (zlfm p, zlfm (NOT q)), And (zlfm (NOT p), zlfm q))
7.1549 - | zlfm (NOT (NOT p)) = zlfm p
7.1550 - | zlfm (NOT T) = F
7.1551 - | zlfm (NOT F) = T
7.1552 - | zlfm (NOT (Lt a)) = zlfm (Ge a)
7.1553 - | zlfm (NOT (Le a)) = zlfm (Gt a)
7.1554 - | zlfm (NOT (Gt a)) = zlfm (Le a)
7.1555 - | zlfm (NOT (Ge a)) = zlfm (Lt a)
7.1556 - | zlfm (NOT (Eq a)) = zlfm (NEq a)
7.1557 - | zlfm (NOT (NEq a)) = zlfm (Eq a)
7.1558 - | zlfm (NOT (Dvd (i, a))) = zlfm (NDvd (i, a))
7.1559 - | zlfm (NOT (NDvd (i, a))) = zlfm (Dvd (i, a))
7.1560 - | zlfm (NOT (Closed P)) = NClosed P
7.1561 - | zlfm (NOT (NClosed P)) = Closed P
7.1562 - | zlfm T = T
7.1563 - | zlfm F = F
7.1564 - | zlfm (NOT (E ci)) = NOT (E ci)
7.1565 - | zlfm (NOT (A cj)) = NOT (A cj)
7.1566 - | zlfm (E ao) = E ao
7.1567 - | zlfm (A ap) = A ap
7.1568 - | zlfm (Closed aq) = Closed aq
7.1569 - | zlfm (NClosed ar) = NClosed ar;
7.1570 -
7.1571 -fun unit p =
7.1572 - let val p' = zlfm p; val l = zeta p';
7.1573 - val q = And (Dvd (l, CX (1, C 0)), a_beta p' l); val d = delta q;
7.1574 - val B = remdups (map simpnum (beta q));
7.1575 - val a = remdups (map simpnum (alpha q))
7.1576 - in (if less_eq_def3 (size_def9 B) (size_def9 a) then (q, (B, d))
7.1577 - else (mirror q, (a, d)))
7.1578 - end;
7.1579 -
7.1580 -fun cooper p =
7.1581 - let val (q, (B, d)) = unit p; val js = iupt (1, d);
7.1582 - val mq = simpfm (minusinf q);
7.1583 - val md = evaldjf (fn j => simpfm (subst0 (C j) mq)) js
7.1584 - in (if (md = T) then T
7.1585 - else let val qd =
7.1586 - evaldjf (fn (b, j) => simpfm (subst0 (Add (b, C j)) q))
7.1587 - (allpairs (fn x => fn xa => (x, xa)) B js)
7.1588 - in decr (disj md qd) end)
7.1589 - end;
7.1590 -
7.1591 -fun prep (E T) = T
7.1592 - | prep (E F) = F
7.1593 - | prep (E (Or (p, q))) = Or (prep (E p), prep (E q))
7.1594 - | prep (E (Imp (p, q))) = Or (prep (E (NOT p)), prep (E q))
7.1595 - | prep (E (Iff (p, q))) =
7.1596 - Or (prep (E (And (p, q))), prep (E (And (NOT p, NOT q))))
7.1597 - | prep (E (NOT (And (p, q)))) = Or (prep (E (NOT p)), prep (E (NOT q)))
7.1598 - | prep (E (NOT (Imp (p, q)))) = prep (E (And (p, NOT q)))
7.1599 - | prep (E (NOT (Iff (p, q)))) =
7.1600 - Or (prep (E (And (p, NOT q))), prep (E (And (NOT p, q))))
7.1601 - | prep (E (Lt ef)) = E (prep (Lt ef))
7.1602 - | prep (E (Le eg)) = E (prep (Le eg))
7.1603 - | prep (E (Gt eh)) = E (prep (Gt eh))
7.1604 - | prep (E (Ge ei)) = E (prep (Ge ei))
7.1605 - | prep (E (Eq ej)) = E (prep (Eq ej))
7.1606 - | prep (E (NEq ek)) = E (prep (NEq ek))
7.1607 - | prep (E (Dvd (el, em))) = E (prep (Dvd (el, em)))
7.1608 - | prep (E (NDvd (en, eo))) = E (prep (NDvd (en, eo)))
7.1609 - | prep (E (NOT T)) = E (prep (NOT T))
7.1610 - | prep (E (NOT F)) = E (prep (NOT F))
7.1611 - | prep (E (NOT (Lt gw))) = E (prep (NOT (Lt gw)))
7.1612 - | prep (E (NOT (Le gx))) = E (prep (NOT (Le gx)))
7.1613 - | prep (E (NOT (Gt gy))) = E (prep (NOT (Gt gy)))
7.1614 - | prep (E (NOT (Ge gz))) = E (prep (NOT (Ge gz)))
7.1615 - | prep (E (NOT (Eq ha))) = E (prep (NOT (Eq ha)))
7.1616 - | prep (E (NOT (NEq hb))) = E (prep (NOT (NEq hb)))
7.1617 - | prep (E (NOT (Dvd (hc, hd)))) = E (prep (NOT (Dvd (hc, hd))))
7.1618 - | prep (E (NOT (NDvd (he, hf)))) = E (prep (NOT (NDvd (he, hf))))
7.1619 - | prep (E (NOT (NOT hg))) = E (prep (NOT (NOT hg)))
7.1620 - | prep (E (NOT (Or (hj, hk)))) = E (prep (NOT (Or (hj, hk))))
7.1621 - | prep (E (NOT (E hp))) = E (prep (NOT (E hp)))
7.1622 - | prep (E (NOT (A hq))) = E (prep (NOT (A hq)))
7.1623 - | prep (E (NOT (Closed hr))) = E (prep (NOT (Closed hr)))
7.1624 - | prep (E (NOT (NClosed hs))) = E (prep (NOT (NClosed hs)))
7.1625 - | prep (E (And (eq, er))) = E (prep (And (eq, er)))
7.1626 - | prep (E (E ey)) = E (prep (E ey))
7.1627 - | prep (E (A ez)) = E (prep (A ez))
7.1628 - | prep (E (Closed fa)) = E (prep (Closed fa))
7.1629 - | prep (E (NClosed fb)) = E (prep (NClosed fb))
7.1630 - | prep (A (And (p, q))) = And (prep (A p), prep (A q))
7.1631 - | prep (A T) = prep (NOT (E (NOT T)))
7.1632 - | prep (A F) = prep (NOT (E (NOT F)))
7.1633 - | prep (A (Lt jn)) = prep (NOT (E (NOT (Lt jn))))
7.1634 - | prep (A (Le jo)) = prep (NOT (E (NOT (Le jo))))
7.1635 - | prep (A (Gt jp)) = prep (NOT (E (NOT (Gt jp))))
7.1636 - | prep (A (Ge jq)) = prep (NOT (E (NOT (Ge jq))))
7.1637 - | prep (A (Eq jr)) = prep (NOT (E (NOT (Eq jr))))
7.1638 - | prep (A (NEq js)) = prep (NOT (E (NOT (NEq js))))
7.1639 - | prep (A (Dvd (jt, ju))) = prep (NOT (E (NOT (Dvd (jt, ju)))))
7.1640 - | prep (A (NDvd (jv, jw))) = prep (NOT (E (NOT (NDvd (jv, jw)))))
7.1641 - | prep (A (NOT jx)) = prep (NOT (E (NOT (NOT jx))))
7.1642 - | prep (A (Or (ka, kb))) = prep (NOT (E (NOT (Or (ka, kb)))))
7.1643 - | prep (A (Imp (kc, kd))) = prep (NOT (E (NOT (Imp (kc, kd)))))
7.1644 - | prep (A (Iff (ke, kf))) = prep (NOT (E (NOT (Iff (ke, kf)))))
7.1645 - | prep (A (E kg)) = prep (NOT (E (NOT (E kg))))
7.1646 - | prep (A (A kh)) = prep (NOT (E (NOT (A kh))))
7.1647 - | prep (A (Closed ki)) = prep (NOT (E (NOT (Closed ki))))
7.1648 - | prep (A (NClosed kj)) = prep (NOT (E (NOT (NClosed kj))))
7.1649 - | prep (NOT (NOT p)) = prep p
7.1650 - | prep (NOT (And (p, q))) = Or (prep (NOT p), prep (NOT q))
7.1651 - | prep (NOT (A p)) = prep (E (NOT p))
7.1652 - | prep (NOT (Or (p, q))) = And (prep (NOT p), prep (NOT q))
7.1653 - | prep (NOT (Imp (p, q))) = And (prep p, prep (NOT q))
7.1654 - | prep (NOT (Iff (p, q))) = Or (prep (And (p, NOT q)), prep (And (NOT p, q)))
7.1655 - | prep (NOT T) = NOT (prep T)
7.1656 - | prep (NOT F) = NOT (prep F)
7.1657 - | prep (NOT (Lt bo)) = NOT (prep (Lt bo))
7.1658 - | prep (NOT (Le bp)) = NOT (prep (Le bp))
7.1659 - | prep (NOT (Gt bq)) = NOT (prep (Gt bq))
7.1660 - | prep (NOT (Ge br)) = NOT (prep (Ge br))
7.1661 - | prep (NOT (Eq bs)) = NOT (prep (Eq bs))
7.1662 - | prep (NOT (NEq bt)) = NOT (prep (NEq bt))
7.1663 - | prep (NOT (Dvd (bu, bv))) = NOT (prep (Dvd (bu, bv)))
7.1664 - | prep (NOT (NDvd (bw, bx))) = NOT (prep (NDvd (bw, bx)))
7.1665 - | prep (NOT (E ch)) = NOT (prep (E ch))
7.1666 - | prep (NOT (Closed cj)) = NOT (prep (Closed cj))
7.1667 - | prep (NOT (NClosed ck)) = NOT (prep (NClosed ck))
7.1668 - | prep (Or (p, q)) = Or (prep p, prep q)
7.1669 - | prep (And (p, q)) = And (prep p, prep q)
7.1670 - | prep (Imp (p, q)) = prep (Or (NOT p, q))
7.1671 - | prep (Iff (p, q)) = Or (prep (And (p, q)), prep (And (NOT p, NOT q)))
7.1672 - | prep T = T
7.1673 - | prep F = F
7.1674 - | prep (Lt u) = Lt u
7.1675 - | prep (Le v) = Le v
7.1676 - | prep (Gt w) = Gt w
7.1677 - | prep (Ge x) = Ge x
7.1678 - | prep (Eq y) = Eq y
7.1679 - | prep (NEq z) = NEq z
7.1680 - | prep (Dvd (aa, ab)) = Dvd (aa, ab)
7.1681 - | prep (NDvd (ac, ad)) = NDvd (ac, ad)
7.1682 - | prep (Closed ap) = Closed ap
7.1683 - | prep (NClosed aq) = NClosed aq;
7.1684 -
7.1685 -fun pa x = qelim (prep x) cooper;
7.1686 -
7.1687 -val pa = (fn x => pa x);
7.1688 -
7.1689 -val test =
7.1690 - (fn x =>
7.1691 - pa (E (A (Imp (Ge (Sub (Bound 0, Bound one_def0)),
7.1692 - E (E (Eq (Sub (Add (Mul (3, Bound one_def0),
7.1693 - Mul (5, Bound 0)),
7.1694 - Bound (nat 2))))))))));
7.1695 -
7.1696 -end;
8.1 --- a/src/HOL/Tools/Presburger/presburger.ML Thu Jun 21 20:48:47 2007 +0200
8.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
8.3 @@ -1,201 +0,0 @@
8.4 -
8.5 -(* Title: HOL/Tools/Presburger/presburger.ML
8.6 - ID: $Id$
8.7 - Author: Amine Chaieb, TU Muenchen
8.8 -*)
8.9 -
8.10 -signature PRESBURGER =
8.11 - sig
8.12 - val cooper_tac: bool -> thm list -> thm list -> Proof.context -> int -> Tactical.tactic
8.13 -end;
8.14 -
8.15 -structure Presburger : PRESBURGER =
8.16 -struct
8.17 -
8.18 -open Conv;
8.19 -val comp_ss = HOL_ss addsimps @{thms "Groebner_Basis.comp_arith"};
8.20 -
8.21 -fun strip_imp_cprems ct =
8.22 - case term_of ct of
8.23 - Const ("==>", _) $ _ $ _ => Thm.dest_arg1 ct :: strip_imp_cprems (Thm.dest_arg ct)
8.24 -| _ => [];
8.25 -
8.26 -val cprems_of = strip_imp_cprems o cprop_of;
8.27 -
8.28 -fun strip_objimp ct =
8.29 - case term_of ct of
8.30 - Const ("op -->", _) $ _ $ _ => Thm.dest_arg1 ct :: strip_objimp (Thm.dest_arg ct)
8.31 -| _ => [ct];
8.32 -
8.33 -fun strip_objall ct =
8.34 - case term_of ct of
8.35 - Const ("All", _) $ Abs (xn,xT,p) =>
8.36 - let val (a,(v,t')) = (apsnd (Thm.dest_abs (SOME xn)) o Thm.dest_comb) ct
8.37 - in apfst (cons (a,v)) (strip_objall t')
8.38 - end
8.39 -| _ => ([],ct);
8.40 -
8.41 -local
8.42 - val all_maxscope_ss =
8.43 - HOL_basic_ss addsimps map (fn th => th RS sym) @{thms "all_simps"}
8.44 -in
8.45 -fun thin_prems_tac P i = simp_tac all_maxscope_ss i THEN
8.46 - (fn st => case try (nth (cprems_of st)) (i - 1) of
8.47 - NONE => no_tac st
8.48 - | SOME p' =>
8.49 - let
8.50 - val (qvs, p) = strip_objall (Thm.dest_arg p')
8.51 - val (ps, c) = split_last (strip_objimp p)
8.52 - val qs = filter P ps
8.53 - val q = if P c then c else @{cterm "False"}
8.54 - val ng = fold_rev (fn (a,v) => fn t => Thm.capply a (Thm.cabs v t)) qvs
8.55 - (fold_rev (fn p => fn q => Thm.capply (Thm.capply @{cterm "op -->"} p) q) qs q)
8.56 - val g = Thm.capply (Thm.capply @{cterm "op ==>"} (Thm.capply @{cterm "Trueprop"} ng)) p'
8.57 - val ntac = (case qs of [] => q aconvc @{cterm "False"}
8.58 - | _ => false)
8.59 - in
8.60 - if ntac then no_tac st
8.61 - else rtac (Goal.prove_internal [] g (K (blast_tac HOL_cs 1))) i st
8.62 - end)
8.63 -end;
8.64 -
8.65 -local
8.66 - fun ty cts t =
8.67 - if not (typ_of (ctyp_of_term t) mem [HOLogic.intT, HOLogic.natT]) then false
8.68 - else case term_of t of
8.69 - c$_$_ => not (member (op aconv) cts c)
8.70 - | c$_ => not (member (op aconv) cts c)
8.71 - | c => not (member (op aconv) cts c)
8.72 - | _ => true
8.73 -
8.74 - val term_constants =
8.75 - let fun h acc t = case t of
8.76 - Const _ => insert (op aconv) t acc
8.77 - | a$b => h (h acc a) b
8.78 - | Abs (_,_,t) => h acc t
8.79 - | _ => acc
8.80 - in h [] end;
8.81 -in
8.82 -fun is_relevant ctxt ct =
8.83 - gen_subset (op aconv) (term_constants (term_of ct) , snd (CooperData.get ctxt))
8.84 - andalso forall (fn Free (_,T) => T = HOLogic.intT) (term_frees (term_of ct))
8.85 - andalso forall (fn Var (_,T) => T = HOLogic.intT) (term_vars (term_of ct));
8.86 -
8.87 -fun int_nat_terms ctxt ct =
8.88 - let
8.89 - val cts = snd (CooperData.get ctxt)
8.90 - fun h acc t = if ty cts t then insert (op aconvc) t acc else
8.91 - case (term_of t) of
8.92 - _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
8.93 - | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
8.94 - | _ => acc
8.95 - in h [] ct end
8.96 -end;
8.97 -
8.98 -fun generalize_tac ctxt f i st =
8.99 - case try (nth (cprems_of st)) (i - 1) of
8.100 - NONE => all_tac st
8.101 - | SOME p =>
8.102 - let
8.103 - fun all T = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "all"}
8.104 - fun gen x t = Thm.capply (all (ctyp_of_term x)) (Thm.cabs x t)
8.105 - val ts = sort (fn (a,b) => Term.fast_term_ord (term_of a, term_of b)) (f p)
8.106 - val p' = fold_rev gen ts p
8.107 - in Seq.of_list [implies_intr p' (implies_elim st (fold forall_elim ts (assume p')))]
8.108 - end;
8.109 -
8.110 -local
8.111 -val ss1 = comp_ss
8.112 - addsimps simp_thms @ [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}]
8.113 - @ map (fn r => r RS sym)
8.114 - [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"},
8.115 - @{thm "zmult_int"}]
8.116 - addsplits [@{thm "zdiff_int_split"}]
8.117 -
8.118 -val ss2 = HOL_basic_ss
8.119 - addsimps [@{thm "nat_0_le"}, @{thm "int_nat_number_of"},
8.120 - @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"},
8.121 - @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}, @{thm "Suc_plus1"}]
8.122 - addcongs [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
8.123 -val div_mod_ss = HOL_basic_ss addsimps simp_thms
8.124 - @ map (symmetric o mk_meta_eq)
8.125 - [@{thm "dvd_eq_mod_eq_0"}, @{thm "zdvd_iff_zmod_eq_0"}, mod_add1_eq,
8.126 - mod_add_left_eq, mod_add_right_eq,
8.127 - @{thm "zmod_zadd1_eq"}, @{thm "zmod_zadd_left_eq"},
8.128 - @{thm "zmod_zadd_right_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
8.129 - @ [@{thm "mod_self"}, @{thm "zmod_self"}, @{thm "DIVISION_BY_ZERO_MOD"},
8.130 - @{thm "DIVISION_BY_ZERO_DIV"}, @{thm "DIVISION_BY_ZERO"} RS conjunct1,
8.131 - @{thm "DIVISION_BY_ZERO"} RS conjunct2, @{thm "zdiv_zero"}, @{thm "zmod_zero"},
8.132 - @{thm "div_0"}, @{thm "mod_0"}, @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"},
8.133 - @{thm "mod_1"}, @{thm "Suc_plus1"}]
8.134 - @ add_ac
8.135 - addsimprocs [cancel_div_mod_proc]
8.136 - val splits_ss = comp_ss addsimps [@{thm "mod_div_equality'"}] addsplits
8.137 - [@{thm "split_zdiv"}, @{thm "split_zmod"}, @{thm "split_div'"},
8.138 - @{thm "split_min"}, @{thm "split_max"}, @{thm "abs_split"}]
8.139 -in
8.140 -fun nat_to_int_tac ctxt i =
8.141 - simp_tac (Simplifier.context ctxt ss1) i THEN
8.142 - simp_tac (Simplifier.context ctxt ss2) i THEN
8.143 - TRY (simp_tac (Simplifier.context ctxt comp_ss) i);
8.144 -
8.145 -fun div_mod_tac ctxt i = simp_tac (Simplifier.context ctxt div_mod_ss) i;
8.146 -fun splits_tac ctxt i = simp_tac (Simplifier.context ctxt splits_ss) i;
8.147 -end;
8.148 -
8.149 -
8.150 -fun eta_beta_tac ctxt i st = case try (nth (cprems_of st)) (i - 1) of
8.151 - NONE => no_tac st
8.152 - | SOME p =>
8.153 - let
8.154 - val eq = (eta_conv (ProofContext.theory_of ctxt) then_conv Thm.beta_conversion true) p
8.155 - val p' = Thm.rhs_of eq
8.156 - val th = implies_intr p' (equal_elim (symmetric eq) (assume p'))
8.157 - in rtac th i st
8.158 - end;
8.159 -
8.160 -
8.161 -
8.162 -fun core_cooper_tac ctxt i st =
8.163 - case try (nth (cprems_of st)) (i - 1) of
8.164 - NONE => all_tac st
8.165 - | SOME p =>
8.166 - let
8.167 - val cpth =
8.168 - if !quick_and_dirty
8.169 - then linzqe_oracle (ProofContext.theory_of ctxt)
8.170 - (Envir.beta_norm (Pattern.eta_long [] (term_of (Thm.dest_arg p))))
8.171 - else arg_conv (Cooper.cooper_conv ctxt) p
8.172 - val p' = Thm.rhs_of cpth
8.173 - val th = implies_intr p' (equal_elim (symmetric cpth) (assume p'))
8.174 - in rtac th i st end
8.175 - handle Cooper.COOPER _ => no_tac st;
8.176 -
8.177 -fun nogoal_tac i st = case try (nth (cprems_of st)) (i - 1) of
8.178 - NONE => no_tac st
8.179 - | SOME _ => all_tac st
8.180 -
8.181 -fun finish_tac q i st = case try (nth (cprems_of st)) (i - 1) of
8.182 - NONE => all_tac st
8.183 - | SOME _ => (if q then I else TRY) (rtac TrueI i) st
8.184 -
8.185 -fun cooper_tac elim add_ths del_ths ctxt i =
8.186 -let val ss = fst (CooperData.get ctxt) delsimps del_ths addsimps add_ths
8.187 -in
8.188 -nogoal_tac i
8.189 -THEN (EVERY o (map TRY))
8.190 - [ObjectLogic.full_atomize_tac i,
8.191 - eta_beta_tac ctxt i,
8.192 - simp_tac ss i,
8.193 - generalize_tac ctxt (int_nat_terms ctxt) i,
8.194 - ObjectLogic.full_atomize_tac i,
8.195 - div_mod_tac ctxt i,
8.196 - splits_tac ctxt i,
8.197 - simp_tac ss i,
8.198 - eta_beta_tac ctxt i,
8.199 - nat_to_int_tac ctxt i,
8.200 - thin_prems_tac (is_relevant ctxt) i]
8.201 -THEN core_cooper_tac ctxt i THEN finish_tac elim i
8.202 -end;
8.203 -
8.204 -end;
9.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2 +++ b/src/HOL/Tools/Qelim/cooper.ML Thu Jun 21 20:48:48 2007 +0200
9.3 @@ -0,0 +1,661 @@
9.4 +(* Title: HOL/Tools/Presburger/cooper.ML
9.5 + ID: $Id$
9.6 + Author: Amine Chaieb, TU Muenchen
9.7 +*)
9.8 +
9.9 +signature COOPER =
9.10 + sig
9.11 + val cooper_conv : Proof.context -> Conv.conv
9.12 + exception COOPER of string * exn
9.13 +end;
9.14 +
9.15 +structure Cooper: COOPER =
9.16 +struct
9.17 +open Conv;
9.18 +open Normalizer;
9.19 +structure Integertab = TableFun(type key = integer val ord = Integer.cmp);
9.20 +exception COOPER of string * exn;
9.21 +val simp_thms_conv = Simplifier.rewrite (HOL_basic_ss addsimps simp_thms);
9.22 +
9.23 +fun C f x y = f y x;
9.24 +
9.25 +val FWD = C (fold (C implies_elim));
9.26 +
9.27 +val true_tm = @{cterm "True"};
9.28 +val false_tm = @{cterm "False"};
9.29 +val zdvd1_eq = @{thm "zdvd1_eq"};
9.30 +val presburger_ss = @{simpset} addsimps [zdvd1_eq];
9.31 +val lin_ss = presburger_ss addsimps (@{thm "dvd_eq_mod_eq_0"}::zdvd1_eq::@{thms zadd_ac});
9.32 +(* Some types and constants *)
9.33 +val iT = HOLogic.intT
9.34 +val bT = HOLogic.boolT;
9.35 +val dest_numeral = HOLogic.dest_number #> snd;
9.36 +
9.37 +val [miconj, midisj, mieq, mineq, milt, mile, migt, mige, midvd, mindvd, miP] =
9.38 + map(instantiate' [SOME @{ctyp "int"}] []) @{thms "minf"};
9.39 +
9.40 +val [infDconj, infDdisj, infDdvd,infDndvd,infDP] =
9.41 + map(instantiate' [SOME @{ctyp "int"}] []) @{thms "inf_period"};
9.42 +
9.43 +val [piconj, pidisj, pieq,pineq,pilt,pile,pigt,pige,pidvd,pindvd,piP] =
9.44 + map (instantiate' [SOME @{ctyp "int"}] []) @{thms "pinf"};
9.45 +
9.46 +val [miP, piP] = map (instantiate' [SOME @{ctyp "bool"}] []) [miP, piP];
9.47 +
9.48 +val infDP = instantiate' (map SOME [@{ctyp "int"}, @{ctyp "bool"}]) [] infDP;
9.49 +
9.50 +val [[asetconj, asetdisj, aseteq, asetneq, asetlt, asetle,
9.51 + asetgt, asetge, asetdvd, asetndvd,asetP],
9.52 + [bsetconj, bsetdisj, bseteq, bsetneq, bsetlt, bsetle,
9.53 + bsetgt, bsetge, bsetdvd, bsetndvd,bsetP]] = [@{thms "aset"}, @{thms "bset"}];
9.54 +
9.55 +val [miex, cpmi, piex, cppi] = [@{thm "minusinfinity"}, @{thm "cpmi"},
9.56 + @{thm "plusinfinity"}, @{thm "cppi"}];
9.57 +
9.58 +val unity_coeff_ex = instantiate' [SOME @{ctyp "int"}] [] @{thm "unity_coeff_ex"};
9.59 +
9.60 +val [zdvd_mono,simp_from_to,all_not_ex] =
9.61 + [@{thm "zdvd_mono"}, @{thm "simp_from_to"}, @{thm "all_not_ex"}];
9.62 +
9.63 +val [dvd_uminus, dvd_uminus'] = @{thms "uminus_dvd_conv"};
9.64 +
9.65 +val eval_ss = presburger_ss addsimps [simp_from_to] delsimps [insert_iff,bex_triv];
9.66 +val eval_conv = Simplifier.rewrite eval_ss;
9.67 +
9.68 +(* recongnising cterm without moving to terms *)
9.69 +
9.70 +datatype fm = And of cterm*cterm| Or of cterm*cterm| Eq of cterm | NEq of cterm
9.71 + | Lt of cterm | Le of cterm | Gt of cterm | Ge of cterm
9.72 + | Dvd of cterm*cterm | NDvd of cterm*cterm | Nox
9.73 +
9.74 +fun whatis x ct =
9.75 +( case (term_of ct) of
9.76 + Const("op &",_)$_$_ => And (Thm.dest_binop ct)
9.77 +| Const ("op |",_)$_$_ => Or (Thm.dest_binop ct)
9.78 +| Const ("op =",ty)$y$_ => if term_of x aconv y then Eq (Thm.dest_arg ct) else Nox
9.79 +| Const("Not",_) $ (Const ("op =",_)$y$_) =>
9.80 + if term_of x aconv y then NEq (funpow 2 Thm.dest_arg ct) else Nox
9.81 +| Const ("Orderings.ord_class.less",_)$y$z =>
9.82 + if term_of x aconv y then Lt (Thm.dest_arg ct)
9.83 + else if term_of x aconv z then Gt (Thm.dest_arg1 ct) else Nox
9.84 +| Const ("Orderings.ord_class.less_eq",_)$y$z =>
9.85 + if term_of x aconv y then Le (Thm.dest_arg ct)
9.86 + else if term_of x aconv z then Ge (Thm.dest_arg1 ct) else Nox
9.87 +| Const ("Divides.dvd",_)$_$(Const(@{const_name "HOL.plus"},_)$y$_) =>
9.88 + if term_of x aconv y then Dvd (Thm.dest_binop ct ||> Thm.dest_arg) else Nox
9.89 +| Const("Not",_) $ (Const ("Divides.dvd",_)$_$(Const(@{const_name "HOL.plus"},_)$y$_)) =>
9.90 + if term_of x aconv y then
9.91 + NDvd (Thm.dest_binop (Thm.dest_arg ct) ||> Thm.dest_arg) else Nox
9.92 +| _ => Nox)
9.93 + handle CTERM _ => Nox;
9.94 +
9.95 +fun get_pmi_term t =
9.96 + let val (x,eq) =
9.97 + (Thm.dest_abs NONE o Thm.dest_arg o snd o Thm.dest_abs NONE o Thm.dest_arg)
9.98 + (Thm.dest_arg t)
9.99 +in (Thm.cabs x o Thm.dest_arg o Thm.dest_arg) eq end;
9.100 +
9.101 +val get_pmi = get_pmi_term o cprop_of;
9.102 +
9.103 +val p_v' = @{cpat "?P' :: int => bool"};
9.104 +val q_v' = @{cpat "?Q' :: int => bool"};
9.105 +val p_v = @{cpat "?P:: int => bool"};
9.106 +val q_v = @{cpat "?Q:: int => bool"};
9.107 +
9.108 +fun myfwd (th1, th2, th3) p q
9.109 + [(th_1,th_2,th_3), (th_1',th_2',th_3')] =
9.110 + let
9.111 + val (mp', mq') = (get_pmi th_1, get_pmi th_1')
9.112 + val mi_th = FWD (instantiate ([],[(p_v,p),(q_v,q), (p_v',mp'),(q_v',mq')]) th1)
9.113 + [th_1, th_1']
9.114 + val infD_th = FWD (instantiate ([],[(p_v,mp'), (q_v, mq')]) th3) [th_3,th_3']
9.115 + val set_th = FWD (instantiate ([],[(p_v,p), (q_v,q)]) th2) [th_2, th_2']
9.116 + in (mi_th, set_th, infD_th)
9.117 + end;
9.118 +
9.119 +val inst' = fn cts => instantiate' [] (map SOME cts);
9.120 +val infDTrue = instantiate' [] [SOME true_tm] infDP;
9.121 +val infDFalse = instantiate' [] [SOME false_tm] infDP;
9.122 +
9.123 +val cadd = @{cterm "op + :: int => _"}
9.124 +val cmulC = @{cterm "op * :: int => _"}
9.125 +val cminus = @{cterm "op - :: int => _"}
9.126 +val cone = @{cterm "1:: int"}
9.127 +val cneg = @{cterm "uminus :: int => _"}
9.128 +val [addC, mulC, subC, negC] = map term_of [cadd, cmulC, cminus, cneg]
9.129 +val [zero, one] = [@{term "0::int"}, @{term "1::int"}];
9.130 +
9.131 +val is_numeral = can dest_numeral;
9.132 +
9.133 +fun numeral1 f n = HOLogic.mk_number iT (f (dest_numeral n));
9.134 +fun numeral2 f m n = HOLogic.mk_number iT (f (dest_numeral m) (dest_numeral n));
9.135 +
9.136 +val [minus1,plus1] =
9.137 + map (fn c => fn t => Thm.capply (Thm.capply c t) cone) [cminus,cadd];
9.138 +
9.139 +fun decomp_pinf x dvd inS [aseteq, asetneq, asetlt, asetle,
9.140 + asetgt, asetge,asetdvd,asetndvd,asetP,
9.141 + infDdvd, infDndvd, asetconj,
9.142 + asetdisj, infDconj, infDdisj] cp =
9.143 + case (whatis x cp) of
9.144 + And (p,q) => ([p,q], myfwd (piconj, asetconj, infDconj) (Thm.cabs x p) (Thm.cabs x q))
9.145 +| Or (p,q) => ([p,q], myfwd (pidisj, asetdisj, infDdisj) (Thm.cabs x p) (Thm.cabs x q))
9.146 +| Eq t => ([], K (inst' [t] pieq, FWD (inst' [t] aseteq) [inS (plus1 t)], infDFalse))
9.147 +| NEq t => ([], K (inst' [t] pineq, FWD (inst' [t] asetneq) [inS t], infDTrue))
9.148 +| Lt t => ([], K (inst' [t] pilt, FWD (inst' [t] asetlt) [inS t], infDFalse))
9.149 +| Le t => ([], K (inst' [t] pile, FWD (inst' [t] asetle) [inS (plus1 t)], infDFalse))
9.150 +| Gt t => ([], K (inst' [t] pigt, (inst' [t] asetgt), infDTrue))
9.151 +| Ge t => ([], K (inst' [t] pige, (inst' [t] asetge), infDTrue))
9.152 +| Dvd (d,s) =>
9.153 + ([],let val dd = dvd d
9.154 + in K (inst' [d,s] pidvd, FWD (inst' [d,s] asetdvd) [dd],FWD (inst' [d,s] infDdvd) [dd]) end)
9.155 +| NDvd(d,s) => ([],let val dd = dvd d
9.156 + in K (inst' [d,s] pindvd, FWD (inst' [d,s] asetndvd) [dd], FWD (inst' [d,s] infDndvd) [dd]) end)
9.157 +| _ => ([], K (inst' [cp] piP, inst' [cp] asetP, inst' [cp] infDP));
9.158 +
9.159 +fun decomp_minf x dvd inS [bseteq,bsetneq,bsetlt, bsetle, bsetgt,
9.160 + bsetge,bsetdvd,bsetndvd,bsetP,
9.161 + infDdvd, infDndvd, bsetconj,
9.162 + bsetdisj, infDconj, infDdisj] cp =
9.163 + case (whatis x cp) of
9.164 + And (p,q) => ([p,q], myfwd (miconj, bsetconj, infDconj) (Thm.cabs x p) (Thm.cabs x q))
9.165 +| Or (p,q) => ([p,q], myfwd (midisj, bsetdisj, infDdisj) (Thm.cabs x p) (Thm.cabs x q))
9.166 +| Eq t => ([], K (inst' [t] mieq, FWD (inst' [t] bseteq) [inS (minus1 t)], infDFalse))
9.167 +| NEq t => ([], K (inst' [t] mineq, FWD (inst' [t] bsetneq) [inS t], infDTrue))
9.168 +| Lt t => ([], K (inst' [t] milt, (inst' [t] bsetlt), infDTrue))
9.169 +| Le t => ([], K (inst' [t] mile, (inst' [t] bsetle), infDTrue))
9.170 +| Gt t => ([], K (inst' [t] migt, FWD (inst' [t] bsetgt) [inS t], infDFalse))
9.171 +| Ge t => ([], K (inst' [t] mige,FWD (inst' [t] bsetge) [inS (minus1 t)], infDFalse))
9.172 +| Dvd (d,s) => ([],let val dd = dvd d
9.173 + in K (inst' [d,s] midvd, FWD (inst' [d,s] bsetdvd) [dd] , FWD (inst' [d,s] infDdvd) [dd]) end)
9.174 +| NDvd (d,s) => ([],let val dd = dvd d
9.175 + in K (inst' [d,s] mindvd, FWD (inst' [d,s] bsetndvd) [dd], FWD (inst' [d,s] infDndvd) [dd]) end)
9.176 +| _ => ([], K (inst' [cp] miP, inst' [cp] bsetP, inst' [cp] infDP))
9.177 +
9.178 + (* Canonical linear form for terms, formulae etc.. *)
9.179 +fun provelin ctxt t = Goal.prove ctxt [] [] t
9.180 + (fn _ => EVERY [simp_tac lin_ss 1, TRY (simple_arith_tac 1)]);
9.181 +fun linear_cmul 0 tm = zero
9.182 + | linear_cmul n tm =
9.183 + case tm of
9.184 + Const("HOL.plus_class.plus",_)$a$b => addC$(linear_cmul n a)$(linear_cmul n b)
9.185 + | Const ("HOL.times_class.times",_)$c$x => mulC$(numeral1 (Integer.mult n) c)$x
9.186 + | Const("HOL.minus_class.minus",_)$a$b => subC$(linear_cmul n a)$(linear_cmul n b)
9.187 + | (m as Const("HOL.minus_class.uminus",_))$a => m$(linear_cmul n a)
9.188 + | _ => numeral1 (Integer.mult n) tm;
9.189 +fun earlier [] x y = false
9.190 + | earlier (h::t) x y =
9.191 + if h aconv y then false else if h aconv x then true else earlier t x y;
9.192 +
9.193 +fun linear_add vars tm1 tm2 =
9.194 + case (tm1,tm2) of
9.195 + (Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c1$x1)$r1,
9.196 + Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c2$x2)$r2) =>
9.197 + if x1 = x2 then
9.198 + let val c = numeral2 Integer.add c1 c2
9.199 + in if c = zero then linear_add vars r1 r2
9.200 + else addC$(mulC$c$x1)$(linear_add vars r1 r2)
9.201 + end
9.202 + else if earlier vars x1 x2 then addC$(mulC$ c1 $ x1)$(linear_add vars r1 tm2)
9.203 + else addC$(mulC$c2$x2)$(linear_add vars tm1 r2)
9.204 + | (Const("HOL.plus_class.plus",_) $ (Const("HOL.times_class.times",_)$c1$x1)$r1 ,_) =>
9.205 + addC$(mulC$c1$x1)$(linear_add vars r1 tm2)
9.206 + | (_, Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c2$x2)$r2) =>
9.207 + addC$(mulC$c2$x2)$(linear_add vars tm1 r2)
9.208 + | (_,_) => numeral2 Integer.add tm1 tm2;
9.209 +
9.210 +fun linear_neg tm = linear_cmul ~1 tm;
9.211 +fun linear_sub vars tm1 tm2 = linear_add vars tm1 (linear_neg tm2);
9.212 +
9.213 +
9.214 +fun lint vars tm =
9.215 +if is_numeral tm then tm
9.216 +else case tm of
9.217 + Const("HOL.minus_class.uminus",_)$t => linear_neg (lint vars t)
9.218 +| Const("HOL.plus_class.plus",_) $ s $ t => linear_add vars (lint vars s) (lint vars t)
9.219 +| Const("HOL.minus_class.minus",_) $ s $ t => linear_sub vars (lint vars s) (lint vars t)
9.220 +| Const ("HOL.times_class.times",_) $ s $ t =>
9.221 + let val s' = lint vars s
9.222 + val t' = lint vars t
9.223 + in if is_numeral s' then (linear_cmul (dest_numeral s') t')
9.224 + else if is_numeral t' then (linear_cmul (dest_numeral t') s')
9.225 + else raise COOPER ("Cooper Failed", TERM ("lint: not linear",[tm]))
9.226 + end
9.227 + | _ => addC$(mulC$one$tm)$zero;
9.228 +
9.229 +fun lin (vs as x::_) (Const("Not",_)$(Const("Orderings.ord_class.less",T)$s$t)) =
9.230 + lin vs (Const("Orderings.ord_class.less_eq",T)$t$s)
9.231 + | lin (vs as x::_) (Const("Not",_)$(Const("Orderings.ord_class.less_eq",T)$s$t)) =
9.232 + lin vs (Const("Orderings.ord_class.less",T)$t$s)
9.233 + | lin vs (Const ("Not",T)$t) = Const ("Not",T)$ (lin vs t)
9.234 + | lin (vs as x::_) (Const("Divides.dvd",_)$d$t) =
9.235 + HOLogic.mk_binrel "Divides.dvd" (numeral1 abs d, lint vs t)
9.236 + | lin (vs as x::_) ((b as Const("op =",_))$s$t) =
9.237 + (case lint vs (subC$t$s) of
9.238 + (t as a$(m$c$y)$r) =>
9.239 + if x <> y then b$zero$t
9.240 + else if dest_numeral c < 0 then b$(m$(numeral1 ~ c)$y)$r
9.241 + else b$(m$c$y)$(linear_neg r)
9.242 + | t => b$zero$t)
9.243 + | lin (vs as x::_) (b$s$t) =
9.244 + (case lint vs (subC$t$s) of
9.245 + (t as a$(m$c$y)$r) =>
9.246 + if x <> y then b$zero$t
9.247 + else if dest_numeral c < 0 then b$(m$(numeral1 ~ c)$y)$r
9.248 + else b$(linear_neg r)$(m$c$y)
9.249 + | t => b$zero$t)
9.250 + | lin vs fm = fm;
9.251 +
9.252 +fun lint_conv ctxt vs ct =
9.253 +let val t = term_of ct
9.254 +in (provelin ctxt ((HOLogic.eq_const iT)$t$(lint vs t) |> HOLogic.mk_Trueprop))
9.255 + RS eq_reflection
9.256 +end;
9.257 +
9.258 +fun is_intrel (b$_$_) = domain_type (fastype_of b) = HOLogic.intT
9.259 + | is_intrel (@{term "Not"}$(b$_$_)) = domain_type (fastype_of b) = HOLogic.intT
9.260 + | is_intrel _ = false;
9.261 +
9.262 +fun linearize_conv ctxt vs ct =
9.263 + case (term_of ct) of
9.264 + Const("Divides.dvd",_)$d$t =>
9.265 + let
9.266 + val th = binop_conv (lint_conv ctxt vs) ct
9.267 + val (d',t') = Thm.dest_binop (Thm.rhs_of th)
9.268 + val (dt',tt') = (term_of d', term_of t')
9.269 + in if is_numeral dt' andalso is_numeral tt'
9.270 + then Conv.fconv_rule (arg_conv (Simplifier.rewrite presburger_ss)) th
9.271 + else
9.272 + let
9.273 + val dth =
9.274 + ((if dest_numeral (term_of d') < 0 then
9.275 + Conv.fconv_rule (arg_conv (arg1_conv (lint_conv ctxt vs)))
9.276 + (Thm.transitive th (inst' [d',t'] dvd_uminus))
9.277 + else th) handle TERM _ => th)
9.278 + val d'' = Thm.rhs_of dth |> Thm.dest_arg1
9.279 + in
9.280 + case tt' of
9.281 + Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c$_)$_ =>
9.282 + let val x = dest_numeral c
9.283 + in if x < 0 then Conv.fconv_rule (arg_conv (arg_conv (lint_conv ctxt vs)))
9.284 + (Thm.transitive dth (inst' [d'',t'] dvd_uminus'))
9.285 + else dth end
9.286 + | _ => dth
9.287 + end
9.288 + end
9.289 +| Const("Not",_)$(Const("Divides.dvd",_)$_$_) => arg_conv (linearize_conv ctxt vs) ct
9.290 +| t => if is_intrel t
9.291 + then (provelin ctxt ((HOLogic.eq_const bT)$t$(lin vs t) |> HOLogic.mk_Trueprop))
9.292 + RS eq_reflection
9.293 + else reflexive ct;
9.294 +
9.295 +val dvdc = @{cterm "op dvd :: int => _"};
9.296 +
9.297 +fun unify ctxt q =
9.298 + let
9.299 + val (e,(cx,p)) = q |> Thm.dest_comb ||> Thm.dest_abs NONE
9.300 + val x = term_of cx
9.301 + val ins = insert (op = : integer*integer -> bool)
9.302 + fun h (acc,dacc) t =
9.303 + case (term_of t) of
9.304 + Const(s,_)$(Const("HOL.times_class.times",_)$c$y)$ _ =>
9.305 + if x aconv y
9.306 + andalso s mem ["op =", "Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
9.307 + then (ins (dest_numeral c) acc,dacc) else (acc,dacc)
9.308 + | Const(s,_)$_$(Const("HOL.times_class.times",_)$c$y) =>
9.309 + if x aconv y
9.310 + andalso s mem ["Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
9.311 + then (ins (dest_numeral c) acc, dacc) else (acc,dacc)
9.312 + | Const("Divides.dvd",_)$_$(Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c$y)$_) =>
9.313 + if x aconv y then (acc,ins (dest_numeral c) dacc) else (acc,dacc)
9.314 + | Const("op &",_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
9.315 + | Const("op |",_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
9.316 + | Const("Not",_)$_ => h (acc,dacc) (Thm.dest_arg t)
9.317 + | _ => (acc, dacc)
9.318 + val (cs,ds) = h ([],[]) p
9.319 + val l = fold (curry lcm) (cs union ds) 1
9.320 + fun cv k ct =
9.321 + let val (tm as b$s$t) = term_of ct
9.322 + in ((HOLogic.eq_const bT)$tm$(b$(linear_cmul k s)$(linear_cmul k t))
9.323 + |> HOLogic.mk_Trueprop |> provelin ctxt) RS eq_reflection end
9.324 + fun nzprop x =
9.325 + let
9.326 + val th =
9.327 + Simplifier.rewrite lin_ss
9.328 + (Thm.capply @{cterm Trueprop} (Thm.capply @{cterm "Not"}
9.329 + (Thm.capply (Thm.capply @{cterm "op = :: int => _"} (mk_cnumber @{ctyp "int"} x))
9.330 + @{cterm "0::int"})))
9.331 + in equal_elim (Thm.symmetric th) TrueI end;
9.332 + val notz = let val tab = fold Integertab.update
9.333 + (ds ~~ (map (fn x => nzprop (Integer.div l x)) ds)) Integertab.empty
9.334 + in
9.335 + (fn ct => (valOf (Integertab.lookup tab (ct |> term_of |> dest_numeral))
9.336 + handle Option => (writeln "noz: Theorems-Table contains no entry for";
9.337 + print_cterm ct ; raise Option)))
9.338 + end
9.339 + fun unit_conv t =
9.340 + case (term_of t) of
9.341 + Const("op &",_)$_$_ => binop_conv unit_conv t
9.342 + | Const("op |",_)$_$_ => binop_conv unit_conv t
9.343 + | Const("Not",_)$_ => arg_conv unit_conv t
9.344 + | Const(s,_)$(Const("HOL.times_class.times",_)$c$y)$ _ =>
9.345 + if x=y andalso s mem ["op =", "Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
9.346 + then cv (Integer.div l (dest_numeral c)) t else Thm.reflexive t
9.347 + | Const(s,_)$_$(Const("HOL.times_class.times",_)$c$y) =>
9.348 + if x=y andalso s mem ["Orderings.ord_class.less", "Orderings.ord_class.less_eq"]
9.349 + then cv (Integer.div l (dest_numeral c)) t else Thm.reflexive t
9.350 + | Const("Divides.dvd",_)$d$(r as (Const("HOL.plus_class.plus",_)$(Const("HOL.times_class.times",_)$c$y)$_)) =>
9.351 + if x=y then
9.352 + let
9.353 + val k = Integer.div l (dest_numeral c)
9.354 + val kt = HOLogic.mk_number iT k
9.355 + val th1 = inst' [Thm.dest_arg1 t, Thm.dest_arg t]
9.356 + ((Thm.dest_arg t |> funpow 2 Thm.dest_arg1 |> notz) RS zdvd_mono)
9.357 + val (d',t') = (mulC$kt$d, mulC$kt$r)
9.358 + val thc = (provelin ctxt ((HOLogic.eq_const iT)$d'$(lint [] d') |> HOLogic.mk_Trueprop))
9.359 + RS eq_reflection
9.360 + val tht = (provelin ctxt ((HOLogic.eq_const iT)$t'$(linear_cmul k r) |> HOLogic.mk_Trueprop))
9.361 + RS eq_reflection
9.362 + in Thm.transitive th1 (Thm.combination (Drule.arg_cong_rule dvdc thc) tht) end
9.363 + else Thm.reflexive t
9.364 + | _ => Thm.reflexive t
9.365 + val uth = unit_conv p
9.366 + val clt = mk_cnumber @{ctyp "int"} l
9.367 + val ltx = Thm.capply (Thm.capply cmulC clt) cx
9.368 + val th = Drule.arg_cong_rule e (Thm.abstract_rule (fst (dest_Free x )) cx uth)
9.369 + val th' = inst' [Thm.cabs ltx (Thm.rhs_of uth), clt] unity_coeff_ex
9.370 + val thf = transitive th
9.371 + (transitive (symmetric (beta_conversion true (cprop_of th' |> Thm.dest_arg1))) th')
9.372 + val (lth,rth) = Thm.dest_comb (cprop_of thf) |>> Thm.dest_arg |>> Thm.beta_conversion true
9.373 + ||> beta_conversion true |>> Thm.symmetric
9.374 + in transitive (transitive lth thf) rth end;
9.375 +
9.376 +
9.377 +val emptyIS = @{cterm "{}::int set"};
9.378 +val insert_tm = @{cterm "insert :: int => _"};
9.379 +val mem_tm = Const("op :",[iT , HOLogic.mk_setT iT] ---> bT);
9.380 +fun mkISet cts = fold_rev (Thm.capply insert_tm #> Thm.capply) cts emptyIS;
9.381 +val cTrp = @{cterm "Trueprop"};
9.382 +val eqelem_imp_imp = (thm"eqelem_imp_iff") RS iffD1;
9.383 +val [A_tm,B_tm] = map (fn th => cprop_of th |> funpow 2 Thm.dest_arg |> Thm.dest_abs NONE |> snd |> Thm.dest_arg1 |> Thm.dest_arg
9.384 + |> Thm.dest_abs NONE |> snd |> Thm.dest_fun |> Thm.dest_arg)
9.385 + [asetP,bsetP];
9.386 +
9.387 +val D_tm = @{cpat "?D::int"};
9.388 +
9.389 +val int_eq = (op =):integer*integer -> bool;
9.390 +fun cooperex_conv ctxt vs q =
9.391 +let
9.392 +
9.393 + val uth = unify ctxt q
9.394 + val (x,p) = Thm.dest_abs NONE (Thm.dest_arg (Thm.rhs_of uth))
9.395 + val ins = insert (op aconvc)
9.396 + fun h t (bacc,aacc,dacc) =
9.397 + case (whatis x t) of
9.398 + And (p,q) => h q (h p (bacc,aacc,dacc))
9.399 + | Or (p,q) => h q (h p (bacc,aacc,dacc))
9.400 + | Eq t => (ins (minus1 t) bacc,
9.401 + ins (plus1 t) aacc,dacc)
9.402 + | NEq t => (ins t bacc,
9.403 + ins t aacc, dacc)
9.404 + | Lt t => (bacc, ins t aacc, dacc)
9.405 + | Le t => (bacc, ins (plus1 t) aacc,dacc)
9.406 + | Gt t => (ins t bacc, aacc,dacc)
9.407 + | Ge t => (ins (minus1 t) bacc, aacc,dacc)
9.408 + | Dvd (d,s) => (bacc,aacc,insert int_eq (term_of d |> dest_numeral) dacc)
9.409 + | NDvd (d,s) => (bacc,aacc,insert int_eq (term_of d|> dest_numeral) dacc)
9.410 + | _ => (bacc, aacc, dacc)
9.411 + val (b0,a0,ds) = h p ([],[],[])
9.412 + val d = fold (curry lcm) ds 1
9.413 + val cd = mk_cnumber @{ctyp "int"} d
9.414 + val dt = term_of cd
9.415 + fun divprop x =
9.416 + let
9.417 + val th =
9.418 + Simplifier.rewrite lin_ss
9.419 + (Thm.capply @{cterm Trueprop}
9.420 + (Thm.capply (Thm.capply dvdc (mk_cnumber @{ctyp "int"} x)) cd))
9.421 + in equal_elim (Thm.symmetric th) TrueI end;
9.422 + val dvd = let val tab = fold Integertab.update
9.423 + (ds ~~ (map divprop ds)) Integertab.empty in
9.424 + (fn ct => (valOf (Integertab.lookup tab (term_of ct |> dest_numeral))
9.425 + handle Option => (writeln "dvd: Theorems-Table contains no entry for";
9.426 + print_cterm ct ; raise Option)))
9.427 + end
9.428 + val dp =
9.429 + let val th = Simplifier.rewrite lin_ss
9.430 + (Thm.capply @{cterm Trueprop}
9.431 + (Thm.capply (Thm.capply @{cterm "op < :: int => _"} @{cterm "0::int"}) cd))
9.432 + in equal_elim (Thm.symmetric th) TrueI end;
9.433 + (* A and B set *)
9.434 + local
9.435 + val insI1 = instantiate' [SOME @{ctyp "int"}] [] @{thm "insertI1"}
9.436 + val insI2 = instantiate' [SOME @{ctyp "int"}] [] @{thm "insertI2"}
9.437 + in
9.438 + fun provein x S =
9.439 + case term_of S of
9.440 + Const("{}",_) => error "Unexpected error in Cooper please email Amine Chaieb"
9.441 + | Const("insert",_)$y$_ =>
9.442 + let val (cy,S') = Thm.dest_binop S
9.443 + in if term_of x aconv y then instantiate' [] [SOME x, SOME S'] insI1
9.444 + else implies_elim (instantiate' [] [SOME x, SOME S', SOME cy] insI2)
9.445 + (provein x S')
9.446 + end
9.447 + end
9.448 +
9.449 + val al = map (lint vs o term_of) a0
9.450 + val bl = map (lint vs o term_of) b0
9.451 + val (sl,s0,f,abths,cpth) =
9.452 + if length (distinct (op aconv) bl) <= length (distinct (op aconv) al)
9.453 + then
9.454 + (bl,b0,decomp_minf,
9.455 + fn B => (map (fn th => implies_elim (Thm.instantiate ([],[(B_tm,B), (D_tm,cd)]) th) dp)
9.456 + [bseteq,bsetneq,bsetlt, bsetle, bsetgt,bsetge])@
9.457 + (map (Thm.instantiate ([],[(B_tm,B), (D_tm,cd)]))
9.458 + [bsetdvd,bsetndvd,bsetP,infDdvd, infDndvd,bsetconj,
9.459 + bsetdisj,infDconj, infDdisj]),
9.460 + cpmi)
9.461 + else (al,a0,decomp_pinf,fn A =>
9.462 + (map (fn th => implies_elim (Thm.instantiate ([],[(A_tm,A), (D_tm,cd)]) th) dp)
9.463 + [aseteq,asetneq,asetlt, asetle, asetgt,asetge])@
9.464 + (map (Thm.instantiate ([],[(A_tm,A), (D_tm,cd)]))
9.465 + [asetdvd,asetndvd, asetP, infDdvd, infDndvd,asetconj,
9.466 + asetdisj,infDconj, infDdisj]),cppi)
9.467 + val cpth =
9.468 + let
9.469 + val sths = map (fn (tl,t0) =>
9.470 + if tl = term_of t0
9.471 + then instantiate' [SOME @{ctyp "int"}] [SOME t0] refl
9.472 + else provelin ctxt ((HOLogic.eq_const iT)$tl$(term_of t0)
9.473 + |> HOLogic.mk_Trueprop))
9.474 + (sl ~~ s0)
9.475 + val csl = distinct (op aconvc) (map (cprop_of #> Thm.dest_arg #> Thm.dest_arg1) sths)
9.476 + val S = mkISet csl
9.477 + val inStab = fold (fn ct => fn tab => Termtab.update (term_of ct, provein ct S) tab)
9.478 + csl Termtab.empty
9.479 + val eqelem_th = instantiate' [SOME @{ctyp "int"}] [NONE,NONE, SOME S] eqelem_imp_imp
9.480 + val inS =
9.481 + let
9.482 + fun transmem th0 th1 =
9.483 + Thm.equal_elim
9.484 + (Drule.arg_cong_rule cTrp (Drule.fun_cong_rule (Drule.arg_cong_rule
9.485 + ((Thm.dest_fun o Thm.dest_fun o Thm.dest_arg o cprop_of) th1) th0) S)) th1
9.486 + val tab = fold Termtab.update
9.487 + (map (fn eq =>
9.488 + let val (s,t) = cprop_of eq |> Thm.dest_arg |> Thm.dest_binop
9.489 + val th = if term_of s = term_of t
9.490 + then valOf(Termtab.lookup inStab (term_of s))
9.491 + else FWD (instantiate' [] [SOME s, SOME t] eqelem_th)
9.492 + [eq, valOf(Termtab.lookup inStab (term_of s))]
9.493 + in (term_of t, th) end)
9.494 + sths) Termtab.empty
9.495 + in fn ct =>
9.496 + (valOf (Termtab.lookup tab (term_of ct))
9.497 + handle Option => (writeln "inS: No theorem for " ; print_cterm ct ; raise Option))
9.498 + end
9.499 + val (inf, nb, pd) = divide_and_conquer (f x dvd inS (abths S)) p
9.500 + in [dp, inf, nb, pd] MRS cpth
9.501 + end
9.502 + val cpth' = Thm.transitive uth (cpth RS eq_reflection)
9.503 +in Thm.transitive cpth' ((simp_thms_conv then_conv eval_conv) (Thm.rhs_of cpth'))
9.504 +end;
9.505 +
9.506 +fun literals_conv bops uops env cv =
9.507 + let fun h t =
9.508 + case (term_of t) of
9.509 + b$_$_ => if member (op aconv) bops b then binop_conv h t else cv env t
9.510 + | u$_ => if member (op aconv) uops u then arg_conv h t else cv env t
9.511 + | _ => cv env t
9.512 + in h end;
9.513 +
9.514 +fun integer_nnf_conv ctxt env =
9.515 + nnf_conv then_conv literals_conv [HOLogic.conj, HOLogic.disj] [] env (linearize_conv ctxt);
9.516 +
9.517 +(* val my_term = ref (@{cterm "NOTHING"}); *)
9.518 +local
9.519 + val pcv = Simplifier.rewrite
9.520 + (HOL_basic_ss addsimps (simp_thms @ (List.take(ex_simps,4))
9.521 + @ [not_all,all_not_ex, ex_disj_distrib]))
9.522 + val postcv = Simplifier.rewrite presburger_ss
9.523 + fun conv ctxt p =
9.524 + let val _ = () (* my_term := p *)
9.525 + in
9.526 + Qelim.gen_qelim_conv ctxt pcv postcv pcv (cons o term_of)
9.527 + (term_frees (term_of p)) (linearize_conv ctxt) (integer_nnf_conv ctxt)
9.528 + (cooperex_conv ctxt) p
9.529 + end
9.530 + handle CTERM s => raise COOPER ("Cooper Failed", CTERM s)
9.531 + | THM s => raise COOPER ("Cooper Failed", THM s)
9.532 +in val cooper_conv = conv
9.533 +end;
9.534 +end;
9.535 +
9.536 +
9.537 +
9.538 +structure Coopereif =
9.539 +struct
9.540 +
9.541 +open GeneratedCooper;
9.542 +fun cooper s = raise Cooper.COOPER ("Cooper Oracle Failed", ERROR s);
9.543 +fun i_of_term vs t =
9.544 + case t of
9.545 + Free(xn,xT) => (case AList.lookup (op aconv) vs t of
9.546 + NONE => cooper "Variable not found in the list!!"
9.547 + | SOME n => Bound n)
9.548 + | @{term "0::int"} => C 0
9.549 + | @{term "1::int"} => C 1
9.550 + | Term.Bound i => Bound i
9.551 + | Const(@{const_name "HOL.uminus"},_)$t' => Neg (i_of_term vs t')
9.552 + | Const(@{const_name "HOL.plus"},_)$t1$t2 => Add (i_of_term vs t1,i_of_term vs t2)
9.553 + | Const(@{const_name "HOL.minus"},_)$t1$t2 => Sub (i_of_term vs t1,i_of_term vs t2)
9.554 + | Const(@{const_name "HOL.times"},_)$t1$t2 =>
9.555 + (Mul (HOLogic.dest_number t1 |> snd |> Integer.machine_int,i_of_term vs t2)
9.556 + handle TERM _ =>
9.557 + (Mul (HOLogic.dest_number t2 |> snd |> Integer.machine_int,i_of_term vs t1)
9.558 + handle TERM _ => cooper "Reification: Unsupported kind of multiplication"))
9.559 + | _ => (C (HOLogic.dest_number t |> snd |> Integer.machine_int)
9.560 + handle TERM _ => cooper "Reification: unknown term");
9.561 +
9.562 +fun qf_of_term ps vs t =
9.563 + case t of
9.564 + Const("True",_) => T
9.565 + | Const("False",_) => F
9.566 + | Const(@{const_name "Orderings.less"},_)$t1$t2 => Lt (Sub (i_of_term vs t1,i_of_term vs t2))
9.567 + | Const(@{const_name "Orderings.less_eq"},_)$t1$t2 => Le (Sub(i_of_term vs t1,i_of_term vs t2))
9.568 + | Const(@{const_name "Divides.dvd"},_)$t1$t2 =>
9.569 + (Dvd(HOLogic.dest_number t1 |> snd |> Integer.machine_int, i_of_term vs t2) handle _ => cooper "Reification: unsupported dvd")
9.570 + | @{term "op = :: int => _"}$t1$t2 => Eq (Sub (i_of_term vs t1,i_of_term vs t2))
9.571 + | @{term "op = :: bool => _ "}$t1$t2 => Iff(qf_of_term ps vs t1,qf_of_term ps vs t2)
9.572 + | Const("op &",_)$t1$t2 => And(qf_of_term ps vs t1,qf_of_term ps vs t2)
9.573 + | Const("op |",_)$t1$t2 => Or(qf_of_term ps vs t1,qf_of_term ps vs t2)
9.574 + | Const("op -->",_)$t1$t2 => Imp(qf_of_term ps vs t1,qf_of_term ps vs t2)
9.575 + | Const("Not",_)$t' => NOT(qf_of_term ps vs t')
9.576 + | Const("Ex",_)$Abs(xn,xT,p) =>
9.577 + let val (xn',p') = variant_abs (xn,xT,p)
9.578 + val vs' = (Free (xn',xT), nat 0) :: (map (fn(v,n) => (v,1+ n)) vs)
9.579 + in E (qf_of_term ps vs' p')
9.580 + end
9.581 + | Const("All",_)$Abs(xn,xT,p) =>
9.582 + let val (xn',p') = variant_abs (xn,xT,p)
9.583 + val vs' = (Free (xn',xT), nat 0) :: (map (fn(v,n) => (v,1+ n)) vs)
9.584 + in A (qf_of_term ps vs' p')
9.585 + end
9.586 + | _ =>(case AList.lookup (op aconv) ps t of
9.587 + NONE => cooper "Reification: unknown term!"
9.588 + | SOME n => Closed n);
9.589 +
9.590 +local
9.591 + val ops = [@{term "op &"}, @{term "op |"}, @{term "op -->"}, @{term "op = :: bool => _"},
9.592 + @{term "op = :: int => _"}, @{term "op < :: int => _"},
9.593 + @{term "op <= :: int => _"}, @{term "Not"}, @{term "All:: (int => _) => _"},
9.594 + @{term "Ex:: (int => _) => _"}, @{term "True"}, @{term "False"}]
9.595 +fun ty t = Bool.not (fastype_of t = HOLogic.boolT)
9.596 +in
9.597 +fun term_bools acc t =
9.598 +case t of
9.599 + (l as f $ a) $ b => if ty t orelse f mem ops then term_bools (term_bools acc l)b
9.600 + else insert (op aconv) t acc
9.601 + | f $ a => if ty t orelse f mem ops then term_bools (term_bools acc f) a
9.602 + else insert (op aconv) t acc
9.603 + | Abs p => term_bools acc (snd (variant_abs p))
9.604 + | _ => if ty t orelse t mem ops then acc else insert (op aconv) t acc
9.605 +end;
9.606 +
9.607 +
9.608 +fun start_vs t =
9.609 +let
9.610 + val fs = term_frees t
9.611 + val ps = term_bools [] t
9.612 +in (fs ~~ (0 upto (length fs - 1)), ps ~~ (0 upto (length ps - 1)))
9.613 +end ;
9.614 +
9.615 +val iT = HOLogic.intT;
9.616 +val bT = HOLogic.boolT;
9.617 +fun myassoc2 l v =
9.618 + case l of
9.619 + [] => NONE
9.620 + | (x,v')::xs => if v = v' then SOME x
9.621 + else myassoc2 xs v;
9.622 +
9.623 +fun term_of_i vs t =
9.624 + case t of
9.625 + C i => HOLogic.mk_number HOLogic.intT (Integer.int i)
9.626 + | Bound n => valOf (myassoc2 vs n)
9.627 + | Neg t' => @{term "uminus :: int => _"}$(term_of_i vs t')
9.628 + | Add(t1,t2) => @{term "op +:: int => _"}$ (term_of_i vs t1)$(term_of_i vs t2)
9.629 + | Sub(t1,t2) => Const(@{const_name "HOL.minus"},[iT,iT] ---> iT)$
9.630 + (term_of_i vs t1)$(term_of_i vs t2)
9.631 + | Mul(i,t2) => Const(@{const_name "HOL.times"},[iT,iT] ---> iT)$
9.632 + (HOLogic.mk_number HOLogic.intT (Integer.int i))$(term_of_i vs t2)
9.633 + | CX(i,t')=> term_of_i vs (Add(Mul (i,Bound (nat 0)),t'));
9.634 +
9.635 +fun term_of_qf ps vs t =
9.636 + case t of
9.637 + T => HOLogic.true_const
9.638 + | F => HOLogic.false_const
9.639 + | Lt t' => @{term "op < :: int => _ "}$ term_of_i vs t'$ @{term "0::int"}
9.640 + | Le t' => @{term "op <= :: int => _ "}$ term_of_i vs t' $ @{term "0::int"}
9.641 + | Gt t' => @{term "op < :: int => _ "}$ @{term "0::int"}$ term_of_i vs t'
9.642 + | Ge t' => @{term "op <= :: int => _ "}$ @{term "0::int"}$ term_of_i vs t'
9.643 + | Eq t' => @{term "op = :: int => _ "}$ term_of_i vs t'$ @{term "0::int"}
9.644 + | NEq t' => term_of_qf ps vs (NOT(Eq t'))
9.645 + | Dvd(i,t') => @{term "op dvd :: int => _ "}$
9.646 + (HOLogic.mk_number HOLogic.intT (Integer.int i))$(term_of_i vs t')
9.647 + | NDvd(i,t')=> term_of_qf ps vs (NOT(Dvd(i,t')))
9.648 + | NOT t' => HOLogic.Not$(term_of_qf ps vs t')
9.649 + | And(t1,t2) => HOLogic.conj$(term_of_qf ps vs t1)$(term_of_qf ps vs t2)
9.650 + | Or(t1,t2) => HOLogic.disj$(term_of_qf ps vs t1)$(term_of_qf ps vs t2)
9.651 + | Imp(t1,t2) => HOLogic.imp$(term_of_qf ps vs t1)$(term_of_qf ps vs t2)
9.652 + | Iff(t1,t2) => (HOLogic.eq_const bT)$(term_of_qf ps vs t1)$ (term_of_qf ps vs t2)
9.653 + | Closed n => valOf (myassoc2 ps n)
9.654 + | NClosed n => term_of_qf ps vs (NOT (Closed n))
9.655 + | _ => cooper "If this is raised, Isabelle/HOL or generate_code is inconsistent!";
9.656 +
9.657 +(* The oracle *)
9.658 +fun cooper_oracle thy t =
9.659 + let val (vs,ps) = start_vs t
9.660 + in (equals propT) $ (HOLogic.mk_Trueprop t) $
9.661 + (HOLogic.mk_Trueprop (term_of_qf ps vs (pa (qf_of_term ps vs t))))
9.662 + end;
9.663 +
9.664 +end;
10.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2 +++ b/src/HOL/Tools/Qelim/cooper_data.ML Thu Jun 21 20:48:48 2007 +0200
10.3 @@ -0,0 +1,91 @@
10.4 +(* Title: HOL/Tools/Presburger/cooper_data.ML
10.5 + ID: $Id$
10.6 + Author: Amine Chaieb, TU Muenchen
10.7 +*)
10.8 +
10.9 +signature COOPER_DATA =
10.10 +sig
10.11 + type entry
10.12 + val get: Proof.context -> entry
10.13 + val del: term list -> attribute
10.14 + val add: term list -> attribute
10.15 + val setup: theory -> theory
10.16 +end;
10.17 +
10.18 +structure CooperData : COOPER_DATA =
10.19 +struct
10.20 +
10.21 +type entry = simpset * (term list);
10.22 +val start_ss = HOL_ss (* addsimps @{thms "Groebner_Basis.comp_arith"}
10.23 + addcongs [if_weak_cong, @{thm "let_weak_cong"}];*)
10.24 +val allowed_consts =
10.25 + [@{term "op + :: int => _"}, @{term "op + :: nat => _"},
10.26 + @{term "op - :: int => _"}, @{term "op - :: nat => _"},
10.27 + @{term "op * :: int => _"}, @{term "op * :: nat => _"},
10.28 + @{term "op div :: int => _"}, @{term "op div :: nat => _"},
10.29 + @{term "op mod :: int => _"}, @{term "op mod :: nat => _"},
10.30 + @{term "Numeral.Bit"},
10.31 + @{term "op &"}, @{term "op |"}, @{term "op -->"},
10.32 + @{term "op = :: int => _"}, @{term "op = :: nat => _"}, @{term "op = :: bool => _"},
10.33 + @{term "op < :: int => _"}, @{term "op < :: nat => _"},
10.34 + @{term "op <= :: int => _"}, @{term "op <= :: nat => _"},
10.35 + @{term "op dvd :: int => _"}, @{term "op dvd :: nat => _"},
10.36 + @{term "abs :: int => _"}, @{term "abs :: nat => _"},
10.37 + @{term "max :: int => _"}, @{term "max :: nat => _"},
10.38 + @{term "min :: int => _"}, @{term "min :: nat => _"},
10.39 + @{term "HOL.uminus :: int => _"}, @{term "HOL.uminus :: nat => _"},
10.40 + @{term "Not"}, @{term "Suc"},
10.41 + @{term "Ex :: (int => _) => _"}, @{term "Ex :: (nat => _) => _"},
10.42 + @{term "All :: (int => _) => _"}, @{term "All :: (nat => _) => _"},
10.43 + @{term "nat"}, @{term "int"},
10.44 + @{term "Numeral.bit.B0"},@{term "Numeral.bit.B1"},
10.45 + @{term "Numeral.Bit"}, @{term "Numeral.Pls"}, @{term "Numeral.Min"},
10.46 + @{term "Numeral.number_of :: int => int"}, @{term "Numeral.number_of :: int => nat"},
10.47 + @{term "0::int"}, @{term "1::int"}, @{term "0::nat"}, @{term "1::nat"},
10.48 + @{term "True"}, @{term "False"}];
10.49 +
10.50 +structure Data = GenericDataFun
10.51 +(
10.52 + type T = simpset * (term list);
10.53 + val empty = (start_ss, allowed_consts);
10.54 + fun extend (ss, ts) = (MetaSimplifier.inherit_context empty_ss ss, ts);
10.55 + fun merge _ ((ss1, ts1), (ss2, ts2)) =
10.56 + (merge_ss (ss1, ss2), Library.merge (op aconv) (ts1, ts2));
10.57 +);
10.58 +
10.59 +val get = Data.get o Context.Proof;
10.60 +
10.61 +fun add ts = Thm.declaration_attribute (fn th => fn context =>
10.62 + context |> Data.map (fn (ss,ts') =>
10.63 + (ss addsimps [th], merge (op aconv) (ts',ts) )))
10.64 +
10.65 +fun del ts = Thm.declaration_attribute (fn th => fn context =>
10.66 + context |> Data.map (fn (ss,ts') =>
10.67 + (ss delsimps [th], subtract (op aconv) ts' ts )))
10.68 +
10.69 +
10.70 +(* concrete syntax *)
10.71 +
10.72 +local
10.73 +fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ();
10.74 +
10.75 +val constsN = "consts";
10.76 +val any_keyword = keyword constsN
10.77 +val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat;
10.78 +val terms = thms >> map (term_of o Drule.dest_term);
10.79 +
10.80 +fun optional scan = Scan.optional scan [];
10.81 +
10.82 +in
10.83 +fun att_syntax src = src |> Attrib.syntax
10.84 + ((Scan.lift (Args.$$$ "del") |-- optional (keyword constsN |-- terms)) >> del ||
10.85 + optional (keyword constsN |-- terms) >> add)
10.86 +end;
10.87 +
10.88 +
10.89 +(* theory setup *)
10.90 +
10.91 +val setup =
10.92 + Attrib.add_attributes [("presburger", att_syntax, "Cooper data")];
10.93 +
10.94 +end;
11.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
11.2 +++ b/src/HOL/Tools/Qelim/ferrante_rackoff.ML Thu Jun 21 20:48:48 2007 +0200
11.3 @@ -0,0 +1,263 @@
11.4 +(* Title: HOL/Tools/ferrante_rackoff.ML
11.5 + ID: $Id$
11.6 + Author: Amine Chaieb, TU Muenchen
11.7 +
11.8 +Ferrante and Rackoff's algorithm for quantifier elimination in dense
11.9 +linear orders. Proof-synthesis and tactic.
11.10 +*)
11.11 +
11.12 +signature FERRANTE_RACKOFF =
11.13 +sig
11.14 + val dlo_tac: Proof.context -> int -> tactic
11.15 +end;
11.16 +
11.17 +structure FerranteRackoff: FERRANTE_RACKOFF =
11.18 +struct
11.19 +
11.20 +open Ferrante_Rackoff_Data;
11.21 +open Conv;
11.22 +
11.23 +type entry = {minf: thm list, pinf: thm list, nmi: thm list, npi: thm list,
11.24 + ld: thm list, qe: thm, atoms : cterm list} *
11.25 + {isolate_conv: cterm list -> cterm -> thm,
11.26 + whatis : cterm -> cterm -> ord,
11.27 + simpset : simpset};
11.28 +
11.29 +fun binop_cong b th1 th2 = Thm.combination (Drule.arg_cong_rule b th1) th2;
11.30 +val is_refl = op aconv o Logic.dest_equals o Thm.prop_of;
11.31 +fun C f x y = f y x
11.32 +
11.33 +fun get_p1 th =
11.34 + let
11.35 + fun appair f (x,y) = (f x, f y)
11.36 + in funpow 2 (Thm.dest_arg o snd o Thm.dest_abs NONE)
11.37 + (funpow 2 Thm.dest_arg (cprop_of th)) |> Thm.dest_arg
11.38 +end;
11.39 +
11.40 +fun ferrack_conv
11.41 + (entr as ({minf = minf, pinf = pinf, nmi = nmi, npi = npi,
11.42 + ld = ld, qe = qe, atoms = atoms},
11.43 + {isolate_conv = icv, whatis = wi, simpset = simpset}):entry) =
11.44 +let
11.45 + fun uset (vars as (x::vs)) p = case term_of p of
11.46 + Const("op &", _)$ _ $ _ =>
11.47 + let
11.48 + val ((b,l),r) = Thm.dest_comb p |>> Thm.dest_comb
11.49 + val (lS,lth) = uset vars l val (rS, rth) = uset vars r
11.50 + in (lS@rS, binop_cong b lth rth) end
11.51 + | Const("op |", _)$ _ $ _ =>
11.52 + let
11.53 + val ((b,l),r) = Thm.dest_comb p |>> Thm.dest_comb
11.54 + val (lS,lth) = uset vars l val (rS, rth) = uset vars r
11.55 + in (lS@rS, binop_cong b lth rth) end
11.56 + | _ =>
11.57 + let
11.58 + val th = icv vars p
11.59 + val p' = Thm.rhs_of th
11.60 + val c = wi x p'
11.61 + val S = (if c mem [Lt, Le, Eq] then single o Thm.dest_arg
11.62 + else if c mem [Gt, Ge] then single o Thm.dest_arg1
11.63 + else if c = NEq then single o Thm.dest_arg o Thm.dest_arg
11.64 + else K []) p'
11.65 + in (S,th) end
11.66 +
11.67 + val ((p1_v,p2_v),(mp1_v,mp2_v)) =
11.68 + let
11.69 + fun appair f (x,y) = (f x, f y)
11.70 + in funpow 2 (Thm.dest_arg o snd o Thm.dest_abs NONE)
11.71 + (funpow 4 Thm.dest_arg (cprop_of (hd minf)))
11.72 + |> Thm.dest_binop |> appair Thm.dest_binop |> apfst (appair Thm.dest_fun)
11.73 + end
11.74 +
11.75 + fun myfwd (th1, th2, th3, th4, th5) p1 p2
11.76 + [(th_1,th_2,th_3,th_4,th_5), (th_1',th_2',th_3',th_4',th_5')] =
11.77 + let
11.78 + val (mp1, mp2) = (get_p1 th_1, get_p1 th_1')
11.79 + val (pp1, pp2) = (get_p1 th_2, get_p1 th_2')
11.80 + fun fw mi th th' th'' =
11.81 + let
11.82 + val th0 = if mi then
11.83 + instantiate ([],[(p1_v, p1),(p2_v, p2),(mp1_v, mp1), (mp2_v, mp2)]) th
11.84 + else instantiate ([],[(p1_v, p1),(p2_v, p2),(mp1_v, pp1), (mp2_v, pp2)]) th
11.85 + in implies_elim (implies_elim th0 th') th'' end
11.86 + in (fw true th1 th_1 th_1', fw false th2 th_2 th_2',
11.87 + fw true th3 th_3 th_3', fw false th4 th_4 th_4', fw true th5 th_5 th_5')
11.88 + end
11.89 + val U_v = (Thm.dest_arg o Thm.dest_arg o Thm.dest_arg1) (cprop_of qe)
11.90 + fun main vs p =
11.91 + let
11.92 + val ((xn,ce),(x,fm)) = (case term_of p of
11.93 + Const("Ex",_)$Abs(xn,xT,_) =>
11.94 + Thm.dest_comb p ||> Thm.dest_abs (SOME xn) |>> pair xn
11.95 + | _ => error "main QE only trats existential quantifiers!")
11.96 + val cT = ctyp_of_term x
11.97 + val (u,nth) = uset (x::vs) fm |>> distinct (op aconvc)
11.98 + val nthx = Thm.abstract_rule xn x nth
11.99 + val q = Thm.rhs_of nth
11.100 + val qx = Thm.rhs_of nthx
11.101 + val enth = Drule.arg_cong_rule ce nthx
11.102 + val [th0,th1] = map (instantiate' [SOME cT] []) @{thms "finite.intros"}
11.103 + fun ins x th =
11.104 + implies_elim (instantiate' [] [(SOME o Thm.dest_arg o Thm.dest_arg)
11.105 + (Thm.cprop_of th), SOME x] th1) th
11.106 + val fU = fold ins u th0
11.107 + val cU = funpow 2 Thm.dest_arg (Thm.cprop_of fU)
11.108 + local
11.109 + val insI1 = instantiate' [SOME cT] [] @{thm "insertI1"}
11.110 + val insI2 = instantiate' [SOME cT] [] @{thm "insertI2"}
11.111 + in
11.112 + fun provein x S =
11.113 + case term_of S of
11.114 + Const("{}",_) => error "provein : not a member!"
11.115 + | Const("insert",_)$y$_ =>
11.116 + let val (cy,S') = Thm.dest_binop S
11.117 + in if term_of x aconv y then instantiate' [] [SOME x, SOME S'] insI1
11.118 + else implies_elim (instantiate' [] [SOME x, SOME S', SOME cy] insI2)
11.119 + (provein x S')
11.120 + end
11.121 + end
11.122 + val tabU = fold (fn t => fn tab => Termtab.update (term_of t, provein t cU) tab)
11.123 + u Termtab.empty
11.124 + val U = valOf o Termtab.lookup tabU o term_of
11.125 + val [minf_conj, minf_disj, minf_eq, minf_neq, minf_lt,
11.126 + minf_le, minf_gt, minf_ge, minf_P] = minf
11.127 + val [pinf_conj, pinf_disj, pinf_eq, pinf_neq, pinf_lt,
11.128 + pinf_le, pinf_gt, pinf_ge, pinf_P] = pinf
11.129 + val [nmi_conj, nmi_disj, nmi_eq, nmi_neq, nmi_lt,
11.130 + nmi_le, nmi_gt, nmi_ge, nmi_P] = map (instantiate ([],[(U_v,cU)])) nmi
11.131 + val [npi_conj, npi_disj, npi_eq, npi_neq, npi_lt,
11.132 + npi_le, npi_gt, npi_ge, npi_P] = map (instantiate ([],[(U_v,cU)])) npi
11.133 + val [ld_conj, ld_disj, ld_eq, ld_neq, ld_lt,
11.134 + ld_le, ld_gt, ld_ge, ld_P] = map (instantiate ([],[(U_v,cU)])) ld
11.135 +
11.136 + fun decomp_mpinf fm =
11.137 + case term_of fm of
11.138 + Const("op &",_)$_$_ =>
11.139 + let val (p,q) = Thm.dest_binop fm
11.140 + in ([p,q], myfwd (minf_conj,pinf_conj, nmi_conj, npi_conj,ld_conj)
11.141 + (Thm.cabs x p) (Thm.cabs x q))
11.142 + end
11.143 + | Const("op |",_)$_$_ =>
11.144 + let val (p,q) = Thm.dest_binop fm
11.145 + in ([p,q],myfwd (minf_disj, pinf_disj, nmi_disj, npi_disj,ld_disj)
11.146 + (Thm.cabs x p) (Thm.cabs x q))
11.147 + end
11.148 + | _ =>
11.149 + (let val c = wi x fm
11.150 + val t = (if c=Nox then I
11.151 + else if c mem [Lt, Le, Eq] then Thm.dest_arg
11.152 + else if c mem [Gt,Ge] then Thm.dest_arg1
11.153 + else if c = NEq then (Thm.dest_arg o Thm.dest_arg)
11.154 + else error "decomp_mpinf: Impossible case!!") fm
11.155 + val [mi_th, pi_th, nmi_th, npi_th, ld_th] =
11.156 + if c = Nox then map (instantiate' [] [SOME fm])
11.157 + [minf_P, pinf_P, nmi_P, npi_P, ld_P]
11.158 + else
11.159 + let val [mi_th,pi_th,nmi_th,npi_th,ld_th] =
11.160 + map (instantiate' [] [SOME t])
11.161 + (case c of Lt => [minf_lt, pinf_lt, nmi_lt, npi_lt, ld_lt]
11.162 + | Le => [minf_le, pinf_le, nmi_le, npi_le, ld_le]
11.163 + | Gt => [minf_gt, pinf_gt, nmi_gt, npi_gt, ld_gt]
11.164 + | Ge => [minf_ge, pinf_ge, nmi_ge, npi_ge, ld_ge]
11.165 + | Eq => [minf_eq, pinf_eq, nmi_eq, npi_eq, ld_eq]
11.166 + | NEq => [minf_neq, pinf_neq, nmi_neq, npi_neq, ld_neq])
11.167 + val tU = U t
11.168 + fun Ufw th = implies_elim th tU
11.169 + in [mi_th, pi_th, Ufw nmi_th, Ufw npi_th, Ufw ld_th]
11.170 + end
11.171 + in ([], K (mi_th, pi_th, nmi_th, npi_th, ld_th)) end)
11.172 + val (minf_th, pinf_th, nmi_th, npi_th, ld_th) = divide_and_conquer decomp_mpinf q
11.173 + val qe_th = fold (C implies_elim) [fU, ld_th, nmi_th, npi_th, minf_th, pinf_th]
11.174 + ((fconv_rule (Thm.beta_conversion true))
11.175 + (instantiate' [] (map SOME [cU, qx, get_p1 minf_th, get_p1 pinf_th])
11.176 + qe))
11.177 + val bex_conv =
11.178 + Simplifier.rewrite (HOL_basic_ss addsimps simp_thms@(@{thms "bex_simps" (1-5)}))
11.179 + val result_th = fconv_rule (arg_conv bex_conv) (transitive enth qe_th)
11.180 + in result_th
11.181 + end
11.182 +
11.183 +in main
11.184 +end;
11.185 +
11.186 +val grab_atom_bop =
11.187 + let
11.188 + fun h bounds tm =
11.189 + (case term_of tm of
11.190 + Const ("op =", T) $ _ $ _ =>
11.191 + if domain_type T = HOLogic.boolT then find_args bounds tm
11.192 + else Thm.dest_fun2 tm
11.193 + | Const ("Not", _) $ _ => h bounds (Thm.dest_arg tm)
11.194 + | Const ("All", _) $ _ => find_body bounds (Thm.dest_arg tm)
11.195 + | Const ("Ex", _) $ _ => find_body bounds (Thm.dest_arg tm)
11.196 + | Const ("op &", _) $ _ $ _ => find_args bounds tm
11.197 + | Const ("op |", _) $ _ $ _ => find_args bounds tm
11.198 + | Const ("op -->", _) $ _ $ _ => find_args bounds tm
11.199 + | Const ("==>", _) $ _ $ _ => find_args bounds tm
11.200 + | Const ("==", _) $ _ $ _ => find_args bounds tm
11.201 + | Const ("Trueprop", _) $ _ => h bounds (Thm.dest_arg tm)
11.202 + | _ => Thm.dest_fun2 tm)
11.203 + and find_args bounds tm =
11.204 + (h bounds (Thm.dest_arg tm) handle CTERM _ => Thm.dest_arg1 tm)
11.205 + and find_body bounds b =
11.206 + let val (_, b') = Thm.dest_abs (SOME (Name.bound bounds)) b
11.207 + in h (bounds + 1) b' end;
11.208 +in h end;
11.209 +
11.210 +local
11.211 +fun cterm_frees ct =
11.212 + let fun h acc t =
11.213 + case (term_of t) of
11.214 + _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
11.215 + | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
11.216 + | Free _ => insert (op aconvc) t acc
11.217 + | _ => acc
11.218 + in h [] ct end;
11.219 +in
11.220 +
11.221 +fun raw_ferrack_qe_conv ctxt (thy, {isolate_conv, whatis, simpset}) tm =
11.222 + let
11.223 + val ss = simpset
11.224 + val pcv = Simplifier.rewrite
11.225 + (merge_ss (HOL_basic_ss addsimps (simp_thms @ ex_simps @ all_simps)
11.226 + @ [not_all,@{thm "all_not_ex"}, ex_disj_distrib], ss))
11.227 + val postcv = Simplifier.rewrite ss
11.228 + val nnf = K (nnf_conv then_conv postcv)
11.229 + val qe_conv = Qelim.gen_qelim_conv ctxt pcv postcv pcv cons (cterm_frees tm)
11.230 + (isolate_conv ctxt) nnf
11.231 + (fn vs => ferrack_conv (thy,{isolate_conv = isolate_conv ctxt,
11.232 + whatis = whatis, simpset = simpset}) vs
11.233 + then_conv postcv)
11.234 + in (Simplifier.rewrite ss then_conv qe_conv) tm
11.235 + end
11.236 +
11.237 +fun ferrackqe_conv ctxt tm =
11.238 + case Ferrante_Rackoff_Data.match ctxt (grab_atom_bop 0 tm) of
11.239 + NONE => error "ferrackqe_conv : no corresponding instance in context!"
11.240 +| SOME res => raw_ferrack_qe_conv ctxt res tm
11.241 +end;
11.242 +
11.243 +fun core_ferrack_tac ctxt res i st =
11.244 + let val p = nth (cprems_of st) (i - 1)
11.245 + val th = symmetric (arg_conv (raw_ferrack_qe_conv ctxt res) p)
11.246 + val p' = Thm.lhs_of th
11.247 + val th' = implies_intr p' (equal_elim th (assume p'))
11.248 + val _ = print_thm th
11.249 + in (rtac th' i) st
11.250 + end
11.251 +
11.252 +fun dlo_tac ctxt i st =
11.253 + let
11.254 + val instance = (case Ferrante_Rackoff_Data.match ctxt
11.255 + (grab_atom_bop 0 (nth (cprems_of st) (i - 1))) of
11.256 + NONE => error "ferrackqe_conv : no corresponding instance in context!"
11.257 + | SOME r => r)
11.258 + val ss = #simpset (snd instance)
11.259 + in
11.260 + (ObjectLogic.full_atomize_tac i THEN
11.261 + simp_tac ss i THEN
11.262 + core_ferrack_tac ctxt instance i THEN
11.263 + (TRY (simp_tac (Simplifier.local_simpset_of ctxt) i))) st
11.264 + end;
11.265 +
11.266 +end;
12.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
12.2 +++ b/src/HOL/Tools/Qelim/ferrante_rackoff_data.ML Thu Jun 21 20:48:48 2007 +0200
12.3 @@ -0,0 +1,149 @@
12.4 +(* Title: HOL/Tools/ferrante_rackoff_data.ML
12.5 + ID: $Id$
12.6 + Author: Amine Chaieb, TU Muenchen
12.7 +
12.8 +Context data for Ferrante and Rackoff's algorithm for quantifier
12.9 +elimination in dense linear orders.
12.10 +*)
12.11 +
12.12 +signature FERRANTE_RACKOF_DATA =
12.13 +sig
12.14 + datatype ord = Lt | Le | Gt | Ge | Eq | NEq | Nox
12.15 + type entry
12.16 + val get: Proof.context -> (thm * entry) list
12.17 + val del: attribute
12.18 + val add: entry -> attribute
12.19 + val funs: thm ->
12.20 + {isolate_conv: morphism -> Proof.context -> cterm list -> cterm -> thm,
12.21 + whatis: morphism -> cterm -> cterm -> ord,
12.22 + simpset: morphism -> simpset}
12.23 + -> morphism -> Context.generic -> Context.generic
12.24 + val match: Proof.context -> cterm -> entry option
12.25 + val setup: theory -> theory
12.26 +end;
12.27 +
12.28 +structure Ferrante_Rackoff_Data: FERRANTE_RACKOF_DATA =
12.29 +struct
12.30 +
12.31 +(* data *)
12.32 +
12.33 +datatype ord = Lt | Le | Gt | Ge | Eq | NEq | Nox
12.34 +
12.35 +type entry =
12.36 + {minf: thm list, pinf: thm list, nmi: thm list, npi: thm list,
12.37 + ld: thm list, qe: thm, atoms : cterm list} *
12.38 + {isolate_conv: Proof.context -> cterm list -> cterm -> thm,
12.39 + whatis : cterm -> cterm -> ord,
12.40 + simpset : simpset};
12.41 +
12.42 +val eq_key = Thm.eq_thm;
12.43 +fun eq_data arg = eq_fst eq_key arg;
12.44 +
12.45 +structure Data = GenericDataFun
12.46 +(
12.47 + type T = (thm * entry) list;
12.48 + val empty = [];
12.49 + val extend = I;
12.50 + fun merge _ = AList.merge eq_key (K true);
12.51 +);
12.52 +
12.53 +val get = Data.get o Context.Proof;
12.54 +
12.55 +fun del_data key = remove eq_data (key, []);
12.56 +
12.57 +val del = Thm.declaration_attribute (Data.map o del_data);
12.58 +
12.59 +fun undefined x = error "undefined";
12.60 +
12.61 +fun add entry =
12.62 + Thm.declaration_attribute (fn key => fn context => context |> Data.map
12.63 + (del_data key #> cons (key, entry)));
12.64 +
12.65 +
12.66 +(* extra-logical functions *)
12.67 +
12.68 +fun funs raw_key {isolate_conv = icv, whatis = wi, simpset = ss} phi = Data.map (fn data =>
12.69 + let
12.70 + val key = Morphism.thm phi raw_key;
12.71 + val _ = AList.defined eq_key data key orelse
12.72 + raise THM ("No data entry for structure key", 0, [key]);
12.73 + val fns = {isolate_conv = icv phi, whatis = wi phi, simpset = ss phi};
12.74 + in AList.map_entry eq_key key (apsnd (K fns)) data end);
12.75 +
12.76 +fun match ctxt tm =
12.77 + let
12.78 + fun match_inst
12.79 + ({minf, pinf, nmi, npi, ld, qe, atoms},
12.80 + fns as {isolate_conv, whatis, simpset}) pat =
12.81 + let
12.82 + fun h instT =
12.83 + let
12.84 + val substT = Thm.instantiate (instT, []);
12.85 + val substT_cterm = Drule.cterm_rule substT;
12.86 +
12.87 + val minf' = map substT minf
12.88 + val pinf' = map substT pinf
12.89 + val nmi' = map substT nmi
12.90 + val npi' = map substT npi
12.91 + val ld' = map substT ld
12.92 + val qe' = substT qe
12.93 + val atoms' = map substT_cterm atoms
12.94 + val result = ({minf = minf', pinf = pinf', nmi = nmi', npi = npi',
12.95 + ld = ld', qe = qe', atoms = atoms'}, fns)
12.96 + in SOME result end
12.97 + in (case try Thm.match (pat, tm) of
12.98 + NONE => NONE
12.99 + | SOME (instT, _) => h instT)
12.100 + end;
12.101 +
12.102 + fun match_struct (_,
12.103 + entry as ({atoms = atoms, ...}, _): entry) =
12.104 + get_first (match_inst entry) atoms;
12.105 + in get_first match_struct (get ctxt) end;
12.106 +
12.107 +
12.108 +(* concrete syntax *)
12.109 +
12.110 +local
12.111 +val minfN = "minf";
12.112 +val pinfN = "pinf";
12.113 +val nmiN = "nmi";
12.114 +val npiN = "npi";
12.115 +val lin_denseN = "lindense";
12.116 +val qeN = "qe"
12.117 +val atomsN = "atoms"
12.118 +val simpsN = "simps"
12.119 +fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ();
12.120 +val any_keyword =
12.121 + keyword minfN || keyword pinfN || keyword nmiN
12.122 +|| keyword npiN || keyword lin_denseN || keyword qeN
12.123 +|| keyword atomsN || keyword simpsN;
12.124 +
12.125 +val thms = Scan.repeat (Scan.unless any_keyword Attrib.multi_thm) >> flat;
12.126 +val terms = thms >> map Drule.dest_term;
12.127 +in
12.128 +
12.129 +fun att_syntax src = src |> Attrib.syntax
12.130 + ((keyword minfN |-- thms)
12.131 + -- (keyword pinfN |-- thms)
12.132 + -- (keyword nmiN |-- thms)
12.133 + -- (keyword npiN |-- thms)
12.134 + -- (keyword lin_denseN |-- thms)
12.135 + -- (keyword qeN |-- thms)
12.136 + -- (keyword atomsN |-- terms) >>
12.137 + (fn ((((((minf,pinf),nmi),npi),lin_dense),qe), atoms)=>
12.138 + if length qe = 1 then
12.139 + add ({minf = minf, pinf = pinf, nmi = nmi, npi = npi, ld = lin_dense,
12.140 + qe = hd qe, atoms = atoms},
12.141 + {isolate_conv = undefined, whatis = undefined, simpset = HOL_ss})
12.142 + else error "only one theorem for qe!"))
12.143 +
12.144 +end;
12.145 +
12.146 +
12.147 +(* theory setup *)
12.148 +
12.149 +val setup =
12.150 + Attrib.add_attributes [("dlo", att_syntax, "Ferrante Rackoff data")];
12.151 +
12.152 +end;
13.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
13.2 +++ b/src/HOL/Tools/Qelim/generated_cooper.ML Thu Jun 21 20:48:48 2007 +0200
13.3 @@ -0,0 +1,1693 @@
13.4 +structure GeneratedCooper =
13.5 +struct
13.6 +nonfix oo;
13.7 +fun nat i = if i < 0 then 0 else i;
13.8 +
13.9 +val one_def0 : int = (0 + 1);
13.10 +
13.11 +datatype num = C of int | Bound of int | CX of int * num | Neg of num
13.12 + | Add of num * num | Sub of num * num | Mul of int * num;
13.13 +
13.14 +fun snd (a, b) = b;
13.15 +
13.16 +fun negateSnd x = (fn (q, r) => (q, ~ r)) x;
13.17 +
13.18 +fun minus_def2 z w = (z + ~ w);
13.19 +
13.20 +fun adjust b =
13.21 + (fn (q, r) =>
13.22 + (if (0 <= minus_def2 r b) then (((2 * q) + 1), minus_def2 r b)
13.23 + else ((2 * q), r)));
13.24 +
13.25 +fun negDivAlg a b =
13.26 + (if ((0 <= (a + b)) orelse (b <= 0)) then (~1, (a + b))
13.27 + else adjust b (negDivAlg a (2 * b)));
13.28 +
13.29 +fun posDivAlg a b =
13.30 + (if ((a < b) orelse (b <= 0)) then (0, a)
13.31 + else adjust b (posDivAlg a (2 * b)));
13.32 +
13.33 +fun divAlg x =
13.34 + (fn (a, b) =>
13.35 + (if (0 <= a)
13.36 + then (if (0 <= b) then posDivAlg a b
13.37 + else (if (a = 0) then (0, 0)
13.38 + else negateSnd (negDivAlg (~ a) (~ b))))
13.39 + else (if (0 < b) then negDivAlg a b
13.40 + else negateSnd (posDivAlg (~ a) (~ b)))))
13.41 + x;
13.42 +
13.43 +fun mod_def1 a b = snd (divAlg (a, b));
13.44 +
13.45 +fun dvd m n = (mod_def1 n m = 0);
13.46 +
13.47 +fun abs i = (if (i < 0) then ~ i else i);
13.48 +
13.49 +fun less_def3 m n = ((m) < (n));
13.50 +
13.51 +fun less_eq_def3 m n = Bool.not (less_def3 n m);
13.52 +
13.53 +fun numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (c2, Bound n2), r2)) =
13.54 + (if (n1 = n2)
13.55 + then let val c = (c1 + c2)
13.56 + in (if (c = 0) then numadd (r1, r2)
13.57 + else Add (Mul (c, Bound n1), numadd (r1, r2)))
13.58 + end
13.59 + else (if less_eq_def3 n1 n2
13.60 + then Add (Mul (c1, Bound n1),
13.61 + numadd (r1, Add (Mul (c2, Bound n2), r2)))
13.62 + else Add (Mul (c2, Bound n2),
13.63 + numadd (Add (Mul (c1, Bound n1), r1), r2))))
13.64 + | numadd (Add (Mul (c1, Bound n1), r1), C afq) =
13.65 + Add (Mul (c1, Bound n1), numadd (r1, C afq))
13.66 + | numadd (Add (Mul (c1, Bound n1), r1), Bound afr) =
13.67 + Add (Mul (c1, Bound n1), numadd (r1, Bound afr))
13.68 + | numadd (Add (Mul (c1, Bound n1), r1), CX (afs, aft)) =
13.69 + Add (Mul (c1, Bound n1), numadd (r1, CX (afs, aft)))
13.70 + | numadd (Add (Mul (c1, Bound n1), r1), Neg afu) =
13.71 + Add (Mul (c1, Bound n1), numadd (r1, Neg afu))
13.72 + | numadd (Add (Mul (c1, Bound n1), r1), Add (C agx, afw)) =
13.73 + Add (Mul (c1, Bound n1), numadd (r1, Add (C agx, afw)))
13.74 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Bound agy, afw)) =
13.75 + Add (Mul (c1, Bound n1), numadd (r1, Add (Bound agy, afw)))
13.76 + | numadd (Add (Mul (c1, Bound n1), r1), Add (CX (agz, aha), afw)) =
13.77 + Add (Mul (c1, Bound n1), numadd (r1, Add (CX (agz, aha), afw)))
13.78 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Neg ahb, afw)) =
13.79 + Add (Mul (c1, Bound n1), numadd (r1, Add (Neg ahb, afw)))
13.80 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Add (ahc, ahd), afw)) =
13.81 + Add (Mul (c1, Bound n1), numadd (r1, Add (Add (ahc, ahd), afw)))
13.82 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Sub (ahe, ahf), afw)) =
13.83 + Add (Mul (c1, Bound n1), numadd (r1, Add (Sub (ahe, ahf), afw)))
13.84 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, C aie), afw)) =
13.85 + Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, C aie), afw)))
13.86 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, CX (aig, aih)), afw)) =
13.87 + Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, CX (aig, aih)), afw)))
13.88 + | numadd (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Neg aii), afw)) =
13.89 + Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Neg aii), afw)))
13.90 + | numadd
13.91 + (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Add (aij, aik)), afw)) =
13.92 + Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Add (aij, aik)), afw)))
13.93 + | numadd
13.94 + (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Sub (ail, aim)), afw)) =
13.95 + Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Sub (ail, aim)), afw)))
13.96 + | numadd
13.97 + (Add (Mul (c1, Bound n1), r1), Add (Mul (ahg, Mul (ain, aio)), afw)) =
13.98 + Add (Mul (c1, Bound n1), numadd (r1, Add (Mul (ahg, Mul (ain, aio)), afw)))
13.99 + | numadd (Add (Mul (c1, Bound n1), r1), Sub (afx, afy)) =
13.100 + Add (Mul (c1, Bound n1), numadd (r1, Sub (afx, afy)))
13.101 + | numadd (Add (Mul (c1, Bound n1), r1), Mul (afz, aga)) =
13.102 + Add (Mul (c1, Bound n1), numadd (r1, Mul (afz, aga)))
13.103 + | numadd (C w, Add (Mul (c2, Bound n2), r2)) =
13.104 + Add (Mul (c2, Bound n2), numadd (C w, r2))
13.105 + | numadd (Bound x, Add (Mul (c2, Bound n2), r2)) =
13.106 + Add (Mul (c2, Bound n2), numadd (Bound x, r2))
13.107 + | numadd (CX (y, z), Add (Mul (c2, Bound n2), r2)) =
13.108 + Add (Mul (c2, Bound n2), numadd (CX (y, z), r2))
13.109 + | numadd (Neg ab, Add (Mul (c2, Bound n2), r2)) =
13.110 + Add (Mul (c2, Bound n2), numadd (Neg ab, r2))
13.111 + | numadd (Add (C li, ad), Add (Mul (c2, Bound n2), r2)) =
13.112 + Add (Mul (c2, Bound n2), numadd (Add (C li, ad), r2))
13.113 + | numadd (Add (Bound lj, ad), Add (Mul (c2, Bound n2), r2)) =
13.114 + Add (Mul (c2, Bound n2), numadd (Add (Bound lj, ad), r2))
13.115 + | numadd (Add (CX (lk, ll), ad), Add (Mul (c2, Bound n2), r2)) =
13.116 + Add (Mul (c2, Bound n2), numadd (Add (CX (lk, ll), ad), r2))
13.117 + | numadd (Add (Neg lm, ad), Add (Mul (c2, Bound n2), r2)) =
13.118 + Add (Mul (c2, Bound n2), numadd (Add (Neg lm, ad), r2))
13.119 + | numadd (Add (Add (ln, lo), ad), Add (Mul (c2, Bound n2), r2)) =
13.120 + Add (Mul (c2, Bound n2), numadd (Add (Add (ln, lo), ad), r2))
13.121 + | numadd (Add (Sub (lp, lq), ad), Add (Mul (c2, Bound n2), r2)) =
13.122 + Add (Mul (c2, Bound n2), numadd (Add (Sub (lp, lq), ad), r2))
13.123 + | numadd (Add (Mul (lr, C abv), ad), Add (Mul (c2, Bound n2), r2)) =
13.124 + Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, C abv), ad), r2))
13.125 + | numadd (Add (Mul (lr, CX (abx, aby)), ad), Add (Mul (c2, Bound n2), r2)) =
13.126 + Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, CX (abx, aby)), ad), r2))
13.127 + | numadd (Add (Mul (lr, Neg abz), ad), Add (Mul (c2, Bound n2), r2)) =
13.128 + Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Neg abz), ad), r2))
13.129 + | numadd (Add (Mul (lr, Add (aca, acb)), ad), Add (Mul (c2, Bound n2), r2)) =
13.130 + Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Add (aca, acb)), ad), r2))
13.131 + | numadd (Add (Mul (lr, Sub (acc, acd)), ad), Add (Mul (c2, Bound n2), r2)) =
13.132 + Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Sub (acc, acd)), ad), r2))
13.133 + | numadd (Add (Mul (lr, Mul (ace, acf)), ad), Add (Mul (c2, Bound n2), r2)) =
13.134 + Add (Mul (c2, Bound n2), numadd (Add (Mul (lr, Mul (ace, acf)), ad), r2))
13.135 + | numadd (Sub (ae, af), Add (Mul (c2, Bound n2), r2)) =
13.136 + Add (Mul (c2, Bound n2), numadd (Sub (ae, af), r2))
13.137 + | numadd (Mul (ag, ah), Add (Mul (c2, Bound n2), r2)) =
13.138 + Add (Mul (c2, Bound n2), numadd (Mul (ag, ah), r2))
13.139 + | numadd (C b1, C b2) = C (b1 + b2)
13.140 + | numadd (C ai, Bound bf) = Add (C ai, Bound bf)
13.141 + | numadd (C ai, CX (bg, bh)) = Add (C ai, CX (bg, bh))
13.142 + | numadd (C ai, Neg bi) = Add (C ai, Neg bi)
13.143 + | numadd (C ai, Add (C ca, bk)) = Add (C ai, Add (C ca, bk))
13.144 + | numadd (C ai, Add (Bound cb, bk)) = Add (C ai, Add (Bound cb, bk))
13.145 + | numadd (C ai, Add (CX (cc, cd), bk)) = Add (C ai, Add (CX (cc, cd), bk))
13.146 + | numadd (C ai, Add (Neg ce, bk)) = Add (C ai, Add (Neg ce, bk))
13.147 + | numadd (C ai, Add (Add (cf, cg), bk)) = Add (C ai, Add (Add (cf, cg), bk))
13.148 + | numadd (C ai, Add (Sub (ch, ci), bk)) = Add (C ai, Add (Sub (ch, ci), bk))
13.149 + | numadd (C ai, Add (Mul (cj, C cw), bk)) =
13.150 + Add (C ai, Add (Mul (cj, C cw), bk))
13.151 + | numadd (C ai, Add (Mul (cj, CX (cy, cz)), bk)) =
13.152 + Add (C ai, Add (Mul (cj, CX (cy, cz)), bk))
13.153 + | numadd (C ai, Add (Mul (cj, Neg da), bk)) =
13.154 + Add (C ai, Add (Mul (cj, Neg da), bk))
13.155 + | numadd (C ai, Add (Mul (cj, Add (db, dc)), bk)) =
13.156 + Add (C ai, Add (Mul (cj, Add (db, dc)), bk))
13.157 + | numadd (C ai, Add (Mul (cj, Sub (dd, de)), bk)) =
13.158 + Add (C ai, Add (Mul (cj, Sub (dd, de)), bk))
13.159 + | numadd (C ai, Add (Mul (cj, Mul (df, dg)), bk)) =
13.160 + Add (C ai, Add (Mul (cj, Mul (df, dg)), bk))
13.161 + | numadd (C ai, Sub (bl, bm)) = Add (C ai, Sub (bl, bm))
13.162 + | numadd (C ai, Mul (bn, bo)) = Add (C ai, Mul (bn, bo))
13.163 + | numadd (Bound aj, C ds) = Add (Bound aj, C ds)
13.164 + | numadd (Bound aj, Bound dt) = Add (Bound aj, Bound dt)
13.165 + | numadd (Bound aj, CX (du, dv)) = Add (Bound aj, CX (du, dv))
13.166 + | numadd (Bound aj, Neg dw) = Add (Bound aj, Neg dw)
13.167 + | numadd (Bound aj, Add (C eo, dy)) = Add (Bound aj, Add (C eo, dy))
13.168 + | numadd (Bound aj, Add (Bound ep, dy)) = Add (Bound aj, Add (Bound ep, dy))
13.169 + | numadd (Bound aj, Add (CX (eq, er), dy)) =
13.170 + Add (Bound aj, Add (CX (eq, er), dy))
13.171 + | numadd (Bound aj, Add (Neg es, dy)) = Add (Bound aj, Add (Neg es, dy))
13.172 + | numadd (Bound aj, Add (Add (et, eu), dy)) =
13.173 + Add (Bound aj, Add (Add (et, eu), dy))
13.174 + | numadd (Bound aj, Add (Sub (ev, ew), dy)) =
13.175 + Add (Bound aj, Add (Sub (ev, ew), dy))
13.176 + | numadd (Bound aj, Add (Mul (ex, C fk), dy)) =
13.177 + Add (Bound aj, Add (Mul (ex, C fk), dy))
13.178 + | numadd (Bound aj, Add (Mul (ex, CX (fm, fn')), dy)) =
13.179 + Add (Bound aj, Add (Mul (ex, CX (fm, fn')), dy))
13.180 + | numadd (Bound aj, Add (Mul (ex, Neg fo), dy)) =
13.181 + Add (Bound aj, Add (Mul (ex, Neg fo), dy))
13.182 + | numadd (Bound aj, Add (Mul (ex, Add (fp, fq)), dy)) =
13.183 + Add (Bound aj, Add (Mul (ex, Add (fp, fq)), dy))
13.184 + | numadd (Bound aj, Add (Mul (ex, Sub (fr, fs)), dy)) =
13.185 + Add (Bound aj, Add (Mul (ex, Sub (fr, fs)), dy))
13.186 + | numadd (Bound aj, Add (Mul (ex, Mul (ft, fu)), dy)) =
13.187 + Add (Bound aj, Add (Mul (ex, Mul (ft, fu)), dy))
13.188 + | numadd (Bound aj, Sub (dz, ea)) = Add (Bound aj, Sub (dz, ea))
13.189 + | numadd (Bound aj, Mul (eb, ec)) = Add (Bound aj, Mul (eb, ec))
13.190 + | numadd (CX (ak, al), C gg) = Add (CX (ak, al), C gg)
13.191 + | numadd (CX (ak, al), Bound gh) = Add (CX (ak, al), Bound gh)
13.192 + | numadd (CX (ak, al), CX (gi, gj)) = Add (CX (ak, al), CX (gi, gj))
13.193 + | numadd (CX (ak, al), Neg gk) = Add (CX (ak, al), Neg gk)
13.194 + | numadd (CX (ak, al), Add (C hc, gm)) = Add (CX (ak, al), Add (C hc, gm))
13.195 + | numadd (CX (ak, al), Add (Bound hd, gm)) =
13.196 + Add (CX (ak, al), Add (Bound hd, gm))
13.197 + | numadd (CX (ak, al), Add (CX (he, hf), gm)) =
13.198 + Add (CX (ak, al), Add (CX (he, hf), gm))
13.199 + | numadd (CX (ak, al), Add (Neg hg, gm)) = Add (CX (ak, al), Add (Neg hg, gm))
13.200 + | numadd (CX (ak, al), Add (Add (hh, hi), gm)) =
13.201 + Add (CX (ak, al), Add (Add (hh, hi), gm))
13.202 + | numadd (CX (ak, al), Add (Sub (hj, hk), gm)) =
13.203 + Add (CX (ak, al), Add (Sub (hj, hk), gm))
13.204 + | numadd (CX (ak, al), Add (Mul (hl, C hy), gm)) =
13.205 + Add (CX (ak, al), Add (Mul (hl, C hy), gm))
13.206 + | numadd (CX (ak, al), Add (Mul (hl, CX (ia, ib)), gm)) =
13.207 + Add (CX (ak, al), Add (Mul (hl, CX (ia, ib)), gm))
13.208 + | numadd (CX (ak, al), Add (Mul (hl, Neg ic), gm)) =
13.209 + Add (CX (ak, al), Add (Mul (hl, Neg ic), gm))
13.210 + | numadd (CX (ak, al), Add (Mul (hl, Add (id, ie)), gm)) =
13.211 + Add (CX (ak, al), Add (Mul (hl, Add (id, ie)), gm))
13.212 + | numadd (CX (ak, al), Add (Mul (hl, Sub (if', ig)), gm)) =
13.213 + Add (CX (ak, al), Add (Mul (hl, Sub (if', ig)), gm))
13.214 + | numadd (CX (ak, al), Add (Mul (hl, Mul (ih, ii)), gm)) =
13.215 + Add (CX (ak, al), Add (Mul (hl, Mul (ih, ii)), gm))
13.216 + | numadd (CX (ak, al), Sub (gn, go)) = Add (CX (ak, al), Sub (gn, go))
13.217 + | numadd (CX (ak, al), Mul (gp, gq)) = Add (CX (ak, al), Mul (gp, gq))
13.218 + | numadd (Neg am, C iu) = Add (Neg am, C iu)
13.219 + | numadd (Neg am, Bound iv) = Add (Neg am, Bound iv)
13.220 + | numadd (Neg am, CX (iw, ix)) = Add (Neg am, CX (iw, ix))
13.221 + | numadd (Neg am, Neg iy) = Add (Neg am, Neg iy)
13.222 + | numadd (Neg am, Add (C jq, ja)) = Add (Neg am, Add (C jq, ja))
13.223 + | numadd (Neg am, Add (Bound jr, ja)) = Add (Neg am, Add (Bound jr, ja))
13.224 + | numadd (Neg am, Add (CX (js, jt), ja)) = Add (Neg am, Add (CX (js, jt), ja))
13.225 + | numadd (Neg am, Add (Neg ju, ja)) = Add (Neg am, Add (Neg ju, ja))
13.226 + | numadd (Neg am, Add (Add (jv, jw), ja)) =
13.227 + Add (Neg am, Add (Add (jv, jw), ja))
13.228 + | numadd (Neg am, Add (Sub (jx, jy), ja)) =
13.229 + Add (Neg am, Add (Sub (jx, jy), ja))
13.230 + | numadd (Neg am, Add (Mul (jz, C km), ja)) =
13.231 + Add (Neg am, Add (Mul (jz, C km), ja))
13.232 + | numadd (Neg am, Add (Mul (jz, CX (ko, kp)), ja)) =
13.233 + Add (Neg am, Add (Mul (jz, CX (ko, kp)), ja))
13.234 + | numadd (Neg am, Add (Mul (jz, Neg kq), ja)) =
13.235 + Add (Neg am, Add (Mul (jz, Neg kq), ja))
13.236 + | numadd (Neg am, Add (Mul (jz, Add (kr, ks)), ja)) =
13.237 + Add (Neg am, Add (Mul (jz, Add (kr, ks)), ja))
13.238 + | numadd (Neg am, Add (Mul (jz, Sub (kt, ku)), ja)) =
13.239 + Add (Neg am, Add (Mul (jz, Sub (kt, ku)), ja))
13.240 + | numadd (Neg am, Add (Mul (jz, Mul (kv, kw)), ja)) =
13.241 + Add (Neg am, Add (Mul (jz, Mul (kv, kw)), ja))
13.242 + | numadd (Neg am, Sub (jb, jc)) = Add (Neg am, Sub (jb, jc))
13.243 + | numadd (Neg am, Mul (jd, je)) = Add (Neg am, Mul (jd, je))
13.244 + | numadd (Add (C lt, ao), C mp) = Add (Add (C lt, ao), C mp)
13.245 + | numadd (Add (C lt, ao), Bound mq) = Add (Add (C lt, ao), Bound mq)
13.246 + | numadd (Add (C lt, ao), CX (mr, ms)) = Add (Add (C lt, ao), CX (mr, ms))
13.247 + | numadd (Add (C lt, ao), Neg mt) = Add (Add (C lt, ao), Neg mt)
13.248 + | numadd (Add (C lt, ao), Add (C nl, mv)) =
13.249 + Add (Add (C lt, ao), Add (C nl, mv))
13.250 + | numadd (Add (C lt, ao), Add (Bound nm, mv)) =
13.251 + Add (Add (C lt, ao), Add (Bound nm, mv))
13.252 + | numadd (Add (C lt, ao), Add (CX (nn, no), mv)) =
13.253 + Add (Add (C lt, ao), Add (CX (nn, no), mv))
13.254 + | numadd (Add (C lt, ao), Add (Neg np, mv)) =
13.255 + Add (Add (C lt, ao), Add (Neg np, mv))
13.256 + | numadd (Add (C lt, ao), Add (Add (nq, nr), mv)) =
13.257 + Add (Add (C lt, ao), Add (Add (nq, nr), mv))
13.258 + | numadd (Add (C lt, ao), Add (Sub (ns, nt), mv)) =
13.259 + Add (Add (C lt, ao), Add (Sub (ns, nt), mv))
13.260 + | numadd (Add (C lt, ao), Add (Mul (nu, C oh), mv)) =
13.261 + Add (Add (C lt, ao), Add (Mul (nu, C oh), mv))
13.262 + | numadd (Add (C lt, ao), Add (Mul (nu, CX (oj, ok)), mv)) =
13.263 + Add (Add (C lt, ao), Add (Mul (nu, CX (oj, ok)), mv))
13.264 + | numadd (Add (C lt, ao), Add (Mul (nu, Neg ol), mv)) =
13.265 + Add (Add (C lt, ao), Add (Mul (nu, Neg ol), mv))
13.266 + | numadd (Add (C lt, ao), Add (Mul (nu, Add (om, on)), mv)) =
13.267 + Add (Add (C lt, ao), Add (Mul (nu, Add (om, on)), mv))
13.268 + | numadd (Add (C lt, ao), Add (Mul (nu, Sub (oo, op')), mv)) =
13.269 + Add (Add (C lt, ao), Add (Mul (nu, Sub (oo, op')), mv))
13.270 + | numadd (Add (C lt, ao), Add (Mul (nu, Mul (oq, or)), mv)) =
13.271 + Add (Add (C lt, ao), Add (Mul (nu, Mul (oq, or)), mv))
13.272 + | numadd (Add (C lt, ao), Sub (mw, mx)) = Add (Add (C lt, ao), Sub (mw, mx))
13.273 + | numadd (Add (C lt, ao), Mul (my, mz)) = Add (Add (C lt, ao), Mul (my, mz))
13.274 + | numadd (Add (Bound lu, ao), C pd) = Add (Add (Bound lu, ao), C pd)
13.275 + | numadd (Add (Bound lu, ao), Bound pe) = Add (Add (Bound lu, ao), Bound pe)
13.276 + | numadd (Add (Bound lu, ao), CX (pf, pg)) =
13.277 + Add (Add (Bound lu, ao), CX (pf, pg))
13.278 + | numadd (Add (Bound lu, ao), Neg ph) = Add (Add (Bound lu, ao), Neg ph)
13.279 + | numadd (Add (Bound lu, ao), Add (C pz, pj)) =
13.280 + Add (Add (Bound lu, ao), Add (C pz, pj))
13.281 + | numadd (Add (Bound lu, ao), Add (Bound qa, pj)) =
13.282 + Add (Add (Bound lu, ao), Add (Bound qa, pj))
13.283 + | numadd (Add (Bound lu, ao), Add (CX (qb, qc), pj)) =
13.284 + Add (Add (Bound lu, ao), Add (CX (qb, qc), pj))
13.285 + | numadd (Add (Bound lu, ao), Add (Neg qd, pj)) =
13.286 + Add (Add (Bound lu, ao), Add (Neg qd, pj))
13.287 + | numadd (Add (Bound lu, ao), Add (Add (qe, qf), pj)) =
13.288 + Add (Add (Bound lu, ao), Add (Add (qe, qf), pj))
13.289 + | numadd (Add (Bound lu, ao), Add (Sub (qg, qh), pj)) =
13.290 + Add (Add (Bound lu, ao), Add (Sub (qg, qh), pj))
13.291 + | numadd (Add (Bound lu, ao), Add (Mul (qi, C qv), pj)) =
13.292 + Add (Add (Bound lu, ao), Add (Mul (qi, C qv), pj))
13.293 + | numadd (Add (Bound lu, ao), Add (Mul (qi, CX (qx, qy)), pj)) =
13.294 + Add (Add (Bound lu, ao), Add (Mul (qi, CX (qx, qy)), pj))
13.295 + | numadd (Add (Bound lu, ao), Add (Mul (qi, Neg qz), pj)) =
13.296 + Add (Add (Bound lu, ao), Add (Mul (qi, Neg qz), pj))
13.297 + | numadd (Add (Bound lu, ao), Add (Mul (qi, Add (ra, rb)), pj)) =
13.298 + Add (Add (Bound lu, ao), Add (Mul (qi, Add (ra, rb)), pj))
13.299 + | numadd (Add (Bound lu, ao), Add (Mul (qi, Sub (rc, rd)), pj)) =
13.300 + Add (Add (Bound lu, ao), Add (Mul (qi, Sub (rc, rd)), pj))
13.301 + | numadd (Add (Bound lu, ao), Add (Mul (qi, Mul (re, rf)), pj)) =
13.302 + Add (Add (Bound lu, ao), Add (Mul (qi, Mul (re, rf)), pj))
13.303 + | numadd (Add (Bound lu, ao), Sub (pk, pl)) =
13.304 + Add (Add (Bound lu, ao), Sub (pk, pl))
13.305 + | numadd (Add (Bound lu, ao), Mul (pm, pn)) =
13.306 + Add (Add (Bound lu, ao), Mul (pm, pn))
13.307 + | numadd (Add (CX (lv, lw), ao), C rr) = Add (Add (CX (lv, lw), ao), C rr)
13.308 + | numadd (Add (CX (lv, lw), ao), Bound rs) =
13.309 + Add (Add (CX (lv, lw), ao), Bound rs)
13.310 + | numadd (Add (CX (lv, lw), ao), CX (rt, ru)) =
13.311 + Add (Add (CX (lv, lw), ao), CX (rt, ru))
13.312 + | numadd (Add (CX (lv, lw), ao), Neg rv) = Add (Add (CX (lv, lw), ao), Neg rv)
13.313 + | numadd (Add (CX (lv, lw), ao), Add (C sn, rx)) =
13.314 + Add (Add (CX (lv, lw), ao), Add (C sn, rx))
13.315 + | numadd (Add (CX (lv, lw), ao), Add (Bound so, rx)) =
13.316 + Add (Add (CX (lv, lw), ao), Add (Bound so, rx))
13.317 + | numadd (Add (CX (lv, lw), ao), Add (CX (sp, sq), rx)) =
13.318 + Add (Add (CX (lv, lw), ao), Add (CX (sp, sq), rx))
13.319 + | numadd (Add (CX (lv, lw), ao), Add (Neg sr, rx)) =
13.320 + Add (Add (CX (lv, lw), ao), Add (Neg sr, rx))
13.321 + | numadd (Add (CX (lv, lw), ao), Add (Add (ss, st), rx)) =
13.322 + Add (Add (CX (lv, lw), ao), Add (Add (ss, st), rx))
13.323 + | numadd (Add (CX (lv, lw), ao), Add (Sub (su, sv), rx)) =
13.324 + Add (Add (CX (lv, lw), ao), Add (Sub (su, sv), rx))
13.325 + | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, C tj), rx)) =
13.326 + Add (Add (CX (lv, lw), ao), Add (Mul (sw, C tj), rx))
13.327 + | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, CX (tl, tm)), rx)) =
13.328 + Add (Add (CX (lv, lw), ao), Add (Mul (sw, CX (tl, tm)), rx))
13.329 + | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Neg tn), rx)) =
13.330 + Add (Add (CX (lv, lw), ao), Add (Mul (sw, Neg tn), rx))
13.331 + | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Add (to, tp)), rx)) =
13.332 + Add (Add (CX (lv, lw), ao), Add (Mul (sw, Add (to, tp)), rx))
13.333 + | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Sub (tq, tr)), rx)) =
13.334 + Add (Add (CX (lv, lw), ao), Add (Mul (sw, Sub (tq, tr)), rx))
13.335 + | numadd (Add (CX (lv, lw), ao), Add (Mul (sw, Mul (ts, tt)), rx)) =
13.336 + Add (Add (CX (lv, lw), ao), Add (Mul (sw, Mul (ts, tt)), rx))
13.337 + | numadd (Add (CX (lv, lw), ao), Sub (ry, rz)) =
13.338 + Add (Add (CX (lv, lw), ao), Sub (ry, rz))
13.339 + | numadd (Add (CX (lv, lw), ao), Mul (sa, sb)) =
13.340 + Add (Add (CX (lv, lw), ao), Mul (sa, sb))
13.341 + | numadd (Add (Neg lx, ao), C uf) = Add (Add (Neg lx, ao), C uf)
13.342 + | numadd (Add (Neg lx, ao), Bound ug) = Add (Add (Neg lx, ao), Bound ug)
13.343 + | numadd (Add (Neg lx, ao), CX (uh, ui)) = Add (Add (Neg lx, ao), CX (uh, ui))
13.344 + | numadd (Add (Neg lx, ao), Neg uj) = Add (Add (Neg lx, ao), Neg uj)
13.345 + | numadd (Add (Neg lx, ao), Add (C vb, ul)) =
13.346 + Add (Add (Neg lx, ao), Add (C vb, ul))
13.347 + | numadd (Add (Neg lx, ao), Add (Bound vc, ul)) =
13.348 + Add (Add (Neg lx, ao), Add (Bound vc, ul))
13.349 + | numadd (Add (Neg lx, ao), Add (CX (vd, ve), ul)) =
13.350 + Add (Add (Neg lx, ao), Add (CX (vd, ve), ul))
13.351 + | numadd (Add (Neg lx, ao), Add (Neg vf, ul)) =
13.352 + Add (Add (Neg lx, ao), Add (Neg vf, ul))
13.353 + | numadd (Add (Neg lx, ao), Add (Add (vg, vh), ul)) =
13.354 + Add (Add (Neg lx, ao), Add (Add (vg, vh), ul))
13.355 + | numadd (Add (Neg lx, ao), Add (Sub (vi, vj), ul)) =
13.356 + Add (Add (Neg lx, ao), Add (Sub (vi, vj), ul))
13.357 + | numadd (Add (Neg lx, ao), Add (Mul (vk, C vx), ul)) =
13.358 + Add (Add (Neg lx, ao), Add (Mul (vk, C vx), ul))
13.359 + | numadd (Add (Neg lx, ao), Add (Mul (vk, CX (vz, wa)), ul)) =
13.360 + Add (Add (Neg lx, ao), Add (Mul (vk, CX (vz, wa)), ul))
13.361 + | numadd (Add (Neg lx, ao), Add (Mul (vk, Neg wb), ul)) =
13.362 + Add (Add (Neg lx, ao), Add (Mul (vk, Neg wb), ul))
13.363 + | numadd (Add (Neg lx, ao), Add (Mul (vk, Add (wc, wd)), ul)) =
13.364 + Add (Add (Neg lx, ao), Add (Mul (vk, Add (wc, wd)), ul))
13.365 + | numadd (Add (Neg lx, ao), Add (Mul (vk, Sub (we, wf)), ul)) =
13.366 + Add (Add (Neg lx, ao), Add (Mul (vk, Sub (we, wf)), ul))
13.367 + | numadd (Add (Neg lx, ao), Add (Mul (vk, Mul (wg, wh)), ul)) =
13.368 + Add (Add (Neg lx, ao), Add (Mul (vk, Mul (wg, wh)), ul))
13.369 + | numadd (Add (Neg lx, ao), Sub (um, un)) =
13.370 + Add (Add (Neg lx, ao), Sub (um, un))
13.371 + | numadd (Add (Neg lx, ao), Mul (uo, up)) =
13.372 + Add (Add (Neg lx, ao), Mul (uo, up))
13.373 + | numadd (Add (Add (ly, lz), ao), C wt) = Add (Add (Add (ly, lz), ao), C wt)
13.374 + | numadd (Add (Add (ly, lz), ao), Bound wu) =
13.375 + Add (Add (Add (ly, lz), ao), Bound wu)
13.376 + | numadd (Add (Add (ly, lz), ao), CX (wv, ww)) =
13.377 + Add (Add (Add (ly, lz), ao), CX (wv, ww))
13.378 + | numadd (Add (Add (ly, lz), ao), Neg wx) =
13.379 + Add (Add (Add (ly, lz), ao), Neg wx)
13.380 + | numadd (Add (Add (ly, lz), ao), Add (C xp, wz)) =
13.381 + Add (Add (Add (ly, lz), ao), Add (C xp, wz))
13.382 + | numadd (Add (Add (ly, lz), ao), Add (Bound xq, wz)) =
13.383 + Add (Add (Add (ly, lz), ao), Add (Bound xq, wz))
13.384 + | numadd (Add (Add (ly, lz), ao), Add (CX (xr, xs), wz)) =
13.385 + Add (Add (Add (ly, lz), ao), Add (CX (xr, xs), wz))
13.386 + | numadd (Add (Add (ly, lz), ao), Add (Neg xt, wz)) =
13.387 + Add (Add (Add (ly, lz), ao), Add (Neg xt, wz))
13.388 + | numadd (Add (Add (ly, lz), ao), Add (Add (xu, xv), wz)) =
13.389 + Add (Add (Add (ly, lz), ao), Add (Add (xu, xv), wz))
13.390 + | numadd (Add (Add (ly, lz), ao), Add (Sub (xw, xx), wz)) =
13.391 + Add (Add (Add (ly, lz), ao), Add (Sub (xw, xx), wz))
13.392 + | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, C yl), wz)) =
13.393 + Add (Add (Add (ly, lz), ao), Add (Mul (xy, C yl), wz))
13.394 + | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, CX (yn, yo)), wz)) =
13.395 + Add (Add (Add (ly, lz), ao), Add (Mul (xy, CX (yn, yo)), wz))
13.396 + | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Neg yp), wz)) =
13.397 + Add (Add (Add (ly, lz), ao), Add (Mul (xy, Neg yp), wz))
13.398 + | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Add (yq, yr)), wz)) =
13.399 + Add (Add (Add (ly, lz), ao), Add (Mul (xy, Add (yq, yr)), wz))
13.400 + | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Sub (ys, yt)), wz)) =
13.401 + Add (Add (Add (ly, lz), ao), Add (Mul (xy, Sub (ys, yt)), wz))
13.402 + | numadd (Add (Add (ly, lz), ao), Add (Mul (xy, Mul (yu, yv)), wz)) =
13.403 + Add (Add (Add (ly, lz), ao), Add (Mul (xy, Mul (yu, yv)), wz))
13.404 + | numadd (Add (Add (ly, lz), ao), Sub (xa, xb)) =
13.405 + Add (Add (Add (ly, lz), ao), Sub (xa, xb))
13.406 + | numadd (Add (Add (ly, lz), ao), Mul (xc, xd)) =
13.407 + Add (Add (Add (ly, lz), ao), Mul (xc, xd))
13.408 + | numadd (Add (Sub (ma, mb), ao), C zh) = Add (Add (Sub (ma, mb), ao), C zh)
13.409 + | numadd (Add (Sub (ma, mb), ao), Bound zi) =
13.410 + Add (Add (Sub (ma, mb), ao), Bound zi)
13.411 + | numadd (Add (Sub (ma, mb), ao), CX (zj, zk)) =
13.412 + Add (Add (Sub (ma, mb), ao), CX (zj, zk))
13.413 + | numadd (Add (Sub (ma, mb), ao), Neg zl) =
13.414 + Add (Add (Sub (ma, mb), ao), Neg zl)
13.415 + | numadd (Add (Sub (ma, mb), ao), Add (C aad, zn)) =
13.416 + Add (Add (Sub (ma, mb), ao), Add (C aad, zn))
13.417 + | numadd (Add (Sub (ma, mb), ao), Add (Bound aae, zn)) =
13.418 + Add (Add (Sub (ma, mb), ao), Add (Bound aae, zn))
13.419 + | numadd (Add (Sub (ma, mb), ao), Add (CX (aaf, aag), zn)) =
13.420 + Add (Add (Sub (ma, mb), ao), Add (CX (aaf, aag), zn))
13.421 + | numadd (Add (Sub (ma, mb), ao), Add (Neg aah, zn)) =
13.422 + Add (Add (Sub (ma, mb), ao), Add (Neg aah, zn))
13.423 + | numadd (Add (Sub (ma, mb), ao), Add (Add (aai, aaj), zn)) =
13.424 + Add (Add (Sub (ma, mb), ao), Add (Add (aai, aaj), zn))
13.425 + | numadd (Add (Sub (ma, mb), ao), Add (Sub (aak, aal), zn)) =
13.426 + Add (Add (Sub (ma, mb), ao), Add (Sub (aak, aal), zn))
13.427 + | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, C aaz), zn)) =
13.428 + Add (Add (Sub (ma, mb), ao), Add (Mul (aam, C aaz), zn))
13.429 + | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, CX (abb, abc)), zn)) =
13.430 + Add (Add (Sub (ma, mb), ao), Add (Mul (aam, CX (abb, abc)), zn))
13.431 + | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Neg abd), zn)) =
13.432 + Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Neg abd), zn))
13.433 + | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Add (abe, abf)), zn)) =
13.434 + Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Add (abe, abf)), zn))
13.435 + | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Sub (abg, abh)), zn)) =
13.436 + Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Sub (abg, abh)), zn))
13.437 + | numadd (Add (Sub (ma, mb), ao), Add (Mul (aam, Mul (abi, abj)), zn)) =
13.438 + Add (Add (Sub (ma, mb), ao), Add (Mul (aam, Mul (abi, abj)), zn))
13.439 + | numadd (Add (Sub (ma, mb), ao), Sub (zo, zp)) =
13.440 + Add (Add (Sub (ma, mb), ao), Sub (zo, zp))
13.441 + | numadd (Add (Sub (ma, mb), ao), Mul (zq, zr)) =
13.442 + Add (Add (Sub (ma, mb), ao), Mul (zq, zr))
13.443 + | numadd (Add (Mul (mc, C acg), ao), C adc) =
13.444 + Add (Add (Mul (mc, C acg), ao), C adc)
13.445 + | numadd (Add (Mul (mc, C acg), ao), Bound add) =
13.446 + Add (Add (Mul (mc, C acg), ao), Bound add)
13.447 + | numadd (Add (Mul (mc, C acg), ao), CX (ade, adf)) =
13.448 + Add (Add (Mul (mc, C acg), ao), CX (ade, adf))
13.449 + | numadd (Add (Mul (mc, C acg), ao), Neg adg) =
13.450 + Add (Add (Mul (mc, C acg), ao), Neg adg)
13.451 + | numadd (Add (Mul (mc, C acg), ao), Add (C ady, adi)) =
13.452 + Add (Add (Mul (mc, C acg), ao), Add (C ady, adi))
13.453 + | numadd (Add (Mul (mc, C acg), ao), Add (Bound adz, adi)) =
13.454 + Add (Add (Mul (mc, C acg), ao), Add (Bound adz, adi))
13.455 + | numadd (Add (Mul (mc, C acg), ao), Add (CX (aea, aeb), adi)) =
13.456 + Add (Add (Mul (mc, C acg), ao), Add (CX (aea, aeb), adi))
13.457 + | numadd (Add (Mul (mc, C acg), ao), Add (Neg aec, adi)) =
13.458 + Add (Add (Mul (mc, C acg), ao), Add (Neg aec, adi))
13.459 + | numadd (Add (Mul (mc, C acg), ao), Add (Add (aed, aee), adi)) =
13.460 + Add (Add (Mul (mc, C acg), ao), Add (Add (aed, aee), adi))
13.461 + | numadd (Add (Mul (mc, C acg), ao), Add (Sub (aef, aeg), adi)) =
13.462 + Add (Add (Mul (mc, C acg), ao), Add (Sub (aef, aeg), adi))
13.463 + | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, C aeu), adi)) =
13.464 + Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, C aeu), adi))
13.465 + | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, CX (aew, aex)), adi)) =
13.466 + Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, CX (aew, aex)), adi))
13.467 + | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Neg aey), adi)) =
13.468 + Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Neg aey), adi))
13.469 + | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Add (aez, afa)), adi)) =
13.470 + Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Add (aez, afa)), adi))
13.471 + | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Sub (afb, afc)), adi)) =
13.472 + Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Sub (afb, afc)), adi))
13.473 + | numadd (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Mul (afd, afe)), adi)) =
13.474 + Add (Add (Mul (mc, C acg), ao), Add (Mul (aeh, Mul (afd, afe)), adi))
13.475 + | numadd (Add (Mul (mc, C acg), ao), Sub (adj, adk)) =
13.476 + Add (Add (Mul (mc, C acg), ao), Sub (adj, adk))
13.477 + | numadd (Add (Mul (mc, C acg), ao), Mul (adl, adm)) =
13.478 + Add (Add (Mul (mc, C acg), ao), Mul (adl, adm))
13.479 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), C ajl) =
13.480 + Add (Add (Mul (mc, CX (aci, acj)), ao), C ajl)
13.481 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Bound ajm) =
13.482 + Add (Add (Mul (mc, CX (aci, acj)), ao), Bound ajm)
13.483 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), CX (ajn, ajo)) =
13.484 + Add (Add (Mul (mc, CX (aci, acj)), ao), CX (ajn, ajo))
13.485 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Neg ajp) =
13.486 + Add (Add (Mul (mc, CX (aci, acj)), ao), Neg ajp)
13.487 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (C akh, ajr)) =
13.488 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (C akh, ajr))
13.489 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Bound aki, ajr)) =
13.490 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Bound aki, ajr))
13.491 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (CX (akj, akk), ajr)) =
13.492 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (CX (akj, akk), ajr))
13.493 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Neg akl, ajr)) =
13.494 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Neg akl, ajr))
13.495 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Add (akm, akn), ajr)) =
13.496 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Add (akm, akn), ajr))
13.497 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Sub (ako, akp), ajr)) =
13.498 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Sub (ako, akp), ajr))
13.499 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, C ald), ajr)) =
13.500 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, C ald), ajr))
13.501 + | numadd
13.502 + (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, CX (alf, alg)), ajr)) =
13.503 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, CX (alf, alg)), ajr))
13.504 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, Neg alh), ajr)) =
13.505 + Add (Add (Mul (mc, CX (aci, acj)), ao), Add (Mul (akq, Neg alh), ajr))
13.506 + | numadd
13.507 + (Add (Mul (mc, CX (aci, acj)), ao),
13.508 + Add (Mul (akq, Add (ali, alj)), ajr)) =
13.509 + Add (Add (Mul (mc, CX (aci, acj)), ao),
13.510 + Add (Mul (akq, Add (ali, alj)), ajr))
13.511 + | numadd
13.512 + (Add (Mul (mc, CX (aci, acj)), ao),
13.513 + Add (Mul (akq, Sub (alk, all)), ajr)) =
13.514 + Add (Add (Mul (mc, CX (aci, acj)), ao),
13.515 + Add (Mul (akq, Sub (alk, all)), ajr))
13.516 + | numadd
13.517 + (Add (Mul (mc, CX (aci, acj)), ao),
13.518 + Add (Mul (akq, Mul (alm, aln)), ajr)) =
13.519 + Add (Add (Mul (mc, CX (aci, acj)), ao),
13.520 + Add (Mul (akq, Mul (alm, aln)), ajr))
13.521 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Sub (ajs, ajt)) =
13.522 + Add (Add (Mul (mc, CX (aci, acj)), ao), Sub (ajs, ajt))
13.523 + | numadd (Add (Mul (mc, CX (aci, acj)), ao), Mul (aju, ajv)) =
13.524 + Add (Add (Mul (mc, CX (aci, acj)), ao), Mul (aju, ajv))
13.525 + | numadd (Add (Mul (mc, Neg ack), ao), C alz) =
13.526 + Add (Add (Mul (mc, Neg ack), ao), C alz)
13.527 + | numadd (Add (Mul (mc, Neg ack), ao), Bound ama) =
13.528 + Add (Add (Mul (mc, Neg ack), ao), Bound ama)
13.529 + | numadd (Add (Mul (mc, Neg ack), ao), CX (amb, amc)) =
13.530 + Add (Add (Mul (mc, Neg ack), ao), CX (amb, amc))
13.531 + | numadd (Add (Mul (mc, Neg ack), ao), Neg amd) =
13.532 + Add (Add (Mul (mc, Neg ack), ao), Neg amd)
13.533 + | numadd (Add (Mul (mc, Neg ack), ao), Add (C amv, amf)) =
13.534 + Add (Add (Mul (mc, Neg ack), ao), Add (C amv, amf))
13.535 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Bound amw, amf)) =
13.536 + Add (Add (Mul (mc, Neg ack), ao), Add (Bound amw, amf))
13.537 + | numadd (Add (Mul (mc, Neg ack), ao), Add (CX (amx, amy), amf)) =
13.538 + Add (Add (Mul (mc, Neg ack), ao), Add (CX (amx, amy), amf))
13.539 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Neg amz, amf)) =
13.540 + Add (Add (Mul (mc, Neg ack), ao), Add (Neg amz, amf))
13.541 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Add (ana, anb), amf)) =
13.542 + Add (Add (Mul (mc, Neg ack), ao), Add (Add (ana, anb), amf))
13.543 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Sub (anc, and'), amf)) =
13.544 + Add (Add (Mul (mc, Neg ack), ao), Add (Sub (anc, and'), amf))
13.545 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, C anr), amf)) =
13.546 + Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, C anr), amf))
13.547 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, CX (ant, anu)), amf)) =
13.548 + Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, CX (ant, anu)), amf))
13.549 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Neg anv), amf)) =
13.550 + Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Neg anv), amf))
13.551 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Add (anw, anx)), amf)) =
13.552 + Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Add (anw, anx)), amf))
13.553 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Sub (any, anz)), amf)) =
13.554 + Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Sub (any, anz)), amf))
13.555 + | numadd (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Mul (aoa, aob)), amf)) =
13.556 + Add (Add (Mul (mc, Neg ack), ao), Add (Mul (ane, Mul (aoa, aob)), amf))
13.557 + | numadd (Add (Mul (mc, Neg ack), ao), Sub (amg, amh)) =
13.558 + Add (Add (Mul (mc, Neg ack), ao), Sub (amg, amh))
13.559 + | numadd (Add (Mul (mc, Neg ack), ao), Mul (ami, amj)) =
13.560 + Add (Add (Mul (mc, Neg ack), ao), Mul (ami, amj))
13.561 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), C aon) =
13.562 + Add (Add (Mul (mc, Add (acl, acm)), ao), C aon)
13.563 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Bound aoo) =
13.564 + Add (Add (Mul (mc, Add (acl, acm)), ao), Bound aoo)
13.565 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), CX (aop, aoq)) =
13.566 + Add (Add (Mul (mc, Add (acl, acm)), ao), CX (aop, aoq))
13.567 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Neg aor) =
13.568 + Add (Add (Mul (mc, Add (acl, acm)), ao), Neg aor)
13.569 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (C apj, aot)) =
13.570 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (C apj, aot))
13.571 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Bound apk, aot)) =
13.572 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Bound apk, aot))
13.573 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (CX (apl, apm), aot)) =
13.574 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (CX (apl, apm), aot))
13.575 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Neg apn, aot)) =
13.576 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Neg apn, aot))
13.577 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Add (apo, app), aot)) =
13.578 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Add (apo, app), aot))
13.579 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Sub (apq, apr), aot)) =
13.580 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Sub (apq, apr), aot))
13.581 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, C aqf), aot)) =
13.582 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, C aqf), aot))
13.583 + | numadd
13.584 + (Add (Mul (mc, Add (acl, acm)), ao),
13.585 + Add (Mul (aps, CX (aqh, aqi)), aot)) =
13.586 + Add (Add (Mul (mc, Add (acl, acm)), ao),
13.587 + Add (Mul (aps, CX (aqh, aqi)), aot))
13.588 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, Neg aqj), aot)) =
13.589 + Add (Add (Mul (mc, Add (acl, acm)), ao), Add (Mul (aps, Neg aqj), aot))
13.590 + | numadd
13.591 + (Add (Mul (mc, Add (acl, acm)), ao),
13.592 + Add (Mul (aps, Add (aqk, aql)), aot)) =
13.593 + Add (Add (Mul (mc, Add (acl, acm)), ao),
13.594 + Add (Mul (aps, Add (aqk, aql)), aot))
13.595 + | numadd
13.596 + (Add (Mul (mc, Add (acl, acm)), ao),
13.597 + Add (Mul (aps, Sub (aqm, aqn)), aot)) =
13.598 + Add (Add (Mul (mc, Add (acl, acm)), ao),
13.599 + Add (Mul (aps, Sub (aqm, aqn)), aot))
13.600 + | numadd
13.601 + (Add (Mul (mc, Add (acl, acm)), ao),
13.602 + Add (Mul (aps, Mul (aqo, aqp)), aot)) =
13.603 + Add (Add (Mul (mc, Add (acl, acm)), ao),
13.604 + Add (Mul (aps, Mul (aqo, aqp)), aot))
13.605 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Sub (aou, aov)) =
13.606 + Add (Add (Mul (mc, Add (acl, acm)), ao), Sub (aou, aov))
13.607 + | numadd (Add (Mul (mc, Add (acl, acm)), ao), Mul (aow, aox)) =
13.608 + Add (Add (Mul (mc, Add (acl, acm)), ao), Mul (aow, aox))
13.609 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), C arb) =
13.610 + Add (Add (Mul (mc, Sub (acn, aco)), ao), C arb)
13.611 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Bound arc) =
13.612 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Bound arc)
13.613 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), CX (ard, are)) =
13.614 + Add (Add (Mul (mc, Sub (acn, aco)), ao), CX (ard, are))
13.615 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Neg arf) =
13.616 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Neg arf)
13.617 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (C arx, arh)) =
13.618 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (C arx, arh))
13.619 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Bound ary, arh)) =
13.620 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Bound ary, arh))
13.621 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (CX (arz, asa), arh)) =
13.622 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (CX (arz, asa), arh))
13.623 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Neg asb, arh)) =
13.624 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Neg asb, arh))
13.625 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Add (asc, asd), arh)) =
13.626 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Add (asc, asd), arh))
13.627 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Sub (ase, asf), arh)) =
13.628 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Sub (ase, asf), arh))
13.629 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, C ast), arh)) =
13.630 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, C ast), arh))
13.631 + | numadd
13.632 + (Add (Mul (mc, Sub (acn, aco)), ao),
13.633 + Add (Mul (asg, CX (asv, asw)), arh)) =
13.634 + Add (Add (Mul (mc, Sub (acn, aco)), ao),
13.635 + Add (Mul (asg, CX (asv, asw)), arh))
13.636 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, Neg asx), arh)) =
13.637 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Add (Mul (asg, Neg asx), arh))
13.638 + | numadd
13.639 + (Add (Mul (mc, Sub (acn, aco)), ao),
13.640 + Add (Mul (asg, Add (asy, asz)), arh)) =
13.641 + Add (Add (Mul (mc, Sub (acn, aco)), ao),
13.642 + Add (Mul (asg, Add (asy, asz)), arh))
13.643 + | numadd
13.644 + (Add (Mul (mc, Sub (acn, aco)), ao),
13.645 + Add (Mul (asg, Sub (ata, atb)), arh)) =
13.646 + Add (Add (Mul (mc, Sub (acn, aco)), ao),
13.647 + Add (Mul (asg, Sub (ata, atb)), arh))
13.648 + | numadd
13.649 + (Add (Mul (mc, Sub (acn, aco)), ao),
13.650 + Add (Mul (asg, Mul (atc, atd)), arh)) =
13.651 + Add (Add (Mul (mc, Sub (acn, aco)), ao),
13.652 + Add (Mul (asg, Mul (atc, atd)), arh))
13.653 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Sub (ari, arj)) =
13.654 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Sub (ari, arj))
13.655 + | numadd (Add (Mul (mc, Sub (acn, aco)), ao), Mul (ark, arl)) =
13.656 + Add (Add (Mul (mc, Sub (acn, aco)), ao), Mul (ark, arl))
13.657 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), C atp) =
13.658 + Add (Add (Mul (mc, Mul (acp, acq)), ao), C atp)
13.659 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Bound atq) =
13.660 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Bound atq)
13.661 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), CX (atr, ats)) =
13.662 + Add (Add (Mul (mc, Mul (acp, acq)), ao), CX (atr, ats))
13.663 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Neg att) =
13.664 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Neg att)
13.665 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (C aul, atv)) =
13.666 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (C aul, atv))
13.667 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Bound aum, atv)) =
13.668 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Bound aum, atv))
13.669 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (CX (aun, auo), atv)) =
13.670 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (CX (aun, auo), atv))
13.671 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Neg aup, atv)) =
13.672 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Neg aup, atv))
13.673 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Add (auq, aur), atv)) =
13.674 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Add (auq, aur), atv))
13.675 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Sub (aus, aut), atv)) =
13.676 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Sub (aus, aut), atv))
13.677 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, C avh), atv)) =
13.678 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, C avh), atv))
13.679 + | numadd
13.680 + (Add (Mul (mc, Mul (acp, acq)), ao),
13.681 + Add (Mul (auu, CX (avj, avk)), atv)) =
13.682 + Add (Add (Mul (mc, Mul (acp, acq)), ao),
13.683 + Add (Mul (auu, CX (avj, avk)), atv))
13.684 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, Neg avl), atv)) =
13.685 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Add (Mul (auu, Neg avl), atv))
13.686 + | numadd
13.687 + (Add (Mul (mc, Mul (acp, acq)), ao),
13.688 + Add (Mul (auu, Add (avm, avn)), atv)) =
13.689 + Add (Add (Mul (mc, Mul (acp, acq)), ao),
13.690 + Add (Mul (auu, Add (avm, avn)), atv))
13.691 + | numadd
13.692 + (Add (Mul (mc, Mul (acp, acq)), ao),
13.693 + Add (Mul (auu, Sub (avo, avp)), atv)) =
13.694 + Add (Add (Mul (mc, Mul (acp, acq)), ao),
13.695 + Add (Mul (auu, Sub (avo, avp)), atv))
13.696 + | numadd
13.697 + (Add (Mul (mc, Mul (acp, acq)), ao),
13.698 + Add (Mul (auu, Mul (avq, avr)), atv)) =
13.699 + Add (Add (Mul (mc, Mul (acp, acq)), ao),
13.700 + Add (Mul (auu, Mul (avq, avr)), atv))
13.701 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Sub (atw, atx)) =
13.702 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Sub (atw, atx))
13.703 + | numadd (Add (Mul (mc, Mul (acp, acq)), ao), Mul (aty, atz)) =
13.704 + Add (Add (Mul (mc, Mul (acp, acq)), ao), Mul (aty, atz))
13.705 + | numadd (Sub (ap, aq), C awd) = Add (Sub (ap, aq), C awd)
13.706 + | numadd (Sub (ap, aq), Bound awe) = Add (Sub (ap, aq), Bound awe)
13.707 + | numadd (Sub (ap, aq), CX (awf, awg)) = Add (Sub (ap, aq), CX (awf, awg))
13.708 + | numadd (Sub (ap, aq), Neg awh) = Add (Sub (ap, aq), Neg awh)
13.709 + | numadd (Sub (ap, aq), Add (C awz, awj)) =
13.710 + Add (Sub (ap, aq), Add (C awz, awj))
13.711 + | numadd (Sub (ap, aq), Add (Bound axa, awj)) =
13.712 + Add (Sub (ap, aq), Add (Bound axa, awj))
13.713 + | numadd (Sub (ap, aq), Add (CX (axb, axc), awj)) =
13.714 + Add (Sub (ap, aq), Add (CX (axb, axc), awj))
13.715 + | numadd (Sub (ap, aq), Add (Neg axd, awj)) =
13.716 + Add (Sub (ap, aq), Add (Neg axd, awj))
13.717 + | numadd (Sub (ap, aq), Add (Add (axe, axf), awj)) =
13.718 + Add (Sub (ap, aq), Add (Add (axe, axf), awj))
13.719 + | numadd (Sub (ap, aq), Add (Sub (axg, axh), awj)) =
13.720 + Add (Sub (ap, aq), Add (Sub (axg, axh), awj))
13.721 + | numadd (Sub (ap, aq), Add (Mul (axi, C axv), awj)) =
13.722 + Add (Sub (ap, aq), Add (Mul (axi, C axv), awj))
13.723 + | numadd (Sub (ap, aq), Add (Mul (axi, CX (axx, axy)), awj)) =
13.724 + Add (Sub (ap, aq), Add (Mul (axi, CX (axx, axy)), awj))
13.725 + | numadd (Sub (ap, aq), Add (Mul (axi, Neg axz), awj)) =
13.726 + Add (Sub (ap, aq), Add (Mul (axi, Neg axz), awj))
13.727 + | numadd (Sub (ap, aq), Add (Mul (axi, Add (aya, ayb)), awj)) =
13.728 + Add (Sub (ap, aq), Add (Mul (axi, Add (aya, ayb)), awj))
13.729 + | numadd (Sub (ap, aq), Add (Mul (axi, Sub (ayc, ayd)), awj)) =
13.730 + Add (Sub (ap, aq), Add (Mul (axi, Sub (ayc, ayd)), awj))
13.731 + | numadd (Sub (ap, aq), Add (Mul (axi, Mul (aye, ayf)), awj)) =
13.732 + Add (Sub (ap, aq), Add (Mul (axi, Mul (aye, ayf)), awj))
13.733 + | numadd (Sub (ap, aq), Sub (awk, awl)) = Add (Sub (ap, aq), Sub (awk, awl))
13.734 + | numadd (Sub (ap, aq), Mul (awm, awn)) = Add (Sub (ap, aq), Mul (awm, awn))
13.735 + | numadd (Mul (ar, as'), C ayr) = Add (Mul (ar, as'), C ayr)
13.736 + | numadd (Mul (ar, as'), Bound ays) = Add (Mul (ar, as'), Bound ays)
13.737 + | numadd (Mul (ar, as'), CX (ayt, ayu)) = Add (Mul (ar, as'), CX (ayt, ayu))
13.738 + | numadd (Mul (ar, as'), Neg ayv) = Add (Mul (ar, as'), Neg ayv)
13.739 + | numadd (Mul (ar, as'), Add (C azn, ayx)) =
13.740 + Add (Mul (ar, as'), Add (C azn, ayx))
13.741 + | numadd (Mul (ar, as'), Add (Bound azo, ayx)) =
13.742 + Add (Mul (ar, as'), Add (Bound azo, ayx))
13.743 + | numadd (Mul (ar, as'), Add (CX (azp, azq), ayx)) =
13.744 + Add (Mul (ar, as'), Add (CX (azp, azq), ayx))
13.745 + | numadd (Mul (ar, as'), Add (Neg azr, ayx)) =
13.746 + Add (Mul (ar, as'), Add (Neg azr, ayx))
13.747 + | numadd (Mul (ar, as'), Add (Add (azs, azt), ayx)) =
13.748 + Add (Mul (ar, as'), Add (Add (azs, azt), ayx))
13.749 + | numadd (Mul (ar, as'), Add (Sub (azu, azv), ayx)) =
13.750 + Add (Mul (ar, as'), Add (Sub (azu, azv), ayx))
13.751 + | numadd (Mul (ar, as'), Add (Mul (azw, C baj), ayx)) =
13.752 + Add (Mul (ar, as'), Add (Mul (azw, C baj), ayx))
13.753 + | numadd (Mul (ar, as'), Add (Mul (azw, CX (bal, bam)), ayx)) =
13.754 + Add (Mul (ar, as'), Add (Mul (azw, CX (bal, bam)), ayx))
13.755 + | numadd (Mul (ar, as'), Add (Mul (azw, Neg ban), ayx)) =
13.756 + Add (Mul (ar, as'), Add (Mul (azw, Neg ban), ayx))
13.757 + | numadd (Mul (ar, as'), Add (Mul (azw, Add (bao, bap)), ayx)) =
13.758 + Add (Mul (ar, as'), Add (Mul (azw, Add (bao, bap)), ayx))
13.759 + | numadd (Mul (ar, as'), Add (Mul (azw, Sub (baq, bar)), ayx)) =
13.760 + Add (Mul (ar, as'), Add (Mul (azw, Sub (baq, bar)), ayx))
13.761 + | numadd (Mul (ar, as'), Add (Mul (azw, Mul (bas, bat)), ayx)) =
13.762 + Add (Mul (ar, as'), Add (Mul (azw, Mul (bas, bat)), ayx))
13.763 + | numadd (Mul (ar, as'), Sub (ayy, ayz)) = Add (Mul (ar, as'), Sub (ayy, ayz))
13.764 + | numadd (Mul (ar, as'), Mul (aza, azb)) =
13.765 + Add (Mul (ar, as'), Mul (aza, azb));
13.766 +
13.767 +fun nummul (C j) = (fn i => C (i * j))
13.768 + | nummul (Add (a, b)) = (fn i => numadd (nummul a i, nummul b i))
13.769 + | nummul (Mul (c, t)) = (fn i => nummul t (i * c))
13.770 + | nummul (Bound v) = (fn i => Mul (i, Bound v))
13.771 + | nummul (CX (w, x)) = (fn i => Mul (i, CX (w, x)))
13.772 + | nummul (Neg y) = (fn i => Mul (i, Neg y))
13.773 + | nummul (Sub (ac, ad)) = (fn i => Mul (i, Sub (ac, ad)));
13.774 +
13.775 +fun numneg t = nummul t (~ 1);
13.776 +
13.777 +fun numsub s t = (if (s = t) then C 0 else numadd (s, numneg t));
13.778 +
13.779 +fun simpnum (C j) = C j
13.780 + | simpnum (Bound n) = Add (Mul (1, Bound n), C 0)
13.781 + | simpnum (Neg t) = numneg (simpnum t)
13.782 + | simpnum (Add (t, s)) = numadd (simpnum t, simpnum s)
13.783 + | simpnum (Sub (t, s)) = numsub (simpnum t) (simpnum s)
13.784 + | simpnum (Mul (i, t)) = (if (i = 0) then C 0 else nummul (simpnum t) i)
13.785 + | simpnum (CX (w, x)) = CX (w, x);
13.786 +
13.787 +datatype fm = T | F | Lt of num | Le of num | Gt of num | Ge of num | Eq of num
13.788 + | NEq of num | Dvd of int * num | NDvd of int * num | NOT of fm
13.789 + | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm | E of fm
13.790 + | A of fm | Closed of int | NClosed of int;
13.791 +
13.792 +fun not (NOT p) = p
13.793 + | not T = F
13.794 + | not F = T
13.795 + | not (Lt u) = NOT (Lt u)
13.796 + | not (Le v) = NOT (Le v)
13.797 + | not (Gt w) = NOT (Gt w)
13.798 + | not (Ge x) = NOT (Ge x)
13.799 + | not (Eq y) = NOT (Eq y)
13.800 + | not (NEq z) = NOT (NEq z)
13.801 + | not (Dvd (aa, ab)) = NOT (Dvd (aa, ab))
13.802 + | not (NDvd (ac, ad)) = NOT (NDvd (ac, ad))
13.803 + | not (And (af, ag)) = NOT (And (af, ag))
13.804 + | not (Or (ah, ai)) = NOT (Or (ah, ai))
13.805 + | not (Imp (aj, ak)) = NOT (Imp (aj, ak))
13.806 + | not (Iff (al, am)) = NOT (Iff (al, am))
13.807 + | not (E an) = NOT (E an)
13.808 + | not (A ao) = NOT (A ao)
13.809 + | not (Closed ap) = NOT (Closed ap)
13.810 + | not (NClosed aq) = NOT (NClosed aq);
13.811 +
13.812 +fun iff p q =
13.813 + (if (p = q) then T
13.814 + else (if ((p = not q) orelse (not p = q)) then F
13.815 + else (if (p = F) then not q
13.816 + else (if (q = F) then not p
13.817 + else (if (p = T) then q
13.818 + else (if (q = T) then p else Iff (p, q)))))));
13.819 +
13.820 +fun imp p q =
13.821 + (if ((p = F) orelse (q = T)) then T
13.822 + else (if (p = T) then q else (if (q = F) then not p else Imp (p, q))));
13.823 +
13.824 +fun disj p q =
13.825 + (if ((p = T) orelse (q = T)) then T
13.826 + else (if (p = F) then q else (if (q = F) then p else Or (p, q))));
13.827 +
13.828 +fun conj p q =
13.829 + (if ((p = F) orelse (q = F)) then F
13.830 + else (if (p = T) then q else (if (q = T) then p else And (p, q))));
13.831 +
13.832 +fun simpfm (And (p, q)) = conj (simpfm p) (simpfm q)
13.833 + | simpfm (Or (p, q)) = disj (simpfm p) (simpfm q)
13.834 + | simpfm (Imp (p, q)) = imp (simpfm p) (simpfm q)
13.835 + | simpfm (Iff (p, q)) = iff (simpfm p) (simpfm q)
13.836 + | simpfm (NOT p) = not (simpfm p)
13.837 + | simpfm (Lt a) =
13.838 + let val a' = simpnum a
13.839 + in (case a' of C x => (if (x < 0) then T else F) | Bound x => Lt a'
13.840 + | CX (x, xa) => Lt a' | Neg x => Lt a' | Add (x, xa) => Lt a'
13.841 + | Sub (x, xa) => Lt a' | Mul (x, xa) => Lt a')
13.842 + end
13.843 + | simpfm (Le a) =
13.844 + let val a' = simpnum a
13.845 + in (case a' of C x => (if (x <= 0) then T else F) | Bound x => Le a'
13.846 + | CX (x, xa) => Le a' | Neg x => Le a' | Add (x, xa) => Le a'
13.847 + | Sub (x, xa) => Le a' | Mul (x, xa) => Le a')
13.848 + end
13.849 + | simpfm (Gt a) =
13.850 + let val a' = simpnum a
13.851 + in (case a' of C x => (if (0 < x) then T else F) | Bound x => Gt a'
13.852 + | CX (x, xa) => Gt a' | Neg x => Gt a' | Add (x, xa) => Gt a'
13.853 + | Sub (x, xa) => Gt a' | Mul (x, xa) => Gt a')
13.854 + end
13.855 + | simpfm (Ge a) =
13.856 + let val a' = simpnum a
13.857 + in (case a' of C x => (if (0 <= x) then T else F) | Bound x => Ge a'
13.858 + | CX (x, xa) => Ge a' | Neg x => Ge a' | Add (x, xa) => Ge a'
13.859 + | Sub (x, xa) => Ge a' | Mul (x, xa) => Ge a')
13.860 + end
13.861 + | simpfm (Eq a) =
13.862 + let val a' = simpnum a
13.863 + in (case a' of C x => (if (x = 0) then T else F) | Bound x => Eq a'
13.864 + | CX (x, xa) => Eq a' | Neg x => Eq a' | Add (x, xa) => Eq a'
13.865 + | Sub (x, xa) => Eq a' | Mul (x, xa) => Eq a')
13.866 + end
13.867 + | simpfm (NEq a) =
13.868 + let val a' = simpnum a
13.869 + in (case a' of C x => (if Bool.not (x = 0) then T else F)
13.870 + | Bound x => NEq a' | CX (x, xa) => NEq a' | Neg x => NEq a'
13.871 + | Add (x, xa) => NEq a' | Sub (x, xa) => NEq a'
13.872 + | Mul (x, xa) => NEq a')
13.873 + end
13.874 + | simpfm (Dvd (i, a)) =
13.875 + (if (i = 0) then simpfm (Eq a)
13.876 + else (if (abs i = 1) then T
13.877 + else let val a' = simpnum a
13.878 + in (case a' of C x => (if dvd i x then T else F)
13.879 + | Bound x => Dvd (i, a') | CX (x, xa) => Dvd (i, a')
13.880 + | Neg x => Dvd (i, a') | Add (x, xa) => Dvd (i, a')
13.881 + | Sub (x, xa) => Dvd (i, a')
13.882 + | Mul (x, xa) => Dvd (i, a'))
13.883 + end))
13.884 + | simpfm (NDvd (i, a)) =
13.885 + (if (i = 0) then simpfm (NEq a)
13.886 + else (if (abs i = 1) then F
13.887 + else let val a' = simpnum a
13.888 + in (case a' of C x => (if Bool.not (dvd i x) then T else F)
13.889 + | Bound x => NDvd (i, a') | CX (x, xa) => NDvd (i, a')
13.890 + | Neg x => NDvd (i, a') | Add (x, xa) => NDvd (i, a')
13.891 + | Sub (x, xa) => NDvd (i, a')
13.892 + | Mul (x, xa) => NDvd (i, a'))
13.893 + end))
13.894 + | simpfm T = T
13.895 + | simpfm F = F
13.896 + | simpfm (E ao) = E ao
13.897 + | simpfm (A ap) = A ap
13.898 + | simpfm (Closed aq) = Closed aq
13.899 + | simpfm (NClosed ar) = NClosed ar;
13.900 +
13.901 +fun foldr f [] a = a
13.902 + | foldr f (x :: xs) a = f x (foldr f xs a);
13.903 +
13.904 +fun djf f p q =
13.905 + (if (q = T) then T
13.906 + else (if (q = F) then f p
13.907 + else let val fp = f p
13.908 + in (case fp of T => T | F => q | Lt x => Or (f p, q)
13.909 + | Le x => Or (f p, q) | Gt x => Or (f p, q)
13.910 + | Ge x => Or (f p, q) | Eq x => Or (f p, q)
13.911 + | NEq x => Or (f p, q) | Dvd (x, xa) => Or (f p, q)
13.912 + | NDvd (x, xa) => Or (f p, q) | NOT x => Or (f p, q)
13.913 + | And (x, xa) => Or (f p, q) | Or (x, xa) => Or (f p, q)
13.914 + | Imp (x, xa) => Or (f p, q) | Iff (x, xa) => Or (f p, q)
13.915 + | E x => Or (f p, q) | A x => Or (f p, q)
13.916 + | Closed x => Or (f p, q) | NClosed x => Or (f p, q))
13.917 + end));
13.918 +
13.919 +fun evaldjf f ps = foldr (djf f) ps F;
13.920 +
13.921 +fun append [] ys = ys
13.922 + | append (x :: xs) ys = (x :: append xs ys);
13.923 +
13.924 +fun disjuncts (Or (p, q)) = append (disjuncts p) (disjuncts q)
13.925 + | disjuncts F = []
13.926 + | disjuncts T = [T]
13.927 + | disjuncts (Lt u) = [Lt u]
13.928 + | disjuncts (Le v) = [Le v]
13.929 + | disjuncts (Gt w) = [Gt w]
13.930 + | disjuncts (Ge x) = [Ge x]
13.931 + | disjuncts (Eq y) = [Eq y]
13.932 + | disjuncts (NEq z) = [NEq z]
13.933 + | disjuncts (Dvd (aa, ab)) = [Dvd (aa, ab)]
13.934 + | disjuncts (NDvd (ac, ad)) = [NDvd (ac, ad)]
13.935 + | disjuncts (NOT ae) = [NOT ae]
13.936 + | disjuncts (And (af, ag)) = [And (af, ag)]
13.937 + | disjuncts (Imp (aj, ak)) = [Imp (aj, ak)]
13.938 + | disjuncts (Iff (al, am)) = [Iff (al, am)]
13.939 + | disjuncts (E an) = [E an]
13.940 + | disjuncts (A ao) = [A ao]
13.941 + | disjuncts (Closed ap) = [Closed ap]
13.942 + | disjuncts (NClosed aq) = [NClosed aq];
13.943 +
13.944 +fun DJ f p = evaldjf f (disjuncts p);
13.945 +
13.946 +fun qelim (E p) = (fn qe => DJ qe (qelim p qe))
13.947 + | qelim (A p) = (fn qe => not (qe (qelim (NOT p) qe)))
13.948 + | qelim (NOT p) = (fn qe => not (qelim p qe))
13.949 + | qelim (And (p, q)) = (fn qe => conj (qelim p qe) (qelim q qe))
13.950 + | qelim (Or (p, q)) = (fn qe => disj (qelim p qe) (qelim q qe))
13.951 + | qelim (Imp (p, q)) = (fn qe => imp (qelim p qe) (qelim q qe))
13.952 + | qelim (Iff (p, q)) = (fn qe => iff (qelim p qe) (qelim q qe))
13.953 + | qelim T = (fn y => simpfm T)
13.954 + | qelim F = (fn y => simpfm F)
13.955 + | qelim (Lt u) = (fn y => simpfm (Lt u))
13.956 + | qelim (Le v) = (fn y => simpfm (Le v))
13.957 + | qelim (Gt w) = (fn y => simpfm (Gt w))
13.958 + | qelim (Ge x) = (fn y => simpfm (Ge x))
13.959 + | qelim (Eq y) = (fn ya => simpfm (Eq y))
13.960 + | qelim (NEq z) = (fn y => simpfm (NEq z))
13.961 + | qelim (Dvd (aa, ab)) = (fn y => simpfm (Dvd (aa, ab)))
13.962 + | qelim (NDvd (ac, ad)) = (fn y => simpfm (NDvd (ac, ad)))
13.963 + | qelim (Closed ap) = (fn y => simpfm (Closed ap))
13.964 + | qelim (NClosed aq) = (fn y => simpfm (NClosed aq));
13.965 +
13.966 +fun minus_def1 m n = nat (minus_def2 (m) (n));
13.967 +
13.968 +fun decrnum (Bound n) = Bound (minus_def1 n one_def0)
13.969 + | decrnum (Neg a) = Neg (decrnum a)
13.970 + | decrnum (Add (a, b)) = Add (decrnum a, decrnum b)
13.971 + | decrnum (Sub (a, b)) = Sub (decrnum a, decrnum b)
13.972 + | decrnum (Mul (c, a)) = Mul (c, decrnum a)
13.973 + | decrnum (C u) = C u
13.974 + | decrnum (CX (w, x)) = CX (w, x);
13.975 +
13.976 +fun decr (Lt a) = Lt (decrnum a)
13.977 + | decr (Le a) = Le (decrnum a)
13.978 + | decr (Gt a) = Gt (decrnum a)
13.979 + | decr (Ge a) = Ge (decrnum a)
13.980 + | decr (Eq a) = Eq (decrnum a)
13.981 + | decr (NEq a) = NEq (decrnum a)
13.982 + | decr (Dvd (i, a)) = Dvd (i, decrnum a)
13.983 + | decr (NDvd (i, a)) = NDvd (i, decrnum a)
13.984 + | decr (NOT p) = NOT (decr p)
13.985 + | decr (And (p, q)) = And (decr p, decr q)
13.986 + | decr (Or (p, q)) = Or (decr p, decr q)
13.987 + | decr (Imp (p, q)) = Imp (decr p, decr q)
13.988 + | decr (Iff (p, q)) = Iff (decr p, decr q)
13.989 + | decr T = T
13.990 + | decr F = F
13.991 + | decr (E ao) = E ao
13.992 + | decr (A ap) = A ap
13.993 + | decr (Closed aq) = Closed aq
13.994 + | decr (NClosed ar) = NClosed ar;
13.995 +
13.996 +fun map f [] = []
13.997 + | map f (x :: xs) = (f x :: map f xs);
13.998 +
13.999 +fun allpairs f [] ys = []
13.1000 + | allpairs f (x :: xs) ys = append (map (f x) ys) (allpairs f xs ys);
13.1001 +
13.1002 +fun numsubst0 t (C c) = C c
13.1003 + | numsubst0 t (Bound n) = (if (n = 0) then t else Bound n)
13.1004 + | numsubst0 t (CX (i, a)) = Add (Mul (i, t), numsubst0 t a)
13.1005 + | numsubst0 t (Neg a) = Neg (numsubst0 t a)
13.1006 + | numsubst0 t (Add (a, b)) = Add (numsubst0 t a, numsubst0 t b)
13.1007 + | numsubst0 t (Sub (a, b)) = Sub (numsubst0 t a, numsubst0 t b)
13.1008 + | numsubst0 t (Mul (i, a)) = Mul (i, numsubst0 t a);
13.1009 +
13.1010 +fun subst0 t T = T
13.1011 + | subst0 t F = F
13.1012 + | subst0 t (Lt a) = Lt (numsubst0 t a)
13.1013 + | subst0 t (Le a) = Le (numsubst0 t a)
13.1014 + | subst0 t (Gt a) = Gt (numsubst0 t a)
13.1015 + | subst0 t (Ge a) = Ge (numsubst0 t a)
13.1016 + | subst0 t (Eq a) = Eq (numsubst0 t a)
13.1017 + | subst0 t (NEq a) = NEq (numsubst0 t a)
13.1018 + | subst0 t (Dvd (i, a)) = Dvd (i, numsubst0 t a)
13.1019 + | subst0 t (NDvd (i, a)) = NDvd (i, numsubst0 t a)
13.1020 + | subst0 t (NOT p) = NOT (subst0 t p)
13.1021 + | subst0 t (And (p, q)) = And (subst0 t p, subst0 t q)
13.1022 + | subst0 t (Or (p, q)) = Or (subst0 t p, subst0 t q)
13.1023 + | subst0 t (Imp (p, q)) = Imp (subst0 t p, subst0 t q)
13.1024 + | subst0 t (Iff (p, q)) = Iff (subst0 t p, subst0 t q)
13.1025 + | subst0 t (Closed P) = Closed P
13.1026 + | subst0 t (NClosed P) = NClosed P;
13.1027 +
13.1028 +fun minusinf (And (p, q)) = And (minusinf p, minusinf q)
13.1029 + | minusinf (Or (p, q)) = Or (minusinf p, minusinf q)
13.1030 + | minusinf (Eq (CX (c, e))) = F
13.1031 + | minusinf (NEq (CX (c, e))) = T
13.1032 + | minusinf (Lt (CX (c, e))) = T
13.1033 + | minusinf (Le (CX (c, e))) = T
13.1034 + | minusinf (Gt (CX (c, e))) = F
13.1035 + | minusinf (Ge (CX (c, e))) = F
13.1036 + | minusinf T = T
13.1037 + | minusinf F = F
13.1038 + | minusinf (Lt (C bo)) = Lt (C bo)
13.1039 + | minusinf (Lt (Bound bp)) = Lt (Bound bp)
13.1040 + | minusinf (Lt (Neg bs)) = Lt (Neg bs)
13.1041 + | minusinf (Lt (Add (bt, bu))) = Lt (Add (bt, bu))
13.1042 + | minusinf (Lt (Sub (bv, bw))) = Lt (Sub (bv, bw))
13.1043 + | minusinf (Lt (Mul (bx, by))) = Lt (Mul (bx, by))
13.1044 + | minusinf (Le (C ck)) = Le (C ck)
13.1045 + | minusinf (Le (Bound cl)) = Le (Bound cl)
13.1046 + | minusinf (Le (Neg co)) = Le (Neg co)
13.1047 + | minusinf (Le (Add (cp, cq))) = Le (Add (cp, cq))
13.1048 + | minusinf (Le (Sub (cr, cs))) = Le (Sub (cr, cs))
13.1049 + | minusinf (Le (Mul (ct, cu))) = Le (Mul (ct, cu))
13.1050 + | minusinf (Gt (C dg)) = Gt (C dg)
13.1051 + | minusinf (Gt (Bound dh)) = Gt (Bound dh)
13.1052 + | minusinf (Gt (Neg dk)) = Gt (Neg dk)
13.1053 + | minusinf (Gt (Add (dl, dm))) = Gt (Add (dl, dm))
13.1054 + | minusinf (Gt (Sub (dn, do'))) = Gt (Sub (dn, do'))
13.1055 + | minusinf (Gt (Mul (dp, dq))) = Gt (Mul (dp, dq))
13.1056 + | minusinf (Ge (C ec)) = Ge (C ec)
13.1057 + | minusinf (Ge (Bound ed)) = Ge (Bound ed)
13.1058 + | minusinf (Ge (Neg eg)) = Ge (Neg eg)
13.1059 + | minusinf (Ge (Add (eh, ei))) = Ge (Add (eh, ei))
13.1060 + | minusinf (Ge (Sub (ej, ek))) = Ge (Sub (ej, ek))
13.1061 + | minusinf (Ge (Mul (el, em))) = Ge (Mul (el, em))
13.1062 + | minusinf (Eq (C ey)) = Eq (C ey)
13.1063 + | minusinf (Eq (Bound ez)) = Eq (Bound ez)
13.1064 + | minusinf (Eq (Neg fc)) = Eq (Neg fc)
13.1065 + | minusinf (Eq (Add (fd, fe))) = Eq (Add (fd, fe))
13.1066 + | minusinf (Eq (Sub (ff, fg))) = Eq (Sub (ff, fg))
13.1067 + | minusinf (Eq (Mul (fh, fi))) = Eq (Mul (fh, fi))
13.1068 + | minusinf (NEq (C fu)) = NEq (C fu)
13.1069 + | minusinf (NEq (Bound fv)) = NEq (Bound fv)
13.1070 + | minusinf (NEq (Neg fy)) = NEq (Neg fy)
13.1071 + | minusinf (NEq (Add (fz, ga))) = NEq (Add (fz, ga))
13.1072 + | minusinf (NEq (Sub (gb, gc))) = NEq (Sub (gb, gc))
13.1073 + | minusinf (NEq (Mul (gd, ge))) = NEq (Mul (gd, ge))
13.1074 + | minusinf (Dvd (aa, ab)) = Dvd (aa, ab)
13.1075 + | minusinf (NDvd (ac, ad)) = NDvd (ac, ad)
13.1076 + | minusinf (NOT ae) = NOT ae
13.1077 + | minusinf (Imp (aj, ak)) = Imp (aj, ak)
13.1078 + | minusinf (Iff (al, am)) = Iff (al, am)
13.1079 + | minusinf (E an) = E an
13.1080 + | minusinf (A ao) = A ao
13.1081 + | minusinf (Closed ap) = Closed ap
13.1082 + | minusinf (NClosed aq) = NClosed aq;
13.1083 +
13.1084 +fun iupt (i, j) = (if (j < i) then [] else (i :: iupt ((i + 1), j)));
13.1085 +
13.1086 +fun mirror (And (p, q)) = And (mirror p, mirror q)
13.1087 + | mirror (Or (p, q)) = Or (mirror p, mirror q)
13.1088 + | mirror (Eq (CX (c, e))) = Eq (CX (c, Neg e))
13.1089 + | mirror (NEq (CX (c, e))) = NEq (CX (c, Neg e))
13.1090 + | mirror (Lt (CX (c, e))) = Gt (CX (c, Neg e))
13.1091 + | mirror (Le (CX (c, e))) = Ge (CX (c, Neg e))
13.1092 + | mirror (Gt (CX (c, e))) = Lt (CX (c, Neg e))
13.1093 + | mirror (Ge (CX (c, e))) = Le (CX (c, Neg e))
13.1094 + | mirror (Dvd (i, CX (c, e))) = Dvd (i, CX (c, Neg e))
13.1095 + | mirror (NDvd (i, CX (c, e))) = NDvd (i, CX (c, Neg e))
13.1096 + | mirror T = T
13.1097 + | mirror F = F
13.1098 + | mirror (Lt (C bo)) = Lt (C bo)
13.1099 + | mirror (Lt (Bound bp)) = Lt (Bound bp)
13.1100 + | mirror (Lt (Neg bs)) = Lt (Neg bs)
13.1101 + | mirror (Lt (Add (bt, bu))) = Lt (Add (bt, bu))
13.1102 + | mirror (Lt (Sub (bv, bw))) = Lt (Sub (bv, bw))
13.1103 + | mirror (Lt (Mul (bx, by))) = Lt (Mul (bx, by))
13.1104 + | mirror (Le (C ck)) = Le (C ck)
13.1105 + | mirror (Le (Bound cl)) = Le (Bound cl)
13.1106 + | mirror (Le (Neg co)) = Le (Neg co)
13.1107 + | mirror (Le (Add (cp, cq))) = Le (Add (cp, cq))
13.1108 + | mirror (Le (Sub (cr, cs))) = Le (Sub (cr, cs))
13.1109 + | mirror (Le (Mul (ct, cu))) = Le (Mul (ct, cu))
13.1110 + | mirror (Gt (C dg)) = Gt (C dg)
13.1111 + | mirror (Gt (Bound dh)) = Gt (Bound dh)
13.1112 + | mirror (Gt (Neg dk)) = Gt (Neg dk)
13.1113 + | mirror (Gt (Add (dl, dm))) = Gt (Add (dl, dm))
13.1114 + | mirror (Gt (Sub (dn, do'))) = Gt (Sub (dn, do'))
13.1115 + | mirror (Gt (Mul (dp, dq))) = Gt (Mul (dp, dq))
13.1116 + | mirror (Ge (C ec)) = Ge (C ec)
13.1117 + | mirror (Ge (Bound ed)) = Ge (Bound ed)
13.1118 + | mirror (Ge (Neg eg)) = Ge (Neg eg)
13.1119 + | mirror (Ge (Add (eh, ei))) = Ge (Add (eh, ei))
13.1120 + | mirror (Ge (Sub (ej, ek))) = Ge (Sub (ej, ek))
13.1121 + | mirror (Ge (Mul (el, em))) = Ge (Mul (el, em))
13.1122 + | mirror (Eq (C ey)) = Eq (C ey)
13.1123 + | mirror (Eq (Bound ez)) = Eq (Bound ez)
13.1124 + | mirror (Eq (Neg fc)) = Eq (Neg fc)
13.1125 + | mirror (Eq (Add (fd, fe))) = Eq (Add (fd, fe))
13.1126 + | mirror (Eq (Sub (ff, fg))) = Eq (Sub (ff, fg))
13.1127 + | mirror (Eq (Mul (fh, fi))) = Eq (Mul (fh, fi))
13.1128 + | mirror (NEq (C fu)) = NEq (C fu)
13.1129 + | mirror (NEq (Bound fv)) = NEq (Bound fv)
13.1130 + | mirror (NEq (Neg fy)) = NEq (Neg fy)
13.1131 + | mirror (NEq (Add (fz, ga))) = NEq (Add (fz, ga))
13.1132 + | mirror (NEq (Sub (gb, gc))) = NEq (Sub (gb, gc))
13.1133 + | mirror (NEq (Mul (gd, ge))) = NEq (Mul (gd, ge))
13.1134 + | mirror (Dvd (aa, C gq)) = Dvd (aa, C gq)
13.1135 + | mirror (Dvd (aa, Bound gr)) = Dvd (aa, Bound gr)
13.1136 + | mirror (Dvd (aa, Neg gu)) = Dvd (aa, Neg gu)
13.1137 + | mirror (Dvd (aa, Add (gv, gw))) = Dvd (aa, Add (gv, gw))
13.1138 + | mirror (Dvd (aa, Sub (gx, gy))) = Dvd (aa, Sub (gx, gy))
13.1139 + | mirror (Dvd (aa, Mul (gz, ha))) = Dvd (aa, Mul (gz, ha))
13.1140 + | mirror (NDvd (ac, C hm)) = NDvd (ac, C hm)
13.1141 + | mirror (NDvd (ac, Bound hn)) = NDvd (ac, Bound hn)
13.1142 + | mirror (NDvd (ac, Neg hq)) = NDvd (ac, Neg hq)
13.1143 + | mirror (NDvd (ac, Add (hr, hs))) = NDvd (ac, Add (hr, hs))
13.1144 + | mirror (NDvd (ac, Sub (ht, hu))) = NDvd (ac, Sub (ht, hu))
13.1145 + | mirror (NDvd (ac, Mul (hv, hw))) = NDvd (ac, Mul (hv, hw))
13.1146 + | mirror (NOT ae) = NOT ae
13.1147 + | mirror (Imp (aj, ak)) = Imp (aj, ak)
13.1148 + | mirror (Iff (al, am)) = Iff (al, am)
13.1149 + | mirror (E an) = E an
13.1150 + | mirror (A ao) = A ao
13.1151 + | mirror (Closed ap) = Closed ap
13.1152 + | mirror (NClosed aq) = NClosed aq;
13.1153 +
13.1154 +fun plus_def0 m n = nat ((m) + (n));
13.1155 +
13.1156 +fun size_def9 [] = 0
13.1157 + | size_def9 (a :: list) = plus_def0 (size_def9 list) (0 + 1);
13.1158 +
13.1159 +fun alpha (And (p, q)) = append (alpha p) (alpha q)
13.1160 + | alpha (Or (p, q)) = append (alpha p) (alpha q)
13.1161 + | alpha (Eq (CX (c, e))) = [Add (C ~1, e)]
13.1162 + | alpha (NEq (CX (c, e))) = [e]
13.1163 + | alpha (Lt (CX (c, e))) = [e]
13.1164 + | alpha (Le (CX (c, e))) = [Add (C ~1, e)]
13.1165 + | alpha (Gt (CX (c, e))) = []
13.1166 + | alpha (Ge (CX (c, e))) = []
13.1167 + | alpha T = []
13.1168 + | alpha F = []
13.1169 + | alpha (Lt (C bo)) = []
13.1170 + | alpha (Lt (Bound bp)) = []
13.1171 + | alpha (Lt (Neg bs)) = []
13.1172 + | alpha (Lt (Add (bt, bu))) = []
13.1173 + | alpha (Lt (Sub (bv, bw))) = []
13.1174 + | alpha (Lt (Mul (bx, by))) = []
13.1175 + | alpha (Le (C ck)) = []
13.1176 + | alpha (Le (Bound cl)) = []
13.1177 + | alpha (Le (Neg co)) = []
13.1178 + | alpha (Le (Add (cp, cq))) = []
13.1179 + | alpha (Le (Sub (cr, cs))) = []
13.1180 + | alpha (Le (Mul (ct, cu))) = []
13.1181 + | alpha (Gt (C dg)) = []
13.1182 + | alpha (Gt (Bound dh)) = []
13.1183 + | alpha (Gt (Neg dk)) = []
13.1184 + | alpha (Gt (Add (dl, dm))) = []
13.1185 + | alpha (Gt (Sub (dn, do'))) = []
13.1186 + | alpha (Gt (Mul (dp, dq))) = []
13.1187 + | alpha (Ge (C ec)) = []
13.1188 + | alpha (Ge (Bound ed)) = []
13.1189 + | alpha (Ge (Neg eg)) = []
13.1190 + | alpha (Ge (Add (eh, ei))) = []
13.1191 + | alpha (Ge (Sub (ej, ek))) = []
13.1192 + | alpha (Ge (Mul (el, em))) = []
13.1193 + | alpha (Eq (C ey)) = []
13.1194 + | alpha (Eq (Bound ez)) = []
13.1195 + | alpha (Eq (Neg fc)) = []
13.1196 + | alpha (Eq (Add (fd, fe))) = []
13.1197 + | alpha (Eq (Sub (ff, fg))) = []
13.1198 + | alpha (Eq (Mul (fh, fi))) = []
13.1199 + | alpha (NEq (C fu)) = []
13.1200 + | alpha (NEq (Bound fv)) = []
13.1201 + | alpha (NEq (Neg fy)) = []
13.1202 + | alpha (NEq (Add (fz, ga))) = []
13.1203 + | alpha (NEq (Sub (gb, gc))) = []
13.1204 + | alpha (NEq (Mul (gd, ge))) = []
13.1205 + | alpha (Dvd (aa, ab)) = []
13.1206 + | alpha (NDvd (ac, ad)) = []
13.1207 + | alpha (NOT ae) = []
13.1208 + | alpha (Imp (aj, ak)) = []
13.1209 + | alpha (Iff (al, am)) = []
13.1210 + | alpha (E an) = []
13.1211 + | alpha (A ao) = []
13.1212 + | alpha (Closed ap) = []
13.1213 + | alpha (NClosed aq) = [];
13.1214 +
13.1215 +fun memberl x [] = false
13.1216 + | memberl x (y :: ys) = ((x = y) orelse memberl x ys);
13.1217 +
13.1218 +fun remdups [] = []
13.1219 + | remdups (x :: xs) =
13.1220 + (if memberl x xs then remdups xs else (x :: remdups xs));
13.1221 +
13.1222 +fun beta (And (p, q)) = append (beta p) (beta q)
13.1223 + | beta (Or (p, q)) = append (beta p) (beta q)
13.1224 + | beta (Eq (CX (c, e))) = [Sub (C ~1, e)]
13.1225 + | beta (NEq (CX (c, e))) = [Neg e]
13.1226 + | beta (Lt (CX (c, e))) = []
13.1227 + | beta (Le (CX (c, e))) = []
13.1228 + | beta (Gt (CX (c, e))) = [Neg e]
13.1229 + | beta (Ge (CX (c, e))) = [Sub (C ~1, e)]
13.1230 + | beta T = []
13.1231 + | beta F = []
13.1232 + | beta (Lt (C bo)) = []
13.1233 + | beta (Lt (Bound bp)) = []
13.1234 + | beta (Lt (Neg bs)) = []
13.1235 + | beta (Lt (Add (bt, bu))) = []
13.1236 + | beta (Lt (Sub (bv, bw))) = []
13.1237 + | beta (Lt (Mul (bx, by))) = []
13.1238 + | beta (Le (C ck)) = []
13.1239 + | beta (Le (Bound cl)) = []
13.1240 + | beta (Le (Neg co)) = []
13.1241 + | beta (Le (Add (cp, cq))) = []
13.1242 + | beta (Le (Sub (cr, cs))) = []
13.1243 + | beta (Le (Mul (ct, cu))) = []
13.1244 + | beta (Gt (C dg)) = []
13.1245 + | beta (Gt (Bound dh)) = []
13.1246 + | beta (Gt (Neg dk)) = []
13.1247 + | beta (Gt (Add (dl, dm))) = []
13.1248 + | beta (Gt (Sub (dn, do'))) = []
13.1249 + | beta (Gt (Mul (dp, dq))) = []
13.1250 + | beta (Ge (C ec)) = []
13.1251 + | beta (Ge (Bound ed)) = []
13.1252 + | beta (Ge (Neg eg)) = []
13.1253 + | beta (Ge (Add (eh, ei))) = []
13.1254 + | beta (Ge (Sub (ej, ek))) = []
13.1255 + | beta (Ge (Mul (el, em))) = []
13.1256 + | beta (Eq (C ey)) = []
13.1257 + | beta (Eq (Bound ez)) = []
13.1258 + | beta (Eq (Neg fc)) = []
13.1259 + | beta (Eq (Add (fd, fe))) = []
13.1260 + | beta (Eq (Sub (ff, fg))) = []
13.1261 + | beta (Eq (Mul (fh, fi))) = []
13.1262 + | beta (NEq (C fu)) = []
13.1263 + | beta (NEq (Bound fv)) = []
13.1264 + | beta (NEq (Neg fy)) = []
13.1265 + | beta (NEq (Add (fz, ga))) = []
13.1266 + | beta (NEq (Sub (gb, gc))) = []
13.1267 + | beta (NEq (Mul (gd, ge))) = []
13.1268 + | beta (Dvd (aa, ab)) = []
13.1269 + | beta (NDvd (ac, ad)) = []
13.1270 + | beta (NOT ae) = []
13.1271 + | beta (Imp (aj, ak)) = []
13.1272 + | beta (Iff (al, am)) = []
13.1273 + | beta (E an) = []
13.1274 + | beta (A ao) = []
13.1275 + | beta (Closed ap) = []
13.1276 + | beta (NClosed aq) = [];
13.1277 +
13.1278 +fun fst (a, b) = a;
13.1279 +
13.1280 +fun div_def1 a b = fst (divAlg (a, b));
13.1281 +
13.1282 +fun div_def0 m n = nat (div_def1 (m) (n));
13.1283 +
13.1284 +fun mod_def0 m n = nat (mod_def1 (m) (n));
13.1285 +
13.1286 +fun gcd (m, n) = (if (n = 0) then m else gcd (n, mod_def0 m n));
13.1287 +
13.1288 +fun times_def0 m n = nat ((m) * (n));
13.1289 +
13.1290 +fun lcm x = (fn (m, n) => div_def0 (times_def0 m n) (gcd (m, n))) x;
13.1291 +
13.1292 +fun ilcm x = (fn j => (lcm (nat (abs x), nat (abs j))));
13.1293 +
13.1294 +fun delta (And (p, q)) = ilcm (delta p) (delta q)
13.1295 + | delta (Or (p, q)) = ilcm (delta p) (delta q)
13.1296 + | delta (Dvd (i, CX (c, e))) = i
13.1297 + | delta (NDvd (i, CX (c, e))) = i
13.1298 + | delta T = 1
13.1299 + | delta F = 1
13.1300 + | delta (Lt u) = 1
13.1301 + | delta (Le v) = 1
13.1302 + | delta (Gt w) = 1
13.1303 + | delta (Ge x) = 1
13.1304 + | delta (Eq y) = 1
13.1305 + | delta (NEq z) = 1
13.1306 + | delta (Dvd (aa, C bo)) = 1
13.1307 + | delta (Dvd (aa, Bound bp)) = 1
13.1308 + | delta (Dvd (aa, Neg bs)) = 1
13.1309 + | delta (Dvd (aa, Add (bt, bu))) = 1
13.1310 + | delta (Dvd (aa, Sub (bv, bw))) = 1
13.1311 + | delta (Dvd (aa, Mul (bx, by))) = 1
13.1312 + | delta (NDvd (ac, C ck)) = 1
13.1313 + | delta (NDvd (ac, Bound cl)) = 1
13.1314 + | delta (NDvd (ac, Neg co)) = 1
13.1315 + | delta (NDvd (ac, Add (cp, cq))) = 1
13.1316 + | delta (NDvd (ac, Sub (cr, cs))) = 1
13.1317 + | delta (NDvd (ac, Mul (ct, cu))) = 1
13.1318 + | delta (NOT ae) = 1
13.1319 + | delta (Imp (aj, ak)) = 1
13.1320 + | delta (Iff (al, am)) = 1
13.1321 + | delta (E an) = 1
13.1322 + | delta (A ao) = 1
13.1323 + | delta (Closed ap) = 1
13.1324 + | delta (NClosed aq) = 1;
13.1325 +
13.1326 +fun a_beta (And (p, q)) = (fn k => And (a_beta p k, a_beta q k))
13.1327 + | a_beta (Or (p, q)) = (fn k => Or (a_beta p k, a_beta q k))
13.1328 + | a_beta (Eq (CX (c, e))) = (fn k => Eq (CX (1, Mul (div_def1 k c, e))))
13.1329 + | a_beta (NEq (CX (c, e))) = (fn k => NEq (CX (1, Mul (div_def1 k c, e))))
13.1330 + | a_beta (Lt (CX (c, e))) = (fn k => Lt (CX (1, Mul (div_def1 k c, e))))
13.1331 + | a_beta (Le (CX (c, e))) = (fn k => Le (CX (1, Mul (div_def1 k c, e))))
13.1332 + | a_beta (Gt (CX (c, e))) = (fn k => Gt (CX (1, Mul (div_def1 k c, e))))
13.1333 + | a_beta (Ge (CX (c, e))) = (fn k => Ge (CX (1, Mul (div_def1 k c, e))))
13.1334 + | a_beta (Dvd (i, CX (c, e))) =
13.1335 + (fn k => Dvd ((div_def1 k c * i), CX (1, Mul (div_def1 k c, e))))
13.1336 + | a_beta (NDvd (i, CX (c, e))) =
13.1337 + (fn k => NDvd ((div_def1 k c * i), CX (1, Mul (div_def1 k c, e))))
13.1338 + | a_beta T = (fn k => T)
13.1339 + | a_beta F = (fn k => F)
13.1340 + | a_beta (Lt (C bo)) = (fn k => Lt (C bo))
13.1341 + | a_beta (Lt (Bound bp)) = (fn k => Lt (Bound bp))
13.1342 + | a_beta (Lt (Neg bs)) = (fn k => Lt (Neg bs))
13.1343 + | a_beta (Lt (Add (bt, bu))) = (fn k => Lt (Add (bt, bu)))
13.1344 + | a_beta (Lt (Sub (bv, bw))) = (fn k => Lt (Sub (bv, bw)))
13.1345 + | a_beta (Lt (Mul (bx, by))) = (fn k => Lt (Mul (bx, by)))
13.1346 + | a_beta (Le (C ck)) = (fn k => Le (C ck))
13.1347 + | a_beta (Le (Bound cl)) = (fn k => Le (Bound cl))
13.1348 + | a_beta (Le (Neg co)) = (fn k => Le (Neg co))
13.1349 + | a_beta (Le (Add (cp, cq))) = (fn k => Le (Add (cp, cq)))
13.1350 + | a_beta (Le (Sub (cr, cs))) = (fn k => Le (Sub (cr, cs)))
13.1351 + | a_beta (Le (Mul (ct, cu))) = (fn k => Le (Mul (ct, cu)))
13.1352 + | a_beta (Gt (C dg)) = (fn k => Gt (C dg))
13.1353 + | a_beta (Gt (Bound dh)) = (fn k => Gt (Bound dh))
13.1354 + | a_beta (Gt (Neg dk)) = (fn k => Gt (Neg dk))
13.1355 + | a_beta (Gt (Add (dl, dm))) = (fn k => Gt (Add (dl, dm)))
13.1356 + | a_beta (Gt (Sub (dn, do'))) = (fn k => Gt (Sub (dn, do')))
13.1357 + | a_beta (Gt (Mul (dp, dq))) = (fn k => Gt (Mul (dp, dq)))
13.1358 + | a_beta (Ge (C ec)) = (fn k => Ge (C ec))
13.1359 + | a_beta (Ge (Bound ed)) = (fn k => Ge (Bound ed))
13.1360 + | a_beta (Ge (Neg eg)) = (fn k => Ge (Neg eg))
13.1361 + | a_beta (Ge (Add (eh, ei))) = (fn k => Ge (Add (eh, ei)))
13.1362 + | a_beta (Ge (Sub (ej, ek))) = (fn k => Ge (Sub (ej, ek)))
13.1363 + | a_beta (Ge (Mul (el, em))) = (fn k => Ge (Mul (el, em)))
13.1364 + | a_beta (Eq (C ey)) = (fn k => Eq (C ey))
13.1365 + | a_beta (Eq (Bound ez)) = (fn k => Eq (Bound ez))
13.1366 + | a_beta (Eq (Neg fc)) = (fn k => Eq (Neg fc))
13.1367 + | a_beta (Eq (Add (fd, fe))) = (fn k => Eq (Add (fd, fe)))
13.1368 + | a_beta (Eq (Sub (ff, fg))) = (fn k => Eq (Sub (ff, fg)))
13.1369 + | a_beta (Eq (Mul (fh, fi))) = (fn k => Eq (Mul (fh, fi)))
13.1370 + | a_beta (NEq (C fu)) = (fn k => NEq (C fu))
13.1371 + | a_beta (NEq (Bound fv)) = (fn k => NEq (Bound fv))
13.1372 + | a_beta (NEq (Neg fy)) = (fn k => NEq (Neg fy))
13.1373 + | a_beta (NEq (Add (fz, ga))) = (fn k => NEq (Add (fz, ga)))
13.1374 + | a_beta (NEq (Sub (gb, gc))) = (fn k => NEq (Sub (gb, gc)))
13.1375 + | a_beta (NEq (Mul (gd, ge))) = (fn k => NEq (Mul (gd, ge)))
13.1376 + | a_beta (Dvd (aa, C gq)) = (fn k => Dvd (aa, C gq))
13.1377 + | a_beta (Dvd (aa, Bound gr)) = (fn k => Dvd (aa, Bound gr))
13.1378 + | a_beta (Dvd (aa, Neg gu)) = (fn k => Dvd (aa, Neg gu))
13.1379 + | a_beta (Dvd (aa, Add (gv, gw))) = (fn k => Dvd (aa, Add (gv, gw)))
13.1380 + | a_beta (Dvd (aa, Sub (gx, gy))) = (fn k => Dvd (aa, Sub (gx, gy)))
13.1381 + | a_beta (Dvd (aa, Mul (gz, ha))) = (fn k => Dvd (aa, Mul (gz, ha)))
13.1382 + | a_beta (NDvd (ac, C hm)) = (fn k => NDvd (ac, C hm))
13.1383 + | a_beta (NDvd (ac, Bound hn)) = (fn k => NDvd (ac, Bound hn))
13.1384 + | a_beta (NDvd (ac, Neg hq)) = (fn k => NDvd (ac, Neg hq))
13.1385 + | a_beta (NDvd (ac, Add (hr, hs))) = (fn k => NDvd (ac, Add (hr, hs)))
13.1386 + | a_beta (NDvd (ac, Sub (ht, hu))) = (fn k => NDvd (ac, Sub (ht, hu)))
13.1387 + | a_beta (NDvd (ac, Mul (hv, hw))) = (fn k => NDvd (ac, Mul (hv, hw)))
13.1388 + | a_beta (NOT ae) = (fn k => NOT ae)
13.1389 + | a_beta (Imp (aj, ak)) = (fn k => Imp (aj, ak))
13.1390 + | a_beta (Iff (al, am)) = (fn k => Iff (al, am))
13.1391 + | a_beta (E an) = (fn k => E an)
13.1392 + | a_beta (A ao) = (fn k => A ao)
13.1393 + | a_beta (Closed ap) = (fn k => Closed ap)
13.1394 + | a_beta (NClosed aq) = (fn k => NClosed aq);
13.1395 +
13.1396 +fun zeta (And (p, q)) = ilcm (zeta p) (zeta q)
13.1397 + | zeta (Or (p, q)) = ilcm (zeta p) (zeta q)
13.1398 + | zeta (Eq (CX (c, e))) = c
13.1399 + | zeta (NEq (CX (c, e))) = c
13.1400 + | zeta (Lt (CX (c, e))) = c
13.1401 + | zeta (Le (CX (c, e))) = c
13.1402 + | zeta (Gt (CX (c, e))) = c
13.1403 + | zeta (Ge (CX (c, e))) = c
13.1404 + | zeta (Dvd (i, CX (c, e))) = c
13.1405 + | zeta (NDvd (i, CX (c, e))) = c
13.1406 + | zeta T = 1
13.1407 + | zeta F = 1
13.1408 + | zeta (Lt (C bo)) = 1
13.1409 + | zeta (Lt (Bound bp)) = 1
13.1410 + | zeta (Lt (Neg bs)) = 1
13.1411 + | zeta (Lt (Add (bt, bu))) = 1
13.1412 + | zeta (Lt (Sub (bv, bw))) = 1
13.1413 + | zeta (Lt (Mul (bx, by))) = 1
13.1414 + | zeta (Le (C ck)) = 1
13.1415 + | zeta (Le (Bound cl)) = 1
13.1416 + | zeta (Le (Neg co)) = 1
13.1417 + | zeta (Le (Add (cp, cq))) = 1
13.1418 + | zeta (Le (Sub (cr, cs))) = 1
13.1419 + | zeta (Le (Mul (ct, cu))) = 1
13.1420 + | zeta (Gt (C dg)) = 1
13.1421 + | zeta (Gt (Bound dh)) = 1
13.1422 + | zeta (Gt (Neg dk)) = 1
13.1423 + | zeta (Gt (Add (dl, dm))) = 1
13.1424 + | zeta (Gt (Sub (dn, do'))) = 1
13.1425 + | zeta (Gt (Mul (dp, dq))) = 1
13.1426 + | zeta (Ge (C ec)) = 1
13.1427 + | zeta (Ge (Bound ed)) = 1
13.1428 + | zeta (Ge (Neg eg)) = 1
13.1429 + | zeta (Ge (Add (eh, ei))) = 1
13.1430 + | zeta (Ge (Sub (ej, ek))) = 1
13.1431 + | zeta (Ge (Mul (el, em))) = 1
13.1432 + | zeta (Eq (C ey)) = 1
13.1433 + | zeta (Eq (Bound ez)) = 1
13.1434 + | zeta (Eq (Neg fc)) = 1
13.1435 + | zeta (Eq (Add (fd, fe))) = 1
13.1436 + | zeta (Eq (Sub (ff, fg))) = 1
13.1437 + | zeta (Eq (Mul (fh, fi))) = 1
13.1438 + | zeta (NEq (C fu)) = 1
13.1439 + | zeta (NEq (Bound fv)) = 1
13.1440 + | zeta (NEq (Neg fy)) = 1
13.1441 + | zeta (NEq (Add (fz, ga))) = 1
13.1442 + | zeta (NEq (Sub (gb, gc))) = 1
13.1443 + | zeta (NEq (Mul (gd, ge))) = 1
13.1444 + | zeta (Dvd (aa, C gq)) = 1
13.1445 + | zeta (Dvd (aa, Bound gr)) = 1
13.1446 + | zeta (Dvd (aa, Neg gu)) = 1
13.1447 + | zeta (Dvd (aa, Add (gv, gw))) = 1
13.1448 + | zeta (Dvd (aa, Sub (gx, gy))) = 1
13.1449 + | zeta (Dvd (aa, Mul (gz, ha))) = 1
13.1450 + | zeta (NDvd (ac, C hm)) = 1
13.1451 + | zeta (NDvd (ac, Bound hn)) = 1
13.1452 + | zeta (NDvd (ac, Neg hq)) = 1
13.1453 + | zeta (NDvd (ac, Add (hr, hs))) = 1
13.1454 + | zeta (NDvd (ac, Sub (ht, hu))) = 1
13.1455 + | zeta (NDvd (ac, Mul (hv, hw))) = 1
13.1456 + | zeta (NOT ae) = 1
13.1457 + | zeta (Imp (aj, ak)) = 1
13.1458 + | zeta (Iff (al, am)) = 1
13.1459 + | zeta (E an) = 1
13.1460 + | zeta (A ao) = 1
13.1461 + | zeta (Closed ap) = 1
13.1462 + | zeta (NClosed aq) = 1;
13.1463 +
13.1464 +fun split x = (fn p => x (fst p) (snd p));
13.1465 +
13.1466 +fun zsplit0 (C c) = (0, C c)
13.1467 + | zsplit0 (Bound n) = (if (n = 0) then (1, C 0) else (0, Bound n))
13.1468 + | zsplit0 (CX (i, a)) = split (fn i' => (fn x => ((i + i'), x))) (zsplit0 a)
13.1469 + | zsplit0 (Neg a) = (fn (i', a') => (~ i', Neg a')) (zsplit0 a)
13.1470 + | zsplit0 (Add (a, b)) =
13.1471 + (fn (ia, a') => (fn (ib, b') => ((ia + ib), Add (a', b'))) (zsplit0 b))
13.1472 + (zsplit0 a)
13.1473 + | zsplit0 (Sub (a, b)) =
13.1474 + (fn (ia, a') =>
13.1475 + (fn (ib, b') => (minus_def2 ia ib, Sub (a', b'))) (zsplit0 b))
13.1476 + (zsplit0 a)
13.1477 + | zsplit0 (Mul (i, a)) = (fn (i', a') => ((i * i'), Mul (i, a'))) (zsplit0 a);
13.1478 +
13.1479 +fun zlfm (And (p, q)) = And (zlfm p, zlfm q)
13.1480 + | zlfm (Or (p, q)) = Or (zlfm p, zlfm q)
13.1481 + | zlfm (Imp (p, q)) = Or (zlfm (NOT p), zlfm q)
13.1482 + | zlfm (Iff (p, q)) =
13.1483 + Or (And (zlfm p, zlfm q), And (zlfm (NOT p), zlfm (NOT q)))
13.1484 + | zlfm (Lt a) =
13.1485 + let val x = zsplit0 a
13.1486 + in (fn (c, r) =>
13.1487 + (if (c = 0) then Lt r
13.1488 + else (if (0 < c) then Lt (CX (c, r)) else Gt (CX (~ c, Neg r)))))
13.1489 + x
13.1490 + end
13.1491 + | zlfm (Le a) =
13.1492 + let val x = zsplit0 a
13.1493 + in (fn (c, r) =>
13.1494 + (if (c = 0) then Le r
13.1495 + else (if (0 < c) then Le (CX (c, r)) else Ge (CX (~ c, Neg r)))))
13.1496 + x
13.1497 + end
13.1498 + | zlfm (Gt a) =
13.1499 + let val x = zsplit0 a
13.1500 + in (fn (c, r) =>
13.1501 + (if (c = 0) then Gt r
13.1502 + else (if (0 < c) then Gt (CX (c, r)) else Lt (CX (~ c, Neg r)))))
13.1503 + x
13.1504 + end
13.1505 + | zlfm (Ge a) =
13.1506 + let val x = zsplit0 a
13.1507 + in (fn (c, r) =>
13.1508 + (if (c = 0) then Ge r
13.1509 + else (if (0 < c) then Ge (CX (c, r)) else Le (CX (~ c, Neg r)))))
13.1510 + x
13.1511 + end
13.1512 + | zlfm (Eq a) =
13.1513 + let val x = zsplit0 a
13.1514 + in (fn (c, r) =>
13.1515 + (if (c = 0) then Eq r
13.1516 + else (if (0 < c) then Eq (CX (c, r)) else Eq (CX (~ c, Neg r)))))
13.1517 + x
13.1518 + end
13.1519 + | zlfm (NEq a) =
13.1520 + let val x = zsplit0 a
13.1521 + in (fn (c, r) =>
13.1522 + (if (c = 0) then NEq r
13.1523 + else (if (0 < c) then NEq (CX (c, r)) else NEq (CX (~ c, Neg r)))))
13.1524 + x
13.1525 + end
13.1526 + | zlfm (Dvd (i, a)) =
13.1527 + (if (i = 0) then zlfm (Eq a)
13.1528 + else let val x = zsplit0 a
13.1529 + in (fn (c, r) =>
13.1530 + (if (c = 0) then Dvd (abs i, r)
13.1531 + else (if (0 < c) then Dvd (abs i, CX (c, r))
13.1532 + else Dvd (abs i, CX (~ c, Neg r)))))
13.1533 + x
13.1534 + end)
13.1535 + | zlfm (NDvd (i, a)) =
13.1536 + (if (i = 0) then zlfm (NEq a)
13.1537 + else let val x = zsplit0 a
13.1538 + in (fn (c, r) =>
13.1539 + (if (c = 0) then NDvd (abs i, r)
13.1540 + else (if (0 < c) then NDvd (abs i, CX (c, r))
13.1541 + else NDvd (abs i, CX (~ c, Neg r)))))
13.1542 + x
13.1543 + end)
13.1544 + | zlfm (NOT (And (p, q))) = Or (zlfm (NOT p), zlfm (NOT q))
13.1545 + | zlfm (NOT (Or (p, q))) = And (zlfm (NOT p), zlfm (NOT q))
13.1546 + | zlfm (NOT (Imp (p, q))) = And (zlfm p, zlfm (NOT q))
13.1547 + | zlfm (NOT (Iff (p, q))) =
13.1548 + Or (And (zlfm p, zlfm (NOT q)), And (zlfm (NOT p), zlfm q))
13.1549 + | zlfm (NOT (NOT p)) = zlfm p
13.1550 + | zlfm (NOT T) = F
13.1551 + | zlfm (NOT F) = T
13.1552 + | zlfm (NOT (Lt a)) = zlfm (Ge a)
13.1553 + | zlfm (NOT (Le a)) = zlfm (Gt a)
13.1554 + | zlfm (NOT (Gt a)) = zlfm (Le a)
13.1555 + | zlfm (NOT (Ge a)) = zlfm (Lt a)
13.1556 + | zlfm (NOT (Eq a)) = zlfm (NEq a)
13.1557 + | zlfm (NOT (NEq a)) = zlfm (Eq a)
13.1558 + | zlfm (NOT (Dvd (i, a))) = zlfm (NDvd (i, a))
13.1559 + | zlfm (NOT (NDvd (i, a))) = zlfm (Dvd (i, a))
13.1560 + | zlfm (NOT (Closed P)) = NClosed P
13.1561 + | zlfm (NOT (NClosed P)) = Closed P
13.1562 + | zlfm T = T
13.1563 + | zlfm F = F
13.1564 + | zlfm (NOT (E ci)) = NOT (E ci)
13.1565 + | zlfm (NOT (A cj)) = NOT (A cj)
13.1566 + | zlfm (E ao) = E ao
13.1567 + | zlfm (A ap) = A ap
13.1568 + | zlfm (Closed aq) = Closed aq
13.1569 + | zlfm (NClosed ar) = NClosed ar;
13.1570 +
13.1571 +fun unit p =
13.1572 + let val p' = zlfm p; val l = zeta p';
13.1573 + val q = And (Dvd (l, CX (1, C 0)), a_beta p' l); val d = delta q;
13.1574 + val B = remdups (map simpnum (beta q));
13.1575 + val a = remdups (map simpnum (alpha q))
13.1576 + in (if less_eq_def3 (size_def9 B) (size_def9 a) then (q, (B, d))
13.1577 + else (mirror q, (a, d)))
13.1578 + end;
13.1579 +
13.1580 +fun cooper p =
13.1581 + let val (q, (B, d)) = unit p; val js = iupt (1, d);
13.1582 + val mq = simpfm (minusinf q);
13.1583 + val md = evaldjf (fn j => simpfm (subst0 (C j) mq)) js
13.1584 + in (if (md = T) then T
13.1585 + else let val qd =
13.1586 + evaldjf (fn (b, j) => simpfm (subst0 (Add (b, C j)) q))
13.1587 + (allpairs (fn x => fn xa => (x, xa)) B js)
13.1588 + in decr (disj md qd) end)
13.1589 + end;
13.1590 +
13.1591 +fun prep (E T) = T
13.1592 + | prep (E F) = F
13.1593 + | prep (E (Or (p, q))) = Or (prep (E p), prep (E q))
13.1594 + | prep (E (Imp (p, q))) = Or (prep (E (NOT p)), prep (E q))
13.1595 + | prep (E (Iff (p, q))) =
13.1596 + Or (prep (E (And (p, q))), prep (E (And (NOT p, NOT q))))
13.1597 + | prep (E (NOT (And (p, q)))) = Or (prep (E (NOT p)), prep (E (NOT q)))
13.1598 + | prep (E (NOT (Imp (p, q)))) = prep (E (And (p, NOT q)))
13.1599 + | prep (E (NOT (Iff (p, q)))) =
13.1600 + Or (prep (E (And (p, NOT q))), prep (E (And (NOT p, q))))
13.1601 + | prep (E (Lt ef)) = E (prep (Lt ef))
13.1602 + | prep (E (Le eg)) = E (prep (Le eg))
13.1603 + | prep (E (Gt eh)) = E (prep (Gt eh))
13.1604 + | prep (E (Ge ei)) = E (prep (Ge ei))
13.1605 + | prep (E (Eq ej)) = E (prep (Eq ej))
13.1606 + | prep (E (NEq ek)) = E (prep (NEq ek))
13.1607 + | prep (E (Dvd (el, em))) = E (prep (Dvd (el, em)))
13.1608 + | prep (E (NDvd (en, eo))) = E (prep (NDvd (en, eo)))
13.1609 + | prep (E (NOT T)) = E (prep (NOT T))
13.1610 + | prep (E (NOT F)) = E (prep (NOT F))
13.1611 + | prep (E (NOT (Lt gw))) = E (prep (NOT (Lt gw)))
13.1612 + | prep (E (NOT (Le gx))) = E (prep (NOT (Le gx)))
13.1613 + | prep (E (NOT (Gt gy))) = E (prep (NOT (Gt gy)))
13.1614 + | prep (E (NOT (Ge gz))) = E (prep (NOT (Ge gz)))
13.1615 + | prep (E (NOT (Eq ha))) = E (prep (NOT (Eq ha)))
13.1616 + | prep (E (NOT (NEq hb))) = E (prep (NOT (NEq hb)))
13.1617 + | prep (E (NOT (Dvd (hc, hd)))) = E (prep (NOT (Dvd (hc, hd))))
13.1618 + | prep (E (NOT (NDvd (he, hf)))) = E (prep (NOT (NDvd (he, hf))))
13.1619 + | prep (E (NOT (NOT hg))) = E (prep (NOT (NOT hg)))
13.1620 + | prep (E (NOT (Or (hj, hk)))) = E (prep (NOT (Or (hj, hk))))
13.1621 + | prep (E (NOT (E hp))) = E (prep (NOT (E hp)))
13.1622 + | prep (E (NOT (A hq))) = E (prep (NOT (A hq)))
13.1623 + | prep (E (NOT (Closed hr))) = E (prep (NOT (Closed hr)))
13.1624 + | prep (E (NOT (NClosed hs))) = E (prep (NOT (NClosed hs)))
13.1625 + | prep (E (And (eq, er))) = E (prep (And (eq, er)))
13.1626 + | prep (E (E ey)) = E (prep (E ey))
13.1627 + | prep (E (A ez)) = E (prep (A ez))
13.1628 + | prep (E (Closed fa)) = E (prep (Closed fa))
13.1629 + | prep (E (NClosed fb)) = E (prep (NClosed fb))
13.1630 + | prep (A (And (p, q))) = And (prep (A p), prep (A q))
13.1631 + | prep (A T) = prep (NOT (E (NOT T)))
13.1632 + | prep (A F) = prep (NOT (E (NOT F)))
13.1633 + | prep (A (Lt jn)) = prep (NOT (E (NOT (Lt jn))))
13.1634 + | prep (A (Le jo)) = prep (NOT (E (NOT (Le jo))))
13.1635 + | prep (A (Gt jp)) = prep (NOT (E (NOT (Gt jp))))
13.1636 + | prep (A (Ge jq)) = prep (NOT (E (NOT (Ge jq))))
13.1637 + | prep (A (Eq jr)) = prep (NOT (E (NOT (Eq jr))))
13.1638 + | prep (A (NEq js)) = prep (NOT (E (NOT (NEq js))))
13.1639 + | prep (A (Dvd (jt, ju))) = prep (NOT (E (NOT (Dvd (jt, ju)))))
13.1640 + | prep (A (NDvd (jv, jw))) = prep (NOT (E (NOT (NDvd (jv, jw)))))
13.1641 + | prep (A (NOT jx)) = prep (NOT (E (NOT (NOT jx))))
13.1642 + | prep (A (Or (ka, kb))) = prep (NOT (E (NOT (Or (ka, kb)))))
13.1643 + | prep (A (Imp (kc, kd))) = prep (NOT (E (NOT (Imp (kc, kd)))))
13.1644 + | prep (A (Iff (ke, kf))) = prep (NOT (E (NOT (Iff (ke, kf)))))
13.1645 + | prep (A (E kg)) = prep (NOT (E (NOT (E kg))))
13.1646 + | prep (A (A kh)) = prep (NOT (E (NOT (A kh))))
13.1647 + | prep (A (Closed ki)) = prep (NOT (E (NOT (Closed ki))))
13.1648 + | prep (A (NClosed kj)) = prep (NOT (E (NOT (NClosed kj))))
13.1649 + | prep (NOT (NOT p)) = prep p
13.1650 + | prep (NOT (And (p, q))) = Or (prep (NOT p), prep (NOT q))
13.1651 + | prep (NOT (A p)) = prep (E (NOT p))
13.1652 + | prep (NOT (Or (p, q))) = And (prep (NOT p), prep (NOT q))
13.1653 + | prep (NOT (Imp (p, q))) = And (prep p, prep (NOT q))
13.1654 + | prep (NOT (Iff (p, q))) = Or (prep (And (p, NOT q)), prep (And (NOT p, q)))
13.1655 + | prep (NOT T) = NOT (prep T)
13.1656 + | prep (NOT F) = NOT (prep F)
13.1657 + | prep (NOT (Lt bo)) = NOT (prep (Lt bo))
13.1658 + | prep (NOT (Le bp)) = NOT (prep (Le bp))
13.1659 + | prep (NOT (Gt bq)) = NOT (prep (Gt bq))
13.1660 + | prep (NOT (Ge br)) = NOT (prep (Ge br))
13.1661 + | prep (NOT (Eq bs)) = NOT (prep (Eq bs))
13.1662 + | prep (NOT (NEq bt)) = NOT (prep (NEq bt))
13.1663 + | prep (NOT (Dvd (bu, bv))) = NOT (prep (Dvd (bu, bv)))
13.1664 + | prep (NOT (NDvd (bw, bx))) = NOT (prep (NDvd (bw, bx)))
13.1665 + | prep (NOT (E ch)) = NOT (prep (E ch))
13.1666 + | prep (NOT (Closed cj)) = NOT (prep (Closed cj))
13.1667 + | prep (NOT (NClosed ck)) = NOT (prep (NClosed ck))
13.1668 + | prep (Or (p, q)) = Or (prep p, prep q)
13.1669 + | prep (And (p, q)) = And (prep p, prep q)
13.1670 + | prep (Imp (p, q)) = prep (Or (NOT p, q))
13.1671 + | prep (Iff (p, q)) = Or (prep (And (p, q)), prep (And (NOT p, NOT q)))
13.1672 + | prep T = T
13.1673 + | prep F = F
13.1674 + | prep (Lt u) = Lt u
13.1675 + | prep (Le v) = Le v
13.1676 + | prep (Gt w) = Gt w
13.1677 + | prep (Ge x) = Ge x
13.1678 + | prep (Eq y) = Eq y
13.1679 + | prep (NEq z) = NEq z
13.1680 + | prep (Dvd (aa, ab)) = Dvd (aa, ab)
13.1681 + | prep (NDvd (ac, ad)) = NDvd (ac, ad)
13.1682 + | prep (Closed ap) = Closed ap
13.1683 + | prep (NClosed aq) = NClosed aq;
13.1684 +
13.1685 +fun pa x = qelim (prep x) cooper;
13.1686 +
13.1687 +val pa = (fn x => pa x);
13.1688 +
13.1689 +val test =
13.1690 + (fn x =>
13.1691 + pa (E (A (Imp (Ge (Sub (Bound 0, Bound one_def0)),
13.1692 + E (E (Eq (Sub (Add (Mul (3, Bound one_def0),
13.1693 + Mul (5, Bound 0)),
13.1694 + Bound (nat 2))))))))));
13.1695 +
13.1696 +end;
14.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
14.2 +++ b/src/HOL/Tools/Qelim/presburger.ML Thu Jun 21 20:48:48 2007 +0200
14.3 @@ -0,0 +1,201 @@
14.4 +
14.5 +(* Title: HOL/Tools/Presburger/presburger.ML
14.6 + ID: $Id$
14.7 + Author: Amine Chaieb, TU Muenchen
14.8 +*)
14.9 +
14.10 +signature PRESBURGER =
14.11 + sig
14.12 + val cooper_tac: bool -> thm list -> thm list -> Proof.context -> int -> Tactical.tactic
14.13 +end;
14.14 +
14.15 +structure Presburger : PRESBURGER =
14.16 +struct
14.17 +
14.18 +open Conv;
14.19 +val comp_ss = HOL_ss addsimps @{thms "Groebner_Basis.comp_arith"};
14.20 +
14.21 +fun strip_imp_cprems ct =
14.22 + case term_of ct of
14.23 + Const ("==>", _) $ _ $ _ => Thm.dest_arg1 ct :: strip_imp_cprems (Thm.dest_arg ct)
14.24 +| _ => [];
14.25 +
14.26 +val cprems_of = strip_imp_cprems o cprop_of;
14.27 +
14.28 +fun strip_objimp ct =
14.29 + case term_of ct of
14.30 + Const ("op -->", _) $ _ $ _ => Thm.dest_arg1 ct :: strip_objimp (Thm.dest_arg ct)
14.31 +| _ => [ct];
14.32 +
14.33 +fun strip_objall ct =
14.34 + case term_of ct of
14.35 + Const ("All", _) $ Abs (xn,xT,p) =>
14.36 + let val (a,(v,t')) = (apsnd (Thm.dest_abs (SOME xn)) o Thm.dest_comb) ct
14.37 + in apfst (cons (a,v)) (strip_objall t')
14.38 + end
14.39 +| _ => ([],ct);
14.40 +
14.41 +local
14.42 + val all_maxscope_ss =
14.43 + HOL_basic_ss addsimps map (fn th => th RS sym) @{thms "all_simps"}
14.44 +in
14.45 +fun thin_prems_tac P i = simp_tac all_maxscope_ss i THEN
14.46 + (fn st => case try (nth (cprems_of st)) (i - 1) of
14.47 + NONE => no_tac st
14.48 + | SOME p' =>
14.49 + let
14.50 + val (qvs, p) = strip_objall (Thm.dest_arg p')
14.51 + val (ps, c) = split_last (strip_objimp p)
14.52 + val qs = filter P ps
14.53 + val q = if P c then c else @{cterm "False"}
14.54 + val ng = fold_rev (fn (a,v) => fn t => Thm.capply a (Thm.cabs v t)) qvs
14.55 + (fold_rev (fn p => fn q => Thm.capply (Thm.capply @{cterm "op -->"} p) q) qs q)
14.56 + val g = Thm.capply (Thm.capply @{cterm "op ==>"} (Thm.capply @{cterm "Trueprop"} ng)) p'
14.57 + val ntac = (case qs of [] => q aconvc @{cterm "False"}
14.58 + | _ => false)
14.59 + in
14.60 + if ntac then no_tac st
14.61 + else rtac (Goal.prove_internal [] g (K (blast_tac HOL_cs 1))) i st
14.62 + end)
14.63 +end;
14.64 +
14.65 +local
14.66 + fun ty cts t =
14.67 + if not (typ_of (ctyp_of_term t) mem [HOLogic.intT, HOLogic.natT]) then false
14.68 + else case term_of t of
14.69 + c$_$_ => not (member (op aconv) cts c)
14.70 + | c$_ => not (member (op aconv) cts c)
14.71 + | c => not (member (op aconv) cts c)
14.72 + | _ => true
14.73 +
14.74 + val term_constants =
14.75 + let fun h acc t = case t of
14.76 + Const _ => insert (op aconv) t acc
14.77 + | a$b => h (h acc a) b
14.78 + | Abs (_,_,t) => h acc t
14.79 + | _ => acc
14.80 + in h [] end;
14.81 +in
14.82 +fun is_relevant ctxt ct =
14.83 + gen_subset (op aconv) (term_constants (term_of ct) , snd (CooperData.get ctxt))
14.84 + andalso forall (fn Free (_,T) => T = HOLogic.intT) (term_frees (term_of ct))
14.85 + andalso forall (fn Var (_,T) => T = HOLogic.intT) (term_vars (term_of ct));
14.86 +
14.87 +fun int_nat_terms ctxt ct =
14.88 + let
14.89 + val cts = snd (CooperData.get ctxt)
14.90 + fun h acc t = if ty cts t then insert (op aconvc) t acc else
14.91 + case (term_of t) of
14.92 + _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
14.93 + | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
14.94 + | _ => acc
14.95 + in h [] ct end
14.96 +end;
14.97 +
14.98 +fun generalize_tac ctxt f i st =
14.99 + case try (nth (cprems_of st)) (i - 1) of
14.100 + NONE => all_tac st
14.101 + | SOME p =>
14.102 + let
14.103 + fun all T = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "all"}
14.104 + fun gen x t = Thm.capply (all (ctyp_of_term x)) (Thm.cabs x t)
14.105 + val ts = sort (fn (a,b) => Term.fast_term_ord (term_of a, term_of b)) (f p)
14.106 + val p' = fold_rev gen ts p
14.107 + in Seq.of_list [implies_intr p' (implies_elim st (fold forall_elim ts (assume p')))]
14.108 + end;
14.109 +
14.110 +local
14.111 +val ss1 = comp_ss
14.112 + addsimps simp_thms @ [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}]
14.113 + @ map (fn r => r RS sym)
14.114 + [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"},
14.115 + @{thm "zmult_int"}]
14.116 + addsplits [@{thm "zdiff_int_split"}]
14.117 +
14.118 +val ss2 = HOL_basic_ss
14.119 + addsimps [@{thm "nat_0_le"}, @{thm "int_nat_number_of"},
14.120 + @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"},
14.121 + @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}, @{thm "Suc_plus1"}]
14.122 + addcongs [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
14.123 +val div_mod_ss = HOL_basic_ss addsimps simp_thms
14.124 + @ map (symmetric o mk_meta_eq)
14.125 + [@{thm "dvd_eq_mod_eq_0"}, @{thm "zdvd_iff_zmod_eq_0"}, mod_add1_eq,
14.126 + mod_add_left_eq, mod_add_right_eq,
14.127 + @{thm "zmod_zadd1_eq"}, @{thm "zmod_zadd_left_eq"},
14.128 + @{thm "zmod_zadd_right_eq"}, @{thm "div_add1_eq"}, @{thm "zdiv_zadd1_eq"}]
14.129 + @ [@{thm "mod_self"}, @{thm "zmod_self"}, @{thm "DIVISION_BY_ZERO_MOD"},
14.130 + @{thm "DIVISION_BY_ZERO_DIV"}, @{thm "DIVISION_BY_ZERO"} RS conjunct1,
14.131 + @{thm "DIVISION_BY_ZERO"} RS conjunct2, @{thm "zdiv_zero"}, @{thm "zmod_zero"},
14.132 + @{thm "div_0"}, @{thm "mod_0"}, @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"},
14.133 + @{thm "mod_1"}, @{thm "Suc_plus1"}]
14.134 + @ add_ac
14.135 + addsimprocs [cancel_div_mod_proc]
14.136 + val splits_ss = comp_ss addsimps [@{thm "mod_div_equality'"}] addsplits
14.137 + [@{thm "split_zdiv"}, @{thm "split_zmod"}, @{thm "split_div'"},
14.138 + @{thm "split_min"}, @{thm "split_max"}, @{thm "abs_split"}]
14.139 +in
14.140 +fun nat_to_int_tac ctxt i =
14.141 + simp_tac (Simplifier.context ctxt ss1) i THEN
14.142 + simp_tac (Simplifier.context ctxt ss2) i THEN
14.143 + TRY (simp_tac (Simplifier.context ctxt comp_ss) i);
14.144 +
14.145 +fun div_mod_tac ctxt i = simp_tac (Simplifier.context ctxt div_mod_ss) i;
14.146 +fun splits_tac ctxt i = simp_tac (Simplifier.context ctxt splits_ss) i;
14.147 +end;
14.148 +
14.149 +
14.150 +fun eta_beta_tac ctxt i st = case try (nth (cprems_of st)) (i - 1) of
14.151 + NONE => no_tac st
14.152 + | SOME p =>
14.153 + let
14.154 + val eq = (eta_conv (ProofContext.theory_of ctxt) then_conv Thm.beta_conversion true) p
14.155 + val p' = Thm.rhs_of eq
14.156 + val th = implies_intr p' (equal_elim (symmetric eq) (assume p'))
14.157 + in rtac th i st
14.158 + end;
14.159 +
14.160 +
14.161 +
14.162 +fun core_cooper_tac ctxt i st =
14.163 + case try (nth (cprems_of st)) (i - 1) of
14.164 + NONE => all_tac st
14.165 + | SOME p =>
14.166 + let
14.167 + val cpth =
14.168 + if !quick_and_dirty
14.169 + then linzqe_oracle (ProofContext.theory_of ctxt)
14.170 + (Envir.beta_norm (Pattern.eta_long [] (term_of (Thm.dest_arg p))))
14.171 + else arg_conv (Cooper.cooper_conv ctxt) p
14.172 + val p' = Thm.rhs_of cpth
14.173 + val th = implies_intr p' (equal_elim (symmetric cpth) (assume p'))
14.174 + in rtac th i st end
14.175 + handle Cooper.COOPER _ => no_tac st;
14.176 +
14.177 +fun nogoal_tac i st = case try (nth (cprems_of st)) (i - 1) of
14.178 + NONE => no_tac st
14.179 + | SOME _ => all_tac st
14.180 +
14.181 +fun finish_tac q i st = case try (nth (cprems_of st)) (i - 1) of
14.182 + NONE => all_tac st
14.183 + | SOME _ => (if q then I else TRY) (rtac TrueI i) st
14.184 +
14.185 +fun cooper_tac elim add_ths del_ths ctxt i =
14.186 +let val ss = fst (CooperData.get ctxt) delsimps del_ths addsimps add_ths
14.187 +in
14.188 +nogoal_tac i
14.189 +THEN (EVERY o (map TRY))
14.190 + [ObjectLogic.full_atomize_tac i,
14.191 + eta_beta_tac ctxt i,
14.192 + simp_tac ss i,
14.193 + generalize_tac ctxt (int_nat_terms ctxt) i,
14.194 + ObjectLogic.full_atomize_tac i,
14.195 + div_mod_tac ctxt i,
14.196 + splits_tac ctxt i,
14.197 + simp_tac ss i,
14.198 + eta_beta_tac ctxt i,
14.199 + nat_to_int_tac ctxt i,
14.200 + thin_prems_tac (is_relevant ctxt) i]
14.201 +THEN core_cooper_tac ctxt i THEN finish_tac elim i
14.202 +end;
14.203 +
14.204 +end;
15.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
15.2 +++ b/src/HOL/Tools/Qelim/qelim.ML Thu Jun 21 20:48:48 2007 +0200
15.3 @@ -0,0 +1,76 @@
15.4 +(*
15.5 + ID: $Id$
15.6 + Author: Amine Chaieb and Tobias Nipkow, TU Muenchen
15.7 +
15.8 +File containing the implementation of the proof protocoling
15.9 +and proof generation for multiple quantified formulae.
15.10 +*)
15.11 +
15.12 +signature QELIM =
15.13 +sig
15.14 + val standard_qelim_conv: Proof.context -> (cterm list -> cterm -> thm) ->
15.15 + (cterm list -> Conv.conv) -> (cterm list -> cterm -> thm) -> cterm -> thm
15.16 + val gen_qelim_conv: Proof.context -> Conv.conv -> Conv.conv -> Conv.conv ->
15.17 + (cterm -> 'a -> 'a) -> 'a -> ('a -> cterm -> thm) ->
15.18 + ('a -> Conv.conv) -> ('a -> cterm -> thm) -> Conv.conv
15.19 +end;
15.20 +
15.21 +structure Qelim : QELIM =
15.22 +struct
15.23 +
15.24 +open Conv;
15.25 +
15.26 +local
15.27 + val all_not_ex = mk_meta_eq @{thm "all_not_ex"}
15.28 +in
15.29 +fun gen_qelim_conv ctxt precv postcv simpex_conv ins env atcv ncv qcv =
15.30 + let
15.31 + val thy = ProofContext.theory_of ctxt
15.32 + fun conv env p =
15.33 + case (term_of p) of
15.34 + Const(s,T)$_$_ => if domain_type T = HOLogic.boolT
15.35 + andalso s mem ["op &","op |","op -->","op ="]
15.36 + then binop_conv (conv env) p else atcv env p
15.37 + | Const("Not",_)$_ => arg_conv (conv env) p
15.38 + | Const("Ex",_)$Abs(s,_,_) =>
15.39 + let
15.40 + val (e,p0) = Thm.dest_comb p
15.41 + val (x,p') = Thm.dest_abs (SOME s) p0
15.42 + val env' = ins x env
15.43 + val th = Thm.abstract_rule s x ((conv env' then_conv ncv env') p')
15.44 + |> Drule.arg_cong_rule e
15.45 + val th' = simpex_conv (Thm.rhs_of th)
15.46 + val (l,r) = Thm.dest_equals (cprop_of th')
15.47 + in if is_refl th' then Thm.transitive th (qcv env (Thm.rhs_of th))
15.48 + else Thm.transitive (Thm.transitive th th') (conv env r) end
15.49 + | Const("Ex",_)$ _ => (eta_conv thy then_conv conv env) p
15.50 + | Const("All",_)$_ =>
15.51 + let
15.52 + val p = Thm.dest_arg p
15.53 + val ([(_,T)],[]) = Thm.match (@{cpat "All"}, Thm.dest_fun p)
15.54 + val th = instantiate' [SOME T] [SOME p] all_not_ex
15.55 + in transitive th (conv env (Thm.rhs_of th))
15.56 + end
15.57 + | _ => atcv env p
15.58 + in precv then_conv (conv env) then_conv postcv end
15.59 +end;
15.60 +
15.61 +fun cterm_frees ct =
15.62 + let fun h acc t =
15.63 + case (term_of t) of
15.64 + _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
15.65 + | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
15.66 + | Free _ => insert (op aconvc) t acc
15.67 + | _ => acc
15.68 + in h [] ct end;
15.69 +
15.70 +local
15.71 +val pcv = Simplifier.rewrite
15.72 + (HOL_basic_ss addsimps (simp_thms @ ex_simps @ all_simps)
15.73 + @ [@{thm "all_not_ex"}, not_all,ex_disj_distrib])
15.74 +in
15.75 +fun standard_qelim_conv ctxt atcv ncv qcv p =
15.76 + gen_qelim_conv ctxt pcv pcv pcv cons (cterm_frees p) atcv ncv qcv p
15.77 +end;
15.78 +
15.79 +end;
16.1 --- a/src/HOL/Tools/qelim.ML Thu Jun 21 20:48:47 2007 +0200
16.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
16.3 @@ -1,76 +0,0 @@
16.4 -(*
16.5 - ID: $Id$
16.6 - Author: Amine Chaieb and Tobias Nipkow, TU Muenchen
16.7 -
16.8 -File containing the implementation of the proof protocoling
16.9 -and proof generation for multiple quantified formulae.
16.10 -*)
16.11 -
16.12 -signature QELIM =
16.13 -sig
16.14 - val standard_qelim_conv: Proof.context -> (cterm list -> cterm -> thm) ->
16.15 - (cterm list -> Conv.conv) -> (cterm list -> cterm -> thm) -> cterm -> thm
16.16 - val gen_qelim_conv: Proof.context -> Conv.conv -> Conv.conv -> Conv.conv ->
16.17 - (cterm -> 'a -> 'a) -> 'a -> ('a -> cterm -> thm) ->
16.18 - ('a -> Conv.conv) -> ('a -> cterm -> thm) -> Conv.conv
16.19 -end;
16.20 -
16.21 -structure Qelim : QELIM =
16.22 -struct
16.23 -
16.24 -open Conv;
16.25 -
16.26 -local
16.27 - val all_not_ex = mk_meta_eq @{thm "all_not_ex"}
16.28 -in
16.29 -fun gen_qelim_conv ctxt precv postcv simpex_conv ins env atcv ncv qcv =
16.30 - let
16.31 - val thy = ProofContext.theory_of ctxt
16.32 - fun conv env p =
16.33 - case (term_of p) of
16.34 - Const(s,T)$_$_ => if domain_type T = HOLogic.boolT
16.35 - andalso s mem ["op &","op |","op -->","op ="]
16.36 - then binop_conv (conv env) p else atcv env p
16.37 - | Const("Not",_)$_ => arg_conv (conv env) p
16.38 - | Const("Ex",_)$Abs(s,_,_) =>
16.39 - let
16.40 - val (e,p0) = Thm.dest_comb p
16.41 - val (x,p') = Thm.dest_abs (SOME s) p0
16.42 - val env' = ins x env
16.43 - val th = Thm.abstract_rule s x ((conv env' then_conv ncv env') p')
16.44 - |> Drule.arg_cong_rule e
16.45 - val th' = simpex_conv (Thm.rhs_of th)
16.46 - val (l,r) = Thm.dest_equals (cprop_of th')
16.47 - in if is_refl th' then Thm.transitive th (qcv env (Thm.rhs_of th))
16.48 - else Thm.transitive (Thm.transitive th th') (conv env r) end
16.49 - | Const("Ex",_)$ _ => (eta_conv thy then_conv conv env) p
16.50 - | Const("All",_)$_ =>
16.51 - let
16.52 - val p = Thm.dest_arg p
16.53 - val ([(_,T)],[]) = Thm.match (@{cpat "All"}, Thm.dest_fun p)
16.54 - val th = instantiate' [SOME T] [SOME p] all_not_ex
16.55 - in transitive th (conv env (Thm.rhs_of th))
16.56 - end
16.57 - | _ => atcv env p
16.58 - in precv then_conv (conv env) then_conv postcv end
16.59 -end;
16.60 -
16.61 -fun cterm_frees ct =
16.62 - let fun h acc t =
16.63 - case (term_of t) of
16.64 - _$_ => h (h acc (Thm.dest_arg t)) (Thm.dest_fun t)
16.65 - | Abs(_,_,_) => Thm.dest_abs NONE t ||> h acc |> uncurry (remove (op aconvc))
16.66 - | Free _ => insert (op aconvc) t acc
16.67 - | _ => acc
16.68 - in h [] ct end;
16.69 -
16.70 -local
16.71 -val pcv = Simplifier.rewrite
16.72 - (HOL_basic_ss addsimps (simp_thms @ ex_simps @ all_simps)
16.73 - @ [@{thm "all_not_ex"}, not_all,ex_disj_distrib])
16.74 -in
16.75 -fun standard_qelim_conv ctxt atcv ncv qcv p =
16.76 - gen_qelim_conv ctxt pcv pcv pcv cons (cterm_frees p) atcv ncv qcv p
16.77 -end;
16.78 -
16.79 -end;