Cleanup some type predicates
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
parent
3e96dd4f88
commit
8df6739077
4 changed files with 42 additions and 62 deletions
|
|
@ -3463,45 +3463,12 @@ Of course, we really can't know that for sure, so it's just a heuristic."
|
|||
;; Please keep it in sync with `comp-known-predicates'.
|
||||
(pcase-dolist (`(,type . ,pred)
|
||||
;; Mostly kept in alphabetical order.
|
||||
'((array . arrayp)
|
||||
(atom . atom)
|
||||
(base-char . characterp)
|
||||
(bignum . bignump)
|
||||
(boolean . booleanp)
|
||||
(bool-vector . bool-vector-p)
|
||||
(buffer . bufferp)
|
||||
(byte-code-function . byte-code-function-p)
|
||||
(character . natnump)
|
||||
(char-table . char-table-p)
|
||||
(command . commandp)
|
||||
(compiled-function . compiled-function-p)
|
||||
(hash-table . hash-table-p)
|
||||
(cons . consp)
|
||||
(fixnum . fixnump)
|
||||
(float . floatp)
|
||||
(frame . framep)
|
||||
(function . functionp)
|
||||
(integer . integerp)
|
||||
(keyword . keywordp)
|
||||
(list . listp)
|
||||
(marker . markerp)
|
||||
(natnum . natnump)
|
||||
(number . numberp)
|
||||
(null . null)
|
||||
(obarray . obarrayp)
|
||||
(overlay . overlayp)
|
||||
(process . processp)
|
||||
(real . numberp)
|
||||
(sequence . sequencep)
|
||||
(subr . subrp)
|
||||
(string . stringp)
|
||||
(symbol . symbolp)
|
||||
(symbol-with-pos . symbol-with-pos-p)
|
||||
(vector . vectorp)
|
||||
(window . windowp)
|
||||
;; FIXME: Do we really want to consider these types?
|
||||
(number-or-marker . number-or-marker-p)
|
||||
(integer-or-marker . integer-or-marker-p)
|
||||
;; These aren't defined via `cl--define-built-in-type'.
|
||||
'((base-char . characterp) ;Could be subtype of `fixnum'.
|
||||
(character . natnump) ;Could be subtype of `fixnum'.
|
||||
(command . commandp) ;Subtype of closure & subr.
|
||||
(natnum . natnump) ;Subtype of fixnum & bignum.
|
||||
(real . numberp) ;Not clear where it would fit.
|
||||
))
|
||||
(put type 'cl-deftype-satisfies pred))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -437,7 +437,7 @@ This has 2 uses:
|
|||
- For compiled code, this is used as a marker which cconv uses to check that
|
||||
immutable fields are indeed not mutated."
|
||||
(if (byte-code-function-p oclosure)
|
||||
;; Actually, this should never happen since the `cconv.el' should have
|
||||
;; Actually, this should never happen since `cconv.el' should have
|
||||
;; optimized away the call to this function.
|
||||
oclosure
|
||||
;; For byte-coded functions, we store the type as a symbol in the docstring
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue