mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Cleanup some type predicates

Browse source 
Use the new `cl--define-built-in-type` to reduce the manually
maintained list of built-in type predicates.
Also tweak docstrings to use "supertype" rather than "super type",
since it seems to be what we use elsewhere.

* lisp/subr.el (special-form-p): Remove redundant `fboundp` test.
(compiled-function-p): Don'Return nil for subrs that aren't functions.

* lisp/emacs-lisp/cl-macs.el (type predicates): Trim down the list.

* lisp/emacs-lisp/cl-preloaded.el (cl--define-built-in-type):
Register the corresponding predicate if applicable.
(atom, null): Specify the predicate name explicitly.
This commit is contained in:
Stefan Monnier 2024-03-12 15:43:43 -04:00
parent 3e96dd4f88
commit 8df6739077
4 changed files with 42 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

51
lisp/emacs-lisp/cl-preloaded.el
View file

@ -308,7 +308,7 @@
(:copier nil))
)
(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots)
(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots)
;; `slots' is currently unused, but we could make it take
;; a list of "slot like properties" together with the corresponding
;; accessor, and then we could maybe even make `slot-value' work
@ -317,15 +317,26 @@
(unless (listp parents) (setq parents (list parents)))
(unless (or parents (eq name t))
(error "Missing parents for %S: %S" name parents))
`(progn
(put ',name 'cl--class
(built-in-class--make ',name ,docstring
(mapcar (lambda (type)
(let ((class (get type 'cl--class)))
(unless class
(error "Unknown type: %S" type))
class))
',parents)))))
(let ((predicate (intern-soft (format
(if (string-match "-" (symbol-name name))
"%s-p" "%sp")
name))))
(unless (fboundp predicate) (setq predicate nil))
(while (keywordp (car slots))
(let ((kw (pop slots)) (val (pop slots)))
(pcase kw
(:predicate (setq predicate val))
(_ (error "Unknown keyword arg: %S" kw)))))
`(progn
,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate))
(put ',name 'cl--class
(built-in-class--make ',name ,docstring
(mapcar (lambda (type)
(let ((class (get type 'cl--class)))
(unless class
(error "Unknown type: %S" type))
class))
',parents))))))
;; FIXME: Our type DAG has various quirks:
;; - `subr' says it's a `compiled-function' but that's not true
@ -336,8 +347,9 @@
;; so the DAG of OClosure types is "orthogonal" to the distinction
;; between interpreted and compiled functions.
(cl--define-built-in-type t nil "The type of everything.")
(cl--define-built-in-type atom t "The type of anything but cons cells.")
(cl--define-built-in-type t nil "Abstract supertype of everything.")
(cl--define-built-in-type atom t "Abstract supertype of anything but cons cells."
:predicate atom)
(cl--define-built-in-type tree-sitter-compiled-query atom)
(cl--define-built-in-type tree-sitter-node atom)
@ -358,7 +370,7 @@
(cl--define-built-in-type window-configuration atom)
(cl--define-built-in-type overlay atom)
(cl--define-built-in-type number-or-marker atom
"Abstract super type of both `number's and `marker's.")
"Abstract supertype of both `number's and `marker's.")
(cl--define-built-in-type symbol atom
"Type of symbols."
;; Example of slots we could document. It would be desirable to
@ -373,14 +385,14 @@
(cl--define-built-in-type obarray atom)
(cl--define-built-in-type native-comp-unit atom)
(cl--define-built-in-type sequence t "Abstract super type of sequences.")
(cl--define-built-in-type sequence t "Abstract supertype of sequences.")
(cl--define-built-in-type list sequence)
(cl--define-built-in-type array (sequence atom) "Abstract super type of arrays.")
(cl--define-built-in-type array (sequence atom) "Abstract supertype of arrays.")
(cl--define-built-in-type number (number-or-marker)
"Abstract super type of numbers.")
"Abstract supertype of numbers.")
(cl--define-built-in-type float (number))
(cl--define-built-in-type integer-or-marker (number-or-marker)
"Abstract super type of both `integer's and `marker's.")
"Abstract supertype of both `integer's and `marker's.")
(cl--define-built-in-type integer (number integer-or-marker))
(cl--define-built-in-type marker (integer-or-marker))
(cl--define-built-in-type bignum (integer)
@ -404,13 +416,14 @@ For this build of Emacs it's %dbit."
"Type of special arrays that are indexed by characters.")
(cl--define-built-in-type string (array))
(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'?
"Type of the nil value.")
"Type of the nil value."
:predicate null)
(cl--define-built-in-type cons (list)
"Type of cons cells."
;; Example of slots we could document.
(car car) (cdr cdr))
(cl--define-built-in-type function (atom)
"Abstract super type of function values.")
"Abstract supertype of function values.")
(cl--define-built-in-type compiled-function (function)
"Abstract type of functions that have been compiled.")
(cl--define-built-in-type byte-code-function (compiled-function)