[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/comp-safety2 4ef3ef15a12 2/4: Add 'safety' function declaration
From: |
Andrea Corallo |
Subject: |
scratch/comp-safety2 4ef3ef15a12 2/4: Add 'safety' function declaration |
Date: |
Fri, 10 May 2024 13:55:35 -0400 (EDT) |
branch: scratch/comp-safety2
commit 4ef3ef15a12b1623711100a9febdf7c33385bdd1
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 | 12 ++++++++++++
3 files changed, 19 insertions(+)
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 fa866b802cc..22cf1569878 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -369,6 +369,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
@@ -528,6 +530,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
@@ -699,6 +703,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)
@@ -825,6 +834,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))
@@ -851,6 +861,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