# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# 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@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.

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@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.
+
 2011-04-23  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* 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@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.
+
 2011-04-17  Jeff Sparkes  <jsparkes@gmail.com>
 
 	* 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);