scratch/comp-safety 158954a7920 2/5: Add 'safety' function declaration

[Andrea Corallo]

branch: scratch/comp-safety
commit 158954a792060d94a817106908e1235f0c9d43cf
Author: Andrea Corallo <acorallo@gnu.org>
Commit: Andrea Corallo <acorallo@gnu.org>

    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.
---
 lisp/emacs-lisp/byte-run.el |  6 ++++++
 lisp/emacs-lisp/bytecomp.el |  1 +
 lisp/emacs-lisp/comp.el     | 14 +++++++++++++-
 3 files changed, 20 insertions(+), 1 deletion(-)

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 8c76b915337..a91c4c6e37b 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 `(safety . ,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 cfeb4a9b4cd..86627e06ba8 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -205,7 +205,7 @@ Useful to hook into pass checkers.")
 
 (defun comp--maybe-relax-function-type (type)
   "In case relax function type TYPE so we can't optimize of it."
-  (if (= safety 0)
+  (if (= (comp-func-safety comp-func) 0)
       type
     (pcase type
       (`(function ,args ,ret)
@@ -388,6 +388,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 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
@@ -547,6 +549,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
@@ -718,6 +722,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)
@@ -844,6 +853,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))
 
@@ -870,6 +880,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 '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