Process the
(atc-process-const-name options target-fns wrld) → (mv erp prog-const wf-thm fn-thms fn-limits fn-body-limits)
Since this input also determines, indirectly, the names of the theorems generated and exported by ATC, here we also calculate the names of those theorems, ensure they are fresh, and return them for use in event generation. More precisely, we return the name of the program well-formedness theorem and the names of the function correctness theorems; the latter are returned as an alist from the target functions to the respective theorem names.
The name of each theorem is obtained by appending something to the name of the constant. The thing appended differs across the theorems: thus, their names are all distinct by construction.
Besides the names of the generated theorems,
we also return the names of the soon-to-be-generated limit functions.
There will be one limit function for each target function,
whose name is obtained by adding
Function:
(defun atc-process-const-name-aux (target-fns prog-const wrld) (declare (xargs :guard (and (symbol-listp target-fns) (symbolp prog-const) (plist-worldp wrld)))) (let ((__function__ 'atc-process-const-name-aux)) (declare (ignorable __function__)) (b* (((reterr) nil nil nil) ((when (endp target-fns)) (retok nil nil nil)) (fn (car target-fns)) (fn-thm (packn (list prog-const "-" (symbol-name fn) "-CORRECT"))) (msg? (acl2::fresh-namep-msg-weak fn-thm nil wrld)) ((when msg?) (reterr (msg "The generated theorem name ~x0 ~ for the correctness theorem of the function ~x1 ~ is invalid: ~@2" fn-thm fn msg?))) ((erp fn-thms fn-limits fn-body-limits) (atc-process-const-name-aux (cdr target-fns) prog-const wrld)) (fn-limit (packn (list prog-const "-" (symbol-name fn) "-LIMIT"))) (msg? (acl2::fresh-namep-msg-weak fn-limit 'function wrld)) ((when msg?) (reterr (msg "The generated function name ~x0 ~ for the limit of the function ~x1 ~ is invalid: ~@2" fn-limit fn msg?))) ((when (not (irecursivep+ fn wrld))) (retok (acons fn fn-thm fn-thms) (acons fn fn-limit fn-limits) fn-body-limits)) (fn-body-limit (packn (list prog-const "-" (symbol-name fn) "-BODY-LIMIT"))) (msg? (acl2::fresh-namep-msg-weak fn-body-limit 'function wrld)) ((when msg?) (reterr (msg "The generated function name ~x0 ~ for the body limit of the function ~x1 ~ is invalid: ~@2" fn-body-limit fn msg?)))) (retok (acons fn fn-thm fn-thms) (acons fn fn-limit fn-limits) (acons fn fn-body-limit fn-body-limits)))))
Theorem:
(defthm symbol-symbol-alistp-of-atc-process-const-name-aux.fn-thms (implies (symbol-listp target-fns) (b* (((mv acl2::?erp ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name-aux target-fns prog-const wrld))) (symbol-symbol-alistp fn-thms))) :rule-classes :rewrite)
Theorem:
(defthm symbol-symbol-alistp-of-atc-process-const-name-aux.fn-limits (implies (symbol-listp target-fns) (b* (((mv acl2::?erp ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name-aux target-fns prog-const wrld))) (symbol-symbol-alistp fn-limits))) :rule-classes :rewrite)
Theorem:
(defthm symbol-symbol-alistp-of-atc-process-const-name-aux.fn-body-limits (implies (symbol-listp target-fns) (b* (((mv acl2::?erp ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name-aux target-fns prog-const wrld))) (symbol-symbol-alistp fn-body-limits))) :rule-classes :rewrite)
Function:
(defun atc-process-const-name (options target-fns wrld) (declare (xargs :guard (and (symbol-alistp options) (symbol-listp target-fns) (plist-worldp wrld)))) (let ((__function__ 'atc-process-const-name)) (declare (ignorable __function__)) (b* (((reterr) nil nil nil nil nil) (const-name-option (assoc-eq :const-name options)) (const-name (if (consp const-name-option) (cdr const-name-option) :auto)) ((unless (symbolp const-name)) (reterr (msg "The :CONST-NAME input must be a symbol, ~ but ~x0 is not a symbol." const-name))) (prog-const (if (eq const-name :auto) '*program* const-name)) (msg? (acl2::fresh-namep-msg-weak prog-const 'acl2::const wrld)) ((when msg?) (reterr (msg "The constant name ~x0 ~ determined by the :CONST-NAME input ~x0 ~ is invalid: ~@2" prog-const const-name msg?))) (wf-thm (add-suffix prog-const "-WELL-FORMED")) (msg? (acl2::fresh-namep-msg-weak wf-thm nil wrld)) ((when msg?) (reterr (msg "The generated theorem name ~x0 ~ for the well-formedness theorem is invalid: ~@1" wf-thm msg?))) ((erp fn-thms fn-limits fn-body-limits) (atc-process-const-name-aux target-fns prog-const wrld))) (retok prog-const wf-thm fn-thms fn-limits fn-body-limits))))
Theorem:
(defthm symbolp-of-atc-process-const-name.prog-const (b* (((mv acl2::?erp ?prog-const ?wf-thm ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name options target-fns wrld))) (symbolp prog-const)) :rule-classes :rewrite)
Theorem:
(defthm symbolp-of-atc-process-const-name.wf-thm (b* (((mv acl2::?erp ?prog-const ?wf-thm ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name options target-fns wrld))) (symbolp wf-thm)) :rule-classes :rewrite)
Theorem:
(defthm symbol-symbol-alistp-of-atc-process-const-name.fn-thms (implies (symbol-listp target-fns) (b* (((mv acl2::?erp ?prog-const ?wf-thm ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name options target-fns wrld))) (symbol-symbol-alistp fn-thms))) :rule-classes :rewrite)
Theorem:
(defthm symbol-symbol-alistp-of-atc-process-const-name.fn-limits (implies (symbol-listp target-fns) (b* (((mv acl2::?erp ?prog-const ?wf-thm ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name options target-fns wrld))) (symbol-symbol-alistp fn-limits))) :rule-classes :rewrite)
Theorem:
(defthm symbol-symbol-alistp-of-atc-process-const-name.fn-body-limits (implies (symbol-listp target-fns) (b* (((mv acl2::?erp ?prog-const ?wf-thm ?fn-thms ?fn-limits ?fn-body-limits) (atc-process-const-name options target-fns wrld))) (symbol-symbol-alistp fn-body-limits))) :rule-classes :rewrite)