1open HolKernel Parse boolLib bossLib; 2open multiwordTheory helperLib; 3open wordsTheory wordsLib addressTheory arithmeticTheory listTheory pairSyntax; 4open addressTheory pairTheory set_sepTheory rich_listTheory integerTheory; 5local open tailrecLib blastLib intLib in end 6 7val _ = new_theory "mc_multiword"; 8 9val REV = Tactical.REVERSE; 10 11fun tailrec_define name tm = let 12 val (def,t1,pre,t2) = tailrecLib.tailrec_define_from_step name tm NONE; 13 val _ = save_thm(name ^ "_def", def) 14 val _ = save_thm(name ^ "_pre_def", pre) 15 in (def,t1,pre,t2) end 16 17val EVEN_BIT0 = bitTheory.BIT0_ODD |> REWRITE_RULE [ODD_EVEN,FUN_EQ_THM] 18 19(* TODO: move? *) 20 21val EVEN_BIT_SUC = Q.store_thm("EVEN_BIT_SUC", 22 `EVEN n ==> !i. (BIT i (SUC n) = if i = 0 then T else BIT i n)`, 23 completeInduct_on`n` \\ rw[] 24 \\ Cases_on`i=0` \\ fs[] 25 >- ( 26 CCONTR_TAC \\ fs[EVEN_BIT0,EVEN] ) 27 \\ Cases_on`i` \\ fs[] 28 \\ fs[GSYM bitTheory.BIT_DIV2] 29 \\ fs[ADD1,ADD_DIV_RWT,EVEN_MOD2]); 30 31val EVEN_MOD = Q.store_thm("EVEN_MOD", 32 `0 < m /\ EVEN m ==> (EVEN (n MOD m) <=> EVEN n)`, 33 strip_tac 34 \\ first_x_assum(CHANGED_TAC o strip_assume_tac o REWRITE_RULE[EVEN_EXISTS]) 35 \\ rw[EVEN_MOD2] 36 \\ rw[MOD_MULT_MOD]); 37 38val word_msb_double_lsr_1 = Q.store_thm("word_msb_double_lsr_1", 39 `word_msb w <=> (w <> (word_lsr (word_add w w) 1))`, 40 rw[d_word_msb,DIV_LE_X] 41 \\ qspecl_then[`w`,`1`](mp_tac o SYM)WORD_MUL_LSL \\ rw[] 42 \\ reverse(rw[EQ_IMP_THM]) 43 >- ( 44 CCONTR_TAC 45 \\ qpat_x_assum`_ <> _`mp_tac \\ simp[] 46 \\ match_mp_tac EQ_SYM 47 \\ match_mp_tac lsl_lsr \\ fs[] ) 48 \\ fsrw_tac[wordsLib.WORD_BIT_EQ_ss][] 49 \\ qexists_tac`dimindex(:'a)-1` 50 \\ assume_tac DIMINDEX_GT_0 51 \\ simp[GSYM word_msb_def,d_word_msb,DIV_LE_X]); 52 53val xor_one_add_one = Q.store_thm("xor_one_add_one", 54 `~w ' 0 ==> (w ?? 1w = w + 1w)`, 55 srw_tac[wordsLib.WORD_BIT_EQ_ss][word_index] 56 \\ Cases_on`i=0` \\ fs[WORD_ADD_BIT0,word_index] 57 \\ Cases_on`w` \\ fs[word_add_n2w,word_index,EVEN_BIT0] 58 \\ simp[GSYM ADD1,EVEN_BIT_SUC]); 59 60val add_one_xor_one = Q.store_thm("add_one_xor_one", 61 `~w ' 0 ==> (w + 1w ?? 1w = w)`, 62 srw_tac[wordsLib.WORD_BIT_EQ_ss][word_index] 63 \\ Cases_on`i=0` \\ fs[WORD_ADD_BIT0,word_index] 64 \\ Cases_on`w` \\ fs[word_add_n2w,word_index,EVEN_BIT0] 65 \\ simp[GSYM ADD1,EVEN_BIT_SUC]); 66 67val one_neq_zero_word = SIMP_CONV(srw_ss())[]``1w = 0w`` 68 69(* -- *) 70 71(* 72 73 This file produces functions that resemble machine code. The 74 functions perform any of the following arithmetic functions over 75 arbitrary size integer inputs. 76 77 + - * div mod compare print-to-dec 78 79*) 80 81(* compare *) 82 83val (mc_cmp_def, _, 84 mc_cmp_pre_def, _) = 85 tailrec_define "mc_cmp" `` 86 (\(l,r10,xs,ys). 87 if r10 = 0x0w then (INR (l,r10,xs,ys),T) 88 else 89 (let r10 = r10 - 0x1w in 90 let cond = w2n r10 < LENGTH xs in 91 let r8 = EL (w2n r10) xs in 92 let cond = cond /\ w2n r10 < LENGTH ys in 93 let r9 = EL (w2n r10) ys 94 in 95 if r8 = r9 then (INL (l-1,r10,xs,ys),cond /\ l <> 0n) 96 else if r8 <+ r9 97 then (let r10 = 0x1w in (INR (l,r10,xs,ys),cond)) 98 else (let r10 = 0x2w in (INR (l,r10,xs,ys),cond)))) 99 :num # �� word # �� word list # �� word list -> (num # �� word # �� word list # �� 100 word list + num # �� word # �� word list # �� word list) # bool``; 101 102val (mc_compare_def, _, 103 mc_compare_pre_def, _) = 104 tailrec_define "mc_compare" `` 105 (\(l,r10,r11,xs,ys). 106 if r10 <+ r11 then (let r10 = 0x1w in (INR (l,r10,xs,ys),T)) 107 else if r11 <+ r10 then (let r10 = 0x2w in (INR (l,r10,xs,ys),T)) 108 else 109 (let cond = mc_cmp_pre (l-1,r10,xs,ys) /\ l <> 0 in 110 let (l,r10,xs,ys) = mc_cmp (l-1,r10,xs,ys) 111 in 112 (INR (l,r10,xs,ys),cond))) 113 :num # �� word # �� word # �� word list # �� word list -> (num # �� 114 word # �� word # �� word list # �� word list + num # �� word # �� word 115 list # �� word list) # bool``; 116 117val mc_header_def = Define ` 118 mc_header (s,xs:�� word list) = n2w (LENGTH xs * 2) + if s then 1w else 0w:�� word`; 119 120val (mc_icompare_def, _, 121 mc_icompare_pre_def, _) = 122 tailrec_define "mc_icompare" `` 123 (\(l,r10,r11,xs,ys). 124 if r10 && 0x1w = 0x0w then 125 if r11 && 0x1w = 0x0w then 126 (let r10 = r10 >>> 1 in 127 let r11 = r11 >>> 1 in 128 let cond = mc_compare_pre (l,r10,r11,xs,ys) in 129 let (l,r10,xs,ys) = mc_compare (l,r10,r11,xs,ys) 130 in 131 (INR (l,r10,xs,ys),cond)) 132 else (let r10 = 0x2w in (INR (l,r10,xs,ys),T)) 133 else if r11 && 0x1w = 0x0w then 134 (let r10 = 0x1w in (INR (l,r10,xs,ys),T)) 135 else 136 (let r10 = r10 >>> 1 in 137 let r11 = r11 >>> 1 in 138 let cond = mc_compare_pre (l,r10,r11,xs,ys) in 139 let (l,r10,xs,ys) = mc_compare (l,r10,r11,xs,ys) 140 in 141 if r10 = 0x0w then (INR (l,r10,xs,ys),cond) 142 else (let r10 = r10 ?? 0x3w in (INR (l,r10,xs,ys),cond)))) 143 :num # �� word # �� word # �� word list # �� word list -> (num # �� 144 word # �� word # �� word list # �� word list + num # �� word # �� word 145 list # �� word list) # bool``; 146 147val cmp2w_def = Define ` 148 (cmp2w NONE = 0w:�� word) /\ 149 (cmp2w (SOME T) = 1w) /\ 150 (cmp2w (SOME F) = 2w)`; 151 152val mc_cmp_thm = prove( 153 ``!xs ys xs1 ys1 l. 154 (LENGTH ys = LENGTH xs) /\ LENGTH (xs:�� word list) < dimword(:��) /\ 155 LENGTH xs <= l ==> 156 mc_cmp_pre (l,n2w (LENGTH xs),xs++xs1,ys++ys1) /\ 157 ?l2. 158 (mc_cmp (l,n2w (LENGTH xs),xs++xs1,ys++ys1) = 159 (l2,cmp2w (mw_cmp xs ys),xs++xs1,ys++ys1)) /\ 160 l <= l2 + LENGTH xs``, 161 HO_MATCH_MP_TAC SNOC_INDUCT \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 162 \\ STRIP_TAC THEN1 163 (REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [mc_cmp_def,Once mc_cmp_pre_def] 164 \\ FULL_SIMP_TAC std_ss [Once mw_cmp_def,cmp2w_def,APPEND]) 165 \\ NTAC 8 STRIP_TAC 166 \\ `(ys = []) \/ ?y ys2. ys = SNOC y ys2` by METIS_TAC [SNOC_CASES] 167 \\ FULL_SIMP_TAC (srw_ss()) [] \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,ADD1] 168 \\ `LENGTH xs < dimword (:��)` by (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 169 \\ RES_TAC \\ ONCE_REWRITE_TAC [mc_cmp_def,mc_cmp_pre_def] 170 \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB] 171 \\ FULL_SIMP_TAC (srw_ss()) [n2w_11,word_add_n2w,LET_DEF] 172 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND] 173 \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.EL_LENGTH_APPEND] 174 \\ Q.PAT_X_ASSUM `LENGTH ys2 = LENGTH xs` (ASSUME_TAC o GSYM) 175 \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.EL_LENGTH_APPEND] 176 \\ reverse IF_CASES_TAC THEN1 177 (fs [] \\ SIMP_TAC std_ss [Once mw_cmp_def] 178 \\ FULL_SIMP_TAC (srw_ss()) [] 179 \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,FRONT_SNOC] 180 \\ SRW_TAC [] [cmp2w_def]) 181 \\ fs [] 182 \\ SIMP_TAC std_ss [Once mw_cmp_def] 183 \\ FULL_SIMP_TAC (srw_ss()) [] 184 \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,FRONT_SNOC] 185 \\ `LENGTH ys2 <= l-1` by decide_tac 186 \\ `LENGTH ys2 = LENGTH ys2` by decide_tac 187 \\ res_tac 188 \\ rpt (first_x_assum (qspecl_then [`y::ys1`,`y::xs1`] mp_tac)) 189 \\ rpt strip_tac \\ fs []) 190 |> Q.SPECL [`xs`,`ys`,`[]`,`[]`] 191 |> SIMP_RULE std_ss [APPEND_NIL]; 192 193val mc_compare_thm = prove( 194 ``LENGTH (xs:�� word list) < dimword (:��) /\ LENGTH ys < dimword (:��) /\ 195 LENGTH xs + 1 <= l ==> 196 ?l2. mc_compare_pre (l,n2w (LENGTH xs),n2w (LENGTH ys),xs,ys) /\ 197 (mc_compare (l,n2w (LENGTH xs),n2w (LENGTH ys),xs,ys) = 198 (l2,cmp2w (mw_compare xs ys),xs,ys)) /\ 199 l <= l2 + LENGTH xs + 1``, 200 SIMP_TAC (srw_ss()) [mc_compare_def,mc_compare_pre_def, 201 n2w_11,WORD_LO,LET_DEF,mw_compare_def] 202 \\ SRW_TAC [] [cmp2w_def] 203 \\ fs [] 204 \\ `LENGTH xs = LENGTH ys` by DECIDE_TAC 205 \\ MP_TAC mc_cmp_thm \\ FULL_SIMP_TAC (srw_ss()) [] 206 \\ disch_then (qspec_then `l-1` mp_tac) \\ fs [] 207 \\ strip_tac \\ fs []); 208 209val mc_header_AND_1 = store_thm("mc_header_AND_1", 210 ``mc_header (s,xs) && (0x1w:'a word) = b2w s``, 211 rw[mc_header_def,GSYM word_mul_n2w,b2w_def,b2n_def] 212 \\ Q.SPEC_TAC (`n2w (LENGTH xs) :�� word`,`w`) 213 \\ rw[fcpTheory.CART_EQ] 214 \\ rw[word_and_def,WORD_ADD_BIT0,fcpTheory.FCP_BETA] 215 \\ rw[word_mul_def,dimword_def,word_index] 216 \\ Cases_on`i=0` \\ fs[word_add_n2w,word_index] 217 \\ fs[bitTheory.ADD_BIT0] 218 \\ simp[EVEN_BIT0,EVEN_MULT] 219 \\ rw[EVEN_MULT] \\ disj2_tac 220 THEN_LT USE_SG_THEN ACCEPT_TAC 1 2 221 \\ qmatch_goalsub_abbrev_tac`EVEN (n MOD m)` 222 \\ `0 < m ��� EVEN m` 223 by ( simp[Abbr`m`,Abbr`n`,EVEN_EXP] ) 224 \\ simp[EVEN_MOD,Abbr`n`]); 225 226val mc_header_sign = prove( 227 ``(mc_header (s,xs) && 1w = (0w:'a word)) = ~s``, 228 Cases_on`s` \\ rw[mc_header_AND_1] 229 \\ EVAL_TAC \\ simp[]); 230 231val mc_length_lemma = prove( 232 ``(w * 2w + if s then 0x1w else 0x0w) >>> 1 = (w * 2w:'a word) >>> 1``, 233 Cases_on `s` \\ FULL_SIMP_TAC std_ss [] \\ blastLib.BBLAST_TAC 234 \\ Cases_on`w` \\ fs[WORD_MUL_LSL,word_mul_n2w,word_add_n2w] 235 \\ rewrite_tac[Once(GSYM w2n_11),w2n_lsr] 236 \\ simp[] 237 \\ simp[dimword_def] 238 \\ Cases_on`dimindex(:'a)`\\fs[EXP] 239 \\ fs[GSYM DIV_MOD_MOD_DIV] 240 \\ AP_THM_TAC \\ AP_TERM_TAC 241 \\ once_rewrite_tac[MULT_COMM] 242 \\ simp[DIV_MULT,MULT_DIV]); 243 244val mc_length = prove( 245 ``LENGTH (xs:'a word list) < dimword (:'a) DIV 2 ==> 246 (mc_header (s,xs) >>> 1 = n2w (LENGTH xs))``, 247 FULL_SIMP_TAC std_ss [mc_header_def,GSYM word_mul_n2w,mc_length_lemma] 248 \\ SIMP_TAC std_ss [GSYM w2n_11,w2n_lsr,w2n_n2w,word_mul_n2w] 249 \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT STRIP_TAC 250 \\ fs[X_LT_DIV] 251 \\ ONCE_REWRITE_TAC[MULT_COMM] 252 \\ simp[MULT_DIV]); 253 254val dim63_IMP_dim64 = prove( 255 ``n < dimword (:'a) DIV 2 ==> n < dimword (:'a)``, 256 fs[X_LT_DIV]); 257 258val mc_icompare_thm = prove( 259 ``LENGTH (xs:'a word list) < dimword (:'a) DIV 2 /\ 260 LENGTH ys < dimword (:'a) DIV 2 /\ 261 LENGTH xs + 1 <= l ==> 262 ?l2. mc_icompare_pre (l,mc_header (s,xs),mc_header (t,ys),xs,ys) /\ 263 (mc_icompare (l,mc_header (s,xs),mc_header (t,ys),xs,ys) = 264 (l2,cmp2w (mwi_compare (s,xs) (t,ys)),xs,ys)) /\ 265 l <= l2 + LENGTH xs + 1``, 266 strip_tac \\ 267 FULL_SIMP_TAC std_ss [mc_icompare_def,mc_icompare_pre_def,mc_header_sign, 268 mc_length,LET_DEF] \\ IMP_RES_TAC dim63_IMP_dim64 269 \\ mp_tac mc_compare_thm \\ fs [] \\ strip_tac \\ fs [] 270 \\ FULL_SIMP_TAC std_ss [mwi_compare_def] 271 \\ Cases_on `s` \\ Cases_on `t` \\ FULL_SIMP_TAC std_ss [cmp2w_def] \\ fs [] 272 \\ Cases_on `mw_compare xs ys` \\ FULL_SIMP_TAC std_ss [cmp2w_def,option_eq_def] 273 \\ Cases_on `x` \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,option_eq_def,n2w_11] 274 \\ rw[] 275 \\ rfs[MOD_EQ_0_DIVISOR] 276 \\ Cases_on`d` \\ fs[MULT] 277 \\ Cases_on`dimword(:'a)` \\ fs[ADD1] 278 \\ Cases_on`n` \\ fs[MULT] 279 >- ( 280 Cases_on`xs` \\ fs[] \\ 281 Cases_on`ys` \\ fs[] \\ 282 fs[mw_compare_def] \\ 283 fs[Once mw_cmp_def] ) 284 \\ qmatch_asmsub_rename_tac`2n = 2 * k + _` 285 \\ Cases_on`k` \\ fs[] 286 \\ Cases_on`xs` \\ fs[] 287 \\ Cases_on`ys` \\ fs[] 288 \\ fs[mw_compare_def] 289 \\ fs[Once mw_cmp_def]); 290 291(* addition *) 292 293val single_add_word_def = Define ` 294 single_add_word w1 w2 c = 295 let (z,c) = single_add w1 w2 (c <> 0w:'a word) in 296 (z:'a word, (b2w c) :'a word)`; 297 298val single_add_word_thm = 299 single_add_word_def 300 |> SIMP_RULE std_ss [LET_DEF] 301 |> CONV_RULE (DEPTH_CONV PairRules.PBETA_CONV); 302 303val (mc_add_loop2_def, _, 304 mc_add_loop2_pre_def, _) = 305 tailrec_define "mc_add_loop2" `` 306 (\(l,r1:'a word,r3:'a word,r8:'a word,r9:'a word,r10:'a word,xs,zs). 307 if r1 = 0x1w then 308 (let r1 = 0x0w 309 in 310 (INR (l,r1:'a word,r3,r8,r9,r10,xs,zs),T)) 311 else 312 (let r1 = r1 - 0x1w in 313 let cond = w2n r10 < LENGTH xs in 314 let r8 = EL (w2n r10) xs in 315 let cond = cond /\ (r3 <> 0w ==> (r3 = 1w)) in 316 let (r8,r3) = single_add_word r8 r9 r3 in 317 let cond = cond /\ w2n r10 < LENGTH zs in 318 let zs = LUPDATE r8 (w2n r10) zs in 319 let r10 = r10 + 0x1w 320 in 321 (INL (l-1,r1,r3,r8,r9,r10,xs,zs),cond /\ l <> 0n)))``; 322 323val (mc_add_loop1_def, _, 324 mc_add_loop1_pre_def, _) = 325 tailrec_define "mc_add_loop1" `` 326 (\(l,r1:'a word,r3:'a word,r8:'a word,r9:'a word,r10:'a word,xs,ys,zs). 327 if r1 = 0x1w then 328 (let r1 = 0x0w:'a word 329 in 330 (INR (l,r1,r3,r8,r9,r10,xs,ys,zs),T)) 331 else 332 (let r1 = r1 - 0x1w in 333 let cond = w2n r10 < LENGTH xs in 334 let r8 = EL (w2n r10) xs in 335 let cond = cond /\ w2n r10 < LENGTH ys in 336 let r9 = EL (w2n r10) ys in 337 let cond = cond /\ (r3 <> 0w ==> (r3 = 1w)) in 338 let (r8,r3) = single_add_word r8 r9 r3 in 339 let cond = cond /\ w2n r10 < LENGTH zs in 340 let zs = LUPDATE r8 (w2n r10) zs in 341 let r10 = r10 + 0x1w 342 in 343 (INL (l-1,r1,r3,r8,r9,r10,xs,ys,zs),cond /\ l <> 0n)))``; 344 345val (mc_add_loop_def, _, 346 mc_add_loop_pre_def, _) = 347 tailrec_define "mc_add_loop" `` 348 (\(l,r1,r2,r8,r9,r10,xs,ys,zs). 349 (let r1 = r1 + 0x1w in 350 let r2 = r2 + 0x1w in 351 let r3 = 0w in 352 let cond = mc_add_loop1_pre (l-1,r1,r3,r8,r9,r10,xs,ys,zs) /\ l <> 0 in 353 let (l,r1,r3,r8,r9,r10,xs,ys,zs) = mc_add_loop1 (l-1,r1,r3,r8,r9,r10,xs,ys,zs) in 354 let r1 = r2 in 355 let r9 = 0x0w in 356 let cond = cond /\ mc_add_loop2_pre (l-1,r1,r3,r8,r9,r10,xs,zs) /\ l <> 0 in 357 let (l,r1,r3,r8,r9,r10,xs,zs) = mc_add_loop2 (l-1,r1,r3,r8,r9,r10,xs,zs) 358 in 359 if r3 = 0w then 360 (INR (l,r1,r2,r8,r9,r10,xs,ys,zs),cond) 361 else 362 (let r8 = 0x1w in 363 let cond = cond /\ w2n r10 < LENGTH zs in 364 let zs = LUPDATE r8 (w2n r10) zs in 365 let r10 = r10 + 0x1w 366 in 367 (INR (l,r1,r2,r8,r9,r10,xs,ys,zs),cond)))) 368 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word 369 list # 'a word list # 'a word list -> (num # 'a word # 'a word # 370 'a word # 'a word # 'a word # 'a word list # 'a word list # 'a 371 word list + num # 'a word # 'a word # 'a word # 'a word # 'a word 372 # 'a word list # 'a word list # 'a word list) # bool``; 373 374val mc_add_loop_def = 375 LIST_CONJ [mc_add_loop_def,mc_add_loop_pre_def, 376 mc_add_loop1_def,mc_add_loop1_pre_def, 377 mc_add_loop2_def,mc_add_loop2_pre_def] 378 379val (mc_add_def, _, 380 mc_add_pre_def, _) = 381 tailrec_define "mc_add" `` 382 (\(l,r1,r2,r8,r9,r10,xs,ys,zs). 383 (let r2 = r2 - r1 in 384 let cond = mc_add_loop_pre (l,r1,r2,r8,r9,r10,xs,ys,zs) in 385 let (l,r1,r2,r8,r9,r10,xs,ys,zs) = 386 mc_add_loop (l,r1,r2,r8,r9,r10,xs,ys,zs) 387 in 388 (INR (l,r1,r2,r8,r9,r10,xs,ys,zs),cond))) 389 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word 390 list # 'a word list # 'a word list -> (num # 'a word # 'a word # 391 'a word # 'a word # 'a word # 'a word list # 'a word list # 'a 392 word list + num # 'a word # 'a word # 'a word # 'a word # 'a word 393 # 'a word list # 'a word list # 'a word list) # bool``; 394 395val SNOC_INTRO = prove( 396 ``xs1 ++ x::(xs ++ xs2) = SNOC x xs1 ++ (xs ++ xs2)``, 397 FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]); 398 399val LUPDATE_SNOC = prove( 400 ``(LENGTH zs1 = LENGTH xs1) ==> 401 (LUPDATE x (LENGTH xs1) (SNOC y zs1 ++ (t ++ zs2)) = 402 (SNOC x zs1 ++ (t ++ zs2)))``, 403 ONCE_REWRITE_TAC [EQ_SYM_EQ] 404 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH]); 405 406val b2n_thm = prove(``!b. b2n b = b2n b``,Cases \\ EVAL_TAC) 407 408val b2w_eq = store_thm("b2w_eq[simp]", 409 ``((b2w b = 0w) <=> ~b) /\ ((b2w b = 1w) <=> b)``, 410 Cases_on `b` \\ EVAL_TAC \\ fs[]); 411 412val mc_add_loop1_thm = prove( 413 ``!(xs:'a word list) ys zs xs1 ys1 zs1 xs2 ys2 zs2 r8 r9 c l. 414 (LENGTH ys1 = LENGTH xs1) /\ (LENGTH zs1 = LENGTH xs1) /\ 415 (LENGTH ys = LENGTH xs) /\ (LENGTH zs = LENGTH xs) /\ 416 LENGTH (xs1 ++ xs) + 1 < dimword(:'a) /\ 417 LENGTH xs <= l ==> 418 ?r8' r9' l2. 419 mc_add_loop1_pre (l,n2w (LENGTH xs + 1),b2w c,r8,r9,n2w (LENGTH xs1), 420 xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,zs1 ++ zs ++ zs2) /\ 421 (mc_add_loop1 (l,n2w (LENGTH xs + 1),b2w c,r8,r9,n2w (LENGTH xs1), 422 xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,zs1 ++ zs ++ zs2) = 423 (l2,0w,b2w (SND (mw_add xs ys c)),r8',r9',n2w (LENGTH (xs1++xs)), 424 xs1 ++ xs ++ xs2,ys1 ++ ys ++ ys2, 425 zs1 ++ FST (mw_add xs ys c) ++ zs2)) /\ 426 l <= l2 + LENGTH xs``, 427 Induct THEN1 428 (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def] 429 \\ ONCE_REWRITE_TAC [mc_add_loop_def] 430 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def,LET_DEF]) 431 \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 432 \\ ONCE_REWRITE_TAC [mc_add_loop_def] 433 \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF,single_add_word_thm] 434 \\ REPEAT STRIP_TAC 435 \\ `LENGTH xs < dimword(:'a) /\ 436 LENGTH xs + 1 < dimword(:'a) /\ 437 LENGTH xs + 1 + 1 < dimword(:'a)` by DECIDE_TAC 438 \\ `LENGTH xs1 < dimword(:'a) /\ 439 LENGTH xs1 + 1 < dimword(:'a)` by DECIDE_TAC 440 \\ FULL_SIMP_TAC std_ss [] 441 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND, 442 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL] 443 \\ Q.PAT_X_ASSUM `LENGTH ys1 = LENGTH xs1` (ASSUME_TAC o GSYM) 444 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND, 445 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL] 446 \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB] 447 \\ SIMP_TAC std_ss [word_add_n2w] 448 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND] 449 \\ SIMP_TAC std_ss [SNOC_INTRO] 450 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [] 451 \\ `LENGTH xs1 + 1 = LENGTH (SNOC h' xs1)` by 452 FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss [] 453 \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC] 454 \\ SEP_I_TAC "mc_add_loop1" \\ POP_ASSUM MP_TAC 455 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 456 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 457 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 458 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_add_def, 459 LET_DEF,single_add_def,b2n_thm] 460 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 461 \\ FULL_SIMP_TAC (srw_ss()) [b2w_def] \\ DECIDE_TAC); 462 463val mc_add_loop2_thm = prove( 464 ``!(xs:'a word list) zs xs1 zs1 xs2 zs2 r8 c l. 465 (LENGTH zs1 = LENGTH xs1) /\ (LENGTH zs = LENGTH xs) /\ 466 LENGTH (xs1 ++ xs) + 1 < dimword(:'a) /\ 467 LENGTH xs <= l ==> 468 ?r8' r9' l2. 469 mc_add_loop2_pre (l,n2w (LENGTH xs + 1),b2w c,r8,0w,n2w (LENGTH xs1), 470 xs1 ++ xs ++ xs2,zs1 ++ zs ++ zs2) /\ 471 (mc_add_loop2 (l,n2w (LENGTH xs + 1),b2w c,r8,0w,n2w (LENGTH xs1), 472 xs1 ++ xs ++ xs2,zs1 ++ zs ++ zs2) = 473 (l2,0w,b2w ((SND (mw_add xs (MAP (\x.0w) xs) c))), 474 r8',r9',n2w (LENGTH (xs1++xs)),xs1 ++ xs ++ xs2, 475 zs1 ++ FST (mw_add xs (MAP (\x.0w) xs) c) ++ zs2)) /\ 476 l <= l2 + LENGTH xs``, 477 Induct THEN1 478 (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def] 479 \\ ONCE_REWRITE_TAC [mc_add_loop_def] 480 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def,LET_DEF]) 481 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 482 \\ ONCE_REWRITE_TAC [mc_add_loop_def] 483 \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF,single_add_word_thm] 484 \\ REPEAT STRIP_TAC 485 \\ `LENGTH xs < dimword(:'a) /\ 486 LENGTH xs + 1 < dimword(:'a) /\ 487 LENGTH xs + 1 + 1 < dimword(:'a)` by DECIDE_TAC 488 \\ `LENGTH xs1 < dimword(:'a) /\ 489 LENGTH xs1 + 1 < dimword(:'a)` by DECIDE_TAC 490 \\ FULL_SIMP_TAC std_ss [] 491 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND, 492 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL] 493 \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB] 494 \\ SIMP_TAC std_ss [word_add_n2w] 495 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND] 496 \\ SIMP_TAC std_ss [SNOC_INTRO] 497 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [] 498 \\ `LENGTH xs1 + 1 = LENGTH (SNOC h xs1)` by 499 FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss [] 500 \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC] 501 \\ SEP_I_TAC "mc_add_loop2" \\ POP_ASSUM MP_TAC 502 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 503 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 504 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 505 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_add_def, 506 LET_DEF,single_add_def,b2n_thm] 507 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 508 \\ FULL_SIMP_TAC (srw_ss()) [b2w_def] 509 \\ DECIDE_TAC) 510 511val mc_add_thm = prove( 512 ``!(xs:'a word list) ys zs zs2 l. 513 LENGTH ys <= LENGTH xs /\ (LENGTH zs = LENGTH (mw_addv xs ys F)) /\ 514 LENGTH xs + 1 < dimword(:'a) /\ LENGTH xs + 2 <= l ==> 515 ?r1' r2' r8' r9' r10' l2. 516 mc_add_pre (l,n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) /\ 517 (mc_add (l,n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) = 518 (l2,r1',r2',r8',r9',n2w (LENGTH (mw_addv xs ys F)),xs,ys, 519 mw_addv xs ys F ++ zs2)) /\ 520 l <= l2 + LENGTH xs + 2``, 521 REPEAT STRIP_TAC \\ IMP_RES_TAC LESS_EQ_LENGTH 522 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,mc_add_def,mc_add_pre_def,LET_DEF] 523 \\ ONCE_REWRITE_TAC [ADD_COMM] 524 \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB] 525 \\ ONCE_REWRITE_TAC [mc_add_loop_def] 526 \\ SIMP_TAC (srw_ss()) [LET_DEF,w2n_n2w,word_add_n2w] 527 \\ `~((dimword(:'a) <= (LENGTH ys + 1) MOD dimword(:'a)))` by (fs[]) 528 \\ FULL_SIMP_TAC std_ss [] 529 \\ (mc_add_loop1_thm |> Q.SPECL [`xs1`,`ys`,`zs`,`[]`,`[]`,`[]`, 530 `xs2`,`[]`,`zs2`,`r8`,`r9`,`F`] |> SIMP_RULE std_ss [EVAL ``b2w F``] 531 |> GEN_ALL |> MP_TAC) 532 \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND,APPEND_NIL] \\ STRIP_TAC 533 \\ Q.PAT_X_ASSUM `LENGTH xs1 = LENGTH ys` (ASSUME_TAC o GSYM) 534 \\ FULL_SIMP_TAC std_ss [mw_addv_EQ_mw_add,LET_DEF] 535 \\ `?qs1 c1. mw_add xs1 ys F = (qs1,c1)` by METIS_TAC [PAIR] 536 \\ `?qs2 c2. mw_add xs2 (MAP (\x.0w) xs2) c1 = (qs2,c2)` by METIS_TAC [PAIR] 537 \\ FULL_SIMP_TAC std_ss [] 538 \\ Q.ABBREV_TAC `qs3 = if c2 then [0x1w] else []:'a word list` 539 \\ `?zs1 zs3 zs4. (zs = zs1 ++ zs3 ++ zs4) /\ 540 (LENGTH zs1 = LENGTH xs1) /\ 541 (LENGTH zs3 = LENGTH xs2) /\ 542 (LENGTH zs4 = LENGTH qs3)` by 543 (IMP_RES_TAC LENGTH_mw_add 544 \\ `LENGTH xs1 <= LENGTH zs` by 545 (FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ DECIDE_TAC) 546 \\ IMP_RES_TAC LESS_EQ_LENGTH \\ FULL_SIMP_TAC std_ss [] 547 \\ Q.EXISTS_TAC `xs1'` \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 548 \\ `LENGTH xs2 <= LENGTH xs2'` by 549 (FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ DECIDE_TAC) 550 \\ IMP_RES_TAC LESS_EQ_LENGTH \\ FULL_SIMP_TAC std_ss [] 551 \\ Q.LIST_EXISTS_TAC [`xs1''`,`xs2''`] 552 \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC,LENGTH_APPEND] 553 \\ DECIDE_TAC) 554 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC] 555 \\ SEP_I_TAC "mc_add_loop1" \\ POP_ASSUM MP_TAC 556 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 557 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 558 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 559 \\ (mc_add_loop2_thm |> Q.SPECL [`xs`,`ys`,`xs1`,`zs1`,`[]`] |> GEN_ALL 560 |> SIMP_RULE std_ss [GSYM APPEND_ASSOC,APPEND_NIL] |> ASSUME_TAC) 561 \\ SEP_I_TAC "mc_add_loop2" \\ POP_ASSUM MP_TAC 562 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 563 THEN1 (IMP_RES_TAC LENGTH_mw_add \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 564 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [b2w_eq] 565 \\ REV (Cases_on `c2`) \\ FULL_SIMP_TAC std_ss [] 566 THEN1 (Q.UNABBREV_TAC `qs3` 567 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL,APPEND_NIL,LENGTH_APPEND] 568 \\ fs []) 569 \\ `LENGTH xs1 + LENGTH xs2 < dimword(:'a)` by DECIDE_TAC 570 \\ FULL_SIMP_TAC (srw_ss()) [] 571 \\ IMP_RES_TAC LENGTH_mw_add 572 \\ Q.UNABBREV_TAC `qs3` \\ FULL_SIMP_TAC std_ss [LENGTH] 573 \\ STRIP_TAC THEN1 DECIDE_TAC 574 \\ Cases_on `zs4` \\ FULL_SIMP_TAC std_ss [LENGTH] 575 \\ Cases_on `t` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 576 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,word_add_n2w,ADD_ASSOC] 577 \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC,GSYM LENGTH_APPEND,LUPDATE_LENGTH] 578 \\ fs []); 579 580(* subtraction *) 581 582val single_sub_word_def = Define ` 583 single_sub_word w1 w2 c = 584 let (z,c) = single_sub w1 w2 (c <> 0w:'a word) in 585 (z:'a word, (b2w c) :'a word)`; 586 587val single_sub_word_thm = 588 single_sub_word_def 589 |> SIMP_RULE std_ss [LET_DEF] 590 |> CONV_RULE (DEPTH_CONV PairRules.PBETA_CONV); 591 592val (mc_sub_loop2_def, _, 593 mc_sub_loop2_pre_def, _) = 594 tailrec_define "mc_sub_loop2" `` 595 (\(l,r1:'a word,r3:'a word,r8:'a word,r9:'a word,r10:'a word,xs,zs). 596 if r1 = 0x1w then 597 (let r1 = 0x0w:'a word 598 in 599 (INR (l,r1,r3,r8,r9,r10,xs,zs),T)) 600 else 601 (let r1 = r1 - 0x1w in 602 let cond = w2n r10 < LENGTH xs in 603 let r8 = EL (w2n r10) xs in 604 let cond = cond /\ (r3 <> 0w ==> (r3 = 1w)) in 605 let (r8,r3) = single_sub_word r8 r9 r3 in 606 let cond = cond /\ w2n r10 < LENGTH zs in 607 let zs = LUPDATE r8 (w2n r10) zs in 608 let r10 = r10 + 0x1w 609 in 610 (INL (l-1,r1,r3,r8,r9,r10,xs,zs),cond /\ l <> 0n)))``; 611 612val (mc_sub_loop1_def, _, 613 mc_sub_loop1_pre_def, _) = 614 tailrec_define "mc_sub_loop1" `` 615 (\(l,r1:'a word,r3:'a word,r8:'a word,r9:'a word,r10:'a word,xs,ys,zs). 616 if r1 = 0x1w then 617 (let r1 = 0x0w:'a word 618 in 619 (INR (l,r1,r3,r8,r9,r10,xs,ys,zs),T)) 620 else 621 (let r1 = r1 - 0x1w in 622 let cond = w2n r10 < LENGTH xs in 623 let r8 = EL (w2n r10) xs in 624 let cond = cond /\ w2n r10 < LENGTH ys in 625 let r9 = EL (w2n r10) ys in 626 let cond = cond /\ (r3 <> 0w ==> (r3 = 1w)) in 627 let (r8,r3) = single_sub_word r8 r9 r3 in 628 let cond = cond /\ w2n r10 < LENGTH zs in 629 let zs = LUPDATE r8 (w2n r10) zs in 630 let r10 = r10 + 0x1w 631 in 632 (INL (l-1,r1,r3,r8,r9,r10,xs,ys,zs),cond /\ l <> 0n)))``; 633 634val (mc_sub_loop_def, _, 635 mc_sub_loop_pre_def, _) = 636 tailrec_define "mc_sub_loop" `` 637 (\(l,r1,r2,r8,r9,r10,xs,ys,zs). 638 (let r1 = r1 + 0x1w in 639 let r2 = r2 + 0x1w in 640 let r3 = 1w in 641 let r8 = r8 - 0x0w in 642 let cond = mc_sub_loop1_pre (l-1,r1,r3,r8,r9,r10,xs,ys,zs) /\ l <> 0n in 643 let (l,r1,r3,r8,r9,r10,xs,ys,zs) = mc_sub_loop1 (l-1,r1,r3,r8,r9,r10,xs,ys,zs) in 644 let r1 = r2 in 645 let r9 = 0x0w in 646 let cond = cond /\ mc_sub_loop2_pre (l-1,r1,r3,r8,r9,r10,xs,zs) /\ l <> 0n in 647 let (l,r1,r3,r8,r9,r10,xs,zs) = mc_sub_loop2 (l-1,r1,r3,r8,r9,r10,xs,zs) 648 in 649 (INR (l,r1,r2,r8,r9,r10,xs,ys,zs),cond))) 650 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word 651 list # 'a word list # 'a word list -> (num # 'a word # 'a word # 'a 652 word # 'a word # 'a word # 'a word list # 'a word list # 'a word 653 list + num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a 654 word list # 'a word list # 'a word list) # bool`` 655 656val mc_sub_loop_def = 657 LIST_CONJ [mc_sub_loop_def,mc_sub_loop_pre_def, 658 mc_sub_loop1_def,mc_sub_loop1_pre_def, 659 mc_sub_loop2_def,mc_sub_loop2_pre_def] 660 661val (mc_fix_def, _, 662 mc_fix_pre_def, _) = 663 tailrec_define "mc_fix" `` 664 (\(l:num,r8:'a word,r10:'a word,zs:'a word list). 665 if r10 = 0x0w then (INR (l,r8,r10,zs),T) 666 else 667 (let r10 = r10 - 0x1w in 668 let cond = w2n r10 < LENGTH zs in 669 let r8 = EL (w2n r10) zs 670 in 671 if r8 = 0x0w then (INL (l-1,r8,r10,zs),cond /\ l <> 0) 672 else (let r10 = r10 + 0x1w in (INR (l,r8,r10,zs),cond))))``; 673 674val mc_fix_def = 675 LIST_CONJ [mc_fix_def,mc_fix_pre_def] 676 677val (mc_sub_def, _, 678 mc_sub_pre_def, _) = 679 tailrec_define "mc_sub" `` 680 (\(l,r1,r2,r8,r9,r10,xs,ys,zs). 681 (let r2 = r2 - r1 in 682 let cond = mc_sub_loop_pre (l,r1,r2,r8,r9,r10,xs,ys,zs) in 683 let (l,r1,r2,r8,r9,r10,xs,ys,zs) = mc_sub_loop (l,r1,r2,r8,r9,r10,xs,ys,zs) in 684 let cond = cond /\ mc_fix_pre (l-1,r8,r10,zs) /\ l <> 0 in 685 let (l,r8,r10,zs) = mc_fix (l-1,r8,r10,zs) 686 in 687 (INR (l,r1,r2,r8,r9,r10,xs,ys,zs),cond))) 688 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word 689 list # 'a word list # 'a word list -> (num # 'a word # 'a word # 690 'a word # 'a word # 'a word # 'a word list # 'a word list # 'a 691 word list + num # 'a word # 'a word # 'a word # 'a word # 'a word 692 # 'a word list # 'a word list # 'a word list) # bool``; 693 694val mc_sub_def = 695 LIST_CONJ [mc_sub_def,mc_sub_pre_def] 696 697val mc_fix_thm = prove( 698 ``!(zs:'a word list) zs1 r8 l. 699 LENGTH zs < dimword(:'a) /\ LENGTH zs <= l ==> 700 ?r8' l2. 701 mc_fix_pre (l,r8,n2w (LENGTH zs),zs++zs1) /\ 702 (mc_fix (l,r8,n2w (LENGTH zs),zs++zs1) = 703 (l2,r8',n2w (LENGTH (mw_fix zs)), 704 mw_fix zs ++ REPLICATE (LENGTH zs - LENGTH (mw_fix zs)) 0w ++ zs1)) /\ 705 l <= l2 + LENGTH zs``, 706 HO_MATCH_MP_TAC SNOC_INDUCT \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 707 \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [mc_fix_def,mw_fix_def] 708 \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.REPLICATE,LET_DEF] 709 \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,ADD1,GSYM word_sub_def,WORD_ADD_SUB] 710 \\ IMP_RES_TAC (DECIDE ``n + 1 < k ==> n < k:num``) 711 \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w] 712 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND, 713 rich_listTheory.EL_LENGTH_APPEND,NULL,HD] 714 \\ REV (Cases_on `x = 0w`) \\ FULL_SIMP_TAC std_ss [] THEN1 715 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,REPLICATE,APPEND, 716 GSYM APPEND_ASSOC,word_add_n2w] \\ DECIDE_TAC) 717 \\ SEP_I_TAC "mc_fix" \\ FULL_SIMP_TAC std_ss [] \\ rfs [] 718 \\ `LENGTH (mw_fix zs) <= LENGTH zs` by 719 FULL_SIMP_TAC std_ss [LENGTH_mw_fix] 720 \\ `LENGTH zs + 1 - LENGTH (mw_fix zs) = 721 SUC (LENGTH zs - LENGTH (mw_fix zs))` by DECIDE_TAC 722 \\ FULL_SIMP_TAC std_ss [REPLICATE_SNOC] 723 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]) 724 725val sub_borrow_lemma = prove( 726 ``!h:'a word h':'a word c. 727 (dimword(:'a) <= b2n ~c + (w2n h' + w2n (~h))) = 728 ~(w2n h' < b2n c + w2n h)``, 729 Cases \\ Cases \\ Cases 730 \\ `(dimword(:'a) - 1 - n) < dimword(:'a)` by DECIDE_TAC 731 \\ FULL_SIMP_TAC (srw_ss()) [b2n_def,word_1comp_n2w] \\ DECIDE_TAC); 732 733val mc_sub_loop1_thm = prove( 734 ``!(xs:'a word list) ys zs xs1 ys1 zs1 xs2 ys2 zs2 c r8 r9 l. 735 (LENGTH ys1 = LENGTH xs1) /\ (LENGTH zs1 = LENGTH xs1) /\ 736 (LENGTH ys = LENGTH xs) /\ (LENGTH zs = LENGTH xs) /\ 737 LENGTH (xs1 ++ xs) + 1 < dimword(:'a) /\ 738 LENGTH xs <= l ==> 739 ?r8' r9' l2. 740 mc_sub_loop1_pre (l,n2w (LENGTH xs + 1),b2w c,r8,r9,n2w (LENGTH xs1), 741 xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,zs1 ++ zs ++ zs2) /\ 742 (mc_sub_loop1 (l,n2w (LENGTH xs + 1),b2w c,r8,r9,n2w (LENGTH xs1), 743 xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,zs1 ++ zs ++ zs2) = 744 (l2,0w,b2w (SND (mw_sub xs ys c)),r8',r9',n2w (LENGTH (xs1++xs)), 745 xs1 ++ xs ++ xs2,ys1 ++ ys ++ ys2, 746 zs1 ++ FST (mw_sub xs ys c) ++ zs2)) /\ 747 l <= l2 + LENGTH xs``, 748 Induct THEN1 749 (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def] 750 \\ ONCE_REWRITE_TAC [mc_sub_loop_def] 751 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def,LET_DEF]) 752 \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 753 \\ ONCE_REWRITE_TAC [mc_sub_loop_def] 754 \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF,single_sub_word_thm] 755 \\ REPEAT STRIP_TAC 756 \\ `LENGTH xs < dimword(:'a) /\ 757 LENGTH xs + 1 < dimword(:'a) /\ 758 LENGTH xs + 1 + 1 < dimword(:'a)` by DECIDE_TAC 759 \\ `LENGTH xs1 < dimword(:'a) /\ 760 LENGTH xs1 + 1 < dimword(:'a)` by DECIDE_TAC 761 \\ FULL_SIMP_TAC std_ss [] 762 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND, 763 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL] 764 \\ Q.PAT_X_ASSUM `LENGTH ys1 = LENGTH xs1` (ASSUME_TAC o GSYM) 765 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND, 766 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL] 767 \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB] 768 \\ SIMP_TAC std_ss [word_add_n2w] 769 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND] 770 \\ SIMP_TAC std_ss [SNOC_INTRO] 771 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [] 772 \\ `LENGTH xs1 + 1 = LENGTH (SNOC h' xs1)` by 773 FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss [] 774 \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC] 775 \\ SEP_I_TAC "mc_sub_loop1" \\ POP_ASSUM MP_TAC 776 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 777 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 778 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 779 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_sub_def, 780 LET_DEF,single_sub_def,b2n_thm,single_add_def] 781 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 782 \\ FULL_SIMP_TAC (srw_ss()) [b2w_def] 783 \\ DECIDE_TAC); 784 785val mc_sub_loop2_thm = prove( 786 ``!(xs:'a word list) zs xs1 zs1 xs2 zs2 c r8 l. 787 (LENGTH zs1 = LENGTH xs1) /\ (LENGTH zs = LENGTH xs) /\ 788 LENGTH (xs1 ++ xs) + 1 < dimword(:'a) /\ LENGTH xs <= l ==> 789 ?r8' r9' l2. 790 mc_sub_loop2_pre (l,n2w (LENGTH xs + 1),b2w c,r8,0w,n2w (LENGTH xs1), 791 xs1 ++ xs ++ xs2,zs1 ++ zs ++ zs2) /\ 792 (mc_sub_loop2 (l,n2w (LENGTH xs + 1),b2w c,r8,0w,n2w (LENGTH xs1), 793 xs1 ++ xs ++ xs2,zs1 ++ zs ++ zs2) = 794 (l2,0w,b2w (SND (mw_sub xs [] c)),r8',r9',n2w (LENGTH (xs1++xs)), 795 xs1 ++ xs ++ xs2,zs1 ++ FST (mw_sub xs [] c) ++ zs2)) /\ 796 l <= l2 + LENGTH xs``, 797 Induct THEN1 798 (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def] 799 \\ ONCE_REWRITE_TAC [mc_sub_loop_def] 800 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def,LET_DEF]) 801 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 802 \\ ONCE_REWRITE_TAC [mc_sub_loop_def] 803 \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF,single_sub_word_thm] 804 \\ REPEAT STRIP_TAC 805 \\ `LENGTH xs < dimword(:'a) /\ 806 LENGTH xs + 1 < dimword(:'a) /\ 807 LENGTH xs + 1 + 1 < dimword(:'a)` by DECIDE_TAC 808 \\ `LENGTH xs1 < dimword(:'a) /\ 809 LENGTH xs1 + 1 < dimword(:'a)` by DECIDE_TAC 810 \\ FULL_SIMP_TAC std_ss [] 811 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND, 812 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL] 813 \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB] 814 \\ SIMP_TAC std_ss [word_add_n2w] 815 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND] 816 \\ SIMP_TAC std_ss [SNOC_INTRO] 817 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [] 818 \\ `LENGTH xs1 + 1 = LENGTH (SNOC h xs1)` by 819 FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss [] 820 \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC] 821 \\ SEP_I_TAC "mc_sub_loop2" \\ POP_ASSUM MP_TAC 822 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 823 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 824 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 825 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_sub_def, 826 LET_DEF,single_add_def,b2n_thm,single_sub_def] 827 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 828 \\ FULL_SIMP_TAC (srw_ss()) [b2w_def] \\ DECIDE_TAC); 829 830val mc_sub_thm = prove( 831 ``!(xs:'a word list) ys zs zs2 l. 832 LENGTH ys <= LENGTH xs /\ (LENGTH zs = LENGTH xs) /\ 833 LENGTH xs + 1 < dimword(:'a) /\ LENGTH xs + LENGTH xs + 3 <= l ==> 834 ?r1' r2' r8' r9' r10' l2. 835 mc_sub_pre (l,n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) /\ 836 (mc_sub (l,n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) = 837 (l2,r1',r2',r8',r9',n2w (LENGTH (mw_subv xs ys)),xs,ys, 838 mw_subv xs ys ++ REPLICATE (LENGTH xs - LENGTH (mw_subv xs ys)) 0w ++ zs2)) /\ 839 l <= l2 + LENGTH xs + LENGTH xs + 3``, 840 REPEAT STRIP_TAC \\ IMP_RES_TAC LESS_EQ_LENGTH 841 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,mc_sub_def,LET_DEF] 842 \\ ONCE_REWRITE_TAC [ADD_COMM] 843 \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB] 844 \\ ONCE_REWRITE_TAC [mc_sub_loop_def] 845 \\ SIMP_TAC std_ss [LET_DEF,w2n_n2w,word_add_n2w,WORD_LO] 846 \\ FULL_SIMP_TAC (srw_ss()) [] 847 \\ (mc_sub_loop1_thm |> Q.SPECL [`xs1`,`ys`,`zs`,`[]`,`[]`,`[]`, 848 `xs2`,`[]`,`zs2`,`T`] 849 |> SIMP_RULE std_ss [EVAL ``b2w T``] 850 |> GEN_ALL |> MP_TAC) 851 \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND,APPEND_NIL] \\ STRIP_TAC 852 \\ Q.PAT_X_ASSUM `LENGTH xs1 = LENGTH ys` (ASSUME_TAC o GSYM) 853 \\ FULL_SIMP_TAC std_ss [mw_subv_def,LET_DEF] 854 \\ ASM_SIMP_TAC std_ss [mw_sub_APPEND] 855 \\ `?qs1 c1. mw_sub xs1 ys T = (qs1,c1)` by METIS_TAC [PAIR] 856 \\ `?qs2 c2. mw_sub xs2 [] c1 = (qs2,c2)` by METIS_TAC [PAIR] 857 \\ FULL_SIMP_TAC std_ss [LET_DEF] 858 \\ `?zs1 zs3. (zs = zs1 ++ zs3) /\ 859 (LENGTH zs1 = LENGTH xs1) /\ 860 (LENGTH zs3 = LENGTH xs2)` by 861 (IMP_RES_TAC LENGTH_mw_sub \\ FULL_SIMP_TAC std_ss [] 862 \\ `LENGTH qs1 <= LENGTH zs` by DECIDE_TAC 863 \\ IMP_RES_TAC LESS_EQ_LENGTH \\ FULL_SIMP_TAC std_ss [] 864 \\ Q.LIST_EXISTS_TAC [`xs1'`,`xs2'`] \\ FULL_SIMP_TAC std_ss [] 865 \\ sg `LENGTH (xs1' ++ xs2') = LENGTH (qs1 ++ qs2)` 866 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ DECIDE_TAC) 867 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC] 868 \\ SEP_I_TAC "mc_sub_loop1" \\ POP_ASSUM MP_TAC 869 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 870 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ fs [] \\ DECIDE_TAC) 871 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 872 \\ (mc_sub_loop2_thm |> Q.SPECL [`xs`,`ys`,`xs1`,`zs1`,`[]`] |> GEN_ALL 873 |> SIMP_RULE std_ss [GSYM APPEND_ASSOC,APPEND_NIL] |> ASSUME_TAC) 874 \\ SEP_I_TAC "mc_sub_loop2" \\ POP_ASSUM MP_TAC 875 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 876 THEN1 (IMP_RES_TAC LENGTH_mw_sub \\ fs []) 877 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 878 \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC] 879 \\ IMP_RES_TAC LENGTH_mw_sub 880 \\ `LENGTH (xs1 ++ xs2) = LENGTH (qs1 ++ qs2)` by fs [LENGTH_APPEND] 881 \\ `LENGTH (qs1 ++ qs2) < dimword (:'a) /\ 882 LENGTH (qs1 ++ qs2) <= l2' ��� 1` by (fs [] \\ NO_TAC) 883 \\ FULL_SIMP_TAC std_ss [] 884 \\ IMP_RES_TAC mc_fix_thm \\ SEP_I_TAC "mc_fix" 885 \\ FULL_SIMP_TAC std_ss [] 886 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,AC ADD_COMM ADD_ASSOC] \\ fs []); 887 888(* integer addition *) 889 890val (mc_iadd1_def, _, 891 mc_iadd1_pre_def, _) = 892 tailrec_define "mc_iadd1" `` 893 (\(r1,r2,xs,ys). 894 (let r0 = 0x0w 895 in 896 if r1 <+ r2 then 897 (let (xs,ys) = (ys,xs) in 898 let r0 = 0x1w 899 in 900 (INR (r1,r2,r0,xs,ys),T)) 901 else 902 (let r8 = r1 in 903 let r1 = r2 in 904 let r2 = r8 905 in 906 (INR (r1,r2,r0,xs,ys),T)))) 907 :'a word # 'a word # 'a word list # 'a word list -> ('a word # 'a 908 word # 'a word list # 'a word list + 'a word # 'a word # 'a word 909 # 'a word list # 'a word list) # bool``; 910 911val (mc_iadd2_def, _, 912 mc_iadd2_pre_def, _) = 913 tailrec_define "mc_iadd2" `` 914 (\(r1,r2,r10,r12,xs,ys). 915 (let r0 = 0x0w 916 in 917 if r10 = 0x1w then 918 (let (xs,ys) = (ys,xs) in 919 let r12 = r12 ?? 0x1w in 920 let r0 = 0x1w 921 in 922 (INR (r1,r2,r0,r12,xs,ys),T)) 923 else 924 (let r8 = r1 in 925 let r1 = r2 in 926 let r2 = r8 927 in 928 (INR (r1,r2,r0,r12,xs,ys),T)))) 929 :'a word # 'a word # 'a word # 'a word # 'a word list # 'a word 930 list -> ('a word # 'a word # 'a word # 'a word # 'a word list # 931 'a word list + 'a word # 'a word # 'a word # 'a word # 'a word 932 list # 'a word list) # bool``; 933 934val (mc_iadd3_def, _, 935 mc_iadd3_pre_def, _) = 936 tailrec_define "mc_iadd3" `` 937 (\(r0,xs,ys). 938 if r0 = 0x0w then (INR (xs,ys),T) 939 else (let (xs,ys) = (ys,xs) in (INR (xs,ys),T))) 940 :'a word # 'a word list # 'a word list -> 941 ('a word # 'a word list # 'a word list + 942 'a word list # 'a word list) # bool``; 943 944val (mc_iadd_def, _, 945 mc_iadd_pre_def, _) = 946 tailrec_define "mc_iadd" `` 947 (\(l,r1,r2,xs,ys,zs). 948 (let r10 = r1 in 949 let r10 = r10 && 0x1w in 950 let r11 = r2 in 951 let r11 = r11 && 0x1w 952 in 953 if r10 = r11 then 954 (let r1 = r1 >>> 1 in 955 let r2 = r2 >>> 1 in 956 let (r1,r2,r0,xs,ys) = mc_iadd1 (r1,r2,xs,ys) in 957 let r8 = 0x0w in 958 let r9 = r8 in 959 let r10 = r8 in 960 let cond = mc_add_pre (l,r1,r2,r8,r9,r10,xs,ys,zs) in 961 let (l,r1,r2,r8,r9,r10,xs,ys,zs) = 962 mc_add (l,r1,r2,r8,r9,r10,xs,ys,zs) 963 in 964 let (xs,ys) = mc_iadd3 (r0,xs,ys) in 965 let r10 = r10 << 1 in 966 let r10 = r10 + r11 967 in 968 (INR (l,r10,xs,ys,zs),cond)) 969 else 970 (let r12 = r10 in 971 let r10 = r1 in 972 let r10 = r10 >>> 1 in 973 let r11 = r2 in 974 let r11 = r11 >>> 1 in 975 let cond = mc_compare_pre (l,r10,r11,xs,ys) in 976 let (l,r10,xs,ys) = mc_compare (l,r10,r11,xs,ys) 977 in 978 if r10 = 0x0w then (INR (l,r10,xs,ys,zs),cond) 979 else 980 (let (r1,r2,r0,r12,xs,ys) = 981 mc_iadd2 (r1,r2,r10,r12,xs,ys) 982 in 983 let r8 = 0x0w in 984 let r9 = r8 in 985 let r10 = r8 in 986 let r1 = r1 >>> 1 in 987 let r2 = r2 >>> 1 in 988 let cond = cond /\ mc_sub_pre (l,r1,r2,r8,r9,r10,xs,ys,zs) 989 in 990 let (l,r1,r2,r8,r9,r10,xs,ys,zs) = 991 mc_sub (l,r1,r2,r8,r9,r10,xs,ys,zs) 992 in 993 let (xs,ys) = mc_iadd3 (r0,xs,ys) in 994 let r10 = r10 << 1 in 995 let r10 = r10 + r12 996 in 997 (INR (l,r10,xs,ys,zs),cond))))) 998 :num # 'a word # 'a word # 'a word list # 'a word list # 'a word 999 list -> (num # 'a word # 'a word # 'a word list # 'a word list # 1000 'a word list + num # 'a word # 'a word list # 'a word list # 'a 1001 word list) # bool``; 1002 1003val mc_header_EQ = prove( 1004 ``(mc_header (s,xs) && 0x1w = mc_header (t,ys) && 0x1w) = (s = t)``, 1005 FULL_SIMP_TAC std_ss [mc_header_AND_1] 1006 \\ Cases_on `s` \\ Cases_on `t` \\ EVAL_TAC \\ simp[]); 1007 1008val b2w_NOT = prove( 1009 ``!s. b2w s ?? 0x1w = b2w (~s):'a word``, 1010 Cases \\ rw[b2w_def,b2n_def]); 1011 1012val mc_iadd_thm = prove( 1013 ``LENGTH (xs:'a word list) < dimword (:'a) DIV 2 /\ 1014 LENGTH ys < dimword (:'a) DIV 2 /\ 1015 LENGTH xs + LENGTH ys <= LENGTH zs /\ mw_ok xs /\ mw_ok ys /\ 1016 4 * LENGTH xs + 4 * LENGTH ys + 4 <= l ==> 1017 ?zs1 l2. 1018 mc_iadd_pre (l,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) /\ 1019 (mc_iadd (l,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) = 1020 (l2,mc_header (mwi_add (s,xs) (t,ys)),xs,ys, 1021 SND (mwi_add (s,xs) (t,ys))++zs1)) /\ 1022 (LENGTH (SND (mwi_add (s,xs) (t,ys))++zs1) = LENGTH zs) /\ 1023 l <= l2 + 4 * LENGTH xs + 4 * LENGTH ys + 4``, 1024 FULL_SIMP_TAC std_ss [mc_iadd_def,mc_iadd_pre_def,LET_DEF] 1025 \\ FULL_SIMP_TAC std_ss [mc_header_EQ,mwi_add_def,mc_length] 1026 \\ Cases_on `s <=> t` \\ FULL_SIMP_TAC std_ss [] 1027 \\ REPEAT STRIP_TAC \\ IMP_RES_TAC dim63_IMP_dim64 THEN1 1028 (Cases_on `LENGTH ys <= LENGTH xs` \\ FULL_SIMP_TAC std_ss [] 1029 \\ FULL_SIMP_TAC (srw_ss()) [mc_iadd1_def,WORD_LO,GSYM NOT_LESS,LET_DEF] 1030 THEN1 1031 (ASSUME_TAC mc_add_thm 1032 \\ `LENGTH (mw_addv xs ys F) <= LENGTH xs + LENGTH ys` by 1033 FULL_SIMP_TAC std_ss [LENGTH_mw_addv,NOT_LESS] 1034 \\ `LENGTH (mw_addv xs ys F) <= LENGTH zs` by DECIDE_TAC 1035 \\ IMP_RES_TAC LESS_EQ_LENGTH 1036 \\ FULL_SIMP_TAC std_ss [] 1037 \\ SEP_I_TAC "mc_add" \\ POP_ASSUM MP_TAC 1038 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1039 THEN1 (FULL_SIMP_TAC std_ss [X_LT_DIV] \\ DECIDE_TAC) 1040 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 1041 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,mc_iadd3_def,mc_iadd3_pre_def,LET_DEF] 1042 \\ FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w] 1043 \\ ONCE_REWRITE_TAC [WORD_AND_COMM] 1044 \\ FULL_SIMP_TAC std_ss [mc_header_AND_1] 1045 \\ FULL_SIMP_TAC std_ss [mc_header_def,AC MULT_COMM MULT_ASSOC] 1046 \\ Cases_on `t` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def, 1047 AC ADD_COMM ADD_ASSOC,word_add_n2w] \\ fs []) 1048 THEN1 1049 (ASSUME_TAC mc_add_thm 1050 \\ `LENGTH (mw_addv ys xs F) <= LENGTH ys + LENGTH xs` by 1051 (`LENGTH xs <= LENGTH ys` by DECIDE_TAC 1052 \\ FULL_SIMP_TAC std_ss [LENGTH_mw_addv]) 1053 \\ `LENGTH (mw_addv ys xs F) <= LENGTH zs` by DECIDE_TAC 1054 \\ IMP_RES_TAC LESS_EQ_LENGTH 1055 \\ FULL_SIMP_TAC std_ss [] 1056 \\ SEP_I_TAC "mc_add" \\ POP_ASSUM MP_TAC 1057 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1058 THEN1 (FULL_SIMP_TAC std_ss [X_LT_DIV] \\ DECIDE_TAC) 1059 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 1060 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,mc_iadd3_def,mc_iadd3_pre_def,LET_DEF] 1061 \\ FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w] 1062 \\ ONCE_REWRITE_TAC [WORD_AND_COMM] 1063 \\ FULL_SIMP_TAC std_ss [mc_header_AND_1] 1064 \\ FULL_SIMP_TAC std_ss [mc_header_def,AC MULT_COMM MULT_ASSOC] 1065 \\ Cases_on `t` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def, 1066 AC ADD_COMM ADD_ASSOC,word_add_n2w] \\ fs [])) 1067 \\ mp_tac mc_compare_thm 1068 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [] 1069 \\ strip_tac 1070 \\ FULL_SIMP_TAC std_ss [mw_compare_thm] 1071 \\ Cases_on `mw2n ys = mw2n xs` \\ FULL_SIMP_TAC std_ss [cmp2w_def] 1072 THEN1 (FULL_SIMP_TAC (srw_ss()) [mc_header_def,APPEND,LENGTH] \\ fs []) 1073 \\ Cases_on `mw2n xs < mw2n ys` \\ FULL_SIMP_TAC std_ss [GSYM NOT_LESS] 1074 \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,mc_iadd2_def,LET_DEF] 1075 THEN1 1076 (`LENGTH ys <= LENGTH zs` by DECIDE_TAC 1077 \\ IMP_RES_TAC LESS_EQ_LENGTH 1078 \\ FULL_SIMP_TAC std_ss [] 1079 \\ ASSUME_TAC mc_sub_thm 1080 \\ FULL_SIMP_TAC (srw_ss()) [mc_length] 1081 \\ SEP_I_TAC "mc_sub" \\ POP_ASSUM MP_TAC 1082 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1083 \\ `mw2n xs <= mw2n ys` by DECIDE_TAC 1084 \\ IMP_RES_TAC mw2n_LESS 1085 THEN1 (FULL_SIMP_TAC std_ss [X_LT_DIV] \\ DECIDE_TAC) 1086 \\ REPEAT STRIP_TAC 1087 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,mc_iadd3_def, 1088 mc_iadd3_pre_def,LET_DEF,one_neq_zero_word] 1089 \\ SIMP_TAC (srw_ss()) [GSYM APPEND_ASSOC,LENGTH_REPLICATE] 1090 \\ STRIP_TAC THEN1 1091 (FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w] 1092 \\ ONCE_REWRITE_TAC [WORD_AND_COMM] 1093 \\ FULL_SIMP_TAC std_ss [mc_header_AND_1] 1094 \\ FULL_SIMP_TAC std_ss [mc_header_def,AC MULT_COMM MULT_ASSOC] 1095 \\ FULL_SIMP_TAC std_ss [b2w_NOT] 1096 \\ Cases_on `s` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def, 1097 AC ADD_COMM ADD_ASSOC,word_add_n2w]) 1098 \\ `LENGTH (mw_subv ys xs) <= LENGTH ys` by ASM_SIMP_TAC std_ss [LENGTH_mw_subv] 1099 \\ DECIDE_TAC) 1100 \\ Cases_on`2 MOD dimword(:'a) = 0` \\ fs[] 1101 >- ( 1102 Cases_on`dimword(:'a)` \\ fs[] 1103 \\ Cases_on`n` \\ fs[] 1104 \\ Cases_on`n'` \\ fs[] 1105 \\ Cases_on`xs` \\ fs[] 1106 \\ Cases_on`ys` \\ fs[] ) 1107 \\ Cases_on`2 MOD dimword (:'a) = 1` \\ fs[] 1108 >- ( 1109 Cases_on`dimword(:'a)` \\ fs[] 1110 \\ Cases_on`n` \\ fs[] 1111 \\ Cases_on`n'` \\ fs[] ) 1112 THEN1 1113 (`LENGTH xs <= LENGTH zs` by DECIDE_TAC 1114 \\ IMP_RES_TAC LESS_EQ_LENGTH 1115 \\ FULL_SIMP_TAC std_ss [] 1116 \\ ASSUME_TAC mc_sub_thm 1117 \\ FULL_SIMP_TAC (srw_ss()) [mc_length] 1118 \\ SEP_I_TAC "mc_sub" \\ POP_ASSUM MP_TAC 1119 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1120 \\ `mw2n ys <= mw2n xs` by DECIDE_TAC 1121 \\ IMP_RES_TAC mw2n_LESS 1122 THEN1 (FULL_SIMP_TAC std_ss [X_LT_DIV] \\ DECIDE_TAC) 1123 \\ REPEAT STRIP_TAC 1124 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,mc_iadd3_def,mc_iadd3_pre_def,LET_DEF] 1125 \\ SIMP_TAC (srw_ss()) [GSYM APPEND_ASSOC,LENGTH_REPLICATE] 1126 \\ STRIP_TAC THEN1 1127 (FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w] 1128 \\ ONCE_REWRITE_TAC [WORD_AND_COMM] 1129 \\ FULL_SIMP_TAC std_ss [mc_header_AND_1] 1130 \\ FULL_SIMP_TAC std_ss [mc_header_def,AC MULT_COMM MULT_ASSOC] 1131 \\ FULL_SIMP_TAC std_ss [b2w_NOT] 1132 \\ Cases_on `s` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def, 1133 AC ADD_COMM ADD_ASSOC,word_add_n2w]) 1134 \\ `LENGTH (mw_subv xs ys) <= LENGTH xs` by ASM_SIMP_TAC std_ss [LENGTH_mw_subv] 1135 \\ DECIDE_TAC)); 1136 1137(* multiplication *) 1138 1139val (mc_single_mul_add_def, _, 1140 mc_single_mul_add_pre_def, _) = 1141 tailrec_define "mc_single_mul_add" `` 1142 (\(r0,r1,r2,r3). 1143 (let cond = T in 1144 let (r0,r2) = single_mul r0 r2 0w in 1145 let (r0,r4) = single_add_word r0 r1 0w in 1146 let (r2,r4) = single_add_word r2 0w r4 in 1147 let (r0,r4) = single_add_word r0 r3 0w in 1148 let (r2,r4) = single_add_word r2 0w r4 in 1149 (INR (r0,r1,r2,r3),cond))) 1150 :'a word # 'a word # 'a word # 'a word -> ('a word # 'a word # 'a 1151 word # 'a word + 'a word # 'a word # 'a word # 'a word) # bool``; 1152 1153val mc_single_mul_add_def = 1154 LIST_CONJ [mc_single_mul_add_def,mc_single_mul_add_pre_def] 1155 1156val mc_single_mul_add_thm = prove( 1157 ``mc_single_mul_add_pre (p,k,q,s) /\ 1158 (mc_single_mul_add (p,k,q,s) = 1159 let (x1,x2) = single_mul_add p q k s in (x1,k,x2,s))``, 1160 FULL_SIMP_TAC (srw_ss()) [mc_single_mul_add_def,LET_DEF] 1161 \\ Cases_on `k` \\ Cases_on `s` \\ Cases_on `p` \\ Cases_on `q` 1162 \\ FULL_SIMP_TAC (srw_ss()) [single_mul_add_def,LET_DEF,single_mul_def,b2n_thm, 1163 mw_add_def,single_add_def,b2n_def(*,b2w_def*),word_add_n2w,word_mul_n2w, 1164 single_add_word_def,EVAL ``b2w F``] 1165 \\ FULL_SIMP_TAC (srw_ss()) [single_mul_add_def,LET_DEF,single_mul_def,b2n_thm, 1166 mw_add_def,single_add_def,b2n_def,b2w_def,word_add_n2w,word_mul_n2w, 1167 single_add_word_def] 1168 \\ FULL_SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC, AC MULT_COMM MULT_ASSOC] 1169 \\ assume_tac ZERO_LT_dimword 1170 \\ qmatch_assum_abbrev_tac`0n < k` \\ pop_assum kall_tac 1171 \\ FULL_SIMP_TAC std_ss [ADD_ASSOC] 1172 \\ sg `n'' * n''' DIV k + b2n (k <= n + (n'' * n''') MOD k) = 1173 (n + n'' * n''') DIV k` \\ FULL_SIMP_TAC std_ss [] 1174 \\ Q.SPEC_TAC (`n'' * n'''`,`l`) \\ STRIP_TAC 1175 \\ `(n + l) DIV k = l DIV k + (n + l MOD k) DIV k` by 1176 (SIMP_TAC std_ss [Once ADD_COMM] 1177 \\ STRIP_ASSUME_TAC (SIMP_RULE bool_ss [PULL_FORALL] DIVISION 1178 |> Q.SPECL [`k`,`l`] |> UNDISCH_ALL |> ONCE_REWRITE_RULE [CONJ_COMM]) 1179 \\ POP_ASSUM (fn th => SIMP_TAC std_ss [Once th]) 1180 \\ FULL_SIMP_TAC std_ss [GSYM ADD_ASSOC,ADD_DIV_ADD_DIV] 1181 \\ FULL_SIMP_TAC std_ss [AC ADD_ASSOC ADD_COMM]) 1182 \\ FULL_SIMP_TAC std_ss [] 1183 \\ Cases_on `k <= n + l MOD k` \\ FULL_SIMP_TAC std_ss [b2n_def] 1184 \\ SIMP_TAC std_ss [Once EQ_SYM_EQ] 1185 \\ `l MOD k < k` by FULL_SIMP_TAC std_ss [] 1186 \\ ASM_SIMP_TAC std_ss [DIV_EQ_X] \\ DECIDE_TAC); 1187 1188val (mc_mul_pass_def, _, 1189 mc_mul_pass_pre_def, _) = 1190 tailrec_define "mc_mul_pass" `` 1191 (\(l,r1,r8,r9,r10,r11,ys,zs). 1192 if r9 = r11 then 1193 (let cond = w2n r10 < LENGTH zs in 1194 let zs = LUPDATE r1 (w2n r10) zs in 1195 let r10 = r10 + 0x1w 1196 in 1197 (INR (l,r1,r9,r10,ys,zs),cond)) 1198 else 1199 (let cond = w2n r10 < LENGTH zs in 1200 let r3 = EL (w2n r10) zs in 1201 let cond = cond /\ w2n r11 < LENGTH ys in 1202 let r2 = EL (w2n r11) ys in 1203 let r0 = r8 in 1204 let cond = cond /\ mc_single_mul_add_pre (r0,r1,r2,r3) in 1205 let (r0,r1,r2,r3) = mc_single_mul_add (r0,r1,r2,r3) in 1206 let zs = LUPDATE r0 (w2n r10) zs in 1207 let r1 = r2 in 1208 let r10 = r10 + 0x1w in 1209 let r11 = r11 + 0x1w 1210 in 1211 (INL (l-1,r1,r8,r9,r10,r11,ys,zs),cond /\ l <> 0))) 1212 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word 1213 list # 'a word list -> (num # 'a word # 'a word # 'a word # 'a 1214 word # 'a word # 'a word list # 'a word list + num # 'a word # 'a 1215 word # 'a word # 'a word list # 'a word list) # bool``; 1216 1217val (mc_mul_def, _, 1218 mc_mul_pre_def, _) = 1219 tailrec_define "mc_mul" `` 1220 (\(l,r7,r9,r10,r12,xs,ys,zs). 1221 if r7 = 0x0w then (let r10 = r10 + r9 in (INR (l,r10,xs,ys,zs),T)) 1222 else 1223 (let r7 = r7 - 0x1w in 1224 let cond = w2n r12 < LENGTH xs in 1225 let r8 = EL (w2n r12) xs in 1226 let r12 = r12 + 0x1w in 1227 let r11 = 0x0w in 1228 let r1 = r11 in 1229 let cond = cond /\ mc_mul_pass_pre (l-1,r1,r8,r9,r10,r11,ys,zs) /\ l <> 0 in 1230 let (l,r1,r9,r10,ys,zs) = mc_mul_pass (l-1,r1,r8,r9,r10,r11,ys,zs) in 1231 let r10 = r10 - r9 1232 in 1233 (INL (l-1,r7,r9,r10,r12,xs,ys,zs),cond /\ l <> 0))) 1234 :num # 'a word # 'a word # 'a word # 'a word # 'a word list # 'a 1235 word list # 'a word list -> (num # 'a word # 'a word # 'a word # 1236 'a word # 'a word list # 'a word list # 'a word list + num # 'a 1237 word # 'a word list # 'a word list # 'a word list) # bool``; 1238 1239val (mc_mul_zero_def, _, 1240 mc_mul_zero_pre_def, _) = 1241 tailrec_define "mc_mul_zero" `` 1242 (\(l:num,r0:'a word,r10:'a word,zs:'a word list). 1243 if r10 = 0x0w then (INR (l,r10,zs),T) 1244 else 1245 (let r10 = r10 - 0x1w in 1246 let cond = w2n r10 < LENGTH zs in 1247 let zs = LUPDATE r0 (w2n r10) zs 1248 in 1249 (INL (l-1,r0,r10,zs),cond /\ l <> 0)))``; 1250 1251val (mc_imul1_def, _, 1252 mc_imul1_pre_def, _) = 1253 tailrec_define "mc_imul1" `` 1254 (\(r10:'a word,r11:'a word). 1255 if r10 = r11 1256 then let r13 = (0w:'a word) in (INR (r10,r11,r13),T) 1257 else let r13 = (1w:'a word) in (INR (r10,r11,r13),T)) 1258 :�� word # �� word -> (�� word # �� word + �� word # �� word # �� word) # bool``; 1259 1260val (mc_imul_def, _, 1261 mc_imul_pre_def, _) = 1262 tailrec_define "mc_imul" `` 1263 ( \ (l,r1,r2,xs,ys,zs). 1264 (let r10 = 0x0w 1265 in 1266 if r1 = 0x0w then (INR (l,r10,xs,ys,zs),T) 1267 else if r2 = 0x0w then (INR (l,r10,xs,ys,zs),T) 1268 else 1269 (let r0 = 0x0w in 1270 let r10 = r2 in 1271 let r10 = r10 >>> 1 in 1272 let cond = mc_mul_zero_pre (l-1,r0,r10,zs) /\ l <> 0 in 1273 let (l,r10,zs) = mc_mul_zero (l-1,r0,r10,zs) in 1274 let r10 = r1 in 1275 let r10 = r10 && 0x1w in 1276 let r11 = r2 in 1277 let r11 = r11 && 0x1w in 1278 let (r10,r11,r13) = mc_imul1 (r10,r11) in 1279 let r7 = r1 in 1280 let r7 = r7 >>> 1 in 1281 let r9 = r2 in 1282 let r9 = r9 >>> 1 in 1283 let r10 = 0x0w in 1284 let r12 = 0x0w in 1285 let cond = cond /\ mc_mul_pre (l-1,r7,r9,r10,r12,xs,ys,zs) /\ l <> 0 in 1286 let (l,r10,xs,ys,zs) = mc_mul (l-1,r7,r9,r10,r12,xs,ys,zs) in 1287 let r8 = 0x0w in 1288 let cond = cond /\ mc_fix_pre (l-1,r8,r10,zs) /\ l <> 0 in 1289 let (l,r8,r10,zs) = mc_fix (l-1,r8,r10,zs) in 1290 let r10 = r10 << 1 in 1291 let r10 = r10 + r13 1292 in 1293 (INR (l,r10,xs,ys,zs),cond)))) 1294 :num # 'a word # 'a word # 'a word list # 'a word list # 'a word 1295 list -> (num # 'a word # 'a word # 'a word list # 'a word list # 1296 'a word list + num # 'a word # 'a word list # 'a word list # 'a 1297 word list) # bool``; 1298 1299val mc_mul_pass_thm = prove( 1300 ``!(ys:'a word list) ys1 x zs k zs1 zs2 z2 l. 1301 LENGTH (ys1++ys) < dimword (:'a) /\ (LENGTH zs = LENGTH ys) /\ 1302 LENGTH (zs1++zs) < dimword (:'a) /\ LENGTH ys <= l ==> 1303 ?r1 l2. 1304 mc_mul_pass_pre (l,k,x,n2w (LENGTH (ys1++ys)),n2w (LENGTH zs1), 1305 n2w (LENGTH ys1),ys1++ys,zs1++zs++z2::zs2) /\ 1306 (mc_mul_pass (l,k,x,n2w (LENGTH (ys1++ys)),n2w (LENGTH zs1), 1307 n2w (LENGTH ys1),ys1++ys,zs1++zs++z2::zs2) = 1308 (l2,r1,n2w (LENGTH (ys1++ys)),n2w (LENGTH (zs1++zs)+1),ys1++ys, 1309 zs1++(mw_mul_pass x ys zs k)++zs2)) /\ 1310 l <= l2 + LENGTH ys``, 1311 Induct \\ Cases_on `zs` 1312 \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND_NIL,mw_mul_pass_def,ADD1] 1313 \\ ONCE_REWRITE_TAC [mc_mul_pass_def,mc_mul_pass_pre_def] 1314 \\ FULL_SIMP_TAC std_ss [LET_DEF,n2w_11,w2n_n2w,LUPDATE_LENGTH] 1315 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,word_add_n2w,LENGTH_APPEND] 1316 \\ FULL_SIMP_TAC std_ss [LENGTH] 1317 \\ REPEAT STRIP_TAC 1318 \\ IMP_RES_TAC (DECIDE ``m+n<k ==> m < k /\ n<k:num``) 1319 \\ FULL_SIMP_TAC std_ss [ADD1,mc_single_mul_add_thm] 1320 \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,LUPDATE_LENGTH,NULL,HD] 1321 \\ Cases_on `single_mul_add x h' k h` \\ FULL_SIMP_TAC std_ss [LET_DEF,TL] 1322 \\ ONCE_REWRITE_TAC [SNOC_INTRO |> Q.INST [`xs2`|->`[]`] |> REWRITE_RULE [APPEND_NIL]] 1323 \\ `((LENGTH ys1 + (LENGTH ys + 1)) = (LENGTH (SNOC h' ys1) + LENGTH ys)) /\ 1324 ((LENGTH ys1 + 1) = (LENGTH (SNOC h' ys1))) /\ 1325 ((LENGTH zs1 + 1) = LENGTH (SNOC q zs1))` by (FULL_SIMP_TAC std_ss [LENGTH_SNOC] \\ DECIDE_TAC) 1326 \\ FULL_SIMP_TAC std_ss [] 1327 \\ SEP_I_TAC "mc_mul_pass" \\ POP_ASSUM MP_TAC 1328 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1329 THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 1330 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 1331 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND, 1332 LENGTH_APPEND,LENGTH,AC ADD_COMM ADD_ASSOC] \\ DECIDE_TAC) 1333 |> Q.SPECL [`ys`,`[]`] |> SIMP_RULE std_ss [APPEND,LENGTH] |> GEN_ALL; 1334 1335val WORD_SUB_LEMMA = prove( 1336 ``v + -1w * w = v - w``, 1337 FULL_SIMP_TAC (srw_ss()) []); 1338 1339val mc_mul_thm = prove( 1340 ``!(xs:'a word list) ys zs xs1 zs1 zs2 l. 1341 LENGTH (xs1 ++ xs) < dimword (:'a) /\ LENGTH ys < dimword (:'a) /\ 1342 (LENGTH zs = LENGTH ys) /\ LENGTH (zs1++zs++zs2) < dimword (:'a) /\ 1343 LENGTH xs <= LENGTH zs2 /\ ys <> [] /\ 1344 2 * LENGTH xs + LENGTH xs * LENGTH ys <= l ==> 1345 ?zs3 l2. 1346 mc_mul_pre (l,n2w (LENGTH xs),n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH xs1), 1347 xs1 ++ xs,ys,zs1 ++ zs ++ zs2) /\ 1348 (mc_mul (l,n2w (LENGTH xs),n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH xs1), 1349 xs1 ++ xs,ys,zs1 ++ zs ++ zs2) = 1350 (l2,n2w (LENGTH (zs1 ++ mw_mul xs ys zs)),xs1++xs,ys,zs1 ++ mw_mul xs ys zs ++ zs3)) /\ 1351 (LENGTH (zs1 ++ zs ++ zs2) = LENGTH (zs1 ++ mw_mul xs ys zs ++ zs3)) /\ 1352 l <= l2 + 2 * LENGTH xs + LENGTH xs * LENGTH ys``, 1353 Induct \\ ONCE_REWRITE_TAC [mc_mul_def,mc_mul_pre_def] 1354 \\ FULL_SIMP_TAC std_ss [LENGTH,mw_mul_def,APPEND_NIL,LET_DEF] 1355 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,word_add_n2w] 1356 THEN1 (METIS_TAC []) 1357 \\ NTAC 8 STRIP_TAC 1358 \\ IMP_RES_TAC (DECIDE ``m+n<k ==> m < k /\ n<k:num``) 1359 \\ IMP_RES_TAC (DECIDE ``SUC n < k ==> n < k``) 1360 \\ FULL_SIMP_TAC (srw_ss()) [] 1361 \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,LUPDATE_LENGTH,NULL,HD] 1362 \\ FULL_SIMP_TAC std_ss [GSYM word_sub_def,ADD1,GSYM word_add_n2w,WORD_ADD_SUB] 1363 \\ Cases_on `zs2` \\ FULL_SIMP_TAC std_ss [LENGTH] 1364 \\ ASSUME_TAC mc_mul_pass_thm 1365 \\ SEP_I_TAC "mc_mul_pass" \\ POP_ASSUM MP_TAC 1366 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1367 THEN1 (FULL_SIMP_TAC (srw_ss()) [RIGHT_ADD_DISTRIB] \\ fs []) 1368 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 1369 \\ `LENGTH (mw_mul_pass h ys zs 0x0w) = LENGTH ys + 1` by (FULL_SIMP_TAC std_ss [LENGTH_mw_mul_pass]) 1370 \\ Cases_on `mw_mul_pass h ys zs 0x0w` 1371 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 1372 \\ `n2w (LENGTH (zs1 ++ zs:'a word list) + 1) + -0x1w * n2w (LENGTH (ys:'a word list)) = 1373 n2w (LENGTH (SNOC h'' zs1)):'a word` by 1374 (FULL_SIMP_TAC std_ss [WORD_SUB_LEMMA,LENGTH,LENGTH_APPEND] 1375 \\ `LENGTH zs1 + LENGTH ys + 1 = (LENGTH zs1 + 1) + LENGTH ys` by DECIDE_TAC 1376 \\ ASM_SIMP_TAC std_ss [] 1377 \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB] 1378 \\ FULL_SIMP_TAC std_ss [word_add_n2w,LENGTH_SNOC,ADD1]) 1379 \\ `n2w (LENGTH xs1) + 0x1w = n2w (LENGTH (SNOC h xs1)):'a word` by (FULL_SIMP_TAC std_ss [word_add_n2w,LENGTH_SNOC,ADD1]) 1380 \\ FULL_SIMP_TAC std_ss [] 1381 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND] 1382 \\ ONCE_REWRITE_TAC [SNOC_INTRO |> Q.INST [`xs2`|->`[]`] |> REWRITE_RULE [APPEND_NIL]] 1383 \\ SEP_I_TAC "mc_mul" \\ POP_ASSUM MP_TAC 1384 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1385 THEN1 (fs [LEFT_ADD_DISTRIB]) 1386 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 1387 \\ SIMP_TAC std_ss [word_add_n2w,TL,LENGTH_SNOC,ADD1,HD,AC ADD_COMM ADD_ASSOC] 1388 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul] \\ STRIP_TAC 1389 \\ full_simp_tac std_ss [DECIDE ``(m+n1=m+n2) <=> (n1 = n2:num)``,GSYM ADD_ASSOC] 1390 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB,ADD1] 1391 \\ full_simp_tac std_ss [ADD_ASSOC] 1392 \\ fs [LENGTH_mw_mul]) 1393 |> Q.SPECL [`xs`,`ys`,`zs`,`[]`,`[]`,`zs2`] 1394 |> SIMP_RULE std_ss [LENGTH,APPEND] |> GEN_ALL; 1395 1396val mc_mul_zero_thm = prove( 1397 ``!zs zs1 l. 1398 LENGTH zs < dimword(:'a) /\ LENGTH zs <= l ==> 1399 mc_mul_zero_pre (l,0w:'a word,n2w (LENGTH zs),zs++zs1) /\ 1400 (mc_mul_zero (l,0w,n2w (LENGTH zs),zs++zs1) = 1401 (l - LENGTH zs,0w,MAP (\x.0w) zs ++ zs1))``, 1402 HO_MATCH_MP_TAC SNOC_INDUCT \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 1403 \\ NTAC 4 STRIP_TAC 1404 \\ ONCE_REWRITE_TAC [mc_mul_zero_def,mc_mul_zero_pre_def] 1405 \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.REPLICATE,LET_DEF] 1406 \\ NTAC 3 STRIP_TAC 1407 \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,ADD1,GSYM word_sub_def,WORD_ADD_SUB] 1408 \\ IMP_RES_TAC (DECIDE ``n+1<k ==> n<k:num``) 1409 \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w] 1410 \\ `LENGTH zs <= l-1` by fs [] 1411 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC, 1412 APPEND,LUPDATE_LENGTH,MAP_APPEND,MAP] \\ DECIDE_TAC); 1413 1414val MAP_EQ_MAP_EQ = prove( 1415 ``!xs ys. (MAP (\x.0w) xs = MAP (\x.0w) ys) = (LENGTH xs = LENGTH ys)``, 1416 Induct \\ Cases_on `ys` \\ FULL_SIMP_TAC (srw_ss()) []); 1417 1418val mc_imul1_thm = prove( 1419 ``mc_imul1_pre (r10,r11) /\ 1420 (mc_imul1 (r10,r11) = (r10,r11,if r10 = r11 then 0w else 1w))``, 1421 fs [mc_imul1_def,mc_imul1_pre_def] \\ rw []); 1422 1423val mc_imul_thm = prove( 1424 ``((mc_header (s,xs) = (0w:'a word)) = (xs = [])) /\ 1425 ((mc_header (t,ys) = 0w) = (ys = [])) /\ 1426 LENGTH xs < dimword (:'a) DIV 2 /\ LENGTH ys < dimword (:'a) DIV 2 /\ 1427 LENGTH xs + LENGTH ys <= LENGTH zs /\ LENGTH zs < dimword (:'a) DIV 2 /\ 1428 3 * LENGTH xs + 3 * LENGTH ys + LENGTH xs * LENGTH ys + 3 <= l ==> 1429 ?zs1 l2. 1430 mc_imul_pre (l,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) /\ 1431 (mc_imul (l,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) = 1432 (l2,mc_header (mwi_mul (s,xs) (t,ys)),xs,ys, 1433 SND (mwi_mul (s,xs) (t,ys))++zs1)) /\ 1434 (LENGTH (SND (mwi_mul (s,xs) (t,ys))++zs1) = LENGTH zs) /\ 1435 l <= l2 + 3 * LENGTH xs + 3 * LENGTH ys + LENGTH xs * LENGTH ys + 3``, 1436 FULL_SIMP_TAC std_ss [mc_imul_def,mc_imul_pre_def,LET_DEF,mc_imul1_thm] 1437 \\ FULL_SIMP_TAC std_ss [mc_header_EQ,mwi_mul_def,mc_length] 1438 \\ Cases_on `xs = []` \\ FULL_SIMP_TAC std_ss [APPEND] 1439 THEN1 (REPEAT STRIP_TAC \\ EVAL_TAC \\ simp[]) 1440 \\ Cases_on `ys = []` \\ FULL_SIMP_TAC std_ss [APPEND] 1441 THEN1 (REPEAT STRIP_TAC \\ EVAL_TAC \\ simp[]) 1442 \\ REPEAT STRIP_TAC 1443 \\ `LENGTH ys <= LENGTH zs` by DECIDE_TAC 1444 \\ `?qs1 qs2. (zs = qs1 ++ qs2) /\ (LENGTH ys = LENGTH qs1)` by 1445 METIS_TAC [LESS_EQ_LENGTH] 1446 \\ `LENGTH qs1 < dimword (:'a)` by (fs [X_LT_DIV] \\ DECIDE_TAC) 1447 \\ `LENGTH ys <= l-1` by fs [] 1448 \\ REV_FULL_SIMP_TAC std_ss [mc_mul_zero_thm] 1449 \\ ASSUME_TAC mc_mul_thm 1450 \\ Q.PAT_X_ASSUM `LENGTH ys = LENGTH qs1` (ASSUME_TAC o GSYM) 1451 \\ `MAP (\x. 0x0w:'a word) qs1 = MAP (\x. 0x0w) ys` by 1452 (ASM_SIMP_TAC std_ss [MAP_EQ_MAP_EQ] \\ NO_TAC) 1453 \\ FULL_SIMP_TAC std_ss [] 1454 \\ SEP_I_TAC "mc_mul" \\ POP_ASSUM MP_TAC 1455 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1456 THEN1 (fs [LENGTH_APPEND,X_LT_DIV]) 1457 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 1458 \\ `LENGTH qs1 < dimword (:'a)` by (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC) 1459 \\ `LENGTH (mw_mul xs ys (MAP (\x. 0x0w) ys)) < dimword (:'a)` by (FULL_SIMP_TAC (srw_ss()) [LENGTH_mw_mul,LENGTH_MAP,X_LT_DIV] \\ DECIDE_TAC) 1460 \\ ASSUME_TAC mc_fix_thm \\ SEP_I_TAC "mc_fix" \\ POP_ASSUM MP_TAC 1461 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 1462 THEN1 (fs [LENGTH_mw_mul]) 1463 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 1464 \\ Cases_on `s = t` \\ FULL_SIMP_TAC std_ss [] 1465 \\ FULL_SIMP_TAC std_ss [mc_header_def,GSYM APPEND_ASSOC] 1466 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_REPLICATE,WORD_MUL_LSL,word_mul_n2w] 1467 \\ FULL_SIMP_TAC std_ss [AC MULT_COMM MULT_ASSOC] 1468 \\ Q.ABBREV_TAC `ts = mw_mul xs ys (MAP (\x. 0x0w) ys)` 1469 \\ `LENGTH (mw_fix ts) <= LENGTH ts` by FULL_SIMP_TAC std_ss [LENGTH_mw_fix] 1470 \\ rpt strip_tac \\ TRY decide_tac 1471 \\ unabbrev_all_tac \\ fs [LENGTH_mw_mul]); 1472 1473(* simple div xs into zs and zs into zs *) 1474 1475val single_div_pre_def = Define ` 1476 single_div_pre r2 r0 r9 <=> 1477 r9 <> (0x0w:'a word) /\ 1478 (w2n r2 * dimword(:'a) + w2n r0) DIV w2n r9 < dimword(:'a)`; 1479 1480val (mc_single_div_def, _, 1481 mc_single_div_pre_def, _) = 1482 tailrec_define "mc_single_div" `` 1483 (\(r0,r2,r9). 1484 (let cond = single_div_pre r2 r0 r9 in 1485 let (r0,r2) = single_div r2 r0 r9 1486 in 1487 (INR (r0,r2,r9),cond))) 1488 :'a word # 'a word # 'a word -> ('a word # 'a word # 'a word + 'a 1489 word # 'a word # 'a word) # bool``; 1490 1491val mc_single_div_def = LIST_CONJ [mc_single_div_def,mc_single_div_pre_def] 1492 1493val MULT_LEMMA_LEMMA = prove( 1494 ``!m n. l < k /\ l + k * m < k + k * n ==> m <= n:num``, 1495 Induct \\ Cases_on `n` \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES] 1496 THEN1 (REPEAT STRIP_TAC \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC) 1497 \\ REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!x.bbb` MATCH_MP_TAC 1498 \\ FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC); 1499 1500val MULT_LEMMA = prove( 1501 ``l < k ==> (l + k * m < k + k * n = m <= n:num)``, 1502 REPEAT STRIP_TAC \\ REV EQ_TAC \\ REPEAT STRIP_TAC THEN1 1503 (SUFF_TAC ``k * m <= k * n:num`` \\ REPEAT STRIP_TAC THEN1 DECIDE_TAC 1504 \\ MATCH_MP_TAC LESS_MONO_MULT2 \\ FULL_SIMP_TAC std_ss []) 1505 \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [GSYM NOT_LESS] 1506 \\ IMP_RES_TAC MULT_LEMMA_LEMMA \\ DECIDE_TAC); 1507 1508val mc_single_div_thm = prove( 1509 ``(mc_single_div_pre (x2,x1,y) = x1 <+ y) /\ 1510 (mc_single_div (x2,x1,y) = let (q,r) = single_div x1 x2 y in (q,r,y))``, 1511 FULL_SIMP_TAC (srw_ss()) [mc_single_div_def,single_div_def,LET_DEF, 1512 single_div_pre_def] 1513 \\ Cases_on `y` \\ Cases_on `n` \\ FULL_SIMP_TAC (srw_ss()) [WORD_LO,DIV_LT_X] 1514 \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES] 1515 \\ SIMP_TAC std_ss [Once ADD_COMM] \\ SIMP_TAC std_ss [Once MULT_COMM] 1516 \\ `w2n x2 < dimword(:'a)` by 1517 (ASSUME_TAC (w2n_lt |> Q.SPEC `x2`) 1518 \\ FULL_SIMP_TAC (srw_ss()) []) 1519 \\ FULL_SIMP_TAC std_ss [MULT_LEMMA] 1520 \\ DECIDE_TAC); 1521 1522val (mc_simple_div_def, _, 1523 mc_simple_div_pre_def, _) = 1524 tailrec_define "mc_simple_div" `` 1525 (\(l,r2,r9,r10,xs,zs). 1526 if r10 = 0x0w then (INR (l,r2,r9,r10,xs,zs),T) 1527 else 1528 (let r10 = r10 - 0x1w in 1529 let cond = w2n r10 < LENGTH xs in 1530 let r0 = EL (w2n r10) xs in 1531 let cond = cond /\ mc_single_div_pre (r0,r2,r9) in 1532 let (r0,r2,r9) = mc_single_div (r0,r2,r9) in 1533 let cond = cond /\ w2n r10 < LENGTH zs in 1534 let zs = LUPDATE r0 (w2n r10) zs 1535 in 1536 (INL (l-1,r2,r9,r10,xs,zs),cond /\ l <> 0))) 1537 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list -> 1538 (num # 'a word # 'a word # 'a word # 'a word list # 'a word list + 1539 num # 'a word # 'a word # 'a word # 'a word list # 'a word list) # bool``; 1540 1541val (mc_simple_div1_def, _, 1542 mc_simple_div1_pre_def, _) = 1543 tailrec_define "mc_simple_div1" `` 1544 (\(l,r2,r9,r10,zs). 1545 if r10 = 0x0w then (INR (l,r2,r9,r10,zs),T) 1546 else 1547 (let r10 = r10 - 0x1w in 1548 let cond = w2n r10 < LENGTH zs in 1549 let r0 = EL (w2n r10) zs in 1550 let cond = cond /\ mc_single_div_pre (r0,r2,r9) in 1551 let (r0,r2,r9) = mc_single_div (r0,r2,r9) in 1552 let zs = LUPDATE r0 (w2n r10) zs 1553 in 1554 (INL (l-1,r2,r9,r10,zs),cond /\ l <> 0))) 1555 :num # 'a word # 'a word # 'a word # 'a word list -> (num # 'a 1556 word # 'a word # 'a word # 'a word list + num # 'a word # 'a word 1557 # 'a word # 'a word list) # bool``; 1558 1559val mc_simple_div_thm = prove( 1560 ``!(xs:'a word list) xs1 zs zs1 r2 r9 qs r l. 1561 LENGTH xs < dimword(:'a) /\ (LENGTH zs = LENGTH xs) /\ 1562 LENGTH xs <= l /\ 1563 (mw_simple_div r2 (REVERSE xs) r9 = (qs,r,T)) ==> 1564 mc_simple_div_pre (l,r2,r9,n2w (LENGTH xs),xs++xs1,zs++zs1) /\ 1565 (mc_simple_div (l,r2,r9,n2w (LENGTH xs),xs++xs1,zs++zs1) = 1566 (l - LENGTH xs,r,r9,0w,xs++xs1,REVERSE qs++zs1))``, 1567 HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1 1568 (REPEAT STRIP_TAC \\ POP_ASSUM MP_TAC 1569 \\ FULL_SIMP_TAC std_ss [LENGTH,Once mc_simple_div_pre_def, 1570 Once mc_simple_div_def,REVERSE,mw_simple_div_def] 1571 \\ Q.SPEC_TAC (`qs`,`qs`) 1572 \\ Cases_on `zs` \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,ADD1]) 1573 \\ NTAC 12 STRIP_TAC 1574 \\ FULL_SIMP_TAC std_ss [REVERSE_SNOC,mw_simple_div_def,LET_DEF] 1575 \\ `(zs = []) \/ ?z zs2. zs = SNOC z zs2` by METIS_TAC [SNOC_CASES] 1576 THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH]) 1577 \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC] 1578 \\ SIMP_TAC std_ss [LENGTH,Once mc_simple_div_pre_def, 1579 Once mc_simple_div_def,REVERSE,mw_simple_div_def] 1580 \\ FULL_SIMP_TAC (srw_ss()) [n2w_11,LET_DEF] 1581 \\ FULL_SIMP_TAC std_ss [ADD1,GSYM word_add_n2w,GSYM word_sub_def,WORD_ADD_SUB] 1582 \\ IMP_RES_TAC (DECIDE ``n+1<k ==> n<k:num``) 1583 \\ FULL_SIMP_TAC (srw_ss()) [] 1584 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH] 1585 \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,NULL,HD] 1586 \\ Q.PAT_X_ASSUM `LENGTH zs2 = LENGTH xs` (ASSUME_TAC o GSYM) 1587 \\ `LENGTH zs2 ��� l - 1` by fs [] 1588 \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH,mc_single_div_thm] 1589 \\ `?q1 r1. single_div r2 x r9 = (q1,r1)` by METIS_TAC [PAIR] 1590 \\ `?qs2 r2 c2. mw_simple_div r1 (REVERSE xs) r9 = (qs2,r2,c2)` by METIS_TAC [PAIR] 1591 \\ FULL_SIMP_TAC std_ss [LET_DEF] \\ rfs [] 1592 \\ `LENGTH zs2 ��� l - 1 /\ (LENGTH zs2 = LENGTH zs2)` by fs [] 1593 \\ res_tac \\ fs [] 1594 \\ Q.PAT_X_ASSUM `q1::qs2 = qs` (ASSUME_TAC o GSYM) 1595 \\ FULL_SIMP_TAC std_ss [REVERSE,SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]); 1596 1597val mc_simple_div1_thm = prove( 1598 ``!(zs:'a word list) zs1 r2 r9 qs r l. 1599 LENGTH zs < dimword(:'a) /\ LENGTH zs <= l /\ 1600 (mw_simple_div r2 (REVERSE zs) r9 = (qs,r,T)) ==> 1601 mc_simple_div1_pre (l,r2,r9,n2w (LENGTH zs),zs++zs1) /\ 1602 (mc_simple_div1 (l,r2,r9,n2w (LENGTH zs),zs++zs1) = 1603 (l - LENGTH zs,r,r9,0w,REVERSE qs++zs1))``, 1604 HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1 1605 (REPEAT STRIP_TAC \\ POP_ASSUM MP_TAC 1606 \\ FULL_SIMP_TAC std_ss [LENGTH,Once mc_simple_div1_pre_def, 1607 Once mc_simple_div1_def,REVERSE,mw_simple_div_def] 1608 \\ Q.SPEC_TAC (`qs`,`qs`) \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,ADD1]) 1609 \\ NTAC 10 STRIP_TAC 1610 \\ FULL_SIMP_TAC std_ss [REVERSE_SNOC,mw_simple_div_def,LET_DEF] 1611 \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC] 1612 \\ SIMP_TAC std_ss [LENGTH,Once mc_simple_div1_pre_def, 1613 Once mc_simple_div1_def,REVERSE,mw_simple_div_def] 1614 \\ FULL_SIMP_TAC (srw_ss()) [n2w_11,LET_DEF] 1615 \\ FULL_SIMP_TAC std_ss [ADD1,GSYM word_add_n2w,GSYM word_sub_def,WORD_ADD_SUB] 1616 \\ IMP_RES_TAC (DECIDE ``n+1<k ==> n<k:num``) 1617 \\ FULL_SIMP_TAC (srw_ss()) [] 1618 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH] 1619 \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,NULL,HD] 1620 \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH,mc_single_div_thm] 1621 \\ `?q1 r1. single_div r2 x r9 = (q1,r1)` by METIS_TAC [PAIR] 1622 \\ `?qs2 r2 c2. mw_simple_div r1 (REVERSE zs) r9 = (qs2,r2,c2)` by METIS_TAC [PAIR] 1623 \\ FULL_SIMP_TAC std_ss [LET_DEF] \\ rfs [] 1624 \\ `LENGTH zs ��� l - 1` by fs [] 1625 \\ res_tac \\ fs [] 1626 \\ Q.PAT_X_ASSUM `q1::qs2 = qs` (ASSUME_TAC o GSYM) 1627 \\ FULL_SIMP_TAC std_ss [REVERSE,SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]); 1628 1629(* mw_div -- calc_d *) 1630 1631val (mc_calc_d_def, _, 1632 mc_calc_d_pre_def, _) = 1633 tailrec_define "mc_calc_d" `` 1634 (\(l,r1,r2). 1635 (if r1 < 0w then (INR (l,r2),T) else 1636 (let r1 = r1 + r1 in let r2 = r2 + r2 in (INL (l-1,r1,r2),l <> 0)))) 1637 :num # 'a word # 'a word -> (num # 'a word # 'a word + num # 'a word) # bool``; 1638 1639val mc_calc_d_thm = prove( 1640 ``!(v1:'a word) d. 1641 (\(v1,d). 1642 !l n. 1643 (v1 <> 0w) /\ dimword (:'a) <= w2n v1 * 2 ** n /\ n <= l ==> 1644 ?l2. 1645 mc_calc_d_pre (l,v1,d) /\ 1646 (mc_calc_d (l,v1,d) = (l2,calc_d (v1,d))) /\ 1647 l <= l2 + n) (v1,d)``, 1648 MATCH_MP_TAC (calc_d_ind) 1649 \\ FULL_SIMP_TAC std_ss [] \\ rpt STRIP_TAC 1650 \\ ONCE_REWRITE_TAC [mc_calc_d_pre_def,mc_calc_d_def,calc_d_def] 1651 \\ FULL_SIMP_TAC std_ss [LET_THM,GSYM wordsTheory.word_msb_neg] 1652 \\ IF_CASES_TAC \\ fs [] 1653 \\ FULL_SIMP_TAC std_ss [GSYM addressTheory.WORD_TIMES2, 1654 AC WORD_MULT_ASSOC WORD_MULT_COMM] 1655 \\ Cases_on `n = 0` \\ fs [] 1656 THEN1 (fs [w2n_lt,GSYM NOT_LESS]) 1657 \\ first_x_assum (qspecl_then [`l-1`,`n-1`] mp_tac) 1658 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 1659 (fs [] \\ Cases_on `v1` \\ fs [word_mul_n2w] 1660 \\ sg `2 * n' < dimword (:'a)` 1661 \\ fs [] \\ Cases_on `n` \\ fs [EXP] 1662 \\ fs [word_msb_n2w] 1663 \\ fs [bitTheory.BIT_def,bitTheory.BITS_THM2] 1664 \\ Cases_on `dimindex (:��)` \\ fs [] 1665 \\ fs [MATCH_MP (DECIDE ``0 < n ==> n <> 0n``) DIMINDEX_GT_0] 1666 \\ fs [ADD1,dimword_def] 1667 \\ fs [DIV_EQ_X] 1668 \\ fs [EXP,EXP_ADD]) 1669 \\ strip_tac \\ fs [] 1670 \\ Cases_on `n` \\ fs [] 1671 \\ fs [w2n_lt,GSYM NOT_LESS]) 1672 |> SIMP_RULE std_ss [] 1673 |> Q.SPECL [`v1`,`d`,`l`,`dimindex (:'a)`] 1674 |> SIMP_RULE std_ss [GSYM dimword_def, 1675 MATCH_MP (DECIDE ``0 < n ==> n <> 0n``) ZERO_LT_dimword] 1676 |> GEN_ALL; 1677 1678(* mw_div -- mw_div_guess *) 1679 1680val (mc_single_mul_def, _, 1681 mc_single_mul_pre_def, _) = 1682 tailrec_define "mc_single_mul" `` 1683 (\(r0,r1,r2). 1684 (let cond = T in 1685 let (r0,r2) = single_mul r0 r2 0w in 1686 let (r0,r4) = single_add_word r0 r1 0w in 1687 let (r2,r4) = single_add_word r2 0w r4 1688 in 1689 (INR (r0,r1,r2),cond))) 1690 :'a word # 'a word # 'a word -> ('a word # 'a word # 'a word + 'a 1691 word # 'a word # 'a word) # bool``; 1692 1693val mc_single_mul_def = LIST_CONJ [mc_single_mul_def,mc_single_mul_pre_def] 1694 1695val single_mul_add_thm = prove( 1696 ``single_mul_add p q k s = 1697 (let (r0,r1,r2,r3) = mc_single_mul_add (p,k,q,s) in 1698 (r0,r2))``, 1699 SIMP_TAC std_ss [mc_single_mul_add_thm] 1700 \\ Q.SPEC_TAC (`single_mul_add p q k s`,`w`) 1701 \\ FULL_SIMP_TAC std_ss [FORALL_PROD,LET_DEF]); 1702 1703val single_add_0_F = prove( 1704 ``(single_add w 0w F = (x,c)) <=> (x = w) /\ ~c``, 1705 fs [single_add_def,EVAL ``b2w F``,b2n_def,GSYM NOT_LESS,w2n_lt] 1706 \\ eq_tac \\ rw []); 1707 1708val mc_single_mul_thm = prove( 1709 ``mc_single_mul_pre (p,k,q) /\ 1710 (mc_single_mul (p,k,q) = 1711 let (x1,x2) = single_mul_add p q k 0w in (x1,k,x2))``, 1712 SIMP_TAC (srw_ss()) [single_mul_add_thm,mc_single_mul_def,LET_DEF, 1713 mc_single_mul_add_def,single_add_word_def] \\ SIMP_TAC std_ss [] 1714 \\ SIMP_TAC std_ss [GSYM NOT_LESS,w2n_lt,EVAL ``b2n F``,WORD_ADD_0] 1715 \\ rpt (pairarg_tac \\ fs []) 1716 \\ rw [] \\ fs [single_add_0_F] \\ rw [] \\ fs [single_add_0_F]); 1717 1718val (mc_mul_by_single2_def, _, 1719 mc_mul_by_single2_pre_def, _) = 1720 tailrec_define "mc_mul_by_single2" `` 1721 (\(r6,r7,r8). 1722 (let r0 = r6 in 1723 let r1 = 0x0w in 1724 let r2 = r7 in 1725 let cond = mc_single_mul_pre (r0,r1,r2) in 1726 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 1727 let r12 = r0 in 1728 let r0 = r6 in 1729 let r1 = r2 in 1730 let r2 = r8 in 1731 let cond = cond /\ mc_single_mul_pre (r0,r1,r2) in 1732 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 1733 let r3 = r2 in 1734 let r2 = r0 in 1735 let r1 = r12 1736 in 1737 (INR (r1,r2,r3,r6,r7,r8),cond))) 1738 :'a word # 'a word # 'a word -> ('a word # 'a word # 'a word + 'a 1739 word # 'a word # 'a word # 'a word # 'a word # 'a word) # bool``; 1740 1741val mc_mul_by_single2_thm = prove( 1742 ``!r6 r7 r8. 1743 ?r1 r2 r3. 1744 mc_mul_by_single2_pre (r6,r7,r8) /\ 1745 (mc_mul_by_single2 (r6,r7,r8) = (r1,r2,r3,r6,r7,r8)) /\ 1746 (mw_mul_by_single r6 [r7; r8] = [r1; r2; r3])``, 1747 SIMP_TAC std_ss [mw_mul_by_single_def,LENGTH,mw_mul_pass_def,mc_single_mul_thm, 1748 k2mw_def,HD,TL,mc_mul_by_single2_def,EVAL ``(k2mw 2 0):'a word list``,LET_DEF] 1749 \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV)) 1750 \\ assume_tac ZERO_LT_dimword 1751 \\ ASM_SIMP_TAC std_ss [mc_mul_by_single2_pre_def,LET_DEF,mc_single_mul_add_def,ZERO_DIV] 1752 \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV)) 1753 \\ SIMP_TAC std_ss [mc_mul_by_single2_pre_def,LET_DEF,mc_single_mul_add_def] 1754 \\ SIMP_TAC std_ss [mc_single_mul_thm] \\ EVAL_TAC); 1755 1756val (mc_cmp3_def, _, 1757 mc_cmp3_pre_def, _) = 1758 tailrec_define "mc_cmp3" `` 1759 (\(r1,r2,r3,r9,r10,r11). 1760 (let r0 = 0x1w 1761 in 1762 if r3 = r11 then 1763 if r2 = r10 then 1764 if r1 = r9 then 1765 (let r0 = 0x0w in (INR (r0,r1,r2,r3,r9,r10,r11),T)) 1766 else if r9 <+ r1 then (INR (r0,r1,r2,r3,r9,r10,r11),T) 1767 else (let r0 = 0x0w in (INR (r0,r1,r2,r3,r9,r10,r11),T)) 1768 else if r10 <+ r2 then (INR (r0,r1,r2,r3,r9,r10,r11),T) 1769 else (let r0 = 0x0w in (INR (r0,r1,r2,r3,r9,r10,r11),T)) 1770 else if r11 <+ r3 then (INR (r0,r1,r2,r3,r9,r10,r11),T) 1771 else (let r0 = 0x0w in (INR (r0,r1,r2,r3,r9,r10,r11),T)))) 1772 :'a word # 'a word # 'a word # 'a word # 'a word # 'a word -> ('a 1773 word # 'a word # 'a word # 'a word # 'a word # 'a word + 'a word 1774 # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word) # 1775 bool``; 1776 1777val mc_cmp3_thm = prove( 1778 ``mc_cmp3_pre (r1,r2,r3,r9,r10,r11) /\ 1779 (mc_cmp3 (r1,r2,r3,r9,r10,r11) = 1780 (if mw_cmp [r9;r10;r11] [r1;r2;r3] = SOME T then 1w else 0w, 1781 r1,r2,r3,r9,r10,r11))``, 1782 NTAC 5 (ONCE_REWRITE_TAC [mw_cmp_def]) 1783 \\ SIMP_TAC (srw_ss()) [mc_cmp3_def,mc_cmp3_pre_def,LET_DEF] 1784 \\ Tactical.REVERSE (Cases_on `r3 = r11`) 1785 \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] [] 1786 \\ Tactical.REVERSE (Cases_on `r2 = r10`) 1787 \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] [] 1788 \\ Tactical.REVERSE (Cases_on `r1 = r9`) 1789 \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []); 1790 1791val (mc_cmp_mul2_def, _, 1792 mc_cmp_mul2_pre_def, _) = 1793 tailrec_define "mc_cmp_mul2" `` 1794 (\(r6,r7,r8,r9,r10,r11). 1795 (let cond = mc_mul_by_single2_pre (r6,r7,r8) in 1796 let (r1,r2,r3,r6,r7,r8) = mc_mul_by_single2 (r6,r7,r8) in 1797 let (r0,r1,r2,r3,r9,r10,r11) = mc_cmp3 (r1,r2,r3,r9,r10,r11) 1798 in 1799 (INR (r0,r6,r7,r8,r9,r10,r11),cond))) 1800 :'a word # 'a word # 'a word # 'a word # 'a word # 'a word -> ('a 1801 word # 'a word # 'a word # 'a word # 'a word # 'a word + 'a word 1802 # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word) # 1803 bool``; 1804 1805val mc_cmp_mul2_thm = prove( 1806 ``mc_cmp_mul2_pre (r6,r7,r8,r9,r10,r11) /\ 1807 (mc_cmp_mul2 (r6,r7,r8,r9,r10,r11) = 1808 ((if mw_cmp [r9;r10;r11] (mw_mul_by_single r6 [r7; r8]) = SOME T 1809 then 1w else 0w),r6,r7,r8,r9,r10,r11))``, 1810 SIMP_TAC std_ss [mc_cmp_mul2_pre_def,mc_cmp_mul2_def] 1811 \\ STRIP_ASSUME_TAC (mc_mul_by_single2_thm |> SPEC_ALL) 1812 \\ FULL_SIMP_TAC std_ss [LET_DEF,mc_cmp3_thm]); 1813 1814val (mc_sub1_def, _, 1815 mc_sub1_pre_def, _) = 1816 tailrec_define "mc_sub1" `` 1817 (\r6. 1818 if r6 = 0x0w then (INR r6,T) else (let r6 = r6 - 0x1w in (INR r6,T))) 1819 :'a word -> ('a word + 'a word) # bool``; 1820 1821val mc_sub1_thm = prove( 1822 ``!r6. mc_sub1_pre r6 /\ (mc_sub1 r6 = n2w (w2n r6 - 1))``, 1823 Cases \\ ASM_SIMP_TAC (srw_ss()) [mc_sub1_pre_def,mc_sub1_def] 1824 \\ Cases_on `n = 0` \\ FULL_SIMP_TAC std_ss [LET_DEF,GSYM word_sub_def] 1825 \\ `~(n < 1)` by DECIDE_TAC 1826 \\ ASM_SIMP_TAC std_ss [addressTheory.word_arith_lemma2]); 1827 1828val (mc_cmp2_def, _, 1829 mc_cmp2_pre_def, _) = 1830 tailrec_define "mc_cmp2" `` 1831 (\(r0,r2,r10,r11). 1832 (let r1 = 0x1w 1833 in 1834 if r2 = r11 then 1835 if r0 = r10 then (let r1 = 0x0w in (INR (r0,r1,r2,r10,r11),T)) 1836 else if r10 <+ r0 then (INR (r0,r1,r2,r10,r11),T) 1837 else (let r1 = 0x0w in (INR (r0,r1,r2,r10,r11),T)) 1838 else if r11 <+ r2 then (INR (r0,r1,r2,r10,r11),T) 1839 else (let r1 = 0x0w in (INR (r0,r1,r2,r10,r11),T)))) 1840 :'a word # 'a word # 'a word # 'a word -> ('a word # 'a word # 'a 1841 word # 'a word + 'a word # 'a word # 'a word # 'a word # 'a word) 1842 # bool``; 1843 1844val mc_cmp2_thm = prove( 1845 ``mc_cmp2_pre (r0,r2,r10,r11) /\ 1846 (mc_cmp2 (r0,r2,r10,r11) = 1847 (r0,if mw_cmp [r10;r11] [r0;r2] = SOME T then 1w else 0w, 1848 r2,r10,r11))``, 1849 NTAC 5 (ONCE_REWRITE_TAC [mw_cmp_def]) 1850 \\ SIMP_TAC (srw_ss()) [mc_cmp2_def,mc_cmp2_pre_def,LET_DEF] 1851 \\ Tactical.REVERSE (Cases_on `r2 = r11`) 1852 \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] [] 1853 \\ Tactical.REVERSE (Cases_on `r0 = r10`) 1854 \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []); 1855 1856val (mc_div_test_def, _, 1857 mc_div_test_pre_def, _) = 1858 tailrec_define "mc_div_test" `` 1859 (\(l,r6,r7,r8,r9,r10,r11). 1860 (let cond = mc_cmp_mul2_pre (r6,r7,r8,r9,r10,r11) in 1861 let (r0,r6,r7,r8,r9,r10,r11) = mc_cmp_mul2 (r6,r7,r8,r9,r10,r11) 1862 in 1863 if r0 = 0x0w then (INR (l,r6,r7,r8,r9,r10,r11),cond) 1864 else 1865 (let r6 = mc_sub1 r6 in 1866 let r0 = r6 in 1867 let r1 = 0x0w in 1868 let r2 = r8 in 1869 let r3 = r1 in 1870 let cond = cond /\ mc_single_mul_add_pre (r0,r1,r2,r3) in 1871 let (r0,r1,r2,r3) = mc_single_mul_add (r0,r1,r2,r3) in 1872 let r2 = r2 + 0x1w in 1873 let (r0,r1,r2,r10,r11) = mc_cmp2 (r0,r2,r10,r11) 1874 in 1875 if r1 = 0x0w then (INR (l,r6,r7,r8,r9,r10,r11),cond) 1876 else (INL (l-1,r6,r7,r8,r9,r10,r11),cond /\ l <> 0n)))) 1877 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word -> 1878 (num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word + 1879 num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word) # bool``; 1880 1881val single_mul_thm = prove( 1882 ``single_mul_add x y 0w 0w = single_mul x y 0w``, 1883 SIMP_TAC (srw_ss()) [single_mul_add_def,single_mul_def,LET_DEF, 1884 mw_add_def,single_add_def,b2n_def,b2w_def,GSYM NOT_LESS,w2n_lt]); 1885 1886val mw_add_0_1 = prove( 1887 ``(FST (mw_add [r0;r2] [0w;1w] F) = [r0;r2+1w])``, 1888 SIMP_TAC (srw_ss()) [mw_add_def,HD,TL,single_add_def,b2w_def, 1889 LET_DEF,EVAL ``b2n F``,GSYM NOT_LESS,w2n_lt]); 1890 1891val mc_div_test_lemma = prove( 1892 ``!q u1 u2 u3 v1 v2 l. 1893 w2n q <= l ==> 1894 ?l2. 1895 mc_div_test_pre (l,q,v2,v1,u3,u2,u1) /\ 1896 (mc_div_test (l,q,v2,v1,u3,u2,u1) = 1897 (l2,mw_div_test q u1 u2 u3 v1 v2,v2,v1,u3,u2,u1)) /\ 1898 l <= l2 + w2n q``, 1899 HO_MATCH_MP_TAC mw_div_test_ind \\ rpt strip_tac 1900 \\ ONCE_REWRITE_TAC [mc_div_test_def,mc_div_test_pre_def,mw_div_test_def] 1901 \\ SIMP_TAC std_ss [mc_cmp_mul2_thm] 1902 \\ Cases_on `mw_cmp [u3; u2; u1] (mw_mul_by_single q [v2; v1]) = SOME T` 1903 \\ ASM_SIMP_TAC std_ss [LET_DEF,GSYM one_neq_zero_word,mc_sub1_thm] 1904 \\ FULL_SIMP_TAC std_ss [mc_single_mul_add_thm,GSYM single_mul_thm] 1905 \\ Cases_on `single_mul_add (n2w (w2n q - 1)) v1 0x0w 0x0w` 1906 \\ FULL_SIMP_TAC std_ss [LET_DEF,mc_cmp2_thm] 1907 \\ Q.MATCH_ASSUM_RENAME_TAC 1908 `single_mul_add (n2w (w2n q - 1)) v1 0x0w 0x0w = (q1,q2)` 1909 \\ FULL_SIMP_TAC std_ss [mw_add_0_1] 1910 \\ Cases_on `mw_cmp [u2; u1] [q1; q2 + 0x1w] = SOME T` 1911 \\ FULL_SIMP_TAC std_ss [GSYM one_neq_zero_word] 1912 \\ Cases_on `w2n q` THEN1 ( 1913 qsuff_tac `mw_cmp [u3; u2; u1] (mw_mul_by_single 0w [v2; v1]) <> SOME T` 1914 THEN1 fs[] >> 1915 Q.PAT_ABBREV_TAC `x = mw_mul_by_single 0w [v2;v1]` >> 1916 Q.PAT_ABBREV_TAC `u = [u3;u2;u1]` >> 1917 `LENGTH x = LENGTH u` by fs[mw_mul_by_single_lemma,Abbr`x`,Abbr`u`] >> 1918 `~(mw2n u < mw2n x)` by rw[mw_mul_by_single_lemma,Abbr`x`] >> 1919 fs[mw_cmp_thm]) 1920 \\ fs [ADD1] 1921 \\ Cases_on `q` \\ fs [] \\ rw [] 1922 \\ first_x_assum (qspec_then `l-1` mp_tac) 1923 \\ match_mp_tac IMP_IMP \\ conj_tac \\ fs []); 1924 1925val mc_div_test_thm = prove( 1926 ``!q u1 u2 u3 v1 (v2:'a word) l. 1927 dimword (:'a) <= l ==> 1928 ?l2. 1929 mc_div_test_pre (l,q,v2,v1,u3,u2,u1) /\ 1930 (mc_div_test (l,q,v2,v1,u3,u2,u1) = 1931 (l2,mw_div_test q u1 u2 u3 v1 v2,v2,v1,u3,u2,u1)) /\ 1932 l <= l2 + dimword (:'a)``, 1933 rw [] \\ assume_tac (Q.SPEC `q` w2n_lt) 1934 \\ `w2n q <= l` by fs [] 1935 \\ imp_res_tac mc_div_test_lemma 1936 \\ pop_assum (strip_assume_tac o SPEC_ALL) 1937 \\ fs []); 1938 1939val (mc_div_r1_def, _, 1940 mc_div_r1_pre_def, _) = 1941 tailrec_define "mc_div_r1" `` 1942 (\(r0,r1,r2). 1943 if r2 <+ r1 then 1944 (let cond = single_div_pre r2 r0 r1 in 1945 let (r0,r2) = single_div r2 r0 r1 1946 in 1947 (INR (r0,r1,r2),cond)) 1948 else (let r0 = 0x0w in let r0 = ~r0 in (INR (r0,r1,r2),T))) 1949 :'a word # 'a word # 'a word -> ('a word # 'a word # 'a word + 'a 1950 word # 'a word # 'a word) # bool``; 1951 1952val mc_div_r1_def = LIST_CONJ [mc_div_r1_def,mc_div_r1_pre_def] 1953 1954val mc_div_r1_thm = prove( 1955 ``mc_div_r1 (r0,r1,r2) = 1956 if r2 <+ r1 then 1957 (FST (single_div r2 r0 r1),r1,SND (single_div r2 r0 r1)) 1958 else (~0w,r1,r2)``, 1959 SIMP_TAC (srw_ss()) [mc_div_r1_def,single_div_def,LET_DEF]); 1960 1961val (mc_div_guess_def, _, 1962 mc_div_guess_pre_def, _) = 1963 tailrec_define "mc_div_guess" `` 1964 (\(l,r7,r8,r9,r10,r11). 1965 (let r0 = r10 in 1966 let r1 = r8 in 1967 let r2 = r11 in 1968 let cond = mc_div_r1_pre (r0,r1,r2) in 1969 let (r0,r1,r2) = mc_div_r1 (r0,r1,r2) in 1970 let r6 = r0 in 1971 let cond = cond /\ mc_div_test_pre (l-1,r6,r7,r8,r9,r10,r11) /\ l <> 0 in 1972 let (l,r6,r7,r8,r9,r10,r11) = mc_div_test (l-1,r6,r7,r8,r9,r10,r11) 1973 in 1974 (INR (l,r6,r7,r8,r9,r10,r11),cond))) 1975 :num # 'a word # 'a word # 'a word # 'a word # 'a word -> 1976 (num # 'a word # 'a word # 'a word # 'a word # 'a word + 1977 num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word) # bool``; 1978 1979val mc_div_guess_thm = prove( 1980 ``!u1 u2 u3 v1 v2:'a word. 1981 dimword (:'a) + 1 <= l ==> 1982 ?l2. 1983 (mc_div_guess_pre (l,v2,v1,u3,u2,u1) <=> 1984 (u1 <+ v1 ==> v1 <> 0w)) /\ 1985 (mc_div_guess (l,v2,v1,u3,u2,u1) = 1986 (l2,mw_div_guess (u1::u2::u3::us) (v1::v2::vs),v2,v1,u3,u2,u1)) /\ 1987 l <= l2 + dimword (:'a) + 1``, 1988 rpt strip_tac 1989 \\ `dimword (:��) ��� l - 1` by decide_tac 1990 \\ imp_res_tac mc_div_test_thm 1991 \\ SIMP_TAC (srw_ss()) [mc_div_guess_def,mc_div_guess_pre_def, 1992 mc_div_test_thm, mw_div_guess_def,HD,TL,mc_div_r1_thm,LET_DEF] 1993 \\ SIMP_TAC std_ss [mc_div_r1_def,LET_DEF,WORD_LO,single_div_pre_def] 1994 \\ REPEAT STRIP_TAC 1995 \\ IF_CASES_TAC \\ fs [] 1996 \\ SEP_I_TAC "mc_div_test" \\ fs [] 1997 \\ FULL_SIMP_TAC (srw_ss()) [single_div_def] 1998 \\ FULL_SIMP_TAC std_ss [EVAL ``-1w:'a word``] 1999 \\ fs [word_2comp_def] 2000 \\ Cases_on `v1 = 0w` \\ FULL_SIMP_TAC std_ss [] 2001 \\ Cases_on `v1` \\ FULL_SIMP_TAC (srw_ss()) [single_div_def] 2002 \\ `0 < n` by DECIDE_TAC 2003 \\ FULL_SIMP_TAC std_ss [DIV_LT_X] 2004 \\ Cases_on `u1` \\ FULL_SIMP_TAC (srw_ss()) [] 2005 \\ Cases_on `u2` \\ FULL_SIMP_TAC (srw_ss()) [] 2006 \\ Cases_on`n` \\ fs[MULT] 2007 \\ qmatch_rename_tac`(a:num) + b * _ < _ + c * _` 2008 \\ qmatch_goalsub_abbrev_tac`b * d` 2009 \\ `b * d <= c * d` by simp[] 2010 \\ decide_tac); 2011 2012(* mw_div -- mw_div_adjust *) 2013 2014(* 2015 2016 r1 -- k1 2017 r6 -- x1, i.e. d 2018 r7 -- x2 2019 r8 -- accumulated result 2020 r9 -- length of ys 2021 r10 -- points into zs 2022 r11 -- points into ys 2023 r12 -- k2 2024 2025*) 2026 2027val (mc_adj_cmp_def, _, 2028 mc_adj_cmp_pre_def, _) = 2029 tailrec_define "mc_adj_cmp" `` 2030 (\(r0,r3,r8). 2031 if r0 = r3 then (INR (r0,r3,r8),T) 2032 else 2033 (let r8 = 0x1w 2034 in 2035 if r3 <+ r0 then (INR (r0,r3,r8),T) 2036 else (let r8 = 0x0w in (INR (r0,r3,r8),T)))) 2037 :'a word # 'a word # 'a word -> ('a word # 'a word # 'a word + 'a 2038 word # 'a word # 'a word) # bool``; 2039 2040val (mc_adjust_aux_def, _, 2041 mc_adjust_aux_pre_def, _) = 2042 tailrec_define "mc_adjust_aux" `` 2043 (\(l,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs). 2044 if r9 = r11 then 2045 (let r0 = r12 in 2046 let cond = w2n r10 < LENGTH zs in 2047 let r3 = EL (w2n r10) zs in 2048 let r10 = r10 + 0x1w in 2049 let (r0,r3,r8) = mc_adj_cmp (r0,r3,r8) 2050 in 2051 (INR (l,r6,r7,r8,r9,r10,r11,ys,zs),cond)) 2052 else 2053 (let r0 = r6 in 2054 let cond = w2n r11 < LENGTH ys in 2055 let r2 = EL (w2n r11) ys in 2056 let cond = cond /\ mc_single_mul_pre (r0,r1,r2) in 2057 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 2058 let r1 = r12 in 2059 let r12 = r2 in 2060 let r2 = r0 in 2061 let r0 = r7 in 2062 let cond = cond /\ mc_single_mul_pre (r0,r1,r2) in 2063 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 2064 let r1 = r12 in 2065 let r12 = r2 in 2066 let cond = cond /\ w2n r10 < LENGTH zs in 2067 let r3 = EL (w2n r10) zs in 2068 let (r0,r3,r8) = mc_adj_cmp (r0,r3,r8) in 2069 let r11 = r11 + 0x1w in 2070 let r10 = r10 + 0x1w 2071 in 2072 (INL (l-1,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs),cond /\ l <> 0))) 2073 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word # 2074 'a word # 'a word # 'a word list # 'a word list -> (num # 'a word 2075 # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word # 'a 2076 word # 'a word list # 'a word list + num # 'a word # 'a word # 'a 2077 word # 'a word # 'a word # 'a word # 'a word list # 'a word list) 2078 # bool``; 2079 2080val (mc_div_adjust_def, _, 2081 mc_div_adjust_pre_def, _) = 2082 tailrec_define "mc_div_adjust" `` 2083 (\(l,r6,r7,r9,r10,ys,zs). 2084 (let r1 = 0x0w in 2085 let r8 = r1 in 2086 let r11 = r1 in 2087 let r12 = r1 in 2088 let cond = mc_adjust_aux_pre (l-1,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs) /\ l<>0 in 2089 let (l,r6,r7,r8,r9,r10,r11,ys,zs) = 2090 mc_adjust_aux (l-1,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs) 2091 in 2092 if r7 = 0x0w then (INR (l,r6,r7,r9,r10,r11,ys,zs),cond) 2093 else if r8 = 0x0w then (INR (l,r6,r7,r9,r10,r11,ys,zs),cond) 2094 else (let r7 = r7 - 0x1w in (INR (l,r6,r7,r9,r10,r11,ys,zs),cond)))) 2095 :num # 'a word # 'a word # 'a word # 'a word # 'a word list # 'a 2096 word list -> (num # 'a word # 'a word # 'a word # 'a word # 'a 2097 word list # 'a word list + num # 'a word # 'a word # 'a word # 'a 2098 word # 'a word # 'a word list # 'a word list) # bool``; 2099 2100val mc_adj_cmp_thm = prove( 2101 ``mc_adj_cmp_pre (r1,h,anything) /\ 2102 (mc_adj_cmp (r1,h,if res = SOME T then 0x1w else 0x0w) = 2103 (r1,h,if mw_cmp_alt [h] [r1] res = SOME T then 0x1w else 0x0w))``, 2104 SIMP_TAC std_ss [mw_cmp_alt_def,HD,TL,mc_adj_cmp_def,mc_adj_cmp_pre_def,LET_DEF] 2105 \\ Cases_on `r1 = h` \\ FULL_SIMP_TAC std_ss [] 2106 \\ Cases_on `h <+ r1` \\ FULL_SIMP_TAC std_ss []); 2107 2108val EL_LENGTH = prove( 2109 ``(EL (LENGTH xs) (xs ++ y::ys) = y) /\ 2110 (EL (LENGTH xs) (xs ++ y::ys ++ zs) = y)``, 2111 SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD, 2112 GSYM APPEND_ASSOC,APPEND]); 2113 2114val SNOC_INTRO = prove( 2115 ``(xs ++ y::ys = SNOC y xs ++ ys) /\ 2116 (xs ++ y::ys ++ zs = SNOC y xs ++ ys ++ zs)``, 2117 FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]); 2118 2119val mw_cmp_alt_CONS = prove( 2120 ``mw_cmp_alt zs (mw_mul_by_single2 r6 r7 ys q2 q4) (mw_cmp_alt [z] [q3] res) = 2121 mw_cmp_alt (z::zs) (q3::mw_mul_by_single2 r6 r7 ys q2 q4) res``, 2122 SIMP_TAC std_ss [mw_cmp_alt_def,TL,HD]); 2123 2124val mc_adjust_aux_thm = prove( 2125 ``!(ys:'a word list) zs ys1 zs1 zs2 res r1 r12 l. 2126 (LENGTH zs = LENGTH ys + 1) /\ LENGTH (ys1 ++ ys) < dimword (:'a) 2127 /\ LENGTH (zs1 ++ zs) < dimword (:'a) /\ 2128 LENGTH ys <= l ==> 2129 ?l2. 2130 mc_adjust_aux_pre (l,r1,r6,r7,if res = SOME T then 1w else 0w, 2131 n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1), 2132 r12,ys1 ++ ys,zs1 ++ zs ++ zs2) /\ 2133 (mc_adjust_aux (l,r1,r6,r7,if res = SOME T then 1w else 0w, 2134 n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1), 2135 r12,ys1 ++ ys,zs1 ++ zs ++ zs2) = 2136 (l2,r6,r7,if mw_cmp_alt zs (mw_mul_by_single2 r6 r7 ys r1 r12) res = SOME T 2137 then 1w else 0w,n2w (LENGTH (ys1 ++ ys)),n2w (LENGTH (zs1 ++ zs)), 2138 n2w (LENGTH (ys1 ++ ys)),ys1 ++ ys,zs1 ++ zs ++ zs2)) /\ 2139 l <= l2 + LENGTH ys``, 2140 Induct THEN1 2141 (SIMP_TAC std_ss [APPEND_NIL,mw_mul_by_single2_def,LENGTH] 2142 \\ Cases \\ SIMP_TAC std_ss [LENGTH] 2143 \\ Cases_on `t` \\ SIMP_TAC std_ss [LENGTH,ADD1] 2144 \\ ONCE_REWRITE_TAC [mc_adjust_aux_def,mc_adjust_aux_pre_def] 2145 \\ SIMP_TAC std_ss [LET_DEF,LENGTH_APPEND,LENGTH] 2146 \\ NTAC 7 STRIP_TAC 2147 \\ `LENGTH zs1 < dimword (:'a)` by DECIDE_TAC 2148 \\ FULL_SIMP_TAC std_ss [APPEND,GSYM APPEND_ASSOC,w2n_n2w, 2149 rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD] 2150 \\ REWRITE_TAC [mc_adj_cmp_thm] \\ SIMP_TAC std_ss [word_add_n2w] 2151 \\ DECIDE_TAC) 2152 \\ ONCE_REWRITE_TAC [mc_adjust_aux_def,mc_adjust_aux_pre_def] 2153 \\ Cases_on `zs` \\ SIMP_TAC std_ss [LENGTH,ADD1] \\ rpt STRIP_TAC 2154 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (zs1 ++ z::zs) < dimword (:'a)` 2155 \\ POP_ASSUM MP_TAC 2156 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (ys1 ++ y::ys) < dimword (:'a)` 2157 \\ STRIP_TAC 2158 \\ `n2w (LENGTH (ys1 ++ y::ys)) <> n2w (LENGTH ys1):'a word` by 2159 (FULL_SIMP_TAC std_ss [LENGTH_APPEND] 2160 \\ `LENGTH ys1 < dimword(:'a)` by DECIDE_TAC 2161 \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH,ADD1]) 2162 \\ FULL_SIMP_TAC std_ss [word_add_n2w,mc_adj_cmp_thm,mc_single_mul_add_thm, 2163 mc_single_mul_thm] 2164 \\ `LENGTH zs1 < dimword (:'a) /\ LENGTH ys1 < dimword (:'a)` by 2165 (FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2166 \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH,LET_DEF,mw_mul_by_single2_def] 2167 \\ `?q1 q2. single_mul_add r6 y r1 0x0w = (q1,q2)` by METIS_TAC [PAIR] 2168 \\ `?q3 q4. single_mul_add r7 q1 r12 0x0w = (q3,q4)` by METIS_TAC [PAIR] 2169 \\ FULL_SIMP_TAC std_ss [SNOC_INTRO] 2170 \\ `LENGTH ys ��� l - 1` by fs [] 2171 \\ first_x_assum (qspecl_then [`zs`,`SNOC y ys1`,`SNOC z zs1`,`zs2`, 2172 `mw_cmp_alt [z] [q3] res`,`q2`,`q4`,`l-1`] mp_tac) 2173 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [] 2174 \\ strip_tac \\ fs [ADD1] 2175 \\ FULL_SIMP_TAC std_ss [mw_cmp_alt_CONS]) 2176 |> Q.SPECL [`ys`,`zs`,`[]`,`zs1`,`zs2`,`NONE`,`0w`,`0w`] 2177 |> SIMP_RULE std_ss [LENGTH,APPEND] |> GEN_ALL; 2178 2179val mc_div_adjust_thm = prove( 2180 ``(LENGTH zs = LENGTH ys + 1) /\ LENGTH (ys:'a word list) < dimword (:'a) 2181 /\ LENGTH (zs1 ++ zs) < dimword (:'a) /\ 2182 LENGTH ys + 1 <= l ==> 2183 ?l2. 2184 mc_div_adjust_pre (l,r6,r7,n2w (LENGTH ys),n2w (LENGTH zs1), 2185 ys,zs1 ++ zs ++ zs2) /\ 2186 (mc_div_adjust (l,r6,r7,n2w (LENGTH ys),n2w (LENGTH zs1), 2187 ys,zs1 ++ zs ++ zs2) = 2188 (l2,r6,mw_div_adjust r7 zs (FRONT (mw_mul_by_single r6 ys)), 2189 n2w (LENGTH ys),n2w (LENGTH (zs1 ++ zs)),n2w (LENGTH ys), 2190 ys,zs1 ++ zs ++ zs2)) /\ 2191 l <= l2 + LENGTH ys + 1``, 2192 SIMP_TAC std_ss [mc_div_adjust_def,mc_div_adjust_pre_def,LET_DEF] 2193 \\ ASSUME_TAC mc_adjust_aux_thm \\ SEP_I_TAC "mc_adjust_aux" 2194 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mw_div_adjust_def] \\ fs [] 2195 \\ SIMP_TAC std_ss [GSYM mw_mul_by_single2_thm] 2196 \\ `mw_cmp_alt zs (mw_mul_by_single2 r6 r7 ys 0x0w 0x0w) NONE = 2197 mw_cmp zs (mw_mul_by_single2 r6 r7 ys 0x0w 0x0w)` by 2198 (MATCH_MP_TAC (GSYM mw_cmp_alt_thm) 2199 \\ SIMP_TAC std_ss [mw_mul_by_single2_thm,LENGTH_mw_mul_by_single] 2200 \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single,LENGTH_FRONT, 2201 GSYM LENGTH_NIL] \\ DECIDE_TAC) 2202 \\ FULL_SIMP_TAC std_ss [] \\ `0 < dimword (:'a)` by DECIDE_TAC 2203 \\ Cases_on `r7` \\ FULL_SIMP_TAC std_ss [w2n_n2w,n2w_11] 2204 \\ Cases_on `mw_cmp zs (mw_mul_by_single2 r6 (n2w n) ys 0x0w 0x0w) = SOME T` 2205 \\ FULL_SIMP_TAC std_ss [GSYM one_neq_zero_word] 2206 \\ Cases_on `n = 0` \\ FULL_SIMP_TAC std_ss [word_arith_lemma2] 2207 \\ `~(n < 1)` by DECIDE_TAC \\ FULL_SIMP_TAC std_ss [] 2208 \\ Cases_on `n` \\ fs [ADD1,GSYM word_add_n2w]); 2209 2210(* mw_div -- mw_sub *) 2211 2212val (mc_div_sub_def, _, 2213 mc_div_sub_pre_def, _) = 2214 tailrec_define "mc_div_sub" `` 2215 (\(r0,r3,r8). 2216 (let cond = ((r8 <> 0w) ==> (r8 = 1w)) in 2217 let (r3,r8) = single_sub_word r3 r0 r8 in 2218 (INR (r0,r3,r8),cond))) 2219 :'a word # 'a word # 'a word -> ('a word # 'a word # 'a word + 'a 2220 word # 'a word # 'a word) # bool``; 2221 2222val mc_div_sub_def = LIST_CONJ [mc_div_sub_def,mc_div_sub_pre_def] 2223 2224val b2n_thm = prove( 2225 ``b2n = b2n``, 2226 FULL_SIMP_TAC std_ss [FUN_EQ_THM] \\ Cases \\ EVAL_TAC); 2227 2228val mc_div_sub_thm = prove( 2229 ``mc_div_sub_pre (r0,r3,b2w c) /\ 2230 (mc_div_sub (r0,r3,b2w c) = 2231 let (r3,c) = single_sub r3 r0 c in 2232 (r0,r3,b2w c))``, 2233 SIMP_TAC std_ss [single_sub_def,mc_div_sub_def,LET_DEF,single_sub_word_def] 2234 \\ fs [] \\ rpt (pairarg_tac \\ fs [])); 2235 2236val (mc_div_sub_loop_def, _, 2237 mc_div_sub_loop_pre_def, _) = 2238 tailrec_define "mc_div_sub_loop" `` 2239 (\(l,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs). 2240 if r9 = r11 then 2241 (let r0 = r12 in 2242 let cond = w2n r10 < LENGTH zs in 2243 let r3 = EL (w2n r10) zs in 2244 let cond = cond /\ mc_div_sub_pre (r0,r3,r8) in 2245 let (r0,r3,r8) = mc_div_sub (r0,r3,r8) in 2246 let r1 = r3 in 2247 let zs = LUPDATE r1 (w2n r10) zs in 2248 let r10 = r10 + 0x1w 2249 in 2250 (INR (l,r6,r7,r9,r10,r11,ys,zs),cond)) 2251 else 2252 (let r0 = r6 in 2253 let cond = w2n r11 < LENGTH ys in 2254 let r2 = EL (w2n r11) ys in 2255 let cond = cond /\ mc_single_mul_pre (r0,r1,r2) in 2256 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 2257 let r1 = r12 in 2258 let r12 = r2 in 2259 let r2 = r0 in 2260 let r0 = r7 in 2261 let cond = cond /\ mc_single_mul_pre (r0,r1,r2) in 2262 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 2263 let r1 = r12 in 2264 let r12 = r2 in 2265 let cond = cond /\ w2n r10 < LENGTH zs in 2266 let r3 = EL (w2n r10) zs in 2267 let cond = cond /\ mc_div_sub_pre (r0,r3,r8) in 2268 let (r0,r3,r8) = mc_div_sub (r0,r3,r8) in 2269 let r0 = r1 in 2270 let r1 = r3 in 2271 let zs = LUPDATE r1 (w2n r10) zs in 2272 let r1 = r0 in 2273 let r11 = r11 + 0x1w in 2274 let r10 = r10 + 0x1w 2275 in 2276 (INL (l-1,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs),cond /\ l <> 0))) 2277 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word # 2278 'a word # 'a word # 'a word list # 'a word list -> (num # 'a word 2279 # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word # 'a 2280 word # 'a word list # 'a word list + num # 'a word # 'a word # 'a 2281 word # 'a word # 'a word # 'a word list # 'a word list) # bool``; 2282 2283val LUPDATE_THM = prove( 2284 ``(LUPDATE q (LENGTH xs) (SNOC x xs) = SNOC q xs) /\ 2285 (LUPDATE q (LENGTH xs) (SNOC x xs ++ ys) = SNOC q xs ++ ys) /\ 2286 (LUPDATE q (LENGTH xs) (SNOC x xs ++ ys ++ zs) = SNOC q xs ++ ys ++ zs)``, 2287 SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH]); 2288 2289val mc_div_sub_loop_thm = prove( 2290 ``!(ys:'a word list) zs ys1 zs1 zs2 c r1 r12 l. 2291 (LENGTH zs = LENGTH ys + 1) /\ LENGTH (ys1 ++ ys) < dimword (:'a) 2292 /\ LENGTH (zs1 ++ zs) < dimword (:'a) /\ 2293 LENGTH ys <= l ==> 2294 ?l2. 2295 mc_div_sub_loop_pre (l,r1,r6,r7,b2w c, 2296 n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1), 2297 r12,ys1 ++ ys,zs1 ++ zs ++ zs2) /\ 2298 (mc_div_sub_loop (l,r1,r6,r7,b2w c, 2299 n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1), 2300 r12,ys1 ++ ys,zs1 ++ zs ++ zs2) = 2301 (l2,r6,r7,n2w (LENGTH (ys1 ++ ys)),n2w (LENGTH (zs1 ++ zs)), 2302 n2w (LENGTH (ys1 ++ ys)),ys1 ++ ys, 2303 zs1 ++ (FST (mw_sub zs (mw_mul_by_single2 r6 r7 ys r1 r12) c)) ++ zs2)) /\ 2304 l <= l2 + LENGTH ys``, 2305 Induct THEN1 2306 (SIMP_TAC std_ss [APPEND_NIL,mw_mul_by_single2_def,LENGTH] 2307 \\ Cases \\ SIMP_TAC std_ss [LENGTH] 2308 \\ Cases_on `t` \\ SIMP_TAC std_ss [LENGTH,ADD1] 2309 \\ ONCE_REWRITE_TAC [mc_div_sub_loop_def,mc_div_sub_loop_pre_def] 2310 \\ SIMP_TAC std_ss [LET_DEF,LENGTH_APPEND,LENGTH] 2311 \\ rpt STRIP_TAC 2312 \\ `LENGTH zs1 < dimword (:'a)` by DECIDE_TAC 2313 \\ FULL_SIMP_TAC std_ss [word_add_n2w,w2n_n2w,EL_LENGTH] 2314 \\ FULL_SIMP_TAC std_ss [LUPDATE_THM,APPEND_NIL,SNOC_INTRO] 2315 \\ FULL_SIMP_TAC std_ss [SNOC_INTRO,mc_div_sub_thm] 2316 \\ FULL_SIMP_TAC std_ss [mw_sub_def,HD,TL] 2317 \\ Cases_on `single_sub h r12 c` 2318 \\ FULL_SIMP_TAC std_ss [LET_DEF,SNOC_INTRO,APPEND_NIL] \\ DECIDE_TAC) 2319 \\ ONCE_REWRITE_TAC [mc_div_sub_loop_def,mc_div_sub_loop_pre_def] 2320 \\ Cases_on `zs` \\ SIMP_TAC std_ss [LENGTH,ADD1] \\ rpt STRIP_TAC 2321 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (zs1 ++ z::zs) < dimword (:'a)` 2322 \\ POP_ASSUM MP_TAC 2323 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (ys1 ++ y::ys) < dimword (:'a)` 2324 \\ STRIP_TAC 2325 \\ `n2w (LENGTH (ys1 ++ y::ys)) <> n2w (LENGTH ys1):'a word` by 2326 (FULL_SIMP_TAC std_ss [LENGTH_APPEND] 2327 \\ `LENGTH ys1 < dimword(:'a)` by DECIDE_TAC 2328 \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH,ADD1]) 2329 \\ FULL_SIMP_TAC std_ss [word_add_n2w,mc_adj_cmp_thm,mc_single_mul_add_thm, 2330 mc_single_mul_thm] 2331 \\ `LENGTH zs1 < dimword (:'a) /\ LENGTH ys1 < dimword (:'a)` by 2332 (FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2333 \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH,LET_DEF,mw_mul_by_single2_def] 2334 \\ `?q1 q2. single_mul_add r6 y r1 0x0w = (q1,q2)` by METIS_TAC [PAIR] 2335 \\ `?q3 q4. single_mul_add r7 q1 r12 0x0w = (q3,q4)` by METIS_TAC [PAIR] 2336 \\ FULL_SIMP_TAC std_ss [SNOC_INTRO,mc_div_sub_thm] 2337 \\ FULL_SIMP_TAC std_ss [mw_sub_def,HD,TL] 2338 \\ Cases_on `single_sub z q3 c` 2339 \\ FULL_SIMP_TAC std_ss [LET_DEF] 2340 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 2341 \\ SIMP_TAC std_ss [SNOC_INTRO,LUPDATE_THM] 2342 \\ `(LENGTH ys1 + 1 = LENGTH (SNOC y ys1)) /\ 2343 (LENGTH zs1 + 1 = LENGTH (SNOC q zs1)) /\ 2344 (LENGTH (SNOC y ys1 ++ ys) = LENGTH (SNOC q ys1 ++ ys)) /\ 2345 LENGTH (SNOC q ys1 ++ ys) < dimword (:'a) /\ 2346 LENGTH (SNOC q zs1 ++ zs) < dimword (:'a)` by 2347 (FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1,LENGTH_APPEND] \\ DECIDE_TAC) 2348 \\ Q.PAT_X_ASSUM `!zs. bbb` (MP_TAC o Q.SPECL [`zs`,`SNOC y ys1`, 2349 `SNOC q zs1`,`zs2`,`r`,`q2`,`q4`,`l-1`]) 2350 \\ fs [] \\ strip_tac \\ fs [ADD1]) 2351 |> Q.SPECL [`ys`,`zs`,`[]`,`zs1`,`zs2`,`T`,`0w`,`0w`] 2352 |> SIMP_RULE std_ss [LENGTH,APPEND,EVAL ``b2w T``] |> GEN_ALL; 2353 2354 2355(* mw_div -- mw_div_aux *) 2356 2357val (mc_div_loop_def, _, 2358 mc_div_loop_pre_def, _) = 2359 tailrec_define "mc_div_loop" `` 2360 (\(l,r7:'a word,r9:'a word,r10:'a word,r11:'a word, 2361 r14:'a word,r15:'a word,ys:'a word list,zs:'a word list). 2362 if r10 = 0x0w then (INR (l,r7,r9,r10,r11,r14,r15,ys,zs),T) 2363 else 2364 (let r6 = r14 in 2365 let r3 = r15 in 2366 let r14 = r7 in 2367 let r15 = r9 in 2368 let r16 = r10 in 2369 let r10 = r10 + r9 in 2370 let r10 = r10 - 0x1w in 2371 let cond = w2n r10 < LENGTH zs in 2372 let r0 = EL (w2n r10) zs in 2373 let r10 = r10 - 0x1w in 2374 let cond = cond /\ w2n r10 < LENGTH zs in 2375 let r1 = EL (w2n r10) zs in 2376 let r10 = r10 - 0x1w in 2377 let cond = cond /\ w2n r10 < LENGTH zs in 2378 let r2 = EL (w2n r10) zs in 2379 let r11 = r0 in 2380 let r10 = r1 in 2381 let r9 = r2 in 2382 let r7 = r3 in 2383 let r8 = r6 in 2384 let cond = cond /\ mc_div_guess_pre (l,r7,r8,r9,r10,r11) in 2385 let (l,r6,r7,r8,r9,r10,r11) = mc_div_guess (l,r7,r8,r9,r10,r11) in 2386 let r0 = r6 in 2387 let r6 = r14 in 2388 let r9 = r15 in 2389 let r10 = r16 in 2390 let r10 = r10 - 0x1w in 2391 let r15 = r7 in 2392 let r14 = r8 in 2393 let r7 = r0 in 2394 let cond = cond /\ mc_div_adjust_pre (l,r6,r7,r9,r10,ys,zs) in 2395 let (l,r6,r7,r9,r10,r11,ys,zs) = mc_div_adjust (l,r6,r7,r9,r10,ys,zs) in 2396 let r10 = r10 - r9 in 2397 let r10 = r10 - 0x1w in 2398 let r1 = 0x0w in 2399 let r8 = r1 in 2400 let r8 = 1w in 2401 let r11 = r1 in 2402 let r12 = r1 in 2403 let cond = 2404 cond /\ 2405 mc_div_sub_loop_pre (l-1,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs) /\ l <> 0 2406 in 2407 let (l,r6,r7,r9,r10,r11,ys,zs) = 2408 mc_div_sub_loop (l-1,r1,r6,r7,r8,r9,r10,r11,r12,ys,zs) 2409 in 2410 let r10 = r10 - 0x1w in 2411 let cond = cond /\ w2n r10 < LENGTH zs in 2412 let zs = LUPDATE r7 (w2n r10) zs in 2413 let r10 = r10 - r9 in 2414 let r7 = r6 2415 in 2416 (INL (l-1,r7,r9,r10,r11,r14,r15,ys,zs),cond /\ l <> 0)))``; 2417 2418val mc_div_loop_thm = prove( 2419 ``!(zs1:'a word list) zs ys1 zs2 c r1 r12 l. 2420 (LENGTH zs = LENGTH ys) /\ LENGTH (zs1 ++ zs ++ zs2) < dimword (:'a) /\ 2421 1 < LENGTH ys /\ LAST (FRONT (mw_mul_by_single d ys)) <> 0x0w /\ 2422 LENGTH zs1 * (dimword (:'a) + 2 * LENGTH ys + 4) <= l ==> 2423 ?l2. 2424 let ys1 = (FRONT (mw_mul_by_single d ys)) in 2425 mc_div_loop_pre (l,d,n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH ys), 2426 LAST ys1,LAST (BUTLAST ys1),ys,zs1 ++ zs ++ zs2) /\ 2427 (mc_div_loop (l,d,n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH ys), 2428 LAST ys1,LAST (BUTLAST ys1),ys,zs1 ++ zs ++ zs2) = 2429 (l2,d,n2w (LENGTH ys),0w,n2w (LENGTH ys),LAST ys1,LAST (BUTLAST ys1),ys, 2430 (let (qs,rs) = mw_div_aux zs1 zs ys1 in 2431 rs ++ REVERSE qs ++ zs2))) /\ 2432 l <= l2 + LENGTH zs1 * (dimword (:'a) + 2 * LENGTH ys + 4)``, 2433 Q.ABBREV_TAC `ys1 = FRONT (mw_mul_by_single d ys)` 2434 \\ SIMP_TAC std_ss [LET_DEF] \\ HO_MATCH_MP_TAC SNOC_INDUCT 2435 \\ STRIP_TAC THEN1 (SIMP_TAC std_ss 2436 [LENGTH,APPEND,Once mw_div_aux_def,APPEND_NIL, 2437 Once mc_div_loop_def,Once mc_div_loop_pre_def,REVERSE_DEF]) 2438 \\ NTAC 2 STRIP_TAC 2439 \\ ONCE_REWRITE_TAC [mw_div_aux_def] \\ NTAC 5 STRIP_TAC 2440 \\ SIMP_TAC std_ss [LAST_SNOC,FRONT_SNOC,rich_listTheory.NOT_SNOC_NIL] 2441 \\ NTAC 4 (SIMP_TAC std_ss [Once LET_DEF]) 2442 \\ Q.ABBREV_TAC `guess = mw_div_guess (REVERSE (x::zs)) (REVERSE ys1)` 2443 \\ Q.ABBREV_TAC `adj = mw_div_adjust guess (x::zs) ys1` 2444 \\ Q.ABBREV_TAC `sub = (FST (mw_sub (x::zs) (mw_mul_by_single adj ys1) T))` 2445 \\ `?qs1 rs1. mw_div_aux zs1 (FRONT sub) ys1 = (qs1,rs1)` by METIS_TAC [PAIR] 2446 \\ FULL_SIMP_TAC std_ss [] 2447 \\ ONCE_REWRITE_TAC [mc_div_loop_def,mc_div_loop_pre_def] 2448 \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH_APPEND] 2449 \\ IMP_RES_TAC (DECIDE ``n + m + k < d ==> 0 < d /\ n < d:num``) 2450 \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH_APPEND] 2451 \\ SIMP_TAC std_ss [LENGTH_SNOC,ADD1,GSYM word_add_n2w,WORD_ADD_SUB,HD,TL] 2452 \\ SIMP_TAC std_ss [LET_DEF,TL,HD,GSYM WORD_SUB_PLUS,word_add_n2w] 2453 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC] 2454 \\ `(zs1 ++ ([x] ++ (zs ++ zs2))) = (zs1 ++ x::zs ++ zs2)` by 2455 (FULL_SIMP_TAC std_ss [APPEND,GSYM APPEND_ASSOC] \\ NO_TAC) 2456 \\ FULL_SIMP_TAC std_ss [] 2457 \\ `~(LENGTH zs1 + 1 + LENGTH ys < 3) /\ 2458 ~(LENGTH zs1 + 1 + LENGTH ys < 2) /\ 2459 ~(LENGTH zs1 + 1 + LENGTH ys < 1) /\ 2460 ~(LENGTH (zs1 ++ x::zs) < 1) /\ 2461 ~(LENGTH (zs1 ++ x::zs) < 1 + LENGTH ys) /\ 2462 (LENGTH zs1 + 1 + LENGTH ys - 3) < dimword (:'a) /\ 2463 (LENGTH zs1 + 1 + LENGTH ys - 2) < dimword (:'a) /\ 2464 (LENGTH zs1 + 1 + LENGTH ys - 1) < dimword (:'a) /\ 2465 (LENGTH zs1 + 1 + LENGTH ys) < dimword (:'a) /\ 2466 (LENGTH (zs1 ++ x::zs) - 1) < dimword (:'a) /\ 2467 ~(LENGTH zs1 + 1 < 1) /\ 2468 ~(LENGTH (zs1 ++ x::zs) < LENGTH ys + 1) /\ 2469 (LENGTH (zs1 ++ x::zs) - (LENGTH ys + 1) = LENGTH zs1)` by 2470 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2471 \\ FULL_SIMP_TAC std_ss [w2n_n2w,word_arith_lemma2] 2472 \\ FULL_SIMP_TAC std_ss [w2n_n2w] 2473 \\ `(EL (LENGTH zs1 + 1 + LENGTH ys - 3) (zs1 ++ x::zs ++ zs2) = 2474 LAST (BUTLAST (BUTLAST (x::zs)))) /\ 2475 (EL (LENGTH zs1 + 1 + LENGTH ys - 2) (zs1 ++ x::zs ++ zs2) = 2476 LAST (BUTLAST (x::zs))) /\ 2477 (EL (LENGTH zs1 + 1 + LENGTH ys - 1) (zs1 ++ x::zs ++ zs2) = 2478 LAST (x::zs))` by 2479 (`(LENGTH zs1 + 1 + LENGTH ys - 3 = LENGTH zs1 + (LENGTH (x::zs) - 3)) /\ 2480 (LENGTH zs1 + 1 + LENGTH ys - 2 = LENGTH zs1 + (LENGTH (x::zs) - 2)) /\ 2481 (LENGTH zs1 + 1 + LENGTH ys - 1 = LENGTH zs1 + (LENGTH (x::zs) - 1)) /\ 2482 (LENGTH (x::zs) - 3 < LENGTH (x::zs))` by 2483 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2484 \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_APPEND2,DECIDE ``n <= n + m:num``, 2485 GSYM APPEND_ASSOC,rich_listTheory.EL_APPEND1] 2486 \\ `(x::zs = []) \/ ?t1 t2. x::zs = SNOC t1 t2` by METIS_TAC [SNOC_CASES] 2487 \\ FULL_SIMP_TAC (srw_ss()) [ADD1] 2488 \\ `LENGTH ys = LENGTH t2` by 2489 (`LENGTH (x::zs) = LENGTH (t2 ++ [t1])` by METIS_TAC [] 2490 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,ADD1]) 2491 \\ FULL_SIMP_TAC std_ss [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC] 2492 \\ `(t2 = []) \/ ?t3 t4. t2 = SNOC t3 t4` by METIS_TAC [SNOC_CASES] 2493 \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC, 2494 LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND] 2495 \\ SIMP_TAC std_ss [EL_LENGTH,DECIDE ``n+1+1-2 = n:num``] 2496 \\ `(t4 = []) \/ ?t5 t6. t4 = SNOC t5 t6` by METIS_TAC [SNOC_CASES] 2497 \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC, 2498 LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND] 2499 \\ SIMP_TAC std_ss [EL_LENGTH,DECIDE ``n+1+1+1-3 = n:num``]) 2500 \\ FULL_SIMP_TAC std_ss [] 2501 \\ ASSUME_TAC (mc_div_guess_thm |> GEN_ALL) 2502 \\ `dimword (:��) + 1 ��� l` by 2503 (fs [LENGTH_APPEND,LEFT_ADD_DISTRIB] \\ NO_TAC) 2504 \\ SEP_I_TAC "mc_div_guess" \\ FULL_SIMP_TAC std_ss [] 2505 \\ REV_FULL_SIMP_TAC std_ss [] 2506 \\ POP_ASSUM (MP_TAC o Q.SPECL [`REVERSE (FRONT (FRONT ys1))`, 2507 `REVERSE (FRONT (FRONT (FRONT (x::zs))))`]) 2508 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 2509 \\ `mw_div_guess 2510 (LAST (x::zs)::LAST (FRONT (x::zs)):: 2511 LAST (FRONT (FRONT (x::zs)))::REVERSE (FRONT (FRONT (FRONT (x::zs))))) 2512 (LAST ys1::LAST (FRONT ys1)::REVERSE (FRONT (FRONT ys1))) = guess` by 2513 (Q.UNABBREV_TAC `guess` 2514 \\ MATCH_MP_TAC (METIS_PROVE [] ``(x1 = x2) /\ (y1 = y2) ==> (f x1 y1 = f x2 y2)``) 2515 \\ Tactical.REVERSE STRIP_TAC THEN1 2516 (`LENGTH ys1 = LENGTH ys` by 2517 (Q.UNABBREV_TAC `ys1` 2518 \\ FULL_SIMP_TAC std_ss [LENGTH_FRONT,LENGTH_mw_mul_by_single,GSYM LENGTH_NIL] 2519 \\ DECIDE_TAC) 2520 \\ `(ys1 = []) \/ ?t1 t2. ys1 = SNOC t1 t2` by METIS_TAC [SNOC_CASES] 2521 \\ FULL_SIMP_TAC (srw_ss()) [ADD1] 2522 \\ FULL_SIMP_TAC std_ss [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC] 2523 \\ `(t2 = []) \/ ?t3 t4. t2 = SNOC t3 t4` by METIS_TAC [SNOC_CASES] 2524 \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC, 2525 LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND] 2526 \\ DECIDE_TAC) 2527 \\ `(x::zs = []) \/ ?t1 t2. x::zs = SNOC t1 t2` by METIS_TAC [SNOC_CASES] 2528 THEN1 FULL_SIMP_TAC (srw_ss()) [ADD1] \\ ASM_SIMP_TAC std_ss [] 2529 \\ `LENGTH ys = LENGTH t2` by 2530 (`LENGTH (x::zs) = LENGTH (SNOC t1 t2)` by METIS_TAC [] 2531 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,LENGTH,ADD1]) 2532 \\ FULL_SIMP_TAC std_ss [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC] 2533 \\ `(t2 = []) \/ ?t3 t4. t2 = SNOC t3 t4` by METIS_TAC [SNOC_CASES] 2534 \\ FULL_SIMP_TAC std_ss [LAST_SNOC,FRONT_SNOC,REVERSE_SNOC,CONS_11] 2535 \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC, 2536 LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND] 2537 \\ `(t4 = []) \/ ?t5 t6. t4 = SNOC t5 t6` by METIS_TAC [SNOC_CASES] 2538 \\ FULL_SIMP_TAC std_ss [LAST_SNOC,FRONT_SNOC,REVERSE_SNOC,CONS_11] 2539 \\ FULL_SIMP_TAC (srw_ss()) []) 2540 \\ FULL_SIMP_TAC std_ss [] 2541 \\ NTAC 2 (qpat_x_assum `_ <= _` mp_tac) 2542 \\ NTAC 6 (POP_ASSUM (K ALL_TAC)) 2543 \\ rpt strip_tac 2544 \\ ASSUME_TAC (GEN_ALL mc_div_adjust_thm) 2545 \\ SEP_I_TAC "mc_div_adjust" \\ POP_ASSUM MP_TAC 2546 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (fs []) 2547 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [word_add_n2w,word_arith_lemma2] 2548 \\ ASSUME_TAC (GEN_ALL mc_div_sub_loop_thm) 2549 \\ SEP_I_TAC "mc_div_sub_loop" \\ POP_ASSUM MP_TAC 2550 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2551 THEN1 (fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB]) 2552 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [word_add_n2w,word_arith_lemma2] 2553 \\ FULL_SIMP_TAC std_ss [w2n_n2w] 2554 \\ `LENGTH (zs1 ++ x::zs) - (1 + LENGTH ys) = LENGTH zs1` by 2555 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2556 \\ FULL_SIMP_TAC std_ss [] 2557 \\ `LUPDATE adj (LENGTH (zs1 ++ x::zs) - 1) (zs1 ++ 2558 FST (mw_sub (x::zs) (mw_mul_by_single2 d adj ys 0x0w 0x0w) T) ++ 2559 zs2) = zs1 ++ SNOC adj (FRONT sub) ++ zs2` by 2560 (FULL_SIMP_TAC std_ss [mw_mul_by_single2_thm] 2561 \\ `LENGTH sub = LENGTH (x::zs)` by 2562 (Q.UNABBREV_TAC `sub` 2563 \\ Cases_on `mw_sub (x::zs) (mw_mul_by_single adj ys1) T` 2564 \\ IMP_RES_TAC LENGTH_mw_sub \\ FULL_SIMP_TAC std_ss [LENGTH]) 2565 \\ `(sub = []) \/ ?t3 t4. sub = SNOC t3 t4` by METIS_TAC [SNOC_CASES] 2566 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,FRONT_SNOC] 2567 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND] 2568 \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC] 2569 \\ `LENGTH (zs1 ++ x::zs) - 1 = LENGTH (zs1 ++ t4)` by 2570 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2571 \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH]) 2572 \\ FULL_SIMP_TAC std_ss [] 2573 \\ SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND] 2574 \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC,APPEND] 2575 \\ SEP_I_TAC "mc_div_loop" \\ POP_ASSUM MP_TAC 2576 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 2577 (`(LENGTH (FRONT sub) = LENGTH ys)` by 2578 (Q.UNABBREV_TAC `sub` 2579 \\ Cases_on `mw_sub (x::zs) (mw_mul_by_single adj ys1) T` 2580 \\ FULL_SIMP_TAC std_ss [] 2581 \\ IMP_RES_TAC LENGTH_mw_sub 2582 \\ Cases_on `q = []` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 2583 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_FRONT,GSYM LENGTH_NIL,ADD1] 2584 \\ DECIDE_TAC) 2585 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] 2586 \\ fs []) 2587 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 2588 \\ FULL_SIMP_TAC std_ss [REVERSE_DEF,GSYM APPEND_ASSOC,APPEND] 2589 \\ FULL_SIMP_TAC (srw_ss()) [GSYM CONJ_ASSOC] 2590 \\ Cases_on `mw_sub (x::zs) (mw_mul_by_single2 d adj ys 0x0w 0x0w) T` 2591 \\ IMP_RES_TAC LENGTH_mw_sub 2592 \\ FULL_SIMP_TAC (srw_ss()) [] 2593 \\ fs []); 2594 2595(* mw_div -- mul_by_single *) 2596 2597val (mc_mul_by_single_def, _, 2598 mc_mul_by_single_pre_def, _) = 2599 tailrec_define "mc_mul_by_single" `` 2600 (\(l,r1,r8,r9,r10,r11,xs,zs). 2601 if r9 = r11 then 2602 (let cond = w2n r10 < LENGTH zs in 2603 let zs = LUPDATE r1 (w2n r10) zs in 2604 let r10 = r10 + 0x1w 2605 in 2606 (INR (l,r1,r8,r9,r10,xs,zs),cond)) 2607 else 2608 (let cond = w2n r11 < LENGTH xs in 2609 let r2 = EL (w2n r11) xs in 2610 let r0 = r8 in 2611 let r3 = 0x0w in 2612 let cond = cond /\ mc_single_mul_add_pre (r0,r1,r2,r3) in 2613 let (r0,r1,r2,r3) = mc_single_mul_add (r0,r1,r2,r3) in 2614 let cond = cond /\ w2n r10 < LENGTH zs in 2615 let zs = LUPDATE r0 (w2n r10) zs in 2616 let r1 = r2 in 2617 let r10 = r10 + 0x1w in 2618 let r11 = r11 + 0x1w 2619 in 2620 (INL (l-1,r1,r8,r9,r10,r11,xs,zs),cond /\ l <> 0))) 2621 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word 2622 list # 'a word list -> (num # 'a word # 'a word # 'a word # 'a 2623 word # 'a word # 'a word list # 'a word list + num # 'a word # 'a 2624 word # 'a word # 'a word # 'a word list # 'a word list) # bool``; 2625 2626val mc_mul_by_single_thm = prove( 2627 ``!(xs:'a word list) xs1 x zs k zs1 zs2 z2 l. 2628 LENGTH (xs1++xs) < dimword (:'a) /\ (LENGTH zs = LENGTH xs) /\ 2629 LENGTH (zs1++zs) < dimword (:'a) /\ LENGTH xs <= l ==> 2630 ?r1 l2. 2631 mc_mul_by_single_pre (l,k,x,n2w (LENGTH (xs1++xs)),n2w (LENGTH zs1), 2632 n2w (LENGTH xs1),xs1++xs,zs1++zs++z2::zs2) /\ 2633 (mc_mul_by_single (l,k,x,n2w (LENGTH (xs1++xs)),n2w (LENGTH zs1), 2634 n2w (LENGTH xs1),xs1++xs,zs1++zs++z2::zs2) = 2635 (l2,r1,x,n2w (LENGTH (xs1++xs)),n2w (LENGTH (zs1++zs)+1),xs1++xs, 2636 zs1++(mw_mul_pass x xs (MAP (K 0w) xs) k)++zs2)) /\ 2637 l <= l2 + LENGTH xs``, 2638 Induct \\ Cases_on `zs` 2639 \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND_NIL,mw_mul_pass_def,ADD1] 2640 \\ ONCE_REWRITE_TAC [mc_mul_by_single_def,mc_mul_by_single_pre_def] 2641 \\ FULL_SIMP_TAC std_ss [LET_DEF,n2w_11,w2n_n2w,LUPDATE_LENGTH] 2642 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,word_add_n2w,LENGTH_APPEND] 2643 \\ FULL_SIMP_TAC std_ss [LENGTH,MAP,HD,TL] 2644 \\ REPEAT STRIP_TAC 2645 \\ IMP_RES_TAC (DECIDE ``m+n<k ==> m < k /\ n<k:num``) 2646 \\ FULL_SIMP_TAC std_ss [ADD1,mc_single_mul_add_thm] 2647 \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,LUPDATE_LENGTH,NULL,HD] 2648 \\ Cases_on `single_mul_add x h' k 0w` \\ FULL_SIMP_TAC std_ss [LET_DEF,TL] 2649 \\ ONCE_REWRITE_TAC [SNOC_INTRO |> Q.INST [`xs2`|->`[]`] |> REWRITE_RULE [APPEND_NIL]] 2650 \\ `((LENGTH xs1 + (LENGTH xs + 1)) = (LENGTH (SNOC h' xs1) + LENGTH xs)) /\ 2651 ((LENGTH xs1 + 1) = (LENGTH (SNOC h' xs1))) /\ 2652 ((LENGTH zs1 + 1) = LENGTH (SNOC q zs1))` by (FULL_SIMP_TAC std_ss [LENGTH_SNOC] \\ DECIDE_TAC) 2653 \\ FULL_SIMP_TAC std_ss [] 2654 \\ SEP_I_TAC "mc_mul_by_single" \\ POP_ASSUM MP_TAC 2655 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2656 THEN1 (fs []) 2657 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 2658 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND, 2659 LENGTH_APPEND,LENGTH,AC ADD_COMM ADD_ASSOC] \\ DECIDE_TAC) 2660 |> Q.SPECL [`xs`,`[]`,`x`,`zs`,`0w`,`[]`] 2661 |> SIMP_RULE std_ss [APPEND,LENGTH,GSYM k2mw_LENGTH_0,GSYM mw_mul_by_single_def] 2662 |> GEN_ALL; 2663 2664(* mw_div -- mul_by_single, top two from ys *) 2665 2666val (mc_top_two_def, _, 2667 mc_top_two_pre_def, _) = 2668 tailrec_define "mc_top_two" `` 2669 (\(l,r0,r1,r3,r8,r9,r11,ys). 2670 if r9 = r11 then (let r1 = r3 in (INR (l,r0,r1,r8,r9,r11,ys),T)) 2671 else 2672 (let r3 = r0 in 2673 let cond = w2n r11 < LENGTH ys in 2674 let r2 = EL (w2n r11) ys in 2675 let r0 = r8 in 2676 let cond = cond /\ mc_single_mul_pre (r0,r1,r2) in 2677 let (r0,r1,r2) = mc_single_mul (r0,r1,r2) in 2678 let r1 = r2 in 2679 let r11 = r11 + 0x1w 2680 in 2681 (INL (l-1,r0,r1,r3,r8,r9,r11,ys),cond /\ l<>0))) 2682 :num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a word # 2683 'a word list -> (num # 'a word # 'a word # 'a word # 'a word # 'a 2684 word # 'a word # 'a word list + num # 'a word # 'a word # 'a word 2685 # 'a word # 'a word # 'a word list) # bool``; 2686 2687val mc_top_two_thm = prove( 2688 ``!(ys:'a word list) x k1 k2 k3 ys1 l. 2689 LENGTH (ys1 ++ ys) < dimword (:'a) /\ LENGTH ys <= l ==> 2690 ?l2. 2691 mc_top_two_pre (l,k2,k1,k3, 2692 x,n2w (LENGTH (ys1++ys)),n2w (LENGTH ys1),ys1++ys) /\ 2693 (mc_top_two (l,k2,k1,k3, 2694 x,n2w (LENGTH (ys1++ys)),n2w (LENGTH ys1),ys1++ys) = 2695 (l2,FST (SND (mw_mul_pass_top x ys (k1,k2,k3))), 2696 SND (SND (mw_mul_pass_top x ys (k1,k2,k3))),x, 2697 n2w (LENGTH (ys1++ys)),n2w (LENGTH (ys1++ys)),ys1++ys)) /\ 2698 l <= l2 + LENGTH ys``, 2699 Induct \\ FULL_SIMP_TAC std_ss [APPEND,APPEND_NIL] 2700 \\ ONCE_REWRITE_TAC [mc_top_two_def,mc_top_two_pre_def] 2701 \\ FULL_SIMP_TAC std_ss [LET_DEF,n2w_11,mw_mul_pass_top_def] 2702 \\ rpt STRIP_TAC 2703 \\ `LENGTH ys1 < dimword (:'a) /\ 2704 LENGTH (ys1 ++ h::ys) <> LENGTH ys1` by 2705 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2706 \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH] 2707 \\ FULL_SIMP_TAC std_ss [mc_single_mul_thm] 2708 \\ Cases_on `single_mul_add x h k1 0w` 2709 \\ FULL_SIMP_TAC std_ss [LET_DEF,SNOC_INTRO] 2710 \\ `(LENGTH ys1 + 1) = (LENGTH (SNOC h ys1))` by 2711 FULL_SIMP_TAC (srw_ss()) [word_add_n2w,ADD1] 2712 \\ FULL_SIMP_TAC std_ss [word_add_n2w] 2713 \\ `LENGTH ys <= l-1` by fs [] 2714 \\ res_tac \\ SEP_I_TAC "mc_top_two" 2715 \\ rfs []) 2716 |> Q.SPECL [`ys`,`x`,`0w`,`0w`,`0w`,`[]`] |> DISCH ``1 < LENGTH (ys:'a word list)`` 2717 |> SIMP_RULE std_ss [APPEND_NIL,APPEND,LENGTH,mw_mul_pass_top_thm] 2718 |> REWRITE_RULE [AND_IMP_INTRO] 2719 2720(* mw_div -- copy result down *) 2721 2722val (mc_copy_down_def, _, 2723 mc_copy_down_pre_def, _) = 2724 tailrec_define "mc_copy_down" `` 2725 (\(l,r8,r10,r11,zs). 2726 if r8 = 0x0w then (INR (l,zs),T) 2727 else 2728 (let cond = w2n r10 < LENGTH zs in 2729 let r0 = EL (w2n r10) zs in 2730 let r8 = r8 - 0x1w in 2731 let r10 = r10 + 0x1w in 2732 let cond = cond /\ w2n r11 < LENGTH zs in 2733 let zs = LUPDATE r0 (w2n r11) zs in 2734 let r11 = r11 + 0x1w 2735 in 2736 (INL (l-1,r8,r10,r11,zs),cond /\ l <> 0))) 2737 :num # 'a word # 'a word # 'a word # 'a word list -> (num # 'a 2738 word # 'a word # 'a word # 'a word list + num # 'a word list) # bool``; 2739 2740val mc_copy_down_thm = prove( 2741 ``!(zs0:'a word list) zs1 zs2 zs3 l. 2742 LENGTH (zs0 ++ zs1 ++ zs2) < dimword (:'a) /\ zs1 <> [] /\ 2743 LENGTH zs2 <= l ==> 2744 ?zs4 l2. 2745 mc_copy_down_pre (l,n2w (LENGTH zs2), 2746 n2w (LENGTH (zs0 ++ zs1)),n2w (LENGTH zs0),zs0 ++ zs1 ++ zs2 ++ zs3) /\ 2747 (mc_copy_down (l,n2w (LENGTH zs2), 2748 n2w (LENGTH (zs0 ++ zs1)),n2w (LENGTH zs0),zs0 ++ zs1 ++ zs2 ++ zs3) = 2749 (l2,zs0 ++ zs2 ++ zs4)) /\ (LENGTH zs4 = LENGTH zs1 + LENGTH zs3) /\ 2750 l <= l2 + LENGTH zs2``, 2751 Induct_on `zs2` 2752 \\ ONCE_REWRITE_TAC [mc_copy_down_def,mc_copy_down_pre_def] 2753 \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND_NIL] 2754 \\ FULL_SIMP_TAC std_ss [APPEND_11,GSYM APPEND_ASSOC,LENGTH_APPEND] 2755 \\ REPEAT STRIP_TAC 2756 \\ `SUC (LENGTH zs2) < dimword (:'a) /\ 0 < dimword (:'a) /\ 2757 (LENGTH zs0 + LENGTH zs1) < dimword (:'a) /\ LENGTH zs0 < dimword (:'a)` 2758 by (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC) 2759 \\ FULL_SIMP_TAC std_ss [n2w_11,ADD1,w2n_n2w] 2760 \\ FULL_SIMP_TAC std_ss [GSYM LENGTH_APPEND,APPEND_ASSOC,EL_LENGTH] 2761 \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB,LET_DEF] 2762 \\ FULL_SIMP_TAC std_ss [word_add_n2w] 2763 \\ Cases_on `zs1` \\ FULL_SIMP_TAC std_ss [] 2764 \\ Q.MATCH_ASSUM_RENAME_TAC `z::zs <> []` 2765 \\ FULL_SIMP_TAC std_ss [] 2766 \\ `(LENGTH (zs0 ++ z::zs) + 1 = LENGTH (SNOC h zs0 ++ SNOC h zs)) /\ 2767 (LENGTH zs0 + 1 = LENGTH (SNOC h zs0))` 2768 by (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,LENGTH_SNOC] \\ DECIDE_TAC) 2769 \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH,GSYM APPEND_ASSOC,APPEND] 2770 \\ SIMP_TAC std_ss [SNOC_INTRO] \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC] 2771 \\ Q.PAT_X_ASSUM `!xx.bb` (MP_TAC o Q.SPECL [`SNOC h zs0`,`SNOC h zs`,`zs3`,`l-1`]) 2772 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 2773 (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,LENGTH_SNOC,NOT_SNOC_NIL] \\ fs []) 2774 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 2775 \\ Q.EXISTS_TAC `zs4` \\ FULL_SIMP_TAC std_ss [] 2776 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,LENGTH_SNOC,NOT_SNOC_NIL] 2777 \\ fs []) |> Q.SPEC `[]` |> SIMP_RULE std_ss [APPEND,LENGTH]; 2778 2779(* mw_div -- copy xs into zs *) 2780 2781val (mc_copy_over_def, _, 2782 mc_copy_over_pre_def, _) = 2783 tailrec_define "mc_copy_over" `` 2784 (\(l,r10,xs,zs). 2785 if r10 = 0x0w then (INR (l,xs,zs),T) 2786 else 2787 (let r10 = r10 - 0x1w in 2788 let cond = w2n r10 < LENGTH xs in 2789 let r0 = EL (w2n r10) xs in 2790 let cond = cond /\ w2n r10 < LENGTH zs in 2791 let zs = LUPDATE r0 (w2n r10) zs 2792 in 2793 (INL (l-1,r10,xs,zs),cond /\ l<>0))) 2794 :num # 'a word # 'a word list # 'a word list -> (num # 'a word # 2795 'a word list # 'a word list + num # 'a word list # 'a word list) # bool``; 2796 2797val mc_copy_over_thm = prove( 2798 ``!(xs0:'a word list) zs0 xs zs l. 2799 (LENGTH zs0 = LENGTH xs0) /\ 2800 LENGTH (zs0++zs) < dimword (:'a) /\ 2801 LENGTH xs0 <= l ==> 2802 ?l2. 2803 mc_copy_over_pre (l,n2w (LENGTH xs0),xs0 ++ xs,zs0 ++ zs) /\ 2804 (mc_copy_over (l,n2w (LENGTH xs0),xs0 ++ xs,zs0 ++ zs) = 2805 (l2,xs0 ++ xs,xs0 ++ zs)) /\ 2806 l <= l2 + LENGTH xs0``, 2807 HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1 2808 (ONCE_REWRITE_TAC [mc_copy_over_def,mc_copy_over_pre_def] 2809 \\ SIMP_TAC std_ss [LENGTH,LENGTH_NIL,APPEND]) 2810 \\ rpt STRIP_TAC 2811 \\ `(zs0 = []) \/ ?x l. zs0 = SNOC x l` by METIS_TAC [SNOC_CASES] 2812 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,LENGTH_SNOC] 2813 \\ `LENGTH xs0 + 1 < dimword (:'a) /\ LENGTH xs0 < dimword (:'a)` by (FULL_SIMP_TAC std_ss [LENGTH_SNOC,LENGTH_APPEND] \\ DECIDE_TAC) 2814 \\ ONCE_REWRITE_TAC [mc_copy_over_def,mc_copy_over_pre_def] 2815 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] 2816 \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB,LET_DEF] 2817 \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH,SNOC_APPEND] 2818 \\ Q.PAT_X_ASSUM `LENGTH l' = LENGTH xs0` (ASSUME_TAC o GSYM) 2819 \\ ASM_SIMP_TAC std_ss [LUPDATE_LENGTH,APPEND,GSYM APPEND_ASSOC] 2820 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] 2821 \\ SEP_I_TAC "mc_copy_over" 2822 \\ pop_assum mp_tac 2823 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [] 2824 \\ strip_tac \\ fs []) 2825 2826(* mw_div -- top-level function *) 2827 2828val (mc_div0_def, _, 2829 mc_div0_pre_def, _) = 2830 tailrec_define "mc_div0" `` 2831 ( \ (l,r0,r1,r3,xs,ys,zs). 2832 let r6 = r0 in 2833 if r3 = 0x0w then 2834 (let r0 = 0x0w in (INR (l,r0,r3,r6,xs,ys,zs),T)) 2835 else 2836 (let r11 = r0 in 2837 let r10 = r1 in 2838 let r0 = 0x0w in 2839 let cond = mc_mul_zero_pre (l-1,r0,r10,zs) /\ l <> 0 in 2840 let (l,r10,zs) = mc_mul_zero (l-1,r0,r10,zs) in 2841 let r10 = r11 in 2842 let cond = cond /\ mc_copy_over_pre (l-1,r10,xs,zs) /\ l <> 0 in 2843 let (l,xs,zs) = mc_copy_over (l-1,r10,xs,zs) in 2844 let r0 = r1 2845 in 2846 (INR (l,r0,r3,r6,xs,ys,zs),cond))) 2847 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list # 2848 'a word list -> (num # 'a word # 'a word # 'a word # 'a word list 2849 # 'a word list # 'a word list + num # 'a word # 'a word # 'a word 2850 # 'a word list # 'a word list # 'a word list) # bool``; 2851 2852 2853val (mc_div1_def, _, 2854 mc_div1_pre_def, _) = 2855 tailrec_define "mc_div1" `` 2856 ( \ (l,r0,r1,r3,xs,ys,zs). 2857 (let r14 = r3 in 2858 let r2 = 0x0w in 2859 let r10 = r2 in 2860 let cond = w2n r10 < LENGTH ys in 2861 let r9 = EL (w2n r10) ys in 2862 let r10 = r0 in 2863 let r8 = r0 in 2864 let cond = cond /\ mc_simple_div_pre (l-1,r2,r9,r10,xs,zs) /\ l <> 0 in 2865 let (l,r2,r9,r10,xs,zs) = mc_simple_div (l-1,r2,r9,r10,xs,zs) in 2866 let r6 = 0x0w in 2867 let r0 = r8 in 2868 let r3 = r14 2869 in 2870 if r3 = 0x0w then 2871 if r2 = 0x0w then (INR (l,r0,r3,r6,xs,ys,zs),cond) 2872 else (let r6 = 0x1w in (INR (l,r0,r3,r6,xs,ys,zs),cond)) 2873 else 2874 (let r0 = 0x1w in 2875 let r10 = 0x0w:'a word in 2876 let cond = cond /\ w2n r10 < LENGTH zs in 2877 let zs = LUPDATE r2 (w2n r10) zs 2878 in 2879 if r2 = 0x0w then (INR (l,r0,r3,r6,xs,ys,zs),cond) 2880 else (let r6 = 0x1w in (INR (l,r0,r3,r6,xs,ys,zs),cond))))) 2881 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list # 2882 'a word list -> (num # 'a word # 'a word # 'a word # 'a word list 2883 # 'a word list # 'a word list + num # 'a word # 'a word # 'a word 2884 # 'a word list # 'a word list # 'a word list) # bool``; 2885 2886val (mc_div2_def, _, 2887 mc_div2_pre_def, _) = 2888 tailrec_define "mc_div2" `` 2889 (\(l,r7,r8,r10,r11,r18,xs,ys,zs). 2890 let r9 = r7 in 2891 let r2 = 0x0w in 2892 let cond = mc_simple_div1_pre (l-1,r2,r9,r10,zs) /\ l <> 0 in 2893 let (l,r2,r9,r10,zs) = mc_simple_div1 (l-1,r2,r9,r10,zs) in 2894 let r9 = r11 in 2895 let r10 = r9 in 2896 let r7 = r8 in 2897 let cond = cond /\ mc_fix_pre (l-1,r8,r10,zs) /\ l <> 0 in 2898 let (l,r8,r10,zs) = mc_fix (l-1,r8,r10,zs) in 2899 let r6 = r10 in 2900 let r10 = r9 in 2901 let r3 = r18 in 2902 let r8 = r7 2903 in 2904 if r3 = 0x0w then 2905 (let r11 = 0x0w in 2906 let cond = cond /\ mc_copy_down_pre (l-1,r8,r10,r11,zs) /\ l<>0 in 2907 let (l,zs) = mc_copy_down (l-1,r8,r10,r11,zs) in 2908 let r0 = r7 2909 in 2910 (INR (l,r0,r3,r6,xs,ys,zs),cond)) 2911 else (let r0 = r9 in (INR (l,r0,r3,r6,xs,ys,zs),cond))) 2912 : num # �� word # �� word # �� word # �� word # �� word # �� word list # 2913 �� word list # �� word list -> (num # �� word # �� word # �� word # �� 2914 word # �� word # �� word list # �� word list # �� word list + num # �� 2915 word # �� word # �� word # �� word list # �� word list # �� word list) 2916 # bool`` 2917 2918val (mc_div3_def, _, 2919 mc_div3_pre_def, _) = 2920 tailrec_define "mc_div3" `` 2921 (\(l,r2,r7,r9,r18,r19,xs,ys,zs). 2922 let r1 = 0x0w in 2923 let r8 = r2 in 2924 let r10 = r1 in 2925 let r11 = r1 in 2926 let cond = mc_mul_by_single_pre (l-1,r1,r8,r9,r10,r11,xs,zs) /\ l<>0 2927 in 2928 let (l,r1,r8,r9,r10,xs,zs) = 2929 mc_mul_by_single (l-1,r1,r8,r9,r10,r11,xs,zs) 2930 in 2931 let r1 = 0x0w in 2932 let cond = cond /\ w2n r10 < LENGTH zs in 2933 let zs = LUPDATE r1 (w2n r10) zs in 2934 let r0 = 0x0w in 2935 let r1 = r0 in 2936 let r3 = r0 in 2937 let r11 = r0 in 2938 let r9 = r7 in 2939 let cond = cond /\ mc_top_two_pre (l-1,r0,r1,r3,r8,r9,r11,ys) /\ l <> 0 in 2940 let (l,r0,r1,r8,r9,r11,ys) = mc_top_two (l-1,r0,r1,r3,r8,r9,r11,ys) in 2941 let r7 = r8 in 2942 let r11 = r9 in 2943 let r10 = r19 in 2944 let r10 = r10 - r9 in 2945 let r10 = r10 + 0x2w in 2946 let r14 = r0 in 2947 let r15 = r1 in 2948 let r17 = r10 in 2949 let cond = cond /\ mc_div_loop_pre (l-1,r7,r9,r10,r11,r14,r15,ys,zs) /\ l<>0 in 2950 let (l,r7,r9,r10,r11,r14,r15,ys,zs) = 2951 mc_div_loop (l-1,r7,r9,r10,r11,r14,r15,ys,zs) 2952 in 2953 let r8 = r17 in 2954 let r11 = r9 in 2955 let r10 = r9 in 2956 let cond = cond /\ mc_div2_pre (l,r7,r8,r10,r11,r18,xs,ys,zs) in 2957 let (l,r0,r3,r6,xs,ys,zs) = mc_div2 (l,r7,r8,r10,r11,r18,xs,ys,zs) in 2958 (INR (l,r0,r3,r6,xs,ys,zs),cond)) 2959 : num # �� word # �� word # �� word # �� word # �� word # �� word list # �� 2960 word list # �� word list -> (num # �� word # �� word # �� word # �� 2961 word # �� word # �� word list # �� word list # �� word list + num # �� 2962 word # �� word # �� word # �� word list # �� word list # �� word list) 2963 # bool`` 2964 2965val (mc_div_def, _, 2966 mc_div_pre_def, _) = 2967 tailrec_define "mc_div" `` 2968 (\(l,r0,r1,r3,xs,ys,zs). 2969 if r0 <+ r1 then 2970 (let cond = mc_div0_pre (l,r0,r1,r3,xs,ys,zs) in 2971 let (l,r0,r3,r6,xs,ys,zs) = mc_div0 (l,r0,r1,r3,xs,ys,zs) in 2972 (INR (l,r0,r3,r6,xs,ys,zs),cond)) 2973 else if r1 = 0x1w then 2974 (let cond = mc_div1_pre (l,r0,r1,r3,xs,ys,zs) in 2975 let (l,r0,r3,r6,xs,ys,zs) = mc_div1 (l,r0,r1,r3,xs,ys,zs) in 2976 (INR (l,r0,r3,r6,xs,ys,zs),cond)) 2977 else 2978 (let r18 = r3 in 2979 let r19 = r0 in 2980 let r7 = r1 in 2981 let r9 = r0 in 2982 let r10 = r1 in 2983 let r10 = r10 - 0x1w in 2984 let cond = w2n r10 < LENGTH ys in 2985 let r1 = EL (w2n r10) ys in 2986 let r2 = 0x1w in 2987 let cond = cond /\ mc_calc_d_pre (l-1,r1,r2) /\ l <> 0 in 2988 let (l,r2) = mc_calc_d (l-1,r1,r2) in 2989 let cond = cond /\ mc_div3_pre (l,r2,r7,r9,r18,r19,xs,ys,zs) in 2990 let (l,r0,r3,r6,xs,ys,zs) = mc_div3 (l,r2,r7,r9,r18,r19,xs,ys,zs) in 2991 (INR (l,r0,r3,r6,xs,ys,zs),cond))) 2992 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list # 2993 'a word list -> (num # 'a word # 'a word # 'a word # 'a word list 2994 # 'a word list # 'a word list + num # 'a word # 'a word # 'a word 2995 # 'a word list # 'a word list # 'a word list) # bool``; 2996 2997val mc_div_def = mc_div_def 2998 |> REWRITE_RULE [mc_div0_def,mc_div0_pre_def, 2999 mc_div1_def,mc_div1_pre_def, 3000 mc_div2_def,mc_div2_pre_def, 3001 mc_div3_def,mc_div3_pre_def] 3002 3003val mc_div_pre_def = mc_div_pre_def 3004 |> REWRITE_RULE [mc_div0_def,mc_div0_pre_def, 3005 mc_div1_def,mc_div1_pre_def, 3006 mc_div2_def,mc_div2_pre_def, 3007 mc_div3_def,mc_div3_pre_def] 3008 3009val mw_fix_SNOC = store_thm("mw_fix_SNOC", 3010 ``mw_fix (SNOC 0w xs) = mw_fix xs``, 3011 SIMP_TAC std_ss [Once mw_fix_def,FRONT_SNOC,LAST_SNOC] \\ SRW_TAC [] []); 3012 3013val mw_fix_REPLICATE = prove( 3014 ``!n. mw_fix (xs ++ REPLICATE n 0w) = mw_fix xs``, 3015 Induct THEN1 SIMP_TAC std_ss [REPLICATE,APPEND_NIL] 3016 \\ ASM_SIMP_TAC std_ss [REPLICATE_SNOC,APPEND_SNOC,mw_fix_SNOC]); 3017 3018val MAP_K_0 = prove( 3019 ``!xs. MAP (\x. 0x0w) xs = REPLICATE (LENGTH xs) 0x0w``, 3020 Induct \\ SRW_TAC [] [REPLICATE]); 3021 3022val mc_div_max_def = Define ` 3023 mc_div_max (xs:'a word list) (ys:'a word list) (zs:'a word list) = 3024 2 * LENGTH ys + 2 * LENGTH zs + 5 + dimindex (:��) + 3025 LENGTH xs * (dimword (:��) + 2 * LENGTH ys + 4)`; 3026 3027val mc_div_thm = prove( 3028 ``(ys:'a word list) <> [] /\ mw_ok xs /\ mw_ok ys /\ 3029 LENGTH xs + LENGTH ys <= LENGTH zs /\ 3030 LENGTH zs < dimword (:'a) /\ ((res,mod,T) = mw_div xs ys) /\ 3031 mc_div_max xs ys zs <= l ==> 3032 ?zs2 l2. 3033 mc_div_pre (l,n2w (LENGTH xs),n2w (LENGTH ys),r3,xs,ys,zs) /\ 3034 (mc_div (l,n2w (LENGTH xs),n2w (LENGTH ys),r3,xs,ys,zs) = 3035 (l2,n2w (LENGTH (if r3 = 0w then res else mod)),r3, 3036 n2w (LENGTH (mw_fix mod)),xs,ys, 3037 (if r3 = 0w then res else mod) ++ zs2)) /\ 3038 (LENGTH zs = LENGTH ((if r3 = 0w then res else mod) ++ zs2)) /\ 3039 ((r3 = 0w) ==> LENGTH zs2 <> 0) /\ LENGTH (mw_fix mod) < dimword (:'a) /\ 3040 l <= l2 + mc_div_max xs ys zs``, 3041 REWRITE_TAC [mc_div_max_def] 3042 \\ SIMP_TAC std_ss [mw_div_def,LET_DEF] \\ STRIP_TAC 3043 \\ `LENGTH xs < dimword (:'a) /\ LENGTH ys < dimword (:'a)` by DECIDE_TAC 3044 \\ IMP_RES_TAC mw_ok_mw_fix_ID \\ FULL_SIMP_TAC std_ss [] 3045 \\ NTAC 2 (POP_ASSUM (K ALL_TAC)) 3046 \\ Cases_on `LENGTH xs < LENGTH ys` \\ FULL_SIMP_TAC std_ss [] THEN1 3047 (Cases_on `r3 = 0w` \\ FULL_SIMP_TAC std_ss [] THEN1 3048 (Q.EXISTS_TAC `zs` 3049 \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND,APPEND] 3050 \\ ASM_SIMP_TAC std_ss [mc_div_def,mc_div_pre_def,LET_DEF,WORD_LO, 3051 w2n_n2w, mw_ok_mw_fix_ID,n2w_11,ZERO_LT_dimword,LENGTH_NIL, 3052 mw_fix_REPLICATE] \\ FULL_SIMP_TAC std_ss [LENGTH,GSYM LENGTH_NIL] 3053 \\ DECIDE_TAC) 3054 \\ ASM_SIMP_TAC std_ss [mc_div_def,mc_div_pre_def,LET_DEF,WORD_LO, 3055 w2n_n2w, mw_ok_mw_fix_ID,n2w_11,ZERO_LT_dimword,LENGTH_NIL] 3056 \\ `?zs1 zs2. (zs = zs1 ++ zs2) /\ (LENGTH zs1 = LENGTH ys)` by (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC) 3057 \\ POP_ASSUM (ASSUME_TAC o GSYM) 3058 \\ FULL_SIMP_TAC std_ss [] 3059 \\ `LENGTH zs1 ��� l ��� 1` by fs [] 3060 \\ ASSUME_TAC mc_mul_zero_thm \\ SEP_I_TAC "mc_mul_zero" 3061 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [] 3062 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3063 \\ `?zs3 zs4. (zs1 = zs3 ++ zs4) /\ (LENGTH zs3 = LENGTH xs)` by (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC) 3064 \\ FULL_SIMP_TAC std_ss [MAP_APPEND,GSYM APPEND_ASSOC] 3065 \\ ASSUME_TAC (mc_copy_over_thm |> 3066 Q.SPECL [`xs`,`MAP (\x.0w) (zs3:'a word list)`,`[]`, 3067 `MAP (\x.0w) (zs4:'a word list) ++ zs2`, 3068 `l ��� 1 ��� LENGTH (xs ++ zs4:'a word list)-1`] 3069 |> SIMP_RULE std_ss [LENGTH_MAP,APPEND_NIL,LENGTH_APPEND] |> GEN_ALL) 3070 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,MAP_APPEND,APPEND_ASSOC] 3071 \\ SEP_I_TAC "mc_copy_over" \\ POP_ASSUM MP_TAC 3072 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 3073 THEN1 (fs []) 3074 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3075 \\ `LENGTH (zs3 ++ zs4) - LENGTH xs = LENGTH zs4` by FULL_SIMP_TAC std_ss [LENGTH_APPEND] 3076 \\ FULL_SIMP_TAC std_ss [mw_fix_REPLICATE,mw_ok_mw_fix_ID] 3077 \\ ASM_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE,GSYM LENGTH_NIL] 3078 \\ ASM_SIMP_TAC std_ss [MAP_K_0,APPEND_11] 3079 \\ fs []) 3080 \\ Cases_on `LENGTH ys = 1` \\ FULL_SIMP_TAC std_ss [] THEN1 3081 (`?qs r c. mw_simple_div 0x0w (REVERSE xs) (HD ys) = (qs,r,c)` by METIS_TAC [PAIR] 3082 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] 3083 \\ `0 < dimword (:'a)` by DECIDE_TAC 3084 \\ ASM_SIMP_TAC std_ss [mc_div_def,mc_div_pre_def,LET_DEF,WORD_LO,w2n_n2w,EL] 3085 \\ `?zs1 zs2. (zs = zs1 ++ zs2) /\ (LENGTH zs1 = LENGTH xs)` by 3086 (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC) 3087 \\ FULL_SIMP_TAC std_ss [] 3088 \\ ASSUME_TAC (mc_simple_div_thm |> Q.SPECL [`xs`,`[]`] |> GEN_ALL 3089 |> SIMP_RULE std_ss [APPEND_NIL]) 3090 \\ SEP_I_TAC "mc_simple_div" \\ POP_ASSUM MP_TAC 3091 \\ `LENGTH xs ��� l ��� 1` by fs [] 3092 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 3093 \\ `(LENGTH xs) = (LENGTH qs)` by 3094 (IMP_RES_TAC LENGTH_mw_simple_div \\ FULL_SIMP_TAC (srw_ss()) []) 3095 \\ Cases_on `r3 = 0w` \\ FULL_SIMP_TAC std_ss [] THEN1 3096 (Q.EXISTS_TAC `zs2` \\ Cases_on `r = 0w` 3097 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REVERSE] 3098 \\ fs [] 3099 \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss [] \\ EVAL_TAC 3100 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL] 3101 \\ fs [dimword_def]) 3102 \\ FULL_SIMP_TAC std_ss [HD,NOT_CONS_NIL,TL,LENGTH] 3103 \\ Cases_on `REVERSE qs` 3104 THEN1 FULL_SIMP_TAC std_ss [GSYM LENGTH_NIL,LENGTH_REVERSE] 3105 \\ FULL_SIMP_TAC std_ss [APPEND,LUPDATE_def,LENGTH] 3106 \\ Q.EXISTS_TAC `t ++ zs2` 3107 \\ `LENGTH (mw_fix [r]) = if r = 0w then 0 else 1` by (EVAL_TAC \\ SRW_TAC [] [] \\ EVAL_TAC) 3108 \\ `LENGTH (REVERSE qs) = LENGTH (h::t)` by FULL_SIMP_TAC std_ss [] 3109 \\ `LENGTH (zs1 ++ zs2) = SUC (LENGTH (t ++ zs2))` by (FULL_SIMP_TAC std_ss [LENGTH,LENGTH_REVERSE,LENGTH_APPEND] \\ DECIDE_TAC) 3110 \\ `LENGTH (t ++ zs2) <> 0` by (FULL_SIMP_TAC std_ss [LENGTH,LENGTH_REVERSE,LENGTH_APPEND] \\ DECIDE_TAC) 3111 \\ FULL_SIMP_TAC std_ss [] 3112 \\ Cases_on `r = 0w` \\ FULL_SIMP_TAC std_ss [HD,NOT_CONS_NIL,TL] 3113 \\ fs []) 3114 \\ Q.ABBREV_TAC `d = calc_d (LAST ys,0x1w)` 3115 \\ Q.ABBREV_TAC `xs1 = mw_mul_by_single d xs ++ [0x0w]` 3116 \\ `?qs1 rs1. (mw_div_aux (BUTLASTN (LENGTH ys) xs1) (LASTN (LENGTH ys) xs1) 3117 (FRONT (mw_mul_by_single d ys))) = (qs1,rs1)` by METIS_TAC [PAIR] 3118 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REVERSE] 3119 \\ `LENGTH ys <> 0` by FULL_SIMP_TAC std_ss [LENGTH_NIL] 3120 \\ `0 < dimword (:'a) /\ LENGTH ys - 1 < dimword (:'a)` by DECIDE_TAC 3121 \\ `1 < dimword (:'a) /\ ~(LENGTH ys < 1) /\ 0 < LENGTH ys` by DECIDE_TAC 3122 \\ ASM_SIMP_TAC std_ss [mc_div_def,mc_div_pre_def,LET_DEF,WORD_LO, 3123 w2n_n2w,n2w_11,word_arith_lemma2] 3124 \\ `(LAST ys <> 0w) /\ (EL (LENGTH ys - 1) ys = LAST ys)` by 3125 (FULL_SIMP_TAC std_ss [mw_ok_def] 3126 \\ `(ys = []) \/ ?y ys2. ys = SNOC y ys2` by METIS_TAC [SNOC_CASES] 3127 \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC,LAST_SNOC] 3128 \\ FULL_SIMP_TAC std_ss [EL_LENGTH,SNOC_APPEND]) 3129 \\ assume_tac mc_calc_d_thm 3130 \\ SEP_I_TAC "mc_calc_d" 3131 \\ pop_assum mp_tac 3132 \\ match_mp_tac IMP_IMP 3133 \\ conj_tac THEN1 (fs [] \\ Cases_on `LAST ys` \\ fs []) 3134 \\ strip_tac \\ fs [] 3135 \\ `?zs1 zs2. (zs = zs1 ++ zs2) /\ (LENGTH zs1 = LENGTH xs)` by 3136 (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC) 3137 \\ FULL_SIMP_TAC std_ss [] 3138 \\ Cases_on `zs2` \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] 3139 THEN1 (`F` by DECIDE_TAC) 3140 \\ ASSUME_TAC mc_mul_by_single_thm 3141 \\ SEP_I_TAC "mc_mul_by_single" 3142 \\ POP_ASSUM MP_TAC 3143 \\ match_mp_tac IMP_IMP 3144 \\ conj_tac THEN1 fs [] 3145 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 3146 \\ FULL_SIMP_TAC std_ss [] 3147 \\ Cases_on `t` \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] 3148 THEN1 (`F` by DECIDE_TAC) 3149 \\ Q.MATCH_ASSUM_RENAME_TAC `zs = zs1 ++ z1::z2::zs2` 3150 \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single] 3151 \\ `LENGTH xs + 1 < dimword (:'a)` by DECIDE_TAC \\ FULL_SIMP_TAC std_ss [w2n_n2w] 3152 \\ `LUPDATE 0x0w (LENGTH xs + 1) (mw_mul_by_single d xs ++ z2::zs2) = 3153 xs1 ++ zs2` by 3154 (`LENGTH xs + 1 = LENGTH (mw_mul_by_single d xs)` by 3155 FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single] 3156 \\ ASM_SIMP_TAC std_ss [LUPDATE_LENGTH] 3157 \\ Q.UNABBREV_TAC `xs1` 3158 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC, APPEND]) 3159 \\ FULL_SIMP_TAC std_ss [] \\ POP_ASSUM (K ALL_TAC) 3160 \\ (mc_top_two_thm |> GEN_ALL |> MP_CANON |> ASSUME_TAC) 3161 \\ SEP_I_TAC "mc_top_two" \\ POP_ASSUM MP_TAC 3162 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 fs [] 3163 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3164 \\ FULL_SIMP_TAC std_ss [HD,TL] 3165 \\ `n2w (LENGTH xs) - n2w (LENGTH ys) + 0x2w:'a word = 3166 n2w (LENGTH xs1 - LENGTH ys)` by 3167 (Q.UNABBREV_TAC `xs1` 3168 \\ FULL_SIMP_TAC std_ss [word_arith_lemma2,word_add_n2w,LENGTH_APPEND, 3169 LENGTH_mw_mul_by_single,LENGTH] \\ AP_TERM_TAC \\ DECIDE_TAC) 3170 \\ FULL_SIMP_TAC std_ss [] 3171 \\ `LENGTH xs + 2 = LENGTH xs1` by 3172 (Q.UNABBREV_TAC `xs1` 3173 \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single,LENGTH_APPEND,LENGTH] 3174 \\ DECIDE_TAC) 3175 \\ `LENGTH ys <= LENGTH xs1` by DECIDE_TAC 3176 \\ `?ts1 ts2. (xs1 = ts1 ++ ts2) /\ (LENGTH ts2 = LENGTH ys)` by 3177 (MATCH_MP_TAC LESS_EQ_LENGTH_ALT \\ FULL_SIMP_TAC std_ss []) 3178 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 3179 \\ FULL_SIMP_TAC std_ss [BUTLASTN_LENGTH_APPEND,LASTN_LENGTH_APPEND] 3180 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 3181 \\ ASSUME_TAC (mc_div_loop_thm |> SIMP_RULE std_ss [LET_DEF] |> GEN_ALL) 3182 \\ `-1w * n2w (LENGTH ys) + n2w (LENGTH xs) + 2w = 3183 n2w (LENGTH ts1):'a word` by 3184 (qpat_x_assum `_ = n2w (LENGTH ts1)` (assume_tac o GSYM) 3185 \\ full_simp_tac std_ss [WORD_SUB_INTRO] \\ NO_TAC) 3186 \\ FULL_SIMP_TAC std_ss [] 3187 \\ SEP_I_TAC "mc_div_loop" \\ POP_ASSUM MP_TAC 3188 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 3189 (FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ fs [] 3190 \\ rpt conj_tac \\ unabbrev_all_tac 3191 \\ TRY (MATCH_MP_TAC LAST_FRONT_mw_mul_by_single_NOT_ZERO \\ fs []) 3192 \\ Cases_on `LENGTH ys` \\ fs [] 3193 \\ Cases_on `n` \\ fs [] 3194 \\ fs [ADD1,GSYM ADD_ASSOC] 3195 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH ys = n2 + 2` 3196 \\ `LENGTH xs = n2 + LENGTH ts1` by fs [] 3197 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB]) 3198 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3199 \\ FULL_SIMP_TAC std_ss [TL,HD,NOT_CONS_NIL] 3200 \\ `(LENGTH rs1 = LENGTH ys) /\ (LENGTH qs1 = LENGTH ts1)` by 3201 (`LENGTH ys = LENGTH (FRONT (mw_mul_by_single d ys))` by 3202 (FULL_SIMP_TAC std_ss [LENGTH_FRONT,GSYM LENGTH_NIL, 3203 LENGTH_mw_mul_by_single] \\ DECIDE_TAC) 3204 \\ FULL_SIMP_TAC std_ss [] \\ MATCH_MP_TAC LENGTH_mw_div_aux 3205 \\ Q.EXISTS_TAC `ts2` \\ FULL_SIMP_TAC std_ss []) 3206 \\ FULL_SIMP_TAC std_ss [] 3207 \\ Q.PAT_X_ASSUM `LENGTH rs1 = LENGTH ys` (ASSUME_TAC o GSYM) 3208 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC] 3209 \\ ASSUME_TAC mc_simple_div1_thm 3210 \\ SEP_I_TAC "mc_simple_div1" \\ POP_ASSUM MP_TAC 3211 \\ `?x1 x2 x3. mw_simple_div 0x0w (REVERSE rs1) d = (x1,x2,x3)` by METIS_TAC [PAIR] 3212 \\ FULL_SIMP_TAC std_ss [] 3213 \\ match_mp_tac IMP_IMP \\ conj_tac 3214 THEN1 (fs [] 3215 \\ Cases_on `LENGTH rs1` \\ fs [] 3216 \\ Cases_on `n` \\ fs [] 3217 \\ fs [ADD1,GSYM ADD_ASSOC] 3218 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH ys = n2 + 2` 3219 \\ `LENGTH xs = n2 + LENGTH ts1` by fs [] 3220 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB]) 3221 \\ FULL_SIMP_TAC std_ss [] 3222 \\ STRIP_TAC \\ NTAC 2 (POP_ASSUM (K ALL_TAC)) 3223 \\ IMP_RES_TAC LENGTH_mw_simple_div 3224 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] 3225 \\ qpat_abbrev_tac `l5 = _ ��� 1 ��� LENGTH x1 ��� 1n` 3226 \\ (mc_fix_thm |> Q.SPECL [`REVERSE x1`,`REVERSE qs1 ++ zs2`, 3227 `n2w (LENGTH (ts1:'a word list))`,`l5`] |> MP_TAC) 3228 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 3229 THEN1 (fs [] 3230 \\ Cases_on `LENGTH x1` \\ fs [] 3231 \\ Cases_on `n` \\ fs [] 3232 \\ fs [ADD1,GSYM ADD_ASSOC] 3233 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH ys = n2 + 2` 3234 \\ `LENGTH xs = n2 + LENGTH ts1` by fs [] 3235 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB] 3236 \\ unabbrev_all_tac \\ fs []) 3237 \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC] \\ STRIP_TAC 3238 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] 3239 \\ Q.ABBREV_TAC `tt = mw_fix (REVERSE x1) ++ 3240 REPLICATE (LENGTH x1 - LENGTH (mw_fix (REVERSE x1))) 0x0w` 3241 \\ `LENGTH tt = LENGTH rs1` by 3242 (Q.UNABBREV_TAC `tt` 3243 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE] 3244 \\ `LENGTH (mw_fix (REVERSE x1)) <= LENGTH (REVERSE x1)` by 3245 FULL_SIMP_TAC std_ss [LENGTH_mw_fix] 3246 \\ `LENGTH (REVERSE x1) = LENGTH x1` by SRW_TAC [] [] 3247 \\ DECIDE_TAC) 3248 \\ Tactical.REVERSE (Cases_on `r3 = 0w`) \\ FULL_SIMP_TAC std_ss [] THEN1 3249 (Q.UNABBREV_TAC `tt` \\ FULL_SIMP_TAC std_ss 3250 [mw_fix_thm |> Q.SPEC `REVERSE xs` |> RW [LENGTH_REVERSE]] 3251 \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11,LENGTH_APPEND,LENGTH_REVERSE] 3252 \\ ASSUME_TAC (Q.ISPEC `REVERSE (x1:'a word list)` LENGTH_mw_fix) 3253 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ fs [ADD1] 3254 \\ Cases_on `LENGTH rs1` \\ fs [] 3255 \\ Cases_on `n` \\ fs [] 3256 \\ fs [ADD1,GSYM ADD_ASSOC] 3257 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH ys = n2 + 2` 3258 \\ `LENGTH xs = n2 + LENGTH ts1` by fs [] 3259 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB] 3260 \\ unabbrev_all_tac \\ fs []) 3261 \\ Q.MATCH_ASSUM_RENAME_TAC `l5 ��� l6 + LENGTH x1` 3262 \\ MP_TAC (mc_copy_down_thm |> Q.SPECL [`tt`,`REVERSE qs1`,`zs2`,`l6-1`]) 3263 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 3264 (full_simp_tac std_ss [GSYM LENGTH_NIL] 3265 \\ Cases_on `LENGTH x1` \\ fs [] 3266 \\ Cases_on `n` \\ fs [] 3267 \\ fs [ADD1,GSYM ADD_ASSOC] 3268 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH ys = n2 + 2` 3269 \\ `LENGTH xs = n2 + LENGTH ts1` by fs [] 3270 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB] 3271 \\ unabbrev_all_tac \\ fs []) 3272 \\ STRIP_TAC \\ NTAC 3 (POP_ASSUM MP_TAC) 3273 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE,APPEND_11] 3274 \\ `LENGTH (mw_fix (REVERSE x1)) < dimword (:'a)` by 3275 (`LENGTH (mw_fix (REVERSE x1)) <= LENGTH (REVERSE x1)` by 3276 FULL_SIMP_TAC std_ss [LENGTH_mw_fix] 3277 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC) 3278 \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH_NIL] 3279 \\ full_simp_tac std_ss [GSYM LENGTH_NIL] \\ rfs [] 3280 \\ rpt (disch_then (assume_tac)) 3281 \\ Cases_on `LENGTH x1` \\ fs [] 3282 \\ Cases_on `n` \\ fs [] 3283 \\ fs [ADD1,GSYM ADD_ASSOC] 3284 \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH ys = n2 + 2` 3285 \\ `LENGTH xs = n2 + LENGTH ts1` by fs [] 3286 \\ fs [LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB] 3287 \\ unabbrev_all_tac \\ fs []); 3288 3289(* mwi_div -- addv zs [] c *) 3290 3291val (mc_add1_def, _, 3292 mc_add1_pre_def, _) = 3293 tailrec_define "mc_add1" `` 3294 (\(l,r2,r10,r11,zs). 3295 if r10 = r11 then 3296 (let r0 = 0x1w in 3297 let cond = w2n r10 < LENGTH zs in 3298 let zs = LUPDATE r0 (w2n r10) zs in 3299 let r11 = r11 + 0x1w 3300 in 3301 (INR (l,r11,zs),cond)) 3302 else 3303 (let cond = w2n r10 < LENGTH zs in 3304 let r0 = EL (w2n r10) zs 3305 in 3306 if r0 = r2 then 3307 (let r0 = 0x0w in 3308 let zs = LUPDATE r0 (w2n r10) zs in 3309 let r10 = r10 + 0x1w 3310 in 3311 (INL (l-1,r2,r10,r11,zs),cond /\ l<>0)) 3312 else 3313 (let r0 = r0 + 0x1w in 3314 let zs = LUPDATE r0 (w2n r10) zs 3315 in 3316 (INR (l,r11,zs),cond)))) 3317 :num # 'a word # 'a word # 'a word # 'a word list -> (num # 'a 3318 word # 'a word # 'a word # 'a word list + num # 'a word # 'a word 3319 list) # bool``; 3320 3321val (mc_add1_call_def, _, 3322 mc_add1_call_pre_def, _) = 3323 tailrec_define "mc_add1_call" `` 3324 (\(l,r2,r6,r11,zs). 3325 if r2 = 0x0w then (INR (l,r11,zs),T) 3326 else if r6 = 0x0w then (INR (l,r11,zs),T) 3327 else 3328 (let r2 = 0x0w in 3329 let r10 = r2 in 3330 let r2 = ~r2 in 3331 let cond = mc_add1_pre (l-1,r2,r10,r11,zs) /\ l<>0 in 3332 let (l,r11,zs) = mc_add1 (l-1,r2,r10,r11,zs) 3333 in 3334 (INR (l,r11,zs),cond))) 3335 :num # 'a word # 'a word # 'a word # 'a word list -> (num # 'a 3336 word # 'a word # 'a word # 'a word list + num # 'a word # 'a word 3337 list) # bool``; 3338 3339val mc_add1_thm = prove( 3340 ``!(zs:'a word list) zs1 l. 3341 LENGTH (zs1 ++ zs) + 1 < dimword (:'a) /\ zs2 <> [] /\ 3342 LENGTH zs <= l ==> 3343 ?rest l2. 3344 mc_add1_pre (l,~0w,n2w (LENGTH zs1),n2w (LENGTH (zs1 ++ zs)), 3345 zs1 ++ zs ++ zs2) /\ 3346 (mc_add1 (l,~0w,n2w (LENGTH zs1),n2w (LENGTH (zs1 ++ zs)), 3347 zs1 ++ zs ++ zs2) = 3348 (l2,n2w (LENGTH (zs1 ++ mw_addv zs [] T)), 3349 zs1 ++ mw_addv zs [] T ++ rest)) /\ 3350 LENGTH (zs1 ++ mw_addv zs [] T) < dimword (:'a) /\ 3351 (LENGTH (zs1 ++ mw_addv zs [] T ++ rest) = LENGTH (zs1 ++ zs ++ zs2)) /\ 3352 l <= l2 + LENGTH zs``, 3353 Cases_on `zs2` \\ SIMP_TAC std_ss [] 3354 \\ Q.SPEC_TAC (`t`,`zs2`) \\ Q.SPEC_TAC (`h`,`t`) \\ STRIP_TAC \\ STRIP_TAC 3355 \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 3356 \\ Induct 3357 \\ SIMP_TAC std_ss [mw_addv_NIL,LENGTH_APPEND,APPEND,APPEND_NIL,LENGTH] 3358 \\ ONCE_REWRITE_TAC [mc_add1_def,mc_add1_pre_def] \\ REPEAT STRIP_TAC 3359 \\ `LENGTH zs1 < dimword (:'a)` by DECIDE_TAC 3360 \\ FULL_SIMP_TAC std_ss [LET_DEF,w2n_n2w,LENGTH_APPEND,LENGTH, 3361 word_add_n2w,n2w_11,LUPDATE_LENGTH] 3362 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,APPEND_11,CONS_11] 3363 THEN1 (fs []) 3364 \\ `(LENGTH zs1 + SUC (LENGTH zs)) < dimword (:'a) /\ 3365 LENGTH zs1 <> LENGTH zs1 + SUC (LENGTH zs)` by DECIDE_TAC 3366 \\ FULL_SIMP_TAC std_ss [LET_DEF,w2n_n2w,LENGTH_APPEND,LENGTH, 3367 word_add_n2w,n2w_11,LUPDATE_LENGTH,EL_LENGTH] 3368 \\ Tactical.REVERSE (Cases_on `h = ~0x0w`) \\ FULL_SIMP_TAC std_ss [] THEN1 3369 (Q.EXISTS_TAC `t::zs2` 3370 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,LENGTH] 3371 \\ DECIDE_TAC) \\ FULL_SIMP_TAC std_ss [LENGTH] 3372 \\ Q.PAT_X_ASSUM `!zss.bbb` (qspecl_then [`SNOC 0w zs1`,`l-1`] mp_tac) 3373 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [] 3374 \\ strip_tac \\ fs [ADD1,SNOC_APPEND] 3375 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND] \\ fs []) 3376 |> Q.SPECL [`zs`,`[]`] 3377 |> SIMP_RULE std_ss [APPEND,LENGTH]; 3378 3379(* mwi_div -- subtraction *) 3380 3381val (mc_div_sub_aux1_def, _, 3382 mc_div_sub_aux1_pre_def, _) = 3383 tailrec_define "mc_div_sub_aux1" `` 3384 (\(l,r1:'a word,r4:'a word,r8:'a word,r9:'a word,r10:'a word,ys,zs). 3385 if r1 = 0x1w then 3386 (let r1 = 0x0w:'a word 3387 in 3388 (INR (l,r1,r4,r8,r9,r10,ys,zs),T)) 3389 else 3390 (let r1 = r1 - 0x1w in 3391 let cond = w2n r10 < LENGTH ys in 3392 let r8 = EL (w2n r10) ys in 3393 let cond = cond /\ w2n r10 < LENGTH zs in 3394 let r9 = EL (w2n r10) zs in 3395 let cond = cond /\ ((r4 <> 0w) ==> (r4 = 1w)) in 3396 let (r8,r4) = single_sub_word r8 r9 r4 in 3397 let zs = LUPDATE r8 (w2n r10) zs in 3398 let r10 = r10 + 0x1w 3399 in 3400 (INL (l-1,r1,r4,r8,r9,r10,ys,zs),cond /\ l<>0n)))``; 3401 3402val (mc_div_sub_aux_def, _, 3403 mc_div_sub_aux_pre_def, _) = 3404 tailrec_define "mc_div_sub_aux" `` 3405 (\(l,r1,r8,r9,ys,zs). 3406 (let r10 = 0x0w in 3407 let r1 = r1 + 0x1w in 3408 let r4 = 1w in 3409 let cond = mc_div_sub_aux1_pre (l-1,r1,r4,r8,r9,r10,ys,zs) /\ l<>0 in 3410 let (l,r1,r4,r8,r9,r10,ys,zs) = mc_div_sub_aux1 (l-1,r1,r4,r8,r9,r10,ys,zs) 3411 in 3412 (INR (l,r1,r4,r8,r9,r10,ys,zs),cond))) 3413 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list 3414 -> (num # 'a word # 'a word # 'a word # 'a word list # 'a word 3415 list + num # 'a word # 'a word # 'a word # 'a word # 'a word # 'a 3416 word list # 'a word list) # bool``; 3417 3418val mc_div_sub_aux_def = 3419 LIST_CONJ [mc_div_sub_aux_def,mc_div_sub_aux_pre_def, 3420 mc_div_sub_aux1_def,mc_div_sub_aux1_pre_def] 3421 3422val (mc_div_sub1_def, _, 3423 mc_div_sub1_pre_def, _) = 3424 tailrec_define "mc_div_sub1" `` 3425 (\(l,r1,r8,r9,ys,zs). 3426 (let cond = mc_div_sub_aux_pre (l,r1,r8,r9,ys,zs) in 3427 let (l,r1,r4,r8,r9,r10,ys,zs) = mc_div_sub_aux (l,r1,r8,r9,ys,zs) 3428 in 3429 (INR (l,r1,r8,r9,r10,ys,zs),cond))) 3430 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list 3431 -> (num # 'a word # 'a word # 'a word # 'a word list # 'a word 3432 list + num # 'a word # 'a word # 'a word # 'a word # 'a word list 3433 # 'a word list) # bool``; 3434 3435val mc_div_sub1_def = 3436 LIST_CONJ [mc_div_sub1_def,mc_div_sub1_pre_def] 3437 3438val (mc_div_sub_call_def, _, 3439 mc_div_sub_call_pre_def, _) = 3440 tailrec_define "mc_div_sub_call" `` 3441 (\(l,r1,r2,r6,ys,zs). 3442 if r2 = 0x0w then (INR (l,r6,ys,zs),T) 3443 else if r6 = 0x0w then (INR (l,r6,ys,zs),T) 3444 else 3445 (let r8 = r6 in 3446 let r9 = r6 in 3447 let r3 = r1 in 3448 let cond = mc_div_sub1_pre (l,r1,r8,r9,ys,zs) in 3449 let (l,r1,r8,r9,r10,ys,zs) = mc_div_sub1 (l,r1,r8,r9,ys,zs) in 3450 let r10 = r3 in 3451 let cond = cond /\ mc_fix_pre (l-1,r8,r10,zs) /\ l<>0 in 3452 let (l,r8,r10,zs) = mc_fix (l-1,r8,r10,zs) in 3453 let r6 = r10 3454 in 3455 (INR (l,r6,ys,zs),cond))) 3456 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list -> 3457 (num # 'a word # 'a word # 'a word # 'a word list # 'a word list + 3458 num # 'a word # 'a word list # 'a word list) # bool``; 3459 3460val mc_div_sub_aux_thm = prove( 3461 ``!(ys:'a word list) zs ys1 zs1 ys2 zs2 c r8 r9 l. 3462 (LENGTH zs1 = LENGTH ys1) /\ (LENGTH zs = LENGTH ys) /\ 3463 LENGTH (zs1 ++ zs) + 1 < dimword (:'a) /\ LENGTH ys <= l ==> 3464 ?r8' r9' z_af' z_of' z_pf' z_sf' z_zf' l2. 3465 mc_div_sub_aux1_pre (l,n2w (LENGTH zs + 1),b2w c,r8, 3466 r9,n2w (LENGTH zs1),ys1 ++ ys ++ ys2,zs1 ++ zs ++ zs2) /\ 3467 (mc_div_sub_aux1 (l,n2w (LENGTH zs + 1),b2w c,r8, 3468 r9,n2w (LENGTH zs1),ys1 ++ ys ++ ys2,zs1 ++ zs ++ zs2) = 3469 (l2,0w,b2w (SND (mw_sub ys zs c)),r8',r9',n2w (LENGTH (zs1++zs)), 3470 ys1 ++ ys ++ ys2,zs1 ++ FST (mw_sub ys zs c) ++ zs2)) /\ 3471 l <= l2 + LENGTH ys``, 3472 Induct THEN1 3473 (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def] 3474 \\ ONCE_REWRITE_TAC [mc_div_sub_aux_def] 3475 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def,LET_DEF]) 3476 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1] 3477 \\ ONCE_REWRITE_TAC [mc_div_sub_aux_def] 3478 \\ FULL_SIMP_TAC std_ss [LET_DEF,ADD1,n2w_w2n,w2n_n2w, 3479 single_sub_word_thm] 3480 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] 3481 \\ `LENGTH ys1 < dimword (:'a) /\ 3482 LENGTH zs1 < dimword (:'a) /\ 3483 LENGTH ys + 1 + 1 < dimword (:'a) /\ 3484 1 < dimword (:'a)` by DECIDE_TAC 3485 \\ FULL_SIMP_TAC std_ss [EL_LENGTH,LUPDATE_LENGTH,GSYM APPEND_ASSOC,APPEND] 3486 \\ Q.PAT_X_ASSUM `LENGTH zs1 = LENGTH ys1` (ASSUME_TAC o GSYM) 3487 \\ FULL_SIMP_TAC std_ss [EL_LENGTH,LUPDATE_LENGTH,n2w_11,GSYM APPEND_ASSOC,APPEND] 3488 \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB] 3489 \\ FULL_SIMP_TAC std_ss [word_add_n2w] 3490 \\ SIMP_TAC std_ss [SNOC_INTRO] 3491 \\ `LENGTH zs1 + 1 = LENGTH (SNOC h' ys1)` by 3492 FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] 3493 \\ FULL_SIMP_TAC std_ss [] 3494 \\ SEP_I_TAC "mc_div_sub_aux1" \\ POP_ASSUM MP_TAC 3495 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 3496 THEN1 (fs []) 3497 \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 3498 \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_sub_def, 3499 LET_DEF,single_sub_def,b2n_thm,single_add_def] 3500 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 3501 \\ FULL_SIMP_TAC (srw_ss()) [b2w_def] 3502 \\ `(dimword(:'a) <= b2n ~c + (w2n h' + w2n (~h))) = 3503 ~(w2n h' < b2n c + w2n h)` by METIS_TAC [sub_borrow_lemma] 3504 \\ fs []) 3505 |> Q.SPECL [`ys`,`zs`,`[]`,`[]`,`ys2`,`zs2`,`T`] 3506 |> SIMP_RULE std_ss [APPEND,LENGTH,EVAL ``b2w T``] |> GEN_ALL; 3507 3508val mc_div_sub1_thm = prove( 3509 ``(LENGTH (zs:'a word list) = LENGTH ys) /\ LENGTH zs + 1 < dimword (:'a) /\ 3510 LENGTH ys + 1 <= l ==> 3511 ?r8' r9' l2. 3512 mc_div_sub1_pre (l,n2w (LENGTH ys),r8,r9,ys ++ ys2,zs ++ zs2) /\ 3513 (mc_div_sub1 (l,n2w (LENGTH ys),r8,r9,ys ++ ys2,zs ++ zs2) = 3514 (l2,0x0w,r8',r9',n2w (LENGTH ys),ys ++ ys2, 3515 FST (mw_sub ys zs T) ++ zs2)) /\ 3516 l <= l2 + LENGTH ys + 1``, 3517 SIMP_TAC std_ss [mc_div_sub1_def] 3518 \\ ONCE_REWRITE_TAC [mc_div_sub_aux_def] 3519 \\ SIMP_TAC std_ss [LET_DEF,WORD_SUB_RZERO,word_add_n2w] 3520 \\ REPEAT STRIP_TAC \\ ASSUME_TAC mc_div_sub_aux_thm 3521 \\ SEP_I_TAC "mc_div_sub_aux1" \\ POP_ASSUM MP_TAC 3522 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3523 \\ fs [] \\ rfs []); 3524 3525(* mwi_div -- integer division *) 3526 3527val (mc_idiv_mod_header_def, _, 3528 mc_idiv_mod_header_pre_def, _) = 3529 tailrec_define "mc_idiv_mod_header" `` 3530 (\(r6,r11). 3531 if r6 = 0x0w then (INR r6,T) 3532 else 3533 (let r6 = r6 << 1 3534 in 3535 if r11 && 0x1w = 0x0w then (INR r6,T) 3536 else (let r6 = r6 + 0x1w in (INR r6,T)))) 3537 :'a word # 'a word -> ('a word # 'a word + 'a word) # bool``; 3538 3539val mc_idiv_mod_header_thm = prove( 3540 ``LENGTH (xs:'a word list) < dimword (:'a) ==> 3541 (mc_idiv_mod_header (n2w (LENGTH xs),mc_header (t,ys)) = 3542 mc_header (xs <> [] /\ t,xs))``, 3543 SIMP_TAC std_ss [mc_idiv_mod_header_def,mc_header_sign,n2w_11, 3544 ZERO_LT_dimword,LENGTH_NIL,LET_DEF,mc_header_def,word_lsl_n2w] 3545 \\ rw[] \\ fs[] \\ rw[] 3546 THEN_LT USE_SG_THEN (fn th => metis_tac[th]) 1 2 3547 \\ Cases_on`xs` \\ fs[] 3548 \\ `dimindex(:'a) = 1` by fs[DIMINDEX_GT_0] 3549 \\ fs[dimword_def]); 3550 3551val (mc_idiv0_def, _, 3552 mc_idiv0_pre_def, _) = 3553 tailrec_define "mc_idiv0" `` 3554 (\(l,r0:'a word,r3:'a word,r6,r11,r20,xs:'a word list,ys,zs). 3555 if r3 = 0x0w then 3556 (let r10 = r0 in 3557 let r8 = r10 in 3558 let cond = mc_fix_pre (l-1,r8,r10,zs) /\ l<>0 in 3559 let (l,r8,r10,zs) = mc_fix (l-1,r8,r10,zs) in 3560 let r11 = r10 in 3561 let r2 = r20 in 3562 let r3 = r2 in 3563 let cond = cond /\ mc_add1_call_pre (l,r2,r6,r11,zs) in 3564 let (l,r11,zs) = mc_add1_call (l,r2,r6,r11,zs) 3565 in 3566 if r11 = 0x0w then (INR (l,r11,xs,ys,zs),cond) 3567 else 3568 (let r11 = r11 << 1 in 3569 let r11 = r11 + r3 3570 in 3571 (INR (l,r11,xs,ys,zs),cond))) 3572 else 3573 (let r2 = r20 in 3574 let r1 = r11 in 3575 let r1 = r1 >>> 1 in 3576 let cond = mc_div_sub_call_pre (l,r1,r2,r6,ys,zs) in 3577 let (l,r6,ys,zs) = mc_div_sub_call (l,r1,r2,r6,ys,zs) in 3578 let r6 = mc_idiv_mod_header (r6,r11) in 3579 let r11 = r6 3580 in 3581 (INR (l,r11,xs,ys,zs),cond))) 3582 : num # �� word # �� word # �� word # �� word # �� word # �� word list # 3583 �� word list # �� word list -> (num # �� word # �� word # �� word # �� 3584 word # �� word # �� word list # �� word list # �� word list + num # 3585 �� word # �� word list # �� word list # �� word list) # bool`` 3586 3587val (mc_idiv_def, _, 3588 mc_idiv_pre_def, _) = 3589 tailrec_define "mc_idiv" `` 3590 (\(l,r3,r10,r11,xs,ys,zs). 3591 (let r0 = r10 >>> 1 in 3592 let r1 = r11 >>> 1 in 3593 let r10 = r10 ?? r11 in 3594 let r10 = r10 && 0x1w in 3595 let r20 = r10 in 3596 let r21 = r11 in 3597 let cond = mc_div_pre (l,r0,r1,r3,xs,ys,zs) in 3598 let (l,r0,r3,r6,xs,ys,zs) = mc_div (l,r0,r1,r3,xs,ys,zs) in 3599 let r11 = r21 in 3600 let cond = cond /\ mc_idiv0_pre (l,r0,r3,r6,r11,r20,xs,ys,zs) in 3601 let (l,r11,xs,ys,zs) = mc_idiv0 (l,r0,r3,r6,r11,r20,xs,ys,zs) in 3602 (INR (l,r11,xs,ys,zs),cond))) 3603 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list # 3604 'a word list -> (num # 'a word # 'a word # 'a word # 'a word list 3605 # 'a word list # 'a word list + num # 'a word # 'a word list # 'a 3606 word list # 'a word list) # bool``; 3607 3608val mc_idiv_def = mc_idiv_def |> REWRITE_RULE [mc_idiv0_def,mc_idiv0_pre_def] 3609val mc_idiv_pre_def = mc_idiv_pre_def |> REWRITE_RULE [mc_idiv0_def,mc_idiv0_pre_def] 3610 3611val mc_header_XOR = prove( 3612 ``!s t. ((mc_header (s,xs) ?? mc_header (t,ys)) && 0x1w:'a word) = 3613 (b2w (s <> t)):'a word``, 3614 SIMP_TAC std_ss [WORD_RIGHT_AND_OVER_XOR,mc_header_AND_1] 3615 \\ Cases \\ Cases \\ rw[b2w_def,b2n_def]); 3616 3617val b2w_EQ_0w = prove( 3618 ``!b. (b2w b = 0w:'a word) = ~b``, 3619 Cases \\ EVAL_TAC \\ rw[one_neq_zero_word]); 3620 3621val mwi_divmod_alt_def = Define ` 3622 mwi_divmod_alt w s_xs t_ys = 3623 if w = 0w then mwi_div s_xs t_ys else mwi_mod s_xs t_ys`; 3624 3625val mc_idiv_thm = prove( 3626 ``LENGTH (xs:'a word list) + LENGTH ys <= LENGTH zs /\ 3627 LENGTH zs < dimword (:'a) DIV 2 /\ 3628 mw_ok xs /\ mw_ok ys /\ ys <> [] /\ 3629 mc_div_max xs ys zs + 2 * LENGTH zs + 2 <= l ==> 3630 ?zs1 l2. 3631 mc_idiv_pre (l,r3,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) /\ 3632 (mc_idiv (l,r3,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) = 3633 (l2,mc_header ((mwi_divmod_alt r3 (s,xs) (t,ys))),xs,ys, 3634 SND ((mwi_divmod_alt r3 (s,xs) (t,ys)))++zs1)) /\ 3635 (LENGTH (SND ((mwi_divmod_alt r3 (s,xs) (t,ys)))++zs1) = LENGTH zs) /\ 3636 l <= l2 + mc_div_max xs ys zs + 2 * LENGTH zs + 2``, 3637 FULL_SIMP_TAC std_ss [mc_idiv_def,mc_idiv_pre_def,LET_DEF] 3638 \\ FULL_SIMP_TAC std_ss [mc_header_EQ,mwi_mul_def,mc_length] 3639 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mc_header_XOR] 3640 \\ `LENGTH xs < dimword (:'a) DIV 2 /\ LENGTH ys < dimword (:'a) DIV 2` by DECIDE_TAC 3641 \\ `LENGTH zs < dimword (:'a)` by (FULL_SIMP_TAC (srw_ss()) [X_LT_DIV] \\ DECIDE_TAC) 3642 \\ IMP_RES_TAC mc_length \\ FULL_SIMP_TAC std_ss [] 3643 \\ `mw2n ys <> 0` by 3644 (SIMP_TAC std_ss [GSYM mw_fix_NIL] 3645 \\ FULL_SIMP_TAC std_ss [mw_ok_mw_fix_ID]) 3646 \\ `?res mod c. (mw_div xs ys = (res,mod,c))` by METIS_TAC [PAIR] 3647 \\ `c /\ (LENGTH mod = LENGTH ys)` by METIS_TAC [mw_div_thm,mw_ok_mw_fix_ID] 3648 \\ FULL_SIMP_TAC std_ss [] 3649 \\ ASSUME_TAC (mc_div_thm |> GEN_ALL) 3650 \\ SEP_I_TAC "mc_div" 3651 \\ POP_ASSUM MP_TAC 3652 \\ `mc_div_max xs ys zs ��� l` by fs [] 3653 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 3654 \\ FULL_SIMP_TAC std_ss [] 3655 \\ NTAC 4 (POP_ASSUM MP_TAC) \\ NTAC 2 (POP_ASSUM (K ALL_TAC)) 3656 \\ REPEAT STRIP_TAC 3657 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 3658 \\ Cases_on `r3 <> 0w` \\ FULL_SIMP_TAC std_ss [mwi_divmod_alt_def] THEN1 3659 (FULL_SIMP_TAC std_ss [mc_div_sub_call_def,mc_div_sub_call_pre_def] 3660 \\ FULL_SIMP_TAC std_ss [TL,mwi_mod_def,mwi_divmod_def,LET_DEF,HD,NOT_CONS_NIL, 3661 mc_header_XOR] 3662 \\ Cases_on `s = t` \\ FULL_SIMP_TAC std_ss [EVAL ``b2w F``] THEN1 3663 (FULL_SIMP_TAC std_ss [mc_idiv_mod_header_thm] 3664 \\ ASSUME_TAC (Q.ISPEC `mod:'a word list` (GSYM mw_fix_thm)) 3665 \\ POP_ASSUM (fn th => SIMP_TAC std_ss [Once th]) 3666 \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11] 3667 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE] 3668 \\ `LENGTH (mw_fix mod) <= LENGTH mod` by METIS_TAC [LENGTH_mw_fix] 3669 \\ DECIDE_TAC) 3670 \\ Cases_on `mw_fix mod = []` 3671 \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND,LENGTH_APPEND] 3672 THEN1 (SIMP_TAC std_ss [mc_idiv_mod_header_def] \\ fs [] \\ EVAL_TAC \\ simp[]) 3673 \\ FULL_SIMP_TAC std_ss [EVAL ``b2w T = 0x0w:'a word``,n2w_11,ZERO_LT_dimword] 3674 \\ FULL_SIMP_TAC std_ss [LENGTH_NIL] 3675 \\ Cases_on`1 MOD dimword(:'a) = 0` \\ fs[] 3676 \\ (mc_div_sub1_thm |> Q.INST [`ys2`|->`[]`] 3677 |> SIMP_RULE std_ss [APPEND_NIL] |> GEN_ALL |> ASSUME_TAC) 3678 \\ SEP_I_TAC "mc_div_sub1" \\ POP_ASSUM MP_TAC 3679 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 3680 THEN1 (FULL_SIMP_TAC std_ss [GSYM LENGTH_NIL,X_LT_DIV] \\ fs []) 3681 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3682 \\ `LENGTH ys = LENGTH (FST (mw_sub ys mod T))` by 3683 (Cases_on `mw_sub ys mod T` \\ IMP_RES_TAC LENGTH_mw_sub 3684 \\ FULL_SIMP_TAC std_ss []) 3685 \\ ASM_SIMP_TAC std_ss [] 3686 \\ ASSUME_TAC mc_fix_thm 3687 \\ SEP_I_TAC "mc_fix" 3688 \\ pop_assum mp_tac 3689 \\ match_mp_tac IMP_IMP \\ strip_tac THEN1 fs [] 3690 \\ strip_tac \\ FULL_SIMP_TAC std_ss [] 3691 \\ FULL_SIMP_TAC std_ss [GSYM mw_subv_def] 3692 \\ `mw_subv ys (mw_fix mod) = mw_subv ys mod` by (SIMP_TAC std_ss [mw_subv_def,mw_sub_mw_fix]) 3693 \\ FULL_SIMP_TAC std_ss [] 3694 \\ `LENGTH (mw_subv ys mod) <= LENGTH ys` by (MATCH_MP_TAC LENGTH_mw_subv \\ FULL_SIMP_TAC std_ss []) 3695 \\ `LENGTH (mw_subv ys mod) < dimword (:'a)` by DECIDE_TAC 3696 \\ ASM_SIMP_TAC std_ss [mc_idiv_mod_header_thm] 3697 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11] 3698 \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE] 3699 \\ SIMP_TAC std_ss [mw_subv_def] 3700 \\ `LENGTH (mw_fix (FST (mw_sub ys mod T))) <= LENGTH (FST (mw_sub ys mod T))` 3701 by FULL_SIMP_TAC std_ss [LENGTH_mw_fix] \\ fs []) 3702 \\ `LENGTH res < dimword (:'a)` by DECIDE_TAC 3703 \\ FULL_SIMP_TAC std_ss [mwi_div_def] 3704 \\ MP_TAC (mc_fix_thm |> Q.SPECL 3705 [`res`,`zs2`,`n2w (LENGTH (res:'a word list))`,`l2-1`]) 3706 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [] 3707 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [HD,TL] 3708 \\ pop_assum mp_tac 3709 \\ NTAC 2 (POP_ASSUM (K ALL_TAC)) \\ strip_tac 3710 \\ FULL_SIMP_TAC std_ss [mc_add1_call_def,mc_add1_call_pre_def, 3711 LET_DEF,mwi_divmod_def,b2w_EQ_0w] 3712 \\ `LENGTH (mw_fix res) <= LENGTH res` by 3713 FULL_SIMP_TAC std_ss [LENGTH_mw_fix] 3714 \\ `LENGTH (mw_fix res) < dimword (:'a)` by DECIDE_TAC 3715 \\ Cases_on `s = t` \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] THEN1 3716 (SIMP_TAC (srw_ss()) [word_lsl_n2w,b2w_def,b2n_def,mc_header_def] 3717 \\ Cases_on`dimindex(:'a) < 2` \\ fs[X_LT_DIV,LEFT_ADD_DISTRIB] 3718 >- ( 3719 `dimindex(:'a) = 1` by fs[DIMINDEX_GT_0] 3720 \\ full_simp_tac (std_ss++ARITH_ss)[dimword_def,GSYM LENGTH_NIL] ) 3721 \\ Cases_on `LENGTH (mw_fix res) = 0` \\ FULL_SIMP_TAC std_ss [] 3722 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11, 3723 LENGTH_APPEND,LENGTH_REPLICATE] \\ fs []) 3724 \\ FULL_SIMP_TAC std_ss [LENGTH_NIL] 3725 \\ Cases_on `mw_fix mod = []` 3726 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL] THEN1 3727 (Cases_on `mw_fix res = []` \\ FULL_SIMP_TAC std_ss [] 3728 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11, 3729 LENGTH_APPEND,LENGTH_REPLICATE] 3730 \\ SIMP_TAC (srw_ss()) [word_lsl_n2w,b2w_def,b2n_def,mc_header_def] 3731 \\ rw[] 3732 \\ `dimindex(:'a) = 1` by fs[DIMINDEX_GT_0] 3733 \\ full_simp_tac (std_ss++ARITH_ss) [dimword_def,GSYM LENGTH_NIL]) 3734 \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC] 3735 \\ Q.ABBREV_TAC `ts1 = REPLICATE (LENGTH res - LENGTH (mw_fix res)) 0x0w ++ zs2` 3736 \\ ASSUME_TAC (mc_add1_thm |> GEN_ALL) 3737 \\ SEP_I_TAC "mc_add1" \\ POP_ASSUM MP_TAC 3738 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 3739 (Q.UNABBREV_TAC `ts1` 3740 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,GSYM LENGTH_NIL, 3741 LENGTH_REPLICATE,mc_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND] 3742 \\ DECIDE_TAC) 3743 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [NOT_CONS_NIL] 3744 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL] 3745 \\ Cases_on `mw_addv (mw_fix res) [] T = []` 3746 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL, 3747 mc_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND] 3748 THEN1 (Q.UNABBREV_TAC `ts1` 3749 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,LENGTH_REPLICATE, 3750 mc_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND] 3751 \\ DECIDE_TAC) 3752 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,LENGTH_REPLICATE, 3753 mc_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND,APPEND_11] 3754 \\ FULL_SIMP_TAC std_ss [b2w_def,b2n_def] 3755 \\ SIMP_TAC (srw_ss()) [word_lsl_n2w,word_add_n2w] 3756 \\ Q.UNABBREV_TAC `ts1` 3757 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,LENGTH_REPLICATE, 3758 mc_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND] 3759 \\ rw[] 3760 >- ( 3761 `dimindex(:'a) = 1` by fs[DIMINDEX_GT_0] 3762 \\ fs[dimword_def] ) 3763 \\ fs[word_add_n2w]); 3764 3765(* 3766 3767(* int to decimal conversion *) 3768 3769val (mc_to_dec_def, _, 3770 mc_to_dec_pre_def, _) = 3771 tailrec_define "mc_to_dec" `` 3772 (\(r9,r10,zs,ss). 3773 (let r2 = 0x0w in 3774 let r11 = r10 in 3775 let cond = mc_simple_div1_pre (r2,r9,r10,zs) in 3776 let (r2,r9,r10,zs) = mc_simple_div1 (r2,r9,r10,zs) in 3777 let r2 = r2 + 0x30w in 3778 let ss = r2::ss in 3779 let r8 = r10 in 3780 let r10 = r11 in 3781 let cond = cond /\ mc_fix_pre (r8,r10,zs) in 3782 let (r8,r10,zs) = mc_fix (r8,r10,zs) 3783 in 3784 if r10 = 0x0w then (INR (zs,ss),cond) 3785 else (INL (r9,r10,zs,ss),cond))) 3786 :'a word # 'a word # 'a word list # 'a word list -> ('a word # 'a 3787 word # 'a word list # 'a word list + 'a word list # 'a word list) 3788 # bool``; 3789 3790val (mc_int_to_dec_def, _, 3791 mc_int_to_dec_pre_def, _) = 3792 tailrec_define "mc_int_to_dec" `` 3793 (\(r10,xs,zs,ss). 3794 (let r1 = r10 in 3795 let r10 = r10 >>> 1 in 3796 let cond = mc_copy_over_pre (r10,xs,zs) in 3797 let (xs,zs) = mc_copy_over (r10,xs,zs) in 3798 let r10 = r1 in 3799 let r10 = r10 >>> 1 in 3800 let r9 = 0xAw in 3801 let cond = cond /\ mc_to_dec_pre (r9,r10,zs,ss) in 3802 let (zs,ss) = mc_to_dec (r9,r10,zs,ss) 3803 in 3804 if r1 && 0x1w = 0x0w then (INR (xs,zs,ss),cond) 3805 else (let r2 = 0x7Ew in let ss = r2::ss in (INR (xs,zs,ss),cond)))) 3806 :'a word # 'a word list # 'a word list # 'a word list -> ('a word 3807 # 'a word list # 'a word list # 'a word list + 'a word list # 'a 3808 word list # 'a word list) # bool``; 3809 3810val mc_to_dec_thm = prove( 3811 ``!(xs:'a word list) ys zs ss. 3812 LENGTH xs < dimword (:'a) /\ (mw_to_dec xs = (ys,T)) ==> 3813 ?zs1. 3814 mc_to_dec_pre (10w,n2w (LENGTH xs),xs++zs,ss) /\ 3815 (mc_to_dec (10w,n2w (LENGTH xs),xs++zs,ss) = (zs1,ys ++ ss)) /\ 3816 (LENGTH zs1 = LENGTH xs + LENGTH zs)``, 3817 HO_MATCH_MP_TAC mw_to_dec_ind \\ REPEAT STRIP_TAC \\ POP_ASSUM MP_TAC 3818 \\ SIMP_TAC std_ss [Once mw_to_dec_def] 3819 \\ IF_CASES_TAC >- fs[] 3820 \\ `?qs r c1. mw_simple_div 0x0w (REVERSE xs) 0xAw = (qs,r,c1)` by METIS_TAC [PAIR] 3821 \\ `?res c2. mw_to_dec (mw_fix (REVERSE qs)) = (res,c2)` by METIS_TAC [PAIR] 3822 \\ FULL_SIMP_TAC std_ss [LET_DEF] 3823 \\ ONCE_REWRITE_TAC [mc_to_dec_def,mc_to_dec_pre_def] 3824 \\ SIMP_TAC std_ss [LET_DEF] 3825 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ STRIP_TAC 3826 \\ sg `c1` \\ FULL_SIMP_TAC std_ss [] 3827 THEN1 (Cases_on `LENGTH (mw_fix (REVERSE qs)) = 0` \\ FULL_SIMP_TAC std_ss []) 3828 \\ SIMP_TAC std_ss [Once EQ_SYM_EQ] 3829 \\ IMP_RES_TAC mc_simple_div1_thm 3830 \\ FULL_SIMP_TAC std_ss [] 3831 \\ IMP_RES_TAC LENGTH_mw_simple_div 3832 \\ MP_TAC (mc_fix_thm |> Q.SPECL [`REVERSE qs`,`zs`,`0w`]) 3833 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ STRIP_TAC 3834 \\ `LENGTH (mw_fix (REVERSE qs)) <= LENGTH (REVERSE qs)` by 3835 METIS_TAC [LENGTH_mw_fix] 3836 \\ `LENGTH (mw_fix (REVERSE qs)) < dimword (:'a)` by (FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC) 3837 \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] 3838 \\ FULL_SIMP_TAC std_ss [LENGTH_NIL] 3839 \\ Cases_on `mw_fix (REVERSE qs) = []` \\ FULL_SIMP_TAC std_ss [LENGTH] 3840 THEN1 (SIMP_TAC std_ss [LENGTH_REPLICATE,LENGTH_APPEND] \\ EVAL_TAC) 3841 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC] 3842 \\ SEP_I_TAC "mc_to_dec" 3843 \\ FULL_SIMP_TAC std_ss [] 3844 \\ SIMP_TAC std_ss [LENGTH_REPLICATE,LENGTH_APPEND,REVERSE_APPEND,REVERSE_DEF] 3845 \\ FULL_SIMP_TAC std_ss [APPEND] 3846 \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC); 3847 3848val mc_int_to_dec_thm = prove( 3849 ``(mwi_to_dec (s,xs) = (res,T)) /\ LENGTH zs < dimword (:'a) DIV 2 /\ 3850 LENGTH (xs:'a word list) <= LENGTH zs ==> 3851 ?zs1. 3852 (mc_int_to_dec_pre (mc_header(s,xs),xs,zs,ss)) /\ 3853 (mc_int_to_dec (mc_header(s,xs),xs,zs,ss) = (xs,zs1,res ++ ss)) /\ 3854 (LENGTH zs1 = LENGTH zs)``, 3855 SIMP_TAC std_ss [Once EQ_SYM_EQ] 3856 \\ SIMP_TAC std_ss [mc_int_to_dec_def,mc_int_to_dec_pre_def,LET_DEF] \\ STRIP_TAC 3857 \\ `LENGTH xs < dimword (:'a) DIV 2` by DECIDE_TAC 3858 \\ ASM_SIMP_TAC std_ss [mc_length] 3859 \\ IMP_RES_TAC LESS_EQ_LENGTH 3860 \\ FULL_SIMP_TAC std_ss [] 3861 \\ ASSUME_TAC (mc_copy_over_thm |> Q.SPECL [`xs0`,`zs0`,`[]`] |> GEN_ALL) 3862 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] 3863 \\ `LENGTH xs + LENGTH xs2 < dimword (:'a)` by 3864 (FULL_SIMP_TAC (srw_ss()) [X_LT_DIV] \\ DECIDE_TAC) 3865 \\ SEP_I_TAC "mc_copy_over" 3866 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] 3867 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3868 \\ FULL_SIMP_TAC std_ss [mwi_to_dec_def,LET_DEF] 3869 \\ Cases_on `mw_to_dec xs` \\ FULL_SIMP_TAC std_ss [] 3870 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 3871 \\ `LENGTH xs < dimword (:'a)` by DECIDE_TAC 3872 \\ IMP_RES_TAC mc_to_dec_thm 3873 \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPECL [`xs2`,`ss`]) 3874 \\ FULL_SIMP_TAC std_ss [mc_header_sign] 3875 \\ Cases_on `s` \\ FULL_SIMP_TAC std_ss [APPEND]); 3876 3877*) 3878 3879(* top-level entry point *) 3880 3881val int_op_rep_def = Define ` 3882 (int_op_rep Add = 0w) /\ 3883 (int_op_rep Sub = 1w) /\ 3884 (int_op_rep Lt = 2w) /\ 3885 (int_op_rep Eq = 3w) /\ 3886 (int_op_rep Mul = 4w) /\ 3887 (int_op_rep Div = 5w) /\ 3888 (int_op_rep Mod = 6w) /\ 3889 (int_op_rep Dec = 7w:'a word)`; 3890 3891val (mc_isub_flip_def, _, 3892 mc_isub_flip_pre_def, _) = 3893 tailrec_define "mc_isub_flip" `` 3894 (\(r1,r3). 3895 if r3 = 0x0w then (INR (r1,r3),T) 3896 else (let r1 = r1 ?? 0x1w in (INR (r1,r3),T))) 3897 :'a word # 'a word -> ('a word # 'a word + 'a word # 'a word) # bool``; 3898 3899val (mc_icmp_res_def, _, 3900 mc_icmp_res_pre_def, _) = 3901 tailrec_define "mc_icmp_res" `` 3902 (\(r10,r3). 3903 if r3 = 0x2w then 3904 if r10 = 0x1w then (let r10 = 0x1w in (INR r10,T)) 3905 else (let r10 = 0x0w in (INR r10,T)) 3906 else if r10 = 0x0w then (let r10 = 0x1w in (INR r10,T)) 3907 else (let r10 = 0x0w in (INR r10,T))) 3908 :'a word # 'a word -> ('a word # 'a word + 'a word) # bool``; 3909 3910val (mc_full_cmp_def, _, 3911 mc_full_cmp_pre_def, _) = 3912 tailrec_define "mc_full_cmp" `` 3913 (\(l,r3,r10,r11,xs,ys,zs). 3914 (let cond = mc_icompare_pre (l,r10,r11,xs,ys) in 3915 let (l,r10,xs,ys) = mc_icompare (l,r10,r11,xs,ys) in 3916 let r10 = mc_icmp_res (r10,r3) 3917 in 3918 if r10 = 0x0w then (INR (l,r10,xs,ys,zs),cond) 3919 else 3920 (let r0 = 0x1w in 3921 let r10 = (0x0w:'a word) in 3922 let cond = cond /\ w2n r10 < LENGTH zs in 3923 let zs = LUPDATE r0 (w2n r10) zs in 3924 let r10 = 0x2w 3925 in 3926 (INR (l,r10,xs,ys,zs),cond)))) 3927 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list # 3928 'a word list -> (num # 'a word # 'a word # 'a word # 'a word list 3929 # 'a word list # 'a word list + num # 'a word # 'a word list # 'a 3930 word list # 'a word list) # bool``; 3931 3932val NumABS_LEMMA = prove( 3933 ``(Num (ABS (0:int)) = 0:num) /\ (Num (ABS (1:int)) = 1:num)``, 3934 intLib.COOPER_TAC); 3935 3936val mc_full_cmp_lt = prove( 3937 ``((mc_header (s,xs) = 0x0w) <=> (xs = [])) /\ mw_ok xs /\ 3938 ((mc_header (t,ys) = 0x0w) <=> (ys = [])) /\ mw_ok ys /\ 3939 LENGTH (xs:'a word list) < dimword (:'a) DIV 2 /\ 3940 LENGTH ys < dimword (:'a) DIV 2 /\ 3941 LENGTH xs + LENGTH ys < LENGTH zs /\ LENGTH zs < dimword (:'a) DIV 2 /\ 3942 LENGTH xs + 1 <= l ==> 3943 ?zs1 l2. 3944 mc_full_cmp_pre (l,2w,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) /\ 3945 (mc_full_cmp (l,2w,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) = 3946 (l2,mc_header (mwi_op Lt (s,xs) (t,ys)),xs,ys, 3947 SND (mwi_op Lt (s,xs) (t,ys)) ++ zs1)) /\ 3948 (LENGTH (SND (mwi_op Lt (s,xs) (t,ys)) ++ zs1) = LENGTH zs) /\ 3949 l <= l2 + LENGTH xs + 1``, 3950 SIMP_TAC std_ss [mc_full_cmp_def,mc_full_cmp_pre_def,LET_DEF] \\ STRIP_TAC 3951 \\ MP_TAC mc_icompare_thm \\ FULL_SIMP_TAC std_ss [] 3952 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] \\ SIMP_TAC std_ss [mwi_lt_def] 3953 \\ Cases_on `mwi_compare (s,xs) (t,ys)` 3954 \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,mc_icmp_res_def,n2w_11,LET_DEF] 3955 THEN1 (Q.EXISTS_TAC `zs` \\ SIMP_TAC std_ss [] 3956 \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] \\ EVAL_TAC 3957 \\ fs[]) 3958 \\ REV (Cases_on `x`) 3959 \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,mc_icmp_res_def,n2w_11,LET_DEF] 3960 THEN1 (Q.EXISTS_TAC `zs` \\ SIMP_TAC std_ss [] 3961 \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] \\ EVAL_TAC 3962 \\ IF_CASES_TAC \\ fs[] 3963 \\ Cases_on`dimword(:'a)` \\ fs[] 3964 \\ Cases_on`n` \\ fs[ADD1] 3965 \\ Cases_on`n'` \\ fs[]) 3966 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH] 3967 \\ Q.EXISTS_TAC `t'` \\ FULL_SIMP_TAC std_ss [LUPDATE_def] 3968 \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``,n2mw_1] 3969 \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss [ADD1] \\ fs[]); 3970 3971val mc_full_cmp_eq = prove( 3972 ``((mc_header (s,xs) = 0x0w) <=> (xs = [])) /\ mw_ok xs /\ 3973 ((mc_header (t,ys) = 0x0w) <=> (ys = [])) /\ mw_ok ys /\ 3974 LENGTH (xs:'a word list) < dimword (:'a) DIV 2 /\ 3975 LENGTH ys < dimword (:'a) DIV 2 /\ 3976 LENGTH xs + LENGTH ys < LENGTH zs /\ LENGTH zs < dimword (:'a) DIV 2 /\ 3977 LENGTH xs + 1 <= l ==> 3978 ?zs1 l2. 3979 mc_full_cmp_pre (l,3w,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) /\ 3980 (mc_full_cmp (l,3w,mc_header (s,xs),mc_header (t,ys),xs,ys,zs) = 3981 (l2,mc_header (mwi_op Eq (s,xs) (t,ys)),xs,ys, 3982 SND (mwi_op Eq (s,xs) (t,ys)) ++ zs1)) /\ 3983 (LENGTH (SND (mwi_op Eq (s,xs) (t,ys)) ++ zs1) = LENGTH zs) /\ 3984 l <= l2 + LENGTH xs + 1``, 3985 SIMP_TAC std_ss [mc_full_cmp_def,mc_full_cmp_pre_def,LET_DEF] \\ STRIP_TAC 3986 \\ MP_TAC mc_icompare_thm \\ FULL_SIMP_TAC std_ss [] 3987 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] \\ SIMP_TAC std_ss [mwi_eq_def] 3988 \\ REV (Cases_on `mwi_compare (s,xs) (t,ys)`) THEN1 3989 (FULL_SIMP_TAC (srw_ss()) [cmp2w_def,mc_icmp_res_def,n2w_11,LET_DEF] 3990 \\ Q.EXISTS_TAC `zs` \\ SIMP_TAC std_ss [] 3991 \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] \\ fs[] 3992 \\ Cases_on`3 < dimword(:'a)` \\ fs[] 3993 >- ( 3994 EVAL_TAC \\ rw[] 3995 \\ pop_assum mp_tac \\ rw[] 3996 \\ Cases_on`x` \\ fs[cmp2w_def] 3997 \\ rfs[] ) 3998 \\ `dimword(:'a) = 2` by ( fs[dimword_def,X_LT_DIV] ) 3999 \\ fs[]) 4000 \\ SIMP_TAC std_ss [cmp2w_def] 4001 \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,mc_icmp_res_def,n2w_11,LET_DEF] 4002 \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH] 4003 \\ Q.EXISTS_TAC `t'` \\ FULL_SIMP_TAC std_ss [LUPDATE_def] 4004 \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] 4005 \\ Cases_on`3 < dimword(:'a)` \\ fs[n2mw_1] 4006 >- ( EVAL_TAC \\ rw[] ) 4007 \\ `dimword(:'a) = 2` by ( fs[dimword_def,X_LT_DIV] ) 4008 \\ fs[]); 4009 4010val (mc_iop_def, _, 4011 mc_iop_pre_def, _) = 4012 tailrec_define "mc_iop" `` 4013 (\(l,r0,r1,r3,xs,ys,zs). 4014 if r3 <+ 0x2w then 4015 (let (r1,r3) = mc_isub_flip (r1,r3) in 4016 let r2 = r1 in 4017 let r1 = r0 in 4018 let cond = mc_iadd_pre (l,r1,r2,xs,ys,zs) in 4019 let (l,r10,xs,ys,zs) = mc_iadd (l,r1,r2,xs,ys,zs) 4020 in 4021 (INR (l,r10,xs,ys,zs),cond)) 4022 (* else if r3 <+ 0x4w then 4023 (let r10 = r0 in 4024 let r11 = r1 in 4025 let cond = mc_full_cmp_pre (r3,r10,r11,xs,ys,zs) in 4026 let (r10,xs,ys,zs) = mc_full_cmp (r3,r10,r11,xs,ys,zs) 4027 in 4028 (INR (r10,xs,ys,zs,ss),cond)) *) 4029 else if r3 = 0x4w then 4030 (let r2 = r1 in 4031 let r1 = r0 in 4032 let cond = mc_imul_pre (l,r1,r2,xs,ys,zs) in 4033 let (l,r10,xs,ys,zs) = mc_imul (l,r1,r2,xs,ys,zs) 4034 in 4035 (INR (l,r10,xs,ys,zs),cond)) 4036 else (* if r3 <+ 0x7w then *) 4037 (let r3 = r3 - 0x5w in 4038 let r10 = r0 in 4039 let r11 = r1 in 4040 let cond = mc_idiv_pre (l,r3,r10,r11,xs,ys,zs) in 4041 let (l,r11,xs,ys,zs) = mc_idiv (l,r3,r10,r11,xs,ys,zs) in 4042 let r10 = r11 4043 in 4044 (INR (l,r10,xs,ys,zs),cond))) 4045 (* else 4046 (let r10 = r0 in 4047 let cond = mc_int_to_dec_pre (r10,xs,zs,ss) in 4048 let (xs,zs,ss) = mc_int_to_dec (r10,xs,zs,ss) in 4049 let r10 = 0x0w 4050 in 4051 (INR (r10,xs,ys,zs,ss),cond)) *) 4052 :num # 'a word # 'a word # 'a word # 'a word list # 'a word list # 4053 'a word list -> (num # 'a word # 'a word # 'a word # 'a word list 4054 # 'a word list # 'a word list + num # 'a word # 'a word list # 'a 4055 word list # 'a word list) # bool``; 4056 4057val mc_header_XOR_1 = prove( 4058 ``mc_header (s,xs) ?? 1w = mc_header (~s,xs)``, 4059 simp[mc_header_def,GSYM word_mul_n2w] 4060 \\ Q.SPEC_TAC(`n2w(LENGTH xs):'a word`,`w`) 4061 \\ gen_tac 4062 \\ qspecl_then[`w`,`1`]mp_tac (GSYM WORD_MUL_LSL) 4063 \\ simp[] \\ disch_then kall_tac 4064 \\ rw[] 4065 \\ FIRST (map match_mp_tac [xor_one_add_one,add_one_xor_one]) 4066 \\ rw[word_lsl_def,fcpTheory.FCP_BETA] ); 4067 4068val mc_iop_thm = store_thm("mc_iop_thm", 4069 ``3 < dimindex(:'a) ==> 4070 ((mc_header (s,xs) = 0x0w) <=> (xs = [])) /\ mw_ok xs /\ 4071 ((mc_header (t,ys) = 0x0w) <=> (ys = [])) /\ mw_ok ys /\ 4072 LENGTH (xs:'a word list) + LENGTH ys < LENGTH zs /\ 4073 LENGTH zs < dimword (:'a) DIV 2 /\ 4074 iop <> Lt /\ iop <> Eq /\ iop <> Dec /\ 4075 (((iop = Div) \/ (iop = Mod)) ==> ys <> []) /\ 4076 mc_div_max xs ys zs + 2 * LENGTH zs + 2 <= l ==> 4077 ?zs1 l2. 4078 mc_iop_pre (l,mc_header (s,xs),mc_header (t,ys),int_op_rep iop, 4079 xs,ys,zs) /\ 4080 (mc_iop (l,mc_header (s,xs),mc_header (t,ys),int_op_rep iop, 4081 xs,ys,zs) = 4082 (l2,mc_header (mwi_op iop (s,xs) (t,ys)),xs,ys, 4083 SND (mwi_op iop (s,xs) (t,ys)) ++ zs1)) /\ 4084 (LENGTH (SND (mwi_op iop (s,xs) (t,ys)) ++ zs1) = LENGTH zs) /\ 4085 l <= l2 + mc_div_max xs ys zs + 2 * LENGTH zs + 2``, 4086 strip_tac \\ 4087 `10 < dimword(:'a)` 4088 by ( 4089 `2 ** 4 <= dimword(:'a)` suffices_by fs[] 4090 \\ rewrite_tac[dimword_def] \\ simp[] ) \\ 4091 Cases_on `iop` \\ SIMP_TAC std_ss [int_op_rep_def] \\ REPEAT STRIP_TAC 4092 \\ `LENGTH xs < dimword (:'a) DIV 2 /\ LENGTH ys < dimword (:'a) DIV 2` by DECIDE_TAC 4093 \\ `LENGTH xs + LENGTH ys <= LENGTH zs` by DECIDE_TAC 4094 \\ SIMP_TAC std_ss [mc_iop_def,mc_iop_pre_def,WORD_LO] 4095 \\ SIMP_TAC (srw_ss()) [w2n_n2w,LET_DEF,mc_isub_flip_def] 4096 THEN1 ( 4097 reverse IF_CASES_TAC \\ rfs[] 4098 \\ MP_TAC mc_iadd_thm \\ fs[] 4099 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [mc_div_max_def] 4100 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] 4101 \\ fs[] \\ fs [mc_div_max_def]) 4102 THEN1 ( 4103 reverse IF_CASES_TAC \\ rfs[] 4104 \\ MP_TAC (mc_iadd_thm |> Q.INST [`t`|->`~t`]) 4105 \\ fs[mc_header_XOR_1] 4106 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [mc_div_max_def] 4107 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def,mwi_sub_def] 4108 \\ fs[] \\ fs [mc_div_max_def]) 4109 THEN1 ( 4110 IF_CASES_TAC \\ rfs[] 4111 \\ MP_TAC mc_imul_thm \\ fs[] 4112 \\ match_mp_tac IMP_IMP \\ conj_tac THEN1 fs [mc_div_max_def] 4113 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] 4114 \\ FULL_SIMP_TAC (srw_ss()) [] 4115 \\ fs[] \\ fs [mc_div_max_def]) 4116 THEN1 ( 4117 IF_CASES_TAC \\ rfs[] 4118 \\ MP_TAC (mc_idiv_thm |> Q.INST [`r3`|->`0w`]) \\ fs[] 4119 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] 4120 \\ FULL_SIMP_TAC (srw_ss()) [mwi_divmod_alt_def]) 4121 THEN1 ( 4122 IF_CASES_TAC \\ rfs[] 4123 \\ MP_TAC (mc_idiv_thm |> Q.INST [`r3`|->`1w`]) \\ fs[] 4124 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] 4125 \\ fs[mwi_divmod_alt_def] )); 4126 4127(* An example which uses recursion that is not tail-recursion: 4128 tail-recursive components are defined as usual; however, 4129 non-tail-recursive functions must be defined using tDefine and the 4130 precondition is to be defined separately but closely following the 4131 structure of the original function *) 4132 4133val (mc_fac_init_def, _, 4134 mc_fac_init_pre_def, _) = 4135 tailrec_define "mc_fac_init" `` 4136 (\(l:num,r1). 4137 if r1 <+ 2w then 4138 (let r0 = 0w:'a word in 4139 let r2 = 0w:'a word in 4140 let r3 = 0w in 4141 let cond = T in 4142 (INR (l,r0,r1,r2,r3),cond)) 4143 else 4144 (let r0 = 1w:'a word in 4145 let r2 = r1 - 1w in 4146 let r3 = r1 - 2w in 4147 let cond = T in 4148 (INR (l,r0,r1,r2,r3),cond))) 4149 :num # �� word -> (num # �� word + num # �� word # �� word # �� word # 4150 �� word) # bool`` 4151 4152val (mc_fac_final_def, _, 4153 mc_fac_final_pre_def, _) = 4154 tailrec_define "mc_fac_final" `` 4155 (\(l:num,r1,r2). 4156 let r1 = r1 + r2 in 4157 let cond = T in 4158 (INR (l,r1),cond)) 4159 :num # �� word # �� word -> (num # �� word # �� word + num # �� word) # bool`` 4160 4161val mc_fac_def = tDefine "mc_fac" ` 4162 mc_fac (l:num,r1:'a word) = 4163 let l0 = l in 4164 let (l,r0,r1,r2,r3) = mc_fac_init (l:num,r1:'a word) in 4165 let l = MIN l l0 in 4166 if r0 = 0w then (l,r1) else 4167 let r1 = r2 in 4168 if l = 0 then (l,r1) else 4169 let ((r2,r3),(l,r1)) = ((r2,r3),mc_fac (l-1,r1)) in 4170 let l = MIN l l0 in 4171 let r2 = r1 in 4172 let r1 = r3 in 4173 if l = 0 then (l,r1) else 4174 let (r2,(l,r1)) = (r2,mc_fac (l-1,r1)) in 4175 let (l,r1) = mc_fac_final (l,r1,r2) in 4176 (l,r1)` 4177 (WF_REL_TAC `measure FST` \\ rw []); 4178 4179val mc_fac_pre_def = tDefine "mc_fac_pre" ` 4180 mc_fac_pre (l:num,r1:'a word) = 4181 let l0 = l in 4182 let cond = mc_fac_init_pre (l:num,r1:'a word) in 4183 let (l,r0,r1,r2,r3) = mc_fac_init (l:num,r1:'a word) in 4184 let l = MIN l l0 in 4185 if r0 = 0w then F else 4186 let r1 = r2 in 4187 if l = 0 then F else 4188 let cond = (mc_fac_pre (l-1,r1) /\ cond) in 4189 let ((r2,r3),(l,r1)) = ((r2,r3),mc_fac (l-1,r1)) in 4190 let l = MIN l l0 in 4191 let r2 = r1 in 4192 let r1 = r3 in 4193 if l = 0 then F else 4194 let cond = (mc_fac_pre (l-1,r1) /\ cond) in 4195 let cond = (mc_fac_final_pre (l,r1,r2) /\ cond) in 4196 let (l,r1) = mc_fac_final (l,r1,r2) in 4197 cond` 4198 (WF_REL_TAC `measure FST` \\ rw []); 4199 4200val (mc_use_fac_def, _, 4201 mc_use_fac_pre_def, _) = 4202 tailrec_define "mc_use_fac" `` 4203 (\(l:num,r1). 4204 let cond = mc_fac_pre (l-1,r1) /\ l <> 0 in 4205 let (l,r1) = mc_fac (l-1,r1) in 4206 let r0 = r1 in 4207 (INR (l,r0),cond)) 4208 :num # �� word -> (num # �� word + num # �� word) # bool`` 4209 4210val _ = export_theory(); 4211