platforms. (thanks to James Anderson for the optimization hint)
* optimization: REPLACE, SUBSEQ, and COPY-SEQ are now optimized in
more cases.
+ * optimization: STRING-{EQUAL,LESSP,GREATER-P} and their NOT-
+ variants no longer cons.
+ * optimization: Direct calls to CHAR-{EQUAL,LESSP,GREATERP} and
+ their NOT- variants no longer cons.
* enhancement: XREF information is now collected to references made
to global variables using SYMBOL-VALUE with a constant argument.
* bug fix: dead unbound variable references now signal an error.
(ucd-value-1 ,ch)
(char-code ,ch)))))
+(defun two-arg-char-equal (c1 c2)
+ (= (equal-char-code c1) (equal-char-code c2)))
+
(defun char-equal (character &rest more-characters)
#!+sb-doc
"Return T if all of the arguments are the same character.
Font, bits, and case are ignored."
(do ((clist more-characters (cdr clist)))
((null clist) t)
- (unless (= (equal-char-code (car clist))
- (equal-char-code character))
+ (unless (two-arg-char-equal (car clist) character)
(return nil))))
+(defun two-arg-char-not-equal (c1 c2)
+ (/= (equal-char-code c1) (equal-char-code c2)))
+
(defun char-not-equal (character &rest more-characters)
#!+sb-doc
"Return T if no two of the arguments are the same character.
((null list) t)
(unless (do* ((l list (cdr l)))
((null l) t)
- (if (= (equal-char-code head)
- (equal-char-code (car l)))
+ (if (two-arg-char-equal head (car l))
(return nil)))
(return nil))))
+(defun two-arg-char-lessp (c1 c2)
+ (< (equal-char-code c1) (equal-char-code c2)))
+
(defun char-lessp (character &rest more-characters)
#!+sb-doc
"Return T if the arguments are in strictly increasing alphabetic order.
(do* ((c character (car list))
(list more-characters (cdr list)))
((null list) t)
- (unless (< (equal-char-code c)
- (equal-char-code (car list)))
+ (unless (two-arg-char-lessp c (car list))
(return nil))))
+(defun two-arg-char-greaterp (c1 c2)
+ (> (equal-char-code c1) (equal-char-code c2)))
+
(defun char-greaterp (character &rest more-characters)
#!+sb-doc
"Return T if the arguments are in strictly decreasing alphabetic order.
(do* ((c character (car list))
(list more-characters (cdr list)))
((null list) t)
- (unless (> (equal-char-code c)
- (equal-char-code (car list)))
+ (unless (two-arg-char-greaterp c (car list))
(return nil))))
+(defun two-arg-char-not-greaterp (c1 c2)
+ (<= (equal-char-code c1) (equal-char-code c2)))
+
(defun char-not-greaterp (character &rest more-characters)
#!+sb-doc
"Return T if the arguments are in strictly non-decreasing alphabetic order.
(do* ((c character (car list))
(list more-characters (cdr list)))
((null list) t)
- (unless (<= (equal-char-code c)
- (equal-char-code (car list)))
+ (unless (two-arg-char-not-greaterp c (car list))
(return nil))))
+(defun two-arg-char-not-lessp (c1 c2)
+ (>= (equal-char-code c1) (equal-char-code c2)))
+
(defun char-not-lessp (character &rest more-characters)
#!+sb-doc
"Return T if the arguments are in strictly non-increasing alphabetic order.
(do* ((c character (car list))
(list more-characters (cdr list)))
((null list) t)
- (unless (>= (equal-char-code c)
- (equal-char-code (car list)))
+ (unless (two-arg-char-not-lessp c (car list))
(return nil))))
\f
;;;; miscellaneous functions
;;; negated test as appropriate. If it is a degenerate one-arg call,
;;; then we transform to code that returns true. Otherwise, we bind
;;; all the arguments and expand into a bunch of IFs.
-(declaim (ftype (function (symbol list boolean t) *) multi-compare))
-(defun multi-compare (predicate args not-p type)
+(defun multi-compare (predicate args not-p type &optional force-two-arg-p)
(let ((nargs (length args)))
(cond ((< nargs 1) (values nil t))
((= nargs 1) `(progn (the ,type ,@args) t))
((= nargs 2)
(if not-p
`(if (,predicate ,(first args) ,(second args)) nil t)
- (values nil t)))
+ (if force-two-arg-p
+ `(,predicate ,(first args) ,(second args))
+ (values nil t))))
(t
(do* ((i (1- nargs) (1- i))
(last nil current)
'character))
(define-source-transform char-equal (&rest args)
- (multi-compare 'char-equal args nil 'character))
+ (multi-compare 'sb!impl::two-arg-char-equal args nil 'character t))
(define-source-transform char-lessp (&rest args)
- (multi-compare 'char-lessp args nil 'character))
+ (multi-compare 'sb!impl::two-arg-char-lessp args nil 'character t))
(define-source-transform char-greaterp (&rest args)
- (multi-compare 'char-greaterp args nil 'character))
+ (multi-compare 'sb!impl::two-arg-char-greaterp args nil 'character t))
(define-source-transform char-not-greaterp (&rest args)
- (multi-compare 'char-greaterp args t 'character))
+ (multi-compare 'sb!impl::two-arg-char-greaterp args t 'character t))
(define-source-transform char-not-lessp (&rest args)
- (multi-compare 'char-lessp args t 'character))
+ (multi-compare 'sb!impl::two-arg-char-lessp args t 'character t))
;;; This function does source transformation of N-arg inequality
;;; functions such as /=. This is similar to MULTI-COMPARE in the <3
projects / sbcl.git / commitdiff