diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 45 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-preloaded.el | 51 | ||||
| -rw-r--r-- | lisp/emacs-lisp/oclosure.el | 2 |
3 files changed, 39 insertions, 59 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index be477b7a6df..129b83c61b9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -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)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 5743684fa89..515aa99549d 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -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) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 977d5735171..4da8e61aaa7 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -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 |