Add 'safety' function declaration

* lisp/emacs-lisp/comp.el (comp-known-predicates): Use
'comp-func-safety'.
(comp-ctxt, comp-mvar-type-hint-match-p): New 'safety' slot.
(comp-c-func-name): New function.
(comp--spill-lap-function, comp--intern-func-in-ctxt): Update.
* lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Spill safety.
* lisp/emacs-lisp/byte-run.el (byte-run--set-completion): New alias.
(defun-declarations-alist): Update.
This commit is contained in:
Andrea Corallo 2024-05-03 22:45:04 +02:00
parent 13ddfc2011
commit 9e4e6d0fc9
3 changed files with 19 additions and 0 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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