See whether two four-valued alists agree on particular keys.
Function:
(defun 4v-alists-agree (keys al1 al2) (declare (xargs :guard t)) (or (atom keys) (and (equal (4v-lookup (car keys) al1) (4v-lookup (car keys) al2)) (4v-alists-agree (cdr keys) al1 al2))))
Theorem:
(defthm 4v-alists-agree-equiv (implies (and (4v-alists-agree keys al1 al2) (member-equal key keys)) (equal (equal (4v-lookup key al1) (4v-lookup key al2)) t)))
Theorem:
(defthm 4v-alists-agree-self (4v-alists-agree k x x))
Theorem:
(defthm 4v-alists-agree-commutes (implies (4v-alists-agree vars al2 al1) (4v-alists-agree vars al1 al2)))
Theorem:
(defthm 4v-alists-agree-transitive1 (implies (and (4v-alists-agree vars al1 al2) (4v-alists-agree vars al2 al3)) (4v-alists-agree vars al1 al3)))
Theorem:
(defthm 4v-alists-agree-transitive2 (implies (and (4v-alists-agree vars al1 al2) (4v-alists-agree vars al2 al3)) (4v-alists-agree vars al1 al3)))
Theorem:
(defthm 4v-alists-agree-append (equal (4v-alists-agree (append k1 k2) a b) (and (4v-alists-agree k1 a b) (4v-alists-agree k2 a b))))
Theorem:
(defthm 4v-alists-agree-witnessing-witness-rule-correct (implies ((lambda (witness al2 al1 keys) (if (not (member-equal witness keys)) (not (member-equal witness keys)) (equal (4v-lookup witness al1) (4v-lookup witness al2)))) (4v-alists-disagree-witness keys al1 al2) al2 al1 keys) (4v-alists-agree keys al1 al2)) :rule-classes nil)
Theorem:
(defthm 4v-alists-agree-instancing-instance-rule-correct (implies (not (if (not (member-equal key keys)) (not (member-equal key keys)) (equal (4v-lookup key al1) (4v-lookup key al2)))) (not (4v-alists-agree keys al1 al2))) :rule-classes nil)
Theorem:
(defthm 4v-alists-agree-to-4v-env-equiv (iff (4v-alists-agree keys al1 al2) (4v-env-equiv (4v-alist-extract keys al1) (4v-alist-extract keys al2))))
Theorem:
(defthm set-equiv-implies-equal-4v-alists-agree-1 (implies (set-equiv keys keys-equiv) (equal (4v-alists-agree keys a b) (4v-alists-agree keys-equiv a b))) :rule-classes (:congruence))
Theorem:
(defthm 4v-env-equiv-implies-equal-4v-alists-agree-2 (implies (4v-env-equiv al al-equiv) (equal (4v-alists-agree keys al al2) (4v-alists-agree keys al-equiv al2))) :rule-classes (:congruence))