Function:
(defun index-permute-shrink (n count mask x numvars) (declare (xargs :guard (and (natp n) (natp mask) (natp x) (natp numvars)))) (declare (xargs :guard (and (<= n numvars) (eql count (logcount (loghead n mask)))))) (let ((__function__ 'index-permute-shrink)) (declare (ignorable __function__)) (b* (((when (mbe :logic (zp (- (nfix numvars) (nfix n))) :exec (eql n numvars))) (lnfix x)) (n (lnfix n)) (count (mbe :logic (logcount (loghead n (lnfix mask))) :exec count)) (bit (logbit n (lnfix mask))) (x (if (eql bit 1) (index-move-down count n x) x))) (index-permute-shrink (1+ n) (+ bit count) mask x numvars))))
Theorem:
(defthm natp-of-index-permute-shrink (b* ((perm-index (index-permute-shrink n count mask x numvars))) (natp perm-index)) :rule-classes :type-prescription)
Theorem:
(defthm index-permute-shrink-bound (b* ((?perm-index (index-permute-shrink n count mask x numvars))) (implies (< (nfix x) (nfix numvars)) (< perm-index (nfix numvars)))) :rule-classes :linear)
Theorem:
(defthm index-permute-shrink-normalize-count (implies (syntaxp (not (equal count ''nil))) (equal (index-permute-shrink n count mask x numvars) (index-permute-shrink n nil mask x numvars))))
Theorem:
(defthm index-permute-shrink-of-index-permute-stretch (equal (index-permute-shrink n count mask (index-permute-stretch n count2 mask x numvars) numvars) (nfix x)))
Theorem:
(defthm index-permute-stretch-of-index-permute-shrink (equal (index-permute-stretch n count mask (index-permute-shrink n count2 mask x numvars) numvars) (nfix x)))
Theorem:
(defthm index-permute-stretch-one-to-one (implies (not (equal (nfix x) (nfix y))) (not (equal (index-permute-stretch n count mask x numvars) (index-permute-stretch n count2 mask y numvars)))))
Theorem:
(defthm index-permute-shrink-one-to-one (implies (not (equal (nfix x) (nfix y))) (not (equal (index-permute-shrink n count mask x numvars) (index-permute-shrink n count2 mask y numvars)))))
Theorem:
(defthm index-permute-shrink-redef (b* ((?perm-index (index-permute-shrink n count mask x numvars))) (implies (<= (nfix n) (nfix numvars)) (equal perm-index (cond ((< (nfix x) (logcount (loghead n (nfix mask)))) (nfix x)) ((< (nfix x) (nfix n)) (+ (nfix x) (- (logcount (loghead numvars (nfix mask))) (logcount (loghead n (nfix mask)))))) ((and (< (nfix x) (nfix numvars)) (logbitp x (nfix mask))) (logcount (loghead x (nfix mask)))) (t (+ (nfix x) (- (logcount (loghead x (loghead numvars (nfix mask))))) (logcount (loghead numvars (nfix mask))))))))))
Theorem:
(defthm index-permute-shrink-redef-base (equal (index-permute-shrink 0 count mask x numvars) (b* ((x (nfix x)) (numvars (nfix numvars)) (mask (nfix mask))) (cond ((and (< x numvars) (logbitp x mask)) (logcount (loghead x mask))) ((<= numvars x) x) (t (+ (logcount (loghead x (lognot mask))) (logcount (loghead numvars mask))))))))
Theorem:
(defthm index-permute-shrink-of-nfix-n (equal (index-permute-shrink (nfix n) count mask x numvars) (index-permute-shrink n count mask x numvars)))
Theorem:
(defthm index-permute-shrink-nat-equiv-congruence-on-n (implies (nat-equiv n n-equiv) (equal (index-permute-shrink n count mask x numvars) (index-permute-shrink n-equiv count mask x numvars))) :rule-classes :congruence)
Theorem:
(defthm index-permute-shrink-of-nfix-mask (equal (index-permute-shrink n count (nfix mask) x numvars) (index-permute-shrink n count mask x numvars)))
Theorem:
(defthm index-permute-shrink-nat-equiv-congruence-on-mask (implies (nat-equiv mask mask-equiv) (equal (index-permute-shrink n count mask x numvars) (index-permute-shrink n count mask-equiv x numvars))) :rule-classes :congruence)
Theorem:
(defthm index-permute-shrink-of-nfix-x (equal (index-permute-shrink n count mask (nfix x) numvars) (index-permute-shrink n count mask x numvars)))
Theorem:
(defthm index-permute-shrink-nat-equiv-congruence-on-x (implies (nat-equiv x x-equiv) (equal (index-permute-shrink n count mask x numvars) (index-permute-shrink n count mask x-equiv numvars))) :rule-classes :congruence)
Theorem:
(defthm index-permute-shrink-of-nfix-numvars (equal (index-permute-shrink n count mask x (nfix numvars)) (index-permute-shrink n count mask x numvars)))
Theorem:
(defthm index-permute-shrink-nat-equiv-congruence-on-numvars (implies (nat-equiv numvars numvars-equiv) (equal (index-permute-shrink n count mask x numvars) (index-permute-shrink n count mask x numvars-equiv))) :rule-classes :congruence)