emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master baf9f1210a3: Add some basic checking for function type declaratio


From: Andrea Corallo
Subject: master baf9f1210a3: Add some basic checking for function type declarations
Date: Wed, 24 Jul 2024 13:21:15 -0400 (EDT)

branch: master
commit baf9f1210a3e44aa19d9ac90e5a4faca214127a7
Author: Andrea Corallo <acorallo@gnu.org>
Commit: Andrea Corallo <acorallo@gnu.org>

    Add some basic checking for function type declarations
    
    * lisp/emacs-lisp/byte-run.el (byte-run--anonymize-arg-list): New function.
    (byte-run--set-function-type): Add some basic checking for
    the function type being declared.
---
 lisp/emacs-lisp/byte-run.el | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 75cfc7b32d3..f1486f70634 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -222,12 +222,27 @@ So far, FUNCTION can only be a symbol, not a lambda 
expression."
                  (cadr elem)))
               val)))))
 
+(defalias 'byte-run--anonymize-arg-list
+  #'(lambda (arg-list)
+      (mapcar (lambda (x)
+                (if (memq x '(&optional &rest))
+                    x
+                 t))
+              arg-list)))
+
 (defalias 'byte-run--set-function-type
-  #'(lambda (f _args val &optional f2)
+  #'(lambda (f args val &optional f2)
       (when (and f2 (not (eq f2 f)))
         (error
          "`%s' does not match top level function `%s' inside function type \
 declaration" f2 f))
+      (unless (and  (length= val 3)
+                    (eq (car val) 'function)
+                    (listp (car (cdr val))))
+        (error "Type `%s' is not valid a function type" val))
+      (unless (equal (byte-run--anonymize-arg-list args)
+                     (byte-run--anonymize-arg-list (car (cdr val))))
+        (error "Type `%s' incompatible with function arguments `%s'" val args))
       (list 'function-put (list 'quote f)
             ''function-type (list 'quote val))))
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]