/Modules/_decimal/libmpdec/literature/umodarith.lisp

https://github.com/albertz/CPython · Lisp · 692 lines · 502 code · 109 blank · 81 comment · 0 complexity · b5884b990c57a48efc9a9dda3aa82221 MD5 · raw file

  1. ;
  2. ; Copyright (c) 2008-2016 Stefan Krah. All rights reserved.
  3. ;
  4. ; Redistribution and use in source and binary forms, with or without
  5. ; modification, are permitted provided that the following conditions
  6. ; are met:
  7. ;
  8. ; 1. Redistributions of source code must retain the above copyright
  9. ; notice, this list of conditions and the following disclaimer.
  10. ;
  11. ; 2. Redistributions in binary form must reproduce the above copyright
  12. ; notice, this list of conditions and the following disclaimer in the
  13. ; documentation and/or other materials provided with the distribution.
  14. ;
  15. ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND
  16. ; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17. ; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18. ; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  19. ; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20. ; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  21. ; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  22. ; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  23. ; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  24. ; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  25. ; SUCH DAMAGE.
  26. ;
  27. (in-package "ACL2")
  28. (include-book "arithmetic/top-with-meta" :dir :system)
  29. (include-book "arithmetic-2/floor-mod/floor-mod" :dir :system)
  30. ;; =====================================================================
  31. ;; Proofs for several functions in umodarith.h
  32. ;; =====================================================================
  33. ;; =====================================================================
  34. ;; Helper theorems
  35. ;; =====================================================================
  36. (defthm elim-mod-m<x<2*m
  37. (implies (and (<= m x)
  38. (< x (* 2 m))
  39. (rationalp x) (rationalp m))
  40. (equal (mod x m)
  41. (+ x (- m)))))
  42. (defthm modaux-1a
  43. (implies (and (< x m) (< 0 x) (< 0 m)
  44. (rationalp x) (rationalp m))
  45. (equal (mod (- x) m)
  46. (+ (- x) m))))
  47. (defthm modaux-1b
  48. (implies (and (< (- x) m) (< x 0) (< 0 m)
  49. (rationalp x) (rationalp m))
  50. (equal (mod x m)
  51. (+ x m)))
  52. :hints (("Goal" :use ((:instance modaux-1a
  53. (x (- x)))))))
  54. (defthm modaux-1c
  55. (implies (and (< x m) (< 0 x) (< 0 m)
  56. (rationalp x) (rationalp m))
  57. (equal (mod x m)
  58. x)))
  59. (defthm modaux-2a
  60. (implies (and (< 0 b) (< b m)
  61. (natp x) (natp b) (natp m)
  62. (< (mod (+ b x) m) b))
  63. (equal (mod (+ (- m) b x) m)
  64. (+ (- m) b (mod x m)))))
  65. (defthm modaux-2b
  66. (implies (and (< 0 b) (< b m)
  67. (natp x) (natp b) (natp m)
  68. (< (mod (+ b x) m) b))
  69. (equal (mod (+ b x) m)
  70. (+ (- m) b (mod x m))))
  71. :hints (("Goal" :use (modaux-2a))))
  72. (defthm linear-mod-1
  73. (implies (and (< x m) (< b m)
  74. (natp x) (natp b)
  75. (rationalp m))
  76. (equal (< x (mod (+ (- b) x) m))
  77. (< x b)))
  78. :hints (("Goal" :use ((:instance modaux-1a
  79. (x (+ b (- x))))))))
  80. (defthm linear-mod-2
  81. (implies (and (< 0 b) (< b m)
  82. (natp x) (natp b)
  83. (natp m))
  84. (equal (< (mod x m)
  85. (mod (+ (- b) x) m))
  86. (< (mod x m) b))))
  87. (defthm linear-mod-3
  88. (implies (and (< x m) (< b m)
  89. (natp x) (natp b)
  90. (rationalp m))
  91. (equal (<= b (mod (+ b x) m))
  92. (< (+ b x) m)))
  93. :hints (("Goal" :use ((:instance elim-mod-m<x<2*m
  94. (x (+ b x)))))))
  95. (defthm modaux-2c
  96. (implies (and (< 0 b) (< b m)
  97. (natp x) (natp b) (natp m)
  98. (<= b (mod (+ b x) m)))
  99. (equal (mod (+ b x) m)
  100. (+ b (mod x m))))
  101. :hints (("Subgoal *1/8''" :use (linear-mod-3))))
  102. (defthmd modaux-2d
  103. (implies (and (< x m) (< 0 x) (< 0 m)
  104. (< (- m) b) (< b 0) (rationalp m)
  105. (<= x (mod (+ b x) m))
  106. (rationalp x) (rationalp b))
  107. (equal (+ (- m) (mod (+ b x) m))
  108. (+ b x)))
  109. :hints (("Goal" :cases ((<= 0 (+ b x))))
  110. ("Subgoal 2'" :use ((:instance modaux-1b
  111. (x (+ b x)))))))
  112. (defthm mod-m-b
  113. (implies (and (< 0 x) (< 0 b) (< 0 m)
  114. (< x b) (< b m)
  115. (natp x) (natp b) (natp m))
  116. (equal (mod (+ (mod (- x) m) b) m)
  117. (mod (- x) b))))
  118. ;; =====================================================================
  119. ;; addmod, submod
  120. ;; =====================================================================
  121. (defun addmod (a b m base)
  122. (let* ((s (mod (+ a b) base))
  123. (s (if (< s a) (mod (- s m) base) s))
  124. (s (if (>= s m) (mod (- s m) base) s)))
  125. s))
  126. (defthmd addmod-correct
  127. (implies (and (< 0 m) (< m base)
  128. (< a m) (<= b m)
  129. (natp m) (natp base)
  130. (natp a) (natp b))
  131. (equal (addmod a b m base)
  132. (mod (+ a b) m)))
  133. :hints (("Goal" :cases ((<= base (+ a b))))
  134. ("Subgoal 2.1'" :use ((:instance elim-mod-m<x<2*m
  135. (x (+ a b)))))))
  136. (defun submod (a b m base)
  137. (let* ((d (mod (- a b) base))
  138. (d (if (< a d) (mod (+ d m) base) d)))
  139. d))
  140. (defthmd submod-aux1
  141. (implies (and (< a (mod (+ a (- b)) base))
  142. (< 0 base) (< a base) (<= b base)
  143. (natp base) (natp a) (natp b))
  144. (< a b))
  145. :rule-classes :forward-chaining)
  146. (defthmd submod-aux2
  147. (implies (and (<= (mod (+ a (- b)) base) a)
  148. (< 0 base) (< a base) (< b base)
  149. (natp base) (natp a) (natp b))
  150. (<= b a))
  151. :rule-classes :forward-chaining)
  152. (defthmd submod-correct
  153. (implies (and (< 0 m) (< m base)
  154. (< a m) (<= b m)
  155. (natp m) (natp base)
  156. (natp a) (natp b))
  157. (equal (submod a b m base)
  158. (mod (- a b) m)))
  159. :hints (("Goal" :cases ((<= base (+ a b))))
  160. ("Subgoal 2.2" :use ((:instance submod-aux1)))
  161. ("Subgoal 2.2'''" :cases ((and (< 0 (+ a (- b) m))
  162. (< (+ a (- b) m) m))))
  163. ("Subgoal 2.1" :use ((:instance submod-aux2)))
  164. ("Subgoal 1.2" :use ((:instance submod-aux1)))
  165. ("Subgoal 1.1" :use ((:instance submod-aux2)))))
  166. (defun submod-2 (a b m base)
  167. (let* ((d (mod (- a b) base))
  168. (d (if (< a b) (mod (+ d m) base) d)))
  169. d))
  170. (defthm submod-2-correct
  171. (implies (and (< 0 m) (< m base)
  172. (< a m) (<= b m)
  173. (natp m) (natp base)
  174. (natp a) (natp b))
  175. (equal (submod-2 a b m base)
  176. (mod (- a b) m)))
  177. :hints (("Subgoal 2'" :cases ((and (< 0 (+ a (- b) m))
  178. (< (+ a (- b) m) m))))))
  179. ;; =========================================================================
  180. ;; ext-submod is correct
  181. ;; =========================================================================
  182. ; a < 2*m, b < 2*m
  183. (defun ext-submod (a b m base)
  184. (let* ((a (if (>= a m) (- a m) a))
  185. (b (if (>= b m) (- b m) b))
  186. (d (mod (- a b) base))
  187. (d (if (< a b) (mod (+ d m) base) d)))
  188. d))
  189. ; a < 2*m, b < 2*m
  190. (defun ext-submod-2 (a b m base)
  191. (let* ((a (mod a m))
  192. (b (mod b m))
  193. (d (mod (- a b) base))
  194. (d (if (< a b) (mod (+ d m) base) d)))
  195. d))
  196. (defthmd ext-submod-ext-submod-2-equal
  197. (implies (and (< 0 m) (< m base)
  198. (< a (* 2 m)) (< b (* 2 m))
  199. (natp m) (natp base)
  200. (natp a) (natp b))
  201. (equal (ext-submod a b m base)
  202. (ext-submod-2 a b m base))))
  203. (defthmd ext-submod-2-correct
  204. (implies (and (< 0 m) (< m base)
  205. (< a (* 2 m)) (< b (* 2 m))
  206. (natp m) (natp base)
  207. (natp a) (natp b))
  208. (equal (ext-submod-2 a b m base)
  209. (mod (- a b) m))))
  210. ;; =========================================================================
  211. ;; dw-reduce is correct
  212. ;; =========================================================================
  213. (defun dw-reduce (hi lo m base)
  214. (let* ((r1 (mod hi m))
  215. (r2 (mod (+ (* r1 base) lo) m)))
  216. r2))
  217. (defthmd dw-reduce-correct
  218. (implies (and (< 0 m) (< m base)
  219. (< hi base) (< lo base)
  220. (natp m) (natp base)
  221. (natp hi) (natp lo))
  222. (equal (dw-reduce hi lo m base)
  223. (mod (+ (* hi base) lo) m))))
  224. (defthmd <=-multiply-both-sides-by-z
  225. (implies (and (rationalp x) (rationalp y)
  226. (< 0 z) (rationalp z))
  227. (equal (<= x y)
  228. (<= (* z x) (* z y)))))
  229. (defthmd dw-reduce-aux1
  230. (implies (and (< 0 m) (< m base)
  231. (natp m) (natp base)
  232. (< lo base) (natp lo)
  233. (< x m) (natp x))
  234. (< (+ lo (* base x)) (* base m)))
  235. :hints (("Goal" :cases ((<= (+ x 1) m)))
  236. ("Subgoal 1''" :cases ((<= (* base (+ x 1)) (* base m))))
  237. ("subgoal 1.2" :use ((:instance <=-multiply-both-sides-by-z
  238. (x (+ 1 x))
  239. (y m)
  240. (z base))))))
  241. (defthm dw-reduce-aux2
  242. (implies (and (< x (* base m))
  243. (< 0 m) (< m base)
  244. (natp m) (natp base) (natp x))
  245. (< (floor x m) base)))
  246. ;; This is the necessary condition for using _mpd_div_words().
  247. (defthmd dw-reduce-second-quotient-fits-in-single-word
  248. (implies (and (< 0 m) (< m base)
  249. (< hi base) (< lo base)
  250. (natp m) (natp base)
  251. (natp hi) (natp lo)
  252. (equal r1 (mod hi m)))
  253. (< (floor (+ (* r1 base) lo) m)
  254. base))
  255. :hints (("Goal" :cases ((< r1 m)))
  256. ("Subgoal 1''" :cases ((< (+ lo (* base (mod hi m))) (* base m))))
  257. ("Subgoal 1.2" :use ((:instance dw-reduce-aux1
  258. (x (mod hi m)))))))
  259. ;; =========================================================================
  260. ;; dw-submod is correct
  261. ;; =========================================================================
  262. (defun dw-submod (a hi lo m base)
  263. (let* ((r (dw-reduce hi lo m base))
  264. (d (mod (- a r) base))
  265. (d (if (< a r) (mod (+ d m) base) d)))
  266. d))
  267. (defthmd dw-submod-aux1
  268. (implies (and (natp a) (< 0 m) (natp m)
  269. (natp x) (equal r (mod x m)))
  270. (equal (mod (- a x) m)
  271. (mod (- a r) m))))
  272. (defthmd dw-submod-correct
  273. (implies (and (< 0 m) (< m base)
  274. (natp a) (< a m)
  275. (< hi base) (< lo base)
  276. (natp m) (natp base)
  277. (natp hi) (natp lo))
  278. (equal (dw-submod a hi lo m base)
  279. (mod (- a (+ (* base hi) lo)) m)))
  280. :hints (("Goal" :in-theory (disable dw-reduce)
  281. :use ((:instance dw-submod-aux1
  282. (x (+ lo (* base hi)))
  283. (r (dw-reduce hi lo m base)))
  284. (:instance dw-reduce-correct)))))
  285. ;; =========================================================================
  286. ;; ANSI C arithmetic for uint64_t
  287. ;; =========================================================================
  288. (defun add (a b)
  289. (mod (+ a b)
  290. (expt 2 64)))
  291. (defun sub (a b)
  292. (mod (- a b)
  293. (expt 2 64)))
  294. (defun << (w n)
  295. (mod (* w (expt 2 n))
  296. (expt 2 64)))
  297. (defun >> (w n)
  298. (floor w (expt 2 n)))
  299. ;; join upper and lower half of a double word, yielding a 128 bit number
  300. (defun join (hi lo)
  301. (+ (* (expt 2 64) hi) lo))
  302. ;; =============================================================================
  303. ;; Fast modular reduction
  304. ;; =============================================================================
  305. ;; These are the three primes used in the Number Theoretic Transform.
  306. ;; A fast modular reduction scheme exists for all of them.
  307. (defmacro p1 ()
  308. (+ (expt 2 64) (- (expt 2 32)) 1))
  309. (defmacro p2 ()
  310. (+ (expt 2 64) (- (expt 2 34)) 1))
  311. (defmacro p3 ()
  312. (+ (expt 2 64) (- (expt 2 40)) 1))
  313. ;; reduce the double word number hi*2**64 + lo (mod p1)
  314. (defun simple-mod-reduce-p1 (hi lo)
  315. (+ (* (expt 2 32) hi) (- hi) lo))
  316. ;; reduce the double word number hi*2**64 + lo (mod p2)
  317. (defun simple-mod-reduce-p2 (hi lo)
  318. (+ (* (expt 2 34) hi) (- hi) lo))
  319. ;; reduce the double word number hi*2**64 + lo (mod p3)
  320. (defun simple-mod-reduce-p3 (hi lo)
  321. (+ (* (expt 2 40) hi) (- hi) lo))
  322. ; ----------------------------------------------------------
  323. ; The modular reductions given above are correct
  324. ; ----------------------------------------------------------
  325. (defthmd congruence-p1-aux
  326. (equal (* (expt 2 64) hi)
  327. (+ (* (p1) hi)
  328. (* (expt 2 32) hi)
  329. (- hi))))
  330. (defthmd congruence-p2-aux
  331. (equal (* (expt 2 64) hi)
  332. (+ (* (p2) hi)
  333. (* (expt 2 34) hi)
  334. (- hi))))
  335. (defthmd congruence-p3-aux
  336. (equal (* (expt 2 64) hi)
  337. (+ (* (p3) hi)
  338. (* (expt 2 40) hi)
  339. (- hi))))
  340. (defthmd mod-augment
  341. (implies (and (rationalp x)
  342. (rationalp y)
  343. (rationalp m))
  344. (equal (mod (+ x y) m)
  345. (mod (+ x (mod y m)) m))))
  346. (defthmd simple-mod-reduce-p1-congruent
  347. (implies (and (integerp hi)
  348. (integerp lo))
  349. (equal (mod (simple-mod-reduce-p1 hi lo) (p1))
  350. (mod (join hi lo) (p1))))
  351. :hints (("Goal''" :use ((:instance congruence-p1-aux)
  352. (:instance mod-augment
  353. (m (p1))
  354. (x (+ (- hi) lo (* (expt 2 32) hi)))
  355. (y (* (p1) hi)))))))
  356. (defthmd simple-mod-reduce-p2-congruent
  357. (implies (and (integerp hi)
  358. (integerp lo))
  359. (equal (mod (simple-mod-reduce-p2 hi lo) (p2))
  360. (mod (join hi lo) (p2))))
  361. :hints (("Goal''" :use ((:instance congruence-p2-aux)
  362. (:instance mod-augment
  363. (m (p2))
  364. (x (+ (- hi) lo (* (expt 2 34) hi)))
  365. (y (* (p2) hi)))))))
  366. (defthmd simple-mod-reduce-p3-congruent
  367. (implies (and (integerp hi)
  368. (integerp lo))
  369. (equal (mod (simple-mod-reduce-p3 hi lo) (p3))
  370. (mod (join hi lo) (p3))))
  371. :hints (("Goal''" :use ((:instance congruence-p3-aux)
  372. (:instance mod-augment
  373. (m (p3))
  374. (x (+ (- hi) lo (* (expt 2 40) hi)))
  375. (y (* (p3) hi)))))))
  376. ; ---------------------------------------------------------------------
  377. ; We need a number less than 2*p, so that we can use the trick from
  378. ; elim-mod-m<x<2*m for the final reduction.
  379. ; For p1, two modular reductions are sufficient, for p2 and p3 three.
  380. ; ---------------------------------------------------------------------
  381. ;; p1: the first reduction is less than 2**96
  382. (defthmd simple-mod-reduce-p1-<-2**96
  383. (implies (and (< hi (expt 2 64))
  384. (< lo (expt 2 64))
  385. (natp hi) (natp lo))
  386. (< (simple-mod-reduce-p1 hi lo)
  387. (expt 2 96))))
  388. ;; p1: the second reduction is less than 2*p1
  389. (defthmd simple-mod-reduce-p1-<-2*p1
  390. (implies (and (< hi (expt 2 64))
  391. (< lo (expt 2 64))
  392. (< (join hi lo) (expt 2 96))
  393. (natp hi) (natp lo))
  394. (< (simple-mod-reduce-p1 hi lo)
  395. (* 2 (p1)))))
  396. ;; p2: the first reduction is less than 2**98
  397. (defthmd simple-mod-reduce-p2-<-2**98
  398. (implies (and (< hi (expt 2 64))
  399. (< lo (expt 2 64))
  400. (natp hi) (natp lo))
  401. (< (simple-mod-reduce-p2 hi lo)
  402. (expt 2 98))))
  403. ;; p2: the second reduction is less than 2**69
  404. (defthmd simple-mod-reduce-p2-<-2*69
  405. (implies (and (< hi (expt 2 64))
  406. (< lo (expt 2 64))
  407. (< (join hi lo) (expt 2 98))
  408. (natp hi) (natp lo))
  409. (< (simple-mod-reduce-p2 hi lo)
  410. (expt 2 69))))
  411. ;; p3: the third reduction is less than 2*p2
  412. (defthmd simple-mod-reduce-p2-<-2*p2
  413. (implies (and (< hi (expt 2 64))
  414. (< lo (expt 2 64))
  415. (< (join hi lo) (expt 2 69))
  416. (natp hi) (natp lo))
  417. (< (simple-mod-reduce-p2 hi lo)
  418. (* 2 (p2)))))
  419. ;; p3: the first reduction is less than 2**104
  420. (defthmd simple-mod-reduce-p3-<-2**104
  421. (implies (and (< hi (expt 2 64))
  422. (< lo (expt 2 64))
  423. (natp hi) (natp lo))
  424. (< (simple-mod-reduce-p3 hi lo)
  425. (expt 2 104))))
  426. ;; p3: the second reduction is less than 2**81
  427. (defthmd simple-mod-reduce-p3-<-2**81
  428. (implies (and (< hi (expt 2 64))
  429. (< lo (expt 2 64))
  430. (< (join hi lo) (expt 2 104))
  431. (natp hi) (natp lo))
  432. (< (simple-mod-reduce-p3 hi lo)
  433. (expt 2 81))))
  434. ;; p3: the third reduction is less than 2*p3
  435. (defthmd simple-mod-reduce-p3-<-2*p3
  436. (implies (and (< hi (expt 2 64))
  437. (< lo (expt 2 64))
  438. (< (join hi lo) (expt 2 81))
  439. (natp hi) (natp lo))
  440. (< (simple-mod-reduce-p3 hi lo)
  441. (* 2 (p3)))))
  442. ; -------------------------------------------------------------------------
  443. ; The simple modular reductions, adapted for compiler friendly C
  444. ; -------------------------------------------------------------------------
  445. (defun mod-reduce-p1 (hi lo)
  446. (let* ((y hi)
  447. (x y)
  448. (hi (>> hi 32))
  449. (x (sub lo x))
  450. (hi (if (> x lo) (+ hi -1) hi))
  451. (y (<< y 32))
  452. (lo (add y x))
  453. (hi (if (< lo y) (+ hi 1) hi)))
  454. (+ (* hi (expt 2 64)) lo)))
  455. (defun mod-reduce-p2 (hi lo)
  456. (let* ((y hi)
  457. (x y)
  458. (hi (>> hi 30))
  459. (x (sub lo x))
  460. (hi (if (> x lo) (+ hi -1) hi))
  461. (y (<< y 34))
  462. (lo (add y x))
  463. (hi (if (< lo y) (+ hi 1) hi)))
  464. (+ (* hi (expt 2 64)) lo)))
  465. (defun mod-reduce-p3 (hi lo)
  466. (let* ((y hi)
  467. (x y)
  468. (hi (>> hi 24))
  469. (x (sub lo x))
  470. (hi (if (> x lo) (+ hi -1) hi))
  471. (y (<< y 40))
  472. (lo (add y x))
  473. (hi (if (< lo y) (+ hi 1) hi)))
  474. (+ (* hi (expt 2 64)) lo)))
  475. ; -------------------------------------------------------------------------
  476. ; The compiler friendly versions are equal to the simple versions
  477. ; -------------------------------------------------------------------------
  478. (defthm mod-reduce-aux1
  479. (implies (and (<= 0 a) (natp a) (natp m)
  480. (< (- m) b) (<= b 0)
  481. (integerp b)
  482. (< (mod (+ b a) m)
  483. (mod a m)))
  484. (equal (mod (+ b a) m)
  485. (+ b (mod a m))))
  486. :hints (("Subgoal 2" :use ((:instance modaux-1b
  487. (x (+ a b)))))))
  488. (defthm mod-reduce-aux2
  489. (implies (and (<= 0 a) (natp a) (natp m)
  490. (< b m) (natp b)
  491. (< (mod (+ b a) m)
  492. (mod a m)))
  493. (equal (+ m (mod (+ b a) m))
  494. (+ b (mod a m)))))
  495. (defthm mod-reduce-aux3
  496. (implies (and (< 0 a) (natp a) (natp m)
  497. (< (- m) b) (< b 0)
  498. (integerp b)
  499. (<= (mod a m)
  500. (mod (+ b a) m)))
  501. (equal (+ (- m) (mod (+ b a) m))
  502. (+ b (mod a m))))
  503. :hints (("Subgoal 1.2'" :use ((:instance modaux-1b
  504. (x b))))
  505. ("Subgoal 1''" :use ((:instance modaux-2d
  506. (x I))))))
  507. (defthm mod-reduce-aux4
  508. (implies (and (< 0 a) (natp a) (natp m)
  509. (< b m) (natp b)
  510. (<= (mod a m)
  511. (mod (+ b a) m)))
  512. (equal (mod (+ b a) m)
  513. (+ b (mod a m)))))
  514. (defthm mod-reduce-p1==simple-mod-reduce-p1
  515. (implies (and (< hi (expt 2 64))
  516. (< lo (expt 2 64))
  517. (natp hi) (natp lo))
  518. (equal (mod-reduce-p1 hi lo)
  519. (simple-mod-reduce-p1 hi lo)))
  520. :hints (("Goal" :in-theory (disable expt)
  521. :cases ((< 0 hi)))
  522. ("Subgoal 1.2.2'" :use ((:instance mod-reduce-aux1
  523. (m (expt 2 64))
  524. (b (+ (- HI) LO))
  525. (a (* (expt 2 32) hi)))))
  526. ("Subgoal 1.2.1'" :use ((:instance mod-reduce-aux3
  527. (m (expt 2 64))
  528. (b (+ (- HI) LO))
  529. (a (* (expt 2 32) hi)))))
  530. ("Subgoal 1.1.2'" :use ((:instance mod-reduce-aux2
  531. (m (expt 2 64))
  532. (b (+ (- HI) LO))
  533. (a (* (expt 2 32) hi)))))
  534. ("Subgoal 1.1.1'" :use ((:instance mod-reduce-aux4
  535. (m (expt 2 64))
  536. (b (+ (- HI) LO))
  537. (a (* (expt 2 32) hi)))))))
  538. (defthm mod-reduce-p2==simple-mod-reduce-p2
  539. (implies (and (< hi (expt 2 64))
  540. (< lo (expt 2 64))
  541. (natp hi) (natp lo))
  542. (equal (mod-reduce-p2 hi lo)
  543. (simple-mod-reduce-p2 hi lo)))
  544. :hints (("Goal" :cases ((< 0 hi)))
  545. ("Subgoal 1.2.2'" :use ((:instance mod-reduce-aux1
  546. (m (expt 2 64))
  547. (b (+ (- HI) LO))
  548. (a (* (expt 2 34) hi)))))
  549. ("Subgoal 1.2.1'" :use ((:instance mod-reduce-aux3
  550. (m (expt 2 64))
  551. (b (+ (- HI) LO))
  552. (a (* (expt 2 34) hi)))))
  553. ("Subgoal 1.1.2'" :use ((:instance mod-reduce-aux2
  554. (m (expt 2 64))
  555. (b (+ (- HI) LO))
  556. (a (* (expt 2 34) hi)))))
  557. ("Subgoal 1.1.1'" :use ((:instance mod-reduce-aux4
  558. (m (expt 2 64))
  559. (b (+ (- HI) LO))
  560. (a (* (expt 2 34) hi)))))))
  561. (defthm mod-reduce-p3==simple-mod-reduce-p3
  562. (implies (and (< hi (expt 2 64))
  563. (< lo (expt 2 64))
  564. (natp hi) (natp lo))
  565. (equal (mod-reduce-p3 hi lo)
  566. (simple-mod-reduce-p3 hi lo)))
  567. :hints (("Goal" :cases ((< 0 hi)))
  568. ("Subgoal 1.2.2'" :use ((:instance mod-reduce-aux1
  569. (m (expt 2 64))
  570. (b (+ (- HI) LO))
  571. (a (* (expt 2 40) hi)))))
  572. ("Subgoal 1.2.1'" :use ((:instance mod-reduce-aux3
  573. (m (expt 2 64))
  574. (b (+ (- HI) LO))
  575. (a (* (expt 2 40) hi)))))
  576. ("Subgoal 1.1.2'" :use ((:instance mod-reduce-aux2
  577. (m (expt 2 64))
  578. (b (+ (- HI) LO))
  579. (a (* (expt 2 40) hi)))))
  580. ("Subgoal 1.1.1'" :use ((:instance mod-reduce-aux4
  581. (m (expt 2 64))
  582. (b (+ (- HI) LO))
  583. (a (* (expt 2 40) hi)))))))