;;; We will now consider what ripple-carry addition means. We first ;;; define several "helper" functions. (defmacro naturalp (x) `(and (integerp ,x) (<= 0 ,x))) (defun div-2 (x) (declare (xargs :guard t)) (if (<= (nfix x) 1) 0 (+ 1 (div-2 (- x 2))))) (defun one-at-a-time (x) (if (zp x) 0 (one-at-a-time (- x 1)))) (defthm div-2-lemma-0 (implies (naturalp x) (equal (div-2 (* 2 x)) x)) :hints (("Goal" :induct (one-at-a-time x)))) (defthm div-2-lemma-1 (implies (naturalp x) (equal (div-2 (+ 1 (* 2 x))) x)) :hints (("Goal" :induct (one-at-a-time x)))) (defun rem-2 (x) (declare (xargs :guard t)) (if (<= (nfix x) 1) (nfix x) (rem-2 (- x 2)))) (defthm rem-2-lemma-0 (implies (naturalp x) (equal (rem-2 (* 2 x)) 0)) :hints (("Goal" :induct (one-at-a-time x)))) (defthm rem-2-lemma-1 (implies (naturalp x) (equal (rem-2 (+ 1 (* 2 x))) 1)) :hints (("Goal" :induct (one-at-a-time x)))) ;;; The function V-TO-NAT converts bit-vector A into a natural number. ;;; This defines the significance of the bits in a bit-vector. (defun v-to-nat (a) (declare (xargs :guard t)) (if (atom a) 0 (+ (if (car a) 1 0) (* 2 (v-to-nat (cdr a)))))) ;;; The function NAT-TO-V converts number X into a bit-vector of L bits. (defun nat-to-v (x l) (declare (xargs :guard (and (naturalp x) (naturalp l)))) (if (zp l) nil (cons (if (= (rem-2 x) 1) t nil) (nat-to-v (div-2 x) (1- l))))) ;;; To make sure that V-TO-NAT and NAT-TO-V are inverses we prove the ;;; following. (defthm nat-to-v-of-v-to-nat (implies (boolean-listp x) (equal (nat-to-v (v-to-nat x) (len x)) x))) ;;; The function XOR has two formal parameters, XOR3 takes three ;;; formal parameters. #| (defun xor (a b) (if a (if b nil t) (if b t nil))) (defun xor3 (a b c) (xor a (xor b c))) |# ;;; Below is the definition of a ripple-carry adder for arbitrary ;;; length vectors. (defun b-carry (a b c) (if a (or b c) (and b c))) (defun v-adder (c a b) (if (atom a) (list c) (cons (xor3 c (car a) (car b)) (v-adder (b-carry c (car a) (car b)) (cdr a) (cdr b))))) ;;; We now prove that our ripple-carry adder V-ADDER really does ;;; addition. (defthm v-adder-really-adds (implies (equal (len a) (len b)) (equal (v-to-nat (v-adder c a b)) (+ (if c 1 0) (v-to-nat a) (v-to-nat b)))))