diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index f9e86d88806..2acd22d0a6a 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -193,6 +193,11 @@ So far, FUNCTION can only be a symbol, not a lambda expression." (list 'function-put (list 'quote f) ''speed (list 'quote val)))) +(defalias 'byte-run--set-safety + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''safety (list 'quote val)))) + (defalias 'byte-run--set-completion #'(lambda (f _args val) (list 'function-put (list 'quote f) @@ -242,6 +247,7 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'doc-string #'byte-run--set-doc-string) (list 'indent #'byte-run--set-indent) (list 'speed #'byte-run--set-speed) + (list 'safety #'byte-run--set-safety) (list 'completion #'byte-run--set-completion) (list 'modes #'byte-run--set-modes) (list 'interactive-args #'byte-run--set-interactive-args) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e0bcdce502b..732a1629177 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2449,6 +2449,7 @@ With argument ARG, insert value in current buffer after the form." (when byte-native-compiling (defvar native-comp-speed) (push `(native-comp-speed . ,native-comp-speed) byte-native-qualities) + (push `(compilation-safety . ,compilation-safety) byte-native-qualities) (defvar native-comp-debug) (push `(native-comp-debug . ,native-comp-debug) byte-native-qualities) (defvar native-comp-compiler-options) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0536b45d118..f9fa83da585 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -368,6 +368,8 @@ Returns ELT." :documentation "Target output file-name for the compilation.") (speed native-comp-speed :type number :documentation "Default speed for this compilation unit.") + (safety compilation-safety :type number + :documentation "Default safety level for this compilation unit.") (debug native-comp-debug :type number :documentation "Default debug level for this compilation unit.") (compiler-options native-comp-compiler-options :type list @@ -527,6 +529,8 @@ CFG is mutated by a pass.") :documentation "t if non local jumps are present.") (speed nil :type number :documentation "Optimization level (see `native-comp-speed').") + (safety nil :type number + :documentation "Safety level (see `safety').") (pure nil :type boolean :documentation "t if pure nil otherwise.") (declared-type nil :type list @@ -698,6 +702,11 @@ current instruction or its cell." (or (comp--spill-decl-spec function-name 'speed) (comp-ctxt-speed comp-ctxt))) +(defun comp--spill-safety (function-name) + "Return the safety level for FUNCTION-NAME." + (or (comp--spill-decl-spec function-name 'safety) + (comp-ctxt-safety comp-ctxt))) + ;; Autoloaded as might be used by `disassemble-internal'. ;;;###autoload (defun comp-c-func-name (name prefix &optional first) @@ -824,6 +833,7 @@ clashes." (comp-func-lap func) lap (comp-func-frame-size func) (comp--byte-frame-size byte-func) (comp-func-speed func) (comp--spill-speed name) + (comp-func-safety func) (comp--spill-safety name) (comp-func-declared-type func) (comp--spill-decl-spec name 'function-type) (comp-func-pure func) (comp--spill-decl-spec name 'pure)) @@ -850,6 +860,8 @@ clashes." (comp-el-to-eln-filename filename native-compile-target-directory))) (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed byte-native-qualities) + (comp-ctxt-safety comp-ctxt) (alist-get 'compilation-safety + byte-native-qualities) (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug byte-native-qualities) (comp-ctxt-compiler-options comp-ctxt) (alist-get 'native-comp-compiler-options