We generally want types to form not just a DAG but a lattice.
If objects can be both `keyword` and `symbol-with-pos`, this
means there should be a more precise type describing this intersection.
If we ever find the need for such a refinement, we could add
such a `keyword-with-pos` type, but here I took the simpler
route of treating `keyword` not as a proper built-in type but
as a second-class type like `natnum`.
While fixing this problem, also fix the problem we had where
`functionp` was not quite adequate to characterize objects of type
`function`, by introducing a new predicate `cl-functionp` for that.
* lisp/emacs-lisp/cl-preloaded.el (cl-functionp): New function.
(function): Use it.
(keyword): Don't declare it as a built-in type.
(user-ptrp): Remove redundant declaration.
* lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types):
Delete constant.
(cl-generic-generalizers): Remove corresponding test.
* lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add entry for
`keyword` type.
* lisp/emacs-lisp/comp.el (comp-known-predicates): Fix type for
negative result of `characterp`. Remove duplicate `numberp` entry.
Fix types for `keywordp` now that `keyword` is not a built-in type any more.
* test/src/data-tests.el (data-tests--cl-type-of): Add a few cases.
Remove workaround for `function`.
(cherry picked from commit
004f2493a542dd0b804a30e97fc612884ca440f4)
a more precise type. For example, for nil and t it returns 'null'
and 'boolean' respectively, instead of just 'symbol'.
-** New function `primitive-function-p`.
-This is like `subr-primitive-p` except that it returns t only if the
-argument is a function rather than a special-form.
+** New functions `primitive-function-p` and `cl-functionp`.
+`primitive-function-p` is like `subr-primitive-p` except that it returns
+t only if the argument is a function rather than a special-form,
+and `cl-functionp` is like `functionp` except it return nil
+for lists and symbols.
** Built-in types have now corresponding classes.
At the Lisp level, this means that things like (cl-find-class 'integer)
;;; Dispatch on "normal types".
-(defconst cl--generic--unreachable-types
- ;; FIXME: Try to make that list empty?
- '(keyword)
- "Built-in classes on which we cannot dispatch for technical reasons.")
-
(defun cl--generic-type-specializers (tag &rest _)
(and (symbolp tag)
(let ((class (cl--find-class tag)))
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
"Support for dispatch on types.
This currently works for built-in types and types built on top of records."
- ;; FIXME: Add support for other types accepted by `cl-typep' such
- ;; as `character', `face', `function', ...
+ ;; FIXME: Add support for other "types" accepted by `cl-typep' such
+ ;; as `character', `face', `keyword', ...?
(or
(and (symbolp type)
(not (eq type t)) ;; Handled by the `t-generalizer'.
(let ((class (cl--find-class type)))
- (when (memq type cl--generic--unreachable-types)
- (error "Dispatch on %S is currently not supported" type))
(memq (type-of class)
'(built-in-class cl-structure-class eieio--class)))
(list cl--generic-typeof-generalizer))
'((base-char . characterp) ;Could be subtype of `fixnum'.
(character . natnump) ;Could be subtype of `fixnum'.
(command . commandp) ;Subtype of closure & subr.
+ (keyword . keywordp) ;Would need `keyword-with-pos`.
(natnum . natnump) ;Subtype of fixnum & bignum.
(real . numberp) ;Not clear where it would fit.
))
;; so the DAG of OClosure types is "orthogonal" to the distinction
;; between interpreted and compiled functions.
+(defun cl-functionp (object)
+ "Return non-nil if OBJECT is a member of type `function'.
+This is like `functionp' except that it returns nil for all lists and symbols,
+regardless if `funcall' would accept to call them."
+ (memq (cl-type-of object)
+ '(primitive-function subr-native-elisp module-function
+ interpreted-function byte-code-function)))
+
(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)
(cl--define-built-in-type tree-sitter-parser atom)
-(declare-function user-ptrp "data.c")
(when (fboundp 'user-ptrp)
(cl--define-built-in-type user-ptr atom nil
- ;; FIXME: Shouldn't it be called
- ;; `user-ptr-p'?
+ ;; FIXME: Shouldn't it be called `user-ptr-p'?
:predicate user-ptrp))
(cl--define-built-in-type font-object atom)
(cl--define-built-in-type font-entity atom)
The size depends on the Emacs version and compilation options.
For this build of Emacs it's %dbit."
(1+ (logb (1+ most-positive-fixnum)))))
-(cl--define-built-in-type keyword (symbol)
- "Type of those symbols whose first char is `:'.")
(cl--define-built-in-type boolean (symbol)
"Type of the canonical boolean values, i.e. either nil or t.")
(cl--define-built-in-type symbol-with-pos (symbol)
;; Example of slots we could document.
(car car) (cdr cdr))
(cl--define-built-in-type function (atom)
- "Abstract supertype of function values.")
+ "Abstract supertype of function values."
+ :predicate cl-functionp)
(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)
;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the
;; relation type <-> predicate is not bijective (bug#45576).
(defconst comp-known-predicates
+ ;; FIXME: Auto-generate (most of) it from `cl-deftype-satifies'?
'((arrayp array)
(atom atom)
(bool-vector-p bool-vector)
(booleanp boolean)
(bufferp buffer)
(char-table-p char-table)
- (characterp fixnum)
+ (characterp fixnum t)
(consp cons)
(floatp float)
(framep frame)
(hash-table-p hash-table)
(integer-or-marker-p integer-or-marker)
(integerp integer)
- (keywordp keyword)
+ (keywordp symbol t)
(listp list)
(markerp marker)
(natnump (integer 0 *))
(null null)
(number-or-marker-p number-or-marker)
(numberp number)
- (numberp number)
(obarrayp obarray)
(overlayp overlay)
(processp process)
;; Note: This doesn't work for list/vector structs since those types
;; are too difficult/unreliable to detect (so `cl-type-of' only says
;; it's a `cons' or a `vector').
- (dolist (val (list -2 10 (expt 2 128) nil t 'car
+ (dolist (val (list -2 10 (expt 2 128) nil t 'car :car
(symbol-function 'car)
(symbol-function 'progn)
- (position-symbol 'car 7)))
+ (eval '(lambda (x) (+ x 1)) t)
+ (position-symbol 'car 7)
+ (position-symbol :car 7)))
(let* ((type (cl-type-of val))
(class (cl-find-class type))
(alltypes (cl--class-allparents class))
(dolist (parent alltypes)
(should (cl-typep val parent))
(dolist (subtype (cl--class-children (cl-find-class parent)))
- (unless (memq subtype alltypes)
- (unless (memq subtype
- ;; FIXME: Some types don't have any associated
- ;; predicate,
- '( font-spec font-entity font-object
- finalizer condvar terminal
- native-comp-unit interpreted-function
- tree-sitter-compiled-query
- tree-sitter-node tree-sitter-parser
- ;; `functionp' also matches things of type
- ;; `symbol' and `cons'.
- function))
- (should-not (cl-typep val subtype)))))))))
+ (when (and (not (memq subtype alltypes))
+ (built-in-class-p (cl-find-class subtype))
+ (not (memq subtype
+ ;; FIXME: Some types don't have any associated
+ ;; predicate,
+ '( font-spec font-entity font-object
+ finalizer condvar terminal
+ native-comp-unit interpreted-function
+ tree-sitter-compiled-query
+ tree-sitter-node tree-sitter-parser))))
+ (should-not (cl-typep val subtype))))))))
;;; data-tests.el ends here
projects / emacs.git / commitdiff