Generate the ``make-self'' function for an option type.
(defmake-self-gen-option sum mutrecp fty-table) → event
Function:
(defun defmake-self-gen-option (sum mutrecp fty-table) (declare (xargs :guard (and (flexsum-p sum) (booleanp mutrecp) (alistp fty-table)))) (declare (xargs :guard (eq (flexsum->typemacro sum) 'defoption))) (let ((__function__ 'defmake-self-gen-option)) (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)) (type-case (flexsum->case sum)) ((mv base-type accessor) (components-of-flexoption-with-name type fty-table)) (base-flextype (flextype-with-name base-type fty-table)) ((unless base-flextype) (raise "Internal error: malformed type ~x0." base-type) '(_)) (base-type-make-self (defmake-self-gen-name base-type)) (body (cons type-case (cons type (cons ':some (cons (cons base-type-make-self (cons (cons accessor (cons type 'nil)) 'nil)) '(:none nil))))))) (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-option (b* ((event (defmake-self-gen-option sum mutrecp fty-table))) (acl2::pseudo-event-formp event)) :rule-classes :rewrite)