Mercurial > hg > xemacs-beta
diff lisp/cl-extra.el @ 5461:568ec109e73d
Check types (unless `byte-compile-delete-errors' is t), #'char<, #'char=, etc.
src/ChangeLog addition:
2011-04-23 Aidan Kehoe <kehoea@parhasard.net>
* editfns.c:
* editfns.c (syms_of_editfns):
Implement #'char= in cl-extra.el, not here, accepting more than
two arguments as Common Lisp specifies.
lisp/ChangeLog addition:
2011-04-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (define-char-comparisons):
Add type-checking when the various character-specific comparison
predicates are used; don't check types if
byte-compile-delete-errors is non-nil at compile-time, instead use
the corresponding built-in numeric byte codes.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 23 Apr 2011 22:42:10 +0100 |
| parents | aa78b0b0b289 |
| children | f2881cb841b4 |
line wrap: on
line diff
--- a/lisp/cl-extra.el Sun Apr 24 01:01:34 2011 +0900 +++ b/lisp/cl-extra.el Sat Apr 23 22:42:10 2011 +0100 @@ -690,13 +690,59 @@ (setq float-negative-epsilon (* x 2)))))) (cl-float-limits)) -;; No type-checking here, we should add it. -(defalias 'char< '<) -(defalias 'char>= '>=) -(defalias 'char> '>) -(defalias 'char<= '<=) ;;; Character functions. +(macrolet + ((define-char-comparisons (&rest alist) + "Provide Common Lisp's character-specific comparison predicates. + +These throw errors if any arguments are non-characters, conflicting with +typical emacs behavior. This is not the case if +`byte-compile-delete-errors' is non-nil; see the documentation of that +variable. + +This doesn't include the case-insensitive comparisons, and it probably +should." + (let* ((functions (mapcar 'car alist)) + (map (mapcar #'(lambda (symbol) + `(,symbol . + ,(intern (substring (symbol-name symbol) + (length "char"))))) + functions))) + `(progn + (mapc + (function* + (lambda ((function . cl-unsafe-comparison)) + (put function 'cl-unsafe-comparison cl-unsafe-comparison) + (put function 'cl-compiler-macro + #'(lambda (form &rest arguments) + (if byte-compile-delete-errors + (cons (get (car form) 'cl-unsafe-comparison) + (cdr form)) + form))))) + ',map) + ,@(mapcar + (function* + (lambda ((function . documentation)) + `(defun ,function (character &rest more-characters) + ,documentation + (check-type character character) + (check-type more-characters + (satisfies (lambda (list) + (every 'characterp list)))) + (apply ',(cdr (assq function map)) + character more-characters)))) + alist))))) + (define-char-comparisons + (char= . "Return t if all character arguments are the same object.") + (char/= . "Return t if no two character arguments are the same object.") + (char< . "Return t if the character arguments monotonically increase.") + (char> . "Return t if the character arguments monotonically decrease.") + (char<= . "Return t if the character arguments are monotonically \ +nondecreasing.") + (char>= . "Return t if the character arguments are monotonically \ +nonincreasing."))) + (defun* digit-char-p (character &optional (radix 10)) "Return non-nil if CHARACTER represents a digit in base RADIX.