X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fchar.lisp;h=ede7352b85371b77a1b511d646b7d2436c189edc;hb=b3cadbfd3e3bb702dadc08a1cf1d57bde4da29bd;hp=f13b5163613fff786c0412dcb88f423604a24c59;hpb=8d57a74774a94181500916657014cfdd3525a238;p=jscl.git

diff --git a/src/char.lisp b/src/char.lisp
index f13b516..ede7352 100644
--- a/src/char.lisp
+++ b/src/char.lisp
@@ -1,3 +1,48 @@
+;; These comparison functions heavily borrowed from SBCL/CMUCL (public domain).
+
+(defun char= (character &rest more-characters)
+  (dolist (c more-characters t)
+    (unless (eql c character) (return nil))))
+
+(defun char/= (character &rest more-characters)
+  (do* ((head character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (dolist (c list)
+	 (when (eql head c) (return-from char/= nil)))))
+
+(defun char< (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (< (char-int c)
+		  (char-int (car list)))
+	 (return nil))))
+
+(defun char> (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (> (char-int c)
+		  (char-int (car list)))
+	 (return nil))))
+
+(defun char<= (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (<= (char-int c)
+		   (char-int (car list)))
+	 (return nil))))
+
+(defun char>= (character &rest more-characters)
+  (do* ((c character (car list))
+        (list more-characters (cdr list)))
+       ((null list) t)
+       (unless (>= (char-int c)
+		   (char-int (car list)))
+	 (return nil))))
+
 (defun character (character)
   (cond ((characterp character)
 	 character)