Commit d4f0427b authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/cl-macs.el: Improve type->predicate mapping.

(cl--macroexp-fboundp): New function.
(cl--make-type-test): Use it.

Fixes: debbugs:16520
parent 565935c8
2014-01-23 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el: Improve type->predicate mapping (bug#16520).
(cl--macroexp-fboundp): New function.
(cl--make-type-test): Use it.
2014-01-23 Glenn Morris <rgm@gnu.org>
* emacs-lisp/lisp-mode.el (eval-print-last-sexp, eval-last-sexp):
......
......@@ -2588,6 +2588,17 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc."
(put ',name 'cl-deftype-handler
(cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
(defvar byte-compile-function-environment)
(defvar byte-compile-macro-environment)
(defun cl--macroexp-fboundp (sym)
"Return non-nil if SYM will be bound when we run the code.
Of course, we really can't know that for sure, so it's just a heuristic."
(or (fboundp sym)
(and (cl--compiling-file)
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym byte-compile-macro-environment))))))
(defun cl--make-type-test (val type)
(if (symbolp type)
(cond ((get type 'cl-deftype-handler)
......@@ -2603,8 +2614,12 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc."
(t
(let* ((name (symbol-name type))
(namep (intern (concat name "p"))))
(if (fboundp namep) (list namep val)
(list (intern (concat name "-p")) val)))))
(cond
((cl--macroexp-fboundp namep) (list namep val))
((cl--macroexp-fboundp
(setq namep (intern (concat name "-p"))))
(list namep val))
(t (list type val))))))
(cond ((get (car type) 'cl-deftype-handler)
(cl--make-type-test val (apply (get (car type) 'cl-deftype-handler)
(cdr type))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment