Generate the ``make-self'' function for a sum type.
(defmake-self-gen-sum sum mutrecp
member-names fty-table make-self-table)
→
eventFunction:
(defun defmake-self-gen-sum (sum mutrecp member-names fty-table make-self-table) (declare (xargs :guard (and (flexsum-p sum) (booleanp mutrecp) (symbol-listp member-names) (alistp fty-table) (alistp make-self-table)))) (declare (xargs :guard (eq (flexsum->typemacro sum) 'deftagsum))) (let ((__function__ 'defmake-self-gen-sum)) (declare (ignorable __function__)) (b* ((type (flexsum->name sum)) ((unless (symbolp type)) (raise "Internal error: malformed type name ~x0." type) '(_)) (type-make-self (defmake-self-gen-name type)) (type-count (flexsum->count sum)) (recog (flexsum->pred sum)) (recp (flexsum->recp sum)) (body (b* ((type-case (flexsum->case sum)) (prods (flexsum->prods sum)) ((unless (flexprod-listp prods)) (raise "Internal error: products ~x0 have the wrong type." prods)) (cases (defmake-self-gen-sum-cases type prods member-names fty-table make-self-table))) (cons type-case (cons type cases))))) (cons 'define (cons type-make-self (cons (cons (cons type (cons recog 'nil)) 'nil) (cons ':parents (cons (cons (defmake-self-gen-topic-name type) 'nil) (cons body (append (cond (mutrecp (cons ':measure (cons (cons 'acl2::nat-list-measure (cons (cons 'list (cons (cons type-count (cons type 'nil)) '(1))) 'nil)) 'nil))) (recp (cons ':measure (cons (cons type-count (cons type 'nil)) 'nil))) (t nil)) (and (not mutrecp) '(:hooks (:fix)))))))))))))
Theorem:
(defthm pseudo-event-formp-of-defmake-self-gen-sum (b* ((event (defmake-self-gen-sum sum mutrecp member-names fty-table make-self-table))) (acl2::pseudo-event-formp event)) :rule-classes :rewrite)