other
(in-package "ACL2")
with-final-error-printingmacro
(defmacro with-final-error-printing (form &key (ctx 'with-final-error-printing)) `(with-output :off (summary warning!) :stack :push (make-event (if (or (f-get-global 'certify-book-info state) (global-val 'include-book-path (w state)) (ld-skip-proofsp state)) (value '(with-output :stack :pop ,FORM)) (mv-let (erp val state) (with-output :stack :pop (make-event ',FORM)) (if erp (er-progn (assign error-redo-flat-fail (f-get-global 'redo-flat-fail state)) (assign error-redo-flat-succ (f-get-global 'redo-flat-succ state)) (er very-soft ',CTX "~@0~%" (if (boundp-global 'saved-error-for-final-error-printing state) (@ saved-error-for-final-error-printing) "The event failed, but no error message was saved~%")) (value '(with-output :off :all (make-event nil)))) (value `(with-output :off :all (progn (skip-proofs ,(F-GET-GLOBAL 'LAST-MAKE-EVENT-EXPANSION STATE)) (value-triple ',VAL))))))))))
with-saved-error-msgmacro
(defmacro with-saved-error-msg (form msg) `(make-event (let ((form ',FORM)) (er-progn (assign saved-error-for-final-error-printing ,MSG) (value `(progn ,FORM (with-output :off :all (make-event (let ((state (makunbound-global 'saved-error-for-final-error-printing state))) (value '(value-triple :invisible)))))))))))
error-redo-flatmacro
(defmacro error-redo-flat (&key (succ-ld-skip-proofsp 't) (label 'r) (succ 't) (fail 't) (pbt 't) (show 'nil)) `(if (null (f-get-global 'error-redo-flat-fail state)) (pprogn (fms " There is no failure saved from a WITH-FINAL-ERROR-PRINTING form.~|" nil (standard-co state) state nil) (value :invisible)) ,(IF SHOW `(PPROGN (FMS "List of events (from encapsulate or progn) preceding ~ the failure:~|~%~x0~|" (LIST (CONS #\0 (F-GET-GLOBAL 'ERROR-REDO-FLAT-SUCC STATE))) (STANDARD-CO STATE) STATE (LD-EVISC-TUPLE STATE)) (FMS "Failed event:~|~%~x0~|" (LIST (CONS #\0 (F-GET-GLOBAL 'ERROR-REDO-FLAT-FAIL STATE))) (STANDARD-CO STATE) STATE (LD-EVISC-TUPLE STATE)) (VALUE :INVISIBLE)) `(LET ((ERROR-REDO-FLAT-SUCC (F-GET-GLOBAL 'ERROR-REDO-FLAT-SUCC STATE)) (ERROR-REDO-FLAT-FAIL (F-GET-GLOBAL 'ERROR-REDO-FLAT-FAIL STATE))) (STATE-GLOBAL-LET* ((ERROR-REDO-FLAT-SUCC ERROR-REDO-FLAT-SUCC) (ERROR-REDO-FLAT-FAIL ERROR-REDO-FLAT-FAIL)) (LD (LIST ,@(AND SUCC LABEL `('(DEFLABEL ,LABEL))) ,@(AND SUCC (LIST (LIST 'LIST ''LD (LIST 'CONS ''LIST (LIST 'KWOTE-LST 'ERROR-REDO-FLAT-SUCC)) :LD-SKIP-PROOFSP SUCC-LD-SKIP-PROOFSP))) ,@(AND FAIL (LIST (LIST 'LIST ''LD (LIST 'LIST ''LIST (LIST 'LIST ''QUOTE 'ERROR-REDO-FLAT-FAIL)) :LD-ERROR-ACTION :CONTINUE :LD-PRE-EVAL-PRINT T))) ,@(AND PBT SUCC LABEL `('(PPROGN (NEWLINE (PROOFS-CO STATE) STATE) (PBT ',LABEL)))))))))))
saved-error-cond-fnfunction
(defun saved-error-cond-fn (conds) (if (atom conds) '((t (value '(value-triple 'bindings-ok)))) (let ((test (caar conds)) (msg (cadar conds))) (cons `(,TEST (er-progn (assign saved-error-for-final-error-printing ,MSG) (value `(with-output :off :all (make-event nil))))) (saved-error-cond-fn (cdr conds))))))
saved-error-condmacro
(defmacro saved-error-cond (&rest conds) `(with-output :off :all (make-event (cond . ,(SAVED-ERROR-COND-FN CONDS)))))
skip-proofs-outside-certify-fnfunction
(defun skip-proofs-outside-certify-fn (form) `(make-event (if (f-get-global 'certify-book-info state) ',FORM `(skip-proofs ,',FORM))))
skip-proofs-outside-certifymacro
(defmacro skip-proofs-outside-certify (form) (skip-proofs-outside-certify-fn form))