Process the
The
Function:
(defun deffoldred-process-override-loop (override fty-table) (declare (xargs :guard (and (true-listp override) (alistp fty-table)))) (let ((__function__ 'deffoldred-process-override-loop)) (declare (ignorable __function__)) (b* (((reterr) nil) ((when (endp override)) (retok nil)) (ovrd (car override)) ((unless (or (std::tuplep 2 ovrd) (std::tuplep 3 ovrd))) (reterr (msg "Every element of the :OVERRIDE list ~ must be a list of 2 or 3 elements, ~ but the element ~x0 is not." ovrd))) (type (car ovrd)) (term (car (last ovrd))) ((unless (symbolp type)) (reterr (msg "The first element of ~ every element of the :OVERRIDE list ~ must be a symbol, ~ but ~x0 is not." type))) (info (flextype-with-name type fty-table)) ((unless info) (reterr (msg "The first element of ~ every element of the :OVERRIDE list ~ must be the name of a type, ~ but ~x0 is not." type))) ((unless (flexsum-p info)) (reterr (msg "The first element of ~ every element of the :OVERRIDE list ~ must be the name of a product or sum type, ~ but ~x0 is not." type))) (typemacro (flexsum->typemacro info)) ((unless (member-eq typemacro (list 'defprod 'deftagsum))) (reterr (msg "The first element of ~ every element of the :OVERRIDE list ~ must be the name of a product or sum type, ~ but ~x0 is not." type))) ((erp key val) (if (= (len ovrd) 2) (mv nil type term) (b* (((reterr) nil nil) (kind (cadr ovrd)) ((unless (keywordp kind)) (reterr (msg "The second element of ~ every element of the :OVERRIDE list ~ that is a 3-tuple ~ must be a keyword, ~ but ~x0 is not." kind))) (prods (flexsum->prods info)) ((unless (flexprod-listp prods)) (raise "Internal error: malformed summands ~x0." prods) (reterr t)) ((unless (member-eq kind (flexprod-list->kind-list prods))) (reterr (msg "The kind ~x0 that accompanies ~ the type ~x1 in the :OVERRIDE list ~ is not one of the kinds of that sum type." kind type)))) (retok (cons type kind) term)))) ((erp alist) (deffoldred-process-override-loop (cdr override) fty-table))) (retok (acons key val alist)))))
Theorem:
(defthm alistp-of-deffoldred-process-override-loop.overrides (b* (((mv ?erp ?overrides) (deffoldred-process-override-loop override fty-table))) (alistp overrides)) :rule-classes :rewrite)
Function:
(defun deffoldred-process-override (override fty-table) (declare (xargs :guard (alistp fty-table))) (let ((__function__ 'deffoldred-process-override)) (declare (ignorable __function__)) (b* (((reterr) nil) ((unless (true-listp override)) (reterr (msg "The :OVERRIDE input must be a list, ~ but it is ~x0 instead." override)))) (deffoldred-process-override-loop override fty-table))))
Theorem:
(defthm alistp-of-deffoldred-process-override.overrides (b* (((mv ?erp ?overrides) (deffoldred-process-override override fty-table))) (alistp overrides)) :rule-classes :rewrite)