Generate the ``make-self'' function for a product type.
(defmake-self-gen-prod sum mutrecp
member-names fty-table make-self-table)
→
eventFunction:
(defun defmake-self-gen-prod (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) 'defprod))) (let ((__function__ 'defmake-self-gen-prod)) (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* ((prods (flexsum->prods sum)) ((unless (flexprod-listp prods)) (raise "Internal error: malformed products ~x0." prods)) ((unless (and (consp prods) (endp (cdr prods)))) (raise "Internal error: non-singleton product ~x0." prods)) (prod (car prods))) (defmake-self-gen-sum-case type prod member-names fty-table make-self-table)))) (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-prod (b* ((event (defmake-self-gen-prod sum mutrecp member-names fty-table make-self-table))) (acl2::pseudo-event-formp event)) :rule-classes :rewrite)