Generate the ``make-self function for an omap type.
(defmake-self-gen-omap omap mutrecp fty-table make-self-table) → event
Function:
(defun defmake-self-gen-omap (omap mutrecp fty-table make-self-table) (declare (xargs :guard (and (flexomap-p omap) (booleanp mutrecp) (alistp fty-table) (alistp make-self-table)))) (let ((__function__ 'defmake-self-gen-omap)) (declare (ignorable __function__)) (b* ((type (flexomap->name omap)) ((unless (symbolp type)) (raise "Internal error: malformed type name ~x0." type) '(_)) (type-make-self (defmake-self-gen-name type)) (type-count (flexomap->count omap)) (recog (flexomap->pred omap)) (recp (flexomap->recp omap)) (key-recog (flexomap->key-type omap)) ((unless (symbolp key-recog)) (raise "Internal error: malformed recognizer ~x0." key-recog) '(_)) (key-info (flextype-with-recognizer key-recog fty-table)) (key-type? (if key-info (flextype->name key-info) nil)) (key-type-make-self? (b* (((unless key-type?) nil) ((mv erp key-type-make-self) (defmake-self-get-make-self-fn key-type? make-self-table))) (if erp (raise "~@0~%" erp) key-type-make-self))) (val-recog (flexomap->val-type omap)) ((unless (symbolp val-recog)) (raise "Internal error: malformed recognizer ~x0." val-recog) '(_)) (val-info (flextype-with-recognizer val-recog fty-table)) (val-type? (if val-info (flextype->name val-info) nil)) (val-type-make-self? (b* (((unless val-type?) nil) ((mv erp val-type-make-self) (defmake-self-get-make-self-fn val-type? make-self-table))) (if erp (raise "~@0~%" erp) val-type-make-self))) (body (cons 'if (cons (cons 'or (cons (cons 'not (cons (cons 'mbt (cons (cons recog (cons type 'nil)) 'nil)) 'nil)) (cons (cons 'omap::emptyp (cons type 'nil)) 'nil))) (cons 'nil (cons (cons 'list (cons ''omap::update (cons (if key-type? (cons key-type-make-self? (cons (cons 'omap::head-key (cons type 'nil)) 'nil)) (cons 'omap::head-key (cons type 'nil))) (cons (if val-type? (cons val-type-make-self? (cons (cons 'omap::head-val (cons type 'nil)) 'nil)) (cons 'omap::head-val (cons type 'nil))) (cons (cons type-make-self (cons (cons 'omap::tail (cons type 'nil)) 'nil)) 'nil))))) '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 (and (or mutrecp recp) (cons ':measure (cons (cons type-count (cons type 'nil)) 'nil))) (and (not mutrecp) '(:hooks (:fix)))))))))))))
Theorem:
(defthm pseudo-event-formp-of-defmake-self-gen-omap (b* ((event (defmake-self-gen-omap omap mutrecp fty-table make-self-table))) (acl2::pseudo-event-formp event)) :rule-classes :rewrite)