[COMMIT] Check types (unless `byte-compile-delete-errors' is t), #'char<, #'char=, etc.

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1303594930 -3600 # Node ID 568ec109e73dcf3107daae6324ad4fb04e05077b # Parent 82e220b08acebf3c5dffe0e9f8b4543db5f13e10 Check types (unless `byte-compile-delete-errors' is t), #'char<, #'char=, etc. src/ChangeLog addition: 2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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. diff -r 82e220b08ace -r 568ec109e73d lisp/ChangeLog --- a/lisp/ChangeLog Sun Apr 24 01:01:34 2011 +0900 +++ b/lisp/ChangeLog Sat Apr 23 22:42:10 2011 +0100 ＠＠ -1,3 +1,11 ＠＠ +2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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. + 2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * font.el: diff -r 82e220b08ace -r 568ec109e73d lisp/cl-extra.el --- 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. diff -r 82e220b08ace -r 568ec109e73d src/ChangeLog --- a/src/ChangeLog Sun Apr 24 01:01:34 2011 +0900 +++ b/src/ChangeLog Sat Apr 23 22:42:10 2011 +0100 ＠＠ -1,3 +1,10 ＠＠ +2011-04-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * editfns.c: + * editfns.c (syms_of_editfns): + Implement #'char= in cl-extra.el, not here, accepting more than + two arguments as Common Lisp specifies. + 2011-04-17 Jeff Sparkes <jsparkes(a)gmail.com&gt; * device-tty.c (tty_device_system_metrics): Fix compile issues for diff -r 82e220b08ace -r 568ec109e73d src/editfns.c --- a/src/editfns.c Sun Apr 24 01:01:34 2011 +0900 +++ b/src/editfns.c Sat Apr 23 22:42:10 2011 +0100 ＠＠ -2260,18 +2260,6 ＠＠ : x1 == x2) ? Qt : Qnil; } - -DEFUN ("char=", Fchar_Equal, 2, 2, 0, /* -Return t if two characters match, case is significant. -Both arguments must be characters (i.e. NOT integers). -*/ - (character1, character2)) -{ - CHECK_CHAR_COERCE_INT (character1); - CHECK_CHAR_COERCE_INT (character2); - - return EQ (character1, character2) ? Qt : Qnil; -}  #if 0 /* Undebugged FSFmacs code */ /* Transpose the markers in two regions of the current buffer, and ＠＠ -2397,7 +2385,6 ＠＠ DEFSYMBOL (Quser_files_and_directories); DEFSUBR (Fchar_equal); - DEFSUBR (Fchar_Equal); DEFSUBR (Fgoto_char); DEFSUBR (Fstring_to_char); DEFSUBR (Fchar_to_string); -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches