]> git.eshelyaron.com Git - emacs.git/commitdiff
Add 'safety' function declaration
authorAndrea Corallo <acorallo@gnu.org>
Fri, 3 May 2024 20:45:04 +0000 (22:45 +0200)
committerEshel Yaron <me@eshelyaron.com>
Thu, 16 May 2024 08:18:54 +0000 (10:18 +0200)
* 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.

(cherry picked from commit 9e4e6d0fc904e8a57c8433c40d6e3e9a230773d9)

lisp/emacs-lisp/byte-run.el
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/comp.el

index 201ed116b98f114bffe68e6d4c5c8c960ae7fc5f..392cc86450da500f193e24c7ad1d2118650ca415 100644 (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)
index e0bcdce502b917baf9bfbe84030f6dba423d9fb9..732a1629177ad350cbaac13d9063bcdb86d92032 100644 (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)
index 0536b45d118ed02dc766f32c1652899707e8f45f..f9fa83da585d320b66ff8c6fe804cff9363d3d25 100644 (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