Function:
(defun env-permute-stretch (n count mask env numvars) (declare (xargs :guard (and (natp n) (natp mask) (natp env) (natp numvars)))) (declare (xargs :guard (and (<= n numvars) (eql count (logcount (loghead n mask)))))) (let ((__function__ 'env-permute-stretch)) (declare (ignorable __function__)) (b* (((when (mbe :logic (zp (- (nfix numvars) (nfix n))) :exec (eql n numvars))) (lnfix env)) (n (lnfix n)) (count (mbe :logic (logcount (loghead n (lnfix mask))) :exec count)) (bit (logbit n (lnfix mask))) (env (env-permute-stretch (1+ n) (+ bit count) mask env numvars))) (if (eql bit 1) (env-move-var-up count n env) env))))
Theorem:
(defthm natp-of-env-permute-stretch (b* ((perm-env (env-permute-stretch n count mask env numvars))) (natp perm-env)) :rule-classes :type-prescription)
Theorem:
(defthm normalize-count-of-env-permute-stretch (b* nil (implies (syntaxp (not (equal count ''nil))) (equal (env-permute-stretch n count mask env numvars) (let ((count nil)) (env-permute-stretch n count mask env numvars))))))
Theorem:
(defthm lookup-in-env-permute-stretch (b* ((?perm-env (env-permute-stretch n count mask env numvars))) (equal (env-lookup k perm-env) (env-lookup (index-permute-shrink n nil mask k numvars) env))))
Theorem:
(defthm env-permute-stretch-of-env-update (b* nil (equal (env-permute-stretch n count mask (env-update k val env) numvars) (env-update (index-permute-stretch n nil mask k numvars) val (env-permute-stretch n count mask env numvars)))))
Theorem:
(defthm env-permute-stretch-of-nfix-n (equal (env-permute-stretch (nfix n) count mask env numvars) (env-permute-stretch n count mask env numvars)))
Theorem:
(defthm env-permute-stretch-nat-equiv-congruence-on-n (implies (nat-equiv n n-equiv) (equal (env-permute-stretch n count mask env numvars) (env-permute-stretch n-equiv count mask env numvars))) :rule-classes :congruence)
Theorem:
(defthm env-permute-stretch-of-nfix-mask (equal (env-permute-stretch n count (nfix mask) env numvars) (env-permute-stretch n count mask env numvars)))
Theorem:
(defthm env-permute-stretch-nat-equiv-congruence-on-mask (implies (nat-equiv mask mask-equiv) (equal (env-permute-stretch n count mask env numvars) (env-permute-stretch n count mask-equiv env numvars))) :rule-classes :congruence)
Theorem:
(defthm env-permute-stretch-of-nfix-env (equal (env-permute-stretch n count mask (nfix env) numvars) (env-permute-stretch n count mask env numvars)))
Theorem:
(defthm env-permute-stretch-nat-equiv-congruence-on-env (implies (nat-equiv env env-equiv) (equal (env-permute-stretch n count mask env numvars) (env-permute-stretch n count mask env-equiv numvars))) :rule-classes :congruence)
Theorem:
(defthm env-permute-stretch-of-nfix-numvars (equal (env-permute-stretch n count mask env (nfix numvars)) (env-permute-stretch n count mask env numvars)))
Theorem:
(defthm env-permute-stretch-nat-equiv-congruence-on-numvars (implies (nat-equiv numvars numvars-equiv) (equal (env-permute-stretch n count mask env numvars) (env-permute-stretch n count mask env numvars-equiv))) :rule-classes :congruence)