| author | tsewell@rubicon.NSW.bigpond.net.au | 
| Thu, 27 Aug 2009 00:40:53 +1000 | |
| changeset 32743 | c4e9a48bc50e | 
| parent 29939 | 2138ff0ec94a | 
| child 36528 | 48c35032d060 | 
| permissions | -rw-r--r-- | 
| 24584 | 1 | (* Title: HOL/Tools/Qelim/generated_cooper.ML | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 2 | |
| 29823 
0ab754d13ccd
session Reflecion renamed to Decision_Procs, moved Dense_Linear_Order there
 haftmann parents: 
29787diff
changeset | 3 | This file is generated from HOL/Decision_Procs/Cooper.thy. DO NOT EDIT. | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 4 | *) | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 5 | |
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 6 | structure GeneratedCooper = | 
| 23466 | 7 | struct | 
| 8 | ||
| 23714 | 9 | type 'a eq = {eq : 'a -> 'a -> bool};
 | 
| 10 | fun eq (A_:'a eq) = #eq A_; | |
| 23466 | 11 | |
| 29787 | 12 | val eq_nat = {eq = (fn a => fn b => ((a : IntInf.int) = b))} : IntInf.int eq;
 | 
| 13 | ||
| 14 | fun eqop A_ a b = eq A_ a b; | |
| 15 | ||
| 16 | fun divmod n m = (if eqop eq_nat m 0 then (0, n) else IntInf.divMod (n, m)); | |
| 17 | ||
| 29939 | 18 | fun snd (a, b) = b; | 
| 29787 | 19 | |
| 20 | fun mod_nat m n = snd (divmod m n); | |
| 21 | ||
| 22 | fun gcd m n = (if eqop eq_nat n 0 then m else gcd n (mod_nat m n)); | |
| 23 | ||
| 29939 | 24 | fun fst (a, b) = a; | 
| 29787 | 25 | |
| 26 | fun div_nat m n = fst (divmod m n); | |
| 27 | ||
| 28 | fun lcm m n = div_nat (IntInf.* (m, n)) (gcd m n); | |
| 29 | ||
| 30 | fun leta s f = f s; | |
| 31 | ||
| 32 | fun suc n = IntInf.+ (n, 1); | |
| 33 | ||
| 34 | datatype num = Mul of IntInf.int * num | Sub of num * num | Add of num * num | | |
| 35 | Neg of num | Cn of IntInf.int * IntInf.int * num | Bound of IntInf.int | | |
| 36 | C of IntInf.int; | |
| 37 | ||
| 38 | datatype fm = NClosed of IntInf.int | Closed of IntInf.int | A of fm | E of fm | | |
| 39 | Iff of fm * fm | Imp of fm * fm | Or of fm * fm | And of fm * fm | Not of fm | | |
| 40 | NDvd of IntInf.int * num | Dvd of IntInf.int * num | NEq of num | Eq of num | | |
| 41 | Ge of num | Gt of num | Le of num | Lt of num | F | T; | |
| 42 | ||
| 43 | fun abs_int i = (if IntInf.< (i, (0 : IntInf.int)) then IntInf.~ i else i); | |
| 44 | ||
| 45 | fun zlcm i j = | |
| 46 | (lcm (IntInf.max (0, (abs_int i))) (IntInf.max (0, (abs_int j)))); | |
| 47 | ||
| 48 | fun map f [] = [] | |
| 49 | | map f (x :: xs) = f x :: map f xs; | |
| 50 | ||
| 29939 | 51 | fun append [] ys = ys | 
| 29787 | 52 | | append (x :: xs) ys = x :: append xs ys; | 
| 53 | ||
| 54 | fun disjuncts (Or (p, q)) = append (disjuncts p) (disjuncts q) | |
| 55 | | disjuncts F = [] | |
| 56 | | disjuncts T = [T] | |
| 57 | | disjuncts (Lt u) = [Lt u] | |
| 58 | | disjuncts (Le v) = [Le v] | |
| 59 | | disjuncts (Gt w) = [Gt w] | |
| 60 | | disjuncts (Ge x) = [Ge x] | |
| 61 | | disjuncts (Eq y) = [Eq y] | |
| 62 | | disjuncts (NEq z) = [NEq z] | |
| 63 | | disjuncts (Dvd (aa, ab)) = [Dvd (aa, ab)] | |
| 64 | | disjuncts (NDvd (ac, ad)) = [NDvd (ac, ad)] | |
| 65 | | disjuncts (Not ae) = [Not ae] | |
| 66 | | disjuncts (And (af, ag)) = [And (af, ag)] | |
| 67 | | disjuncts (Imp (aj, ak)) = [Imp (aj, ak)] | |
| 68 | | disjuncts (Iff (al, am)) = [Iff (al, am)] | |
| 69 | | disjuncts (E an) = [E an] | |
| 70 | | disjuncts (A ao) = [A ao] | |
| 71 | | disjuncts (Closed ap) = [Closed ap] | |
| 72 | | disjuncts (NClosed aq) = [NClosed aq]; | |
| 73 | ||
| 74 | fun fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 75 | (NClosed nat) = f19 nat | |
| 76 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 77 | (Closed nat) = f18 nat | |
| 78 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 79 | (A fm) = f17 fm | |
| 80 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 81 | (E fm) = f16 fm | |
| 82 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 83 | (Iff (fm1, fm2)) = f15 fm1 fm2 | |
| 84 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 85 | (Imp (fm1, fm2)) = f14 fm1 fm2 | |
| 86 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 87 | (Or (fm1, fm2)) = f13 fm1 fm2 | |
| 88 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 89 | (And (fm1, fm2)) = f12 fm1 fm2 | |
| 90 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 91 | (Not fm) = f11 fm | |
| 92 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 93 | (NDvd (inta, num)) = f10 inta num | |
| 94 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 95 | (Dvd (inta, num)) = f9 inta num | |
| 96 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 97 | (NEq num) = f8 num | |
| 98 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 99 | (Eq num) = f7 num | |
| 100 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 101 | (Ge num) = f6 num | |
| 102 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 103 | (Gt num) = f5 num | |
| 104 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 105 | (Le num) = f4 num | |
| 106 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 | |
| 107 | (Lt num) = f3 num | |
| 29939 | 108 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 F | 
| 109 | = f2 | |
| 110 | | fm_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 T | |
| 111 | = f1; | |
| 29787 | 112 | |
| 29939 | 113 | fun eq_num (Mul (c, d)) (Sub (a, b)) = false | 
| 114 | | eq_num (Mul (c, d)) (Add (a, b)) = false | |
| 115 | | eq_num (Sub (c, d)) (Add (a, b)) = false | |
| 116 | | eq_num (Mul (b, c)) (Neg a) = false | |
| 117 | | eq_num (Sub (b, c)) (Neg a) = false | |
| 118 | | eq_num (Add (b, c)) (Neg a) = false | |
| 119 | | eq_num (Mul (d, e)) (Cn (a, b, c)) = false | |
| 120 | | eq_num (Sub (d, e)) (Cn (a, b, c)) = false | |
| 121 | | eq_num (Add (d, e)) (Cn (a, b, c)) = false | |
| 122 | | eq_num (Neg d) (Cn (a, b, c)) = false | |
| 123 | | eq_num (Mul (b, c)) (Bound a) = false | |
| 124 | | eq_num (Sub (b, c)) (Bound a) = false | |
| 125 | | eq_num (Add (b, c)) (Bound a) = false | |
| 126 | | eq_num (Neg b) (Bound a) = false | |
| 127 | | eq_num (Cn (b, c, d)) (Bound a) = false | |
| 128 | | eq_num (Mul (b, c)) (C a) = false | |
| 129 | | eq_num (Sub (b, c)) (C a) = false | |
| 130 | | eq_num (Add (b, c)) (C a) = false | |
| 131 | | eq_num (Neg b) (C a) = false | |
| 132 | | eq_num (Cn (b, c, d)) (C a) = false | |
| 133 | | eq_num (Bound b) (C a) = false | |
| 134 | | eq_num (Sub (a, b)) (Mul (c, d)) = false | |
| 135 | | eq_num (Add (a, b)) (Mul (c, d)) = false | |
| 136 | | eq_num (Add (a, b)) (Sub (c, d)) = false | |
| 137 | | eq_num (Neg a) (Mul (b, c)) = false | |
| 138 | | eq_num (Neg a) (Sub (b, c)) = false | |
| 139 | | eq_num (Neg a) (Add (b, c)) = false | |
| 140 | | eq_num (Cn (a, b, c)) (Mul (d, e)) = false | |
| 141 | | eq_num (Cn (a, b, c)) (Sub (d, e)) = false | |
| 142 | | eq_num (Cn (a, b, c)) (Add (d, e)) = false | |
| 143 | | eq_num (Cn (a, b, c)) (Neg d) = false | |
| 144 | | eq_num (Bound a) (Mul (b, c)) = false | |
| 145 | | eq_num (Bound a) (Sub (b, c)) = false | |
| 146 | | eq_num (Bound a) (Add (b, c)) = false | |
| 147 | | eq_num (Bound a) (Neg b) = false | |
| 148 | | eq_num (Bound a) (Cn (b, c, d)) = false | |
| 149 | | eq_num (C a) (Mul (b, c)) = false | |
| 150 | | eq_num (C a) (Sub (b, c)) = false | |
| 151 | | eq_num (C a) (Add (b, c)) = false | |
| 152 | | eq_num (C a) (Neg b) = false | |
| 153 | | eq_num (C a) (Cn (b, c, d)) = false | |
| 154 | | eq_num (C a) (Bound b) = false | |
| 29787 | 155 | | eq_num (Mul (inta, num)) (Mul (int', num')) = | 
| 156 | ((inta : IntInf.int) = int') andalso eq_num num num' | |
| 157 | | eq_num (Sub (num1, num2)) (Sub (num1', num2')) = | |
| 158 | eq_num num1 num1' andalso eq_num num2 num2' | |
| 159 | | eq_num (Add (num1, num2)) (Add (num1', num2')) = | |
| 160 | eq_num num1 num1' andalso eq_num num2 num2' | |
| 161 | | eq_num (Neg num) (Neg num') = eq_num num num' | |
| 162 | | eq_num (Cn (nat, inta, num)) (Cn (nat', int', num')) = | |
| 163 | ((nat : IntInf.int) = nat') andalso | |
| 164 | (((inta : IntInf.int) = int') andalso eq_num num num') | |
| 165 | | eq_num (Bound nat) (Bound nat') = ((nat : IntInf.int) = nat') | |
| 166 | | eq_num (C inta) (C int') = ((inta : IntInf.int) = int'); | |
| 167 | ||
| 29939 | 168 | fun eq_fm (NClosed b) (Closed a) = false | 
| 169 | | eq_fm (NClosed b) (A a) = false | |
| 170 | | eq_fm (Closed b) (A a) = false | |
| 171 | | eq_fm (NClosed b) (E a) = false | |
| 172 | | eq_fm (Closed b) (E a) = false | |
| 173 | | eq_fm (A b) (E a) = false | |
| 174 | | eq_fm (NClosed c) (Iff (a, b)) = false | |
| 175 | | eq_fm (Closed c) (Iff (a, b)) = false | |
| 176 | | eq_fm (A c) (Iff (a, b)) = false | |
| 177 | | eq_fm (E c) (Iff (a, b)) = false | |
| 178 | | eq_fm (NClosed c) (Imp (a, b)) = false | |
| 179 | | eq_fm (Closed c) (Imp (a, b)) = false | |
| 180 | | eq_fm (A c) (Imp (a, b)) = false | |
| 181 | | eq_fm (E c) (Imp (a, b)) = false | |
| 182 | | eq_fm (Iff (c, d)) (Imp (a, b)) = false | |
| 183 | | eq_fm (NClosed c) (Or (a, b)) = false | |
| 184 | | eq_fm (Closed c) (Or (a, b)) = false | |
| 185 | | eq_fm (A c) (Or (a, b)) = false | |
| 186 | | eq_fm (E c) (Or (a, b)) = false | |
| 187 | | eq_fm (Iff (c, d)) (Or (a, b)) = false | |
| 188 | | eq_fm (Imp (c, d)) (Or (a, b)) = false | |
| 189 | | eq_fm (NClosed c) (And (a, b)) = false | |
| 190 | | eq_fm (Closed c) (And (a, b)) = false | |
| 191 | | eq_fm (A c) (And (a, b)) = false | |
| 192 | | eq_fm (E c) (And (a, b)) = false | |
| 193 | | eq_fm (Iff (c, d)) (And (a, b)) = false | |
| 194 | | eq_fm (Imp (c, d)) (And (a, b)) = false | |
| 195 | | eq_fm (Or (c, d)) (And (a, b)) = false | |
| 196 | | eq_fm (NClosed b) (Not a) = false | |
| 197 | | eq_fm (Closed b) (Not a) = false | |
| 198 | | eq_fm (A b) (Not a) = false | |
| 199 | | eq_fm (E b) (Not a) = false | |
| 200 | | eq_fm (Iff (b, c)) (Not a) = false | |
| 201 | | eq_fm (Imp (b, c)) (Not a) = false | |
| 202 | | eq_fm (Or (b, c)) (Not a) = false | |
| 203 | | eq_fm (And (b, c)) (Not a) = false | |
| 204 | | eq_fm (NClosed c) (NDvd (a, b)) = false | |
| 205 | | eq_fm (Closed c) (NDvd (a, b)) = false | |
| 206 | | eq_fm (A c) (NDvd (a, b)) = false | |
| 207 | | eq_fm (E c) (NDvd (a, b)) = false | |
| 208 | | eq_fm (Iff (c, d)) (NDvd (a, b)) = false | |
| 209 | | eq_fm (Imp (c, d)) (NDvd (a, b)) = false | |
| 210 | | eq_fm (Or (c, d)) (NDvd (a, b)) = false | |
| 211 | | eq_fm (And (c, d)) (NDvd (a, b)) = false | |
| 212 | | eq_fm (Not c) (NDvd (a, b)) = false | |
| 213 | | eq_fm (NClosed c) (Dvd (a, b)) = false | |
| 214 | | eq_fm (Closed c) (Dvd (a, b)) = false | |
| 215 | | eq_fm (A c) (Dvd (a, b)) = false | |
| 216 | | eq_fm (E c) (Dvd (a, b)) = false | |
| 217 | | eq_fm (Iff (c, d)) (Dvd (a, b)) = false | |
| 218 | | eq_fm (Imp (c, d)) (Dvd (a, b)) = false | |
| 219 | | eq_fm (Or (c, d)) (Dvd (a, b)) = false | |
| 220 | | eq_fm (And (c, d)) (Dvd (a, b)) = false | |
| 221 | | eq_fm (Not c) (Dvd (a, b)) = false | |
| 222 | | eq_fm (NDvd (c, d)) (Dvd (a, b)) = false | |
| 223 | | eq_fm (NClosed b) (NEq a) = false | |
| 224 | | eq_fm (Closed b) (NEq a) = false | |
| 225 | | eq_fm (A b) (NEq a) = false | |
| 226 | | eq_fm (E b) (NEq a) = false | |
| 227 | | eq_fm (Iff (b, c)) (NEq a) = false | |
| 228 | | eq_fm (Imp (b, c)) (NEq a) = false | |
| 229 | | eq_fm (Or (b, c)) (NEq a) = false | |
| 230 | | eq_fm (And (b, c)) (NEq a) = false | |
| 231 | | eq_fm (Not b) (NEq a) = false | |
| 232 | | eq_fm (NDvd (b, c)) (NEq a) = false | |
| 233 | | eq_fm (Dvd (b, c)) (NEq a) = false | |
| 234 | | eq_fm (NClosed b) (Eq a) = false | |
| 235 | | eq_fm (Closed b) (Eq a) = false | |
| 236 | | eq_fm (A b) (Eq a) = false | |
| 237 | | eq_fm (E b) (Eq a) = false | |
| 238 | | eq_fm (Iff (b, c)) (Eq a) = false | |
| 239 | | eq_fm (Imp (b, c)) (Eq a) = false | |
| 240 | | eq_fm (Or (b, c)) (Eq a) = false | |
| 241 | | eq_fm (And (b, c)) (Eq a) = false | |
| 242 | | eq_fm (Not b) (Eq a) = false | |
| 243 | | eq_fm (NDvd (b, c)) (Eq a) = false | |
| 244 | | eq_fm (Dvd (b, c)) (Eq a) = false | |
| 245 | | eq_fm (NEq b) (Eq a) = false | |
| 246 | | eq_fm (NClosed b) (Ge a) = false | |
| 247 | | eq_fm (Closed b) (Ge a) = false | |
| 248 | | eq_fm (A b) (Ge a) = false | |
| 249 | | eq_fm (E b) (Ge a) = false | |
| 250 | | eq_fm (Iff (b, c)) (Ge a) = false | |
| 251 | | eq_fm (Imp (b, c)) (Ge a) = false | |
| 252 | | eq_fm (Or (b, c)) (Ge a) = false | |
| 253 | | eq_fm (And (b, c)) (Ge a) = false | |
| 254 | | eq_fm (Not b) (Ge a) = false | |
| 255 | | eq_fm (NDvd (b, c)) (Ge a) = false | |
| 256 | | eq_fm (Dvd (b, c)) (Ge a) = false | |
| 257 | | eq_fm (NEq b) (Ge a) = false | |
| 258 | | eq_fm (Eq b) (Ge a) = false | |
| 259 | | eq_fm (NClosed b) (Gt a) = false | |
| 260 | | eq_fm (Closed b) (Gt a) = false | |
| 261 | | eq_fm (A b) (Gt a) = false | |
| 262 | | eq_fm (E b) (Gt a) = false | |
| 263 | | eq_fm (Iff (b, c)) (Gt a) = false | |
| 264 | | eq_fm (Imp (b, c)) (Gt a) = false | |
| 265 | | eq_fm (Or (b, c)) (Gt a) = false | |
| 266 | | eq_fm (And (b, c)) (Gt a) = false | |
| 267 | | eq_fm (Not b) (Gt a) = false | |
| 268 | | eq_fm (NDvd (b, c)) (Gt a) = false | |
| 269 | | eq_fm (Dvd (b, c)) (Gt a) = false | |
| 270 | | eq_fm (NEq b) (Gt a) = false | |
| 271 | | eq_fm (Eq b) (Gt a) = false | |
| 272 | | eq_fm (Ge b) (Gt a) = false | |
| 273 | | eq_fm (NClosed b) (Le a) = false | |
| 274 | | eq_fm (Closed b) (Le a) = false | |
| 275 | | eq_fm (A b) (Le a) = false | |
| 276 | | eq_fm (E b) (Le a) = false | |
| 277 | | eq_fm (Iff (b, c)) (Le a) = false | |
| 278 | | eq_fm (Imp (b, c)) (Le a) = false | |
| 279 | | eq_fm (Or (b, c)) (Le a) = false | |
| 280 | | eq_fm (And (b, c)) (Le a) = false | |
| 281 | | eq_fm (Not b) (Le a) = false | |
| 282 | | eq_fm (NDvd (b, c)) (Le a) = false | |
| 283 | | eq_fm (Dvd (b, c)) (Le a) = false | |
| 284 | | eq_fm (NEq b) (Le a) = false | |
| 285 | | eq_fm (Eq b) (Le a) = false | |
| 286 | | eq_fm (Ge b) (Le a) = false | |
| 287 | | eq_fm (Gt b) (Le a) = false | |
| 288 | | eq_fm (NClosed b) (Lt a) = false | |
| 289 | | eq_fm (Closed b) (Lt a) = false | |
| 290 | | eq_fm (A b) (Lt a) = false | |
| 291 | | eq_fm (E b) (Lt a) = false | |
| 292 | | eq_fm (Iff (b, c)) (Lt a) = false | |
| 293 | | eq_fm (Imp (b, c)) (Lt a) = false | |
| 294 | | eq_fm (Or (b, c)) (Lt a) = false | |
| 295 | | eq_fm (And (b, c)) (Lt a) = false | |
| 296 | | eq_fm (Not b) (Lt a) = false | |
| 297 | | eq_fm (NDvd (b, c)) (Lt a) = false | |
| 298 | | eq_fm (Dvd (b, c)) (Lt a) = false | |
| 299 | | eq_fm (NEq b) (Lt a) = false | |
| 300 | | eq_fm (Eq b) (Lt a) = false | |
| 301 | | eq_fm (Ge b) (Lt a) = false | |
| 302 | | eq_fm (Gt b) (Lt a) = false | |
| 303 | | eq_fm (Le b) (Lt a) = false | |
| 304 | | eq_fm (NClosed a) F = false | |
| 305 | | eq_fm (Closed a) F = false | |
| 306 | | eq_fm (A a) F = false | |
| 307 | | eq_fm (E a) F = false | |
| 308 | | eq_fm (Iff (a, b)) F = false | |
| 309 | | eq_fm (Imp (a, b)) F = false | |
| 310 | | eq_fm (Or (a, b)) F = false | |
| 311 | | eq_fm (And (a, b)) F = false | |
| 312 | | eq_fm (Not a) F = false | |
| 313 | | eq_fm (NDvd (a, b)) F = false | |
| 314 | | eq_fm (Dvd (a, b)) F = false | |
| 315 | | eq_fm (NEq a) F = false | |
| 316 | | eq_fm (Eq a) F = false | |
| 317 | | eq_fm (Ge a) F = false | |
| 318 | | eq_fm (Gt a) F = false | |
| 319 | | eq_fm (Le a) F = false | |
| 320 | | eq_fm (Lt a) F = false | |
| 321 | | eq_fm (NClosed a) T = false | |
| 322 | | eq_fm (Closed a) T = false | |
| 323 | | eq_fm (A a) T = false | |
| 324 | | eq_fm (E a) T = false | |
| 325 | | eq_fm (Iff (a, b)) T = false | |
| 326 | | eq_fm (Imp (a, b)) T = false | |
| 327 | | eq_fm (Or (a, b)) T = false | |
| 328 | | eq_fm (And (a, b)) T = false | |
| 329 | | eq_fm (Not a) T = false | |
| 330 | | eq_fm (NDvd (a, b)) T = false | |
| 331 | | eq_fm (Dvd (a, b)) T = false | |
| 332 | | eq_fm (NEq a) T = false | |
| 333 | | eq_fm (Eq a) T = false | |
| 334 | | eq_fm (Ge a) T = false | |
| 335 | | eq_fm (Gt a) T = false | |
| 336 | | eq_fm (Le a) T = false | |
| 337 | | eq_fm (Lt a) T = false | |
| 29787 | 338 | | eq_fm F T = false | 
| 339 | | eq_fm (Closed a) (NClosed b) = false | |
| 29939 | 340 | | eq_fm (A a) (NClosed b) = false | 
| 341 | | eq_fm (A a) (Closed b) = false | |
| 342 | | eq_fm (E a) (NClosed b) = false | |
| 343 | | eq_fm (E a) (Closed b) = false | |
| 344 | | eq_fm (E a) (A b) = false | |
| 345 | | eq_fm (Iff (a, b)) (NClosed c) = false | |
| 346 | | eq_fm (Iff (a, b)) (Closed c) = false | |
| 347 | | eq_fm (Iff (a, b)) (A c) = false | |
| 348 | | eq_fm (Iff (a, b)) (E c) = false | |
| 349 | | eq_fm (Imp (a, b)) (NClosed c) = false | |
| 350 | | eq_fm (Imp (a, b)) (Closed c) = false | |
| 351 | | eq_fm (Imp (a, b)) (A c) = false | |
| 352 | | eq_fm (Imp (a, b)) (E c) = false | |
| 353 | | eq_fm (Imp (a, b)) (Iff (c, d)) = false | |
| 354 | | eq_fm (Or (a, b)) (NClosed c) = false | |
| 355 | | eq_fm (Or (a, b)) (Closed c) = false | |
| 356 | | eq_fm (Or (a, b)) (A c) = false | |
| 357 | | eq_fm (Or (a, b)) (E c) = false | |
| 358 | | eq_fm (Or (a, b)) (Iff (c, d)) = false | |
| 359 | | eq_fm (Or (a, b)) (Imp (c, d)) = false | |
| 360 | | eq_fm (And (a, b)) (NClosed c) = false | |
| 361 | | eq_fm (And (a, b)) (Closed c) = false | |
| 362 | | eq_fm (And (a, b)) (A c) = false | |
| 363 | | eq_fm (And (a, b)) (E c) = false | |
| 364 | | eq_fm (And (a, b)) (Iff (c, d)) = false | |
| 365 | | eq_fm (And (a, b)) (Imp (c, d)) = false | |
| 366 | | eq_fm (And (a, b)) (Or (c, d)) = false | |
| 367 | | eq_fm (Not a) (NClosed b) = false | |
| 368 | | eq_fm (Not a) (Closed b) = false | |
| 369 | | eq_fm (Not a) (A b) = false | |
| 370 | | eq_fm (Not a) (E b) = false | |
| 371 | | eq_fm (Not a) (Iff (b, c)) = false | |
| 372 | | eq_fm (Not a) (Imp (b, c)) = false | |
| 373 | | eq_fm (Not a) (Or (b, c)) = false | |
| 374 | | eq_fm (Not a) (And (b, c)) = false | |
| 375 | | eq_fm (NDvd (a, b)) (NClosed c) = false | |
| 376 | | eq_fm (NDvd (a, b)) (Closed c) = false | |
| 377 | | eq_fm (NDvd (a, b)) (A c) = false | |
| 378 | | eq_fm (NDvd (a, b)) (E c) = false | |
| 379 | | eq_fm (NDvd (a, b)) (Iff (c, d)) = false | |
| 380 | | eq_fm (NDvd (a, b)) (Imp (c, d)) = false | |
| 381 | | eq_fm (NDvd (a, b)) (Or (c, d)) = false | |
| 382 | | eq_fm (NDvd (a, b)) (And (c, d)) = false | |
| 383 | | eq_fm (NDvd (a, b)) (Not c) = false | |
| 384 | | eq_fm (Dvd (a, b)) (NClosed c) = false | |
| 385 | | eq_fm (Dvd (a, b)) (Closed c) = false | |
| 386 | | eq_fm (Dvd (a, b)) (A c) = false | |
| 387 | | eq_fm (Dvd (a, b)) (E c) = false | |
| 388 | | eq_fm (Dvd (a, b)) (Iff (c, d)) = false | |
| 389 | | eq_fm (Dvd (a, b)) (Imp (c, d)) = false | |
| 390 | | eq_fm (Dvd (a, b)) (Or (c, d)) = false | |
| 391 | | eq_fm (Dvd (a, b)) (And (c, d)) = false | |
| 392 | | eq_fm (Dvd (a, b)) (Not c) = false | |
| 393 | | eq_fm (Dvd (a, b)) (NDvd (c, d)) = false | |
| 394 | | eq_fm (NEq a) (NClosed b) = false | |
| 395 | | eq_fm (NEq a) (Closed b) = false | |
| 396 | | eq_fm (NEq a) (A b) = false | |
| 397 | | eq_fm (NEq a) (E b) = false | |
| 398 | | eq_fm (NEq a) (Iff (b, c)) = false | |
| 399 | | eq_fm (NEq a) (Imp (b, c)) = false | |
| 400 | | eq_fm (NEq a) (Or (b, c)) = false | |
| 401 | | eq_fm (NEq a) (And (b, c)) = false | |
| 402 | | eq_fm (NEq a) (Not b) = false | |
| 403 | | eq_fm (NEq a) (NDvd (b, c)) = false | |
| 404 | | eq_fm (NEq a) (Dvd (b, c)) = false | |
| 405 | | eq_fm (Eq a) (NClosed b) = false | |
| 406 | | eq_fm (Eq a) (Closed b) = false | |
| 407 | | eq_fm (Eq a) (A b) = false | |
| 408 | | eq_fm (Eq a) (E b) = false | |
| 409 | | eq_fm (Eq a) (Iff (b, c)) = false | |
| 410 | | eq_fm (Eq a) (Imp (b, c)) = false | |
| 411 | | eq_fm (Eq a) (Or (b, c)) = false | |
| 412 | | eq_fm (Eq a) (And (b, c)) = false | |
| 413 | | eq_fm (Eq a) (Not b) = false | |
| 414 | | eq_fm (Eq a) (NDvd (b, c)) = false | |
| 415 | | eq_fm (Eq a) (Dvd (b, c)) = false | |
| 416 | | eq_fm (Eq a) (NEq b) = false | |
| 417 | | eq_fm (Ge a) (NClosed b) = false | |
| 418 | | eq_fm (Ge a) (Closed b) = false | |
| 419 | | eq_fm (Ge a) (A b) = false | |
| 420 | | eq_fm (Ge a) (E b) = false | |
| 421 | | eq_fm (Ge a) (Iff (b, c)) = false | |
| 422 | | eq_fm (Ge a) (Imp (b, c)) = false | |
| 423 | | eq_fm (Ge a) (Or (b, c)) = false | |
| 424 | | eq_fm (Ge a) (And (b, c)) = false | |
| 425 | | eq_fm (Ge a) (Not b) = false | |
| 426 | | eq_fm (Ge a) (NDvd (b, c)) = false | |
| 427 | | eq_fm (Ge a) (Dvd (b, c)) = false | |
| 428 | | eq_fm (Ge a) (NEq b) = false | |
| 429 | | eq_fm (Ge a) (Eq b) = false | |
| 430 | | eq_fm (Gt a) (NClosed b) = false | |
| 431 | | eq_fm (Gt a) (Closed b) = false | |
| 432 | | eq_fm (Gt a) (A b) = false | |
| 433 | | eq_fm (Gt a) (E b) = false | |
| 434 | | eq_fm (Gt a) (Iff (b, c)) = false | |
| 435 | | eq_fm (Gt a) (Imp (b, c)) = false | |
| 436 | | eq_fm (Gt a) (Or (b, c)) = false | |
| 437 | | eq_fm (Gt a) (And (b, c)) = false | |
| 438 | | eq_fm (Gt a) (Not b) = false | |
| 439 | | eq_fm (Gt a) (NDvd (b, c)) = false | |
| 440 | | eq_fm (Gt a) (Dvd (b, c)) = false | |
| 441 | | eq_fm (Gt a) (NEq b) = false | |
| 442 | | eq_fm (Gt a) (Eq b) = false | |
| 443 | | eq_fm (Gt a) (Ge b) = false | |
| 444 | | eq_fm (Le a) (NClosed b) = false | |
| 445 | | eq_fm (Le a) (Closed b) = false | |
| 446 | | eq_fm (Le a) (A b) = false | |
| 447 | | eq_fm (Le a) (E b) = false | |
| 448 | | eq_fm (Le a) (Iff (b, c)) = false | |
| 449 | | eq_fm (Le a) (Imp (b, c)) = false | |
| 450 | | eq_fm (Le a) (Or (b, c)) = false | |
| 451 | | eq_fm (Le a) (And (b, c)) = false | |
| 452 | | eq_fm (Le a) (Not b) = false | |
| 453 | | eq_fm (Le a) (NDvd (b, c)) = false | |
| 454 | | eq_fm (Le a) (Dvd (b, c)) = false | |
| 455 | | eq_fm (Le a) (NEq b) = false | |
| 456 | | eq_fm (Le a) (Eq b) = false | |
| 457 | | eq_fm (Le a) (Ge b) = false | |
| 458 | | eq_fm (Le a) (Gt b) = false | |
| 459 | | eq_fm (Lt a) (NClosed b) = false | |
| 460 | | eq_fm (Lt a) (Closed b) = false | |
| 461 | | eq_fm (Lt a) (A b) = false | |
| 462 | | eq_fm (Lt a) (E b) = false | |
| 463 | | eq_fm (Lt a) (Iff (b, c)) = false | |
| 464 | | eq_fm (Lt a) (Imp (b, c)) = false | |
| 465 | | eq_fm (Lt a) (Or (b, c)) = false | |
| 466 | | eq_fm (Lt a) (And (b, c)) = false | |
| 467 | | eq_fm (Lt a) (Not b) = false | |
| 468 | | eq_fm (Lt a) (NDvd (b, c)) = false | |
| 469 | | eq_fm (Lt a) (Dvd (b, c)) = false | |
| 470 | | eq_fm (Lt a) (NEq b) = false | |
| 471 | | eq_fm (Lt a) (Eq b) = false | |
| 472 | | eq_fm (Lt a) (Ge b) = false | |
| 473 | | eq_fm (Lt a) (Gt b) = false | |
| 474 | | eq_fm (Lt a) (Le b) = false | |
| 29787 | 475 | | eq_fm F (NClosed a) = false | 
| 476 | | eq_fm F (Closed a) = false | |
| 29939 | 477 | | eq_fm F (A a) = false | 
| 478 | | eq_fm F (E a) = false | |
| 479 | | eq_fm F (Iff (a, b)) = false | |
| 480 | | eq_fm F (Imp (a, b)) = false | |
| 481 | | eq_fm F (Or (a, b)) = false | |
| 482 | | eq_fm F (And (a, b)) = false | |
| 483 | | eq_fm F (Not a) = false | |
| 484 | | eq_fm F (NDvd (a, b)) = false | |
| 485 | | eq_fm F (Dvd (a, b)) = false | |
| 486 | | eq_fm F (NEq a) = false | |
| 487 | | eq_fm F (Eq a) = false | |
| 488 | | eq_fm F (Ge a) = false | |
| 489 | | eq_fm F (Gt a) = false | |
| 490 | | eq_fm F (Le a) = false | |
| 491 | | eq_fm F (Lt a) = false | |
| 29787 | 492 | | eq_fm T (NClosed a) = false | 
| 493 | | eq_fm T (Closed a) = false | |
| 29939 | 494 | | eq_fm T (A a) = false | 
| 495 | | eq_fm T (E a) = false | |
| 496 | | eq_fm T (Iff (a, b)) = false | |
| 497 | | eq_fm T (Imp (a, b)) = false | |
| 498 | | eq_fm T (Or (a, b)) = false | |
| 499 | | eq_fm T (And (a, b)) = false | |
| 500 | | eq_fm T (Not a) = false | |
| 501 | | eq_fm T (NDvd (a, b)) = false | |
| 502 | | eq_fm T (Dvd (a, b)) = false | |
| 503 | | eq_fm T (NEq a) = false | |
| 504 | | eq_fm T (Eq a) = false | |
| 505 | | eq_fm T (Ge a) = false | |
| 506 | | eq_fm T (Gt a) = false | |
| 507 | | eq_fm T (Le a) = false | |
| 508 | | eq_fm T (Lt a) = false | |
| 29787 | 509 | | eq_fm T F = false | 
| 510 | | eq_fm (NClosed nat) (NClosed nat') = ((nat : IntInf.int) = nat') | |
| 511 | | eq_fm (Closed nat) (Closed nat') = ((nat : IntInf.int) = nat') | |
| 512 | | eq_fm (A fm) (A fm') = eq_fm fm fm' | |
| 513 | | eq_fm (E fm) (E fm') = eq_fm fm fm' | |
| 514 | | eq_fm (Iff (fm1, fm2)) (Iff (fm1', fm2')) = | |
| 515 | eq_fm fm1 fm1' andalso eq_fm fm2 fm2' | |
| 516 | | eq_fm (Imp (fm1, fm2)) (Imp (fm1', fm2')) = | |
| 517 | eq_fm fm1 fm1' andalso eq_fm fm2 fm2' | |
| 518 | | eq_fm (Or (fm1, fm2)) (Or (fm1', fm2')) = | |
| 519 | eq_fm fm1 fm1' andalso eq_fm fm2 fm2' | |
| 520 | | eq_fm (And (fm1, fm2)) (And (fm1', fm2')) = | |
| 521 | eq_fm fm1 fm1' andalso eq_fm fm2 fm2' | |
| 522 | | eq_fm (Not fm) (Not fm') = eq_fm fm fm' | |
| 523 | | eq_fm (NDvd (inta, num)) (NDvd (int', num')) = | |
| 524 | ((inta : IntInf.int) = int') andalso eq_num num num' | |
| 525 | | eq_fm (Dvd (inta, num)) (Dvd (int', num')) = | |
| 526 | ((inta : IntInf.int) = int') andalso eq_num num num' | |
| 527 | | eq_fm (NEq num) (NEq num') = eq_num num num' | |
| 528 | | eq_fm (Eq num) (Eq num') = eq_num num num' | |
| 529 | | eq_fm (Ge num) (Ge num') = eq_num num num' | |
| 530 | | eq_fm (Gt num) (Gt num') = eq_num num num' | |
| 531 | | eq_fm (Le num) (Le num') = eq_num num num' | |
| 532 | | eq_fm (Lt num) (Lt num') = eq_num num num' | |
| 533 | | eq_fm F F = true | |
| 534 | | eq_fm T T = true; | |
| 535 | ||
| 536 | val eq_fma = {eq = eq_fm} : fm eq;
 | |
| 537 | ||
| 538 | fun djf f p q = | |
| 539 | (if eqop eq_fma q T then T | |
| 540 | else (if eqop eq_fma q F then f p | |
| 541 | else let | |
| 542 | val a = f p; | |
| 543 | in | |
| 544 | (case a of T => T | F => q | Lt num => Or (f p, q) | |
| 545 | | Le num => Or (f p, q) | Gt num => Or (f p, q) | |
| 546 | | Ge num => Or (f p, q) | Eq num => Or (f p, q) | |
| 547 | | NEq num => Or (f p, q) | Dvd (inta, num) => Or (f p, q) | |
| 548 | | NDvd (inta, num) => Or (f p, q) | Not fm => Or (f p, q) | |
| 549 | | And (fm1, fm2) => Or (f p, q) | |
| 550 | | Or (fm1, fm2) => Or (f p, q) | |
| 551 | | Imp (fm1, fm2) => Or (f p, q) | |
| 552 | | Iff (fm1, fm2) => Or (f p, q) | E fm => Or (f p, q) | |
| 553 | | A fm => Or (f p, q) | Closed nat => Or (f p, q) | |
| 554 | | NClosed nat => Or (f p, q)) | |
| 555 | end)); | |
| 556 | ||
| 29939 | 557 | fun foldr f [] a = a | 
| 29787 | 558 | | foldr f (x :: xs) a = f x (foldr f xs a); | 
| 559 | ||
| 560 | fun evaldjf f ps = foldr (djf f) ps F; | |
| 561 | ||
| 562 | fun dj f p = evaldjf f (disjuncts p); | |
| 563 | ||
| 564 | fun disj p q = | |
| 565 | (if eqop eq_fma p T orelse eqop eq_fma q T then T | |
| 566 | else (if eqop eq_fma p F then q | |
| 567 | else (if eqop eq_fma q F then p else Or (p, q)))); | |
| 568 | ||
| 569 | fun minus_nat n m = IntInf.max (0, (IntInf.- (n, m))); | |
| 570 | ||
| 571 | fun decrnum (Bound n) = Bound (minus_nat n 1) | |
| 572 | | decrnum (Neg a) = Neg (decrnum a) | |
| 573 | | decrnum (Add (a, b)) = Add (decrnum a, decrnum b) | |
| 574 | | decrnum (Sub (a, b)) = Sub (decrnum a, decrnum b) | |
| 575 | | decrnum (Mul (c, a)) = Mul (c, decrnum a) | |
| 576 | | decrnum (Cn (n, i, a)) = Cn (minus_nat n 1, i, decrnum a) | |
| 577 | | decrnum (C u) = C u; | |
| 578 | ||
| 579 | fun decr (Lt a) = Lt (decrnum a) | |
| 580 | | decr (Le a) = Le (decrnum a) | |
| 581 | | decr (Gt a) = Gt (decrnum a) | |
| 582 | | decr (Ge a) = Ge (decrnum a) | |
| 583 | | decr (Eq a) = Eq (decrnum a) | |
| 584 | | decr (NEq a) = NEq (decrnum a) | |
| 585 | | decr (Dvd (i, a)) = Dvd (i, decrnum a) | |
| 586 | | decr (NDvd (i, a)) = NDvd (i, decrnum a) | |
| 587 | | decr (Not p) = Not (decr p) | |
| 588 | | decr (And (p, q)) = And (decr p, decr q) | |
| 589 | | decr (Or (p, q)) = Or (decr p, decr q) | |
| 590 | | decr (Imp (p, q)) = Imp (decr p, decr q) | |
| 591 | | decr (Iff (p, q)) = Iff (decr p, decr q) | |
| 592 | | decr T = T | |
| 593 | | decr F = F | |
| 594 | | decr (E ao) = E ao | |
| 595 | | decr (A ap) = A ap | |
| 596 | | decr (Closed aq) = Closed aq | |
| 597 | | decr (NClosed ar) = NClosed ar; | |
| 598 | ||
| 599 | fun concat [] = [] | |
| 600 | | concat (x :: xs) = append x (concat xs); | |
| 601 | ||
| 602 | fun split f (a, b) = f a b; | |
| 603 | ||
| 604 | fun numsubst0 t (C c) = C c | |
| 605 | | numsubst0 t (Bound n) = (if eqop eq_nat n 0 then t else Bound n) | |
| 606 | | numsubst0 t (Neg a) = Neg (numsubst0 t a) | |
| 607 | | numsubst0 t (Add (a, b)) = Add (numsubst0 t a, numsubst0 t b) | |
| 608 | | numsubst0 t (Sub (a, b)) = Sub (numsubst0 t a, numsubst0 t b) | |
| 609 | | numsubst0 t (Mul (i, a)) = Mul (i, numsubst0 t a) | |
| 29939 | 610 | | numsubst0 t (Cn (v, i, a)) = | 
| 611 | (if eqop eq_nat v 0 then Add (Mul (i, t), numsubst0 t a) | |
| 612 | else Cn (suc (minus_nat v 1), i, numsubst0 t a)); | |
| 29787 | 613 | |
| 614 | fun subst0 t T = T | |
| 615 | | subst0 t F = F | |
| 616 | | subst0 t (Lt a) = Lt (numsubst0 t a) | |
| 617 | | subst0 t (Le a) = Le (numsubst0 t a) | |
| 618 | | subst0 t (Gt a) = Gt (numsubst0 t a) | |
| 619 | | subst0 t (Ge a) = Ge (numsubst0 t a) | |
| 620 | | subst0 t (Eq a) = Eq (numsubst0 t a) | |
| 621 | | subst0 t (NEq a) = NEq (numsubst0 t a) | |
| 622 | | subst0 t (Dvd (i, a)) = Dvd (i, numsubst0 t a) | |
| 623 | | subst0 t (NDvd (i, a)) = NDvd (i, numsubst0 t a) | |
| 624 | | subst0 t (Not p) = Not (subst0 t p) | |
| 625 | | subst0 t (And (p, q)) = And (subst0 t p, subst0 t q) | |
| 626 | | subst0 t (Or (p, q)) = Or (subst0 t p, subst0 t q) | |
| 627 | | subst0 t (Imp (p, q)) = Imp (subst0 t p, subst0 t q) | |
| 628 | | subst0 t (Iff (p, q)) = Iff (subst0 t p, subst0 t q) | |
| 629 | | subst0 t (Closed p) = Closed p | |
| 630 | | subst0 t (NClosed p) = NClosed p; | |
| 631 | ||
| 632 | fun minusinf (And (p, q)) = And (minusinf p, minusinf q) | |
| 633 | | minusinf (Or (p, q)) = Or (minusinf p, minusinf q) | |
| 634 | | minusinf T = T | |
| 635 | | minusinf F = F | |
| 636 | | minusinf (Lt (C bo)) = Lt (C bo) | |
| 637 | | minusinf (Lt (Bound bp)) = Lt (Bound bp) | |
| 638 | | minusinf (Lt (Neg bt)) = Lt (Neg bt) | |
| 639 | | minusinf (Lt (Add (bu, bv))) = Lt (Add (bu, bv)) | |
| 640 | | minusinf (Lt (Sub (bw, bx))) = Lt (Sub (bw, bx)) | |
| 641 | | minusinf (Lt (Mul (by, bz))) = Lt (Mul (by, bz)) | |
| 642 | | minusinf (Le (C co)) = Le (C co) | |
| 643 | | minusinf (Le (Bound cp)) = Le (Bound cp) | |
| 644 | | minusinf (Le (Neg ct)) = Le (Neg ct) | |
| 645 | | minusinf (Le (Add (cu, cv))) = Le (Add (cu, cv)) | |
| 646 | | minusinf (Le (Sub (cw, cx))) = Le (Sub (cw, cx)) | |
| 647 | | minusinf (Le (Mul (cy, cz))) = Le (Mul (cy, cz)) | |
| 648 | | minusinf (Gt (C doa)) = Gt (C doa) | |
| 649 | | minusinf (Gt (Bound dp)) = Gt (Bound dp) | |
| 650 | | minusinf (Gt (Neg dt)) = Gt (Neg dt) | |
| 651 | | minusinf (Gt (Add (du, dv))) = Gt (Add (du, dv)) | |
| 652 | | minusinf (Gt (Sub (dw, dx))) = Gt (Sub (dw, dx)) | |
| 653 | | minusinf (Gt (Mul (dy, dz))) = Gt (Mul (dy, dz)) | |
| 654 | | minusinf (Ge (C eo)) = Ge (C eo) | |
| 655 | | minusinf (Ge (Bound ep)) = Ge (Bound ep) | |
| 656 | | minusinf (Ge (Neg et)) = Ge (Neg et) | |
| 657 | | minusinf (Ge (Add (eu, ev))) = Ge (Add (eu, ev)) | |
| 658 | | minusinf (Ge (Sub (ew, ex))) = Ge (Sub (ew, ex)) | |
| 659 | | minusinf (Ge (Mul (ey, ez))) = Ge (Mul (ey, ez)) | |
| 660 | | minusinf (Eq (C fo)) = Eq (C fo) | |
| 661 | | minusinf (Eq (Bound fp)) = Eq (Bound fp) | |
| 662 | | minusinf (Eq (Neg ft)) = Eq (Neg ft) | |
| 663 | | minusinf (Eq (Add (fu, fv))) = Eq (Add (fu, fv)) | |
| 664 | | minusinf (Eq (Sub (fw, fx))) = Eq (Sub (fw, fx)) | |
| 665 | | minusinf (Eq (Mul (fy, fz))) = Eq (Mul (fy, fz)) | |
| 666 | | minusinf (NEq (C go)) = NEq (C go) | |
| 667 | | minusinf (NEq (Bound gp)) = NEq (Bound gp) | |
| 668 | | minusinf (NEq (Neg gt)) = NEq (Neg gt) | |
| 669 | | minusinf (NEq (Add (gu, gv))) = NEq (Add (gu, gv)) | |
| 670 | | minusinf (NEq (Sub (gw, gx))) = NEq (Sub (gw, gx)) | |
| 671 | | minusinf (NEq (Mul (gy, gz))) = NEq (Mul (gy, gz)) | |
| 672 | | minusinf (Dvd (aa, ab)) = Dvd (aa, ab) | |
| 673 | | minusinf (NDvd (ac, ad)) = NDvd (ac, ad) | |
| 674 | | minusinf (Not ae) = Not ae | |
| 675 | | minusinf (Imp (aj, ak)) = Imp (aj, ak) | |
| 676 | | minusinf (Iff (al, am)) = Iff (al, am) | |
| 677 | | minusinf (E an) = E an | |
| 678 | | minusinf (A ao) = A ao | |
| 679 | | minusinf (Closed ap) = Closed ap | |
| 680 | | minusinf (NClosed aq) = NClosed aq | |
| 681 | | minusinf (Lt (Cn (cm, c, e))) = | |
| 682 | (if eqop eq_nat cm 0 then T else Lt (Cn (suc (minus_nat cm 1), c, e))) | |
| 683 | | minusinf (Le (Cn (dm, c, e))) = | |
| 684 | (if eqop eq_nat dm 0 then T else Le (Cn (suc (minus_nat dm 1), c, e))) | |
| 685 | | minusinf (Gt (Cn (em, c, e))) = | |
| 686 | (if eqop eq_nat em 0 then F else Gt (Cn (suc (minus_nat em 1), c, e))) | |
| 687 | | minusinf (Ge (Cn (fm, c, e))) = | |
| 688 | (if eqop eq_nat fm 0 then F else Ge (Cn (suc (minus_nat fm 1), c, e))) | |
| 689 | | minusinf (Eq (Cn (gm, c, e))) = | |
| 690 | (if eqop eq_nat gm 0 then F else Eq (Cn (suc (minus_nat gm 1), c, e))) | |
| 691 | | minusinf (NEq (Cn (hm, c, e))) = | |
| 692 | (if eqop eq_nat hm 0 then T else NEq (Cn (suc (minus_nat hm 1), c, e))); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 693 | |
| 29939 | 694 | val eq_int = {eq = (fn a => fn b => ((a : IntInf.int) = b))} : IntInf.int eq;
 | 
| 23466 | 695 | |
| 29939 | 696 | fun sgn_int i = | 
| 697 | (if eqop eq_int i (0 : IntInf.int) then (0 : IntInf.int) | |
| 698 | else (if IntInf.< ((0 : IntInf.int), i) then (1 : IntInf.int) | |
| 699 | else IntInf.~ (1 : IntInf.int))); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 700 | |
| 29787 | 701 | fun apsnd f (x, y) = (x, f y); | 
| 702 | ||
| 29939 | 703 | fun divmoda k l = | 
| 704 | (if eqop eq_int k (0 : IntInf.int) then ((0 : IntInf.int), (0 : IntInf.int)) | |
| 705 | else (if eqop eq_int l (0 : IntInf.int) then ((0 : IntInf.int), k) | |
| 706 | else apsnd (fn a => IntInf.* (sgn_int l, a)) | |
| 707 | (if eqop eq_int (sgn_int k) (sgn_int l) | |
| 708 | then (fn k => fn l => IntInf.divMod (IntInf.abs k, | |
| 709 | IntInf.abs l)) | |
| 710 | k l | |
| 711 | else let | |
| 712 | val a = | |
| 713 | (fn k => fn l => IntInf.divMod (IntInf.abs k, | |
| 714 | IntInf.abs l)) | |
| 715 | k l; | |
| 716 | val (r, s) = a; | |
| 717 | in | |
| 718 | (if eqop eq_int s (0 : IntInf.int) | |
| 719 | then (IntInf.~ r, (0 : IntInf.int)) | |
| 720 | else (IntInf.- (IntInf.~ r, (1 : IntInf.int)), | |
| 721 | IntInf.- (abs_int l, s))) | |
| 722 | end))); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 723 | |
| 29787 | 724 | fun mod_int a b = snd (divmoda a b); | 
| 23714 | 725 | |
| 29787 | 726 | fun num_case f1 f2 f3 f4 f5 f6 f7 (Mul (inta, num)) = f7 inta num | 
| 727 | | num_case f1 f2 f3 f4 f5 f6 f7 (Sub (num1, num2)) = f6 num1 num2 | |
| 728 | | num_case f1 f2 f3 f4 f5 f6 f7 (Add (num1, num2)) = f5 num1 num2 | |
| 729 | | num_case f1 f2 f3 f4 f5 f6 f7 (Neg num) = f4 num | |
| 730 | | num_case f1 f2 f3 f4 f5 f6 f7 (Cn (nat, inta, num)) = f3 nat inta num | |
| 731 | | num_case f1 f2 f3 f4 f5 f6 f7 (Bound nat) = f2 nat | |
| 732 | | num_case f1 f2 f3 f4 f5 f6 f7 (C inta) = f1 inta; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 733 | |
| 29787 | 734 | fun nummul i (C j) = C (IntInf.* (i, j)) | 
| 735 | | nummul i (Cn (n, c, t)) = Cn (n, IntInf.* (c, i), nummul i t) | |
| 736 | | nummul i (Bound v) = Mul (i, Bound v) | |
| 737 | | nummul i (Neg v) = Mul (i, Neg v) | |
| 738 | | nummul i (Add (v, va)) = Mul (i, Add (v, va)) | |
| 739 | | nummul i (Sub (v, va)) = Mul (i, Sub (v, va)) | |
| 740 | | nummul i (Mul (v, va)) = Mul (i, Mul (v, va)); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 741 | |
| 29787 | 742 | fun numneg t = nummul (IntInf.~ (1 : IntInf.int)) t; | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 743 | |
| 29787 | 744 | fun numadd (Cn (n1, c1, r1), Cn (n2, c2, r2)) = | 
| 745 | (if eqop eq_nat n1 n2 | |
| 746 | then let | |
| 747 | val c = IntInf.+ (c1, c2); | |
| 748 | in | |
| 749 | (if eqop eq_int c (0 : IntInf.int) then numadd (r1, r2) | |
| 750 | else Cn (n1, c, numadd (r1, r2))) | |
| 751 | end | |
| 752 | else (if IntInf.<= (n1, n2) | |
| 753 | then Cn (n1, c1, numadd (r1, Add (Mul (c2, Bound n2), r2))) | |
| 754 | else Cn (n2, c2, numadd (Add (Mul (c1, Bound n1), r1), r2)))) | |
| 755 | | numadd (Cn (n1, c1, r1), C dd) = Cn (n1, c1, numadd (r1, C dd)) | |
| 756 | | numadd (Cn (n1, c1, r1), Bound de) = Cn (n1, c1, numadd (r1, Bound de)) | |
| 757 | | numadd (Cn (n1, c1, r1), Neg di) = Cn (n1, c1, numadd (r1, Neg di)) | |
| 758 | | numadd (Cn (n1, c1, r1), Add (dj, dk)) = | |
| 759 | Cn (n1, c1, numadd (r1, Add (dj, dk))) | |
| 760 | | numadd (Cn (n1, c1, r1), Sub (dl, dm)) = | |
| 761 | Cn (n1, c1, numadd (r1, Sub (dl, dm))) | |
| 762 | | numadd (Cn (n1, c1, r1), Mul (dn, doa)) = | |
| 763 | Cn (n1, c1, numadd (r1, Mul (dn, doa))) | |
| 764 | | numadd (C w, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (C w, r2)) | |
| 765 | | numadd (Bound x, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (Bound x, r2)) | |
| 766 | | numadd (Neg ac, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (Neg ac, r2)) | |
| 767 | | numadd (Add (ad, ae), Cn (n2, c2, r2)) = | |
| 768 | Cn (n2, c2, numadd (Add (ad, ae), r2)) | |
| 769 | | numadd (Sub (af, ag), Cn (n2, c2, r2)) = | |
| 770 | Cn (n2, c2, numadd (Sub (af, ag), r2)) | |
| 771 | | numadd (Mul (ah, ai), Cn (n2, c2, r2)) = | |
| 772 | Cn (n2, c2, numadd (Mul (ah, ai), r2)) | |
| 773 | | numadd (C b1, C b2) = C (IntInf.+ (b1, b2)) | |
| 774 | | numadd (C aj, Bound bi) = Add (C aj, Bound bi) | |
| 775 | | numadd (C aj, Neg bm) = Add (C aj, Neg bm) | |
| 776 | | numadd (C aj, Add (bn, bo)) = Add (C aj, Add (bn, bo)) | |
| 777 | | numadd (C aj, Sub (bp, bq)) = Add (C aj, Sub (bp, bq)) | |
| 778 | | numadd (C aj, Mul (br, bs)) = Add (C aj, Mul (br, bs)) | |
| 779 | | numadd (Bound ak, C cf) = Add (Bound ak, C cf) | |
| 780 | | numadd (Bound ak, Bound cg) = Add (Bound ak, Bound cg) | |
| 781 | | numadd (Bound ak, Neg ck) = Add (Bound ak, Neg ck) | |
| 782 | | numadd (Bound ak, Add (cl, cm)) = Add (Bound ak, Add (cl, cm)) | |
| 783 | | numadd (Bound ak, Sub (cn, co)) = Add (Bound ak, Sub (cn, co)) | |
| 784 | | numadd (Bound ak, Mul (cp, cq)) = Add (Bound ak, Mul (cp, cq)) | |
| 785 | | numadd (Neg ao, C en) = Add (Neg ao, C en) | |
| 786 | | numadd (Neg ao, Bound eo) = Add (Neg ao, Bound eo) | |
| 787 | | numadd (Neg ao, Neg es) = Add (Neg ao, Neg es) | |
| 788 | | numadd (Neg ao, Add (et, eu)) = Add (Neg ao, Add (et, eu)) | |
| 789 | | numadd (Neg ao, Sub (ev, ew)) = Add (Neg ao, Sub (ev, ew)) | |
| 790 | | numadd (Neg ao, Mul (ex, ey)) = Add (Neg ao, Mul (ex, ey)) | |
| 791 | | numadd (Add (ap, aq), C fl) = Add (Add (ap, aq), C fl) | |
| 792 | | numadd (Add (ap, aq), Bound fm) = Add (Add (ap, aq), Bound fm) | |
| 793 | | numadd (Add (ap, aq), Neg fq) = Add (Add (ap, aq), Neg fq) | |
| 794 | | numadd (Add (ap, aq), Add (fr, fs)) = Add (Add (ap, aq), Add (fr, fs)) | |
| 795 | | numadd (Add (ap, aq), Sub (ft, fu)) = Add (Add (ap, aq), Sub (ft, fu)) | |
| 796 | | numadd (Add (ap, aq), Mul (fv, fw)) = Add (Add (ap, aq), Mul (fv, fw)) | |
| 797 | | numadd (Sub (ar, asa), C gj) = Add (Sub (ar, asa), C gj) | |
| 798 | | numadd (Sub (ar, asa), Bound gk) = Add (Sub (ar, asa), Bound gk) | |
| 799 | | numadd (Sub (ar, asa), Neg go) = Add (Sub (ar, asa), Neg go) | |
| 800 | | numadd (Sub (ar, asa), Add (gp, gq)) = Add (Sub (ar, asa), Add (gp, gq)) | |
| 801 | | numadd (Sub (ar, asa), Sub (gr, gs)) = Add (Sub (ar, asa), Sub (gr, gs)) | |
| 802 | | numadd (Sub (ar, asa), Mul (gt, gu)) = Add (Sub (ar, asa), Mul (gt, gu)) | |
| 803 | | numadd (Mul (at, au), C hh) = Add (Mul (at, au), C hh) | |
| 804 | | numadd (Mul (at, au), Bound hi) = Add (Mul (at, au), Bound hi) | |
| 805 | | numadd (Mul (at, au), Neg hm) = Add (Mul (at, au), Neg hm) | |
| 806 | | numadd (Mul (at, au), Add (hn, ho)) = Add (Mul (at, au), Add (hn, ho)) | |
| 807 | | numadd (Mul (at, au), Sub (hp, hq)) = Add (Mul (at, au), Sub (hp, hq)) | |
| 808 | | numadd (Mul (at, au), Mul (hr, hs)) = Add (Mul (at, au), Mul (hr, hs)); | |
| 23714 | 809 | |
| 29787 | 810 | val eq_numa = {eq = eq_num} : num eq;
 | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 811 | |
| 29787 | 812 | fun numsub s t = | 
| 813 | (if eqop eq_numa s t then C (0 : IntInf.int) else numadd (s, numneg t)); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 814 | |
| 29787 | 815 | fun simpnum (C j) = C j | 
| 816 | | simpnum (Bound n) = Cn (n, (1 : IntInf.int), C (0 : IntInf.int)) | |
| 817 | | simpnum (Neg t) = numneg (simpnum t) | |
| 818 | | simpnum (Add (t, s)) = numadd (simpnum t, simpnum s) | |
| 819 | | simpnum (Sub (t, s)) = numsub (simpnum t) (simpnum s) | |
| 820 | | simpnum (Mul (i, t)) = | |
| 821 | (if eqop eq_int i (0 : IntInf.int) then C (0 : IntInf.int) | |
| 822 | else nummul i (simpnum t)) | |
| 823 | | simpnum (Cn (v, va, vb)) = Cn (v, va, vb); | |
| 23714 | 824 | |
| 29939 | 825 | fun nota (Not p) = p | 
| 29787 | 826 | | nota T = F | 
| 827 | | nota F = T | |
| 29939 | 828 | | nota (Lt v) = Not (Lt v) | 
| 829 | | nota (Le v) = Not (Le v) | |
| 830 | | nota (Gt v) = Not (Gt v) | |
| 831 | | nota (Ge v) = Not (Ge v) | |
| 832 | | nota (Eq v) = Not (Eq v) | |
| 833 | | nota (NEq v) = Not (NEq v) | |
| 834 | | nota (Dvd (v, va)) = Not (Dvd (v, va)) | |
| 835 | | nota (NDvd (v, va)) = Not (NDvd (v, va)) | |
| 836 | | nota (And (v, va)) = Not (And (v, va)) | |
| 837 | | nota (Or (v, va)) = Not (Or (v, va)) | |
| 838 | | nota (Imp (v, va)) = Not (Imp (v, va)) | |
| 839 | | nota (Iff (v, va)) = Not (Iff (v, va)) | |
| 840 | | nota (E v) = Not (E v) | |
| 841 | | nota (A v) = Not (A v) | |
| 29787 | 842 | | nota (Closed v) = Not (Closed v) | 
| 843 | | nota (NClosed v) = Not (NClosed v); | |
| 23714 | 844 | |
| 29787 | 845 | fun iffa p q = | 
| 846 | (if eqop eq_fma p q then T | |
| 847 | else (if eqop eq_fma p (nota q) orelse eqop eq_fma (nota p) q then F | |
| 848 | else (if eqop eq_fma p F then nota q | |
| 849 | else (if eqop eq_fma q F then nota p | |
| 850 | else (if eqop eq_fma p T then q | |
| 851 | else (if eqop eq_fma q T then p | |
| 852 | else Iff (p, q))))))); | |
| 23466 | 853 | |
| 29787 | 854 | fun impa p q = | 
| 855 | (if eqop eq_fma p F orelse eqop eq_fma q T then T | |
| 856 | else (if eqop eq_fma p T then q | |
| 857 | else (if eqop eq_fma q F then nota p else Imp (p, q)))); | |
| 23714 | 858 | |
| 29787 | 859 | fun conj p q = | 
| 860 | (if eqop eq_fma p F orelse eqop eq_fma q F then F | |
| 861 | else (if eqop eq_fma p T then q | |
| 862 | else (if eqop eq_fma q T then p else And (p, q)))); | |
| 23714 | 863 | |
| 29787 | 864 | fun simpfm (And (p, q)) = conj (simpfm p) (simpfm q) | 
| 865 | | simpfm (Or (p, q)) = disj (simpfm p) (simpfm q) | |
| 866 | | simpfm (Imp (p, q)) = impa (simpfm p) (simpfm q) | |
| 867 | | simpfm (Iff (p, q)) = iffa (simpfm p) (simpfm q) | |
| 868 | | simpfm (Not p) = nota (simpfm p) | |
| 869 | | simpfm (Lt a) = | |
| 870 | let | |
| 871 | val a' = simpnum a; | |
| 872 | in | |
| 873 | (case a' of C v => (if IntInf.< (v, (0 : IntInf.int)) then T else F) | |
| 874 | | Bound nat => Lt a' | Cn (nat, inta, num) => Lt a' | Neg num => Lt a' | |
| 875 | | Add (num1, num2) => Lt a' | Sub (num1, num2) => Lt a' | |
| 876 | | Mul (inta, num) => Lt a') | |
| 877 | end | |
| 878 | | simpfm (Le a) = | |
| 879 | let | |
| 880 | val a' = simpnum a; | |
| 881 | in | |
| 882 | (case a' of C v => (if IntInf.<= (v, (0 : IntInf.int)) then T else F) | |
| 883 | | Bound nat => Le a' | Cn (nat, inta, num) => Le a' | Neg num => Le a' | |
| 884 | | Add (num1, num2) => Le a' | Sub (num1, num2) => Le a' | |
| 885 | | Mul (inta, num) => Le a') | |
| 886 | end | |
| 887 | | simpfm (Gt a) = | |
| 888 | let | |
| 889 | val a' = simpnum a; | |
| 890 | in | |
| 891 | (case a' of C v => (if IntInf.< ((0 : IntInf.int), v) then T else F) | |
| 892 | | Bound nat => Gt a' | Cn (nat, inta, num) => Gt a' | Neg num => Gt a' | |
| 893 | | Add (num1, num2) => Gt a' | Sub (num1, num2) => Gt a' | |
| 894 | | Mul (inta, num) => Gt a') | |
| 895 | end | |
| 896 | | simpfm (Ge a) = | |
| 897 | let | |
| 898 | val a' = simpnum a; | |
| 899 | in | |
| 900 | (case a' of C v => (if IntInf.<= ((0 : IntInf.int), v) then T else F) | |
| 901 | | Bound nat => Ge a' | Cn (nat, inta, num) => Ge a' | Neg num => Ge a' | |
| 902 | | Add (num1, num2) => Ge a' | Sub (num1, num2) => Ge a' | |
| 903 | | Mul (inta, num) => Ge a') | |
| 904 | end | |
| 905 | | simpfm (Eq a) = | |
| 906 | let | |
| 907 | val a' = simpnum a; | |
| 908 | in | |
| 909 | (case a' of C v => (if eqop eq_int v (0 : IntInf.int) then T else F) | |
| 910 | | Bound nat => Eq a' | Cn (nat, inta, num) => Eq a' | Neg num => Eq a' | |
| 911 | | Add (num1, num2) => Eq a' | Sub (num1, num2) => Eq a' | |
| 912 | | Mul (inta, num) => Eq a') | |
| 913 | end | |
| 914 | | simpfm (NEq a) = | |
| 915 | let | |
| 916 | val a' = simpnum a; | |
| 917 | in | |
| 918 | (case a' of C v => (if not (eqop eq_int v (0 : IntInf.int)) then T else F) | |
| 919 | | Bound nat => NEq a' | Cn (nat, inta, num) => NEq a' | |
| 920 | | Neg num => NEq a' | Add (num1, num2) => NEq a' | |
| 921 | | Sub (num1, num2) => NEq a' | Mul (inta, num) => NEq a') | |
| 922 | end | |
| 923 | | simpfm (Dvd (i, a)) = | |
| 924 | (if eqop eq_int i (0 : IntInf.int) then simpfm (Eq a) | |
| 925 | else (if eqop eq_int (abs_int i) (1 : IntInf.int) then T | |
| 926 | else let | |
| 927 | val a' = simpnum a; | |
| 928 | in | |
| 929 | (case a' | |
| 930 | of C v => | |
| 931 | (if eqop eq_int (mod_int v i) (0 : IntInf.int) then T | |
| 932 | else F) | |
| 933 | | Bound nat => Dvd (i, a') | |
| 934 | | Cn (nat, inta, num) => Dvd (i, a') | |
| 935 | | Neg num => Dvd (i, a') | |
| 936 | | Add (num1, num2) => Dvd (i, a') | |
| 937 | | Sub (num1, num2) => Dvd (i, a') | |
| 938 | | Mul (inta, num) => Dvd (i, a')) | |
| 939 | end)) | |
| 940 | | simpfm (NDvd (i, a)) = | |
| 941 | (if eqop eq_int i (0 : IntInf.int) then simpfm (NEq a) | |
| 942 | else (if eqop eq_int (abs_int i) (1 : IntInf.int) then F | |
| 943 | else let | |
| 944 | val a' = simpnum a; | |
| 945 | in | |
| 946 | (case a' | |
| 947 | of C v => | |
| 948 | (if not (eqop eq_int (mod_int v i) (0 : IntInf.int)) | |
| 949 | then T else F) | |
| 950 | | Bound nat => NDvd (i, a') | |
| 951 | | Cn (nat, inta, num) => NDvd (i, a') | |
| 952 | | Neg num => NDvd (i, a') | |
| 953 | | Add (num1, num2) => NDvd (i, a') | |
| 954 | | Sub (num1, num2) => NDvd (i, a') | |
| 955 | | Mul (inta, num) => NDvd (i, a')) | |
| 956 | end)) | |
| 957 | | simpfm T = T | |
| 958 | | simpfm F = F | |
| 959 | | simpfm (E v) = E v | |
| 960 | | simpfm (A v) = A v | |
| 961 | | simpfm (Closed v) = Closed v | |
| 962 | | simpfm (NClosed v) = NClosed v; | |
| 23466 | 963 | |
| 29787 | 964 | fun iupt i j = | 
| 965 | (if IntInf.< (j, i) then [] | |
| 966 | else i :: iupt (IntInf.+ (i, (1 : IntInf.int))) j); | |
| 967 | ||
| 968 | fun mirror (And (p, q)) = And (mirror p, mirror q) | |
| 969 | | mirror (Or (p, q)) = Or (mirror p, mirror q) | |
| 970 | | mirror T = T | |
| 971 | | mirror F = F | |
| 972 | | mirror (Lt (C bo)) = Lt (C bo) | |
| 973 | | mirror (Lt (Bound bp)) = Lt (Bound bp) | |
| 974 | | mirror (Lt (Neg bt)) = Lt (Neg bt) | |
| 975 | | mirror (Lt (Add (bu, bv))) = Lt (Add (bu, bv)) | |
| 976 | | mirror (Lt (Sub (bw, bx))) = Lt (Sub (bw, bx)) | |
| 977 | | mirror (Lt (Mul (by, bz))) = Lt (Mul (by, bz)) | |
| 978 | | mirror (Le (C co)) = Le (C co) | |
| 979 | | mirror (Le (Bound cp)) = Le (Bound cp) | |
| 980 | | mirror (Le (Neg ct)) = Le (Neg ct) | |
| 981 | | mirror (Le (Add (cu, cv))) = Le (Add (cu, cv)) | |
| 982 | | mirror (Le (Sub (cw, cx))) = Le (Sub (cw, cx)) | |
| 983 | | mirror (Le (Mul (cy, cz))) = Le (Mul (cy, cz)) | |
| 984 | | mirror (Gt (C doa)) = Gt (C doa) | |
| 985 | | mirror (Gt (Bound dp)) = Gt (Bound dp) | |
| 986 | | mirror (Gt (Neg dt)) = Gt (Neg dt) | |
| 987 | | mirror (Gt (Add (du, dv))) = Gt (Add (du, dv)) | |
| 988 | | mirror (Gt (Sub (dw, dx))) = Gt (Sub (dw, dx)) | |
| 989 | | mirror (Gt (Mul (dy, dz))) = Gt (Mul (dy, dz)) | |
| 990 | | mirror (Ge (C eo)) = Ge (C eo) | |
| 991 | | mirror (Ge (Bound ep)) = Ge (Bound ep) | |
| 992 | | mirror (Ge (Neg et)) = Ge (Neg et) | |
| 993 | | mirror (Ge (Add (eu, ev))) = Ge (Add (eu, ev)) | |
| 994 | | mirror (Ge (Sub (ew, ex))) = Ge (Sub (ew, ex)) | |
| 995 | | mirror (Ge (Mul (ey, ez))) = Ge (Mul (ey, ez)) | |
| 996 | | mirror (Eq (C fo)) = Eq (C fo) | |
| 997 | | mirror (Eq (Bound fp)) = Eq (Bound fp) | |
| 998 | | mirror (Eq (Neg ft)) = Eq (Neg ft) | |
| 999 | | mirror (Eq (Add (fu, fv))) = Eq (Add (fu, fv)) | |
| 1000 | | mirror (Eq (Sub (fw, fx))) = Eq (Sub (fw, fx)) | |
| 1001 | | mirror (Eq (Mul (fy, fz))) = Eq (Mul (fy, fz)) | |
| 1002 | | mirror (NEq (C go)) = NEq (C go) | |
| 1003 | | mirror (NEq (Bound gp)) = NEq (Bound gp) | |
| 1004 | | mirror (NEq (Neg gt)) = NEq (Neg gt) | |
| 1005 | | mirror (NEq (Add (gu, gv))) = NEq (Add (gu, gv)) | |
| 1006 | | mirror (NEq (Sub (gw, gx))) = NEq (Sub (gw, gx)) | |
| 1007 | | mirror (NEq (Mul (gy, gz))) = NEq (Mul (gy, gz)) | |
| 1008 | | mirror (Dvd (aa, C ho)) = Dvd (aa, C ho) | |
| 1009 | | mirror (Dvd (aa, Bound hp)) = Dvd (aa, Bound hp) | |
| 1010 | | mirror (Dvd (aa, Neg ht)) = Dvd (aa, Neg ht) | |
| 1011 | | mirror (Dvd (aa, Add (hu, hv))) = Dvd (aa, Add (hu, hv)) | |
| 1012 | | mirror (Dvd (aa, Sub (hw, hx))) = Dvd (aa, Sub (hw, hx)) | |
| 1013 | | mirror (Dvd (aa, Mul (hy, hz))) = Dvd (aa, Mul (hy, hz)) | |
| 1014 | | mirror (NDvd (ac, C io)) = NDvd (ac, C io) | |
| 1015 | | mirror (NDvd (ac, Bound ip)) = NDvd (ac, Bound ip) | |
| 1016 | | mirror (NDvd (ac, Neg it)) = NDvd (ac, Neg it) | |
| 1017 | | mirror (NDvd (ac, Add (iu, iv))) = NDvd (ac, Add (iu, iv)) | |
| 1018 | | mirror (NDvd (ac, Sub (iw, ix))) = NDvd (ac, Sub (iw, ix)) | |
| 1019 | | mirror (NDvd (ac, Mul (iy, iz))) = NDvd (ac, Mul (iy, iz)) | |
| 1020 | | mirror (Not ae) = Not ae | |
| 1021 | | mirror (Imp (aj, ak)) = Imp (aj, ak) | |
| 1022 | | mirror (Iff (al, am)) = Iff (al, am) | |
| 1023 | | mirror (E an) = E an | |
| 1024 | | mirror (A ao) = A ao | |
| 1025 | | mirror (Closed ap) = Closed ap | |
| 1026 | | mirror (NClosed aq) = NClosed aq | |
| 1027 | | mirror (Lt (Cn (cm, c, e))) = | |
| 1028 | (if eqop eq_nat cm 0 then Gt (Cn (0, c, Neg e)) | |
| 1029 | else Lt (Cn (suc (minus_nat cm 1), c, e))) | |
| 1030 | | mirror (Le (Cn (dm, c, e))) = | |
| 1031 | (if eqop eq_nat dm 0 then Ge (Cn (0, c, Neg e)) | |
| 1032 | else Le (Cn (suc (minus_nat dm 1), c, e))) | |
| 1033 | | mirror (Gt (Cn (em, c, e))) = | |
| 1034 | (if eqop eq_nat em 0 then Lt (Cn (0, c, Neg e)) | |
| 1035 | else Gt (Cn (suc (minus_nat em 1), c, e))) | |
| 1036 | | mirror (Ge (Cn (fm, c, e))) = | |
| 1037 | (if eqop eq_nat fm 0 then Le (Cn (0, c, Neg e)) | |
| 1038 | else Ge (Cn (suc (minus_nat fm 1), c, e))) | |
| 1039 | | mirror (Eq (Cn (gm, c, e))) = | |
| 1040 | (if eqop eq_nat gm 0 then Eq (Cn (0, c, Neg e)) | |
| 1041 | else Eq (Cn (suc (minus_nat gm 1), c, e))) | |
| 1042 | | mirror (NEq (Cn (hm, c, e))) = | |
| 1043 | (if eqop eq_nat hm 0 then NEq (Cn (0, c, Neg e)) | |
| 1044 | else NEq (Cn (suc (minus_nat hm 1), c, e))) | |
| 1045 | | mirror (Dvd (i, Cn (im, c, e))) = | |
| 1046 | (if eqop eq_nat im 0 then Dvd (i, Cn (0, c, Neg e)) | |
| 1047 | else Dvd (i, Cn (suc (minus_nat im 1), c, e))) | |
| 1048 | | mirror (NDvd (i, Cn (jm, c, e))) = | |
| 1049 | (if eqop eq_nat jm 0 then NDvd (i, Cn (0, c, Neg e)) | |
| 1050 | else NDvd (i, Cn (suc (minus_nat jm 1), c, e))); | |
| 1051 | ||
| 1052 | fun size_list [] = 0 | |
| 1053 | | size_list (a :: lista) = IntInf.+ (size_list lista, suc 0); | |
| 23466 | 1054 | |
| 29787 | 1055 | fun alpha (And (p, q)) = append (alpha p) (alpha q) | 
| 1056 | | alpha (Or (p, q)) = append (alpha p) (alpha q) | |
| 1057 | | alpha T = [] | |
| 1058 | | alpha F = [] | |
| 1059 | | alpha (Lt (C bo)) = [] | |
| 1060 | | alpha (Lt (Bound bp)) = [] | |
| 1061 | | alpha (Lt (Neg bt)) = [] | |
| 1062 | | alpha (Lt (Add (bu, bv))) = [] | |
| 1063 | | alpha (Lt (Sub (bw, bx))) = [] | |
| 1064 | | alpha (Lt (Mul (by, bz))) = [] | |
| 1065 | | alpha (Le (C co)) = [] | |
| 1066 | | alpha (Le (Bound cp)) = [] | |
| 1067 | | alpha (Le (Neg ct)) = [] | |
| 1068 | | alpha (Le (Add (cu, cv))) = [] | |
| 1069 | | alpha (Le (Sub (cw, cx))) = [] | |
| 1070 | | alpha (Le (Mul (cy, cz))) = [] | |
| 1071 | | alpha (Gt (C doa)) = [] | |
| 1072 | | alpha (Gt (Bound dp)) = [] | |
| 1073 | | alpha (Gt (Neg dt)) = [] | |
| 1074 | | alpha (Gt (Add (du, dv))) = [] | |
| 1075 | | alpha (Gt (Sub (dw, dx))) = [] | |
| 1076 | | alpha (Gt (Mul (dy, dz))) = [] | |
| 1077 | | alpha (Ge (C eo)) = [] | |
| 1078 | | alpha (Ge (Bound ep)) = [] | |
| 1079 | | alpha (Ge (Neg et)) = [] | |
| 1080 | | alpha (Ge (Add (eu, ev))) = [] | |
| 1081 | | alpha (Ge (Sub (ew, ex))) = [] | |
| 1082 | | alpha (Ge (Mul (ey, ez))) = [] | |
| 1083 | | alpha (Eq (C fo)) = [] | |
| 1084 | | alpha (Eq (Bound fp)) = [] | |
| 1085 | | alpha (Eq (Neg ft)) = [] | |
| 1086 | | alpha (Eq (Add (fu, fv))) = [] | |
| 1087 | | alpha (Eq (Sub (fw, fx))) = [] | |
| 1088 | | alpha (Eq (Mul (fy, fz))) = [] | |
| 1089 | | alpha (NEq (C go)) = [] | |
| 1090 | | alpha (NEq (Bound gp)) = [] | |
| 1091 | | alpha (NEq (Neg gt)) = [] | |
| 1092 | | alpha (NEq (Add (gu, gv))) = [] | |
| 1093 | | alpha (NEq (Sub (gw, gx))) = [] | |
| 1094 | | alpha (NEq (Mul (gy, gz))) = [] | |
| 1095 | | alpha (Dvd (aa, ab)) = [] | |
| 1096 | | alpha (NDvd (ac, ad)) = [] | |
| 1097 | | alpha (Not ae) = [] | |
| 1098 | | alpha (Imp (aj, ak)) = [] | |
| 1099 | | alpha (Iff (al, am)) = [] | |
| 1100 | | alpha (E an) = [] | |
| 1101 | | alpha (A ao) = [] | |
| 1102 | | alpha (Closed ap) = [] | |
| 1103 | | alpha (NClosed aq) = [] | |
| 1104 | | alpha (Lt (Cn (cm, c, e))) = (if eqop eq_nat cm 0 then [e] else []) | |
| 1105 | | alpha (Le (Cn (dm, c, e))) = | |
| 1106 | (if eqop eq_nat dm 0 then [Add (C (~1 : IntInf.int), e)] else []) | |
| 1107 | | alpha (Gt (Cn (em, c, e))) = (if eqop eq_nat em 0 then [] else []) | |
| 1108 | | alpha (Ge (Cn (fm, c, e))) = (if eqop eq_nat fm 0 then [] else []) | |
| 1109 | | alpha (Eq (Cn (gm, c, e))) = | |
| 1110 | (if eqop eq_nat gm 0 then [Add (C (~1 : IntInf.int), e)] else []) | |
| 1111 | | alpha (NEq (Cn (hm, c, e))) = (if eqop eq_nat hm 0 then [e] else []); | |
| 1112 | ||
| 1113 | fun beta (And (p, q)) = append (beta p) (beta q) | |
| 1114 | | beta (Or (p, q)) = append (beta p) (beta q) | |
| 1115 | | beta T = [] | |
| 1116 | | beta F = [] | |
| 1117 | | beta (Lt (C bo)) = [] | |
| 1118 | | beta (Lt (Bound bp)) = [] | |
| 1119 | | beta (Lt (Neg bt)) = [] | |
| 1120 | | beta (Lt (Add (bu, bv))) = [] | |
| 1121 | | beta (Lt (Sub (bw, bx))) = [] | |
| 1122 | | beta (Lt (Mul (by, bz))) = [] | |
| 1123 | | beta (Le (C co)) = [] | |
| 1124 | | beta (Le (Bound cp)) = [] | |
| 1125 | | beta (Le (Neg ct)) = [] | |
| 1126 | | beta (Le (Add (cu, cv))) = [] | |
| 1127 | | beta (Le (Sub (cw, cx))) = [] | |
| 1128 | | beta (Le (Mul (cy, cz))) = [] | |
| 1129 | | beta (Gt (C doa)) = [] | |
| 1130 | | beta (Gt (Bound dp)) = [] | |
| 1131 | | beta (Gt (Neg dt)) = [] | |
| 1132 | | beta (Gt (Add (du, dv))) = [] | |
| 1133 | | beta (Gt (Sub (dw, dx))) = [] | |
| 1134 | | beta (Gt (Mul (dy, dz))) = [] | |
| 1135 | | beta (Ge (C eo)) = [] | |
| 1136 | | beta (Ge (Bound ep)) = [] | |
| 1137 | | beta (Ge (Neg et)) = [] | |
| 1138 | | beta (Ge (Add (eu, ev))) = [] | |
| 1139 | | beta (Ge (Sub (ew, ex))) = [] | |
| 1140 | | beta (Ge (Mul (ey, ez))) = [] | |
| 1141 | | beta (Eq (C fo)) = [] | |
| 1142 | | beta (Eq (Bound fp)) = [] | |
| 1143 | | beta (Eq (Neg ft)) = [] | |
| 1144 | | beta (Eq (Add (fu, fv))) = [] | |
| 1145 | | beta (Eq (Sub (fw, fx))) = [] | |
| 1146 | | beta (Eq (Mul (fy, fz))) = [] | |
| 1147 | | beta (NEq (C go)) = [] | |
| 1148 | | beta (NEq (Bound gp)) = [] | |
| 1149 | | beta (NEq (Neg gt)) = [] | |
| 1150 | | beta (NEq (Add (gu, gv))) = [] | |
| 1151 | | beta (NEq (Sub (gw, gx))) = [] | |
| 1152 | | beta (NEq (Mul (gy, gz))) = [] | |
| 1153 | | beta (Dvd (aa, ab)) = [] | |
| 1154 | | beta (NDvd (ac, ad)) = [] | |
| 1155 | | beta (Not ae) = [] | |
| 1156 | | beta (Imp (aj, ak)) = [] | |
| 1157 | | beta (Iff (al, am)) = [] | |
| 1158 | | beta (E an) = [] | |
| 1159 | | beta (A ao) = [] | |
| 1160 | | beta (Closed ap) = [] | |
| 1161 | | beta (NClosed aq) = [] | |
| 1162 | | beta (Lt (Cn (cm, c, e))) = (if eqop eq_nat cm 0 then [] else []) | |
| 1163 | | beta (Le (Cn (dm, c, e))) = (if eqop eq_nat dm 0 then [] else []) | |
| 1164 | | beta (Gt (Cn (em, c, e))) = (if eqop eq_nat em 0 then [Neg e] else []) | |
| 1165 | | beta (Ge (Cn (fm, c, e))) = | |
| 1166 | (if eqop eq_nat fm 0 then [Sub (C (~1 : IntInf.int), e)] else []) | |
| 1167 | | beta (Eq (Cn (gm, c, e))) = | |
| 1168 | (if eqop eq_nat gm 0 then [Sub (C (~1 : IntInf.int), e)] else []) | |
| 1169 | | beta (NEq (Cn (hm, c, e))) = (if eqop eq_nat hm 0 then [Neg e] else []); | |
| 1170 | ||
| 1171 | fun member A_ x [] = false | |
| 1172 | | member A_ x (y :: ys) = eqop A_ x y orelse member A_ x ys; | |
| 1173 | ||
| 1174 | fun remdups A_ [] = [] | |
| 1175 | | remdups A_ (x :: xs) = | |
| 1176 | (if member A_ x xs then remdups A_ xs else x :: remdups A_ xs); | |
| 1177 | ||
| 1178 | fun delta (And (p, q)) = zlcm (delta p) (delta q) | |
| 1179 | | delta (Or (p, q)) = zlcm (delta p) (delta q) | |
| 1180 | | delta T = (1 : IntInf.int) | |
| 1181 | | delta F = (1 : IntInf.int) | |
| 1182 | | delta (Lt u) = (1 : IntInf.int) | |
| 1183 | | delta (Le v) = (1 : IntInf.int) | |
| 1184 | | delta (Gt w) = (1 : IntInf.int) | |
| 1185 | | delta (Ge x) = (1 : IntInf.int) | |
| 29939 | 1186 | | delta (Eq y) = (1 : IntInf.int) | 
| 29787 | 1187 | | delta (NEq z) = (1 : IntInf.int) | 
| 1188 | | delta (Dvd (aa, C bo)) = (1 : IntInf.int) | |
| 1189 | | delta (Dvd (aa, Bound bp)) = (1 : IntInf.int) | |
| 1190 | | delta (Dvd (aa, Neg bt)) = (1 : IntInf.int) | |
| 1191 | | delta (Dvd (aa, Add (bu, bv))) = (1 : IntInf.int) | |
| 1192 | | delta (Dvd (aa, Sub (bw, bx))) = (1 : IntInf.int) | |
| 1193 | | delta (Dvd (aa, Mul (by, bz))) = (1 : IntInf.int) | |
| 1194 | | delta (NDvd (ac, C co)) = (1 : IntInf.int) | |
| 1195 | | delta (NDvd (ac, Bound cp)) = (1 : IntInf.int) | |
| 1196 | | delta (NDvd (ac, Neg ct)) = (1 : IntInf.int) | |
| 1197 | | delta (NDvd (ac, Add (cu, cv))) = (1 : IntInf.int) | |
| 1198 | | delta (NDvd (ac, Sub (cw, cx))) = (1 : IntInf.int) | |
| 1199 | | delta (NDvd (ac, Mul (cy, cz))) = (1 : IntInf.int) | |
| 1200 | | delta (Not ae) = (1 : IntInf.int) | |
| 1201 | | delta (Imp (aj, ak)) = (1 : IntInf.int) | |
| 1202 | | delta (Iff (al, am)) = (1 : IntInf.int) | |
| 1203 | | delta (E an) = (1 : IntInf.int) | |
| 1204 | | delta (A ao) = (1 : IntInf.int) | |
| 1205 | | delta (Closed ap) = (1 : IntInf.int) | |
| 1206 | | delta (NClosed aq) = (1 : IntInf.int) | |
| 29939 | 1207 | | delta (Dvd (i, Cn (cm, c, e))) = | 
| 1208 | (if eqop eq_nat cm 0 then i else (1 : IntInf.int)) | |
| 1209 | | delta (NDvd (i, Cn (dm, c, e))) = | |
| 1210 | (if eqop eq_nat dm 0 then i else (1 : IntInf.int)); | |
| 29787 | 1211 | |
| 1212 | fun div_int a b = fst (divmoda a b); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1213 | |
| 29787 | 1214 | fun a_beta (And (p, q)) = (fn k => And (a_beta p k, a_beta q k)) | 
| 1215 | | a_beta (Or (p, q)) = (fn k => Or (a_beta p k, a_beta q k)) | |
| 1216 | | a_beta T = (fn k => T) | |
| 1217 | | a_beta F = (fn k => F) | |
| 1218 | | a_beta (Lt (C bo)) = (fn k => Lt (C bo)) | |
| 1219 | | a_beta (Lt (Bound bp)) = (fn k => Lt (Bound bp)) | |
| 1220 | | a_beta (Lt (Neg bt)) = (fn k => Lt (Neg bt)) | |
| 1221 | | a_beta (Lt (Add (bu, bv))) = (fn k => Lt (Add (bu, bv))) | |
| 1222 | | a_beta (Lt (Sub (bw, bx))) = (fn k => Lt (Sub (bw, bx))) | |
| 1223 | | a_beta (Lt (Mul (by, bz))) = (fn k => Lt (Mul (by, bz))) | |
| 1224 | | a_beta (Le (C co)) = (fn k => Le (C co)) | |
| 1225 | | a_beta (Le (Bound cp)) = (fn k => Le (Bound cp)) | |
| 1226 | | a_beta (Le (Neg ct)) = (fn k => Le (Neg ct)) | |
| 1227 | | a_beta (Le (Add (cu, cv))) = (fn k => Le (Add (cu, cv))) | |
| 1228 | | a_beta (Le (Sub (cw, cx))) = (fn k => Le (Sub (cw, cx))) | |
| 1229 | | a_beta (Le (Mul (cy, cz))) = (fn k => Le (Mul (cy, cz))) | |
| 1230 | | a_beta (Gt (C doa)) = (fn k => Gt (C doa)) | |
| 1231 | | a_beta (Gt (Bound dp)) = (fn k => Gt (Bound dp)) | |
| 1232 | | a_beta (Gt (Neg dt)) = (fn k => Gt (Neg dt)) | |
| 1233 | | a_beta (Gt (Add (du, dv))) = (fn k => Gt (Add (du, dv))) | |
| 1234 | | a_beta (Gt (Sub (dw, dx))) = (fn k => Gt (Sub (dw, dx))) | |
| 1235 | | a_beta (Gt (Mul (dy, dz))) = (fn k => Gt (Mul (dy, dz))) | |
| 1236 | | a_beta (Ge (C eo)) = (fn k => Ge (C eo)) | |
| 1237 | | a_beta (Ge (Bound ep)) = (fn k => Ge (Bound ep)) | |
| 1238 | | a_beta (Ge (Neg et)) = (fn k => Ge (Neg et)) | |
| 1239 | | a_beta (Ge (Add (eu, ev))) = (fn k => Ge (Add (eu, ev))) | |
| 1240 | | a_beta (Ge (Sub (ew, ex))) = (fn k => Ge (Sub (ew, ex))) | |
| 1241 | | a_beta (Ge (Mul (ey, ez))) = (fn k => Ge (Mul (ey, ez))) | |
| 1242 | | a_beta (Eq (C fo)) = (fn k => Eq (C fo)) | |
| 1243 | | a_beta (Eq (Bound fp)) = (fn k => Eq (Bound fp)) | |
| 1244 | | a_beta (Eq (Neg ft)) = (fn k => Eq (Neg ft)) | |
| 1245 | | a_beta (Eq (Add (fu, fv))) = (fn k => Eq (Add (fu, fv))) | |
| 1246 | | a_beta (Eq (Sub (fw, fx))) = (fn k => Eq (Sub (fw, fx))) | |
| 1247 | | a_beta (Eq (Mul (fy, fz))) = (fn k => Eq (Mul (fy, fz))) | |
| 1248 | | a_beta (NEq (C go)) = (fn k => NEq (C go)) | |
| 1249 | | a_beta (NEq (Bound gp)) = (fn k => NEq (Bound gp)) | |
| 1250 | | a_beta (NEq (Neg gt)) = (fn k => NEq (Neg gt)) | |
| 1251 | | a_beta (NEq (Add (gu, gv))) = (fn k => NEq (Add (gu, gv))) | |
| 1252 | | a_beta (NEq (Sub (gw, gx))) = (fn k => NEq (Sub (gw, gx))) | |
| 1253 | | a_beta (NEq (Mul (gy, gz))) = (fn k => NEq (Mul (gy, gz))) | |
| 1254 | | a_beta (Dvd (aa, C ho)) = (fn k => Dvd (aa, C ho)) | |
| 1255 | | a_beta (Dvd (aa, Bound hp)) = (fn k => Dvd (aa, Bound hp)) | |
| 1256 | | a_beta (Dvd (aa, Neg ht)) = (fn k => Dvd (aa, Neg ht)) | |
| 1257 | | a_beta (Dvd (aa, Add (hu, hv))) = (fn k => Dvd (aa, Add (hu, hv))) | |
| 1258 | | a_beta (Dvd (aa, Sub (hw, hx))) = (fn k => Dvd (aa, Sub (hw, hx))) | |
| 1259 | | a_beta (Dvd (aa, Mul (hy, hz))) = (fn k => Dvd (aa, Mul (hy, hz))) | |
| 1260 | | a_beta (NDvd (ac, C io)) = (fn k => NDvd (ac, C io)) | |
| 1261 | | a_beta (NDvd (ac, Bound ip)) = (fn k => NDvd (ac, Bound ip)) | |
| 1262 | | a_beta (NDvd (ac, Neg it)) = (fn k => NDvd (ac, Neg it)) | |
| 1263 | | a_beta (NDvd (ac, Add (iu, iv))) = (fn k => NDvd (ac, Add (iu, iv))) | |
| 1264 | | a_beta (NDvd (ac, Sub (iw, ix))) = (fn k => NDvd (ac, Sub (iw, ix))) | |
| 1265 | | a_beta (NDvd (ac, Mul (iy, iz))) = (fn k => NDvd (ac, Mul (iy, iz))) | |
| 1266 | | a_beta (Not ae) = (fn k => Not ae) | |
| 1267 | | a_beta (Imp (aj, ak)) = (fn k => Imp (aj, ak)) | |
| 1268 | | a_beta (Iff (al, am)) = (fn k => Iff (al, am)) | |
| 1269 | | a_beta (E an) = (fn k => E an) | |
| 1270 | | a_beta (A ao) = (fn k => A ao) | |
| 1271 | | a_beta (Closed ap) = (fn k => Closed ap) | |
| 1272 | | a_beta (NClosed aq) = (fn k => NClosed aq) | |
| 1273 | | a_beta (Lt (Cn (cm, c, e))) = | |
| 1274 | (if eqop eq_nat cm 0 | |
| 1275 | then (fn k => Lt (Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1276 | else (fn k => Lt (Cn (suc (minus_nat cm 1), c, e)))) | |
| 1277 | | a_beta (Le (Cn (dm, c, e))) = | |
| 1278 | (if eqop eq_nat dm 0 | |
| 1279 | then (fn k => Le (Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1280 | else (fn k => Le (Cn (suc (minus_nat dm 1), c, e)))) | |
| 1281 | | a_beta (Gt (Cn (em, c, e))) = | |
| 1282 | (if eqop eq_nat em 0 | |
| 1283 | then (fn k => Gt (Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1284 | else (fn k => Gt (Cn (suc (minus_nat em 1), c, e)))) | |
| 1285 | | a_beta (Ge (Cn (fm, c, e))) = | |
| 1286 | (if eqop eq_nat fm 0 | |
| 1287 | then (fn k => Ge (Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1288 | else (fn k => Ge (Cn (suc (minus_nat fm 1), c, e)))) | |
| 1289 | | a_beta (Eq (Cn (gm, c, e))) = | |
| 1290 | (if eqop eq_nat gm 0 | |
| 1291 | then (fn k => Eq (Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1292 | else (fn k => Eq (Cn (suc (minus_nat gm 1), c, e)))) | |
| 1293 | | a_beta (NEq (Cn (hm, c, e))) = | |
| 1294 | (if eqop eq_nat hm 0 | |
| 1295 | then (fn k => NEq (Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1296 | else (fn k => NEq (Cn (suc (minus_nat hm 1), c, e)))) | |
| 1297 | | a_beta (Dvd (i, Cn (im, c, e))) = | |
| 1298 | (if eqop eq_nat im 0 | |
| 1299 | then (fn k => | |
| 1300 | Dvd (IntInf.* (div_int k c, i), | |
| 1301 | Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1302 | else (fn k => Dvd (i, Cn (suc (minus_nat im 1), c, e)))) | |
| 1303 | | a_beta (NDvd (i, Cn (jm, c, e))) = | |
| 1304 | (if eqop eq_nat jm 0 | |
| 1305 | then (fn k => | |
| 1306 | NDvd (IntInf.* (div_int k c, i), | |
| 1307 | Cn (0, (1 : IntInf.int), Mul (div_int k c, e)))) | |
| 1308 | else (fn k => NDvd (i, Cn (suc (minus_nat jm 1), c, e)))); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1309 | |
| 29787 | 1310 | fun zeta (And (p, q)) = zlcm (zeta p) (zeta q) | 
| 1311 | | zeta (Or (p, q)) = zlcm (zeta p) (zeta q) | |
| 1312 | | zeta T = (1 : IntInf.int) | |
| 1313 | | zeta F = (1 : IntInf.int) | |
| 1314 | | zeta (Lt (C bo)) = (1 : IntInf.int) | |
| 1315 | | zeta (Lt (Bound bp)) = (1 : IntInf.int) | |
| 1316 | | zeta (Lt (Neg bt)) = (1 : IntInf.int) | |
| 1317 | | zeta (Lt (Add (bu, bv))) = (1 : IntInf.int) | |
| 1318 | | zeta (Lt (Sub (bw, bx))) = (1 : IntInf.int) | |
| 1319 | | zeta (Lt (Mul (by, bz))) = (1 : IntInf.int) | |
| 1320 | | zeta (Le (C co)) = (1 : IntInf.int) | |
| 1321 | | zeta (Le (Bound cp)) = (1 : IntInf.int) | |
| 1322 | | zeta (Le (Neg ct)) = (1 : IntInf.int) | |
| 1323 | | zeta (Le (Add (cu, cv))) = (1 : IntInf.int) | |
| 1324 | | zeta (Le (Sub (cw, cx))) = (1 : IntInf.int) | |
| 1325 | | zeta (Le (Mul (cy, cz))) = (1 : IntInf.int) | |
| 1326 | | zeta (Gt (C doa)) = (1 : IntInf.int) | |
| 1327 | | zeta (Gt (Bound dp)) = (1 : IntInf.int) | |
| 1328 | | zeta (Gt (Neg dt)) = (1 : IntInf.int) | |
| 1329 | | zeta (Gt (Add (du, dv))) = (1 : IntInf.int) | |
| 1330 | | zeta (Gt (Sub (dw, dx))) = (1 : IntInf.int) | |
| 1331 | | zeta (Gt (Mul (dy, dz))) = (1 : IntInf.int) | |
| 1332 | | zeta (Ge (C eo)) = (1 : IntInf.int) | |
| 1333 | | zeta (Ge (Bound ep)) = (1 : IntInf.int) | |
| 1334 | | zeta (Ge (Neg et)) = (1 : IntInf.int) | |
| 1335 | | zeta (Ge (Add (eu, ev))) = (1 : IntInf.int) | |
| 1336 | | zeta (Ge (Sub (ew, ex))) = (1 : IntInf.int) | |
| 1337 | | zeta (Ge (Mul (ey, ez))) = (1 : IntInf.int) | |
| 1338 | | zeta (Eq (C fo)) = (1 : IntInf.int) | |
| 1339 | | zeta (Eq (Bound fp)) = (1 : IntInf.int) | |
| 1340 | | zeta (Eq (Neg ft)) = (1 : IntInf.int) | |
| 1341 | | zeta (Eq (Add (fu, fv))) = (1 : IntInf.int) | |
| 1342 | | zeta (Eq (Sub (fw, fx))) = (1 : IntInf.int) | |
| 1343 | | zeta (Eq (Mul (fy, fz))) = (1 : IntInf.int) | |
| 1344 | | zeta (NEq (C go)) = (1 : IntInf.int) | |
| 1345 | | zeta (NEq (Bound gp)) = (1 : IntInf.int) | |
| 1346 | | zeta (NEq (Neg gt)) = (1 : IntInf.int) | |
| 1347 | | zeta (NEq (Add (gu, gv))) = (1 : IntInf.int) | |
| 1348 | | zeta (NEq (Sub (gw, gx))) = (1 : IntInf.int) | |
| 1349 | | zeta (NEq (Mul (gy, gz))) = (1 : IntInf.int) | |
| 1350 | | zeta (Dvd (aa, C ho)) = (1 : IntInf.int) | |
| 1351 | | zeta (Dvd (aa, Bound hp)) = (1 : IntInf.int) | |
| 1352 | | zeta (Dvd (aa, Neg ht)) = (1 : IntInf.int) | |
| 1353 | | zeta (Dvd (aa, Add (hu, hv))) = (1 : IntInf.int) | |
| 1354 | | zeta (Dvd (aa, Sub (hw, hx))) = (1 : IntInf.int) | |
| 1355 | | zeta (Dvd (aa, Mul (hy, hz))) = (1 : IntInf.int) | |
| 1356 | | zeta (NDvd (ac, C io)) = (1 : IntInf.int) | |
| 1357 | | zeta (NDvd (ac, Bound ip)) = (1 : IntInf.int) | |
| 1358 | | zeta (NDvd (ac, Neg it)) = (1 : IntInf.int) | |
| 1359 | | zeta (NDvd (ac, Add (iu, iv))) = (1 : IntInf.int) | |
| 1360 | | zeta (NDvd (ac, Sub (iw, ix))) = (1 : IntInf.int) | |
| 1361 | | zeta (NDvd (ac, Mul (iy, iz))) = (1 : IntInf.int) | |
| 1362 | | zeta (Not ae) = (1 : IntInf.int) | |
| 1363 | | zeta (Imp (aj, ak)) = (1 : IntInf.int) | |
| 1364 | | zeta (Iff (al, am)) = (1 : IntInf.int) | |
| 1365 | | zeta (E an) = (1 : IntInf.int) | |
| 1366 | | zeta (A ao) = (1 : IntInf.int) | |
| 1367 | | zeta (Closed ap) = (1 : IntInf.int) | |
| 1368 | | zeta (NClosed aq) = (1 : IntInf.int) | |
| 29939 | 1369 | | zeta (Lt (Cn (cm, c, e))) = | 
| 1370 | (if eqop eq_nat cm 0 then c else (1 : IntInf.int)) | |
| 1371 | | zeta (Le (Cn (dm, c, e))) = | |
| 1372 | (if eqop eq_nat dm 0 then c else (1 : IntInf.int)) | |
| 1373 | | zeta (Gt (Cn (em, c, e))) = | |
| 1374 | (if eqop eq_nat em 0 then c else (1 : IntInf.int)) | |
| 1375 | | zeta (Ge (Cn (fm, c, e))) = | |
| 1376 | (if eqop eq_nat fm 0 then c else (1 : IntInf.int)) | |
| 1377 | | zeta (Eq (Cn (gm, c, e))) = | |
| 1378 | (if eqop eq_nat gm 0 then c else (1 : IntInf.int)) | |
| 1379 | | zeta (NEq (Cn (hm, c, e))) = | |
| 1380 | (if eqop eq_nat hm 0 then c else (1 : IntInf.int)) | |
| 1381 | | zeta (Dvd (i, Cn (im, c, e))) = | |
| 1382 | (if eqop eq_nat im 0 then c else (1 : IntInf.int)) | |
| 1383 | | zeta (NDvd (i, Cn (jm, c, e))) = | |
| 1384 | (if eqop eq_nat jm 0 then c else (1 : IntInf.int)); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1385 | |
| 29787 | 1386 | fun zsplit0 (C c) = ((0 : IntInf.int), C c) | 
| 1387 | | zsplit0 (Bound n) = | |
| 1388 | (if eqop eq_nat n 0 then ((1 : IntInf.int), C (0 : IntInf.int)) | |
| 1389 | else ((0 : IntInf.int), Bound n)) | |
| 1390 | | zsplit0 (Cn (n, i, a)) = | |
| 1391 | let | |
| 1392 | val aa = zsplit0 a; | |
| 1393 | val (i', a') = aa; | |
| 1394 | in | |
| 1395 | (if eqop eq_nat n 0 then (IntInf.+ (i, i'), a') else (i', Cn (n, i, a'))) | |
| 1396 | end | |
| 1397 | | zsplit0 (Neg a) = | |
| 1398 | let | |
| 1399 | val aa = zsplit0 a; | |
| 1400 | val (i', a') = aa; | |
| 1401 | in | |
| 1402 | (IntInf.~ i', Neg a') | |
| 1403 | end | |
| 1404 | | zsplit0 (Add (a, b)) = | |
| 1405 | let | |
| 1406 | val aa = zsplit0 a; | |
| 1407 | val (ia, a') = aa; | |
| 1408 | val ab = zsplit0 b; | |
| 1409 | val (ib, b') = ab; | |
| 1410 | in | |
| 1411 | (IntInf.+ (ia, ib), Add (a', b')) | |
| 1412 | end | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1413 | | zsplit0 (Sub (a, b)) = | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1414 | let | 
| 29787 | 1415 | val aa = zsplit0 a; | 
| 1416 | val (ia, a') = aa; | |
| 1417 | val ab = zsplit0 b; | |
| 1418 | val (ib, b') = ab; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1419 | in | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1420 | (IntInf.- (ia, ib), Sub (a', b')) | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1421 | end | 
| 29787 | 1422 | | zsplit0 (Mul (i, a)) = | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1423 | let | 
| 29787 | 1424 | val aa = zsplit0 a; | 
| 1425 | val (i', a') = aa; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1426 | in | 
| 29787 | 1427 | (IntInf.* (i, i'), Mul (i, a')) | 
| 1428 | end; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1429 | |
| 29787 | 1430 | fun zlfm (And (p, q)) = And (zlfm p, zlfm q) | 
| 1431 | | zlfm (Or (p, q)) = Or (zlfm p, zlfm q) | |
| 1432 | | zlfm (Imp (p, q)) = Or (zlfm (Not p), zlfm q) | |
| 1433 | | zlfm (Iff (p, q)) = | |
| 1434 | Or (And (zlfm p, zlfm q), And (zlfm (Not p), zlfm (Not q))) | |
| 1435 | | zlfm (Lt a) = | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1436 | let | 
| 29787 | 1437 | val aa = zsplit0 a; | 
| 1438 | val (c, r) = aa; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1439 | in | 
| 29787 | 1440 | (if eqop eq_int c (0 : IntInf.int) then Lt r | 
| 1441 | else (if IntInf.< ((0 : IntInf.int), c) then Lt (Cn (0, c, r)) | |
| 1442 | else Gt (Cn (0, IntInf.~ c, Neg r)))) | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1443 | end | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1444 | | zlfm (Le a) = | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1445 | let | 
| 29787 | 1446 | val aa = zsplit0 a; | 
| 1447 | val (c, r) = aa; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1448 | in | 
| 29787 | 1449 | (if eqop eq_int c (0 : IntInf.int) then Le r | 
| 1450 | else (if IntInf.< ((0 : IntInf.int), c) then Le (Cn (0, c, r)) | |
| 1451 | else Ge (Cn (0, IntInf.~ c, Neg r)))) | |
| 1452 | end | |
| 1453 | | zlfm (Gt a) = | |
| 1454 | let | |
| 1455 | val aa = zsplit0 a; | |
| 1456 | val (c, r) = aa; | |
| 1457 | in | |
| 1458 | (if eqop eq_int c (0 : IntInf.int) then Gt r | |
| 1459 | else (if IntInf.< ((0 : IntInf.int), c) then Gt (Cn (0, c, r)) | |
| 1460 | else Lt (Cn (0, IntInf.~ c, Neg r)))) | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1461 | end | 
| 29787 | 1462 | | zlfm (Ge a) = | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1463 | let | 
| 29787 | 1464 | val aa = zsplit0 a; | 
| 1465 | val (c, r) = aa; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1466 | in | 
| 29787 | 1467 | (if eqop eq_int c (0 : IntInf.int) then Ge r | 
| 1468 | else (if IntInf.< ((0 : IntInf.int), c) then Ge (Cn (0, c, r)) | |
| 1469 | else Le (Cn (0, IntInf.~ c, Neg r)))) | |
| 1470 | end | |
| 1471 | | zlfm (Eq a) = | |
| 1472 | let | |
| 1473 | val aa = zsplit0 a; | |
| 1474 | val (c, r) = aa; | |
| 1475 | in | |
| 1476 | (if eqop eq_int c (0 : IntInf.int) then Eq r | |
| 1477 | else (if IntInf.< ((0 : IntInf.int), c) then Eq (Cn (0, c, r)) | |
| 1478 | else Eq (Cn (0, IntInf.~ c, Neg r)))) | |
| 1479 | end | |
| 1480 | | zlfm (NEq a) = | |
| 1481 | let | |
| 1482 | val aa = zsplit0 a; | |
| 1483 | val (c, r) = aa; | |
| 1484 | in | |
| 1485 | (if eqop eq_int c (0 : IntInf.int) then NEq r | |
| 1486 | else (if IntInf.< ((0 : IntInf.int), c) then NEq (Cn (0, c, r)) | |
| 1487 | else NEq (Cn (0, IntInf.~ c, Neg r)))) | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1488 | end | 
| 29787 | 1489 | | zlfm (Dvd (i, a)) = | 
| 1490 | (if eqop eq_int i (0 : IntInf.int) then zlfm (Eq a) | |
| 1491 | else let | |
| 1492 | val aa = zsplit0 a; | |
| 1493 | val (c, r) = aa; | |
| 1494 | in | |
| 1495 | (if eqop eq_int c (0 : IntInf.int) then Dvd (abs_int i, r) | |
| 1496 | else (if IntInf.< ((0 : IntInf.int), c) | |
| 1497 | then Dvd (abs_int i, Cn (0, c, r)) | |
| 1498 | else Dvd (abs_int i, Cn (0, IntInf.~ c, Neg r)))) | |
| 1499 | end) | |
| 1500 | | zlfm (NDvd (i, a)) = | |
| 1501 | (if eqop eq_int i (0 : IntInf.int) then zlfm (NEq a) | |
| 1502 | else let | |
| 1503 | val aa = zsplit0 a; | |
| 1504 | val (c, r) = aa; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1505 | in | 
| 29787 | 1506 | (if eqop eq_int c (0 : IntInf.int) then NDvd (abs_int i, r) | 
| 1507 | else (if IntInf.< ((0 : IntInf.int), c) | |
| 1508 | then NDvd (abs_int i, Cn (0, c, r)) | |
| 1509 | else NDvd (abs_int i, Cn (0, IntInf.~ c, Neg r)))) | |
| 1510 | end) | |
| 1511 | | zlfm (Not (And (p, q))) = Or (zlfm (Not p), zlfm (Not q)) | |
| 1512 | | zlfm (Not (Or (p, q))) = And (zlfm (Not p), zlfm (Not q)) | |
| 1513 | | zlfm (Not (Imp (p, q))) = And (zlfm p, zlfm (Not q)) | |
| 1514 | | zlfm (Not (Iff (p, q))) = | |
| 1515 | Or (And (zlfm p, zlfm (Not q)), And (zlfm (Not p), zlfm q)) | |
| 1516 | | zlfm (Not (Not p)) = zlfm p | |
| 1517 | | zlfm (Not T) = F | |
| 1518 | | zlfm (Not F) = T | |
| 1519 | | zlfm (Not (Lt a)) = zlfm (Ge a) | |
| 1520 | | zlfm (Not (Le a)) = zlfm (Gt a) | |
| 1521 | | zlfm (Not (Gt a)) = zlfm (Le a) | |
| 1522 | | zlfm (Not (Ge a)) = zlfm (Lt a) | |
| 1523 | | zlfm (Not (Eq a)) = zlfm (NEq a) | |
| 1524 | | zlfm (Not (NEq a)) = zlfm (Eq a) | |
| 1525 | | zlfm (Not (Dvd (i, a))) = zlfm (NDvd (i, a)) | |
| 1526 | | zlfm (Not (NDvd (i, a))) = zlfm (Dvd (i, a)) | |
| 1527 | | zlfm (Not (Closed p)) = NClosed p | |
| 1528 | | zlfm (Not (NClosed p)) = Closed p | |
| 1529 | | zlfm T = T | |
| 1530 | | zlfm F = F | |
| 1531 | | zlfm (Not (E ci)) = Not (E ci) | |
| 1532 | | zlfm (Not (A cj)) = Not (A cj) | |
| 1533 | | zlfm (E ao) = E ao | |
| 1534 | | zlfm (A ap) = A ap | |
| 1535 | | zlfm (Closed aq) = Closed aq | |
| 1536 | | zlfm (NClosed ar) = NClosed ar; | |
| 23466 | 1537 | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1538 | fun unita p = | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1539 | let | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1540 | val p' = zlfm p; | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1541 | val l = zeta p'; | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1542 | val q = | 
| 29787 | 1543 | And (Dvd (l, Cn (0, (1 : IntInf.int), C (0 : IntInf.int))), a_beta p' l); | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1544 | val d = delta q; | 
| 23714 | 1545 | val b = remdups eq_numa (map simpnum (beta q)); | 
| 1546 | val a = remdups eq_numa (map simpnum (alpha q)); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1547 | in | 
| 29787 | 1548 | (if IntInf.<= (size_list b, size_list a) then (q, (b, d)) | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1549 | else (mirror q, (a, d))) | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1550 | end; | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1551 | |
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1552 | fun cooper p = | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1553 | let | 
| 29787 | 1554 | val a = unita p; | 
| 1555 | val (q, aa) = a; | |
| 1556 | val (b, d) = aa; | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1557 | val js = iupt (1 : IntInf.int) d; | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1558 | val mq = simpfm (minusinf q); | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1559 | val md = evaldjf (fn j => simpfm (subst0 (C j) mq)) js; | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1560 | in | 
| 29787 | 1561 | (if eqop eq_fma md T then T | 
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1562 | else let | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1563 | val qd = | 
| 29787 | 1564 | evaldjf (fn ab as (ba, j) => simpfm (subst0 (Add (ba, C j)) q)) | 
| 1565 | (concat (map (fn ba => map (fn ab => (ba, ab)) js) b)); | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1566 | in | 
| 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1567 | decr (disj md qd) | 
| 23466 | 1568 | end) | 
| 1569 | end; | |
| 1570 | ||
| 29787 | 1571 | fun prep (E T) = T | 
| 1572 | | prep (E F) = F | |
| 1573 | | prep (E (Or (p, q))) = Or (prep (E p), prep (E q)) | |
| 1574 | | prep (E (Imp (p, q))) = Or (prep (E (Not p)), prep (E q)) | |
| 1575 | | prep (E (Iff (p, q))) = | |
| 1576 | Or (prep (E (And (p, q))), prep (E (And (Not p, Not q)))) | |
| 1577 | | prep (E (Not (And (p, q)))) = Or (prep (E (Not p)), prep (E (Not q))) | |
| 1578 | | prep (E (Not (Imp (p, q)))) = prep (E (And (p, Not q))) | |
| 1579 | | prep (E (Not (Iff (p, q)))) = | |
| 1580 | Or (prep (E (And (p, Not q))), prep (E (And (Not p, q)))) | |
| 1581 | | prep (E (Lt ef)) = E (prep (Lt ef)) | |
| 1582 | | prep (E (Le eg)) = E (prep (Le eg)) | |
| 1583 | | prep (E (Gt eh)) = E (prep (Gt eh)) | |
| 1584 | | prep (E (Ge ei)) = E (prep (Ge ei)) | |
| 1585 | | prep (E (Eq ej)) = E (prep (Eq ej)) | |
| 1586 | | prep (E (NEq ek)) = E (prep (NEq ek)) | |
| 1587 | | prep (E (Dvd (el, em))) = E (prep (Dvd (el, em))) | |
| 1588 | | prep (E (NDvd (en, eo))) = E (prep (NDvd (en, eo))) | |
| 1589 | | prep (E (Not T)) = E (prep (Not T)) | |
| 1590 | | prep (E (Not F)) = E (prep (Not F)) | |
| 1591 | | prep (E (Not (Lt gw))) = E (prep (Not (Lt gw))) | |
| 1592 | | prep (E (Not (Le gx))) = E (prep (Not (Le gx))) | |
| 1593 | | prep (E (Not (Gt gy))) = E (prep (Not (Gt gy))) | |
| 1594 | | prep (E (Not (Ge gz))) = E (prep (Not (Ge gz))) | |
| 1595 | | prep (E (Not (Eq ha))) = E (prep (Not (Eq ha))) | |
| 1596 | | prep (E (Not (NEq hb))) = E (prep (Not (NEq hb))) | |
| 1597 | | prep (E (Not (Dvd (hc, hd)))) = E (prep (Not (Dvd (hc, hd)))) | |
| 1598 | | prep (E (Not (NDvd (he, hf)))) = E (prep (Not (NDvd (he, hf)))) | |
| 1599 | | prep (E (Not (Not hg))) = E (prep (Not (Not hg))) | |
| 1600 | | prep (E (Not (Or (hj, hk)))) = E (prep (Not (Or (hj, hk)))) | |
| 1601 | | prep (E (Not (E hp))) = E (prep (Not (E hp))) | |
| 1602 | | prep (E (Not (A hq))) = E (prep (Not (A hq))) | |
| 1603 | | prep (E (Not (Closed hr))) = E (prep (Not (Closed hr))) | |
| 1604 | | prep (E (Not (NClosed hs))) = E (prep (Not (NClosed hs))) | |
| 1605 | | prep (E (And (eq, er))) = E (prep (And (eq, er))) | |
| 1606 | | prep (E (E ey)) = E (prep (E ey)) | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1607 | | prep (E (A ez)) = E (prep (A ez)) | 
| 29787 | 1608 | | prep (E (Closed fa)) = E (prep (Closed fa)) | 
| 1609 | | prep (E (NClosed fb)) = E (prep (NClosed fb)) | |
| 1610 | | prep (A (And (p, q))) = And (prep (A p), prep (A q)) | |
| 1611 | | prep (A T) = prep (Not (E (Not T))) | |
| 1612 | | prep (A F) = prep (Not (E (Not F))) | |
| 1613 | | prep (A (Lt jn)) = prep (Not (E (Not (Lt jn)))) | |
| 1614 | | prep (A (Le jo)) = prep (Not (E (Not (Le jo)))) | |
| 1615 | | prep (A (Gt jp)) = prep (Not (E (Not (Gt jp)))) | |
| 1616 | | prep (A (Ge jq)) = prep (Not (E (Not (Ge jq)))) | |
| 1617 | | prep (A (Eq jr)) = prep (Not (E (Not (Eq jr)))) | |
| 1618 | | prep (A (NEq js)) = prep (Not (E (Not (NEq js)))) | |
| 1619 | | prep (A (Dvd (jt, ju))) = prep (Not (E (Not (Dvd (jt, ju))))) | |
| 1620 | | prep (A (NDvd (jv, jw))) = prep (Not (E (Not (NDvd (jv, jw))))) | |
| 1621 | | prep (A (Not jx)) = prep (Not (E (Not (Not jx)))) | |
| 1622 | | prep (A (Or (ka, kb))) = prep (Not (E (Not (Or (ka, kb))))) | |
| 1623 | | prep (A (Imp (kc, kd))) = prep (Not (E (Not (Imp (kc, kd))))) | |
| 1624 | | prep (A (Iff (ke, kf))) = prep (Not (E (Not (Iff (ke, kf))))) | |
| 1625 | | prep (A (E kg)) = prep (Not (E (Not (E kg)))) | |
| 1626 | | prep (A (A kh)) = prep (Not (E (Not (A kh)))) | |
| 1627 | | prep (A (Closed ki)) = prep (Not (E (Not (Closed ki)))) | |
| 1628 | | prep (A (NClosed kj)) = prep (Not (E (Not (NClosed kj)))) | |
| 1629 | | prep (Not (Not p)) = prep p | |
| 1630 | | prep (Not (And (p, q))) = Or (prep (Not p), prep (Not q)) | |
| 1631 | | prep (Not (A p)) = prep (E (Not p)) | |
| 1632 | | prep (Not (Or (p, q))) = And (prep (Not p), prep (Not q)) | |
| 1633 | | prep (Not (Imp (p, q))) = And (prep p, prep (Not q)) | |
| 1634 | | prep (Not (Iff (p, q))) = Or (prep (And (p, Not q)), prep (And (Not p, q))) | |
| 1635 | | prep (Not T) = Not (prep T) | |
| 1636 | | prep (Not F) = Not (prep F) | |
| 1637 | | prep (Not (Lt bo)) = Not (prep (Lt bo)) | |
| 1638 | | prep (Not (Le bp)) = Not (prep (Le bp)) | |
| 1639 | | prep (Not (Gt bq)) = Not (prep (Gt bq)) | |
| 1640 | | prep (Not (Ge br)) = Not (prep (Ge br)) | |
| 1641 | | prep (Not (Eq bs)) = Not (prep (Eq bs)) | |
| 1642 | | prep (Not (NEq bt)) = Not (prep (NEq bt)) | |
| 1643 | | prep (Not (Dvd (bu, bv))) = Not (prep (Dvd (bu, bv))) | |
| 1644 | | prep (Not (NDvd (bw, bx))) = Not (prep (NDvd (bw, bx))) | |
| 1645 | | prep (Not (E ch)) = Not (prep (E ch)) | |
| 1646 | | prep (Not (Closed cj)) = Not (prep (Closed cj)) | |
| 1647 | | prep (Not (NClosed ck)) = Not (prep (NClosed ck)) | |
| 1648 | | prep (Or (p, q)) = Or (prep p, prep q) | |
| 1649 | | prep (And (p, q)) = And (prep p, prep q) | |
| 1650 | | prep (Imp (p, q)) = prep (Or (Not p, q)) | |
| 1651 | | prep (Iff (p, q)) = Or (prep (And (p, q)), prep (And (Not p, Not q))) | |
| 1652 | | prep T = T | |
| 1653 | | prep F = F | |
| 1654 | | prep (Lt u) = Lt u | |
| 1655 | | prep (Le v) = Le v | |
| 1656 | | prep (Gt w) = Gt w | |
| 1657 | | prep (Ge x) = Ge x | |
| 1658 | | prep (Eq y) = Eq y | |
| 1659 | | prep (NEq z) = NEq z | |
| 1660 | | prep (Dvd (aa, ab)) = Dvd (aa, ab) | |
| 1661 | | prep (NDvd (ac, ad)) = NDvd (ac, ad) | |
| 1662 | | prep (Closed ap) = Closed ap | |
| 1663 | | prep (NClosed aq) = NClosed aq; | |
| 23466 | 1664 | |
| 29787 | 1665 | fun qelim (E p) = (fn qe => dj qe (qelim p qe)) | 
| 1666 | | qelim (A p) = (fn qe => nota (qe (qelim (Not p) qe))) | |
| 1667 | | qelim (Not p) = (fn qe => nota (qelim p qe)) | |
| 1668 | | qelim (And (p, q)) = (fn qe => conj (qelim p qe) (qelim q qe)) | |
| 1669 | | qelim (Or (p, q)) = (fn qe => disj (qelim p qe) (qelim q qe)) | |
| 1670 | | qelim (Imp (p, q)) = (fn qe => impa (qelim p qe) (qelim q qe)) | |
| 1671 | | qelim (Iff (p, q)) = (fn qe => iffa (qelim p qe) (qelim q qe)) | |
| 1672 | | qelim T = (fn y => simpfm T) | |
| 23689 
0410269099dc
replaced code generator framework for reflected cooper
 haftmann parents: 
23466diff
changeset | 1673 | | qelim F = (fn y => simpfm F) | 
| 29787 | 1674 | | qelim (Lt u) = (fn y => simpfm (Lt u)) | 
| 1675 | | qelim (Le v) = (fn y => simpfm (Le v)) | |
| 1676 | | qelim (Gt w) = (fn y => simpfm (Gt w)) | |
| 1677 | | qelim (Ge x) = (fn y => simpfm (Ge x)) | |
| 1678 | | qelim (Eq y) = (fn ya => simpfm (Eq y)) | |
| 1679 | | qelim (NEq z) = (fn y => simpfm (NEq z)) | |
| 1680 | | qelim (Dvd (aa, ab)) = (fn y => simpfm (Dvd (aa, ab))) | |
| 1681 | | qelim (NDvd (ac, ad)) = (fn y => simpfm (NDvd (ac, ad))) | |
| 1682 | | qelim (Closed ap) = (fn y => simpfm (Closed ap)) | |
| 1683 | | qelim (NClosed aq) = (fn y => simpfm (NClosed aq)); | |
| 23466 | 1684 | |
| 29787 | 1685 | fun pa p = qelim (prep p) cooper; | 
| 1686 | ||
| 1687 | fun neg z = IntInf.< (z, (0 : IntInf.int)); | |
| 1688 | ||
| 1689 | fun nat_aux i n = | |
| 1690 | (if IntInf.<= (i, (0 : IntInf.int)) then n | |
| 1691 | else nat_aux (IntInf.- (i, (1 : IntInf.int))) (suc n)); | |
| 23466 | 1692 | |
| 29939 | 1693 | fun adjust b = | 
| 1694 | (fn a as (q, r) => | |
| 1695 | (if IntInf.<= ((0 : IntInf.int), IntInf.- (r, b)) | |
| 1696 | then (IntInf.+ (IntInf.* ((2 : IntInf.int), q), (1 : IntInf.int)), | |
| 1697 | IntInf.- (r, b)) | |
| 1698 | else (IntInf.* ((2 : IntInf.int), q), r))); | |
| 1699 | ||
| 1700 | fun posDivAlg a b = | |
| 1701 | (if IntInf.< (a, b) orelse IntInf.<= (b, (0 : IntInf.int)) | |
| 1702 | then ((0 : IntInf.int), a) | |
| 1703 | else adjust b (posDivAlg a (IntInf.* ((2 : IntInf.int), b)))); | |
| 1704 | ||
| 23714 | 1705 | end; (*struct GeneratedCooper*) |