1 2open HolKernel boolLib bossLib Parse; val _ = new_theory "multiword"; 3 4val _ = set_trace "Unicode" 0; 5 6open pred_setTheory res_quanTheory arithmeticTheory wordsLib wordsTheory bitTheory; 7open pairTheory listTheory rich_listTheory relationTheory pairTheory integerTheory; 8open fcpTheory lcsymtacs; 9open ASCIInumbersTheory 10 11val _ = numLib.prefer_num(); 12 13infix \\ val op \\ = op THEN; 14val RW = REWRITE_RULE; 15val RW1 = ONCE_REWRITE_RULE; 16val REV = Tactical.REVERSE; 17 18 19(* general *) 20 21val b2n_def = Define `(b2n T = 1) /\ (b2n F = 0:num)`; 22val b2w_def = Define `b2w c = n2w (b2n c)`; 23 24val MULT_ADD_LESS_MULT = prove( 25 ``!m n k l j. m < l /\ n < k /\ j <= k ==> m * j + n < l * k:num``, 26 REPEAT STRIP_TAC 27 \\ `SUC m <= l` by ASM_REWRITE_TAC [GSYM LESS_EQ] 28 \\ `m * k + k <= l * k` by ASM_SIMP_TAC bool_ss [LE_MULT_RCANCEL,GSYM MULT] 29 \\ `m * j <= m * k` by ASM_SIMP_TAC bool_ss [LE_MULT_LCANCEL] 30 \\ DECIDE_TAC); 31 32val MULT_ADD_LESS_MULT_ADD = prove( 33 ``!m n k l p. m < l /\ n < k /\ p < k ==> m * k + n < l * k + p:num``, 34 REPEAT STRIP_TAC 35 \\ `SUC m <= l` by ASM_REWRITE_TAC [GSYM LESS_EQ] 36 \\ `m * k + k <= l * k` by ASM_SIMP_TAC bool_ss [LE_MULT_RCANCEL,GSYM MULT] 37 \\ DECIDE_TAC); 38 39val SPLIT_LET2 = prove( 40 ``!x y z P. (let (x,y) = z in P x y (x,y)) = 41 (let x = FST z in let y = SND z in P x y (x,y))``, 42 Cases_on `z` \\ SIMP_TAC std_ss [LET_THM]); 43 44 45(* multiword related general *) 46 47val dimwords_def = Define `dimwords k n = (2:num) ** (k * dimindex n)`; 48 49val k2mw_def = Define ` 50 (k2mw 0 n = []:('a word) list) /\ 51 (k2mw (SUC l) n = n2w n :: k2mw l (n DIV dimword(:'a)))`; 52 53val mw2n_def = Define ` 54 (mw2n [] = 0) /\ 55 (mw2n (x::xs) = w2n (x:'a word) + dimword (:'a) * mw2n xs)`; 56 57val mw2i_def = Define ` 58 (mw2i (F,xs) = (& (mw2n xs)):int) /\ 59 (mw2i (T,xs) = - & (mw2n xs))`; 60 61val n2mw_def = tDefine "n2mw" ` 62 n2mw n = if n = 0 then []:'a word list else 63 n2w (n MOD dimword (:'a)) :: n2mw (n DIV dimword(:'a))` 64 (WF_REL_TAC `measure I` 65 \\ SIMP_TAC std_ss [MATCH_MP DIV_LT_X ZERO_LT_dimword,ONE_LT_dimword] 66 \\ DECIDE_TAC); 67 68val n2mw_ind = fetch "-" "n2mw_ind" 69 70val i2mw_def = Define `i2mw i = (i < 0,n2mw (Num (ABS i)))`; 71 72val mw_ok_def = Define `mw_ok xs = ~(xs = []) ==> ~(LAST xs = 0w)`; 73 74val n2mw_0 = prove(``(n2mw 0 = [])``,METIS_TAC [n2mw_def]); 75val n2mw_thm = prove( 76 ``~(n = 0) ==> (n2mw n = (n2w (n MOD dimword (:'a)):'a word) :: 77 n2mw (n DIV dimword(:'a)))``, 78 METIS_TAC [n2mw_def]); 79 80val k2mw_SUC = REWRITE_CONV [k2mw_def] ``k2mw (SUC n) m``; 81 82val ZERO_LT_dimwords = prove(``!k. 0 < dimwords k (:'a)``, 83 Cases \\ SIMP_TAC std_ss [dimwords_def,EVAL ``0<2``,ZERO_LT_EXP]); 84 85val dimwords_SUC = 86 (REWRITE_CONV [dimwords_def,MULT,EXP_ADD] THENC 87 REWRITE_CONV [GSYM dimwords_def,GSYM dimword_def]) ``dimwords (SUC k) (:'a)``; 88 89val dimwords_thm = prove( 90 ``(dimwords 0 (:'a) = 1) /\ 91 (dimwords (SUC k) (:'a) = dimword (:'a) * dimwords k (:'a))``, 92 FULL_SIMP_TAC std_ss [dimwords_def,MULT,EXP_ADD,dimword_def,AC MULT_COMM MULT_ASSOC]); 93 94val mw_ok_CLAUSES = prove( 95 ``mw_ok [] /\ (mw_ok (x::xs) = ((xs = []) ==> ~(x = 0w)) /\ mw_ok xs)``, 96 SIMP_TAC std_ss [mw_ok_def,NOT_NIL_CONS] 97 \\ `(xs = []) \/ ?y ys. xs = SNOC y ys` by METIS_TAC [SNOC_CASES] 98 \\ ASM_SIMP_TAC std_ss [LAST_DEF,LAST_SNOC,NOT_SNOC_NIL]); 99 100val k2mw_SNOC = store_thm("k2mw_SNOC", 101 ``!k n. k2mw (SUC k) n = SNOC ((n2w (n DIV dimwords k (:'a))):'a word) (k2mw k n)``, 102 Induct THEN1 REWRITE_TAC [k2mw_def,SNOC,dimwords_def,MULT_CLAUSES,EXP,DIV_1] 103 \\ ONCE_REWRITE_TAC [k2mw_def] \\ ASM_REWRITE_TAC [SNOC] 104 \\ SIMP_TAC bool_ss [dimwords_def,dimword_def,MULT,EXP_ADD, 105 AC MULT_COMM MULT_ASSOC,DIV_DIV_DIV_MULT,EVAL ``0<2``,ZERO_LT_EXP,ZERO_LT_dimword]); 106 107val k2mw_mw2n = prove( 108 ``!xs. (k2mw (LENGTH xs) (mw2n xs) = xs)``, 109 Induct THEN1 EVAL_TAC 110 \\ FULL_SIMP_TAC std_ss [LENGTH,mw2n_def,k2mw_def,CONS_11] 111 \\ FULL_SIMP_TAC (srw_ss()) [] 112 \\ Cases \\ FULL_SIMP_TAC (srw_ss()) [] 113 \\ ONCE_REWRITE_TAC [ADD_COMM] \\ ONCE_REWRITE_TAC [MULT_COMM] 114 \\ FULL_SIMP_TAC std_ss [MOD_MULT,DIV_MULT]); 115 116val LENGTH_k2mw = store_thm("LENGTH_k2mw", 117 ``!k n. LENGTH (k2mw k n) = k``,Induct \\ ASM_REWRITE_TAC [k2mw_def,LENGTH]); 118 119val k2mw_mod = prove( 120 ``!k m. k2mw k (m MOD dimwords k (:'a)):('a word) list = k2mw k m``, 121 Induct \\ REWRITE_TAC [k2mw_def,dimwords_def,MULT,CONS_11] 122 \\ REWRITE_TAC [GSYM dimwords_def,EXP_ADD,GSYM dimword_def] 123 \\ ONCE_REWRITE_TAC [MULT_COMM] 124 \\ ASM_SIMP_TAC bool_ss [GSYM DIV_MOD_MOD_DIV,ZERO_LT_dimword,ZERO_LT_dimwords] 125 \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 126 \\ ASM_SIMP_TAC bool_ss [MOD_MULT_MOD,ZERO_LT_dimword,ZERO_LT_dimwords]); 127 128val mw2n_APPEND = prove( 129 ``!xs ys. mw2n (xs ++ ys) = mw2n xs + dimwords (LENGTH xs) (:'a) * mw2n (ys:'a word list)``, 130 Induct \\ ASM_SIMP_TAC std_ss [dimwords_thm,LENGTH,APPEND,mw2n_def] \\ DECIDE_TAC); 131 132val k2mw_APPEND = prove( 133 ``!k l m n. 134 k2mw k m ++ k2mw l n = 135 k2mw (k+l) (m MOD dimwords k (:'a) + dimwords k (:'a) * n) :('a word) list``, 136 Induct 137 THEN1 REWRITE_TAC [k2mw_def,APPEND_NIL,ADD_CLAUSES,dimwords_def,MULT_CLAUSES,EXP,MOD_1] 138 \\ ASM_REWRITE_TAC [ADD,k2mw_def,APPEND,CONS_11] \\ REPEAT STRIP_TAC THENL [ 139 ONCE_REWRITE_TAC [ADD_COMM] \\ ONCE_REWRITE_TAC [MULT_COMM] 140 \\ SIMP_TAC bool_ss [dimwords_SUC,MULT_ASSOC,n2w_11,MOD_TIMES,ZERO_LT_dimword] 141 \\ ONCE_REWRITE_TAC [MULT_COMM] 142 \\ SIMP_TAC bool_ss [MOD_MULT_MOD,ZERO_LT_dimword,ZERO_LT_dimwords], 143 REWRITE_TAC [dimwords_SUC,DECIDE ``m+k*p*q:num=k*q*p+m``] 144 \\ SIMP_TAC bool_ss [ADD_DIV_ADD_DIV,ZERO_LT_dimword,ZERO_LT_dimwords,DIV_MOD_MOD_DIV] 145 \\ METIS_TAC [MULT_COMM,ADD_COMM]]); 146 147val dimwords_ADD = 148 (REWRITE_CONV [dimwords_def,RIGHT_ADD_DISTRIB,EXP_ADD] THENC 149 REWRITE_CONV [GSYM dimwords_def]) ``dimwords (i+j) (:'a)``; 150 151val TWO_dimwords_LE_dinwords_SUC = prove( 152 ``!i. 2 * dimwords i (:'a) <= dimwords (SUC i) (:'a)``, 153 REWRITE_TAC [dimwords_def,MULT,EXP_ADD] \\ STRIP_TAC 154 \\ ASSUME_TAC (MATCH_MP LESS_OR DIMINDEX_GT_0) 155 \\ Q.SPEC_TAC (`2 ** (i * dimindex (:'a))`,`x`) 156 \\ IMP_RES_TAC LESS_EQUAL_ADD 157 \\ ASM_REWRITE_TAC [EXP_ADD,EXP,MULT_CLAUSES,DECIDE ``n*(m*k)=m*n*k:num``] 158 \\ `0 < 2**p` by ASM_REWRITE_TAC [ZERO_LT_EXP,EVAL ``0<2``] 159 \\ REWRITE_TAC [RW [MULT_CLAUSES] (Q.SPECL [`m`,`1`] LE_MULT_LCANCEL)] 160 \\ DECIDE_TAC); 161 162val k2mw_MOD_ADD = prove( 163 ``!i m n. k2mw i (m MOD dimwords i (:'a) + n) = k2mw i (m + n) :('a word)list``, 164 REPEAT STRIP_TAC 165 \\ STRIP_ASSUME_TAC (Q.SPEC `m` (MATCH_MP DA (Q.SPEC `i` ZERO_LT_dimwords))) 166 \\ ASM_SIMP_TAC bool_ss [GSYM ADD_ASSOC,MOD_MULT] 167 \\ ONCE_REWRITE_TAC [GSYM k2mw_mod] 168 \\ ASM_SIMP_TAC bool_ss [MOD_TIMES,ZERO_LT_dimwords]); 169 170val mw2n_lt = prove( 171 ``!xs. mw2n xs < dimwords (LENGTH (xs:'a word list)) (:'a)``, 172 Induct \\ SIMP_TAC std_ss [NOT_NIL_CONS,LENGTH,dimwords_thm,mw2n_def] 173 \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [ADD_COMM] \\ ONCE_REWRITE_TAC [MULT_COMM] 174 \\ MATCH_MP_TAC MULT_ADD_LESS_MULT \\ ASM_SIMP_TAC std_ss [w2n_lt]); 175 176val k2mw_EXISTS = store_thm("k2mw_EXISTS", 177 ``!xs:('a word) list. ?k. (xs = k2mw (LENGTH xs) k) /\ k < dimwords (LENGTH xs) (:'a)``, 178 Induct \\ REWRITE_TAC [k2mw_def,LENGTH] 179 THEN1 (Q.EXISTS_TAC `0` \\ REWRITE_TAC [dimwords_def,EXP,MULT_CLAUSES] \\ EVAL_TAC) 180 \\ POP_ASSUM (STRIP_ASSUME_TAC o GSYM) \\ REPEAT STRIP_TAC 181 \\ Q.EXISTS_TAC `k * dimword (:'a) + w2n h` 182 \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 183 \\ ASM_SIMP_TAC bool_ss [DIV_MULT,w2n_lt,MOD_MULT,n2w_w2n,dimwords_SUC] 184 \\ MATCH_MP_TAC MULT_ADD_LESS_MULT \\ ASM_REWRITE_TAC [w2n_lt,LESS_EQ_REFL]); 185 186val mw2n_MAP_ZERO = prove( 187 ``!xs ys. mw2n (xs ++ MAP (\x.0w) ys) = mw2n xs``, 188 Induct THEN1 (SIMP_TAC std_ss [APPEND] \\ Induct 189 \\ FULL_SIMP_TAC std_ss [MAP,mw2n_def,w2n_n2w,ZERO_LT_dimword]) 190 \\ ASM_SIMP_TAC std_ss [APPEND,mw2n_def]); 191 192val EXISTS_k2mw = prove( 193 ``!(xs:'a word list). 194 ?n k. (xs = k2mw k n) /\ (LENGTH xs = k) /\ n < dimwords k (:'a)``, 195 Induct \\ FULL_SIMP_TAC std_ss [k2mw_def,LENGTH,CONS_11] \\ REPEAT STRIP_TAC 196 THEN1 (Q.EXISTS_TAC `0` \\ SIMP_TAC std_ss [ZERO_LT_dimwords]) 197 \\ Q.EXISTS_TAC `n * dimword (:'a) + w2n h` 198 \\ ASM_SIMP_TAC std_ss [MATCH_MP DIV_MULT (SPEC_ALL w2n_lt)] 199 \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 200 \\ SIMP_TAC std_ss [MATCH_MP MOD_TIMES ZERO_LT_dimword] 201 \\ SIMP_TAC std_ss [n2w_mod,n2w_w2n,dimwords_thm] 202 \\ CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [MULT_COMM])) 203 \\ ONCE_REWRITE_TAC [MULT_COMM] \\ MATCH_MP_TAC MULT_ADD_LESS_MULT 204 \\ ASM_SIMP_TAC std_ss [w2n_lt]); 205 206val mw2n_k2mw = prove( 207 ``!k n. n < dimwords k (:'a) ==> (mw2n ((k2mw k n):'a word list) = n)``, 208 Induct \\ SIMP_TAC std_ss [dimwords_thm,DECIDE ``n<1 = (n = 0)``, 209 k2mw_def,mw2n_def,RW1[MULT_COMM](GSYM DIV_LT_X),ZERO_LT_dimwords,ZERO_LT_dimword] 210 \\ REPEAT STRIP_TAC \\ RES_TAC \\ ASM_SIMP_TAC std_ss [w2n_n2w] 211 \\ METIS_TAC [DIVISION,ZERO_LT_dimword,ADD_COMM,MULT_COMM]); 212 213val mw2n_gt = prove( 214 ``!xs. mw_ok xs /\ ~(xs = []) ==> dimwords (LENGTH xs - 1) (:'a) <= mw2n (xs:'a word list)``, 215 Induct \\ SIMP_TAC std_ss [NOT_NIL_CONS,LENGTH,ADD1,mw2n_def] 216 \\ Cases_on `xs` THEN1 217 (SIMP_TAC std_ss [mw_ok_def,LAST_CONS,NOT_NIL_CONS,LENGTH,mw2n_def,dimwords_thm] 218 \\ Cases_word \\ ASM_SIMP_TAC std_ss [n2w_11,w2n_n2w,ZERO_LT_dimword] \\ DECIDE_TAC) 219 \\ FULL_SIMP_TAC std_ss [NOT_NIL_CONS] \\ REPEAT STRIP_TAC 220 \\ `mw_ok (h::t)` by FULL_SIMP_TAC std_ss [mw_ok_def,LAST_CONS,NOT_NIL_CONS] 221 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [LENGTH,dimwords_thm,mw2n_def] 222 \\ `0 < dimword (:'a)` by METIS_TAC [ZERO_LT_dimword] 223 \\ `~(dimword (:'a) = 0)` by DECIDE_TAC 224 \\ MATCH_MP_TAC (DECIDE ``m <= k ==> m <= n + k:num``) 225 \\ ASM_SIMP_TAC std_ss [LE_MULT_LCANCEL]); 226 227val mw2n_LESS = store_thm("mw2n_LESS", 228 ``!(xs:'a word list) (ys:'a word list). 229 mw_ok xs /\ mw_ok ys /\ mw2n xs <= mw2n ys ==> LENGTH xs <= LENGTH ys``, 230 REPEAT STRIP_TAC \\ Cases_on `xs = []` \\ ASM_SIMP_TAC std_ss [LENGTH] 231 \\ Cases_on `ys = []` THEN1 232 (IMP_RES_TAC mw2n_gt 233 \\ `0 < dimwords (LENGTH xs - 1) (:'a)` by FULL_SIMP_TAC std_ss [ZERO_LT_dimwords] 234 \\ FULL_SIMP_TAC std_ss [LENGTH,mw2n_def] \\ DECIDE_TAC) 235 \\ IMP_RES_TAC mw2n_gt 236 \\ `mw2n xs < dimwords (LENGTH xs) (:'a)` by METIS_TAC [mw2n_lt] 237 \\ `mw2n ys < dimwords (LENGTH ys) (:'a)` by METIS_TAC [mw2n_lt] 238 \\ `dimwords (LENGTH xs - 1) (:'a) < dimwords (LENGTH ys) (:'a)` by DECIDE_TAC 239 \\ FULL_SIMP_TAC std_ss [dimwords_def] \\ DECIDE_TAC); 240 241val mw_ok_n2mw = store_thm("mw_ok_n2mw", 242 ``!n. mw_ok ((n2mw n):'a word list)``, 243 HO_MATCH_MP_TAC n2mw_ind \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [n2mw_def] 244 \\ Cases_on `n = 0` THEN1 ASM_SIMP_TAC std_ss [mw_ok_def] \\ RES_TAC 245 \\ Cases_on `n < dimword (:'a)` \\ ASM_SIMP_TAC std_ss [LESS_DIV_EQ_ZERO] 246 THEN1 (ONCE_REWRITE_TAC [n2mw_def] 247 \\ ASM_SIMP_TAC std_ss [mw_ok_def,LAST_DEF,n2w_11,ZERO_LT_dimword]) 248 \\ FULL_SIMP_TAC std_ss [mw_ok_def,NOT_NIL_CONS,LAST_DEF] 249 \\ REV (sg `~(n2mw (n DIV dimword (:'a)) = ([]:'a word list))`) 250 THEN1 METIS_TAC [] 251 \\ `0 < n DIV dimword (:'a)` by (FULL_SIMP_TAC std_ss [X_LT_DIV,ZERO_LT_dimword] \\ DECIDE_TAC) 252 \\ ONCE_REWRITE_TAC [n2mw_def] \\ FULL_SIMP_TAC std_ss [DECIDE ``0<n = ~(n = 0)``] 253 \\ FULL_SIMP_TAC std_ss [NOT_NIL_CONS]); 254 255val mw_ok_i2mw = store_thm("mw_ok_i2mw", 256 ``!i x xs. (i2mw i = (x,xs)) ==> mw_ok xs``, 257 SIMP_TAC std_ss [i2mw_def,mw_ok_n2mw]); 258 259val n2mw_EQ_k2mw = prove( 260 ``!n. n2mw n = k2mw (LENGTH ((n2mw n):'a word list)) n :'a word list``, 261 HO_MATCH_MP_TAC n2mw_ind \\ REPEAT STRIP_TAC \\ Cases_on `n = 0` 262 \\ FULL_SIMP_TAC std_ss [] \\ ONCE_REWRITE_TAC [n2mw_def] 263 \\ ASM_SIMP_TAC std_ss [LENGTH,k2mw_def,CONS_11,n2w_11,MOD_MOD,ZERO_LT_dimword]); 264 265val LESS_dimwords_n2mw = prove( 266 ``!n. n < dimwords (LENGTH ((n2mw n):'a word list)) (:'a)``, 267 HO_MATCH_MP_TAC n2mw_ind \\ REPEAT STRIP_TAC \\ Cases_on `n = 0` 268 \\ FULL_SIMP_TAC std_ss [ZERO_LT_dimwords] \\ ONCE_REWRITE_TAC [n2mw_def] 269 \\ ASM_SIMP_TAC std_ss [LENGTH,dimwords_SUC] 270 \\ CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [MATCH_MP DIVISION ZERO_LT_dimword])) 271 \\ MATCH_MP_TAC MULT_ADD_LESS_MULT 272 \\ ASM_SIMP_TAC std_ss [ZERO_LT_dimword,MOD_LESS]); 273 274val mw2n_n2mw = store_thm("mw2n_n2mw", 275 ``!n. mw2n (n2mw n) = n``, 276 ONCE_REWRITE_TAC [n2mw_EQ_k2mw] \\ REPEAT STRIP_TAC 277 \\ MATCH_MP_TAC mw2n_k2mw \\ ASM_SIMP_TAC std_ss [LESS_dimwords_n2mw]); 278 279val mw2i_i2mw = store_thm("mw2i_i2mw", 280 ``!i. mw2i (i2mw i) = i``, 281 REPEAT STRIP_TAC \\ Cases_on `i < 0` \\ ASM_SIMP_TAC std_ss [mw2i_def,i2mw_def] 282 \\ ASM_SIMP_TAC std_ss [INT_ABS,mw2n_n2mw] \\ intLib.COOPER_TAC); 283 284val n2mw_11 = store_thm("n2mw_11", 285 ``!m n. (n2mw m = n2mw n) = (m = n)``, 286 HO_MATCH_MP_TAC n2mw_ind 287 \\ REPEAT STRIP_TAC \\ Cases_on `m = 0` \\ Cases_on `n = 0` 288 \\ ONCE_REWRITE_TAC [n2mw_def] \\ FULL_SIMP_TAC std_ss [NOT_CONS_NIL,CONS_11] 289 \\ Cases_on `m = n` \\ ASM_SIMP_TAC std_ss [] 290 \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] 291 \\ METIS_TAC [DIVISION,ZERO_LT_dimword]); 292 293val i2mw_11 = store_thm("i2mw_11", 294 ``!i j. (i2mw i = i2mw j) = (i = j)``, 295 SIMP_TAC std_ss [i2mw_def,n2mw_11] \\ REPEAT STRIP_TAC 296 \\ Cases_on `i = j` \\ ASM_SIMP_TAC std_ss [] \\ intLib.COOPER_TAC); 297 298val mw_ok_IMP_EXISTS_n2mw = prove( 299 ``!xs. mw_ok xs ==> ?n. xs = n2mw n``, 300 Induct THEN1 METIS_TAC [n2mw_def] \\ SIMP_TAC std_ss [mw_ok_CLAUSES] 301 \\ REPEAT STRIP_TAC \\ RES_TAC \\ ASM_SIMP_TAC std_ss [] 302 \\ Q.EXISTS_TAC `n * dimword (:'a) + w2n h` 303 \\ CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [n2mw_def])) 304 \\ SIMP_TAC std_ss [DIV_MULT,w2n_lt,MOD_MULT,n2w_w2n, 305 MATCH_MP (DECIDE ``0<n ==> ~(n = 0)``) ZERO_LT_dimword] 306 \\ Cases_on `n = 0` \\ ASM_SIMP_TAC std_ss [] 307 \\ `xs = []` by METIS_TAC [n2mw_def] \\ FULL_SIMP_TAC std_ss [] 308 \\ Q.PAT_X_ASSUM `h <> 0w` MP_TAC \\ Q.SPEC_TAC (`h`,`h`) \\ Cases 309 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,w2n_n2w]); 310 311val IMP_EQ_n2mw = prove( 312 ``!xs i. mw_ok xs /\ (mw2n xs = i) ==> (xs = n2mw i)``, 313 REPEAT STRIP_TAC \\ IMP_RES_TAC mw_ok_IMP_EXISTS_n2mw 314 \\ FULL_SIMP_TAC std_ss [n2mw_11,mw2n_n2mw]); 315 316val IMP_EQ_n2mw_ALT = prove( 317 ``!xs ys. mw_ok xs /\ mw_ok ys /\ (mw2n xs = mw2n ys) ==> (xs = ys)``, 318 METIS_TAC [IMP_EQ_n2mw]); 319 320val EXISTS_i2mw = prove( 321 ``!x. mw_ok (SND x) /\ ~(x = (T,[])) ==> ?y. x = i2mw y``, 322 Cases \\ SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 323 \\ IMP_RES_TAC mw_ok_IMP_EXISTS_n2mw THEN1 324 (Q.EXISTS_TAC `(& n)` \\ ASM_SIMP_TAC std_ss [i2mw_def,n2mw_11] 325 \\ REPEAT (POP_ASSUM (K ALL_TAC)) \\ intLib.COOPER_TAC) 326 \\ `~(n = 0)` by METIS_TAC [n2mw_def] 327 \\ Q.EXISTS_TAC `if q then -(& n) else (& n)` \\ POP_ASSUM MP_TAC 328 \\ Cases_on `q` \\ FULL_SIMP_TAC std_ss [i2mw_def,n2mw_11] 329 \\ REPEAT (POP_ASSUM (K ALL_TAC)) \\ intLib.COOPER_TAC); 330 331val mw2i_EQ_IMP_EQ_i2mw = prove( 332 ``!x. mw_ok (SND x) /\ ~(x = (T,[])) /\ (mw2i x = i) ==> (x = i2mw i)``, 333 REPEAT STRIP_TAC \\ IMP_RES_TAC EXISTS_i2mw \\ FULL_SIMP_TAC std_ss [mw2i_i2mw]); 334 335val LENGTH_n2mw_LESS_LENGTH_n2mw = store_thm("LENGTH_n2mw_LESS_LENGTH_n2mw", 336 ``!m n. m <= n ==> 337 LENGTH (n2mw m:'a word list) <= LENGTH (n2mw n:'a word list)``, 338 HO_MATCH_MP_TAC n2mw_ind 339 \\ REPEAT STRIP_TAC \\ Cases_on `m = 0` \\ Cases_on `n = 0` 340 \\ ONCE_REWRITE_TAC [n2mw_def] \\ ASM_SIMP_TAC std_ss [LENGTH] THEN1 DECIDE_TAC 341 \\ REV (sg `m DIV dimword (:'a) <= n DIV dimword (:'a)`) THEN1 METIS_TAC [] 342 \\ SIMP_TAC std_ss [X_LE_DIV,ZERO_LT_dimword] 343 \\ MATCH_MP_TAC (DECIDE ``!p. m + p <= n ==> m <= n``) 344 \\ Q.EXISTS_TAC `m MOD dimword (:'a)` 345 \\ ASM_SIMP_TAC std_ss [GSYM DIVISION,ZERO_LT_dimword]); 346 347val mw2n_EQ_IMP_EQ = prove( 348 ``!xs ys. (LENGTH xs = LENGTH ys) /\ (mw2n xs = mw2n ys) ==> (xs = ys)``, 349 REPEAT STRIP_TAC 350 \\ STRIP_ASSUME_TAC (Q.SPEC `xs` EXISTS_k2mw) 351 \\ STRIP_ASSUME_TAC (Q.SPEC `ys` EXISTS_k2mw) 352 \\ FULL_SIMP_TAC std_ss [mw2n_k2mw]); 353 354(* fix and zerofix *) 355 356val mw_fix_def = tDefine "mw_fix" ` 357 mw_fix xs = if xs = [] then [] else 358 if LAST xs = 0w then mw_fix (BUTLAST xs) else xs` 359 (WF_REL_TAC `measure LENGTH` \\ Cases 360 \\ SIMP_TAC std_ss [LENGTH_BUTLAST,NOT_NIL_CONS,LENGTH]); 361 362val mw_fix_ind = fetch "-" "mw_fix_ind" 363 364val mw_zerofix_def = Define ` 365 mw_zerofix x = if x = (T,[]) then (F,[]) else x`; 366 367val mw_ok_mw_fix = store_thm("mw_ok_fix", 368 ``!xs. mw_ok (mw_fix xs)``, 369 HO_MATCH_MP_TAC mw_fix_ind \\ Cases \\ REPEAT STRIP_TAC 370 \\ ONCE_REWRITE_TAC [mw_fix_def] 371 \\ FULL_SIMP_TAC std_ss [mw_ok_CLAUSES,NOT_CONS_NIL] 372 \\ Cases_on `LAST (h::t) = 0w` \\ RES_TAC \\ ASM_SIMP_TAC std_ss [] 373 \\ ASM_SIMP_TAC std_ss [mw_ok_def]); 374 375val mw_ok_mw_fix_ID = store_thm("mw_ok_mw_fix_ID", 376 ``!xs. mw_ok xs ==> (mw_fix xs = xs)``, 377 Cases \\ ASM_SIMP_TAC std_ss [mw_ok_def,Once mw_fix_def,NOT_NIL_CONS]); 378 379val mw2n_mw_fix = prove( 380 ``!xs. mw2n (mw_fix xs) = mw2n xs``, 381 HO_MATCH_MP_TAC mw_fix_ind \\ REPEAT STRIP_TAC 382 \\ ONCE_REWRITE_TAC [mw_fix_def] 383 \\ `(xs = []) \/ ?y ys. xs = SNOC y ys` by METIS_TAC [SNOC_CASES] 384 \\ FULL_SIMP_TAC std_ss [NOT_SNOC_NIL,LAST_SNOC,FRONT_SNOC] 385 \\ Cases_on `y = 0w` \\ ASM_SIMP_TAC std_ss [SNOC_APPEND] 386 \\ ASM_SIMP_TAC std_ss [mw2n_APPEND,mw2n_def,w2n_n2w,ZERO_LT_dimword]); 387 388val mw2i_mw_zerofix = prove( 389 ``!x. mw2i (mw_zerofix x) = mw2i x``, 390 SRW_TAC [] [mw_zerofix_def,mw2i_def,mw2n_def]); 391 392val mw_zerofix_thm = prove( 393 ``!x b xs. ~(mw_zerofix x = (T,[])) /\ mw_ok (SND (mw_zerofix (b, mw_fix xs)))``, 394 SRW_TAC [] [mw_zerofix_def,mw_ok_CLAUSES,mw_ok_mw_fix]); 395 396val mw_fix_NIL = store_thm("mw_fix_NIL", 397 ``!xs. (mw_fix xs = []) = (mw2n xs = 0)``, 398 HO_MATCH_MP_TAC SNOC_INDUCT \\ REPEAT STRIP_TAC 399 \\ ONCE_REWRITE_TAC [mw_fix_def] 400 \\ SIMP_TAC std_ss [mw2n_def,NOT_SNOC_NIL,LAST_SNOC,FRONT_SNOC] 401 \\ Cases_on `x = 0w` \\ ASM_SIMP_TAC std_ss [SNOC_APPEND,mw2n_APPEND,mw2n_def] 402 \\ ASM_SIMP_TAC std_ss [w2n_n2w,ZERO_LT_dimword,GSYM SNOC_APPEND,NOT_SNOC_NIL] 403 \\ `0 < dimwords (LENGTH xs) (:'a)` by METIS_TAC [ZERO_LT_dimwords] \\ DISJ2_TAC 404 \\ REPEAT STRIP_TAC THEN1 DECIDE_TAC \\ Cases_on `x` 405 \\ FULL_SIMP_TAC std_ss [n2w_11,w2n_n2w,ZERO_LT_dimword]); 406 407val mw_fix_LENGTH_ZERO = prove( 408 ``!xs. (LENGTH (mw_fix xs) = 0) = (mw2n xs = 0)``, 409 FULL_SIMP_TAC std_ss [LENGTH_NIL,mw_fix_NIL]); 410 411val mw_fix_NIL = prove( 412 ``!xs. (mw_fix xs = []) = (mw2n xs = 0)``, 413 FULL_SIMP_TAC std_ss [LENGTH_NIL,mw_fix_NIL]); 414 415val mw_fix_EQ_n2mw = 416 Q.SPEC `mw_fix xs` mw_ok_IMP_EXISTS_n2mw |> RW [mw_ok_mw_fix] |> GEN_ALL; 417 418val n2mw_mw2n = prove( 419 ``!xs. (mw_fix xs = n2mw (mw2n xs))``, 420 REPEAT STRIP_TAC 421 \\ `?n. mw_fix xs = n2mw n` by METIS_TAC [mw_fix_EQ_n2mw] 422 \\ ONCE_REWRITE_TAC [GSYM mw2n_mw_fix] \\ FULL_SIMP_TAC std_ss [mw2n_n2mw]); 423 424val mw_ok_mw_mw2n = prove( 425 ``!xs. mw_ok xs ==> (xs = n2mw (mw2n xs))``, 426 METIS_TAC [n2mw_mw2n,mw_ok_mw_fix,mw_ok_mw_fix_ID]); 427 428val LENGTH_mw_fix = store_thm("LENGTH_mw_fix", 429 ``!xs. LENGTH (mw_fix xs) <= LENGTH xs``, 430 HO_MATCH_MP_TAC SNOC_INDUCT \\ REPEAT STRIP_TAC 431 \\ SIMP_TAC (srw_ss()) [Once mw_fix_def] \\ SRW_TAC [] [] 432 \\ DECIDE_TAC); 433 434val REPLICATE_SNOC = store_thm("REPLICATE_SNOC", 435 ``!n x. REPLICATE (SUC n) x = SNOC x (REPLICATE n x)``, 436 Induct \\ FULL_SIMP_TAC (srw_ss()) [REPLICATE]); 437 438val mw_fix_thm = store_thm("mw_fix_thm", 439 ``!xs. mw_fix xs ++ REPLICATE (LENGTH xs - LENGTH (mw_fix xs)) 0x0w = xs``, 440 HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1 EVAL_TAC 441 \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [mw_fix_def] 442 \\ FULL_SIMP_TAC std_ss [NOT_SNOC_NIL,LAST_SNOC,FRONT_SNOC] 443 \\ Cases_on `x = 0w` \\ FULL_SIMP_TAC std_ss [EVAL ``REPLICATE 0 x``,APPEND_NIL] 444 \\ `REPLICATE (LENGTH (SNOC 0x0w xs) - LENGTH (mw_fix xs)) (0x0w:'a word) = 445 SNOC 0w (REPLICATE (LENGTH xs - LENGTH (mw_fix xs)) 0x0w)` by 446 (`LENGTH (SNOC 0x0w xs) - LENGTH (mw_fix xs) = 447 SUC (LENGTH xs - LENGTH (mw_fix xs))` by 448 (`LENGTH (mw_fix xs) <= LENGTH xs` by METIS_TAC [LENGTH_mw_fix] 449 \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC] \\ DECIDE_TAC) 450 \\ FULL_SIMP_TAC std_ss [REPLICATE_SNOC]) 451 \\ FULL_SIMP_TAC std_ss [] 452 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,APPEND_ASSOC]); 453 454val mw2n_REPLICATE = prove( 455 ``!n. mw2n (REPLICATE n 0x0w) = 0``, 456 Induct THEN1 EVAL_TAC 457 \\ ASM_SIMP_TAC std_ss [REPLICATE,mw2n_def,w2n_n2w,ZERO_LT_dimword]); 458 459(* add/sub *) 460 461val single_add_def = Define ` 462 single_add (x:'a word) (y:'a word) c = 463 (x + y + b2w c, dimword (:'a) <= w2n x + w2n y + b2n c)`; 464 465val mw_add_def = Define ` 466 (mw_add [] ys c = ([],c)) /\ 467 (mw_add (x::xs) ys c = 468 let (z,c1) = single_add x (HD ys) c in 469 let (zs,c2) = mw_add xs (TL ys) c1 in (z::zs,c2))`; 470 471val single_sub_def = Define ` 472 single_sub (x:'a word) (y:'a word) c = single_add x (~y) c`; 473 474val mw_sub_def = Define ` 475 (mw_sub [] ys c = ([],c)) /\ 476 (mw_sub (x::xs) [] c = 477 let (z,c1) = single_sub x 0w c in 478 let (zs,c2) = mw_sub xs [] c1 in (z::zs,c2)) /\ 479 (mw_sub (x::xs) (y::ys) c = 480 let (z,c1) = single_sub x y c in 481 let (zs,c2) = mw_sub xs ys c1 in (z::zs,c2))`; 482 483val single_add_thm = store_thm("single_add_thm", 484 ``!(x:'a word) y z c d. 485 (single_add x y c = (z,d)) ==> 486 (w2n z + dimword (:'a) * b2n d = w2n x + w2n y + b2n c)``, 487 NTAC 2 Cases_word \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 488 \\ ASM_SIMP_TAC std_ss [single_add_def,w2n_n2w,LESS_MOD,b2w_def] \\ STRIP_TAC 489 \\ Cases_on `dimword (:'a) <= n + n' + b2n c` 490 \\ FULL_SIMP_TAC std_ss [word_add_n2w,GSYM NOT_LESS,w2n_n2w,b2n_def] 491 \\ REV (sg `(n + n' + b2n c) DIV dimword (:'a) = 1`) 492 THEN1 METIS_TAC [DIVISION,MULT_CLAUSES,ADD_COMM,ZERO_LT_dimword] 493 \\ `b2n c < 2` by (Cases_on `c` \\ SIMP_TAC std_ss [b2n_def]) 494 \\ `n + n' + b2n c - dimword (:'a) < dimword (:'a)` by DECIDE_TAC 495 \\ `n + n' + b2n c = dimword (:'a) + (n + n' + b2n c - dimword (:'a))` by DECIDE_TAC 496 \\ METIS_TAC [bitTheory.DIV_MULT_1]); 497 498val b2n_thm = prove( 499 ``!c. b2n c = if c then 1 else 0``, 500 Cases \\ SIMP_TAC std_ss [b2n_def]); 501 502val single_add_eq = store_thm("single_add_eq", 503 ``single_add x y c = (FST (add_with_carry (x,y:'a word,c)), 504 FST (SND (add_with_carry (x,y,c))))``, 505 SIMP_TAC std_ss [single_add_def,add_with_carry_def,LET_DEF,GSYM b2n_thm] 506 \\ SIMP_TAC std_ss [GSYM word_add_n2w,n2w_w2n,b2w_def] 507 \\ Cases_on `x` \\ Cases_on `y` \\ ASM_SIMP_TAC std_ss [w2n_n2w,LESS_MOD] 508 \\ SIMP_TAC std_ss [word_add_n2w,w2n_n2w] 509 \\ Cases_on `n + n' + b2n c < dimword (:'a)` 510 \\ ASM_SIMP_TAC std_ss [LESS_MOD,DECIDE ``(n <= m) = ~(m < n:num)``] 511 \\ CONV_TAC ((RAND_CONV o RAND_CONV) 512 (ONCE_REWRITE_CONV [MATCH_MP DIVISION ZERO_LT_dimword])) 513 \\ SIMP_TAC std_ss [DECIDE ``((m = n + m:num) = (0 = n)) /\ (~(n=0)=0<n)``] 514 \\ SIMP_TAC std_ss [X_LT_DIV,ZERO_LT_dimword] \\ DECIDE_TAC); 515 516val mw_add_thm = prove( 517 ``!xs ys c (zs:'a word list) d. 518 (mw_add xs ys c = (zs,d)) /\ (LENGTH xs = LENGTH ys) ==> 519 (mw2n zs + dimwords (LENGTH xs) (:'a) * b2n d = 520 mw2n xs + mw2n ys + b2n c)``, 521 Induct \\ Cases_on `ys` \\ SIMP_TAC std_ss 522 [mw_add_def,LENGTH,dimwords_thm,mw2n_def,DECIDE ``~(SUC n = 0)``,HD,TL] 523 \\ BasicProvers.LET_ELIM_TAC 524 \\ Q.PAT_X_ASSUM `bb = (zs,d)` (ASSUME_TAC o GSYM) 525 \\ FULL_SIMP_TAC std_ss [mw2n_def] 526 \\ IMP_RES_TAC single_add_thm 527 \\ Q.PAT_X_ASSUM `!ys. bbb` (MP_TAC o RW [] o Q.SPECL [`t`,`c1`]) 528 \\ ASM_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 529 \\ FULL_SIMP_TAC std_ss [GSYM ADD_ASSOC,GSYM LEFT_ADD_DISTRIB,GSYM MULT_ASSOC] 530 \\ DECIDE_TAC); 531 532val single_sub_thm = prove( 533 ``!(x:'a word) y z c d. 534 (single_sub x y c = (z,d)) ==> 535 (w2n z + dimword (:'a) * b2n d + w2n y = w2n x + b2n c + (dimword(:'a) - 1))``, 536 SIMP_TAC std_ss [single_sub_def] \\ REPEAT STRIP_TAC 537 \\ IMP_RES_TAC single_add_thm \\ ASM_SIMP_TAC std_ss [] 538 \\ SIMP_TAC std_ss [DECIDE ``(x+yy+c+y=x+c+d)=(yy+y=d:num)``] 539 \\ Q.SPEC_TAC (`y`,`y`) \\ Cases 540 \\ `dimword (:'a) - 1 - n < dimword (:'a)` by DECIDE_TAC 541 \\ ASM_SIMP_TAC std_ss [w2n_n2w,word_1comp_n2w] \\ DECIDE_TAC); 542 543val mw_sub_lemma = store_thm("mw_sub_lemma", 544 ``!xs ys c (zs:'a word list) d. 545 (mw_sub xs ys c = (zs,d)) /\ (LENGTH xs = LENGTH ys) ==> 546 (mw2n zs + mw2n ys + dimwords (LENGTH xs) (:'a) * b2n d = 547 mw2n xs + b2n c + (dimwords (LENGTH xs) (:'a) - 1)) /\ 548 (LENGTH zs = LENGTH xs)``, 549 Induct \\ Cases_on `ys` \\ SIMP_TAC std_ss 550 [mw_sub_def,LENGTH,dimwords_thm,mw2n_def,DECIDE ``~(SUC n = 0)``,HD,TL] 551 \\ BasicProvers.LET_ELIM_TAC \\ IMP_RES_TAC single_sub_thm 552 \\ Q.PAT_X_ASSUM `bb = (zs,d)` (ASSUME_TAC o GSYM) 553 \\ FULL_SIMP_TAC std_ss [mw2n_def] 554 \\ Q.PAT_X_ASSUM `!ys. bbb` (MP_TAC o RW [] o Q.SPECL [`t`,`c1`]) 555 \\ ASM_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 556 \\ SIMP_TAC std_ss [DECIDE ``z+d*zs+(h+d*t)+d*kk*c2 = z+h+d*zs+d*t+d*kk*c2:num``] 557 \\ FULL_SIMP_TAC std_ss [GSYM ADD_ASSOC,GSYM LEFT_ADD_DISTRIB,GSYM MULT_ASSOC] 558 \\ FULL_SIMP_TAC std_ss [LEFT_ADD_DISTRIB,ADD_ASSOC,MULT_ASSOC,LENGTH] 559 \\ ASM_SIMP_TAC std_ss [DECIDE ``z+h+d*xs+d*c1+dd:num = (z+d*c1+h)+d*xs+dd``] 560 \\ `0 < dimwords (LENGTH t) (:'a)` by FULL_SIMP_TAC std_ss [ZERO_LT_dimwords] 561 \\ Cases_on `dimwords (LENGTH t) (:'a)` \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES] 562 \\ `0 < dimword (:'a)` by FULL_SIMP_TAC std_ss [ZERO_LT_dimword] \\ DECIDE_TAC); 563 564val mw_sub_thm = prove( 565 ``!xs ys c zs d. 566 (LENGTH xs = LENGTH ys) /\ mw2n ys <= mw2n xs ==> 567 (mw2n (FST (mw_sub xs ys T)) = mw2n xs - mw2n ys)``, 568 ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ REPEAT STRIP_TAC 569 \\ `?zs d. mw_sub xs ys T = (zs,d)` by METIS_TAC [PAIR] 570 \\ IMP_RES_TAC mw_sub_lemma \\ ASM_SIMP_TAC std_ss [] 571 \\ `0 < dimwords (LENGTH xs) (:'a)` by FULL_SIMP_TAC std_ss [ZERO_LT_dimwords] 572 \\ Cases_on `d` \\ FULL_SIMP_TAC std_ss [b2n_def] THEN1 DECIDE_TAC 573 \\ `mw2n zs + mw2n ys = mw2n xs + dimwords (LENGTH xs) (:'a)` by DECIDE_TAC 574 \\ `mw2n zs < dimwords (LENGTH xs) (:'a)` by METIS_TAC [mw2n_lt] 575 \\ `mw2n ys < dimwords (LENGTH xs) (:'a)` by METIS_TAC [mw2n_lt] 576 \\ `F` by DECIDE_TAC); 577 578val mw_addv_def = Define ` 579 (mw_addv [] ys c = if c then [1w] else []) /\ 580 (mw_addv (x::xs) ys c = 581 let (y,ys2) = if ys = [] then (0w,ys) else (HD ys, TL ys) in 582 let (z,c1) = single_add x y c in 583 z :: mw_addv xs ys2 c1)`; 584 585val WORD_NOT_ZERO_ONE = prove( 586 ``~(0w = 1w)``, 587 SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,ONE_LT_dimword]); 588 589val mw_addv_thm = prove( 590 ``!xs (ys:'a word list) c. 591 (LENGTH ys <= LENGTH xs) ==> 592 (mw2n (mw_addv xs ys c) = mw2n xs + mw2n ys + b2n c)``, 593 Induct \\ Cases_on `ys` \\ SIMP_TAC std_ss [LENGTH] THEN1 594 (Cases_on `c` \\ SIMP_TAC std_ss [mw_addv_def,b2n_def, 595 mw2n_def,w2n_n2w,ONE_LT_dimword,mw_ok_def,LAST_DEF]) 596 \\ SIMP_TAC std_ss [mw_addv_def,LET_DEF] \\ REPEAT STRIP_TAC THEN1 597 (POP_ASSUM (ASSUME_TAC o Q.SPEC `[]`) \\ FULL_SIMP_TAC std_ss [LENGTH] 598 \\ `?z3 c3. single_add h 0w c = (z3,c3)` by METIS_TAC [PAIR] 599 \\ IMP_RES_TAC single_add_thm 600 \\ FULL_SIMP_TAC std_ss [mw2n_def,w2n_n2w,ZERO_LT_dimword] \\ DECIDE_TAC) 601 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [HD,TL,NOT_CONS_NIL] 602 \\ `?z3 c3. single_add h' h c = (z3,c3)` by METIS_TAC [PAIR] 603 \\ IMP_RES_TAC single_add_thm \\ FULL_SIMP_TAC std_ss [mw2n_def] \\ DECIDE_TAC); 604 605val mw_ok_addv = prove( 606 ``!xs ys c. mw_ok xs /\ mw_ok ys ==> mw_ok (mw_addv xs (ys:'a word list) c)``, 607 Induct THEN1 (Cases_on `c` 608 \\ SIMP_TAC std_ss [mw_addv_def,mw_ok_def,LAST_DEF,WORD_NOT_ZERO_ONE]) 609 \\ SIMP_TAC std_ss [mw_addv_def,SPLIT_LET2] \\ SIMP_TAC std_ss [LET_DEF] 610 \\ FULL_SIMP_TAC std_ss [mw_ok_CLAUSES] \\ NTAC 4 STRIP_TAC 611 \\ FULL_SIMP_TAC std_ss [] 612 \\ Q.ABBREV_TAC `ys2 = SND (if ys = [] then (0w,[]) else (HD ys,TL (ys:'a word list)))` 613 \\ `mw_ok ys2` by (Q.UNABBREV_TAC `ys2` 614 \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [NOT_CONS_NIL,TL,mw_ok_CLAUSES]) 615 \\ FULL_SIMP_TAC std_ss [] 616 \\ REV (Cases_on `xs`) \\ FULL_SIMP_TAC std_ss [mw_addv_def,SPLIT_LET2] 617 \\ SIMP_TAC std_ss [LET_DEF,NOT_CONS_NIL] 618 \\ Q.ABBREV_TAC `h2 = FST (if ys = [] then (0w,[]) else (HD ys,TL ys))` 619 \\ Q.PAT_X_ASSUM `h <> 0w` MP_TAC \\ Q.SPEC_TAC (`h`,`h`) \\ Cases 620 \\ ASM_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] 621 \\ `?z d. single_add (n2w n) h2 c = (z,d)` by METIS_TAC [PAIR] 622 \\ IMP_RES_TAC single_add_thm 623 \\ POP_ASSUM MP_TAC \\ ASM_SIMP_TAC std_ss [w2n_n2w] 624 \\ Cases_on `d` \\ ASM_SIMP_TAC std_ss [NOT_CONS_NIL,b2n_def] 625 \\ Q.SPEC_TAC (`z`,`z`) \\ Cases 626 \\ ASM_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,w2n_n2w]); 627 628val mw_addv_EQ_mw_add = store_thm("mw_addv_EQ_mw_add", 629 ``!xs1 xs2 ys c1. 630 (LENGTH ys = LENGTH xs1) ==> 631 (mw_addv (xs1 ++ xs2) ys c1 = 632 let (zs1,c2) = mw_add xs1 ys c1 in 633 let (zs2,c3) = mw_add xs2 (MAP (\x.0w) xs2) c2 in 634 zs1 ++ zs2 ++ if c3 then [1w] else [])``, 635 Induct THEN1 636 (Induct \\ FULL_SIMP_TAC std_ss [APPEND,LENGTH,LENGTH_NIL,mw_addv_def,mw_add_def] 637 THEN1 SIMP_TAC std_ss [LET_DEF,APPEND] \\ REPEAT STRIP_TAC 638 \\ FULL_SIMP_TAC std_ss [MAP,HD,TL,LET_DEF] \\ Cases_on `single_add h 0x0w c1` 639 \\ FULL_SIMP_TAC std_ss [APPEND] 640 \\ `?ts t. mw_add xs2 (MAP (\x. 0x0w) xs2) r = (ts,t)` by METIS_TAC [PAIR] 641 \\ ASM_SIMP_TAC std_ss [APPEND]) 642 \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [LENGTH,DECIDE ``~(SUC n = 0)``] 643 \\ FULL_SIMP_TAC std_ss [APPEND,LENGTH,LENGTH_NIL,mw_addv_def,mw_add_def, 644 NOT_NIL_CONS,LET_DEF,TL,HD] \\ REPEAT STRIP_TAC 645 \\ Cases_on `single_add h' h c1` \\ ASM_SIMP_TAC std_ss [] 646 \\ Cases_on `mw_add xs1 t r` \\ ASM_SIMP_TAC std_ss [] 647 \\ Cases_on `mw_add xs2 (MAP (\x. 0x0w) xs2) r'` 648 \\ ASM_SIMP_TAC std_ss [APPEND]); 649 650val mw_sub_APPEND = store_thm("mw_sub_APPEND", 651 ``!xs1 xs2 ys c. 652 (LENGTH xs1 = LENGTH ys) ==> 653 (mw_sub (xs1 ++ xs2) ys c = 654 let (ts1,c) = mw_sub xs1 ys c in 655 let (ts2,c) = mw_sub xs2 [] c in 656 (ts1 ++ ts2,c))``, 657 Induct \\ Cases_on `ys` 658 \\ ASM_SIMP_TAC std_ss [mw_sub_def,APPEND,LET_DEF,LENGTH,ADD1] 659 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 660 \\ ASM_SIMP_TAC std_ss [CONS_11,APPEND]); 661 662val mw_subv_def = Define ` 663 mw_subv xs ys = mw_fix (FST (mw_sub xs ys T))`; 664 665val mw_sub_SNOC_0 = prove( 666 ``!xs ys c. mw_sub xs (SNOC 0w ys) c = mw_sub xs ys c``, 667 Induct \\ SIMP_TAC std_ss [mw_sub_def] \\ Cases_on `ys` 668 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,APPEND,mw_sub_def]); 669 670val mw_sub_APPEND_0 = prove( 671 ``!n xs ys c. mw_sub xs (ys ++ REPLICATE n 0w) c = mw_sub xs ys c``, 672 Induct \\ ASM_SIMP_TAC std_ss [REPLICATE_SNOC,APPEND_SNOC,mw_sub_SNOC_0] 673 \\ SIMP_TAC std_ss [REPLICATE,APPEND_NIL]); 674 675val mw_sub_mw_fix = store_thm("mw_sub_mw_fix", 676 ``!xs ys. mw_sub xs (mw_fix ys) c = mw_sub xs (ys:'a word list) c``, 677 METIS_TAC [mw_sub_APPEND_0,mw_fix_thm]); 678 679val mw2n_APPEND_REPLICATE = prove( 680 ``!ys n. mw2n ys = mw2n (ys ++ REPLICATE n 0w)``, 681 SIMP_TAC std_ss [mw2n_APPEND,mw2n_REPLICATE]); 682 683val mw_subv_thm = prove( 684 ``!xs ys. mw2n ys <= mw2n xs /\ (LENGTH ys <= LENGTH xs) ==> 685 (mw2n (mw_subv xs ys) = mw2n xs - mw2n ys)``, 686 SIMP_TAC std_ss [mw_subv_def,mw2n_mw_fix] \\ REPEAT STRIP_TAC 687 \\ ONCE_REWRITE_TAC [(GSYM mw_sub_APPEND_0) 688 |> Q.SPECL [`(LENGTH (xs:'a word list) - LENGTH (ys:'a word list))`, 689 `xs`,`ys`,`T`]] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 690 \\ ASSUME_TAC (Q.SPECL [`ys`, 691 `(LENGTH (xs:'a word list) - LENGTH (ys:'a word list))`] mw2n_APPEND_REPLICATE) 692 \\ POP_ASSUM (fn th => SIMP_TAC std_ss [Once th]) 693 \\ MATCH_MP_TAC (GSYM mw_sub_thm) \\ FULL_SIMP_TAC std_ss [] 694 \\ ASM_SIMP_TAC std_ss [GSYM mw2n_APPEND_REPLICATE,LENGTH_APPEND,LENGTH_REPLICATE] 695 \\ DECIDE_TAC); 696 697val mwi_add_def = Define ` 698 mwi_add (s,xs) (t,ys) = 699 if s = t then 700 if LENGTH ys <= LENGTH xs then (s, mw_addv xs ys F) else (s, mw_addv ys xs F) 701 else 702 if mw2n ys = mw2n xs then (F,[]) else 703 if mw2n ys <= mw2n xs then (s,mw_subv xs ys) else (~s,mw_subv ys xs)`; 704 705val mwi_sub_def = Define ` 706 mwi_sub (s,xs) (t,ys) = mwi_add (s,xs) (~t,ys)`; 707 708val mwi_add_lemma = prove( 709 ``!s t xs ys. 710 mw_ok xs /\ mw_ok ys ==> 711 (mw2i (mwi_add (s,xs) (t,ys)) = mw2i (s,xs) + mw2i (t,ys))``, 712 REPEAT STRIP_TAC \\ Cases_on `s` \\ Cases_on `t` \\ Cases_on `mw2n ys <= mw2n xs` 713 \\ Cases_on `LENGTH ys <= LENGTH xs` 714 \\ IMP_RES_TAC (DECIDE ``~(m<=n) ==> n <= m:num``) 715 \\ IMP_RES_TAC mw2n_LESS \\ Cases_on `mw2n xs = mw2n ys` 716 \\ IMP_RES_TAC (DECIDE ``m<=n/\~(m=n) ==> ~(n<=m:num)``) 717 \\ FULL_SIMP_TAC std_ss [mwi_add_def,mw2i_def,mw_addv_thm,INT_ADD_CALCULATE, 718 AC ADD_COMM ADD_ASSOC,mw_subv_thm,INT_ADD_REDUCE,mw2n_def,b2n_def]); 719 720val mwi_add_lemma2 = RW [mw_ok_n2mw,GSYM i2mw_def,mw2i_i2mw] 721 (Q.SPECL [`i<0:int`,`j<0:int`,`n2mw (Num (ABS i))`,`n2mw (Num (ABS j))`] mwi_add_lemma); 722 723val mw_addv_IMP_NIL = prove( 724 ``!xs ys. (mw_addv xs ys c = []) ==> (xs = [])``, 725 Induct \\ SIMP_TAC std_ss [mw_addv_def,SPLIT_LET2] 726 \\ SIMP_TAC std_ss [LET_DEF,NOT_CONS_NIL]); 727 728val n2mw_NIL = store_thm("n2mw_NIL", 729 ``!n. (n2mw n = []) = (n = 0)``, 730 REPEAT STRIP_TAC \\ Cases_on `n = 0` \\ ONCE_REWRITE_TAC [n2mw_def] 731 \\ ASM_SIMP_TAC std_ss [NOT_CONS_NIL]); 732 733val n2mw_1 = Q.store_thm("n2mw_1", 734 `n2mw 1 = [1w]`, 735 rw[Once n2mw_def] 736 \\ `1 DIV dimword(:'a) = 0` 737 by ( 738 MATCH_MP_TAC LESS_DIV_EQ_ZERO 739 \\ rw[dimword_def] ) 740 \\ rw[n2mw_NIL]); 741 742val mwi_add_thm = store_thm("mwi_add_thm", 743 ``!i j. mwi_add (i2mw i) (i2mw j) = i2mw (i + j)``, 744 REPEAT STRIP_TAC \\ MATCH_MP_TAC mw2i_EQ_IMP_EQ_i2mw 745 \\ FULL_SIMP_TAC std_ss [mwi_add_lemma2] 746 \\ SIMP_TAC std_ss [mwi_add_def,i2mw_def,mw2n_n2mw] \\ STRIP_TAC 747 THEN1 SRW_TAC [] [mw_ok_addv,mw_ok_n2mw,mw_subv_def,mw_ok_mw_fix,mw_ok_CLAUSES] 748 \\ SRW_TAC [] [] \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [] 749 \\ IMP_RES_TAC mw_addv_IMP_NIL \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 750 THEN1 (FULL_SIMP_TAC std_ss [mw_addv_def,n2mw_NIL] \\ intLib.COOPER_TAC) 751 \\ IMP_RES_TAC (METIS_PROVE [] ``(xs = ys) ==> (mw2n xs = mw2n ys)``) 752 \\ FULL_SIMP_TAC std_ss [mw2n_def] 753 \\ IMP_RES_TAC (SIMP_RULE std_ss [mw2n_n2mw,GSYM AND_IMP_INTRO, 754 LENGTH_n2mw_LESS_LENGTH_n2mw] (Q.SPECL [`n2mw n`,`n2mw m`] mw_subv_thm)) 755 THEN1 (FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC) 756 \\ `Num (ABS i) <= Num (ABS j)` by intLib.COOPER_TAC 757 \\ IMP_RES_TAC (SIMP_RULE std_ss [mw2n_n2mw,GSYM AND_IMP_INTRO, 758 LENGTH_n2mw_LESS_LENGTH_n2mw] (Q.SPECL [`n2mw n`,`n2mw m`] mw_subv_thm)) 759 \\ intLib.COOPER_TAC); 760 761val mwi_sub_lemma = prove( 762 ``!s t xs ys. 763 mw_ok xs /\ mw_ok ys ==> 764 (mw2i (mwi_sub (s,xs) (t,ys)) = mw2i (s,xs) - mw2i (t,ys))``, 765 ASM_SIMP_TAC std_ss [mwi_add_lemma,mwi_sub_def] \\ Cases_on `t` 766 \\ ASM_SIMP_TAC std_ss [mw2i_def,INT_ADD_REDUCE,INT_ADD_CALCULATE, 767 INT_SUB_REDUCE,INT_SUB_CALCULATE]); 768 769val mwi_sub_lemma2 = RW [mw_ok_n2mw,GSYM i2mw_def,mw2i_i2mw] 770 (Q.SPECL [`i<0:int`,`j<0:int`,`n2mw (Num (ABS i))`,`n2mw (Num (ABS j))`] 771 mwi_sub_lemma); 772 773val mwi_sub_thm = store_thm("mwi_sub_thm", 774 ``!i j. mwi_sub (i2mw i) (i2mw j) = i2mw (i - j)``, 775 REPEAT STRIP_TAC \\ MATCH_MP_TAC mw2i_EQ_IMP_EQ_i2mw 776 \\ FULL_SIMP_TAC std_ss [mwi_sub_lemma2] 777 \\ SIMP_TAC std_ss [mwi_sub_def,mwi_add_def,i2mw_def,mw2n_n2mw] \\ STRIP_TAC 778 THEN1 SRW_TAC [] [mw_ok_addv,mw_ok_n2mw,mw_subv_def,mw_ok_mw_fix,mw_ok_CLAUSES] 779 \\ SRW_TAC [] [] \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [] 780 \\ IMP_RES_TAC mw_addv_IMP_NIL \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 781 THEN1 (FULL_SIMP_TAC std_ss [mw_addv_def,n2mw_NIL] \\ intLib.COOPER_TAC) 782 \\ IMP_RES_TAC (METIS_PROVE [] ``(xs = ys) ==> (mw2n xs = mw2n ys)``) 783 \\ FULL_SIMP_TAC std_ss [mw2n_def] 784 \\ IMP_RES_TAC (SIMP_RULE std_ss [mw2n_n2mw,GSYM AND_IMP_INTRO, 785 LENGTH_n2mw_LESS_LENGTH_n2mw] (Q.SPECL [`n2mw n`,`n2mw m`] mw_subv_thm)) 786 \\ FULL_SIMP_TAC std_ss [] THEN1 DECIDE_TAC 787 \\ `Num (ABS i) <= Num (ABS j)` by intLib.COOPER_TAC 788 \\ IMP_RES_TAC (SIMP_RULE std_ss [mw2n_n2mw,GSYM AND_IMP_INTRO, 789 LENGTH_n2mw_LESS_LENGTH_n2mw] (Q.SPECL [`n2mw n`,`n2mw m`] mw_subv_thm)) 790 \\ DECIDE_TAC); 791 792 793(* mul *) 794 795val single_mul_def = Define ` 796 single_mul (x:'a word) (y:'a word) (c:'a word) = 797 (x * y + c, n2w ((w2n x * w2n y + w2n c) DIV dimword (:'a)):'a word)`; 798 799val single_mul_add_def = Define ` 800 single_mul_add p q k s = 801 let (x,kc) = single_mul p q k in 802 let (zs,c) = mw_add [x;kc] [s;0w] F in 803 (HD zs, HD (TL zs))`; 804 805val mw_mul_pass_def = Define ` 806 (mw_mul_pass x [] zs k = [k]) /\ 807 (mw_mul_pass x (y::ys) zs k = 808 let (y1,k1) = single_mul_add x y k (HD zs) in 809 y1 :: mw_mul_pass x ys (TL zs) k1)`; 810 811val mw_mul_def = Define ` 812 (mw_mul [] ys zs = zs) /\ 813 (mw_mul (x::xs) ys zs = 814 let zs2 = mw_mul_pass x ys zs 0w in 815 HD zs2 :: mw_mul xs ys (TL zs2))`; 816 817val mwi_mul_def = Define ` 818 mwi_mul (s,xs) (t,ys) = 819 if (xs = []) \/ (ys = []) then (F,[]) else 820 (~(s = t), mw_fix (mw_mul xs ys (MAP (\x.0w) ys)))`; 821 822val single_mul_thm = prove( 823 ``!(x:'a word) y k z l. 824 (single_mul x y k = (z,l)) ==> 825 (w2n z + dimword (:'a) * w2n l = w2n x * w2n y + w2n k)``, 826 NTAC 3 Cases_word \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 827 \\ ASM_SIMP_TAC std_ss [single_mul_def,w2n_n2w,LESS_MOD,b2w_def] 828 \\ `(n * n' + n'') DIV dimword (:'a) < dimword (:'a)` by 829 (SIMP_TAC std_ss [DIV_LT_X,ZERO_LT_dimword] 830 \\ MATCH_MP_TAC MULT_ADD_LESS_MULT \\ DECIDE_TAC) 831 \\ ASM_SIMP_TAC std_ss [word_add_n2w,word_mul_n2w,w2n_n2w] 832 \\ METIS_TAC [DIVISION,MULT_COMM,ADD_COMM,ZERO_LT_dimword]); 833 834val ADD_LESS_MULT = prove( 835 ``!n. 1 < n ==> n + (n - 1) < n * n``, 836 Induct \\ SIMP_TAC std_ss [MULT_CLAUSES] \\ REPEAT STRIP_TAC 837 \\ Cases_on `1<n` \\ RES_TAC THEN1 DECIDE_TAC 838 \\ `n = 1` by DECIDE_TAC \\ ASM_SIMP_TAC std_ss []); 839 840val single_mul_add_thm = prove( 841 ``!(p:'a word) q k1 k2 x1 x2. 842 (single_mul_add p q k1 k2 = (x1,x2)) ==> 843 (w2n x1 + dimword (:'a) * w2n x2 = w2n p * w2n q + w2n k1 + w2n k2)``, 844 SIMP_TAC std_ss [single_mul_add_def] \\ BasicProvers.LET_ELIM_TAC 845 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [] 846 \\ IMP_RES_TAC mw_add_thm \\ FULL_SIMP_TAC bool_ss [LENGTH,dimwords_thm] 847 \\ FULL_SIMP_TAC std_ss [mw2n_def,w2n_n2w,ZERO_LT_dimword,b2n_def] 848 \\ `?z1 z2. zs = [z1;z2]` by 849 (Q.PAT_X_ASSUM `mw_add _ _ _ = _` MP_TAC \\ FULL_SIMP_TAC std_ss [mw_add_def] 850 \\ BasicProvers.LET_ELIM_TAC \\ FULL_SIMP_TAC std_ss [] \\ METIS_TAC []) 851 \\ FULL_SIMP_TAC std_ss [HD,TL,mw2n_def] 852 \\ IMP_RES_TAC single_mul_thm \\ FULL_SIMP_TAC std_ss [] 853 \\ Cases_on `c` \\ FULL_SIMP_TAC std_ss [b2n_def] \\ CCONTR_TAC 854 \\ `dimword (:'a) * dimword (:'a) <= w2n p * w2n q + w2n k1 + w2n k2` by DECIDE_TAC 855 \\ POP_ASSUM MP_TAC \\ ASM_SIMP_TAC std_ss [GSYM NOT_LESS] 856 \\ `w2n p < dimword (:'a) /\ w2n k1 < dimword (:'a)` by METIS_TAC [w2n_lt] 857 \\ `w2n q < dimword (:'a) /\ w2n k2 < dimword (:'a)` by METIS_TAC [w2n_lt] 858 \\ `w2n p <= dimword (:'a) - 1` by DECIDE_TAC 859 \\ `w2n q <= dimword (:'a) - 1` by DECIDE_TAC 860 \\ `w2n p * w2n q <= (dimword (:'a) - 1) * (dimword (:'a) - 1)` by METIS_TAC [LESS_MONO_MULT2] 861 \\ FULL_SIMP_TAC std_ss [LEFT_SUB_DISTRIB,RIGHT_SUB_DISTRIB,GSYM SUB_PLUS] 862 \\ ASSUME_TAC (MATCH_MP ADD_LESS_MULT ONE_LT_dimword) 863 \\ Q.ABBREV_TAC `d = dimword(:'a)` \\ DECIDE_TAC); 864 865val mw_mul_pass_thm = prove( 866 ``!ys zs (x:'a word) k. 867 (LENGTH ys = LENGTH zs) ==> 868 (mw2n (mw_mul_pass x ys zs k) = w2n x * mw2n ys + mw2n zs + w2n k) /\ 869 (LENGTH (mw_mul_pass x ys zs k) = LENGTH ys + 1)``, 870 Induct \\ Cases_on `zs` \\ SIMP_TAC std_ss 871 [mw_mul_pass_def,LENGTH,dimwords_thm,mw2n_def,DECIDE ``~(SUC n = 0)``,HD,TL] 872 \\ POP_ASSUM (ASSUME_TAC o Q.SPEC `t`) \\ REPEAT STRIP_TAC 873 \\ BasicProvers.LET_ELIM_TAC 874 \\ FULL_SIMP_TAC std_ss [mw2n_def,LEFT_ADD_DISTRIB,LENGTH,ADD1,TL] 875 \\ IMP_RES_TAC single_mul_add_thm \\ DECIDE_TAC); 876 877val mw_mul_thm = store_thm("mw_mul_thm", 878 ``!xs ys (zs:'a word list). 879 (LENGTH ys = LENGTH zs) ==> 880 (mw2n (mw_mul xs ys zs) = mw2n xs * mw2n ys + mw2n zs)``, 881 Induct \\ SIMP_TAC std_ss [mw_mul_def,mw2n_def] \\ REPEAT STRIP_TAC 882 \\ SIMP_TAC std_ss [LET_DEF,mw2n_def] 883 \\ (STRIP_ASSUME_TAC o UNDISCH o Q.SPECL [`ys`,`zs`,`h`,`0w`]) mw_mul_pass_thm 884 \\ Q.ABBREV_TAC `qs = mw_mul_pass h ys zs (0w:'a word)` \\ POP_ASSUM (K ALL_TAC) 885 \\ Cases_on `qs` \\ FULL_SIMP_TAC std_ss [LENGTH,DECIDE ``~(0 = SUC n)``,ADD1] 886 \\ FULL_SIMP_TAC std_ss [TL,HD,mw2n_def,w2n_n2w,ZERO_LT_dimword] 887 \\ DECIDE_TAC); 888 889val Num_ABS_EQ_0 = prove( 890 ``!i. (Num (ABS i) = 0) = (i = 0)``, 891 intLib.COOPER_TAC); 892 893val NUM_EXISTS = prove( 894 ``!i. ?n. ABS i = & n``, 895 REPEAT STRIP_TAC \\ Cases_on `i < 0:int` \\ ASM_SIMP_TAC std_ss [INT_ABS] 896 THEN1 (Q.EXISTS_TAC `Num (-i)` \\ intLib.COOPER_TAC) 897 THEN1 (Q.EXISTS_TAC `Num i` \\ intLib.COOPER_TAC)); 898 899val mwi_mul_thm = store_thm("mwi_mul_thm", 900 ``!i j. mwi_mul (i2mw i) (i2mw j) = i2mw (i * j)``, 901 REPEAT STRIP_TAC 902 \\ SIMP_TAC std_ss [i2mw_def,mwi_mul_def,n2mw_NIL,Num_ABS_EQ_0] 903 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 904 \\ Cases_on `i = 0` 905 THEN1 ASM_SIMP_TAC std_ss [n2mw_NIL,Num_ABS_EQ_0,INT_MUL_REDUCE,INT_LT_REFL] 906 \\ Cases_on `j = 0` 907 THEN1 ASM_SIMP_TAC std_ss [n2mw_NIL,Num_ABS_EQ_0,INT_MUL_REDUCE,INT_LT_REFL] 908 \\ `i * j < 0 = ~(i < 0 = j < 0)` by 909 (SIMP_TAC std_ss [INT_MUL_SIGN_CASES] \\ intLib.COOPER_TAC) 910 \\ ASM_SIMP_TAC std_ss [] \\ SRW_TAC [] [] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 911 \\ MATCH_MP_TAC IMP_EQ_n2mw \\ ASM_SIMP_TAC std_ss [mw_ok_mw_fix] 912 \\ ASM_SIMP_TAC std_ss [mw2n_mw_fix,LENGTH_MAP,mw_mul_thm,mw2n_n2mw, 913 RW [APPEND,mw2n_def] (Q.SPEC `[]` mw2n_MAP_ZERO),GSYM INT_ABS_MUL] 914 \\ STRIP_ASSUME_TAC (Q.SPEC `i` NUM_EXISTS) 915 \\ STRIP_ASSUME_TAC (Q.SPEC `j` NUM_EXISTS) 916 \\ ASM_SIMP_TAC std_ss [INT_MUL,NUM_OF_INT,AC MULT_COMM MULT_ASSOC]); 917 918 919(* div by 2 *) 920 921val mw_shift_def = Define ` 922 (mw_shift [] = []) /\ 923 (mw_shift [w] = [w >>> 1]) /\ 924 (mw_shift ((w:'a word)::x::xs) = 925 (w >>> 1 !! x << (dimindex (:'a) - 1)) :: mw_shift (x::xs))`; 926 927val w2n_add = prove( 928 ``!x y. w2n (x + y) = (w2n x + w2n (y:'a word)) MOD dimword (:'a)``, 929 REPEAT Cases \\ SIMP_TAC std_ss [word_add_n2w,w2n_n2w,MOD_PLUS,ZERO_LT_dimword]); 930 931val word_LSL_n2w = prove( 932 ``!m k. ((n2w m):'a word) << k = n2w (m * 2 ** k)``, 933 SIMP_TAC std_ss [AC MULT_ASSOC MULT_COMM,WORD_MUL_LSL,word_mul_n2w]); 934 935val mw_shift_thm = store_thm("mw_shift_thm", 936 ``!xs. mw2n (mw_shift xs) = mw2n (xs:'a word list) DIV 2``, 937 Induct \\ SIMP_TAC std_ss [mw_shift_def,mw2n_def] 938 \\ Cases_on `xs` \\ ASM_SIMP_TAC std_ss [mw_shift_def,mw2n_def,w2n_lsr] 939 \\ CONV_TAC (RAND_CONV (ALPHA_CONV ``w:'a word``)) \\ REPEAT STRIP_TAC 940 \\ `w >>> 1 && h << (dimindex (:'a) - 1) = 0w` by 941 (SIMP_TAC std_ss [fcpTheory.CART_EQ,word_and_def,fcpTheory.FCP_BETA, 942 word_lsr_def,word_lsl_def,word_0] 943 \\ REPEAT STRIP_TAC \\ CCONTR_TAC 944 \\ FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC) 945 \\ IMP_RES_TAC WORD_ADD_OR \\ POP_ASSUM (fn th => SIMP_TAC std_ss [GSYM th]) 946 \\ REPEAT (POP_ASSUM (K ALL_TAC)) 947 \\ Q.SPEC_TAC (`h`,`h`) \\ Q.SPEC_TAC (`w`,`w`) \\ Cases \\ Cases 948 \\ ASM_SIMP_TAC std_ss [w2n_add,w2n_lsr,word_LSL_n2w,w2n_n2w] 949 \\ FULL_SIMP_TAC std_ss [dimword_def] 950 \\ `0 < dimindex (:'a)` by METIS_TAC [DIMINDEX_GT_0] 951 \\ `dimindex (:'a) = (dimindex (:'a) - 1) + 1` by DECIDE_TAC 952 \\ Q.ABBREV_TAC `d = dimindex (:'a) - 1` 953 \\ FULL_SIMP_TAC std_ss [GSYM ADD1,EXP] 954 \\ SIMP_TAC std_ss [RW1 [MULT_COMM] (GSYM MOD_COMMON_FACTOR)] 955 \\ `n DIV 2 + n' MOD 2 * 2 ** d < 2 * 2 ** d` by 956 (ONCE_REWRITE_TAC [ADD_COMM] \\ MATCH_MP_TAC MULT_ADD_LESS_MULT 957 \\ FULL_SIMP_TAC std_ss [DIV_LT_X,AC MULT_COMM MULT_ASSOC]) 958 \\ ASM_SIMP_TAC std_ss [GSYM MULT_ASSOC] 959 \\ ASM_SIMP_TAC std_ss [RW1 [ADD_COMM] (RW1 [MULT_COMM] ADD_DIV_ADD_DIV)] 960 \\ SIMP_TAC std_ss [LEFT_ADD_DISTRIB,MULT_ASSOC,ADD_ASSOC] 961 \\ `n' = n' DIV 2 * 2 + n' MOD 2` by METIS_TAC [DIVISION,DECIDE ``0<2``] 962 \\ POP_ASSUM (fn th => CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [th]))) 963 \\ SIMP_TAC std_ss [LEFT_ADD_DISTRIB,MULT_ASSOC,ADD_ASSOC] 964 \\ SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC, AC MULT_COMM MULT_ASSOC]); 965 966val LENGTH_mw_shift = store_thm("LENGTH_mw_shift", 967 ``!xs. LENGTH (mw_shift xs) = LENGTH xs``, 968 Induct \\ SIMP_TAC std_ss [LENGTH,mw_shift_def] 969 \\ Cases_on `xs` \\ ASM_SIMP_TAC std_ss [LENGTH,mw_shift_def]); 970 971 972(* compare *) 973 974val mw_cmp_def = tDefine "mw_cmp" ` 975 mw_cmp xs ys = if xs = [] then NONE else 976 if LAST xs = LAST ys then 977 mw_cmp (BUTLAST xs) (BUTLAST ys) 978 else SOME (LAST xs <+ LAST ys)` 979 (WF_REL_TAC `measure (LENGTH o FST)` \\ Cases \\ Cases 980 \\ SIMP_TAC std_ss [LENGTH_BUTLAST,NOT_NIL_CONS,LENGTH]) 981 982val mw_compare_def = Define ` 983 mw_compare xs ys = 984 if LENGTH xs < LENGTH ys then SOME (0 < 1) else 985 if LENGTH ys < LENGTH xs then SOME (1 < 0) else mw_cmp xs ys`; 986 987val option_eq_def = Define ` 988 (option_eq b NONE = NONE) /\ 989 (option_eq b (SOME x) = SOME (~(b = x)))`; 990 991val mwi_compare_def = Define ` 992 mwi_compare (s,xs) (t,ys) = 993 if s = t then option_eq s (mw_compare xs ys) else SOME s`; 994 995val mwi_lt_def = Define ` 996 mwi_lt s_xs t_ys = (mwi_compare s_xs t_ys = SOME T)`; 997 998val mwi_eq_def = Define ` 999 mwi_eq s_xs t_ys = (mwi_compare s_xs t_ys = NONE)`; 1000 1001val LAST_IMP_mw2n_LESS_mw2n = prove( 1002 ``!xs ys. (LENGTH xs = LENGTH ys) /\ (LAST xs <+ LAST ys) /\ ~(xs = []) ==> 1003 mw2n xs < mw2n ys``, 1004 STRIP_TAC \\ `(xs = []) \/ ?x xs1. xs = SNOC x xs1` by METIS_TAC [SNOC_CASES] 1005 \\ STRIP_TAC \\ `(ys = []) \/ ?y ys1. ys = SNOC y ys1` by METIS_TAC [SNOC_CASES] 1006 \\ ASM_SIMP_TAC std_ss [LENGTH_SNOC,LENGTH,DECIDE ``~(SUC n = 0)``,LAST_SNOC] 1007 \\ SIMP_TAC std_ss [SNOC_APPEND,mw2n_APPEND,mw2n_def] \\ REPEAT STRIP_TAC 1008 \\ ONCE_REWRITE_TAC [ADD_COMM] \\ ONCE_REWRITE_TAC [MULT_COMM] 1009 \\ MATCH_MP_TAC MULT_ADD_LESS_MULT_ADD 1010 \\ FULL_SIMP_TAC std_ss [mw2n_lt,WORD_LO] \\ METIS_TAC [mw2n_lt]); 1011 1012val mw_cmp_thm = store_thm("mw_cmp_thm", 1013 ``!xs ys. (LENGTH ys = LENGTH xs) ==> 1014 (mw_cmp xs ys = if mw2n xs = mw2n ys then NONE else 1015 SOME (mw2n xs < mw2n ys))``, 1016 HO_MATCH_MP_TAC SNOC_INDUCT \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [mw_cmp_def] 1017 THEN1 FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 1018 \\ `(ys = []) \/ ?z zs. ys = SNOC z zs` by METIS_TAC [SNOC_CASES] 1019 \\ FULL_SIMP_TAC std_ss [LENGTH,DECIDE ``~(0 = SUC n)``,LENGTH_SNOC] 1020 \\ FULL_SIMP_TAC std_ss [LAST_SNOC,NOT_NIL_SNOC] 1021 \\ Cases_on `x = z` \\ ASM_SIMP_TAC std_ss [FRONT_SNOC] 1022 THEN1 ASM_SIMP_TAC std_ss [SNOC_APPEND,mw2n_APPEND] 1023 \\ Cases_on `x <+ z` \\ ASM_SIMP_TAC std_ss [] THEN1 1024 (REV (sg `mw2n (SNOC x xs) < mw2n (SNOC z zs)`) THEN1 DECIDE_TAC 1025 \\ METIS_TAC [LAST_IMP_mw2n_LESS_mw2n,LENGTH_SNOC,LAST_SNOC,NOT_NIL_SNOC]) 1026 \\ MATCH_MP_TAC (DECIDE ``n < m ==> m <> n /\ ~(m < n:num)``) 1027 \\ METIS_TAC [LAST_IMP_mw2n_LESS_mw2n,LENGTH_SNOC,LAST_SNOC,NOT_NIL_SNOC, 1028 WORD_LOWER_LOWER_CASES]); 1029 1030val LENGTH_LESS_IMP_mw2n_LESS = store_thm("LENGTH_LESS_IMP_mw2n_LESS", 1031 ``!(xs:'a word list) (ys:'a word list). 1032 mw_ok xs /\ mw_ok ys /\ LENGTH xs < LENGTH ys ==> mw2n xs < mw2n ys``, 1033 REPEAT STRIP_TAC \\ STRIP_ASSUME_TAC (Q.ISPEC `ys:'a word list` SNOC_CASES) 1034 \\ FULL_SIMP_TAC std_ss [LENGTH,mw_ok_def,NOT_SNOC_NIL,LAST_SNOC,LENGTH_SNOC] 1035 \\ SIMP_TAC std_ss [SNOC_APPEND,mw2n_APPEND,mw2n_def] 1036 \\ Q.PAT_X_ASSUM `~(x = 0w)` MP_TAC \\ Q.SPEC_TAC (`x`,`x`) 1037 \\ Cases \\ ASM_SIMP_TAC std_ss [n2w_11,w2n_n2w,ZERO_LT_dimword] 1038 \\ REPEAT STRIP_TAC \\ ASSUME_TAC (Q.ISPEC `xs:'a word list` mw2n_lt) 1039 \\ `dimwords (LENGTH xs) (:'a) <= dimwords (LENGTH l) (:'a)` by 1040 (SIMP_TAC std_ss [dimwords_def] \\ DECIDE_TAC) 1041 \\ `0 < dimwords (LENGTH l) (:'a)` by FULL_SIMP_TAC std_ss [ZERO_LT_dimwords] 1042 \\ Cases_on `n` \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES] \\ DECIDE_TAC); 1043 1044val mw2n_LESS_IMP_LENGTH_LESS_EQ = store_thm("mw2n_LESS_IMP_LENGTH_LESS_EQ", 1045 ``!xs:'a word list ys:'a word list. 1046 mw_ok xs /\ mw_ok ys /\ mw2n xs < mw2n ys ==> LENGTH xs <= LENGTH ys``, 1047 SIMP_TAC std_ss [GSYM NOT_LESS] \\ REPEAT STRIP_TAC 1048 \\ IMP_RES_TAC LENGTH_LESS_IMP_mw2n_LESS \\ DECIDE_TAC); 1049 1050val mw_compare_thm = store_thm("mw_compare_thm", 1051 ``!xs ys. mw_ok xs /\ mw_ok ys ==> 1052 (mw_compare xs ys = if mw2n xs = mw2n ys then NONE else 1053 SOME (mw2n xs < mw2n ys))``, 1054 REPEAT STRIP_TAC \\ ASM_SIMP_TAC std_ss [mw_compare_def] 1055 \\ Cases_on `LENGTH xs = LENGTH ys` \\ ASM_SIMP_TAC std_ss [mw_cmp_thm] 1056 \\ `LENGTH xs < LENGTH ys \/ LENGTH ys < LENGTH xs` by DECIDE_TAC 1057 \\ IMP_RES_TAC LENGTH_LESS_IMP_mw2n_LESS 1058 \\ IMP_RES_TAC (DECIDE ``m < n ==> ~(n < m) /\ ~(m = n:num)``) 1059 \\ ASM_SIMP_TAC std_ss []); 1060 1061val mwi_compare_thm = store_thm("mwi_compare_thm", 1062 ``!i j. mwi_compare (i2mw i) (i2mw j) = if i = j then NONE else SOME (i < j)``, 1063 SIMP_TAC std_ss [i2mw_def,mwi_compare_def,mw_compare_thm,mw_ok_n2mw,mw2n_n2mw] 1064 \\ REPEAT STRIP_TAC \\ Cases_on `i = j` \\ ASM_SIMP_TAC std_ss [option_eq_def] 1065 \\ REV (Cases_on `i < 0 = j < 0`) \\ ASM_SIMP_TAC std_ss [] THEN1 intLib.COOPER_TAC 1066 \\ Cases_on `i < 0` \\ Cases_on `j < 0` \\ SRW_TAC [] [option_eq_def,INT_ABS] 1067 \\ intLib.COOPER_TAC); 1068 1069val mw_subv_NOT_NIL = store_thm("mw_subv_NOT_NIL", 1070 ``!xs ys. mw_ok xs /\ mw_ok ys /\ mw2n xs < mw2n ys ==> ~(mw_subv ys xs = [])``, 1071 REPEAT STRIP_TAC \\ IMP_RES_TAC mw2n_LESS_IMP_LENGTH_LESS_EQ 1072 \\ `mw2n xs <= mw2n ys` by DECIDE_TAC \\ IMP_RES_TAC mw_subv_thm 1073 \\ POP_ASSUM MP_TAC \\ ASM_SIMP_TAC std_ss [mw2n_def] \\ DECIDE_TAC); 1074 1075 1076(* alternative compare *) 1077 1078val mw_cmp_alt_def = Define ` 1079 (mw_cmp_alt [] ys b = b) /\ 1080 (mw_cmp_alt (x::xs) ys b = 1081 mw_cmp_alt xs (TL ys) (if x = HD ys then b else 1082 if x <+ HD ys then SOME T else SOME F))` 1083 1084val mw_cmp_CONS = prove( 1085 ``!xs ys. 1086 (LENGTH xs = LENGTH ys) ==> 1087 (mw_cmp (x::xs) (y::ys) = 1088 case mw_cmp xs ys of NONE => mw_cmp [x] [y] | t => t)``, 1089 HO_MATCH_MP_TAC (fetch "-" "mw_cmp_ind") \\ REPEAT STRIP_TAC 1090 \\ `(xs = []) \/ ?x1 l1. xs = SNOC x1 l1` by METIS_TAC [SNOC_CASES] 1091 \\ `(ys = []) \/ ?x2 l2. ys = SNOC x2 l2` by METIS_TAC [SNOC_CASES] 1092 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``mw_cmp [] []``] 1093 \\ SIMP_TAC (srw_ss()) [Once mw_cmp_def,LAST_DEF,FRONT_DEF] 1094 \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,FRONT_SNOC] 1095 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 1096 \\ SIMP_TAC (srw_ss()) [Once mw_cmp_def,LAST_SNOC,FRONT_SNOC] 1097 \\ Cases_on `x1 = x2` \\ FULL_SIMP_TAC std_ss []); 1098 1099val mw_cmp_alt_lemma = prove( 1100 ``!xs ys res. 1101 (LENGTH xs = LENGTH ys) ==> 1102 (mw_cmp_alt xs ys res = 1103 case mw_cmp xs ys of NONE => res | SOME t => SOME t)``, 1104 Induct \\ Cases_on `ys` \\ FULL_SIMP_TAC (srw_ss()) [] 1105 \\ SIMP_TAC (srw_ss()) [mw_cmp_alt_def,HD,TL] 1106 THEN1 (STRIP_TAC \\ EVAL_TAC) 1107 \\ REPEAT STRIP_TAC \\ Cases_on `h = h'` \\ FULL_SIMP_TAC std_ss [] 1108 \\ Q.PAT_X_ASSUM `!xx.bb` (MP_TAC o Q.SPEC `t`) 1109 \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 1110 \\ ASM_SIMP_TAC std_ss [Once mw_cmp_CONS] 1111 \\ Cases_on `mw_cmp xs t` \\ FULL_SIMP_TAC std_ss [] 1112 \\ EVAL_TAC \\ Cases_on `h = h'` \\ FULL_SIMP_TAC (srw_ss()) [] 1113 \\ SRW_TAC [] []); 1114 1115val mw_cmp_alt_thm = store_thm("mw_cmp_alt_thm", 1116 ``(LENGTH xs = LENGTH ys) ==> 1117 (mw_cmp xs ys = mw_cmp_alt xs ys NONE)``, 1118 Cases_on `mw_cmp xs ys` \\ ASM_SIMP_TAC std_ss [mw_cmp_alt_lemma]); 1119 1120 1121(* Division *) 1122 1123(* Following will be a definition of a division algorithm miming that 1124 described by Donald E. Knuth in "The Art of Computer 1125 Programming". (Found in "Volume II: Seminumerical Algorithms", on 1126 pages 270-273 in the most recent edition (3rd edition, 1997)). 1127 1128 It is meant to compute the quotient of a word list x_{1}...x_{m+n} 1129 by a word list y_{1}...y{n} where n and m are natural numbers, and 1130 the words have arbitrary dimension b = 2 ^ k, for some given 1131 natural k. 1132 1133 For this section, the digits of the word-list inputs are ordered in 1134 reverse - that is, with the most significant bit as head *) 1135 1136(* General Definitions *) 1137 1138val mw_mul_by_single_def = Define ` 1139 mw_mul_by_single (x:'a word) (ys:'a word list) = 1140 mw_mul_pass x ys (k2mw (LENGTH ys) 0) 0w`; 1141 1142val LENGTH_mw_mul_pass = store_thm("LENGTH_mw_mul_pass", 1143 ``!ys zs (x:'a word) k. 1144 (LENGTH (mw_mul_pass x ys zs k) = LENGTH ys + 1)``, 1145 Induct \\ Cases_on `zs` 1146 \\ FULL_SIMP_TAC (srw_ss()) [mw_mul_pass_def,single_mul_add_def,LET_DEF, 1147 single_mul_def,mw_add_def,single_add_def] \\ DECIDE_TAC); 1148 1149val LENGTH_mw_mul_by_single = store_thm("LENGTH_mw_mul_by_single", 1150 ``(LENGTH (mw_mul_by_single x ys) = LENGTH ys + 1)``, 1151 SIMP_TAC std_ss [LENGTH_mw_mul_pass,mw_mul_by_single_def]); 1152 1153val PULL_CONJ = METIS_PROVE [] ``!a b c.( a ==> b /\ c) ==>(a ==> b) /\ (a ==> c)`` 1154 1155(* Two theorems and corresponding tactics for handling equations 1156 in a more "high-level" way, compared with the ones I know. *) 1157 1158val EQ_M_R_S_i = 1159 GEN_ALL (CONJUNCT2 1160 (MP (Q.SPECL [`m*n < p*n`,`0<n`,`m<p`] PULL_CONJ) 1161 ((fn (x,y) => x) (EQ_IMP_RULE (SPEC_ALL LT_MULT_RCANCEL))))) 1162 1163val EQT_M_R_S_i = fn x => (MATCH_MP_TAC (Q.SPECL [`xxx`,x,`yyy`] EQ_M_R_S_i)) 1164 1165val EQ_A_S_R_2 = store_thm ("EQ_A_S_R_2", 1166 ``!c d a b. d <= c /\ a + c < b + d ==> a < b``, 1167 REPEAT strip_tac >> RW_TAC arith_ss[]); 1168 1169val EQT_A_S_R_2 = 1170 (* If the goal is `a < b` and `c <= d` is an assumption, transforms current goal into `a + c < b + d` *) 1171 fn (c,d) => 1172 (MATCH_MP_TAC 1173 (Q.SPECL [c,d,`xxx`,`yyy`] EQ_A_S_R_2) 1174 >> strip_tac THEN1 METIS_TAC[]); 1175 1176(* division arithmetic lemmas*) 1177 1178val DIV_thm2 = store_thm( "DIV_thm2", 1179 ``0 < b /\ a < c * b ==> a DIV b < c``, 1180 strip_tac >> METIS_TAC[DIV_LT_X]); 1181 1182val DIV_thm3 = store_thm( "DIV_thm3", 1183 ``!a b. 0 < b ==> (a DIV b * b <= a)``, 1184 REPEAT strip_tac >> IMP_RES_TAC DIVISION >> METIS_TAC[LESS_EQ_ADD]); 1185 1186val DIV_thm4 = store_thm( "DIV_thm4", 1187 ``!a b. 0 < b ==> (a - a DIV b * b < b)``, 1188 REPEAT strip_tac >> IMP_RES_TAC DIVISION >> 1189 METIS_TAC[MOD_LESS_EQ,DIV_thm3,CANCEL_SUB,ADD_SUB,ADD_COMM]); 1190 1191val DIV_thm4_bis = store_thm( "DIV_thm4_bis", 1192 ``!a b. 0 < b ==> a < b + a DIV b * b``, strip_tac >> 1193 METIS_TAC[DIV_EQ_X,MULT,ADD_COMM]); 1194 1195val DIV_thm1 = store_thm( "DIV_thm1", 1196 ``0 < b /\ b <= c ==> a DIV c <= a DIV b`` , 1197 strip_tac >> qsuff_tac `a < (a DIV b + 1) * c` THEN1 ( 1198 strip_tac >> METIS_TAC[LESS_LESS_EQ_TRANS,DIV_LE_X]) >> 1199 MATCH_MP_TAC LESS_LESS_EQ_TRANS >> EXISTS_TAC ``(a DIV b + 1)*b`` >> strip_tac THEN1 1200 METIS_TAC[DIV_thm4_bis,RIGHT_ADD_DISTRIB,MULT_LEFT_1,ADD_COMM] >> 1201 METIS_TAC[MULT_COMM,LESS_MONO_MULT]); 1202 1203val DIV_thm5 = store_thm( "DIV_thm5", 1204 ``0 < b /\ a - q*b < b ==> (q >= a DIV b)``, 1205 rw[GREATER_EQ] >> rw[DIV_LE_X] >> srw_tac[ARITH_ss][]); 1206 1207(* word & multiWord general *) 1208 1209val NOT_0w_bis = store_thm("NOT_0w_bis", 1210 ``w <> 0w ==> 0 < w2n w``, 1211 Cases_on `w`>> fs [] >> DECIDE_TAC); 1212 1213val dimwords_dimword = store_thm("dimwords_dimword", 1214 ``!n. dimwords n (:'a) = dimword(:'a) ** n``, 1215 rw[dimwords_def,dimword_def,Once MULT_COMM] >> 1216 Induct_on `n` THEN1 rw[] >> 1217 METIS_TAC[MULT_COMM,MULT,EXP,EXP_ADD]); 1218 1219val mw2n_msf = store_thm ("mw2n_msf" , 1220 ``!(x:'a word) xs. mw2n (xs++[x]) = mw2n xs + dimwords (LENGTH xs) (:'a) * w2n x``, 1221 Induct_on `xs` >> 1222 lrw[mw2n_def, EXP,dimwords_def,dimword_def,LEFT_ADD_DISTRIB] >> 1223 REWRITE_TAC[MULT,DECIDE ``z * dimindex (:'a) = dimindex (:'a) * z``] >> 1224 METIS_TAC[MULT_ASSOC,EXP_ADD,ADD_COMM]); 1225 1226val mw2n_msf_NIL = store_thm ("mw2n_msf_NIL", 1227 ``!(xs:'a word list). (xs <> []) /\ 1228 (mw2n xs < dimwords (LENGTH (FRONT xs)) (:'a)) ==> 1229 (mw2n xs = mw2n (FRONT xs))``, 1230 REPEAT strip_tac >> 1231 `mw2n xs = mw2n (FRONT xs ++ [LAST xs])` by METIS_TAC[APPEND_FRONT_LAST] >> 1232 POP_ASSUM (fn x => FULL_SIMP_TAC std_ss [x,mw2n_msf]) >> 1233 METIS_TAC[LESS_EQ_ADD,ADD_COMM,LESS_EQ_LESS_TRANS,LT_MULT_CANCEL_RBARE]); 1234 1235val mw2n_k2mw_0 = store_thm( "mw2n_k2mw_0", 1236 ``!x. mw2n ((k2mw x 0):'a word list) = 0``, 1237 Induct_on `x` THEN1 METIS_TAC[k2mw_def,mw2n_def] >> 1238 `0 DIV dimword(:'a) = 0` by METIS_TAC[ZERO_LT_dimword,ZERO_DIV] >> 1239 RW_TAC std_ss [word_0_n2w,k2mw_def,mw2n_def]); 1240 1241val mw_mul_by_single_lemma = store_thm( "mw_mul_by_single_lemma", 1242 ``!(x:'a word) (ys:'a word list). 1243 (mw2n (mw_mul_by_single x ys) = w2n x * mw2n ys) /\ 1244 (LENGTH (mw_mul_by_single x ys) = LENGTH ys + 1)``, 1245 REPEAT strip_tac >> 1246 REWRITE_TAC[mw_mul_by_single_def] >> 1247 `LENGTH (ys:'a word list) = LENGTH ((k2mw (LENGTH ys) 0): 'a word list)` 1248 by METIS_TAC[LENGTH_k2mw] >> 1249 IMP_RES_TAC (SPEC_ALL mw_mul_pass_thm) >> lrw[mw2n_k2mw_0]); 1250 1251val word_reverse_lsl = prove( 1252 ``!w n. word_reverse (w << n) = (word_reverse w >>> n):'a word``, 1253 FULL_SIMP_TAC std_ss [word_reverse_def,word_lsl_def,word_lsr_def, 1254 fcpTheory.CART_EQ,fcpTheory.FCP_BETA] \\ REPEAT STRIP_TAC 1255 \\ `(dimindex (:'a) - 1 - i) < dimindex (:'a)` by DECIDE_TAC 1256 \\ Cases_on `i + n < dimindex (:'a)` 1257 \\ FULL_SIMP_TAC std_ss [fcpTheory.FCP_BETA] 1258 \\ `i + n < dimindex (:'a) = n <= dimindex (:'a) - 1 - i` by DECIDE_TAC 1259 \\ FULL_SIMP_TAC std_ss [fcpTheory.FCP_BETA,SUB_PLUS]); 1260 1261val word_reverse_EQ_ZERO = prove( 1262 ``!w:'a word. (word_reverse w = 0w) = (w = 0w)``, 1263 FULL_SIMP_TAC std_ss 1264 [fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_reverse_def,word_0] 1265 \\ REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC 1266 \\ `dimindex (:'a) - 1 - i < dimindex (:'a)` by DECIDE_TAC \\ RES_TAC 1267 \\ `dimindex (:'a) - 1 - (dimindex (:'a) - 1 - i) = i` by DECIDE_TAC 1268 \\ FULL_SIMP_TAC std_ss []); 1269 1270val calc_d_def = tDefine "calc_d" ` 1271 1272(* Following is an algorithm that computes the normalisation factor 1273 (named d in Knuth's discussion) by which both xs and ys are multiplied 1274 to ensure that the most significant figure of ys in greater or equal to 1275 b / 2 1276 1277 Since we are working with word-size b = 2 ^ k for some natural k, 1278 we produce the factor by multiplying the mentioned figure by 2 1279 successively until b / 2 is reached. *) 1280 1281 calc_d (v1:'a word, d:'a word) = 1282 if (v1 = 0w) \/ word_msb(v1) then d else 1283 calc_d (v1 * 2w, d * 2w)` 1284 (WF_REL_TAC `measure (\(v1,d). w2n (word_reverse v1))` 1285 \\ SIMP_TAC std_ss [WORD_MUL_LSL |> Q.SPECL [`w`,`1`] |> 1286 SIMP_RULE std_ss [Once WORD_MULT_COMM] |> GSYM] 1287 \\ FULL_SIMP_TAC std_ss [word_reverse_lsl,w2n_lsr] 1288 \\ REPEAT STRIP_TAC 1289 \\ `~(word_reverse v1 = 0w)` by FULL_SIMP_TAC std_ss [word_reverse_EQ_ZERO] 1290 \\ Cases_on `word_reverse v1` 1291 \\ FULL_SIMP_TAC (srw_ss()) [DIV_LT_X] \\ DECIDE_TAC); 1292 1293val calc_d_ind = fetch "-" "calc_d_ind" 1294 1295(* Definition *) 1296 1297val single_div_def = Define ` 1298 (single_div (x1:'a word) (x2:'a word) (y:'a word) = 1299 (n2w ((w2n x1 * dimword (:'a) + w2n x2) DIV w2n y): 'a word, 1300 n2w ((w2n x1 * dimword (:'a) + w2n x2) MOD w2n y): 'a word))`; 1301 1302val mw_div_by_single_def = tDefine "mw_div_by_single" ` 1303 1304(* This algorithm forms the quotient of a multi-word number 1305 x_{1}x_{2}x_{3}...x_{n} by a single word y using the classic 1306 Euclidean division algorithm *) 1307 1308 (mw_div_by_single [] (y:'a word) = [0w]:'a word list) /\ 1309 (mw_div_by_single ([x]:'a word list) (y:'a word) = (\(a,b).if w2n x < w2n y then [b] else a::[b]) (single_div 0w x y)) /\ 1310 (mw_div_by_single (x1::x2::xs:'a word list) (y:'a word) = 1311 if (w2n x1 < w2n y) \/ (w2n y = 0) 1312 then let (q,r) = single_div x1 x2 y in 1313 q::(mw_div_by_single (r::xs) y) 1314 else let (q,r) = single_div 0w x1 y in 1315 q::(mw_div_by_single (r::x2::xs) y))` 1316 1317 (WF_REL_TAC`measure(\(xs,y). if w2n (HD xs) < w2n y 1318 then 2 * LENGTH xs 1319 else 2 * LENGTH xs + 1)` >> 1320 lrw[single_div_def] >> 1321 Cases_on `y = 0w` THEN1 METIS_TAC[] >> 1322 `0 < w2n y` by METIS_TAC[w2n_eq_0,NOT_ZERO_LT_ZERO] >> 1323 METIS_TAC[MOD_LESS,MOD_LESS_EQ,ZERO_LT_dimword,LESS_EQ_LESS_TRANS]) 1324 1325val mw_div_by_single_ind = fetch "-" "mw_div_by_single_ind" 1326 1327val mw_simple_div_def = Define ` 1328 (mw_simple_div x [] y = ([],x,T)) /\ 1329 (mw_simple_div x (x1::xs) y = 1330 let c1 = x <+ y in 1331 let (q,r) = single_div x x1 y in 1332 let (qs,r,c) = mw_simple_div r xs y in 1333 (q::qs,r,c /\ c1))`; 1334 1335val mw_div_test_def = tDefine "mw_div_test" ` 1336 1337(* This function encloses the 3rd step "D3" of Knuth's algorithm. It 1338 is meant to take input q = u_{1}u_{2} / v_{1}, and either outputs Q 1339 or Q + 1, where Q = U / V, U = u_{1}u_{2}u_{3}...u_{n+1}, 1340 V = v_{1}v_{2}...v_{n} are word lists with word-size b for some 1341 n > 1, and Q < b. 1342 1343 Both if statements rephrase Knuth's tests, replacing the value of 1344 the remainder r of the division u1u2 / v1 by r = u1u2 - u1u2 / v1, 1345 and adding values on both sides of each equation to avoid 1346 substractions. *) 1347 1348 mw_div_test (q:'a word) (u1:'a word) (u2:'a word) (u3:'a word) (v1:'a word) (v2:'a word) = 1349 if (mw_cmp [u3;u2;u1] (mw_mul_by_single q [v2;v1])) = SOME T 1350 then let q2 = n2w (w2n q - 1) in 1351 let s = single_mul q2 v1 0w in 1352 if (mw_cmp [u2;u1] (FST (mw_add [FST s; SND s] [0w;1w] F))) = SOME T 1353 then mw_div_test q2 u1 u2 u3 v1 v2 1354 else q2 1355 else q` 1356 1357 (WF_REL_TAC `measure (\(q,u1,u2,u3,v1,v2). w2n q)` >> 1358 REPEAT strip_tac >> 1359 Cases_on `w2n q` THEN1 ( 1360 qsuff_tac `mw_cmp [u3; u2; u1] (mw_mul_by_single 0w [v2; v1]) <> SOME T` THEN1 fs[] >> 1361 Q.PAT_ABBREV_TAC `x = mw_mul_by_single 0w [v2;v1]` >> 1362 Q.PAT_ABBREV_TAC `u = [u3;u2;u1]` >> 1363 `LENGTH x = LENGTH u` by fs[mw_mul_by_single_lemma,Abbr`x`,Abbr`u`] >> 1364 `~(mw2n u < mw2n x)` by rw[mw_mul_by_single_lemma,Abbr`x`] >> 1365 fs[mw_cmp_thm]) >> 1366 rw[SUC_SUB1] >> 1367 `n < dimword(:'a)` by METIS_TAC[w2n_lt,DECIDE ``n < SUC n``,LESS_TRANS] >> 1368 rw[]); 1369 1370val mw_div_test_ind = fetch "-" "mw_div_test_ind" 1371 1372val mw_div_loop_def = tDefine "mw_div_loop" 1373 1374(* This algorithm encloses the steps between the 3rd "D3" and the 1375 seventh "D7" which are repeated m + 1 times, where the initial 1376 inputs are dividend xs = x_{1}...x_{m+n} and divisor ys = 1377 y_{1}...y_{n}, and the normalised dividend is x_{1}...x_{m+n+1}. *) 1378 1379(* Inputs are: 1380 1381 zs = x_{1}...{j+n+1} 1382 us = x_{j}...x_{j+n+1} ( j = m, m-1,..., 0 ) 1383 q = x1x2 / y1 1384 1385 q is then modified through mw_div_test. 1386 1387 if us < q * ys, quotient digit is q - 1 1388 and input X becomes X - (q-1) * ys 1389 else quotient digit is q 1390 and input X's becomes X's - q * ys *) 1391 1392 `mw_div_loop (zs:'a word list) (ys:'a word list) = 1393 1394 if LENGTH ys < LENGTH zs 1395 then let (us:'a word list) = TAKE (SUC(LENGTH ys)) zs in 1396 let q = if w2n (HD us) < w2n (HD ys) 1397 then FST (single_div (HD us) (HD (TL us)) (HD ys)) 1398 else (n2w (dimword(:'a) - 1):'a word) in 1399 let q2 = mw_div_test q (HD us) (HD (TL us)) (HD (TL (TL us))) (HD ys) (HD (TL ys)) in 1400 let q2ys = mw_mul_by_single q2 (REVERSE ys) in 1401 1402 if mw_cmp (REVERSE us) q2ys = SOME T 1403 then let q3 = (n2w (w2n q2 - 1):'a word) in 1404 let q3ys = mw_mul_by_single q3 (REVERSE ys) in 1405 let zs2 = (REVERSE (FRONT (FST(mw_sub (REVERSE us) q3ys T)))) ++ DROP (SUC(LENGTH ys)) zs in 1406 q3::(mw_div_loop zs2 ys) 1407 else let zs2 = (REVERSE (FRONT (FST(mw_sub (REVERSE us) q2ys T)))) ++ DROP (SUC(LENGTH ys)) zs in 1408 q2::(mw_div_loop zs2 ys) 1409 else zs` 1410 1411(WF_REL_TAC `measure (LENGTH o FST)` >> 1412 REPEAT strip_tac >> 1413 Q.PAT_ABBREV_TAC `us = (TAKE (SUC (LENGTH ys)) zs)` >> 1414 Q.PAT_ABBREV_TAC `q = (if w2n (HD us) < w2n (HD ys) then 1415 FST (single_div (HD us) (HD (TL us)) (HD ys)) 1416 else 1417 n2w (dimword (:'a) - 1))` >> 1418 Q.PAT_ABBREV_TAC `q2 =(mw_div_test q (HD us) (HD (TL us)) 1419 (HD (TL (TL us))) (HD ys) (HD (TL ys)))` >> 1420 `LENGTH us = SUC (LENGTH ys)` by METIS_TAC[LENGTH_TAKE,LESS_EQ] THENL [ 1421 1422 Q.PAT_ABBREV_TAC `q3:'a word = n2w (w2n q2 - 1)` >> 1423 Q.PAT_ABBREV_TAC `q3ys = (mw_mul_by_single q3 (REVERSE ys))` >> 1424 `LENGTH (REVERSE us) = LENGTH q3ys` by METIS_TAC[LENGTH_REVERSE,Abbr`q3ys`,mw_mul_by_single_lemma,ADD1] >> 1425 Q.PAT_ABBREV_TAC `ws = FST (mw_sub (REVERSE us) q3ys T)` , 1426 1427 Q.PAT_ABBREV_TAC `q2ys = (mw_mul_by_single q2 (REVERSE ys))` >> 1428 `LENGTH (REVERSE us) = LENGTH q2ys` by METIS_TAC[LENGTH_REVERSE,Abbr`q2ys`,mw_mul_by_single_lemma,ADD1] >> 1429 Q.PAT_ABBREV_TAC `ws = FST (mw_sub (REVERSE us) q2ys T)` ] >> 1430 1431 `LENGTH ws = LENGTH (REVERSE us)` by METIS_TAC[PAIR,mw_sub_lemma,Abbr`ws`] >> 1432 lrw[] >> 1433 qsuff_tac `ws <> []` THEN1 METIS_TAC[rich_listTheory.LENGTH_BUTLAST,LENGTH_REVERSE,prim_recTheory.PRE,DECIDE ``n < SUC n``] THEN1 1434 METIS_TAC[NULL,rich_listTheory.LENGTH_NOT_NULL,DECIDE ``0 < SUC n``,LENGTH_REVERSE] THEN1 1435 METIS_TAC[rich_listTheory.LENGTH_BUTLAST,LENGTH_REVERSE,prim_recTheory.PRE,DECIDE ``n < SUC n``] >> 1436 METIS_TAC[NULL,rich_listTheory.LENGTH_NOT_NULL,DECIDE ``0 < SUC n``,LENGTH_REVERSE]) 1437 1438val mw_div_loop_ind = fetch "-" "mw_div_loop_ind" 1439 1440(* calc_d Lemmas *) 1441 1442val d_word_msb = store_thm( "d_word_msb", 1443``!(a:'a word). word_msb a <=> dimword(:'a) DIV 2 <= w2n a``, 1444 Cases \\ `0 < dimindex (:'a)` by FULL_SIMP_TAC std_ss [DIMINDEX_GT_0] 1445 \\ `(dimindex(:'a)) - 1 < (dimindex (:'a))` by DECIDE_TAC 1446 \\ `2 ** SUC (dimindex(:'a) - 1) = dimword (:'a)` by 1447 (FULL_SIMP_TAC std_ss [dimword_def] \\ DECIDE_TAC) 1448 \\ FULL_SIMP_TAC std_ss [w2n_n2w,word_msb_def,word_index,bitTheory.BIT_def, 1449 bitTheory.BITS_THM2,DIV_LE_X,DIV_EQ_X,GSYM EXP] 1450 \\ FULL_SIMP_TAC std_ss [dimword_def] \\ Cases_on `dimindex (:'a)` 1451 \\ FULL_SIMP_TAC std_ss [EXP] \\ DECIDE_TAC); 1452 1453val d_lemma1 = store_thm ("d_lemma1", 1454``!(v1:'a word) (d:'a word) (x:'a word). 1455 calc_d (FST(v1,d),SND(v1,d)*x) = calc_d(v1,d) * x``, 1456 HO_MATCH_MP_TAC calc_d_ind >> REPEAT strip_tac >> 1457 rw[Once calc_d_def] THEN1 rw[Once calc_d_def] THEN1 rw[Once calc_d_def] >> 1458 fs[FST,SND] >> 1459 `!(x1:'a word) (x2:'a word). x1 * x2 = x2 * x1` by rw[] >> 1460 METIS_TAC[calc_d_def]); 1461 1462val d_lemma2 = store_thm ("d_lemma2", 1463``!(v1:'a word) (d:'a word). 1464 FST(v1,d) <> 0w ==> 1465 dimword(:'a) DIV 2 <= w2n ((calc_d (FST(v1,d),1w:'a word)) * (FST (v1,d)))``, 1466 1467 HO_MATCH_MP_TAC calc_d_ind >> REPEAT strip_tac >> 1468 rw[Once calc_d_def] THEN1 METIS_TAC[d_word_msb] >> 1469 fs[FST] >> 1470 `w2n d < dimword(:'a) DIV 2` by METIS_TAC[d_word_msb,NOT_LESS_EQUAL] >> 1471 `0 < 2` by DECIDE_TAC >> 1472 `(2 * w2n d) < dimword(:'a)` by METIS_TAC[MULT_COMM,DIV_thm3,LESS_LESS_EQ_TRANS,LT_MULT_RCANCEL] >> 1473 Cases_on `dimword(:'a) = 2` THEN1 (`w2n d = 0` by DECIDE_TAC >> METIS_TAC[w2n_eq_0]) >> 1474 ASSUME_TAC ONE_LT_dimword >> `2 < dimword(:'a)` by DECIDE_TAC >> 1475 `2w * d <> 0w` by rw[word_mul_def] >> 1476 `2w = 1w * 2w` by rw[] >> 1477 `calc_d(2w *d, 2w) = calc_d(2w*d,1w) * 2w` by METIS_TAC[d_lemma1,FST,SND] >> POP_ASSUM (fn x => REWRITE_TAC[x]) >> 1478 RES_TAC >>rw[]); 1479 1480val d_lemma2_bis = store_thm ( "d_lemma2_bis", 1481``!(v1:'a word) (d:'a word). 1482 FST(v1,d) <> 0w ==> calc_d (FST(v1,d),1w) <> 0w``, 1483 REPEAT strip_tac >> IMP_RES_TAC d_lemma2 >> 1484 `w2n (calc_d (FST (v1,d),1w)) = 0` by METIS_TAC[word_0_n2w] >> 1485 fs[FST,word_mul_def] >> 1486 METIS_TAC[TWO,LESS_EQ,ONE_LT_dimword,DECIDE``0<2``,prim_recTheory.LESS_NOT_EQ,DIV_GT0]); 1487 1488val d_lemma3 = store_thm ("d_lemma3", 1489``!(v1:'a word) (d:'a word). 1490 w2n (calc_d (FST(v1,d),1w:'a word)) * w2n (FST (v1,d)) < dimword(:'a)``, 1491 1492 HO_MATCH_MP_TAC calc_d_ind >> REPEAT strip_tac >> 1493 srw_tac[][Once calc_d_def,w2n_lt] >> 1494 ASSUME_TAC d_lemma1 >> 1495 RES_TAC >> full_simp_tac (srw_ss())[FST,SND] >> 1496 `2w = 1w*2w` by srw_tac[][] >> 1497 `calc_d (2w * d,2w) = 2w * (calc_d (2w * d,1w))` by METIS_TAC[] >> POP_ASSUM (fn x => REWRITE_TAC[x]) >> 1498 Q.PAT_ABBREV_TAC` X = calc_d (2w * d,1w)` >> 1499 full_simp_tac (srw_ss())[word_mul_def] >> 1500 Cases_on `dimword(:'a) = 2` THEN1 full_simp_tac (srw_ss())[] >> 1501 ASSUME_TAC ONE_LT_dimword >> 1502 `2 < dimword(:'a)` by DECIDE_TAC >> 1503 `2 MOD dimword(:'a) = 2` by METIS_TAC[LESS_MOD] >> 1504 POP_ASSUM (fn x => full_simp_tac (srw_ss())[x]) >> 1505 `w2n d < dimword(:'a) DIV 2` by METIS_TAC[d_word_msb,NOT_LESS_EQUAL] >> 1506 `0 < 2` by DECIDE_TAC >> 1507 `(2 * w2n d) < dimword(:'a)` by METIS_TAC[MULT_COMM,DIV_thm3,LESS_LESS_EQ_TRANS,LT_MULT_RCANCEL] >> 1508 `(2 * w2n d) MOD dimword(:'a) = (2 * w2n d)` by srw_tac[][LESS_MOD] >> POP_ASSUM (fn x => full_simp_tac (srw_ss())[x]) >> 1509 `(2 * w2n X) * w2n d < dimword(:'a)` by RW_TAC arith_ss[] >> 1510 METIS_TAC[MOD_LESS_EQ,ZERO_LT_dimword,LESS_EQ_LESS_TRANS,LESS_MONO_MULT]); 1511 1512val d_lemma4 = store_thm ("d_lemma4", 1513``!(v1:'a word) (d:'a word). 1514 ?n. w2n (calc_d (FST(v1,d),1w)) = 2 ** n``, 1515 1516 HO_MATCH_MP_TAC calc_d_ind >> REPEAT strip_tac >> srw_tac[][Once calc_d_def] >> RES_TAC >> 1517 full_simp_tac (srw_ss())[FST] >> 1518 `2w = 1w * 2w` by srw_tac[][] >> 1519 `calc_d (2w * d,2w) = calc_d (2w * d,1w) * 2w` by METIS_TAC[d_lemma1,FST,SND] >> 1520 POP_ASSUM (fn x => REWRITE_TAC[x]) >> srw_tac[][word_mul_def] >> 1521 REWRITE_TAC[dimword_def] >> ASSUME_TAC dimword_def >> Q.PAT_ABBREV_TAC `m = dimindex(:'a)` >> markerLib.RM_ABBREV_TAC "m" >> 1522 Cases_on `m = 1` THEN1 ( 1523 `w2n d < 1` by METIS_TAC[d_word_msb,NOT_LESS_EQUAL,EVAL ``2 ** 1 DIV 2``] >> 1524 `w2n d = 0` by DECIDE_TAC >> 1525 METIS_TAC[w2n_eq_0]) >> 1526 Cases_on `m` THEN1 METIS_TAC[EXP,ONE_LT_dimword,prim_recTheory.LESS_NOT_EQ] >> 1527 `2 < dimword(:'a)` by (srw_tac[][] >> 1528 Cases_on `n'` THEN1 DECIDE_TAC >> 1529 srw_tac[][EXP] >> METIS_TAC[LE_MULT_CANCEL_LBARE,ZERO_LT_EXP,DECIDE ``0 < 2 /\ 1 < 2``, LESS_LESS_EQ_TRANS] ) >> 1530 qpat_x_assum `dimword(:'a) = xxx` (fn x => REWRITE_TAC [GSYM x] \\ (ASSUME_TAC x)) >> 1531 srw_tac[][LESS_MOD,DECIDE ``2 ** n * 2 = 2 * 2 ** n``,GSYM EXP] >> 1532 `SUC n < SUC n'` 1533 by (ASSUME_TAC (Q.SPECL [`(2w:'a word)*(d:'a word)`,`x`] d_lemma3) >> 1534 qpat_x_assum `2 < xxx` 1535 (fn x => full_simp_tac (srw_ss())[FST] \\ ASSUME_TAC x) >> 1536 qsuff_tac `w2n (calc_d (2w * d, 1w)) < dimword(:'a) DIV 2` THEN1 1537 (strip_tac >> 1538 `dimword(:'a) DIV 2 = 2 ** SUC n' DIV 2 ** 1` by srw_tac[][] >> 1539 `dimword(:'a) DIV 2 = 2 ** n'` 1540 by METIS_TAC[SUC_SUB1,EXP_SUB, 1541 DECIDE ``(0 < 2) /\ (1 <= SUC n')`` ] >> 1542 ` 2 ** n < 2 ** n'` by METIS_TAC[] >> full_simp_tac (srw_ss())[]) >> 1543 `w2n (2w * d) = 2 * w2n d` 1544 by (srw_tac[][word_mul_def] >> 1545 `w2n d < dimword(:'a) DIV 2` 1546 by METIS_TAC[d_word_msb,NOT_LESS_EQUAL] >> 1547 `0 < 2` by DECIDE_TAC >> 1548 METIS_TAC[MULT_COMM,DIV_thm3,LESS_LESS_EQ_TRANS, 1549 LT_MULT_RCANCEL]) >> 1550 POP_ASSUM (fn x => full_simp_tac (srw_ss())[x,EXP]) >> 1551 POP_ASSUM (K ALL_TAC) >> 1552 POP_ASSUM (fn x => ASSUME_TAC (RW [DECIDE ``a*(b*c) = a*c*b``] x)) >> 1553 `0 < w2n d` by METIS_TAC[NOT_0w_bis] >> 1554 ONCE_REWRITE_TAC[MULT_COMM] >> srw_tac[][MULT_DIV] >> 1555 METIS_TAC[LE_MULT_CANCEL_LBARE,LESS_EQ_LESS_TRANS,MULT_COMM, 1556 EQ_M_R_S_i,EXP_BASE_LT_MONO,DECIDE ``1 < 2``]) >> 1557 IMP_RES_TAC TWOEXP_MONO >> srw_tac[][LESS_MOD]); 1558 1559val d_lemma5 = store_thm ("d_lemma5", 1560``!(v1:'a word) (d:'a word). 1561 2 <= w2n (calc_d (FST(v1,d),1w:'a word)) ==> 1562 w2n (calc_d (FST(v1,d),1w:'a word)) * SUC (w2n (FST (v1,d))) <= dimword(:'a)``, 1563 1564 REPEAT strip_tac >> 1565 REWRITE_TAC[dimword_def] >> ASSUME_TAC dimword_def >> Q.PAT_ABBREV_TAC `m = dimindex(:'a)` >> markerLib.RM_ABBREV_TAC "m" >> 1566 ASSUME_TAC (Q.SPECL [`v1:'a word`, `d:'a word`] d_lemma4) >> 1567 full_simp_tac (srw_ss())[] >> 1568 `n < m` by METIS_TAC[EXP_BASE_LT_MONO,DECIDE ``1 < 2``,w2n_lt] >> 1569 `?p. m = n + p` by METIS_TAC[LESS_EQ_EXISTS,LESS_IMP_LESS_OR_EQ] >> 1570 `w2n v1 * 2 ** n < 2 ** p * 2 ** n` by METIS_TAC[d_lemma3,FST,EXP_ADD,MULT_COMM] >> 1571 POP_ASSUM (fn x => ASSUME_TAC (MP (Q.SPECL [`2 ** p`,`2 ** n`,`w2n (v1:'a word)`] EQ_M_R_S_i) x)) >> 1572 `2 ** p = 2 ** m DIV 2 ** n` by METIS_TAC[EXP_ADD,MULT_COMM,MULT_DIV,ZERO_LT_EXP,DECIDE ``0 < 2``] >> 1573 METIS_TAC[ZERO_LT_EXP,DECIDE ``0<2``,ADD1,X_LT_DIV,MULT_COMM]); 1574 1575val d_clauses = store_thm( "d_clauses", 1576``!(vs:'a word list) (v1:'a word). 1577 (0 < w2n v1) ==> 1578 (0 < w2n (calc_d (v1,1w))) /\ 1579 (mw2n (mw_mul_by_single (calc_d (v1,1w)) (REVERSE (v1::vs))) = mw2n (FRONT (mw_mul_by_single (calc_d (v1,1w)) (REVERSE (v1::vs))))) /\ 1580 (dimword(:'a) DIV 2 <= w2n (LAST (FRONT (mw_mul_by_single (calc_d (v1,1w)) (REVERSE (v1::vs))))))``, 1581 1582 REPEAT GEN_TAC >> strip_tac >> 1583 qsuff_tac `0 < w2n (calc_d (v1,1w))` 1584 THEN1( strip_tac >> strip_tac THEN1 DECIDE_TAC >> 1585 Q.PAT_ABBREV_TAC `X = mw_mul_by_single (calc_d (v1,1w)) (REVERSE (v1::vs))` >> 1586 `0 < mw2n X` by( markerLib.UNABBREV_TAC "X" >> 1587 REWRITE_TAC[mw_mul_by_single_lemma] >> 1588 MATCH_MP_TAC ((fn (x,y) => y) (EQ_IMP_RULE (SPEC_ALL (ZERO_LESS_MULT)))) >> 1589 strip_tac THEN1 DECIDE_TAC >> 1590 lrw[mw2n_msf] >> 1591 METIS_TAC[ZERO_LT_EXP,ZERO_LT_dimword,ADD_COMM,LESS_EQ_ADD,LESS_LESS_EQ_TRANS,ZERO_LESS_MULT,dimwords_dimword]) >> 1592 `X <> []` by METIS_TAC[mw2n_def,NOT_ZERO_LT_ZERO] >> 1593 qsuff_tac `mw2n X = mw2n (FRONT X)` 1594 THEN1( qsuff_tac `dimword(:'a) DIV 2 * dimwords (LENGTH vs) (:'a) <= mw2n X` 1595 THEN1( REPEAT strip_tac THEN1 DECIDE_TAC >> 1596 FULL_SIMP_TAC std_ss [] >> 1597 `FRONT X <> []` by METIS_TAC[NOT_ZERO_LT_ZERO,mw2n_def] >> 1598 `mw2n (FRONT X) = mw2n (FRONT (FRONT X) ++ [LAST (FRONT X)])` by METIS_TAC[APPEND_FRONT_LAST] >> 1599 POP_ASSUM (fn x => FULL_SIMP_TAC std_ss [x,mw2n_msf]) >> 1600 `LENGTH (FRONT (FRONT X)) = LENGTH (vs:'a word list)` by METIS_TAC[rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE, 1601 LENGTH,LENGTH_REVERSE,mw_mul_by_single_lemma,ADD1,Abbr`X`] >> 1602 POP_ASSUM (fn x => FULL_SIMP_TAC std_ss [x] \\ ASSUME_TAC x) >> 1603 `mw2n (FRONT (FRONT X)) < dimwords (LENGTH (vs:'a word list)) (:'a) ` by METIS_TAC[mw2n_lt]>> 1604 `mw2n (FRONT (FRONT X)) + dimwords (LENGTH vs) (:'a) * w2n (LAST (FRONT X)) 1605 < dimwords (LENGTH vs) (:'a) * (1 + w2n (LAST (FRONT X)))` 1606 by METIS_TAC [LESS_MONO_ADD,MULT_RIGHT_1,LEFT_ADD_DISTRIB] >> 1607 `dimword(:'a) DIV 2 < SUC (w2n (LAST (FRONT X)))` by METIS_TAC[EQ_M_R_S_i,MULT_COMM,LESS_EQ_LESS_TRANS,ADD1,ADD_COMM] >> 1608 DECIDE_TAC) >> 1609 `mw2n X = w2n (calc_d (v1,1w)) * mw2n (REVERSE (v1::vs))` by METIS_TAC[mw_mul_by_single_lemma,Abbr`X`] >> 1610 POP_ASSUM (fn x => REWRITE_TAC[x]) >> 1611 srw_tac[][mw2n_msf,LEFT_ADD_DISTRIB] >> 1612 REWRITE_TAC[DECIDE ``a*b + a * (c * d) = a*d*c + a*b``] >> 1613 `v1 <> 0w` by (Cases_on `v1 = 0w` >> full_simp_tac (srw_ss())[]) >> 1614 `!(a:'a word) (b:'a word).w2n (a * b) <= w2n a * w2n b` by srw_tac[][word_mul_def,MOD_LESS_EQ] >> 1615 METIS_TAC[d_lemma2,FST,LESS_MONO_MULT,LESS_EQ_ADD,LESS_EQ_TRANS]) >> 1616 MATCH_MP_TAC mw2n_msf_NIL >> strip_tac THEN1 METIS_TAC[] >> 1617 srw_tac[][rich_listTheory.LENGTH_BUTLAST] >> 1618 markerLib.UNABBREV_TAC "X" >> 1619 REWRITE_TAC[mw_mul_by_single_lemma,GSYM ADD1,prim_recTheory.PRE] >> 1620 Q.PAT_ABBREV_TAC `Z = w2n (calc_d (v1,1w))` >> 1621 Cases_on `Z = 1` THEN1 METIS_TAC[mw2n_lt,DECIDE``1*x = x``] >> 1622 full_simp_tac (srw_ss())[mw2n_msf,LEFT_ADD_DISTRIB] >> 1623 REWRITE_TAC[DECIDE ``x*y + x*(z*w) = x*w*z + x*y``,EXP] >> 1624 Q.PAT_ABBREV_TAC `Y = Z * w2n v1 * dimwords (LENGTH vs) (:'a)` >> 1625 Cases_on `v1 = 0w` THEN1 METIS_TAC[word_0_n2w,DECIDE ``~(0<0)``] >> 1626 `0 < Z` by METIS_TAC[FST,d_lemma2_bis,NOT_0w_bis] >> 1627 `2 <= Z` by DECIDE_TAC >> 1628 MATCH_MP_TAC LESS_LESS_EQ_TRANS >> 1629 EXISTS_TAC ``Y + Z * dimwords (LENGTH (vs:'a word list)) (:'a)`` >> strip_tac THEN1 1630 METIS_TAC[LESS_MONO_ADD,ADD_COMM,MULT_COMM,mw2n_lt,LENGTH_REVERSE,LT_MULT_RCANCEL] >> 1631 markerLib.UNABBREV_TAC "Y" >> 1632 REWRITE_TAC[dimwords_SUC,DECIDE ``z*v*l + z*l = z*(v+1)*l``,DECIDE ``x * dimword(:'a) = dimword(:'a) * x``] >> 1633 MATCH_MP_TAC LESS_MONO_MULT >> METIS_TAC[Abbr`Z`,ADD1,d_lemma5,FST,MULT_COMM]) >> 1634 Cases_on `v1 = 0w` THEN1 full_simp_tac (srw_ss())[] >> METIS_TAC[d_lemma2_bis,FST,NOT_0w_bis]) 1635 1636val LAST_FRONT_mw_mul_by_single_NOT_ZERO = store_thm( 1637 "LAST_FRONT_mw_mul_by_single_NOT_ZERO", 1638 ``mw_ok ys /\ ys <> [] /\ 2 < dimword (:'a) ==> 1639 LAST (FRONT (mw_mul_by_single (calc_d (LAST ys,0x1w:'a word)) ys)) <> 0x0w``, 1640 STRIP_TAC 1641 \\ MP_TAC (d_clauses |> Q.SPECL [`TL (REVERSE ys)`,`HD (REVERSE ys)`]) 1642 \\ `~(NULL (REVERSE ys))` by FULL_SIMP_TAC std_ss [NULL_EQ,REVERSE_EQ_NIL] 1643 \\ FULL_SIMP_TAC std_ss [CONS,NULL_DEF,REVERSE_REVERSE] 1644 \\ FULL_SIMP_TAC std_ss [HD_REVERSE] 1645 \\ Cases_on `LAST (FRONT (mw_mul_by_single (calc_d (LAST ys,0x1w)) ys))` 1646 \\ FULL_SIMP_TAC std_ss [w2n_n2w,DIV_LE_X,n2w_11,ZERO_LT_dimword,mw_ok_def] 1647 \\ Cases_on `LAST ys` 1648 \\ FULL_SIMP_TAC std_ss [w2n_n2w,DIV_LE_X,n2w_11,ZERO_LT_dimword,mw_ok_def] 1649 \\ Cases_on `n'` \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 1650 \\ FULL_SIMP_TAC std_ss [] 1651 \\ DECIDE_TAC); 1652 1653(* Single Division: x1x2 / y *) 1654 1655val single_div_lemma1 = store_thm ( "single_div_lemma1" , 1656`` w2n (x1:'a word) < w2n (y:'a word) ==> 1657 (w2n (x2:'a word) + dimword(:'a) * w2n x1) DIV w2n y < dimword(:'a)``, 1658 strip_tac >> MATCH_MP_TAC DIV_thm2 >> strip_tac THEN1 DECIDE_TAC >> 1659 `w2n x2 < dimword(:'a)` by METIS_TAC[w2n_lt] >> 1660 `w2n x2 + dimword(:'a) * w2n x1 < dimword(:'a) * SUC (w2n x1)` 1661 by METIS_TAC[LESS_MONO_ADD,MULT_RIGHT_1,LEFT_ADD_DISTRIB,ADD1,ADD_COMM] >> 1662 METIS_TAC[LESS_EQ,LESS_LESS_EQ_TRANS,LESS_MONO_MULT,MULT_COMM] ); 1663 1664val single_div_lemma2 = store_thm ( "single_div_lemma2", 1665 ``y <> 0w ==> w2n (SND (single_div x1 x2 y)) < w2n y``, 1666 lrw[single_div_def] >> 1667 ` 0 < w2n y` by PROVE_TAC [NOT_0w_bis] >> 1668 `0 < dimword(:'a)` by PROVE_TAC[ZERO_LT_dimword] >> 1669 Q.PAT_ABBREV_TAC`x = w2n x2 + dimword (:'a) * w2n x1` >> 1670 Q.PAT_ABBREV_TAC`z = x MOD w2n y` >> 1671 `z < w2n y` by PROVE_TAC[MOD_LESS] >> 1672 `z MOD dimword(:'a) <= z` by PROVE_TAC[MOD_LESS_EQ] >> 1673 DECIDE_TAC); 1674 1675val single_div_thm = store_thm ( "single_div_thm", 1676 ``!(x1:'a word) (x2:'a word) y q r. (single_div x1 x2 y = (q,r)) 1677 ==>(((w2n x1 * dimword(:'a) + w2n x2) DIV w2n y < dimword(:'a) /\ 1678 y <> 0w) 1679 ==> ((w2n q = (w2n x1 * dimword(:'a) + w2n x2) DIV w2n y) /\ 1680 (w2n r = (w2n x1 * dimword(:'a) + w2n x2) MOD w2n y)))``, 1681 1682 lrw[single_div_def] >> full_simp_tac (srw_ss()) [] >> lrw[w2n_n2w] >> 1683 `!w. w <> 0w ==> 0 < w2n w` by (Cases_on `w`>> full_simp_tac (srw_ss()) [] >> DECIDE_TAC) >> 1684 `w2n y < dimword(:'a)` by lrw[w2n_lt] >> 1685 METIS_TAC[MOD_LESS,LESS_TRANS] ); 1686 1687val single_div_thm_bis = store_thm ( "single_div_thm_bis", 1688 ``!(x1:'a word) (x2:'a word) y q r. (single_div x1 x2 y = (q,r)) /\ 1689 (w2n x1 < w2n y) ==> 1690 (w2n q * w2n y + w2n r = w2n x1 * dimword(:'a) + w2n x2)``, 1691 1692 REPEAT strip_tac >> IMP_RES_TAC single_div_lemma1 >> 1693 qpat_x_assum `!xs. xxx` (fn x => (ASSUME_TAC (RW[Once ADD_COMM,Once MULT_COMM] (SPEC ``x2:'a word`` x)))) >> 1694 Cases_on `y = 0w` THEN1 full_simp_tac (srw_ss())[word_0_n2w] >> 1695 IMP_RES_TAC single_div_thm >> `0 < w2n y` by DECIDE_TAC >> 1696 METIS_TAC[DIVISION]); 1697 1698(* Division by single: x_{1}x_{2}...x_{n} / y *) 1699 1700val mw_div_by_single_LENGTH = store_thm ("mw_div_by_single_LENGTH", 1701``!x xs y. w2n x < w2n y ==> 1702 (LENGTH (mw_div_by_single (x::xs) y) = SUC (LENGTH xs))``, 1703 1704 REPEAT GEN_TAC >> 1705 completeInduct_on `LENGTH (x::xs)`>> 1706 REPEAT STRIP_TAC >> 1707 Cases_on `xs` THEN1 lrw[Once mw_div_by_single_def,single_div_def] >> 1708 lrw[Once mw_div_by_single_def,single_div_def] >> 1709 Q.PAT_ABBREV_TAC `w:'a word = n2w ((w2n h + dimword (:'a) * w2n x) MOD w2n y)` >> 1710 `w2n w < w2n y` by (markerLib.UNABBREV_TAC "w" >> 1711 REWRITE_TAC[w2n_n2w] >> 1712 METIS_TAC[DECIDE ``!a. 0 <= a``,LESS_EQ_LESS_TRANS,MOD_LESS_EQ,MOD_LESS,ZERO_LT_dimword]) >> 1713 METIS_TAC[LENGTH, DECIDE ``n < SUC n``]) 1714 1715val mw_div_by_single_thm = store_thm ( "mw_div_by_single_thm", 1716``!xs y. 0 < w2n y ==> (mw2n (REVERSE xs) = mw2n (mw_mul_by_single y (REVERSE (FRONT (mw_div_by_single xs y)))) + w2n (LAST (mw_div_by_single xs y)))``, 1717 1718HO_MATCH_MP_TAC mw_div_by_single_ind >> 1719REPEAT strip_tac 1720THEN1 (srw_tac[][Once mw_div_by_single_def] >> srw_tac[][mw_div_by_single_def,mw_mul_by_single_def,mw_mul_pass_def,mw2n_def]) 1721THEN1 (srw_tac[][single_div_def,mw_mul_by_single_lemma,mw_div_by_single_def,mw2n_def] >> 1722 METIS_TAC[MULT_COMM,DIVISION,w2n_lt,LESS_MOD,MOD_LESS_EQ,DIV_LESS_EQ,LESS_EQ_LESS_TRANS]) >> 1723Cases_on `(w2n x1 < w2n y \/ (w2n y = 0))` >> 1724Q.PAT_ABBREV_TAC `rxs = REVERSE (x1::x2::xs)` >> 1725srw_tac[][Once mw_div_by_single_def] 1726THENL [ALL_TAC,full_simp_tac (srw_ss())[],ALL_TAC] 1727THEN1 (`(mw2n (REVERSE (r::xs)) = mw2n (mw_mul_by_single y (REVERSE (FRONT (mw_div_by_single (r::xs) y)))) + w2n (LAST (mw_div_by_single (r::xs) y)))` by METIS_TAC[] >> 1728 REPEAT (qpat_x_assum `!q r. xxx` (K ALL_TAC)) >> 1729 srw_tac[][Once mw_div_by_single_def] >> 1730 `w2n r < w2n y` by ( full_simp_tac (srw_ss())[single_div_def] >> 1731 qpat_x_assum `xxx=r` (fn x => REWRITE_TAC[GSYM x]) >> 1732 srw_tac[][w2n_n2w] >> 1733 METIS_TAC[LESS_EQ_LESS_TRANS,MOD_LESS_EQ,MOD_LESS,ZERO_LT_dimword]) >> 1734 `mw_div_by_single (r::xs) y <> []` by 1735 METIS_TAC[mw_div_by_single_LENGTH,NOT_NIL_EQ_LENGTH_NOT_0,DECIDE ``0 < SUC n``] >> 1736 srw_tac[][LAST_DEF,FRONT_DEF,mw2n_msf,mw_mul_by_single_lemma] >> 1737 `mw2n rxs = mw2n (REVERSE (r::xs)) + w2n q * w2n y * dimwords (LENGTH xs) (:'a)` by(markerLib.UNABBREV_TAC "rxs" >> 1738 qpat_x_assum `mw2n (REVERSE xx) = yy` (K ALL_TAC) >> 1739 lrw[mw2n_msf] >> 1740 REWRITE_TAC[dimwords_dimword] >> 1741 REWRITE_TAC[GSYM ADD1, EXP, 1742 DECIDE ``a1 * (d * l) + a2 * l = (a1 * d + a2)*l``, 1743 DECIDE ``b * l + d * e * l = (d * e + b)*l``] >> 1744 METIS_TAC[single_div_thm_bis]) >> 1745 ASM_SIMP_TAC std_ss [mw_mul_by_single_lemma] >> 1746 `LENGTH (FRONT (mw_div_by_single (r::xs) y)) = LENGTH xs` by 1747 METIS_TAC[mw_div_by_single_LENGTH,DECIDE ``0 < SUC n``,NOT_NIL_EQ_LENGTH_NOT_0,rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 1748 RW_TAC arith_ss[]) >> 1749`mw2n (REVERSE (r::x2::xs)) = mw2n (mw_mul_by_single y (REVERSE (FRONT (mw_div_by_single (r::x2::xs) y)))) + w2n (LAST (mw_div_by_single (r::x2::xs) y))` by METIS_TAC[] >> 1750REPEAT (qpat_x_assum `!q r. xxx` (K ALL_TAC)) >> 1751`mw2n rxs = mw2n (REVERSE (r::x2::xs)) + w2n q * w2n y * dimwords (SUC(LENGTH xs)) (:'a)` by (markerLib.UNABBREV_TAC "rxs" >> 1752 qpat_x_assum `mw2n (REVERSE xx) = yy` (K ALL_TAC) >> 1753 lrw[mw2n_msf,GSYM ADD1,EXP] >> 1754 `w2n x1 = w2n r + w2n q * w2n y` by (IMP_RES_TAC single_div_thm_bis >> ASSUME_TAC word_0_n2w >> 1755 FULL_SIMP_TAC arith_ss []) >> 1756RW_TAC arith_ss[]) >> 1757`(mw_div_by_single (x1::x2::xs) y) = q::mw_div_by_single (r::x2::xs) y` by srw_tac[][Once mw_div_by_single_def] >> 1758POP_ASSUM (fn x => REWRITE_TAC[x]) >> 1759`w2n r < w2n y` by ( full_simp_tac (srw_ss())[single_div_def] >> 1760 qpat_x_assum `xxx=r` (fn x => REWRITE_TAC[GSYM x]) >> 1761 srw_tac[][w2n_n2w] >> 1762 METIS_TAC[LESS_EQ_LESS_TRANS,MOD_LESS_EQ,MOD_LESS,ZERO_LT_dimword]) >> 1763`mw_div_by_single (r::x2::xs) y <> []` by 1764METIS_TAC[mw_div_by_single_LENGTH,NOT_NIL_EQ_LENGTH_NOT_0,DECIDE ``0 < SUC n``] >> 1765lrw[mw_mul_by_single_lemma,FRONT_DEF,LAST_DEF,mw2n_msf] >> 1766`LENGTH (FRONT (mw_div_by_single (r::x2::xs) y)) = SUC (LENGTH xs)` by 1767METIS_TAC[mw_div_by_single_LENGTH,DECIDE ``0 < SUC n``,LENGTH,NOT_NIL_EQ_LENGTH_NOT_0,rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 1768RW_TAC arith_ss[]) 1769 1770val mw_div_by_single_thm_bis = store_thm ("mw_div_by_single_thm_bis", 1771``!xs y. 0 < w2n y ==> 1772 (mw2n (REVERSE (FRONT (mw_div_by_single xs y))) = mw2n (REVERSE xs) DIV w2n y) /\ 1773 (w2n (LAST (mw_div_by_single xs y)) = mw2n (REVERSE xs) MOD w2n y)``, 1774 1775 qsuff_tac `! (xs:'a word list) (y:'a word). 0 < w2n y ==> 1776 w2n (LAST (mw_div_by_single xs y)) < w2n y` 1777 THEN1( REPEAT strip_tac >> 1778 IMP_RES_TAC mw_div_by_single_thm >> 1779 POP_ASSUM (fn x => ASSUME_TAC (Q.SPECL [`xs:'a word list`] x)) >> 1780 FULL_SIMP_TAC std_ss [mw_mul_by_single_lemma] >> 1781 ONCE_REWRITE_TAC[MULT_COMM] >> 1782 srw_tac[][MOD_TIMES,ADD_DIV_ADD_DIV] >> 1783 MATCH_MP_TAC ((fn (x,y) => y) (EQ_IMP_RULE (SPEC_ALL EQ_ADDL))) >> 1784 MATCH_MP_TAC LESS_DIV_EQ_ZERO >> METIS_TAC[]) >> 1785 1786 HO_MATCH_MP_TAC mw_div_by_single_ind >> 1787 REPEAT strip_tac 1788 THEN1 lrw[mw_div_by_single_def] 1789 THEN1( lrw[mw_div_by_single_def,single_div_def] >> 1790 METIS_TAC[MOD_LESS,LESS_EQ_LESS_TRANS,MOD_LESS_EQ,ZERO_LT_dimword]) >> 1791 srw_tac[][Once mw_div_by_single_def] 1792 THENL[Q.PAT_ABBREV_TAC `w = r::xs`,METIS_TAC[word_0_n2w,NOT_ZERO_LT_ZERO],Q.PAT_ABBREV_TAC `w = r::x2::xs`] >> 1793 `w2n r < w2n y` by 1794 ( FULL_SIMP_TAC std_ss [single_div_def] >> 1795 POP_ASSUM (fn x => REWRITE_TAC[GSYM x]) >> 1796 srw_tac[][] >> 1797 METIS_TAC[MOD_LESS,LESS_EQ_LESS_TRANS,MOD_LESS_EQ,ZERO_LT_dimword]) >> 1798 `mw_div_by_single w y <> []` by METIS_TAC[DECIDE ``0 < SUC x``,NOT_NIL_EQ_LENGTH_NOT_0,mw_div_by_single_LENGTH] >> 1799 markerLib.UNABBREV_TAC "w" >> 1800 srw_tac[][listTheory.LAST_CONS_cond,word_0_n2w] >> 1801 METIS_TAC[w2n_eq_0]) 1802 1803val mw_simple_div_lemma = prove( 1804 ``!xs x y qs (r:'a word) c. 1805 (mw_simple_div x xs y = (qs,r,c)) /\ 0w <+ y /\ x <+ y ==> 1806 (mw_div_by_single (x::xs) y = SNOC r qs) /\ c``, 1807 Induct THEN1 1808 (FULL_SIMP_TAC std_ss [mw_simple_div_def,mw_div_by_single_def,WORD_LO] 1809 \\ REPEAT STRIP_TAC 1810 \\ Cases_on `single_div 0x0w x y` \\ FULL_SIMP_TAC std_ss [SNOC,CONS_11] 1811 \\ IMP_RES_TAC single_div_thm_bis 1812 \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w] 1813 \\ Cases_on `w2n q` \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES] 1814 \\ Cases_on `r` \\ Cases_on `x` \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w] 1815 \\ DECIDE_TAC) 1816 \\ SIMP_TAC std_ss [Once mw_simple_div_def,Once mw_div_by_single_def,WORD_LO] 1817 \\ NTAC 5 STRIP_TAC 1818 \\ Cases_on `single_div x h y` \\ SIMP_TAC std_ss [LET_DEF] 1819 \\ `?qs r1 c1. mw_simple_div r' xs y = (qs,r1,c1)` by METIS_TAC [PAIR] 1820 \\ ASM_REWRITE_TAC [] \\ SIMP_TAC std_ss [] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 1821 \\ SIMP_TAC std_ss [SNOC,CONS_11] \\ STRIP_TAC \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 1822 \\ Q.PAT_X_ASSUM `!x.bb` MATCH_MP_TAC 1823 \\ FULL_SIMP_TAC std_ss [WORD_LO] 1824 \\ `y <> 0w` by (Cases_on `y` \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 1825 \\ `(w2n x * dimword (:'a) + w2n h) DIV w2n y < dimword (:'a)` by 1826 (FULL_SIMP_TAC (srw_ss()) [DIV_LT_X] 1827 \\ MATCH_MP_TAC LESS_LESS_EQ_TRANS 1828 \\ Q.EXISTS_TAC `SUC (w2n x) * dimword (:'a)` \\ STRIP_TAC THEN1 1829 (FULL_SIMP_TAC std_ss [MULT_CLAUSES] \\ Cases_on `h` 1830 \\ FULL_SIMP_TAC (srw_ss()) [DIV_LT_X]) 1831 \\ SIMP_TAC std_ss [Once MULT_COMM] 1832 \\ DECIDE_TAC) 1833 \\ IMP_RES_TAC single_div_thm \\ FULL_SIMP_TAC (srw_ss()) []); 1834 1835val mw2n_SNOC_0 = prove( 1836 ``!xs. mw2n (SNOC 0w xs) = mw2n xs``, 1837 Induct \\ FULL_SIMP_TAC (srw_ss()) [mw2n_def,SNOC]); 1838 1839val mw_simple_div_thm = store_thm("mw_simple_div_thm", 1840 ``!xs y qs (r:'a word) c. 1841 (mw_simple_div 0w xs y = (qs,r,c)) /\ 0w <+ y ==> 1842 (mw2n (REVERSE qs) = mw2n (REVERSE xs) DIV w2n y) /\ 1843 (w2n r = mw2n (REVERSE xs) MOD w2n y) /\ c``, 1844 REPEAT STRIP_TAC \\ IMP_RES_TAC mw_simple_div_lemma 1845 \\ FULL_SIMP_TAC (srw_ss()) [WORD_LO] 1846 \\ IMP_RES_TAC mw_div_by_single_thm_bis 1847 \\ REPEAT (Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `0w::xs`)) 1848 \\ FULL_SIMP_TAC (srw_ss()) [] 1849 \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,FRONT_SNOC,mw2n_SNOC_0]); 1850 1851 1852(* multiWord Division: x_{1}_x{2}...x_{m+n} / y_{1}...y_{n} *) 1853 1854(* Following the proof on p.271 *) 1855 1856val mw_div_range1 = store_thm("mw_div_range1", 1857 ``! (u1:'a word) u2 us (v1:'a word) vs. 1858 (LENGTH us = LENGTH vs) /\ 1859 0 < w2n v1 /\ 1860 mw2n (REVERSE (u1::u2::us)) DIV mw2n (REVERSE (v1::vs)) 1861 < dimword(:'a) ==> 1862 MIN ((w2n u1 * dimword(:'a) + w2n u2) DIV w2n v1) (dimword(:'a)-1) 1863 >= mw2n (REVERSE (u1::u2::us)) DIV mw2n (REVERSE (v1::vs))``, 1864 1865 REPEAT GEN_TAC >> 1866 Q.PAT_ABBREV_TAC`Q = (w2n u1 * dimword (:'a) + w2n u2) DIV w2n v1` >> 1867 Q.PAT_ABBREV_TAC`X = mw2n (REVERSE (u1::u2::us)) DIV mw2n (REVERSE (v1::vs))` >> 1868 REPEAT strip_tac >> 1869 Cases_on `Q < (dimword(:'a) - 1)` >> lrw[MIN_DEF] >> 1870 markerLib.UNABBREV_TAC"X">> 1871 `0 < mw2n (REVERSE (v1::vs))` by 1872 (full_simp_tac (srw_ss())[mw2n_msf] >> METIS_TAC[dimwords_dimword,ZERO_LT_dimword,ZERO_LT_EXP,LE_MULT_CANCEL_LBARE,LESS_LESS_EQ_TRANS,ADD_COMM,LESS_EQ_ADD,LESS_EQ_TRANS]) >> 1873 MATCH_MP_TAC DIV_thm5 >> strip_tac THEN1 DECIDE_TAC >> 1874 markerLib.UNABBREV_TAC "Q" >> 1875 Q.PAT_ABBREV_TAC`a=(w2n u1) * dimword(:'a) + w2n u2`>> 1876 lrw[mw2n_msf,dimwords_dimword] >> 1877 Q.PAT_ABBREV_TAC`V1= w2n v1` >> 1878 Q.PAT_ABBREV_TAC`U1 = w2n u1` >> 1879 Q.PAT_ABBREV_TAC`U2 = w2n u2` >> 1880 full_simp_tac (srw_ss())[] >> 1881 `a + 1 <= V1 + a DIV V1 * V1` 1882 by METIS_TAC[DIV_thm4,LESS_MONO_ADD,DIV_thm3,SUB_ADD,LESS_EQ,ADD1] >> 1883 Q.PAT_ABBREV_TAC`q=a DIV V1` >> 1884 REWRITE_TAC[GSYM ADD1,EXP] >> 1885 Q.PAT_ABBREV_TAC`offset= dimword(:'a) ** (LENGTH t)` >> 1886 MATCH_MP_TAC (METIS_PROVE [ADD_COMM,LESS_EQ_ADD,LESS_LESS_EQ_TRANS] ``(a < b) ==> (a < c + b)``) >> 1887 REWRITE_TAC[RIGHT_ADD_DISTRIB] >> 1888 ONCE_REWRITE_TAC[METIS_PROVE [ADD_ASSOC,ADD_COMM] ``a + (b + c) = b + (a + c)``] >> 1889 MATCH_MP_TAC (METIS_PROVE [ADD_COMM,LESS_EQ_ADD,LESS_LESS_EQ_TRANS] ``(a < b) ==> (a < c + b)``) >> 1890 RW_TAC arith_ss [] >> 1891 ONCE_REWRITE_TAC[DECIDE ``a*b*c = a*c*b``] >> REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] >> 1892 `offset * (a + 1) <= offset * (V1 + q * V1)` by METIS_TAC[LESS_MONO_MULT,MULT_COMM] >> 1893 MATCH_MP_TAC LESS_LESS_EQ_TRANS >> 1894 EXISTS_TAC ``offset * (a + 1)`` >> lrw[] >> 1895 `U2 + U1 * dimword(:'a) = a` by METIS_TAC[Abbr`a`,ADD_COMM] >> 1896 ASM_REWRITE_TAC[] >> REWRITE_TAC[LEFT_ADD_DISTRIB] >> RW_TAC arith_ss[] >> 1897 METIS_TAC[LENGTH_REVERSE,mw2n_lt,Abbr `offset`,dimwords_dimword]); 1898 1899(* Proof on p.271-272 *) 1900 1901val mw_div_range2 = store_thm( "mw_div_range2", 1902 ``! (u1:'a word) u2 us (v1:'a word) vs. 1903 (LENGTH us = LENGTH vs) /\ 1904 mw2n (REVERSE (u1::u2::us)) DIV mw2n (REVERSE (v1::vs)) 1905 < dimword(:'a) /\ 1906 dimword(:'a) DIV 2 <= w2n v1 ==> 1907 MIN ((w2n u1 * dimword(:'a) + w2n u2) DIV w2n v1) (dimword(:'a)-1) 1908 <= mw2n (REVERSE (u1::u2::us)) DIV mw2n (REVERSE (v1::vs)) + 2``, 1909 1910 REPEAT GEN_TAC >> 1911 Q.PAT_ABBREV_TAC`V = mw2n (REVERSE (v1::vs))` >> 1912 Q.PAT_ABBREV_TAC`U = mw2n (REVERSE (u1::u2::us))`>> 1913 Q.PAT_ABBREV_TAC`q = U DIV V` >> 1914 Q.PAT_ABBREV_TAC`q' = MIN ((w2n u1 * dimword(:'a) + w2n u2) DIV w2n v1) (dimword(:'a) - 1)` >> 1915 Cases_on `V <= U` 1916 THEN1( (MATCH_MP_TAC o (fn (x,y) => y)) (EQ_IMP_RULE MONO_NOT_EQ) >> 1917 strip_tac >> 1918 qpat_x_assum `~x` (ASSUME_TAC o (fn x => (MP ((fn (x,y)=>x) (EQ_IMP_RULE (Q.SPECL [`q'`,`q+2`] NOT_LESS_EQUAL))) x))) >> 1919 Cases_on `LENGTH us = LENGTH vs` 1920 THEN1( Cases_on `q < dimword(:'a)` 1921 THEN1( srw_tac[][] >> REWRITE_TAC [NOT_LESS_EQUAL] >> 1922 `3 <= q' - q` by METIS_TAC[SUB_LEFT_LESS,ADD_COMM,LESS_EQ,DECIDE ``3 = SUC 2``] >> 1923 Q.PAT_ABBREV_TAC`b = dimword(:'a)` >> REWRITE_TAC[HD] >> 1924 Cases_on `0 < w2n v1` 1925 THEN1( Q.PAT_ABBREV_TAC`a = w2n v1` >> 1926 `0 < b ** LENGTH vs` by METIS_TAC[Abbr`b`,ZERO_LT_dimword,ZERO_LT_EXP] >> 1927 `0 < V` by (lrw[Abbr`V`,Abbr`a`,mw2n_msf,dimwords_dimword] >> METIS_TAC[ADD_COMM,MULT_COMM,LESS_EQ_ADD,LE_MULT_CANCEL_LBARE,LESS_EQ_TRANS,LESS_LESS_EQ_TRANS]) >> 1928 `b ** (LENGTH vs ) <= V` by (lrw[Abbr`V`,mw2n_msf,LENGTH_REVERSE,dimwords_dimword] >> METIS_TAC[LE_MULT_CANCEL_LBARE,LESS_EQ_ADD,ADD_COMM,LESS_EQ_TRANS]) >> 1929 Cases_on `V = b ** (LENGTH vs)` 1930 THEN1( `V = mw2n ((REVERSE vs)++[v1])` by full_simp_tac (srw_ss())[] >> 1931 qpat_x_assum `V = mw2n xxx` (fn x => (ASSUME_TAC (RW[mw2n_msf,LENGTH_REVERSE,dimwords_dimword] x))) >> 1932 `b ** LENGTH vs * w2n v1 <= V` by METIS_TAC[ADD_COMM,LESS_EQ_ADD] >> 1933 `0 < b ** LENGTH vs` by METIS_TAC[ZERO_LT_EXP,Abbr`b`,ZERO_LT_dimword] >> 1934 `a <= 1` by METIS_TAC[Abbr`a`,LE_MULT_CANCEL_RBARE,NOT_ZERO_LT_ZERO] >> 1935 `a = 1` by DECIDE_TAC >> 1936 `U = mw2n (REVERSE us) + V*(w2n u2) + V*b*(w2n u1)` by full_simp_tac (srw_ss())[MULT_COMM,Abbr`b`,Abbr`U`,LENGTH_REVERSE,mw2n_msf,dimwords_dimword,GSYM ADD1,EXP] >> 1937 qpat_x_assum `U = xxx` (fn x => ASSUME_TAC(RW[GSYM MULT_ASSOC,GSYM ADD_ASSOC,GSYM LEFT_ADD_DISTRIB] x)) >> 1938 `mw2n (REVERSE us) < V` by METIS_TAC[mw2n_lt,dimwords_dimword,Abbr`b`,LENGTH_REVERSE] >> 1939 `q = w2n u1 * b + w2n u2` by METIS_TAC[RIGHT_ADD_DISTRIB,DIV_MULT,ADD_COMM,MULT_COMM] >> 1940 `q' = MIN (b-1) q` by full_simp_tac (srw_ss())[MIN_COMM] >> 1941 `~(b - 1 < q)` by DECIDE_TAC >> 1942 `q' = q` by full_simp_tac (srw_ss())[MIN_DEF] >> 1943 RW_TAC arith_ss [] ) >> 1944 `b ** (LENGTH vs) < V` by DECIDE_TAC >> 1945 qpat_x_assum `xxx <> yyy` (fn x => ALL_TAC) >> 1946 `2 * V * (V - b ** (LENGTH vs)) <= U * b ** (LENGTH vs)` by( Q.PAT_ABBREV_TAC`l = b ** LENGTH vs` >> 1947 `l < V` by METIS_TAC[LE_MULT_CANCEL_LBARE,LESS_EQ_LESS_TRANS] >> 1948 Q.PAT_ABBREV_TAC`X= V - l` >> `0 < X` by METIS_TAC[SUB_LESS_0] >> 1949 `0 < l` by METIS_TAC[ZERO_LT_dimword,ZERO_LT_EXP] >> 1950 `0 < q*V` by METIS_TAC[DIV_GT0,ZERO_LESS_MULT] >> 1951 `U - V < q * V + V - V` by METIS_TAC[DIV_thm4,DIV_thm3,LESS_MONO_ADD,SUB_ADD,ADD_COMM,LT_SUB_RCANCEL,ADD_0] >> 1952 qpat_x_assum `U - V < xxx` (fn x => `U-V < q*V` by METIS_TAC[x,ADD_SUB]) >> 1953 `q' <= (w2n u1 * b + w2n u2) DIV a` by lrw[Abbr`a`,Abbr`q'`] >> 1954 `q' * (a * l) <= (w2n u1 * b + w2n u2) * l` by METIS_TAC[MULT_ASSOC,Abbr`a`,DIV_thm3,LESS_EQ_TRANS,LESS_MONO_MULT,Abbr`q'`] >> 1955 `U = (w2n u1 * b + w2n u2) * l + mw2n (REVERSE us)` by lrw[Abbr`U`,Abbr`b`,Abbr`l`,mw2n_msf,dimwords_dimword,EXP,GSYM ADD1] >> 1956 `q' * (a * l) <= U` by METIS_TAC[Abbr`a`,LESS_EQ_ADD,LESS_EQ_TRANS,Abbr`q'`] >> 1957 Cases_on `U = 0` THEN1 full_simp_tac (srw_ss())[] >> 1958 `q' * X < U` by( Cases_on `0 < q'` 1959 THEN1( `V = a * l + mw2n(REVERSE vs)` by lrw[Abbr`V`,Abbr`l`,Abbr`a`,mw2n_msf,dimwords_dimword] >> 1960 `V < a * l + l` by (full_simp_tac (srw_ss())[Abbr`l`,Abbr`b`,Abbr`a`] >> METIS_TAC[mw2n_lt,LENGTH_REVERSE,dimwords_dimword]) >> 1961 `0 < a * l` by METIS_TAC[ZERO_LT_EXP,ZERO_LT_dimword, Abbr`a`,ZERO_LESS_MULT] >> 1962 `X < a * l` by full_simp_tac (srw_ss())[Abbr`X`,ADD_SUB,LT_SUB_RCANCEL,LT_ADDL,ADD_COMM] >> 1963 METIS_TAC[LT_MULT_RCANCEL,MULT_COMM,LESS_LESS_EQ_TRANS]) >> 1964 DECIDE_TAC) >> 1965 qpat_x_assum `q' <= xxx` (fn x => ALL_TAC)>> 1966 REPEAT (qpat_x_assum `q' * (a * l) <= xxx` (fn x => ALL_TAC)) >> 1967 `3 * (X * V) <= q' * (X * V) - q * (X * V) /\ 1968 (q' * (X * V) < U * V) /\ 1969 ((U - V) * X < q * (V * X))` 1970 by METIS_TAC[LESS_MONO_MULT,RIGHT_SUB_DISTRIB,LT_MULT_RCANCEL,MULT_ASSOC] >> 1971 `3 * (X * V) <= U * V - (U-V)*X` by DECIDE_TAC >> 1972 markerLib.UNABBREV_TAC "X" >> 1973 `3 * ((V-l)*V) <= U*V - ((U-V)*V - (U-V)*l)` by METIS_TAC[LEFT_SUB_DISTRIB] >> 1974 `(U-V)*l <= (U-V)*V` by METIS_TAC[LESS_IMP_LESS_OR_EQ,LE_MULT_LCANCEL] >> 1975 `3 * ((V-l)*V) <= U*V + (U-V)*l - (U-V)*V` by METIS_TAC[SUB_SUB] >> 1976 `3 * ((V-l)*V) <= U*V + (U*l - V*l) - (U*V - V*V)` by METIS_TAC[RIGHT_SUB_DISTRIB]>> 1977 `3 * ((V-l)*V) <= U*V + (U*l - V*l) + V*V - U*V`by METIS_TAC[LE_MULT_RCANCEL,SUB_SUB] >> 1978 `3 * ((V-l)*V) <= U*l - V*l + V*V` by METIS_TAC[ADD_ASSOC,PROVE [ADD_COMM,ADD_ASSOC,ADD_SUB] ``a+b-a=b``]>> 1979 `V*l <= U*l` by METIS_TAC[LESS_MONO_MULT] >> 1980 `3*((V-l)*V) <= (V*V + U*l) - V*l` by METIS_TAC[ADD_COMM,LESS_MONO_MULT,LESS_EQ_ADD_SUB] >> 1981 `3*((V-l)*V) <= U*l + V*(V-l)` by METIS_TAC[ADD_COMM,LEFT_SUB_DISTRIB,LESS_EQ_ADD_SUB,SUB_LESS_0,LESS_IMP_LESS_OR_EQ,LE_MULT_LCANCEL] >> 1982 qpat_x_assum `xxx <= yyy + V*(V-l)` (fn x => 1983 ASSUME_TAC (RW[DECIDE ``3 = 2 + 1``,RIGHT_ADD_DISTRIB,MULT_LEFT_1] x)) >> 1984 `(V-l)*V <= V*V` by METIS_TAC[SUB_LESS_EQ,LESS_MONO_MULT] >> 1985 REPEAT (qpat_x_assum `3*xxx <= yyy` (fn x => ALL_TAC)) >> 1986 METIS_TAC[MULT_COMM,MULT_ASSOC,LESS_EQ_MONO_ADD_EQ]) >> 1987 `V = (a-1+1) * b ** LENGTH vs + mw2n(REVERSE vs)` by lrw[Abbr`V`,Abbr`a`,mw2n_msf,dimwords_dimword] >> 1988 qpat_x_assum `V = xxx` (fn x => (ASSUME_TAC (RW[RIGHT_ADD_DISTRIB,MULT_LEFT_1,Once (DECIDE ``a + b + c = a + c + b``)] x))) >> 1989 `(a - 1) * b ** (LENGTH vs) <= V - b ** (LENGTH vs)` by METIS_TAC[ADD_SUB,LESS_EQ_ADD] >> 1990 `2 * V * ((a-1) * b ** LENGTH vs) <= 2 * V * (V - b ** LENGTH vs)` by full_simp_tac (srw_ss())[] >> 1991 `2 * V * ((a-1) * b ** LENGTH vs) <= U * b ** LENGTH vs` by METIS_TAC[LESS_EQ_TRANS] >> 1992 qpat_x_assum `xxx <= U * b ** LENGTH vs` (fn x => ASSUME_TAC (RW[MULT_ASSOC] x)) >> 1993 `b ** LENGTH vs <> 0` by METIS_TAC[ZERO_LT_EXP,Abbr`b`,ZERO_LT_dimword,NOT_ZERO_LT_ZERO] >> 1994 `2 * V * (a-1) <= U` by METIS_TAC[LE_MULT_RCANCEL] >> 1995 qpat_x_assum `2 * V * xxx <= U` (fn x => (ASSUME_TAC (RW[Once (DECIDE ``a * b * c = a * c * b``)] x))) >> 1996 `2 * (a-1) <= q` by METIS_TAC[Abbr`q`,DIV_LE_MONOTONE,MULT_DIV] >> 1997 `q + 3 <= q'` by METIS_TAC [LESS_EQ, EVAL ``SUC 2``,ADD,ADD_COMM] >> 1998 `q <= (q' - 3)` by METIS_TAC[LE_SUB_RCANCEL,ADD_SUB,ADD_COMM,LESS_EQ_ADD] >> 1999 qpat_x_assum ` q + 3 <= q'` (fn x => ALL_TAC) >> 2000 `!xx yy.MIN xx yy <= yy` by srw_tac[][] >> 2001 `q' <= b - 1` by METIS_TAC[] >> qpat_x_assum `!xx yy. zzz` (fn x => ALL_TAC) >> 2002 `2 <= b - 2` by METIS_TAC[SUB_LESS_EQ,LESS_EQ_TRANS,LE_SUB_RCANCEL,DECIDE ``(3-1 = 2)/\(b - 1 - 1 = b - 2)``] >> 2003 `2 <= 2 * a` by METIS_TAC[LE_MULT_CANCEL_LBARE,Abbr`a`] >> 2004 `q' - 3 <= b - 4` by METIS_TAC[LE_SUB_RCANCEL,SUB_LESS_EQ,LESS_EQ_TRANS,DECIDE ``x - 1 - 3 = x - 4``] >> 2005 `2 * a <= b - 2` by RW_TAC arith_ss [] >> 2006 qpat_x_assum `2*a <= xxx` (fn x => `a <= (b - 2) DIV 2` by METIS_TAC [DIV_LE_MONOTONE, DECIDE ``0<2``, MULT_COMM,MULT_DIV,x]) >> 2007 `2 <= b` by METIS_TAC[SUB_LESS_EQ, LESS_EQ_TRANS] >> 2008 `a <= (b DIV 2 - 1)` by METIS_TAC[DECIDE ``0<2``,MULT_RIGHT_1,DIV_SUB] >> 2009 RW_TAC arith_ss [Abbr`b`,ZERO_LT_dimword] ) >> 2010 `w2n v1 = 0` by DECIDE_TAC >> 2011 METIS_TAC[DIV_GT0,DECIDE ``0<2``,ONE_LT_dimword,Abbr`b`,LESS_EQ,TWO]) >> 2012 DECIDE_TAC)>> 2013 DECIDE_TAC)>> 2014 strip_tac >> 2015 qpat_x_assum `~x` (fn x => ASSUME_TAC(MP ((fn (x,y) => x)(EQ_IMP_RULE (Q.SPECL [`V`,`U`] NOT_LESS_EQUAL))) x)) >> 2016 `LENGTH ((REVERSE us) ++ [u2]) = SUC(LENGTH us)` by lrw[] >> 2017 `U = mw2n (REVERSE us) + dimword(:'a) ** LENGTH us * w2n u2 + dimword(:'a) ** (LENGTH(REVERSE us ++ [u2])) * w2n u1` by full_simp_tac (srw_ss())[Abbr`U`,LENGTH_REVERSE,GSYM ADD1,mw2n_msf,dimwords_dimword] >> 2018 `U = mw2n (REVERSE us) + dimword(:'a) ** LENGTH us * w2n u2 + dimword(:'a) ** (LENGTH us) * dimword(:'a) * w2n u1` by full_simp_tac (srw_ss())[EXP,MULT_COMM] >> 2019 qpat_x_assum `U = xxx` (fn x => ASSUME_TAC(RW[GSYM MULT_ASSOC,GSYM ADD_ASSOC,GSYM LEFT_ADD_DISTRIB] x)) >> 2020 `V = mw2n (REVERSE vs) + dimword(:'a) ** LENGTH vs * w2n v1` by full_simp_tac (srw_ss())[mw2n_msf,dimwords_dimword] >> 2021 `V < dimword(:'a) ** LENGTH vs * SUC (w2n v1)` by METIS_TAC[mw2n_lt,LENGTH_REVERSE,LESS_MONO_ADD,MULT,ADD_COMM,MULT_COMM,dimwords_dimword] >> 2022 `U < dimword(:'a) ** SUC(LENGTH us)` by METIS_TAC[mw2n_lt,LESS_TRANS,LENGTH_REVERSE,LENGTH,dimwords_dimword]>> 2023 `w2n u2 + dimword(:'a) * w2n u1 <= w2n v1` by METIS_TAC[ADD_COMM,LESS_EQ_ADD,LESS_EQ_LESS_TRANS,LESS_TRANS,LT_MULT_LCANCEL,DECIDE ``a < SUC b ==> (a <= b)``] >> 2024 `MIN a b <= a` by lrw[] >> 2025 `q' <= (w2n u2 + dimword(:'a)*w2n u1) DIV w2n v1` by full_simp_tac (srw_ss())[ADD_COMM,MULT_COMM,Abbr`q'`]>> 2026 `0 < w2n v1` by METIS_TAC[DIV_GT0,DECIDE ``0<2``,ONE_LT_dimword,LESS_EQ,TWO,ONE,LESS_EQ_TRANS] >> 2027 `(w2n u2 + dimword(:'a)*w2n u1) DIV w2n v1 <= 1` by (Cases_on `w2n u2 + dimword(:'a)*w2n u1 = w2n v1` THEN1 (RW_TAC arith_ss[]) >> 2028 `(w2n u2 + dimword(:'a) * w2n u1) < w2n v1` by RW_TAC arith_ss[] >> METIS_TAC[LESS_DIV_EQ_ZERO, DECIDE ``0<=1``]) >> 2029 lrw[]); 2030 2031val mw_div_test_lemma1 = store_thm( "mw_div_test_lemma1", 2032``!q u1 u2 u3 v1 v2. w2n (mw_div_test q u1 u2 u3 v1 v2) <= w2n q``, 2033 HO_MATCH_MP_TAC mw_div_test_ind >> REPEAT strip_tac >> 2034 srw_tac[][Once mw_div_test_def] >> 2035 `w2n q2 <= w2n q` by 2036 METIS_TAC[Abbr`q2`,w2n_n2w,ZERO_LT_dimword,MOD_LESS_EQ,LESS_EQ_TRANS,DECIDE ``x - 1 <=x``] >> 2037 Cases_on `mw_cmp [u2; u1] (FST (mw_add [FST s; SND s] [0w; 1w] F)) = SOME T` 2038 >> full_simp_tac (srw_ss())[] >> METIS_TAC[LESS_EQ_TRANS]) 2039 2040val mw_div_test_lemma2 = store_thm( "mw_div_test_lemma2", 2041``!(us:'a word list) (vs:'a word list). 2042 !q u1 u2 u3 v1 v2. 2043 (0 < w2n v1) /\ (LENGTH us = LENGTH vs) /\ 2044 (mw2n (REVERSE (u1::u2::u3::us)) DIV mw2n (REVERSE (v1::v2::vs)) < dimword(:'a)) /\ 2045 (mw2n (REVERSE (u1::u2::u3::us)) DIV mw2n (REVERSE (v1::v2::vs)) <= w2n q) ==> 2046 (mw2n (REVERSE (u1::u2::u3::us)) DIV mw2n (REVERSE (v1::v2::vs)) 2047 <= w2n (mw_div_test q u1 u2 u3 v1 v2))``, 2048 2049 GEN_TAC >> GEN_TAC >> 2050 HO_MATCH_MP_TAC mw_div_test_ind >> 2051 REPEAT strip_tac >> 2052 Cases_on `(mw_cmp [u3; u2; u1] (mw_mul_by_single q [v2; v1]) = SOME T)` 2053 THEN1( Q.PAT_ABBREV_TAC `u = u1::u2::u3::us` >> 2054 Q.PAT_ABBREV_TAC` v = v1::v2::vs` >> 2055 srw_tac[][Once mw_div_test_def] >> 2056 qsuff_tac `mw2n (REVERSE (u:'a word list)) DIV mw2n (REVERSE (v:'a word list)) <= w2n (n2w (w2n (q:'a word) - 1):'a word)` 2057 THEN1( strip_tac >> 2058 Cases_on `mw_cmp [u2; u1] (FST (mw_add [FST s; SND s] [0w; 1w] F)) = SOME T` >> 2059 METIS_TAC[Abbr`q2`]) >> 2060 qpat_x_assum `!q'. xxx` (K ALL_TAC) >> 2061 qsuff_tac `w2n u1 * dimword (:'a) * dimword (:'a) + w2n u2 * dimword (:'a) + w2n u3 < w2n q * (w2n v1 * dimword (:'a) + w2n v2)` 2062 THEN1( strip_tac >> 2063 Cases_on `mw2n (REVERSE u) DIV mw2n (REVERSE v) = 0` THEN1 DECIDE_TAC >> 2064 `0 < w2n q` by DECIDE_TAC >> 2065 `w2n (n2w (w2n (q:'a word) - 1):'a word) = w2n q - 1` by METIS_TAC[w2n_n2w,LESS_MOD,DECIDE ``x - 1 <= x``,LESS_EQ_LESS_TRANS,w2n_lt] >> 2066 POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2067 markerLib.UNABBREV_TAC "v" >> 2068 srw_tac[][mw2n_msf,EXP, GSYM ADD1,dimwords_dimword] >> 2069 `0 < w2n v1 * dimword(:'a) + w2n v2` 2070 by METIS_TAC[ZERO_LT_dimword,LE_MULT_CANCEL_LBARE,LESS_EQ_ADD,LESS_EQ_TRANS,LESS_LESS_EQ_TRANS] >> 2071 `0 < dimword(:'a) ** (LENGTH vs)` by METIS_TAC[ZERO_LT_dimword,ZERO_LT_EXP] >> 2072 Q.PAT_ABBREV_TAC `U = mw2n (REVERSE u)` >> 2073 qsuff_tac `U DIV ((w2n v1 * dimword(:'a) + w2n v2) * dimword(:'a)**(LENGTH vs)) <= w2n q - 1` 2074 THEN1( Q.PAT_ABBREV_TAC`X = (w2n v1 * dimword(:'a) + w2n v2) * dimword(:'a) ** (LENGTH vs)` >> 2075 Q.PAT_ABBREV_TAC`V = mw2n (REVERSE vs) + dimword (:'a) ** LENGTH vs * w2n v2 + dimword (:'a) * dimword (:'a) ** LENGTH vs * w2n v1` >> 2076 strip_tac >> 2077 `0 < X` by METIS_TAC[Abbr `X`,ZERO_LESS_MULT]>> 2078 `X <= V` by METIS_TAC[LESS_EQ_ADD,LESS_EQ_TRANS,DECIDE ``vs + l*v2 + b*l*v1 = (v1*b + v2)*l + vs``] >> 2079 METIS_TAC[DIV_thm1,LESS_EQ_TRANS]) >> 2080 Q.PAT_ABBREV_TAC`X1 = w2n v1 * dimword(:'a) + w2n v2` >> 2081 Q.PAT_ABBREV_TAC`X2 = dimword(:'a) ** LENGTH vs` >> 2082 `U DIV (X1 * X2) = U DIV X2 DIV X1` by METIS_TAC[MULT_COMM,DIV_DIV_DIV_MULT] >> 2083 qpat_x_assum `U DIV xxx = yyy` (fn x => REWRITE_TAC[x]) >> 2084 srw_tac[][Abbr`U`,Abbr`u`,mw2n_msf,dimwords_dimword,EXP, GSYM ADD1] >> 2085 REWRITE_TAC[DECIDE ``u + x2 * u3 + b * x2 * u2 + b * (b * x2) * u1 = (u3 + u2*b + u1*b*b)*x2 + u``] >> 2086 Q.PAT_ABBREV_TAC`A = (w2n u3 + w2n u2 * dimword (:'a) + w2n u1 * dimword (:'a) * dimword (:'a))` >> 2087 Q.PAT_ABBREV_TAC`B = mw2n (REVERSE us)` >> 2088 `(A * X2 + B) DIV X2 = A` by METIS_TAC[DIV_MULT,Abbr`X2`,Abbr`B`,mw2n_lt,dimwords_dimword,LENGTH_REVERSE] >> 2089 qpat_x_assum `xx DIV X2 = A` (fn x => REWRITE_TAC[x]) >> 2090 `A < w2n q * X1` by METIS_TAC[ADD_COMM,ADD_ASSOC] >> 2091 `A DIV X1 < w2n q` by METIS_TAC[DIV_thm2] >> 2092 Cases_on `w2n q` THEN1 full_simp_tac (srw_ss())[] >> 2093 METIS_TAC[SUC_SUB1,LESS_EQ,LESS_EQ_MONO]) >> 2094 REWRITE_TAC[DECIDE ``a1 * d * d + a2 * d + a3 = a3 + d * (a2 + ( d * a1))``, 2095 DECIDE ``w * (b1 * d + b2) = w *( b2 + d * b1)``] >> 2096 `(w2n u1 = mw2n [u1]) /\ (w2n v1 = mw2n [v1])` by lrw[mw2n_def] >> 2097 POP_ASSUM (fn x => REWRITE_TAC[x]) >> POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2098 REWRITE_TAC[SPEC_ALL (GSYM (CONJUNCT2 mw2n_def)),GSYM (CONJUNCT1 (SPEC_ALL mw_mul_by_single_lemma))] >> 2099 `LENGTH [u3;u2;u1] = LENGTH (mw_mul_by_single q [v2;v1])` by lrw[mw_mul_by_single_lemma] >> 2100 FULL_SIMP_TAC std_ss [mw_cmp_thm]) >> 2101full_simp_tac (srw_ss())[Once mw_div_test_def] ) 2102 2103val q_thm = store_thm( "q_thm", 2104``!(u1:'a word) u2 us (v1:'a word) vs. 2105 (LENGTH us = LENGTH vs) /\ (0 < w2n v1) /\ 2106 (mw2n (REVERSE (u1::u2::us)) DIV mw2n (REVERSE (v1::vs)) < dimword(:'a)) ==> 2107 w2n u1 * dimword(:'a) + w2n u2 < dimword(:'a) * (1 + w2n v1)``, 2108 2109 REPEAT GEN_TAC >> 2110 Q.PAT_ABBREV_TAC`U = mw2n (REVERSE (u1::u2::us))` >> 2111 Q.PAT_ABBREV_TAC`V = mw2n (REVERSE (v1::vs))` >> 2112 strip_tac >> 2113 EQT_M_R_S_i `dimword(:'a) ** LENGTH (us:'a word list)` >> 2114 `0 < V` by (full_simp_tac (srw_ss())[Abbr`V`,mw2n_msf,dimwords_dimword,Once ADD_COMM,Once MULT_COMM] 2115 >> METIS_TAC[ZERO_LT_dimword,ZERO_LT_EXP,LESS_EQ_ADD, LE_MULT_CANCEL_LBARE, 2116 LESS_LESS_EQ_TRANS]) >> 2117 `U < dimword(:'a) * V` by METIS_TAC[DIV_LT_X] >> 2118 MATCH_MP_TAC LESS_EQ_LESS_TRANS >> EXISTS_TAC ``(U:num)`` >> strip_tac THEN1( 2119 lrw[Abbr`U`,mw2n_msf,dimwords_dimword] >> 2120 REWRITE_TAC[ DECIDE ``(w2 + d * w1) * d ** l = w1 * (d * d ** l) + w2 * d ** l``,GSYM EXP, ADD1] >> 2121 METIS_TAC[LESS_EQ_TRANS,LESS_EQ_ADD,ADD_COMM]) >> 2122 MATCH_MP_TAC LESS_LESS_EQ_TRANS >> EXISTS_TAC ``dimword(:'a) * V`` >> strip_tac THEN1 DECIDE_TAC >> 2123 ASM_REWRITE_TAC[] >> 2124 qsuff_tac `V <= (1 + w2n v1) * dimword(:'a) ** LENGTH vs` THEN1 ( 2125 strip_tac >> METIS_TAC[MULT_COMM,LESS_MONO_MULT,MULT_ASSOC] ) >> 2126 lrw[Abbr`V`,mw2n_msf,dimwords_dimword] >> REWRITE_TAC[RIGHT_ADD_DISTRIB,MULT_LEFT_1] >> 2127 METIS_TAC[LENGTH_REVERSE,ADD_COMM,LESS_EQ_MONO_ADD_EQ,mw2n_lt,dimwords_dimword,LESS_IMP_LESS_OR_EQ] ); 2128 2129val mw_div_test_thm = store_thm( "mw_div_test_thm", 2130``!(u1:'a word) u2 u3 us (v1:'a word) v2 vs. 2131 (LENGTH us = LENGTH vs) /\ (dimword(:'a) DIV 2 <= w2n v1) /\ 2132 (mw2n (REVERSE (u1::u2::u3::us)) DIV (mw2n (REVERSE (v1::v2::vs))) < dimword(:'a)) ==> 2133 (let q = if w2n u1 < w2n v1 then FST (single_div u1 u2 v1) else (n2w (dimword(:'a) - 1):'a word) in 2134 w2n (mw_div_test q u1 u2 u3 v1 v2) < dimword(:'a) /\ ( 2135 (w2n (mw_div_test q u1 u2 u3 v1 v2) = 2136 mw2n (REVERSE (u1::u2::u3::us)) DIV mw2n (REVERSE (v1::v2::vs))) \/ 2137 (w2n (mw_div_test q u1 u2 u3 v1 v2) = 2138 SUC (mw2n (REVERSE (u1::u2::u3::us)) DIV mw2n (REVERSE (v1::v2::vs))))))``, 2139 REPEAT GEN_TAC >> 2140 Q.PAT_ABBREV_TAC`U = mw2n (REVERSE (u1::u2::u3::us))` >> 2141 Q.PAT_ABBREV_TAC`V = mw2n (REVERSE (v1::v2::vs))` >> 2142 Q.PAT_ABBREV_TAC`Q = U DIV V` >> 2143 strip_tac >> 2144 Q.PAT_ABBREV_TAC `q = if w2n u1 < w2n v1 then FST (single_div u1 u2 v1) else n2w (dimword (:'a) - 1)` >> 2145 srw_tac[][] THEN1 METIS_TAC[w2n_lt] >> 2146 `LENGTH (u3::us) = LENGTH (v2::vs)` by lrw[] >> 2147 `0 < w2n v1` by METIS_TAC[ONE_LT_dimword,DECIDE ``0<2 /\ ((1<x)==>(2 <= x))``,DIV_GT0,LESS_LESS_EQ_TRANS] >> 2148 `0 < V` by (full_simp_tac (srw_ss())[Abbr`V`,mw2n_msf,dimwords_dimword,Once ADD_COMM,Once MULT_COMM] 2149 >> METIS_TAC[ZERO_LT_dimword,ZERO_LT_EXP,LESS_EQ_ADD, LE_MULT_CANCEL_LBARE, 2150 LESS_LESS_EQ_TRANS]) >> 2151 `w2n q = MIN ((w2n u1 * dimword (:'a) + w2n u2) DIV w2n v1) (dimword (:'a) - 1)` by( markerLib.UNABBREV_TAC "q" >> 2152 srw_tac[][single_div_def] 2153 THEN1( IMP_RES_TAC single_div_lemma1 >> 2154 POP_ASSUM (fn x => ASSUME_TAC (Q.SPECL [`u2:'a word`] x)) >> 2155 FULL_SIMP_TAC arith_ss[] >> 2156 `!a b. (a <= b) ==> (a = MIN a b)` by lrw[MIN_DEF] >> 2157 METIS_TAC[SUB_LESS_OR]) >> 2158 `!a b. (a <= b) ==> (a = MIN b a)` by lrw[MIN_DEF,MIN_COMM] >> 2159 POP_ASSUM(fn x => MATCH_MP_TAC x) >> 2160 `!a b. a * w2n v1 <= b ==> (a <= b DIV w2n v1)` by METIS_TAC[X_LE_DIV] >> 2161 POP_ASSUM(fn x => MATCH_MP_TAC x) >> 2162 REWRITE_TAC[RIGHT_SUB_DISTRIB] >> 2163 METIS_TAC[NOT_LESS,MULT_COMM,LESS_MONO_MULT,SUB_LESS_EQ,LESS_EQ_ADD,LESS_EQ_TRANS]) >> 2164 markerLib.RM_ABBREV_TAC "q" >> 2165 `dimword(:'a) - 1 < dimword(:'a)` by (Cases_on `dimword(:'a)` >> full_simp_tac (srw_ss())[ZERO_LT_dimword]) >> 2166 `w2n q <= dimword(:'a)-1` by METIS_TAC[w2n_lt,SUB_LESS_OR] >> 2167 `w2n q>=Q` by METIS_TAC[Abbr`Q`,mw_div_range1,Abbr `U`, Abbr`V`] >> 2168 qpat_x_assum `w2n q >= Q` (fn x => `Q <= w2n q` by METIS_TAC [x,GREATER_EQ]) >> 2169 `Q <= w2n (mw_div_test q u1 u2 u3 v1 v2)` by METIS_TAC[mw_div_test_lemma2] >> 2170 `w2n q <= Q + 2` by METIS_TAC[Abbr`Q`,mw_div_range2,Abbr `U`, Abbr`V`] >> 2171 REV (Cases_on `w2n q = Q + 2`) THEN1 2172 (`w2n q <= SUC Q` by DECIDE_TAC >> 2173 Q.PAT_ABBREV_TAC`test = w2n (mw_div_test q u1 u2 u3 v1 v2)` >> 2174 `test <> dimword(:'a)` by METIS_TAC[w2n_lt,prim_recTheory.LESS_NOT_EQ] >> 2175 `test <= w2n q` by METIS_TAC[mw_div_test_lemma1] >> 2176 DECIDE_TAC) >> 2177 REV (sg `mw_cmp [u3; u2; u1] (mw_mul_by_single q [v2; v1]) = SOME T`) 2178 THEN1 (Q.PAT_ABBREV_TAC`test = w2n (mw_div_test q u1 u2 u3 v1 v2)` >> 2179 `test <= w2n q - 1` by( markerLib.UNABBREV_TAC "test" >> 2180 REPEAT (qpat_x_assum `w2n q = xxx` (K ALL_TAC)) >> 2181 srw_tac[][Once mw_div_test_def] >> 2182 `w2n q2 = w2n q - 1` by (markerLib.UNABBREV_TAC "q2" >> lrw[]) >> 2183 Cases_on `mw_cmp [u2; u1] (FST (mw_add [FST s; SND s] [0w; 1w] F)) = SOME T` >> 2184 srw_tac[][] THEN1 METIS_TAC[LESS_EQ_REFL,LESS_EQ_TRANS,mw_div_test_lemma1] >> 2185 DECIDE_TAC) >> 2186 DECIDE_TAC) >> 2187 REV (sg `w2n u1 * dimword(:'a) * dimword(:'a) + w2n u2 * dimword(:'a) + w2n u3 < w2n q * (w2n v1 * dimword(:'a) + w2n v2)`) 2188 THEN1 2189 (qsuff_tac `mw2n [u3;u2;u1] < mw2n (mw_mul_by_single q [v2;v1])` 2190 THEN1( `LENGTH [u3;u2;u1] = LENGTH (mw_mul_by_single q [v2;v1])` by METIS_TAC[mw_mul_by_single_lemma,LENGTH,ADD1] >> 2191 FULL_SIMP_TAC std_ss [mw_cmp_thm,prim_recTheory.LESS_NOT_EQ]) >> 2192 REPEAT (qpat_x_assum `w2n q = xxx` (K ALL_TAC)) >> 2193 FULL_SIMP_TAC arith_ss[mw2n_def,mw_mul_by_single_lemma,LEFT_ADD_DISTRIB]) >> 2194 Q.PAT_ABBREV_TAC` b = dimword(:'a)` >> 2195 Q.PAT_ABBREV_TAC`V1 = w2n v1` >> 2196 Q.PAT_ABBREV_TAC`V2 = w2n v2` >> 2197 Q.PAT_ABBREV_TAC`U1 = w2n u1` >> 2198 Q.PAT_ABBREV_TAC`U2 = w2n u2` >> 2199 Q.PAT_ABBREV_TAC`U3 = w2n u3` >> 2200 EQT_M_R_S_i `b**(LENGTH (vs:'a word list))` >> 2201 `w2n q * mw2n (REVERSE vs) <= mw2n (REVERSE (us:'a word list)) + mw2n (REVERSE (v1::v2::(vs:'a word list)))` by( MATCH_MP_TAC (GEN_ALL (Q.SPECL [`a1*a2`,`a4`,`a5+a4`] LESS_EQ_TRANS)) >> 2202 REV strip_tac THEN1 METIS_TAC[LESS_EQ_ADD,ADD_COMM] >> 2203 MATCH_MP_TAC LESS_EQ_TRANS >> 2204 EXISTS_TAC ``(b:num) * b ** LENGTH (vs:'a word list)`` >> 2205 strip_tac THEN1 2206 (MATCH_MP_TAC LESS_MONO_MULT2 \\ STRIP_TAC 2207 THEN1 (FULL_SIMP_TAC std_ss []) 2208 \\ ONCE_REWRITE_TAC [GSYM LENGTH_REVERSE] 2209 \\ Q.UNABBREV_TAC `b` 2210 \\ FULL_SIMP_TAC std_ss [dimword_def,GSYM EXP_EXP_MULT] 2211 \\ ONCE_REWRITE_TAC [MULT_COMM] 2212 \\ FULL_SIMP_TAC std_ss [GSYM dimwords_def] 2213 \\ MATCH_MP_TAC (DECIDE ``n < m ==> n <= m:num``) 2214 \\ SIMP_TAC std_ss [mw2n_lt]) >> 2215 markerLib.UNABBREV_TAC "V" >> lrw[mw2n_msf,dimwords_dimword,GSYM ADD1,GSYM EXP]>> 2216 ONCE_REWRITE_TAC[DECIDE``a + (b + c) = b + (a + c):num``] >> 2217 Cases_on `V1` THEN1 full_simp_tac (srw_ss())[] >> 2218 Q.PAT_ABBREV_TAC`A = b ** SUC(LENGTH vs)`>> 2219 Q.PAT_ABBREV_TAC`B = mw2n (REVERSE vs) + V2 * b ** LENGTH vs`>> 2220 METIS_TAC[MULT,MULT_COMM,ADD_COMM,ADD_ASSOC,LESS_EQ_ADD])>> 2221 EQT_A_S_R_2 (`mw2n (REVERSE (us:'a word list)) + mw2n (REVERSE (v1::v2::(vs:'a word list)))`,`w2n (q:'a word) * mw2n (REVERSE (vs:'a word list))`) >> 2222 REWRITE_TAC [DECIDE ``(U1 * b * b + U2 * b + U3) * b**y + (u + V:num) = 2223 u + b**y * U3 + b * b**y * U2 + b * b * b**y * U1 + V``] >> 2224 markerLib.UNABBREV_TAC "b" >> 2225 markerLib.UNABBREV_TAC "U3" >> markerLib.UNABBREV_TAC "U2" >> markerLib.UNABBREV_TAC "U1" >> 2226 qpat_x_assum `LENGTH us = xxx` (fn x => (ASSUME_TAC x \\ REWRITE_TAC[GSYM x])) >> 2227 REWRITE_TAC[DECIDE ``b*b*b**c = (b:num)*(b*b**c)``,GSYM EXP, Once 2228 (METIS_PROVE [ADD1,LENGTH_APPEND,LENGTH_REVERSE,EVAL ``LENGTH [x]``]``SUC(LENGTH us) = LENGTH ((REVERSE us)++[u3])``), 2229 Once (METIS_PROVE [ADD1,LENGTH_APPEND,LENGTH_REVERSE,EVAL ``LENGTH [x]``] ``SUC(SUC(LENGTH us)) = LENGTH (((REVERSE us)++[u3])++[u2])``)] >> 2230 REWRITE_TAC[Once (GSYM LENGTH_REVERSE),GSYM mw2n_msf,GSYM dimwords_dimword,METIS_PROVE [REVERSE,SNOC_APPEND] ``(REVERSE xs) ++ [x] = REVERSE (x::xs)``] >> 2231 ASM_REWRITE_TAC[] >> 2232 REWRITE_TAC[dimwords_dimword]>> 2233 REWRITE_TAC[DECIDE``(A:num) * (V1 * b + V2) * b ** c + A * vs = A * (vs + b ** c * V2 + b * b ** c * V1)``,GSYM EXP, 2234 Once (METIS_PROVE [ADD1,LENGTH_APPEND,LENGTH_REVERSE,EVAL ``LENGTH [x]``]``SUC(LENGTH vs) = LENGTH ((REVERSE vs)++[v2])``)] >> 2235 markerLib.UNABBREV_TAC"V2" >> markerLib.UNABBREV_TAC "V1" >> 2236 REWRITE_TAC[Once (GSYM LENGTH_REVERSE),GSYM mw2n_msf,GSYM dimwords_dimword,METIS_PROVE [REVERSE,SNOC_APPEND] ``(REVERSE xs) ++ [x] = REVERSE (x::xs)``] >> 2237 REWRITE_TAC[RIGHT_ADD_DISTRIB,DECIDE ``2 = 1+1:num``,MULT_LEFT_1,ADD_ASSOC] >> 2238 MATCH_MP_TAC LESS_MONO_ADD >> 2239 METIS_TAC[Abbr`Q`,Abbr`U`,Abbr`V`,DIV_thm4_bis,ADD_COMM,MULT_COMM]); 2240 2241val mw_div_loop_LENGTH = store_thm( "mw_div_loop_LENGTH", 2242``!(zs:'a word list) (ys:'a word list). 2243 dimword(:'a) DIV 2 <= w2n (HD ys) /\ 2244 LENGTH ys < LENGTH zs /\ 2245 1 < LENGTH ys ==> 2246 (LENGTH (mw_div_loop zs ys) = LENGTH zs)``, 2247 2248HO_MATCH_MP_TAC mw_div_loop_ind >> 2249REPEAT strip_tac >> 2250srw_tac[][Once mw_div_loop_def] >> 2251Cases_on `mw_cmp (REVERSE us) q2ys = SOME T` >> 2252srw_tac[][] 2253THEN1 (qpat_x_assum `! us q q2. xxx` (K ALL_TAC) >> 2254 qpat_x_assum `! us. xxx` (fn x => ASSUME_TAC (Q.SPECL [`us`,`q`,`q2`,`q2ys`,`q3`,`q3ys`,`zs2'`] x)) >> 2255 `LENGTH zs = SUC (LENGTH zs2')` by(`LENGTH q3ys = LENGTH us` by METIS_TAC[Abbr`us`,Abbr`q3ys`,mw_mul_by_single_lemma,ADD1,LENGTH_TAKE,LESS_EQ,LENGTH_REVERSE] >> 2256 markerLib.UNABBREV_TAC "zs2'" >> 2257 REWRITE_TAC[LENGTH_APPEND,LENGTH_REVERSE,LENGTH_DROP] >> 2258 Q.PAT_ABBREV_TAC `X = (FST (mw_sub (REVERSE us) q3ys T))` >> 2259 `0 < LENGTH us /\ (LENGTH us = SUC(LENGTH ys))` by METIS_TAC[LENGTH_TAKE,LESS_EQ,DECIDE ``0 < SUC x``] >> 2260 `X <> [] /\ (LENGTH X = SUC(LENGTH ys))` by METIS_TAC[mw_sub_lemma,PAIR,LENGTH_REVERSE,NOT_NIL_EQ_LENGTH_NOT_0] >> 2261 srw_tac[][rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 2262 RW_TAC arith_ss[]) >> 2263 Cases_on `LENGTH ys < LENGTH zs2'` THEN1 METIS_TAC[] >> 2264 srw_tac[][Once mw_div_loop_def]) >> 2265qpat_x_assum `! us. xxx` (fn x => ASSUME_TAC (Q.SPECL [`us`,`q`,`q2`,`q2ys`,`zs2`] x)) >> 2266qpat_x_assum `! us q q2. xxx` (K ALL_TAC) >> 2267`LENGTH zs = SUC (LENGTH zs2)` by (`LENGTH q2ys = LENGTH us` by METIS_TAC[Abbr`us`,Abbr`q2ys`,mw_mul_by_single_lemma,ADD1,LENGTH_TAKE,LESS_EQ,LENGTH_REVERSE] >> 2268 markerLib.UNABBREV_TAC "zs2" >> 2269 REWRITE_TAC[LENGTH_APPEND,LENGTH_REVERSE,LENGTH_DROP] >> 2270 Q.PAT_ABBREV_TAC `X = (FST (mw_sub (REVERSE us) q2ys T))` >> 2271 `0 < LENGTH us /\ (LENGTH us = SUC(LENGTH ys))` by METIS_TAC[LENGTH_TAKE,LESS_EQ,DECIDE ``0 < SUC x``] >> 2272 `X <> [] /\ (LENGTH X = SUC(LENGTH ys))` by METIS_TAC[mw_sub_lemma,PAIR,LENGTH_REVERSE,NOT_NIL_EQ_LENGTH_NOT_0] >> 2273 srw_tac[][rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 2274 RW_TAC arith_ss[]) >> 2275Cases_on `LENGTH ys < LENGTH zs2` THEN1 METIS_TAC[] >> 2276srw_tac[][Once mw_div_loop_def]) 2277 2278val tac_div_loop_1 = 2279 `mw2n (REVERSE (TAKE (SUC (LENGTH ys)) zs2)) DIV mw2n (REVERSE ys) < dimword (:'a)` by( `SUC (LENGTH ys) < LENGTH zs` by DECIDE_TAC >> 2280 markerLib.UNABBREV_TAC "zs2" >> 2281 `LENGTH (FRONT w) = LENGTH ys` by METIS_TAC[prim_recTheory.PRE,LENGTH_BUTLAST] >> 2282 `LENGTH (REVERSE (FRONT w)) < SUC (LENGTH ys)` by METIS_TAC[LENGTH_REVERSE,DECIDE ``x < SUC x``] >> 2283 srw_tac[][TAKE_APPEND2,REVERSE_APPEND,SUC_SUB] >> 2284 `LENGTH (TAKE 1 (DROP (SUC (LENGTH ys)) zs)) = 1` by METIS_TAC[LENGTH_TAKE,LENGTH_DROP,LESS_EQ,SUB_LESS_0,ONE] >> 2285 srw_tac[][mw2n_APPEND,dimwords_dimword] >> 2286 `!a b. (a < b * mw2n (REVERSE ys) ==> a DIV mw2n (REVERSE ys) < b)` by METIS_TAC[DIV_LT_X] >> 2287 POP_ASSUM (fn x => MATCH_MP_TAC x) >> 2288 MATCH_MP_TAC LESS_LESS_EQ_TRANS >> EXISTS_TAC ``dimword(:'a) * SUC (mw2n (REVERSE (us:'a word list)) - mw2n (q3ys:'a word list))`` >> 2289 strip_tac 2290 THEN1( REWRITE_TAC[METIS_PROVE [MULT,MULT_COMM,ADD_COMM] ``a * SUC b = a + a * b``] >> 2291 `!(x:num). x ** 1 = x` by 2292 (GEN_TAC >> REWRITE_TAC[ONE,Q.SPECL [`x`,`0`] (CONJUNCT2 EXP)] >> 2293 RW_TAC arith_ss[]) >> 2294 MATCH_MP_TAC LESS_MONO_ADD >> 2295 METIS_TAC[LESS_MONO_ADD,mw2n_lt,dimwords_dimword,LENGTH_REVERSE]) >> 2296 markerLib.UNABBREV_TAC "q3ys" >> 2297 ASM_REWRITE_TAC[mw_mul_by_single_lemma] >> 2298 METIS_TAC[LESS_MONO_MULT,MULT_COMM,DIV_thm4,LESS_EQ]) >> 2299 `mw2n (REVERSE (BUTLASTN (LENGTH ys) (mw_div_loop zs2 ys))) * 2300 mw2n (REVERSE ys) + mw2n (REVERSE (LASTN (LENGTH ys) (mw_div_loop zs2 ys))) = 2301 mw2n (REVERSE zs2)` by METIS_TAC[] >> 2302 qpat_x_assum ` xx /\ (us = us) /\ yyy ==> zz` (K ALL_TAC) >> 2303 `LENGTH ys <= LENGTH (mw_div_loop zs2 ys) /\ (LENGTH (mw_div_loop zs2 ys) = LENGTH zs2)` by METIS_TAC[mw_div_loop_LENGTH,LESS_IMP_LESS_OR_EQ] >> 2304 srw_tac[][rich_listTheory.LASTN_CONS,rich_listTheory.BUTLASTN_CONS,mw2n_msf,dimwords_dimword,rich_listTheory.LENGTH_BUTLASTN] >> 2305 REWRITE_TAC[DECIDE ``(a + b)* c + d = a*c + d + b*c``] >> 2306 qpat_x_assum `xxx = mw2n (REVERSE zs2)` (fn x => REWRITE_TAC[x]) >> 2307 markerLib.UNABBREV_TAC "zs2" >> REWRITE_TAC[REVERSE_APPEND,REVERSE_REVERSE,mw2n_APPEND] >> 2308 qpat_x_assum `mw2n (FRONT xx) = mw2n xx` (fn x => REWRITE_TAC[x]) >> 2309 REWRITE_TAC[LENGTH_REVERSE,LENGTH_APPEND,LENGTH_DROP] >> 2310 full_simp_tac (srw_ss())[rich_listTheory.LENGTH_BUTLAST] >> 2311 markerLib.UNABBREV_TAC "q3ys" >> 2312 full_simp_tac (srw_ss())[mw_mul_by_single_lemma] >> 2313 `zs = us ++ (DROP (SUC(LENGTH ys)) zs)` by METIS_TAC[Abbr`us`,TAKE_DROP] >> 2314 POP_ASSUM (fn x => CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [x]))) >> 2315 REWRITE_TAC[REVERSE_APPEND,mw2n_APPEND,dimwords_dimword,LENGTH_DROP,LENGTH_REVERSE] >> 2316 REWRITE_TAC[DECIDE ``a + b*c + b*d*e = a + b*(c +d*e)``] >> 2317 METIS_TAC[DIV_thm3,SUB_ADD]; 2318 2319val tac_div_loop_2 = 2320 srw_tac[][Once mw_div_loop_def] >> 2321 srw_tac[][Once mw_div_loop_def] >> POP_ASSUM (K ALL_TAC) >> 2322 `LENGTH zs2 = LENGTH ys` by DECIDE_TAC >> 2323 `LENGTH ys <= LENGTH (q3::zs2)` by METIS_TAC[LENGTH,DECIDE ``n <= SUC n``] >> 2324 srw_tac[][rich_listTheory.BUTLASTN_CONS,rich_listTheory.LASTN_CONS,mw2n_msf,dimwords_dimword] >> 2325 `(BUTLASTN (LENGTH ys) zs2 = []) /\ 2326 (LASTN (LENGTH ys) zs2 = zs2)` by METIS_TAC[rich_listTheory.BUTLASTN_LENGTH_NIL,rich_listTheory.LASTN_LENGTH_ID] >> 2327 POP_ASSUM (fn x => REWRITE_TAC[x]) >> POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2328 RW_TAC arith_ss[LENGTH,REVERSE,mw2n_def] >> 2329 markerLib.UNABBREV_TAC "zs2">> 2330 ASM_REWRITE_TAC[REVERSE_REVERSE,REVERSE_APPEND,mw2n_APPEND,dimwords_dimword]>> 2331 markerLib.UNABBREV_TAC "q3ys" >> srw_tac[][mw_mul_by_single_lemma] >> 2332 RW_TAC arith_ss[] >> 2333 ONCE_REWRITE_TAC[GSYM ADD_ASSOC] >> 2334 Q.PAT_ABBREV_TAC `x = mw2n (REVERSE ys) * (mw2n (REVERSE us) DIV mw2n (REVERSE ys))` >> 2335 `mw2n (REVERSE us) - x + x = mw2n (REVERSE us)` by METIS_TAC[MULT_COMM,DIV_thm3,SUB_ADD,Abbr`x`] >> 2336 POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2337 markerLib.UNABBREV_TAC "us" >> 2338 `SUC(LENGTH ys) = LENGTH zs` by DECIDE_TAC >> POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2339 srw_tac[][rich_listTheory.BUTFIRSTN_LENGTH_NIL,listTheory.TAKE_LENGTH_ID,mw2n_def]; 2340 2341val tac_div_loop_test = 2342 Cases_on `us` THEN1 full_simp_tac (srw_ss())[] >> Cases_on `t` THEN1 full_simp_tac (srw_ss())[] >> Cases_on `t'` THEN1 full_simp_tac (srw_ss())[] >> 2343 Cases_on `ys` THEN1 full_simp_tac (srw_ss())[] >> Cases_on `t'` THEN1 full_simp_tac (srw_ss())[] >> 2344 FULL_SIMP_TAC std_ss[HD,TL,LENGTH] >> 2345 METIS_TAC[mw_div_test_thm]; 2346 2347val mw_div_loop_thm = store_thm( "mw_div_loop_thm", 2348``!(zs:'a word list) (ys:'a word list). 2349 dimword(:'a) DIV 2 <= w2n (HD ys) /\ 2350 LENGTH ys < LENGTH zs /\ 1 < LENGTH ys /\ 2351 ((mw2n (REVERSE (TAKE (SUC (LENGTH ys)) zs)) DIV mw2n (REVERSE ys)) < dimword(:'a) ) ==> 2352 (let rslt = mw_div_loop zs ys in 2353 mw2n (REVERSE( BUTLASTN (LENGTH ys) rslt)) * mw2n (REVERSE ys) + mw2n (REVERSE (LASTN (LENGTH ys) rslt)) = 2354 mw2n (REVERSE zs))``, 2355 2356 HO_MATCH_MP_TAC mw_div_loop_ind >> REPEAT strip_tac >> 2357 srw_tac[][Once mw_div_loop_def] >> 2358 markerLib.UNABBREV_TAC "rslt" >> 2359 Cases_on `mw_cmp (REVERSE us) q2ys = SOME T` >> 2360 srw_tac[][] 2361 2362THENL[qpat_x_assum `!us. xxx` (K ALL_TAC) >> 2363 qpat_x_assum `!us. xxx` (fn x => ASSUME_TAC (Q.SPECL [`us`,`q`,`q2`,`q2ys`,`q3`,`q3ys`,`zs2'`] x)), 2364 qpat_x_assum `!us. xxx` (fn x => ASSUME_TAC (Q.SPECL [`us`,`q`,`q2`,`q2ys`,`zs2`] x)) >> 2365 qpat_x_assum `!us. xxx` (K ALL_TAC)] 2366THENL[ALL_TAC,markerLib.UNABBREV_TAC "q3" >> markerLib.UNABBREV_TAC "q2" >> 2367 Q.PAT_ABBREV_TAC `q3 = mw_div_test q (HD us) (HD (TL us)) (HD (TL (TL us))) (HD ys) (HD (TL ys))`] >> 2368markerLib.UNABBREV_TAC "zs2" >> 2369markerLib.UNABBREV_TAC "zs2'" >> 2370markerLib.UNABBREV_TAC "q2ys" >> 2371markerLib.UNABBREV_TAC "q3ys" >> 2372Q.PAT_ABBREV_TAC `q3ys = (mw_mul_by_single q3 (REVERSE ys))` >> 2373Q.PAT_ABBREV_TAC `w = FST (mw_sub (REVERSE us) q3ys T)` >> 2374Q.PAT_ABBREV_TAC `zs2 = (REVERSE (FRONT w) ++ DROP (SUC (LENGTH ys)) zs)` >> 2375`LENGTH q3ys = LENGTH us` by METIS_TAC[Abbr`us`,Abbr`q3ys`,mw_mul_by_single_lemma,ADD1,LENGTH_TAKE,LESS_EQ,LENGTH_REVERSE] >> 2376`0 < LENGTH us /\ (LENGTH us = SUC(LENGTH ys))` by METIS_TAC[LENGTH_TAKE,LESS_EQ,DECIDE ``0 < SUC x``] >> 2377`0 < mw2n (REVERSE ys)` by 2378 (`ys <> []` by METIS_TAC[NOT_NIL_EQ_LENGTH_NOT_0,DECIDE ``0<1``,LESS_TRANS] >> 2379 `?h t. ys = h::t` by METIS_TAC[list_CASES] >> 2380 FULL_SIMP_TAC std_ss[HD] >> 2381 POP_ASSUM (fn x => lrw[x,mw2n_msf,dimwords_dimword]) >> 2382 `0 < dimword(:'a) DIV 2` by METIS_TAC[TWO,DIV_GT0,DECIDE``0<2``,TWO,LESS_EQ,ONE_LT_dimword] >> 2383 METIS_TAC[LESS_LESS_EQ_TRANS,ZERO_LT_EXP,ZERO_LT_dimword,LESS_EQ_ADD,ZERO_LESS_MULT,ADD_COMM]) >> 2384sg `w2n q3 = mw2n (REVERSE us) DIV mw2n (REVERSE ys)` 2385THENL[`(w2n q2 = mw2n (REVERSE us) DIV mw2n (REVERSE ys)) \/(w2n q2 = SUC (mw2n (REVERSE us) DIV mw2n (REVERSE ys)))` by tac_div_loop_test 2386 THEN1(`mw2n (REVERSE us) < mw2n (mw_mul_by_single q2 (REVERSE ys))` by FULL_SIMP_TAC std_ss[ADD1,LENGTH,LENGTH_REVERSE,mw_mul_by_single_lemma,mw_cmp_thm] >> 2387 POP_ASSUM (fn x => ASSUME_TAC (RW[mw_mul_by_single_lemma] x)) >> 2388 qpat_x_assum `w2n q2 = xxx` (fn x => FULL_SIMP_TAC std_ss [x]) >> 2389 METIS_TAC[NOT_LESS,DIV_thm3]) >> 2390 METIS_TAC[SUC_SUB1,w2n_n2w,w2n_lt,LESS_MOD,DECIDE ``x < SUC x``,LESS_TRANS,Abbr`q3`], 2391 ALL_TAC, 2392 `(w2n q3 = mw2n (REVERSE us) DIV mw2n (REVERSE ys)) \/(w2n q3 = SUC (mw2n (REVERSE us) DIV mw2n (REVERSE ys)))` by tac_div_loop_test >> 2393 `LENGTH q3ys = LENGTH (REVERSE us)` by METIS_TAC[ADD1,LENGTH,LENGTH_REVERSE,mw_mul_by_single_lemma,Abbr`q3ys`] >> 2394 `mw2n q3ys <= mw2n (REVERSE us)` by FULL_SIMP_TAC std_ss[mw_cmp_thm,NOT_LESS] >> 2395 markerLib.UNABBREV_TAC "q3ys" >> 2396 POP_ASSUM (fn x => ASSUME_TAC (RW[mw_mul_by_single_lemma] x)) >> 2397 qpat_x_assum `w2n q3 = xxx` (fn x => FULL_SIMP_TAC std_ss [x]) >> 2398 METIS_TAC[X_LE_DIV,NOT_LESS,DECIDE ``z < SUC z``], 2399 ALL_TAC] >> 2400`w <> [] /\ (LENGTH w = SUC(LENGTH ys))` by METIS_TAC[mw_sub_lemma,PAIR,LENGTH_REVERSE,NOT_NIL_EQ_LENGTH_NOT_0] >> 2401`LENGTH zs = SUC (LENGTH zs2)` by ( 2402 markerLib.UNABBREV_TAC "zs2" >> 2403 REWRITE_TAC[LENGTH_APPEND,LENGTH_REVERSE,LENGTH_DROP] >> 2404 srw_tac[][rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 2405 RW_TAC arith_ss[]) >> 2406`mw2n q3ys <= mw2n (REVERSE us)` by METIS_TAC[Abbr`q3ys`,mw_mul_by_single_lemma,DIV_thm3] >> 2407`mw2n w = mw2n (REVERSE us) - mw2n q3ys` by METIS_TAC[LENGTH_REVERSE,mw_sub_thm] >> 2408`mw2n (FRONT w) = mw2n w` by( 2409 `mw2n w < dimword(:'a) ** LENGTH (FRONT w)` by ( 2410 qpat_x_assum `mw2n xx = mw2n yy - mw2n zz` (K ALL_TAC) >> 2411 srw_tac[][rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 2412 `mw2n w = mw2n (REVERSE us) - mw2n q3ys` by METIS_TAC[LENGTH_REVERSE,mw_sub_thm] >> 2413 POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2414 markerLib.UNABBREV_TAC "q3ys" >> 2415 ASM_REWRITE_TAC[mw_mul_by_single_lemma] >> 2416 METIS_TAC[DIV_thm4,LESS_TRANS,mw2n_lt,dimwords_dimword,LENGTH_REVERSE]) >> 2417 METIS_TAC[mw2n_msf_NIL,dimwords_dimword]) >> 2418Cases_on `LENGTH ys < LENGTH zs2` 2419THENL[tac_div_loop_1,tac_div_loop_2,tac_div_loop_1,tac_div_loop_2]); 2420 2421val tac_div_loop_bis_1 = 2422 `0 < LENGTH zs2` by DECIDE_TAC >> 2423 `LENGTH ys <= LENGTH (mw_div_loop zs2 ys)` by METIS_TAC[NOT_NIL_EQ_LENGTH_NOT_0,mw_div_loop_LENGTH,LESS_IMP_LESS_OR_EQ] >> 2424 srw_tac[][LASTN_CONS] >> 2425 `mw2n (REVERSE (TAKE (SUC (LENGTH ys)) zs2)) DIV mw2n (REVERSE ys) < dimword (:'a)` by( `SUC (LENGTH ys) < LENGTH zs` by DECIDE_TAC >> 2426 markerLib.UNABBREV_TAC "zs2" >> 2427 `LENGTH (FRONT w) = LENGTH ys` by METIS_TAC[prim_recTheory.PRE,LENGTH_BUTLAST] >> 2428 `LENGTH (REVERSE (FRONT w)) < SUC (LENGTH ys)` by METIS_TAC[LENGTH_REVERSE,DECIDE ``x < SUC x``] >> 2429 srw_tac[][TAKE_APPEND2,REVERSE_APPEND,SUC_SUB] >> 2430 `LENGTH (TAKE 1 (DROP (SUC (LENGTH ys)) zs)) = 1` by METIS_TAC[LENGTH_TAKE,LENGTH_DROP,LESS_EQ,SUB_LESS_0,ONE] >> 2431 srw_tac[][mw2n_APPEND,dimwords_dimword] >> 2432 `!a b. (a < b * mw2n (REVERSE ys) ==> a DIV mw2n (REVERSE ys) < b)` by METIS_TAC[DIV_LT_X] >> 2433 POP_ASSUM (fn x => MATCH_MP_TAC x) >> 2434 MATCH_MP_TAC LESS_LESS_EQ_TRANS >> EXISTS_TAC ``dimword(:'a) * SUC (mw2n (REVERSE (us:'a word list)) - mw2n (q3ys:'a word list))`` >> 2435 strip_tac 2436 THEN1( REWRITE_TAC[METIS_PROVE [MULT,MULT_COMM,ADD_COMM] ``a * SUC b = a + a * b``] >> 2437 `!(x:num). x ** 1 = x` by 2438 (GEN_TAC >> REWRITE_TAC[ONE,Q.SPECL [`x`,`0`] (CONJUNCT2 EXP)] >> 2439 RW_TAC arith_ss[]) >> 2440 MATCH_MP_TAC LESS_MONO_ADD >> 2441 METIS_TAC[LESS_MONO_ADD,mw2n_lt,dimwords_dimword,LENGTH_REVERSE]) >> 2442 markerLib.UNABBREV_TAC "q3ys" >> 2443 ASM_REWRITE_TAC[mw_mul_by_single_lemma] >> 2444 METIS_TAC[LESS_MONO_MULT,MULT_COMM,DIV_thm4,LESS_EQ]) >> 2445 METIS_TAC[]; 2446 2447val tac_div_loop_bis_2 = 2448srw_tac[][Once mw_div_loop_def] >> 2449lrw[rich_listTheory.LASTN_CONS,rich_listTheory.LASTN_LENGTH_ID] >> 2450markerLib.UNABBREV_TAC "zs2" >> 2451`SUC (LENGTH ys) = LENGTH zs` by DECIDE_TAC >> 2452POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2453REWRITE_TAC[REVERSE_APPEND,REVERSE_REVERSE,rich_listTheory.BUTFIRSTN_LENGTH_NIL,REVERSE,APPEND_NIL] >> 2454`LENGTH (REVERSE (FRONT w)) = LENGTH ys` by METIS_TAC[rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE,LENGTH_REVERSE] >> 2455POP_ASSUM (fn x => ASM_REWRITE_TAC[GSYM x,LASTN_LENGTH_ID,REVERSE_REVERSE]) >> 2456markerLib.UNABBREV_TAC "q3ys" >> 2457ASM_REWRITE_TAC[mw_mul_by_single_lemma] >> 2458METIS_TAC[DIV_thm4]; 2459 2460val mw_div_loop_thm_bis = store_thm ("mw_div_loop_thm_bis", 2461``!(zs:'a word list) (ys:'a word list). 2462 dimword(:'a) DIV 2 <= w2n (HD ys) /\ 2463 LENGTH ys < LENGTH zs /\ 1 < LENGTH ys /\ 2464 ((mw2n (REVERSE (TAKE (SUC (LENGTH ys)) zs)) DIV mw2n (REVERSE ys)) < dimword(:'a) ) ==> 2465 (let rslt = mw_div_loop zs ys in 2466 (mw2n (REVERSE( BUTLASTN (LENGTH ys) rslt)) = mw2n (REVERSE zs) DIV mw2n (REVERSE ys)) /\ 2467 (mw2n (REVERSE (LASTN (LENGTH ys) rslt)) = mw2n (REVERSE zs) MOD mw2n (REVERSE ys)))``, 2468 2469qsuff_tac `!(zs:'a word list) (ys:'a word list). 2470 dimword(:'a) DIV 2 <= w2n (HD ys) /\ 2471 LENGTH ys < LENGTH zs /\ 1 < LENGTH ys /\ 2472 ((mw2n (REVERSE (TAKE (SUC (LENGTH ys)) zs)) DIV mw2n (REVERSE ys)) < dimword(:'a) ) ==> 2473 (mw2n (REVERSE (LASTN (LENGTH ys) (mw_div_loop zs ys))) < mw2n (REVERSE ys))` 2474THEN1(REPEAT strip_tac >> 2475 srw_tac[][] >> 2476 IMP_RES_TAC mw_div_loop_thm >> 2477 `mw2n (REVERSE zs) = mw2n (REVERSE (BUTLASTN (LENGTH ys) rslt)) * mw2n (REVERSE ys) + 2478 mw2n (REVERSE (LASTN (LENGTH ys) rslt))` by METIS_TAC[] >> 2479 POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2480 `0 < mw2n (REVERSE ys)` by 2481 (`ys <> []` by METIS_TAC[NOT_NIL_EQ_LENGTH_NOT_0,DECIDE ``0<1``,LESS_TRANS] >> 2482 `?h t. ys = h::t` by METIS_TAC[list_CASES] >> 2483 FULL_SIMP_TAC std_ss[HD] >> 2484 POP_ASSUM (fn x => lrw[x,mw2n_msf,dimwords_dimword]) >> 2485 `0 < dimword(:'a) DIV 2` by METIS_TAC[TWO,DIV_GT0,DECIDE``0<2``,TWO,LESS_EQ,ONE_LT_dimword] >> 2486 METIS_TAC[LESS_LESS_EQ_TRANS,ZERO_LT_EXP,ZERO_LT_dimword,LESS_EQ_ADD,ZERO_LESS_MULT,ADD_COMM]) >> 2487 srw_tac[][MOD_TIMES,ADD_DIV_ADD_DIV,Abbr`rslt`] >> 2488 MATCH_MP_TAC ((fn (x,y) => y) (EQ_IMP_RULE (SPEC_ALL EQ_ADDL))) >> 2489 MATCH_MP_TAC LESS_DIV_EQ_ZERO >> METIS_TAC[]) >> 2490 2491HO_MATCH_MP_TAC mw_div_loop_ind >> 2492REPEAT strip_tac >> 2493srw_tac[][Once mw_div_loop_def] >> 2494Cases_on `mw_cmp (REVERSE us) q2ys = SOME T` >> 2495markerLib.UNABBREV_TAC "q3" 2496THENL[Q.PAT_ABBREV_TAC`(q3:'a word) = n2w (w2n q2 - 1)`,markerLib.UNABBREV_TAC "q2" >> 2497 Q.PAT_ABBREV_TAC `q3 = mw_div_test q (HD us) (HD (TL us)) (HD (TL (TL us))) (HD ys) (HD (TL ys))`] >> 2498markerLib.UNABBREV_TAC "zs2" >> 2499markerLib.UNABBREV_TAC "zs2'" >> 2500markerLib.UNABBREV_TAC "q2ys" >> 2501markerLib.UNABBREV_TAC "q3ys" >> 2502Q.PAT_ABBREV_TAC `q3ys = (mw_mul_by_single q3 (REVERSE ys))` >> 2503Q.PAT_ABBREV_TAC `w = FST (mw_sub (REVERSE us) q3ys T)` >> 2504Q.PAT_ABBREV_TAC `zs2 = (REVERSE (FRONT w) ++ DROP (SUC (LENGTH ys)) zs)` >> 2505srw_tac[][] >> 2506`0 < LENGTH us /\ (LENGTH us = SUC(LENGTH ys))` by METIS_TAC[LENGTH_TAKE,LESS_EQ,DECIDE ``0 < SUC x``] >> 2507`LENGTH q3ys = LENGTH us` by METIS_TAC[Abbr`us`,Abbr`q3ys`,mw_mul_by_single_lemma,ADD1,LENGTH_TAKE,LESS_EQ,LENGTH_REVERSE] >> 2508`0 < mw2n (REVERSE ys)` by 2509 (`ys <> []` by METIS_TAC[NOT_NIL_EQ_LENGTH_NOT_0,DECIDE ``0<1``,LESS_TRANS] >> 2510 `?h t. ys = h::t` by METIS_TAC[list_CASES] >> 2511 FULL_SIMP_TAC std_ss[HD] >> 2512 POP_ASSUM (fn x => lrw[x,mw2n_msf,dimwords_dimword]) >> 2513 `0 < dimword(:'a) DIV 2` by METIS_TAC[TWO,DIV_GT0,DECIDE``0<2``,TWO,LESS_EQ,ONE_LT_dimword] >> 2514 METIS_TAC[LESS_LESS_EQ_TRANS,ZERO_LT_EXP,ZERO_LT_dimword,LESS_EQ_ADD,ZERO_LESS_MULT,ADD_COMM]) >> 2515sg `w2n q3 = mw2n (REVERSE us) DIV mw2n (REVERSE ys)` 2516THENL[`(w2n q2 = mw2n (REVERSE us) DIV mw2n (REVERSE ys)) \/(w2n q2 = SUC (mw2n (REVERSE us) DIV mw2n (REVERSE ys)))` by tac_div_loop_test 2517 THEN1(`mw2n (REVERSE us) < mw2n (mw_mul_by_single q2 (REVERSE ys))` by FULL_SIMP_TAC std_ss[ADD1,LENGTH,LENGTH_REVERSE,mw_mul_by_single_lemma,mw_cmp_thm] >> 2518 POP_ASSUM (fn x => ASSUME_TAC (RW[mw_mul_by_single_lemma] x)) >> 2519 qpat_x_assum `w2n q2 = xxx` (fn x => FULL_SIMP_TAC std_ss [x]) >> 2520 METIS_TAC[NOT_LESS,DIV_thm3]) >> 2521 METIS_TAC[SUC_SUB1,w2n_n2w,w2n_lt,LESS_MOD,DECIDE ``x < SUC x``,LESS_TRANS,Abbr`q3`], 2522 ALL_TAC, 2523 `(w2n q3 = mw2n (REVERSE us) DIV mw2n (REVERSE ys)) \/(w2n q3 = SUC (mw2n (REVERSE us) DIV mw2n (REVERSE ys)))` by tac_div_loop_test >> 2524 `LENGTH q3ys = LENGTH (REVERSE us)` by METIS_TAC[ADD1,LENGTH,LENGTH_REVERSE,mw_mul_by_single_lemma,Abbr`q3ys`] >> 2525 `mw2n q3ys <= mw2n (REVERSE us)` by FULL_SIMP_TAC std_ss[mw_cmp_thm,NOT_LESS] >> 2526 markerLib.UNABBREV_TAC "q3ys" >> 2527 POP_ASSUM (fn x => ASSUME_TAC (RW[mw_mul_by_single_lemma] x)) >> 2528 qpat_x_assum `w2n q3 = xxx` (fn x => FULL_SIMP_TAC std_ss [x]) >> 2529 METIS_TAC[X_LE_DIV,NOT_LESS,DECIDE ``z < SUC z``], 2530 ALL_TAC] >> 2531`mw2n q3ys <= mw2n (REVERSE us)` by METIS_TAC[Abbr`q3ys`,mw_mul_by_single_lemma,DIV_thm3] >> 2532`w <> [] /\ (LENGTH w = SUC(LENGTH ys))` by METIS_TAC[mw_sub_lemma,PAIR,LENGTH_REVERSE,NOT_NIL_EQ_LENGTH_NOT_0] >> 2533`mw2n w = mw2n (REVERSE us) - mw2n q3ys` by METIS_TAC[Abbr`w`,LENGTH_REVERSE,mw_sub_thm] >> 2534`mw2n (FRONT w) = mw2n w` by ( 2535 `mw2n w < dimword(:'a) ** LENGTH (FRONT w)` by ( 2536 qpat_x_assum `mw2n xx = mw2n yy - mw2n zz` (fn x => ( 2537 srw_tac[][rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 2538 ASSUME_TAC x)) >> 2539 POP_ASSUM (fn x => REWRITE_TAC[x]) >> 2540 markerLib.UNABBREV_TAC "q3ys" >> 2541 ASM_REWRITE_TAC[mw_mul_by_single_lemma] >> 2542 METIS_TAC[DIV_thm4,LESS_TRANS,mw2n_lt,dimwords_dimword,LENGTH_REVERSE]) >> 2543 METIS_TAC[mw2n_msf_NIL,dimwords_dimword]) >> 2544`LENGTH zs = SUC (LENGTH zs2)` by ( 2545 markerLib.UNABBREV_TAC "zs2" >> 2546 REWRITE_TAC[LENGTH_APPEND,LENGTH_REVERSE,LENGTH_DROP] >> 2547 srw_tac[][rich_listTheory.LENGTH_BUTLAST,prim_recTheory.PRE] >> 2548 RW_TAC arith_ss[]) >> 2549Cases_on `LENGTH ys < LENGTH zs2` 2550THENL[tac_div_loop_bis_1,tac_div_loop_bis_2,tac_div_loop_bis_1,tac_div_loop_bis_2]); 2551 2552val mw_div_guess_def = Define ` 2553 mw_div_guess us (ys:'a word list) = 2554 let q = if w2n (HD us) < w2n (HD ys) then 2555 FST (single_div (HD us) (HD (TL us)) (HD ys)) 2556 else n2w (dimword (:'a) - 1) in 2557 let q2 = mw_div_test q (HD us) (HD (TL us)) (HD (TL (TL us))) 2558 (HD ys) (HD (TL ys)) in 2559 q2`; 2560 2561val mw_div_adjust_def = Define ` 2562 mw_div_adjust q zs ys = 2563 if mw_cmp zs (mw_mul_by_single q ys) = SOME T then n2w (w2n q - 1) else q`; 2564 2565val mw_div_aux_def = tDefine "mw_div_aux" ` 2566 mw_div_aux zs1 zs2 ys = 2567 if zs1 = [] then ([],zs2) else 2568 let zs2 = (LAST zs1) :: zs2 in 2569 let zs1 = BUTLAST zs1 in 2570 let q = mw_div_guess (REVERSE zs2) (REVERSE ys) in 2571 let q = mw_div_adjust q zs2 ys in 2572 let zs2 = FST (mw_sub zs2 (mw_mul_by_single q ys) T) in 2573 let (qs,rs) = mw_div_aux zs1 (FRONT zs2) ys in 2574 (q::qs,rs)` 2575 (WF_REL_TAC `measure (\(zs1,zs2,ys). LENGTH zs1)` 2576 \\ SIMP_TAC std_ss [LENGTH_FRONT,DECIDE ``PRE n = n - 1``] 2577 \\ SIMP_TAC std_ss [GSYM LENGTH_NIL] \\ DECIDE_TAC); 2578 2579val mw_div_aux_ind = fetch "-" "mw_div_aux_ind" 2580 2581val mw_div_loop_alt_lemma = prove( 2582 ``mw_div_loop zs ys = 2583 if LENGTH ys < LENGTH zs then 2584 (let us = TAKE (SUC (LENGTH ys)) zs in 2585 let q2 = mw_div_guess us ys in 2586 let q2ys = mw_mul_by_single q2 (REVERSE ys) 2587 in 2588 if mw_cmp (REVERSE us) q2ys = SOME T then 2589 (let q3 = n2w (w2n q2 - 1) in 2590 let q3ys = mw_mul_by_single q3 (REVERSE ys) in 2591 let zs2 = 2592 REVERSE (FRONT (FST (mw_sub (REVERSE us) q3ys T))) ++ 2593 DROP (SUC (LENGTH ys)) zs 2594 in 2595 q3::mw_div_loop zs2 ys) 2596 else 2597 (let zs2 = 2598 REVERSE (FRONT (FST (mw_sub (REVERSE us) q2ys T))) ++ 2599 DROP (SUC (LENGTH ys)) zs 2600 in 2601 q2::mw_div_loop zs2 ys)) 2602 else zs``, 2603 SIMP_TAC std_ss [Once mw_div_loop_def] 2604 \\ SIMP_TAC std_ss [mw_div_guess_def,LET_DEF]); 2605 2606val mw_div_loop_alt = prove( 2607 ``mw_div_loop zs ys = 2608 if LENGTH ys < LENGTH zs then 2609 (let us = TAKE (SUC (LENGTH ys)) zs in 2610 let q2 = mw_div_guess us ys in 2611 let q3 = mw_div_adjust q2 (REVERSE us) (REVERSE ys) in 2612 let q3ys = mw_mul_by_single q3 (REVERSE ys) in 2613 let zs2 = REVERSE (FRONT (FST (mw_sub (REVERSE us) q3ys T))) ++ 2614 DROP (SUC (LENGTH ys)) zs in 2615 q3::mw_div_loop zs2 ys) 2616 else zs``, 2617 SIMP_TAC std_ss [Once mw_div_loop_alt_lemma,mw_div_adjust_def] 2618 \\ Cases_on `LENGTH ys < LENGTH zs` \\ FULL_SIMP_TAC std_ss [] 2619 \\ SIMP_TAC std_ss [LET_DEF] 2620 \\ Cases_on `mw_cmp (REVERSE (TAKE (SUC (LENGTH ys)) zs)) 2621 (mw_mul_by_single (mw_div_guess (TAKE (SUC (LENGTH ys)) zs) ys) 2622 (REVERSE ys)) = SOME T` \\ FULL_SIMP_TAC std_ss []); 2623 2624val IMP_IMP = METIS_PROVE [] ``b1 /\ (b2 ==> b3) ==> (b1 ==> b2) ==> b3`` 2625 2626val LENGTH_mw_sub = store_thm("LENGTH_mw_sub", 2627 ``!xs1 ys c qs1 c1. (mw_sub xs1 ys c = (qs1,c1)) ==> (LENGTH xs1 = LENGTH qs1)``, 2628 Induct \\ Cases_on `ys` 2629 \\ FULL_SIMP_TAC std_ss [mw_sub_def,LET_DEF,single_add_def,single_sub_def] 2630 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ REPEAT STRIP_TAC THEN1 2631 (Q.ABBREV_TAC `t = (dimword (:'a) <= w2n h + w2n (~0w:'a word) + b2n c)` 2632 \\ `?x1 x2. mw_sub xs1 [] t = (x1,x2)` by METIS_TAC [PAIR] 2633 \\ RES_TAC \\ Cases_on `qs1` \\ FULL_SIMP_TAC (srw_ss()) []) 2634 \\ Q.ABBREV_TAC `tt = (dimword (:'a) <= w2n h' + w2n (~h) + b2n c)` 2635 \\ `?x1 x2. mw_sub xs1 t tt = (x1,x2)` by METIS_TAC [PAIR] 2636 \\ RES_TAC \\ Cases_on `qs1` \\ FULL_SIMP_TAC (srw_ss()) []); 2637 2638val mw_div_aux_lemma = prove( 2639 ``!zs1 zs2 ys qs rs. 2640 (LENGTH zs2 = LENGTH ys) /\ 1 < LENGTH ys /\ 2641 (mw_div_aux zs1 zs2 ys = (qs,rs)) ==> 2642 (mw_div_loop (REVERSE (zs1 ++ zs2)) (REVERSE ys) = 2643 qs ++ REVERSE rs) /\ (LENGTH rs = LENGTH ys)``, 2644 STRIP_TAC \\ completeInduct_on `LENGTH zs1` \\ NTAC 2 STRIP_TAC 2645 \\ FULL_SIMP_TAC std_ss [PULL_FORALL] \\ NTAC 5 STRIP_TAC 2646 \\ `(zs1 = []) \/ ?x l. zs1 = SNOC x l` by METIS_TAC [SNOC_CASES] THEN1 2647 (FULL_SIMP_TAC std_ss [APPEND,EVAL ``mw_div_aux [] zs2 ys``] 2648 \\ ONCE_REWRITE_TAC [mw_div_loop_def] 2649 \\ Q.PAT_X_ASSUM `[] = qs` (ASSUME_TAC o GSYM) 2650 \\ FULL_SIMP_TAC (srw_ss()) [APPEND]) 2651 \\ FULL_SIMP_TAC std_ss [] 2652 \\ Q.PAT_X_ASSUM `mw_div_aux (SNOC x l) zs2 ys = (qs,rs)` MP_TAC 2653 \\ SIMP_TAC std_ss [Once mw_div_aux_def,LAST_SNOC,FRONT_SNOC] 2654 \\ FULL_SIMP_TAC std_ss [REVERSE_APPEND,SNOC_APPEND,APPEND_ASSOC] 2655 \\ ONCE_REWRITE_TAC [mw_div_loop_alt] 2656 \\ FULL_SIMP_TAC (srw_ss()) [DECIDE ``n < n + 1 + m:num``] 2657 \\ SIMP_TAC std_ss [Once LET_DEF] 2658 \\ SIMP_TAC std_ss [Once LET_DEF] \\ STRIP_TAC 2659 \\ `TAKE (SUC (LENGTH ys)) (REVERSE zs2 ++ [x] ++ REVERSE l) = 2660 REVERSE zs2 ++ [x]` by 2661 (`SUC (LENGTH ys) = LENGTH (REVERSE zs2 ++ [x])` by FULL_SIMP_TAC (srw_ss()) [ADD1] 2662 \\ FULL_SIMP_TAC std_ss [rich_listTheory.TAKE_LENGTH_APPEND,APPEND_ASSOC]) 2663 \\ ASM_SIMP_TAC std_ss [Once LET_DEF] 2664 \\ FULL_SIMP_TAC std_ss [REVERSE_DEF] 2665 \\ Q.ABBREV_TAC `q2 = mw_div_guess (REVERSE zs2 ++ [x]) (REVERSE ys)` 2666 \\ FULL_SIMP_TAC std_ss [REVERSE_APPEND,REVERSE_REVERSE,REVERSE_DEF,APPEND] 2667 \\ SIMP_TAC (srw_ss()) [Once LET_DEF] 2668 \\ Q.PAT_X_ASSUM `exp = (xx,yy)` MP_TAC 2669 \\ SIMP_TAC (srw_ss()) [Once LET_DEF] 2670 \\ Q.ABBREV_TAC `qq = mw_div_adjust q2 (x::zs2) ys` 2671 \\ SIMP_TAC std_ss [LET_DEF] 2672 \\ Q.ABBREV_TAC `ts = (FRONT (FST (mw_sub (x::zs2) (mw_mul_by_single qq ys) T)))` 2673 \\ `DROP (SUC (LENGTH ys)) (REVERSE zs2 ++ [x] ++ REVERSE l) = 2674 REVERSE l` by 2675 (`SUC (LENGTH ys) = LENGTH (REVERSE zs2 ++ [x])` by FULL_SIMP_TAC (srw_ss()) [ADD1] 2676 \\ FULL_SIMP_TAC std_ss [rich_listTheory.DROP_LENGTH_APPEND,APPEND_ASSOC]) 2677 \\ FULL_SIMP_TAC std_ss [] 2678 \\ `?qs1 rs1. mw_div_aux l ts ys = (qs1,rs1)` by METIS_TAC [PAIR] 2679 \\ Q.PAT_X_ASSUM `!xxx. bbb` (MP_TAC o Q.SPECL [`l`,`ts`,`ys`]) 2680 \\ FULL_SIMP_TAC std_ss [] 2681 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 2682 (Q.UNABBREV_TAC `ts` 2683 \\ `?w1 w2. mw_sub (x::zs2) (mw_mul_by_single qq ys) T = (w1,w2)` by METIS_TAC [PAIR] 2684 \\ FULL_SIMP_TAC std_ss [] \\ IMP_RES_TAC LENGTH_mw_sub 2685 \\ Cases_on `w1` \\ FULL_SIMP_TAC (srw_ss()) []) 2686 \\ STRIP_TAC \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2687 \\ ASM_SIMP_TAC (srw_ss()) []); 2688 2689val mw_div_def = Define ` 2690 mw_div xs ys = 2691 let xs = mw_fix xs in 2692 let ys = mw_fix ys in 2693 if LENGTH xs < LENGTH ys then 2694 ([],xs ++ REPLICATE (LENGTH ys - LENGTH xs) 0w,T) 2695 else if LENGTH ys = 1 then 2696 let (qs,r,c) = mw_simple_div 0w (REVERSE xs) (HD ys) in 2697 (REVERSE qs,[r],c) 2698 else 2699 let d = calc_d (LAST ys,0x1w) in 2700 let xs = mw_mul_by_single d xs ++ [0w] in 2701 let xs1 = BUTLASTN (LENGTH ys) xs in 2702 let xs2 = LASTN (LENGTH ys) xs in 2703 let ys = FRONT (mw_mul_by_single d ys) in 2704 let (qs,rs) = mw_div_aux xs1 xs2 ys in 2705 let (rs,r,c) = mw_simple_div 0w (REVERSE rs) d in 2706 (REVERSE qs,REVERSE rs,c)` 2707 2708val mwi_divmod_def = Define ` 2709 mwi_divmod (s,xs) (t,ys) = 2710 let (res,mod,c) = mw_div xs ys in 2711 let res = mw_fix res in 2712 let mod = mw_fix mod in 2713 let res = if s = t then res else 2714 if mod = [] then res else mw_addv res [] T in 2715 let res_sign = (if res = [] then F else ~(s = t)) in 2716 let mod = if s = t then mod else 2717 if mod = [] then mod else mw_subv ys mod in 2718 let mod_sign = (if mod = [] then F else t) in 2719 (c,(res_sign,res),(mod_sign,mod))`; 2720 2721val mwi_div_def = Define ` 2722 mwi_div s_xs t_ys = FST (SND (mwi_divmod s_xs t_ys))`; 2723 2724val mwi_mod_def = Define ` 2725 mwi_mod s_xs t_ys = SND (SND (mwi_divmod s_xs t_ys))`; 2726 2727val MULT_DIV_MULT_EQ_MULT = prove( 2728 ``!n k m. 0 < n /\ 0 < k ==> ((m * n) DIV (k * n) = m DIV k)``, 2729 ONCE_REWRITE_TAC [MULT_COMM] 2730 \\ SIMP_TAC std_ss [GSYM DIV_DIV_DIV_MULT,RW1 [MULT_COMM] MULT_DIV]); 2731 2732val LENGTH_mw_simple_div = store_thm("LENGTH_mw_simple_div", 2733 ``!xs x ys qs r c. 2734 (mw_simple_div x xs ys = (qs,r,c)) ==> (LENGTH xs = LENGTH qs)``, 2735 Induct \\ SIMP_TAC std_ss [mw_simple_div_def,LET_DEF] 2736 \\ REPEAT STRIP_TAC \\ Cases_on `single_div x h ys` 2737 \\ FULL_SIMP_TAC std_ss [] 2738 \\ `?qs1 r1 c1. mw_simple_div r' xs ys = (qs1,r1,c1)` by METIS_TAC [PAIR] 2739 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [] 2740 \\ Q.PAT_X_ASSUM `q::qs1 = qs` (ASSUME_TAC o GSYM) 2741 \\ FULL_SIMP_TAC std_ss [LENGTH]); 2742 2743val mw_div_thm = store_thm("mw_div_thm", 2744 ``!xs ys mod res c. 2745 (mw_div xs ys = (res,mod,c)) /\ mw2n ys <> 0 ==> 2746 (mw2n res = mw2n xs DIV mw2n ys) /\ 2747 (mw2n mod = mw2n xs MOD mw2n ys) /\ c /\ (LENGTH mod = LENGTH (mw_fix ys))``, 2748 NTAC 5 STRIP_TAC \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2749 \\ SIMP_TAC std_ss [LET_DEF,mw_div_def] 2750 \\ Cases_on `LENGTH (mw_fix xs) < LENGTH (mw_fix ys)` 2751 \\ FULL_SIMP_TAC std_ss [mw2n_mw_fix] THEN1 2752 (IMP_RES_TAC LENGTH_LESS_IMP_mw2n_LESS \\ FULL_SIMP_TAC std_ss 2753 [mw_ok_mw_fix,mw2n_mw_fix,mw2n_def,GSYM mw2n_APPEND_REPLICATE] 2754 \\ `0 < mw2n ys` by DECIDE_TAC \\ FULL_SIMP_TAC std_ss [DIV_EQ_X] 2755 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE] 2756 \\ REPEAT STRIP_TAC \\ DECIDE_TAC) 2757 \\ Cases_on `LENGTH (mw_fix ys) = 1` \\ ASM_SIMP_TAC std_ss [] THEN1 2758 (Cases_on `mw_fix ys` \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 2759 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [HD] \\ STRIP_TAC 2760 \\ `?qs r b. mw_simple_div 0w (REVERSE (mw_fix xs)) h = (qs,r,b)` by 2761 METIS_TAC [PAIR] 2762 \\ FULL_SIMP_TAC std_ss [mw2n_def] 2763 \\ `mw2n ys = mw2n (mw_fix ys)` by FULL_SIMP_TAC std_ss [mw2n_mw_fix] 2764 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [mw2n_def] \\ NTAC 2 STRIP_TAC 2765 \\ `0w <+ h` by 2766 (Cases_on `h` \\ FULL_SIMP_TAC (srw_ss()) [word_lo_n2w] \\ DECIDE_TAC) 2767 \\ FULL_SIMP_TAC std_ss [] 2768 \\ IMP_RES_TAC mw_simple_div_thm \\ FULL_SIMP_TAC (srw_ss()) [mw2n_mw_fix] 2769 \\ Cases_on `r` \\ FULL_SIMP_TAC std_ss [w2n_n2w,mw2n_def]) 2770 \\ Q.ABBREV_TAC `d = (calc_d (LAST (mw_fix ys),0x1w))` 2771 \\ Q.ABBREV_TAC `xs1 = (mw_mul_by_single d (mw_fix xs) ++ [0x0w])` 2772 \\ Q.ABBREV_TAC `ys1 = (FRONT (mw_mul_by_single d (mw_fix ys)))` 2773 \\ `?qs1 rs1. mw_div_aux (BUTLASTN (LENGTH (mw_fix ys)) xs1) 2774 (LASTN (LENGTH (mw_fix ys)) xs1) ys1 = (qs1,rs1)` by METIS_TAC [PAIR] 2775 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 2776 \\ MP_TAC (mw_div_aux_lemma |> Q.SPECL [ 2777 `(BUTLASTN (LENGTH (mw_fix (ys:'a word list))) xs1:'a word list)`, 2778 `(LASTN (LENGTH (mw_fix (ys:'a word list))) xs1:'a word list)`,`ys1`]) 2779 \\ FULL_SIMP_TAC std_ss [] 2780 \\ SIMP_TAC std_ss [AND_IMP_INTRO] 2781 \\ FULL_SIMP_TAC std_ss [LENGTH_DROP] 2782 \\ `LENGTH xs1 = LENGTH (mw_fix xs) + 2` by 2783 (Q.UNABBREV_TAC `xs1` 2784 \\ SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,mw_mul_by_single_def, 2785 LENGTH_mw_mul_pass] \\ DECIDE_TAC) 2786 \\ `LENGTH ys1 = LENGTH (mw_fix ys)` by 2787 (Q.UNABBREV_TAC `ys1` 2788 \\ `mw_mul_by_single d (mw_fix ys) <> []` by 2789 (FULL_SIMP_TAC std_ss [GSYM LENGTH_NIL] 2790 \\ SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,mw_mul_by_single_def, 2791 LENGTH_mw_mul_pass]) 2792 \\ FULL_SIMP_TAC std_ss [LENGTH_FRONT] 2793 \\ SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,mw_mul_by_single_def, 2794 LENGTH_mw_mul_pass] \\ DECIDE_TAC) 2795 \\ FULL_SIMP_TAC std_ss [] 2796 \\ `LENGTH (mw_fix ys) <> 0` by 2797 (FULL_SIMP_TAC std_ss [LENGTH_NIL,mw_fix_NIL]) 2798 \\ `LENGTH (mw_fix ys) <= LENGTH xs1` by 2799 (FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC) 2800 \\ IMP_RES_TAC APPEND_BUTLASTN_LASTN \\ FULL_SIMP_TAC std_ss [] 2801 \\ POP_ASSUM (K ALL_TAC) 2802 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 2803 (REPEAT STRIP_TAC 2804 \\ REPEAT (MATCH_MP_TAC LENGTH_LASTN) \\ DECIDE_TAC) 2805 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 2806 \\ `mw2n xs1 = mw2n xs * w2n d` by 2807 (Q.UNABBREV_TAC `xs1` \\ FULL_SIMP_TAC (srw_ss()) [AC MULT_COMM MULT_ASSOC, 2808 mw2n_APPEND,mw2n_def,mw_mul_by_single_lemma,mw2n_mw_fix]) 2809 \\ `0 < w2n (LAST (mw_fix ys))` by 2810 (`mw_ok (mw_fix ys)` by FULL_SIMP_TAC std_ss [mw_ok_mw_fix] 2811 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [mw_ok_def,LENGTH_NIL] 2812 \\ Cases_on `LAST (mw_fix ys)` \\ SRW_TAC [] [] \\ DECIDE_TAC) 2813 \\ `FRONT (mw_mul_by_single d (mw_fix ys)) <> []` by 2814 (sg `mw_mul_by_single d (mw_fix ys) <> []` 2815 \\ SIMP_TAC std_ss [GSYM LENGTH_NIL,LENGTH_FRONT,mw_mul_by_single_def, 2816 LENGTH_mw_mul_pass] \\ DECIDE_TAC) 2817 \\ `(mw2n ys1 = mw2n ys * w2n d) /\ 2818 dimword (:'a) DIV 2 <= w2n (HD (REVERSE ys1))` by 2819 (Q.UNABBREV_TAC `ys1` \\ FULL_SIMP_TAC (srw_ss()) [AC MULT_COMM MULT_ASSOC, 2820 mw2n_APPEND,mw2n_def,mw_mul_by_single_lemma,mw2n_mw_fix] 2821 \\ IMP_RES_TAC (GSYM d_clauses) 2822 \\ POP_ASSUM (MP_TAC o Q.SPEC `REVERSE (BUTLAST (mw_fix ys))`) 2823 \\ POP_ASSUM (MP_TAC o Q.SPEC `REVERSE (BUTLAST (mw_fix ys))`) 2824 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_NIL,REVERSE_DEF,APPEND_FRONT_LAST] 2825 \\ FULL_SIMP_TAC std_ss [mw_mul_by_single_lemma,mw2n_mw_fix, 2826 AC MULT_COMM MULT_ASSOC,HD_REVERSE]) 2827 \\ MP_TAC (mw_div_loop_thm_bis |> Q.SPECL [`REVERSE xs1`,`REVERSE ys1`]) 2828 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 2829 (FULL_SIMP_TAC std_ss [REVERSE_REVERSE,LENGTH_REVERSE] 2830 \\ STRIP_TAC THEN1 DECIDE_TAC 2831 \\ STRIP_TAC THEN1 DECIDE_TAC 2832 \\ IMP_RES_TAC (GSYM d_clauses) \\ POP_ASSUM (K ALL_TAC) 2833 \\ `0 < (mw2n ys * w2n d)` by 2834 (Q.UNABBREV_TAC `d` 2835 \\ FULL_SIMP_TAC (srw_ss()) [DECIDE ``0 < n <=> n <> 0:num``]) 2836 \\ ASM_SIMP_TAC std_ss [DIV_LT_X] 2837 \\ Q.UNABBREV_TAC `xs1` 2838 \\ FULL_SIMP_TAC (srw_ss()) [REVERSE_APPEND,APPEND, 2839 REVERSE_DEF,TAKE,mw2n_APPEND,mw2n_def] 2840 \\ MATCH_MP_TAC LESS_LESS_EQ_TRANS 2841 \\ Q.EXISTS_TAC `dimwords (LENGTH (mw_fix ys)) (:'a)` 2842 \\ STRIP_TAC THEN1 2843 (`LENGTH (REVERSE 2844 (TAKE (LENGTH (mw_fix ys)) 2845 (REVERSE (mw_mul_by_single d (mw_fix xs))))) = 2846 LENGTH (mw_fix ys)` by 2847 (FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ MATCH_MP_TAC LENGTH_TAKE 2848 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE,LENGTH_mw_mul_by_single] 2849 \\ DECIDE_TAC) 2850 \\ METIS_TAC [mw2n_lt]) 2851 \\ ONCE_REWRITE_TAC [GSYM mw2n_mw_fix] 2852 \\ `mw_ok (mw_fix ys)` by FULL_SIMP_TAC std_ss [mw_ok_mw_fix] 2853 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [mw_ok_def,LENGTH_NIL] 2854 \\ STRIP_TAC 2855 \\ `?x l. mw_fix ys = SNOC x l` by METIS_TAC [SNOC_CASES] 2856 \\ FULL_SIMP_TAC std_ss [LAST_SNOC,LENGTH_SNOC] 2857 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,mw2n_APPEND,mw2n_def,dimwords_SUC] 2858 \\ SIMP_TAC std_ss [Once MULT_COMM] \\ DISJ2_TAC 2859 \\ Cases_on `x` \\ Cases_on `d` \\ FULL_SIMP_TAC (srw_ss()) [] 2860 \\ Cases_on `n` \\ FULL_SIMP_TAC std_ss [] 2861 \\ Cases_on `n'` \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES] 2862 \\ DECIDE_TAC) 2863 \\ FULL_SIMP_TAC std_ss [LET_DEF,REVERSE_REVERSE,LENGTH_REVERSE] 2864 \\ `(LENGTH (mw_fix ys)) = LENGTH (REVERSE rs1)` by 2865 (FULL_SIMP_TAC (srw_ss()) [LENGTH_REVERSE]) 2866 \\ ASM_SIMP_TAC std_ss [] 2867 \\ SIMP_TAC std_ss [rich_listTheory.BUTLASTN_LENGTH_APPEND] 2868 \\ SIMP_TAC std_ss [rich_listTheory.LASTN_LENGTH_APPEND] 2869 \\ FULL_SIMP_TAC std_ss [REVERSE_REVERSE] \\ STRIP_TAC 2870 \\ Q.PAT_X_ASSUM `xxx = (res,mod,c)` (ASSUME_TAC o GSYM) 2871 \\ `?n. w2n d = 2 ** n` by METIS_TAC [d_lemma4 |> SIMP_RULE std_ss []] 2872 \\ `?q2 r2 c2. mw_simple_div 0x0w (REVERSE rs1) d = (q2,r2,c2)` by METIS_TAC [PAIR] 2873 \\ FULL_SIMP_TAC std_ss [] 2874 \\ `0 < mw2n ys` by DECIDE_TAC 2875 \\ `0x0w <+ d` by 2876 (Cases_on `d` \\ FULL_SIMP_TAC std_ss [w2n_n2w,WORD_LO,ZERO_LT_dimword]) 2877 \\ MP_TAC (mw_simple_div_thm |> Q.SPECL [`REVERSE rs1`,`d`]) 2878 \\ FULL_SIMP_TAC std_ss [REVERSE_REVERSE] \\ STRIP_TAC \\ STRIP_TAC 2879 THEN1 (MATCH_MP_TAC MULT_DIV_MULT_EQ_MULT \\ FULL_SIMP_TAC std_ss []) 2880 \\ FULL_SIMP_TAC std_ss [w2n_n2w,WORD_LO, 2881 GSYM (RW1 [MULT_COMM] DIV_MOD_MOD_DIV),MULT_DIV] 2882 \\ IMP_RES_TAC LENGTH_mw_simple_div 2883 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE]); 2884 2885val ABS_NEG = prove( 2886 ``ABS (-(& n)) = & n``, 2887 intLib.COOPER_TAC); 2888 2889val NEG_DIV_LEMMA = prove( 2890 ``m <> 0 ==> 2891 ((- & n) / & m = - (& (n DIV m + if n MOD m = 0 then 0 else 1)):int)``, 2892 STRIP_TAC \\ `& m <> 0i` by intLib.COOPER_TAC 2893 \\ ASM_SIMP_TAC (srw_ss()) [] 2894 \\ `0i < &m /\ (0 <= -&n = (n = 0))` by intLib.COOPER_TAC 2895 \\ ASM_SIMP_TAC std_ss [int_div,EVAL ``-0i``,NUM_OF_INT] 2896 \\ Cases_on `n = 0` \\ FULL_SIMP_TAC std_ss [] THEN1 2897 (`0 < m` by DECIDE_TAC 2898 \\ FULL_SIMP_TAC std_ss [ZERO_DIV] \\ EVAL_TAC) 2899 \\ FULL_SIMP_TAC std_ss [INT_MOD_CALCULATE,NUM_OF_INT] 2900 \\ Cases_on `n MOD m = 0` \\ FULL_SIMP_TAC std_ss [] 2901 \\ Q.ABBREV_TAC `k = n DIV m` \\ intLib.COOPER_TAC); 2902 2903val NEG_DIV = prove( 2904 ``m <> 0 ==> 2905 (& n / & m = (& (n DIV m)):int) /\ 2906 ((- & n) / & m = - (& (n DIV m + if n MOD m = 0 then 0 else 1)):int) /\ 2907 (& n / (- & m) = - (& (n DIV m + if n MOD m = 0 then 0 else 1)):int) /\ 2908 ((- & n) / (- & m) = (& (n DIV m):int))``, 2909 STRIP_TAC \\ `& m <> 0i` by intLib.COOPER_TAC 2910 \\ ASM_SIMP_TAC (srw_ss()) [NEG_DIV_LEMMA]); 2911 2912val NEG_MOD_LEMMA = prove( 2913 ``m <> 0 ==> 2914 (-&n % &m = &(if n MOD m = 0 then 0 else m - n MOD m))``, 2915 STRIP_TAC \\ `& m <> 0i` by intLib.COOPER_TAC 2916 \\ ASM_SIMP_TAC std_ss [int_mod,NEG_DIV_LEMMA] 2917 \\ Cases_on `n MOD m = 0` \\ FULL_SIMP_TAC std_ss [] 2918 \\ FULL_SIMP_TAC (srw_ss()) [integerTheory.INT_MUL_CALCULATE] 2919 \\ `0 < m` by DECIDE_TAC THEN1 (METIS_TAC [DIVISION,ADD_0]) 2920 \\ IMP_RES_TAC DIVISION 2921 \\ REPEAT (Q.PAT_X_ASSUM `!k. bbb` (MP_TAC o GSYM o Q.SPEC `n`)) 2922 \\ REPEAT STRIP_TAC 2923 \\ SIMP_TAC std_ss [RIGHT_ADD_DISTRIB] 2924 \\ `n DIV m * m = n - n MOD m` by DECIDE_TAC 2925 \\ FULL_SIMP_TAC std_ss [] 2926 \\ `&(n - n MOD m + m) = &(n - n MOD m) + & m` by FULL_SIMP_TAC std_ss [integerTheory.INT_ADD_CALCULATE] 2927 \\ FULL_SIMP_TAC std_ss [] 2928 \\ `n MOD m <= n` by (IMP_RES_TAC MOD_LESS_EQ \\ simp[]) 2929 \\ `n MOD m <= m` by DECIDE_TAC 2930 \\ FULL_SIMP_TAC std_ss [GSYM integerTheory.INT_SUB] 2931 \\ Q.ABBREV_TAC `k = n MOD m` \\ POP_ASSUM (K ALL_TAC) 2932 \\ intLib.COOPER_TAC); 2933 2934val NEG_MOD = prove( 2935 ``m <> 0 ==> 2936 (& n % & m = (& (n MOD m)):int) /\ 2937 ((- & n) % & m = &(if n MOD m = 0 then 0 else m - n MOD m)) /\ 2938 (& n % (- & m) = - &(if n MOD m = 0 then 0 else m - n MOD m)) /\ 2939 ((- & n) % (- & m) = - (& (n MOD m):int))``, 2940 STRIP_TAC \\ `& m <> 0i` by intLib.COOPER_TAC 2941 \\ ASM_SIMP_TAC (srw_ss()) [NEG_MOD_LEMMA]); 2942 2943val mw_addv_lemma = prove( 2944 ``mw_addv (n2mw n) [] T = n2mw (n + 1)``, 2945 `mw_ok (mw_addv (n2mw n) [] T)` by 2946 (MATCH_MP_TAC mw_ok_addv 2947 \\ FULL_SIMP_TAC std_ss [mw_ok_n2mw,EVAL ``mw_ok []``]) 2948 \\ IMP_RES_TAC mw_ok_mw_mw2n 2949 \\ POP_ASSUM (fn th => ONCE_REWRITE_TAC [th]) 2950 \\ FULL_SIMP_TAC std_ss [mw2n_n2mw,mw_addv_thm,LENGTH] 2951 \\ AP_TERM_TAC \\ EVAL_TAC); 2952 2953val Num_ABS_ID = prove( 2954 ``Num (ABS (& n)) = n``, 2955 intLib.COOPER_TAC); 2956 2957val mw_subv_lemma = prove( 2958 ``j <> 0 ==> 2959 (mw_subv (n2mw (Num (ABS j))) (n2mw (Num (ABS i) MOD Num (ABS j))) = 2960 n2mw (Num (ABS j) - Num (ABS i) MOD Num (ABS j)))``, 2961 REPEAT STRIP_TAC \\ `0 < Num (ABS j)` by intLib.COOPER_TAC 2962 \\ Q.ABBREV_TAC `k = Num (ABS j)` 2963 \\ MATCH_MP_TAC IMP_EQ_n2mw_ALT 2964 \\ FULL_SIMP_TAC std_ss [mw_ok_n2mw,mw2n_n2mw] 2965 \\ STRIP_TAC THEN1 SIMP_TAC std_ss [mw_subv_def,mw_ok_mw_fix] 2966 \\ CONV_TAC (RAND_CONV (BINOP_CONV (ONCE_REWRITE_CONV [GSYM mw2n_n2mw]))) 2967 \\ MATCH_MP_TAC mw_subv_thm 2968 \\ `Num (ABS i) MOD k < k` by FULL_SIMP_TAC std_ss [LESS_MOD] 2969 \\ FULL_SIMP_TAC std_ss [mw2n_n2mw] \\ STRIP_TAC THEN1 DECIDE_TAC 2970 \\ MATCH_MP_TAC mw2n_LESS 2971 \\ FULL_SIMP_TAC std_ss [mw_ok_n2mw,mw2n_n2mw] \\ DECIDE_TAC); 2972 2973val n2mw_EQ_NIL = prove( 2974 ``(n2mw n = []) <=> (n = 0)``, 2975 Cases_on `n` THEN1 EVAL_TAC \\ ONCE_REWRITE_TAC [n2mw_def] 2976 \\ SIMP_TAC std_ss [ADD1,NOT_CONS_NIL]); 2977 2978val mwi_divmod_thm = store_thm("mwi_divmod_thm", 2979 ``!i j. j <> 0 ==> 2980 (mwi_divmod (i2mw i) ((i2mw j):bool # 'a word list) = 2981 (T,i2mw (i / j),i2mw (i % j)))``, 2982 NTAC 3 STRIP_TAC \\ SIMP_TAC std_ss [i2mw_def,mwi_divmod_def,n2mw_NIL,Num_ABS_EQ_0] 2983 \\ `(?r1 r2 r3. mw_div (n2mw (Num (ABS i))) (n2mw (Num (ABS j))) = 2984 (r1:'a word list,r2,r3))` 2985 by METIS_TAC [PAIR] \\ FULL_SIMP_TAC std_ss [LET_DEF] 2986 \\ `mw2n (n2mw (Num (ABS j))) <> 0` by (FULL_SIMP_TAC std_ss [mw2n_n2mw] \\ intLib.COOPER_TAC) 2987 \\ MP_TAC (mw_div_thm |> Q.SPECL [`n2mw (Num (ABS i))`,`n2mw (Num (ABS j))`]) 2988 \\ ASM_REWRITE_TAC [] \\ SIMP_TAC std_ss [] \\ STRIP_TAC 2989 \\ FULL_SIMP_TAC std_ss [mw2n_n2mw,n2mw_mw2n,mw_addv_lemma, 2990 n2mw_EQ_NIL,mw_subv_lemma] 2991 \\ STRIP_ASSUME_TAC (Q.SPEC `i` INT_NUM_CASES) 2992 \\ STRIP_ASSUME_TAC (Q.SPEC `j` INT_NUM_CASES) 2993 \\ FULL_SIMP_TAC (srw_ss()) [integerTheory.INT_ABS_NUM,ABS_NEG,NEG_DIV,NEG_MOD] 2994 \\ Cases_on `n MOD n' = 0` \\ FULL_SIMP_TAC std_ss [mw2n_n2mw] 2995 \\ `0 < n` by DECIDE_TAC \\ FULL_SIMP_TAC std_ss [mw2n_n2mw, 2996 n2mw_EQ_NIL,EVAL ``n2mw 0``]); 2997 2998 2999(* converting into decimal form *) 3000 3001val int_to_str_def = Define ` 3002 int_to_str i = 3003 (if i < 0 then "~" else "") ++ num_to_dec_string (Num (ABS i))`; 3004 3005val num_to_dec_string_unroll = prove( 3006 ``!n. num_to_dec_string n = 3007 SNOC (CHR (48 + n MOD 10)) 3008 (if n < 10 then [] else num_to_dec_string (n DIV 10))``, 3009 SIMP_TAC std_ss [num_to_dec_string_def,n2s_def] 3010 \\ SIMP_TAC std_ss [Once numposrepTheory.n2l_def] \\ SRW_TAC [] [] 3011 THEN1 (Cases_on `(n=0) \/ (n=1) \/ (n=2) \/ (n=3) \/ (n=4) \/ 3012 (n=5) \/ (n=6) \/ (n=7) \/ (n=8) \/ (n=9)` 3013 \\ FULL_SIMP_TAC std_ss [] \\ EVAL_TAC \\ `F` by DECIDE_TAC) 3014 \\ `n MOD 10 < 10` by FULL_SIMP_TAC std_ss [] 3015 \\ Q.ABBREV_TAC `k = n MOD 10` 3016 THEN1 (Cases_on `(k=0) \/ (k=1) \/ (k=2) \/ (k=3) \/ (k=4) \/ 3017 (k=5) \/ (k=6) \/ (k=7) \/ (k=8) \/ (k=9)` 3018 \\ FULL_SIMP_TAC std_ss [] \\ EVAL_TAC \\ `F` by DECIDE_TAC)); 3019 3020val mw_to_dec_def = tDefine "mw_to_dec" ` 3021 mw_to_dec (xs:'a word list) = 3022 if dimword (:'a) <= 10 then ([],F) else 3023 let (qs,r,c1) = mw_simple_div 0w (REVERSE xs) 10w in 3024 let qs = mw_fix (REVERSE qs) in 3025 if LENGTH qs = 0 then 3026 ([r + 48w],c1) 3027 else 3028 let (result,c2) = mw_to_dec qs in 3029 (result ++ [r + 48w],c1 /\ c2)` 3030 (WF_REL_TAC `measure (mw2n)` \\ REPEAT STRIP_TAC 3031 \\ Q.PAT_X_ASSUM `(xx,yy) = zz` (ASSUME_TAC o GSYM) 3032 \\ FULL_SIMP_TAC std_ss [GSYM NOT_LESS] 3033 \\ `0x0w <+ 10w` by FULL_SIMP_TAC (srw_ss()) [WORD_LO] 3034 \\ IMP_RES_TAC mw_simple_div_thm 3035 \\ FULL_SIMP_TAC (srw_ss()) [REVERSE_REVERSE,mw2n_mw_fix] 3036 \\ FULL_SIMP_TAC std_ss [DIV_LT_X,mw_fix_NIL] 3037 \\ Q.PAT_X_ASSUM `10 < dimword (:'a)` ASSUME_TAC 3038 \\ FULL_SIMP_TAC std_ss [DIV_EQ_X,NOT_LESS] 3039 \\ DECIDE_TAC); 3040 3041val mwi_to_dec_def = Define ` 3042 mwi_to_dec (s,xs) = 3043 let sign = (if s then [126w] else []) in 3044 let (rest,c) = mw_to_dec xs in 3045 (sign ++ rest,c)` 3046 3047val mw_to_dec_thm = store_thm("mw_to_dec_thm", 3048 ``!(xs:'a word list). 3049 10 < dimword (:'a) ==> 3050 (mw_to_dec xs = (MAP (n2w o ORD) (num_to_dec_string (mw2n xs)),T))``, 3051 STRIP_TAC \\ STRIP_ASSUME_TAC (SPEC_ALL k2mw_EXISTS) 3052 \\ Q.PAT_X_ASSUM `xs = bb` (fn th => ONCE_REWRITE_TAC [th]) 3053 \\ POP_ASSUM MP_TAC \\ Q.SPEC_TAC (`xs`,`xs`) 3054 \\ completeInduct_on `k` \\ ONCE_REWRITE_TAC [mw_to_dec_def] 3055 \\ FULL_SIMP_TAC std_ss [GSYM NOT_LESS,LET_DEF] \\ STRIP_TAC 3056 \\ `?x1 x2 x3. mw_simple_div 0x0w (REVERSE (k2mw (LENGTH (xs:'a word list)) k)) 0xAw = (x1,x2:'a word,x3)` by METIS_TAC [PAIR] 3057 \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 3058 \\ `0x0w <+ 10w` by FULL_SIMP_TAC (srw_ss()) [WORD_LO] 3059 \\ IMP_RES_TAC mw_simple_div_thm 3060 \\ FULL_SIMP_TAC std_ss [REVERSE_REVERSE] 3061 \\ IMP_RES_TAC mw2n_k2mw \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w] 3062 \\ Q.PAT_X_ASSUM `10 < dimword (:'a)` ASSUME_TAC \\ FULL_SIMP_TAC std_ss [] 3063 \\ FULL_SIMP_TAC std_ss [PULL_FORALL,AND_IMP_INTRO] 3064 \\ FULL_SIMP_TAC std_ss [mw_fix_NIL] 3065 \\ ONCE_REWRITE_TAC [num_to_dec_string_unroll] 3066 \\ `(k DIV 10 = 0) = k < 10` by FULL_SIMP_TAC std_ss [DIV_EQ_X,NOT_LESS] 3067 \\ FULL_SIMP_TAC std_ss [] 3068 \\ Cases_on `k < 10` \\ FULL_SIMP_TAC std_ss [] THEN1 3069 (EVAL_TAC \\ `48 + k < 256` by DECIDE_TAC 3070 \\ Cases_on `x2` \\ FULL_SIMP_TAC (srw_ss()) [SNOC,MAP,word_add_n2w] 3071 \\ FULL_SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC]) 3072 \\ Q.PAT_X_ASSUM `!m. bbb` (MP_TAC o Q.SPECL [`k DIV 10`,`(mw_fix (REVERSE x1))`]) 3073 \\ MATCH_MP_TAC (METIS_PROVE [] ``b /\ (c ==> d) ==> ((b ==> c) ==> d)``) 3074 \\ STRIP_TAC THEN1 3075 (FULL_SIMP_TAC std_ss [DIV_LT_X,NOT_LESS] 3076 \\ `0 < dimwords (LENGTH x1) (:'a)` by FULL_SIMP_TAC std_ss [ZERO_LT_dimwords] 3077 \\ STRIP_TAC THEN1 DECIDE_TAC 3078 \\ MP_TAC (Q.SPEC `(mw_fix (REVERSE x1))` mw2n_lt) 3079 \\ FULL_SIMP_TAC std_ss [mw2n_mw_fix,DIV_LT_X]) 3080 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3081 \\ `(k2mw (LENGTH (mw_fix (REVERSE x1))) (k DIV 10)) = 3082 (mw_fix (REVERSE x1))` by 3083 (MP_TAC (Q.SPEC `mw_fix (REVERSE x1)` k2mw_mw2n) 3084 \\ FULL_SIMP_TAC std_ss [mw2n_mw_fix]) 3085 \\ FULL_SIMP_TAC std_ss [] 3086 \\ Cases_on `x2` \\ FULL_SIMP_TAC std_ss [mw2n_mw_fix] 3087 \\ FULL_SIMP_TAC (srw_ss()) [word_add_n2w] 3088 \\ `k MOD 10 < 10` by FULL_SIMP_TAC (srw_ss()) [] 3089 \\ `48 + k MOD 10 < 256` by DECIDE_TAC 3090 \\ FULL_SIMP_TAC (srw_ss()) [] 3091 \\ FULL_SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC]); 3092 3093val mwi_to_dec_thm = store_thm("mwi_to_dec_thm", 3094 ``10 < dimword (:'a) /\ ((xs = []) ==> ~s) /\ mw_ok xs ==> 3095 (mwi_to_dec (s,xs:'a word list) = 3096 (MAP (n2w o ORD) (int_to_str (mw2i (s,xs))),T))``, 3097 SIMP_TAC std_ss [mwi_to_dec_def,int_to_str_def,i2mw_def,LET_DEF] \\ STRIP_TAC 3098 \\ `mw2i (s,xs) < 0 <=> s` by 3099 (Cases_on `xs = []` \\ FULL_SIMP_TAC std_ss [] THEN1 EVAL_TAC 3100 \\ Cases_on `s` \\ SIMP_TAC std_ss [mw2i_def] 3101 \\ `mw2n xs <> 0` by 3102 (ASM_SIMP_TAC std_ss [GSYM mw_fix_NIL,mw_ok_mw_fix_ID]) 3103 \\ intLib.COOPER_TAC) 3104 \\ FULL_SIMP_TAC std_ss [] 3105 \\ IMP_RES_TAC mw_to_dec_thm 3106 \\ FULL_SIMP_TAC std_ss [] 3107 \\ `Num (ABS (mw2i (s,xs))) = mw2n xs` by 3108 (Cases_on `s` \\ SIMP_TAC std_ss [mw2i_def] \\ intLib.COOPER_TAC) 3109 \\ Cases_on `s` \\ FULL_SIMP_TAC std_ss [MAP,MAP_APPEND,APPEND,mw2n_n2mw,CONS_11] 3110 \\ EVAL_TAC); 3111 3112 3113(* top-level entry point *) 3114 3115val _ = Hol_datatype `mw_op = Add | Sub | Mul | Div | Mod | Lt | Eq | Dec`; 3116 3117val int_op_def = Define ` 3118 (int_op Add i j = i + j) /\ 3119 (int_op Sub i j = i - j) /\ 3120 (int_op Mul i j = i * j) /\ 3121 (int_op Div i j = i / j) /\ 3122 (int_op Mod i j = i % j) /\ 3123 (int_op Lt i j = if i < j then 1 else 0) /\ 3124 (int_op Eq i j = if i = j then 1 else 0:int) /\ 3125 (int_op Dec i j = 0)`; (* decimal representation returned separately *) 3126 3127val mwi_op_def = Define ` 3128 (mwi_op Add s_xs t_ys = mwi_add s_xs t_ys) /\ 3129 (mwi_op Sub s_xs t_ys = mwi_sub s_xs t_ys) /\ 3130 (mwi_op Mul s_xs t_ys = mwi_mul s_xs t_ys) /\ 3131 (mwi_op Div s_xs t_ys = mwi_div s_xs t_ys) /\ 3132 (mwi_op Mod s_xs t_ys = mwi_mod s_xs t_ys) /\ 3133 (mwi_op Lt s_xs t_ys = i2mw (if mwi_lt s_xs t_ys then 1 else 0)) /\ 3134 (mwi_op Eq s_xs t_ys = i2mw (if mwi_eq s_xs t_ys then 1 else 0)) /\ 3135 (mwi_op Dec s_xs t_ys = (F,[]))`; 3136 3137val mwi_op_thm = store_thm("mwi_op_thm", 3138 ``!op i j. 3139 ((op = Div) \/ (op = Mod) ==> j <> 0) ==> 3140 (mwi_op op (i2mw i) (i2mw j) = i2mw (int_op op i j))``, 3141 Cases \\ FULL_SIMP_TAC (srw_ss()) [int_op_def,mwi_op_def, 3142 mwi_add_thm,mwi_sub_thm,mwi_mul_thm,mwi_divmod_thm,mwi_lt_def, 3143 mwi_eq_def,mwi_compare_thm,mwi_div_def,mwi_mod_def] \\ REPEAT STRIP_TAC 3144 \\ SIMP_TAC std_ss [EVAL ``i2mw 0``] 3145 \\ Cases_on `i < j` \\ FULL_SIMP_TAC std_ss [] 3146 \\ `i <> j` by intLib.COOPER_TAC \\ FULL_SIMP_TAC std_ss []); 3147 3148 3149(* extra *) 3150 3151val LESS_EQ_LENGTH = store_thm("LESS_EQ_LENGTH", 3152 ``!xs n. n <= LENGTH xs ==> ?xs1 xs2. (xs = xs1 ++ xs2) /\ (LENGTH xs1 = n)``, 3153 Induct \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL] 3154 \\ Cases_on `n` \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_NIL] 3155 \\ REPEAT STRIP_TAC \\ RES_TAC \\ FULL_SIMP_TAC std_ss [] 3156 \\ Q.LIST_EXISTS_TAC [`h::xs1`,`xs2`] \\ FULL_SIMP_TAC (srw_ss()) []); 3157 3158val LENGTH_mw_add = store_thm("LENGTH_mw_add", 3159 ``!xs1 ys c qs1 c1. (mw_add xs1 ys c = (qs1,c1)) ==> (LENGTH xs1 = LENGTH qs1)``, 3160 Induct \\ FULL_SIMP_TAC std_ss [mw_add_def,LET_DEF,single_add_def] 3161 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ REPEAT STRIP_TAC 3162 \\ Q.ABBREV_TAC `t = (dimword (:'a) <= w2n h + w2n (HD ys) + b2n c)` 3163 \\ `?x1 x2. mw_add xs1 (TL ys) t = (x1,x2)` by METIS_TAC [PAIR] 3164 \\ RES_TAC \\ Cases_on `qs1` \\ FULL_SIMP_TAC (srw_ss()) []); 3165 3166val LENGTH_mw_fix_IMP = store_thm("LENGTH_mw_fix_IMP", 3167 ``(LENGTH xs = LENGTH ys) ==> 3168 LENGTH (mw_fix xs) <= LENGTH ys``, 3169 METIS_TAC [LENGTH_mw_fix]); 3170 3171val LENGTH_mw_subv = store_thm("LENGTH_mw_subv", 3172 ``!ys xs. LENGTH xs <= LENGTH ys ==> (LENGTH (mw_subv ys xs) <= LENGTH ys)``, 3173 REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [mw_subv_def,LET_DEF] 3174 \\ MATCH_MP_TAC LENGTH_mw_fix_IMP \\ IMP_RES_TAC LESS_EQ_LENGTH 3175 \\ Cases_on `mw_sub ys xs T` 3176 \\ IMP_RES_TAC LENGTH_mw_sub \\ FULL_SIMP_TAC std_ss []); 3177 3178val mw_add_F = store_thm("mw_add_F", 3179 ``!xs2. (mw_add xs2 (MAP (\x. 0x0w) xs2) F = (xs2,F))``, 3180 Induct \\ FULL_SIMP_TAC (srw_ss()) [mw_add_def,MAP,single_add_def, 3181 LET_DEF,b2w_def,b2n_def,GSYM NOT_LESS,w2n_lt]); 3182 3183val LENGTH_mw_addv = store_thm("LENGTH_mw_addv", 3184 ``LENGTH ys <= LENGTH xs ==> 3185 LENGTH (mw_addv xs ys F) <= LENGTH xs + LENGTH ys``, 3186 REPEAT STRIP_TAC \\ IMP_RES_TAC LESS_EQ_LENGTH 3187 \\ FULL_SIMP_TAC std_ss [mw_addv_EQ_mw_add,LET_DEF] 3188 \\ `?ts1 t1. mw_add xs1 ys F = (ts1,t1)` by METIS_TAC [PAIR] 3189 \\ `?ts2 t2. mw_add xs2 (MAP (\x. 0x0w) xs2) t1 = (ts2,t2)` by METIS_TAC [PAIR] 3190 \\ FULL_SIMP_TAC std_ss [] 3191 \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [] THEN1 3192 (Cases_on `xs1` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,mw_add_def] 3193 \\ Cases_on `t1` \\ FULL_SIMP_TAC std_ss [mw_add_F,LENGTH_APPEND] 3194 \\ Cases_on `ts1` \\ FULL_SIMP_TAC (srw_ss()) [LENGTH]) 3195 \\ IMP_RES_TAC LENGTH_mw_add 3196 \\ Cases_on `t2` \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC); 3197 3198val LENGTH_mw_mul = store_thm("LENGTH_mw_mul", 3199 ``!xs ys zs. 3200 (LENGTH zs = LENGTH ys) ==> 3201 (LENGTH (mw_mul xs ys zs) = LENGTH xs + LENGTH ys)``, 3202 Induct \\ FULL_SIMP_TAC std_ss [mw_mul_def,LENGTH,LET_DEF] 3203 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3204 \\ `LENGTH (mw_mul_pass h ys zs 0w) = LENGTH ys + 1` by 3205 FULL_SIMP_TAC std_ss [LENGTH_mw_mul_pass] 3206 \\ Cases_on `mw_mul_pass h ys zs 0x0w` 3207 \\ FULL_SIMP_TAC std_ss [LENGTH,TL,ADD1] \\ DECIDE_TAC); 3208 3209val LESS_EQ_LENGTH_ALT = store_thm("LESS_EQ_LENGTH_ALT", 3210 ``!xs n. n <= LENGTH xs ==> ?ys1 ys2. (xs = ys1 ++ ys2) /\ (LENGTH ys2 = n)``, 3211 HO_MATCH_MP_TAC SNOC_INDUCT \\ REPEAT STRIP_TAC 3212 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL,APPEND_NIL,LENGTH_SNOC] 3213 \\ Cases_on `n` \\ FULL_SIMP_TAC std_ss [LENGTH_NIL,APPEND_NIL] 3214 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC] 3215 \\ Q.LIST_EXISTS_TAC [`ys1`,`SNOC x ys2`] 3216 \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC,SNOC_APPEND]); 3217 3218val LENGTH_mw_div_aux = store_thm("LENGTH_mw_div_aux", 3219 ``!ts1 ts2 ys qs rs. 3220 (mw_div_aux ts1 ts2 ys = (qs,rs)) /\ (LENGTH ts2 = LENGTH ys) ==> 3221 (LENGTH rs = LENGTH ys) /\ (LENGTH qs = LENGTH ts1)``, 3222 HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC 3223 THEN1 (SIMP_TAC std_ss [Once mw_div_aux_def]) 3224 \\ NTAC 7 STRIP_TAC 3225 \\ SIMP_TAC std_ss [Once mw_div_aux_def,NOT_SNOC_NIL,LAST_SNOC,FRONT_SNOC] 3226 \\ FULL_SIMP_TAC std_ss [LET_DEF] 3227 \\ Q.ABBREV_TAC `q = (mw_div_adjust 3228 (mw_div_guess (REVERSE (x::ts2)) (REVERSE ys)) 3229 (x::ts2) ys)` 3230 \\ Cases_on `mw_sub (x::ts2) (mw_mul_by_single q ys) T` 3231 \\ FULL_SIMP_TAC std_ss [] 3232 \\ IMP_RES_TAC LENGTH_mw_sub 3233 \\ `(q' = []) \/ ?y ys2. q' = SNOC y ys2` by METIS_TAC [SNOC_CASES] 3234 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,LENGTH_SNOC,FRONT_SNOC] 3235 \\ Cases_on `mw_div_aux ts1 ys2 ys` \\ FULL_SIMP_TAC std_ss [] 3236 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 3237 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ FULL_SIMP_TAC std_ss [LENGTH] 3238 \\ METIS_TAC []); 3239 3240 3241(* combined mul_by_single *) 3242 3243val mw_mul_by_single2_def = Define ` 3244 (mw_mul_by_single2 x1 x2 [] k1 k2 = [k2]) /\ 3245 (mw_mul_by_single2 x1 x2 (y::ys) k1 k2 = 3246 let (y1,k1) = single_mul_add x1 y k1 0w in 3247 let (y2,k2) = single_mul_add x2 y1 k2 0w in 3248 y2 :: mw_mul_by_single2 x1 x2 ys k1 k2)`; 3249 3250val k2mw_SUC_0 = prove( 3251 ``k2mw (SUC n) 0 = 0w :: k2mw n 0``, 3252 SRW_TAC [] [k2mw_def,ZERO_DIV]); 3253 3254val mw_mul_pass_NOT_NIL = prove( 3255 ``!xs ys r x. mw_mul_pass x xs ys r <> []``, 3256 Cases \\ SIMP_TAC (srw_ss()) [mw_mul_pass_def,LET_DEF] 3257 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 3258 \\ SIMP_TAC (srw_ss()) []); 3259 3260val mw_mul_by_single2_thm = prove( 3261 ``!ys x1 x2 k1 k2. 3262 mw_mul_by_single2 x1 x2 ys k1 k2 = 3263 let ys = mw_mul_pass x1 ys (k2mw (LENGTH ys) 0) k1 in 3264 let ys = mw_mul_pass x2 (FRONT ys) (k2mw (LENGTH (FRONT ys)) 0) k2 in 3265 ys``, 3266 Induct THEN1 (EVAL_TAC \\ SIMP_TAC std_ss []) 3267 \\ FULL_SIMP_TAC std_ss [LET_DEF] \\ REPEAT STRIP_TAC 3268 \\ SIMP_TAC (srw_ss()) [mw_mul_pass_def,LENGTH,k2mw_SUC_0] 3269 \\ FULL_SIMP_TAC std_ss [mw_mul_by_single2_def,LET_DEF] 3270 \\ Cases_on `single_mul_add x1 h k1 0x0w` 3271 \\ FULL_SIMP_TAC (srw_ss()) [FRONT_DEF,mw_mul_pass_NOT_NIL] 3272 \\ SIMP_TAC (srw_ss()) [mw_mul_pass_def,LENGTH,k2mw_SUC_0,LET_DEF] 3273 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 3274 \\ SIMP_TAC std_ss []) |> Q.SPECL [`ys`,`x1`,`x2`,`0w`,`0w`] 3275 |> SIMP_RULE std_ss [GSYM mw_mul_by_single_def,LET_DEF]; 3276 3277val _ = save_thm("mw_mul_by_single2_thm",mw_mul_by_single2_thm); 3278 3279(* calc only top three results of mw_mul_pass *) 3280 3281val mw_mul_pass_top_def = Define ` 3282 (mw_mul_pass_top x [] (k,k1,k2) = (k,k1,k2)) /\ 3283 (mw_mul_pass_top x (y::ys) (k,k1,k2) = 3284 let (y1,k) = single_mul_add x y k 0w in 3285 mw_mul_pass_top x ys (k,y1,k1))`; 3286 3287val k2mw_LENGTH_0 = store_thm("k2mw_LENGTH_0", 3288 ``!ys. (k2mw (LENGTH ys) 0) = MAP (K 0w) ys``, 3289 Induct \\ EVAL_TAC \\ 3290 SIMP_TAC std_ss [LEN_LENGTH_LEM,GSYM ADD1,k2mw_def] \\ 3291 FULL_SIMP_TAC std_ss [MATCH_MP ZERO_DIV ZERO_LT_dimword]); 3292 3293val mw_mul_pass_top_lemma = prove( 3294 ``!ys k1 k2 k3 x. 3295 ((let (x1,x2,x3) = mw_mul_pass_top x ys (k1,k2,k3) in [x1;x2;x3]) = 3296 TAKE 3 (REVERSE (mw_mul_pass x ys (MAP (K 0w) ys) k1) ++ [k2;k3]))``, 3297 Induct THEN1 (EVAL_TAC \\ SIMP_TAC std_ss []) 3298 \\ ONCE_REWRITE_TAC [mw_mul_pass_def,mw_mul_pass_top_def] 3299 \\ FULL_SIMP_TAC std_ss [HD,MAP,TL] \\ REPEAT STRIP_TAC 3300 \\ Cases_on `single_mul_add x h k1 0x0w` 3301 \\ FULL_SIMP_TAC std_ss [LET_DEF,REVERSE_DEF,GSYM APPEND_ASSOC,APPEND] 3302 \\ Cases_on `REVERSE (mw_mul_pass x ys (MAP (K 0x0w) ys) r)` THEN1 3303 (FULL_SIMP_TAC std_ss [REVERSE_EQ_NIL] 3304 \\ FULL_SIMP_TAC std_ss [GSYM LENGTH_NIL,LENGTH_mw_mul_pass]) 3305 \\ Cases_on `t` \\ EVAL_TAC \\ Cases_on `t'` \\ EVAL_TAC) 3306 |> Q.SPECL [`ys`,`0w`] |> GEN_ALL 3307 |> SIMP_RULE std_ss [GSYM k2mw_LENGTH_0,GSYM mw_mul_by_single_def]; 3308 3309val mw_mul_pass_top_thm = store_thm("mw_mul_pass_top_thm", 3310 ``1 < LENGTH ys ==> 3311 (mw_mul_pass_top x ys (0w,0w,0w) = 3312 (LAST (mw_mul_by_single x ys), 3313 LAST (BUTLAST (mw_mul_by_single x ys)), 3314 LAST (BUTLAST (BUTLAST (mw_mul_by_single x ys)))))``, 3315 STRIP_TAC 3316 \\ ASSUME_TAC (mw_mul_pass_top_lemma |> Q.SPECL [`ys`,`0w`,`0w`,`x`]) 3317 \\ Cases_on `mw_mul_pass_top x ys (0x0w,0x0w,0x0w)` 3318 \\ Cases_on `r` \\ FULL_SIMP_TAC std_ss [LET_DEF] 3319 \\ `2 < LENGTH (mw_mul_by_single x ys)` by 3320 (FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single] \\ DECIDE_TAC) 3321 \\ `(mw_mul_by_single x ys = []) \/ 3322 ?y ys2. mw_mul_by_single x ys = SNOC y ys2` by METIS_TAC [SNOC_CASES] 3323 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_SNOC,ADD1] 3324 \\ `(ys2 = []) \/ ?y3 ys3. ys2 = SNOC y3 ys3` by METIS_TAC [SNOC_CASES] 3325 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_SNOC,ADD1] 3326 \\ `(ys3 = []) \/ ?y4 ys4. ys3 = SNOC y4 ys4` by METIS_TAC [SNOC_CASES] 3327 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_SNOC,ADD1] 3328 \\ FULL_SIMP_TAC bool_ss [REVERSE_SNOC,TAKE,LAST_SNOC,FRONT_SNOC, 3329 DECIDE ``3 = SUC (SUC (SUC 0))``,APPEND,CONS_11]); 3330 3331(* extra lemmas about mw_addv special case *) 3332 3333val single_add_lemma = prove( 3334 ``!h. single_add h 0x0w F = (h,F)``, 3335 Cases \\ FULL_SIMP_TAC std_ss [single_add_def,word_add_n2w,b2w_def, 3336 b2n_def,w2n_n2w,ZERO_LT_dimword,GSYM NOT_LESS]); 3337 3338val mw_addv_NIL_F = prove( 3339 ``!xs. mw_addv xs [] F = xs``, 3340 Induct THEN1 EVAL_TAC 3341 \\ ASM_SIMP_TAC std_ss [mw_addv_def,LET_DEF,single_add_lemma,CONS_11]); 3342 3343val mw_addv_CONS_NIL_T = prove( 3344 ``mw_addv (x::xs) [] T = 3345 if x = ~0w then 0w::mw_addv xs [] T else (x+1w)::xs``, 3346 Cases_on `x = ~0x0w` 3347 \\ ASM_SIMP_TAC std_ss [mw_addv_def,LET_DEF, 3348 EVAL ``single_add (~0x0w) (0x0w) T``] 3349 >- ( assume_tac ZERO_LT_dimword \\ simp[] ) 3350 \\ `single_add x 0x0w T = (x+1w,F)` by 3351 (Cases_on `x` \\ FULL_SIMP_TAC std_ss [single_add_def,word_add_n2w,b2w_def, 3352 b2n_def,w2n_n2w,ZERO_LT_dimword,GSYM NOT_LESS,n2w_11] 3353 \\ fs[word_2comp_def]) 3354 \\ ASM_SIMP_TAC std_ss [mw_addv_NIL_F]); 3355 3356val mw_addv_NIL = save_thm("mw_addv_NIL",LIST_CONJ 3357 [EVAL ``mw_addv [] [] T``,mw_addv_NIL_F,GEN_ALL mw_addv_CONS_NIL_T]); 3358 3359 3360(* verify implementation for single_div (to be used on arch without div) *) 3361 3362val num_div_loop_def = Define ` 3363 num_div_loop (k:num,n:num,m:num,i:num) = 3364 if k = 0 then (m,i) else 3365 let n = n DIV 2 in 3366 let m = m * 2 in 3367 if i < n then 3368 num_div_loop (k-1,n,m,i) 3369 else 3370 num_div_loop (k-1,n,m+1,i-n)` 3371 3372val num_div_loop_lemma = prove( 3373 ``!k i n m. 3374 i < n * 2 ** k /\ 0 < n ==> 3375 (num_div_loop (k,n * 2 ** k,m,i) = (m * 2 ** k + i DIV n,i MOD n))``, 3376 Induct 3377 \\ simp [Once num_div_loop_def,arithmeticTheory.LESS_DIV_EQ_ZERO] 3378 \\ rw [] \\ fs [EXP,ONCE_REWRITE_RULE [MULT_COMM] MULT_DIV] 3379 \\ fs [RIGHT_ADD_DISTRIB,MOD_SUB,DIV_SUB] 3380 \\ qsuff_tac `2 ** k <= i DIV n` THEN1 decide_tac 3381 \\ fs [X_LE_DIV]); 3382 3383val num_div_loop_thm = save_thm("num_div_loop_thm", 3384 num_div_loop_lemma 3385 |> Q.SPECL [`k`,`i`,`n`,`0`] |> SIMP_RULE std_ss []); 3386 3387val single_div_loop_def = Define ` 3388 single_div_loop (k:'a word,ns:'a word list,m:'a word,is:'a word list) = 3389 if k = 0w then (m,is) else 3390 let ns = mw_shift ns in 3391 let m = m << 1 in 3392 if mw_cmp is ns = SOME T then 3393 single_div_loop (k-1w,ns,m,is) 3394 else 3395 let m = m + 1w in 3396 let (is,_) = mw_sub is ns T in 3397 single_div_loop (k-1w,ns,m,is)` 3398 3399val single_div_full_def = Define ` 3400 single_div_full m2 (m1:'a word) n = 3401 let (m,is) = single_div_loop (n2w (dimindex (:'a)),[0w;n],0w,[m1;m2]) in 3402 (m, HD is)`; 3403 3404fun drule th = 3405 first_assum(mp_tac o MATCH_MP (ONCE_REWRITE_RULE[GSYM AND_IMP_INTRO] th)) 3406 3407val impl_tac = match_mp_tac IMP_IMP \\ conj_tac 3408 3409val single_div_loop_thm = prove( 3410 ``!k ns m is t qs. 3411 (single_div_loop (n2w k,ns,m,is) = (t,qs:'a word list)) /\ 3412 k < dimword (:'a) /\ 3413 k <= dimindex (:'a) /\ (w2n m < 2 ** (dimindex (:'a) - k)) /\ 3414 (LENGTH ns = 2) /\ (LENGTH is = 2) ==> 3415 (num_div_loop (k,mw2n ns,w2n m,mw2n is) = (w2n t, mw2n qs)) /\ 3416 (LENGTH qs = 2)``, 3417 Induct THEN1 (fs [Once num_div_loop_def,Once single_div_loop_def]) 3418 \\ NTAC 6 strip_tac 3419 \\ qpat_x_assum `single_div_loop _ = _` mp_tac 3420 \\ once_rewrite_tac [single_div_loop_def,num_div_loop_def] 3421 \\ fs [mw_shift_thm,LENGTH_mw_shift,mw_cmp_thm] 3422 \\ Cases_on `mw2n is < mw2n ns DIV 2` \\ fs [] 3423 THEN1 3424 (fs [ADD1,GSYM word_add_n2w] \\ strip_tac 3425 \\ first_x_assum drule 3426 \\ fs [LENGTH_mw_shift,mw_shift_thm] 3427 \\ impl_tac 3428 THEN1 3429 (Cases_on `m` \\ fs [WORD_MUL_LSL,word_mul_n2w] 3430 \\ `2 * n < dimword (:'a)` by 3431 (fs [LESS_EQ_EXISTS] \\ rfs [dimword_def,EXP_ADD] 3432 \\ Cases_on `2 ** k` \\ fs [] 3433 \\ Cases_on `n'` \\ fs [MULT_CLAUSES]) 3434 \\ fs [LESS_EQ_EXISTS] \\ rfs [] 3435 \\ fs [EXP,GSYM ADD1]) 3436 \\ sg `w2n (m << 1) = 2 * w2n m` \\ fs [] 3437 \\ Cases_on `m` \\ fs [WORD_MUL_LSL,word_mul_n2w] 3438 \\ fs [LESS_EQ_EXISTS] \\ rfs [dimword_def] 3439 \\ fs [EXP,GSYM ADD1,ADD_CLAUSES,EXP_ADD] 3440 \\ Cases_on `2 ** k` \\ fs [] 3441 \\ Cases_on `n'` \\ fs [MULT_CLAUSES]) 3442 \\ fs [] \\ Cases_on `(mw_sub is (mw_shift ns) T)` \\ fs [] 3443 \\ fs [ADD1,GSYM word_add_n2w] 3444 \\ strip_tac 3445 \\ first_x_assum drule 3446 \\ fs [LENGTH_mw_shift,mw_shift_thm] 3447 \\ impl_tac THEN1 3448 (imp_res_tac LENGTH_mw_sub \\ fs [LENGTH_mw_shift] 3449 \\ Cases_on `m` \\ fs [WORD_MUL_LSL,word_mul_n2w,word_add_n2w] 3450 \\ fs [LESS_EQ_EXISTS] \\ rfs [dimword_def,EXP_ADD] 3451 \\ sg `2 * n + 1 < 2 * (2 ** k * 2 ** p) /\ 3452 2 * n + 1 < 2 * 2 ** p` \\ fs [] 3453 \\ Cases_on `2 ** k` \\ fs [] 3454 \\ Cases_on `n'` \\ fs [MULT_CLAUSES]) 3455 \\ sg `w2n (m << 1 + 1w) = 2 * w2n m + 1` \\ fs [] 3456 THEN1 3457 (Cases_on `m` \\ fs [WORD_MUL_LSL,word_mul_n2w,word_add_n2w] 3458 \\ fs [LESS_EQ_EXISTS] \\ rfs [dimword_def,EXP_ADD] 3459 \\ Cases_on `2 ** k` \\ fs [] 3460 \\ Cases_on `n'` \\ fs [MULT_CLAUSES]) 3461 \\ sg `mw2n q = mw2n is - mw2n ns DIV 2` \\ fs [] 3462 \\ `q = FST (mw_sub is (mw_shift ns) T)` by fs [] 3463 \\ pop_assum (fn th => fs [th]) 3464 \\ fs [GSYM mw_shift_thm] 3465 \\ match_mp_tac mw_sub_thm 3466 \\ fs [LENGTH_mw_shift]); 3467 3468val mw2n_0 = store_thm("mw2n_0", 3469 ``(mw2n [] = 0) /\ 3470 (mw2n (0w::xs:'a word list) = dimword (:'a) * mw2n xs)``, 3471 fs [mw2n_def]); 3472 3473val HD_eq_n2w_mw2n = store_thm("HD_eq_n2w_mw2n", 3474 ``LENGTH xs <> 0 /\ mw2n xs < dimword (:'a) ==> 3475 (HD xs = n2w (mw2n (xs:'a word list)))``, 3476 Cases_on `xs` \\ fs [mw2n_def] 3477 \\ Cases_on `mw2n t` \\ fs [] 3478 \\ fs [MULT_CLAUSES]); 3479 3480val LESS_2_EXP = store_thm("LESS_2_EXP[simp]", 3481 ``!n. n < 2 ** n``, 3482 Induct \\ fs [EXP]); 3483 3484val single_div_full_thm = store_thm("single_div_full_thm", 3485 ``mw2n [x2;x1] < mw2n [0w;y] ==> 3486 (single_div_full x1 x2 y = single_div x1 x2 y)``, 3487 fs [single_div_full_def] 3488 \\ Cases_on `single_div_loop (n2w (dimindex (:'a)),[0w; y],0w,[x2; x1])` 3489 \\ fs [] \\ strip_tac 3490 \\ drule single_div_loop_thm \\ impl_tac 3491 THEN1 (fs [] \\ fs [dimword_def,LESS_2_EXP]) 3492 \\ rw [] \\ fs [mw2n_0] 3493 \\ `y <> 0w` by (Cases_on `y` \\ fs [mw2n_def] \\ CCONTR_TAC \\ fs []) 3494 \\ `0 < mw2n [0w; y]` by fs [mw2n_0] 3495 \\ fs [dimword_def] 3496 \\ imp_res_tac num_div_loop_thm 3497 \\ pop_assum kall_tac 3498 \\ `0 < mw2n [y]` by (fs [mw2n_0,mw2n_def] \\ Cases_on `y` \\ fs []) 3499 \\ fs [] \\ fs [single_div_def] 3500 \\ Cases_on `x2` \\ Cases_on `x1` \\ Cases_on `y` \\ fs [mw2n_def] 3501 \\ rw [] \\ match_mp_tac HD_eq_n2w_mw2n \\ fs [] 3502 \\ conj_tac >- (strip_tac \\ fs[]) 3503 \\ rpt (qpat_assum `_ = mw2n _` (fn th => fs [GSYM th])) 3504 \\ fs [DIV_LT_X] \\ fs [dimword_def] 3505 \\ match_mp_tac LESS_TRANS 3506 \\ rename1 `k < 2 ** dimindex (:'a)` 3507 \\ qexists_tac `k` \\ fs []); 3508 3509val _ = export_theory(); 3510