Process a target function
(atc-process-function fn previous-fns uncalled-fns wrld) → (mv erp new-previous-fns new-uncalled-fns)
Here we perform some of the checks prescribed in atc, namely the ones that are easy to perform without analyzing the body of the function in detail. The remaining checks are performed during code generation, where it is more natural to perform them, as the functions' bodies are analyzed and translated to C.
The
The
When this input processing function is called,
Function:
(defun atc-process-function (fn previous-fns uncalled-fns wrld) (declare (xargs :guard (and (symbolp fn) (symbol-listp previous-fns) (symbol-listp uncalled-fns) (plist-worldp wrld)))) (declare (xargs :guard (function-symbolp fn wrld))) (let ((__function__ 'atc-process-function)) (declare (ignorable __function__)) (b* (((reterr) nil nil) (previous-fns (cons fn previous-fns)) (desc (msg "The target function ~x0" fn)) ((unless (logicp fn wrld)) (reterr (msg "~@0 must be in logic mode." desc))) ((unless (acl2::guard-verified-p fn wrld)) (reterr (msg "~@0 must be guard-verified." desc))) ((unless (acl2::definedp fn wrld)) (reterr (msg "~@0 must be defined." desc))) ((when (ffnnamep fn (uguard+ fn wrld))) (reterr (msg "The target function ~x0 is used in its own guard. ~ This is currently not supported in ATC." fn))) (rec (irecursivep+ fn wrld)) ((when (and rec (> (len rec) 1))) (reterr (msg "The recursive target function ~x0 ~ must be singly recursive, ~ but it is mutually recursive with ~x1 instead." fn (remove-eq fn rec)))) ((when (and rec (not (equal (well-founded-relation+ fn wrld) 'o<)))) (reterr (msg "The well-founded relation ~ of the recursive target function ~x0 ~ must be O<, but it ~x1 instead. ~ Only recursive functions with well-founded relation O< ~ are currently supported by ATC." fn (well-founded-relation+ fn wrld)))) (uncalled-fns (atc-remove-called-fns uncalled-fns (ubody+ fn wrld))) (uncalled-fns (if rec (cons fn uncalled-fns) uncalled-fns))) (retok previous-fns uncalled-fns))))
Theorem:
(defthm symbol-listp-of-atc-process-function.new-previous-fns (implies (and (symbolp fn) (symbol-listp previous-fns)) (b* (((mv acl2::?erp ?new-previous-fns ?new-uncalled-fns) (atc-process-function fn previous-fns uncalled-fns wrld))) (symbol-listp new-previous-fns))) :rule-classes :rewrite)
Theorem:
(defthm symbol-listp-of-atc-process-function.new-uncalled-fns (implies (and (symbolp fn) (symbol-listp uncalled-fns)) (b* (((mv acl2::?erp ?new-previous-fns ?new-uncalled-fns) (atc-process-function fn previous-fns uncalled-fns wrld))) (symbol-listp new-uncalled-fns))) :rule-classes :rewrite)
Theorem:
(defthm true-listp-of-atc-process-function.new-previous-fns (implies (true-listp previous-fns) (b* (((mv acl2::?erp ?new-previous-fns ?new-uncalled-fns) (atc-process-function fn previous-fns uncalled-fns wrld))) (true-listp new-previous-fns))) :rule-classes :type-prescription)
Theorem:
(defthm true-listp-of-atc-process-function.new-uncalled-fns (implies (true-listp new-uncalled-fns) (b* (((mv acl2::?erp ?new-previous-fns ?new-uncalled-fns) (atc-process-function fn previous-fns uncalled-fns wrld))) (true-listp new-uncalled-fns))) :rule-classes :type-prescription)