Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 5473:ac37a5f7e5be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 17 Mar 2011 23:42:59 +0100
parents 6506fcb40fcf f00192e1cd49
children 5b08be74bb53
comparison
equal deleted inserted replaced
5472:e79980ee5efe 5473:ac37a5f7e5be
819 (defun byte-optimize-identity (form) 819 (defun byte-optimize-identity (form)
820 (if (and (cdr form) (null (cdr (cdr form)))) 820 (if (and (cdr form) (null (cdr (cdr form))))
821 (nth 1 form) 821 (nth 1 form)
822 (byte-compile-warn "identity called with %d arg%s, but requires 1" 822 (byte-compile-warn "identity called with %d arg%s, but requires 1"
823 (length (cdr form)) 823 (length (cdr form))
824 (if (= 1 (length (cdr form))) "" "s")) 824 (if (eql 1 (length (cdr form))) "" "s"))
825 form)) 825 form))
826 826
827 (defun byte-optimize-car (form) 827 (defun byte-optimize-car (form)
828 (let ((arg (cadr form))) 828 (let ((arg (cadr form)))
829 (cond 829 (cond
1017 ((or (nth 3 form) (nthcdr 4 form)) 1017 ((or (nth 3 form) (nthcdr 4 form))
1018 (list 'if 1018 (list 'if
1019 ;; Don't make a double negative; 1019 ;; Don't make a double negative;
1020 ;; instead, take away the one that is there. 1020 ;; instead, take away the one that is there.
1021 (if (and (consp clause) (memq (car clause) '(not null)) 1021 (if (and (consp clause) (memq (car clause) '(not null))
1022 (= (length clause) 2)) ; (not xxxx) or (not (xxxx)) 1022 (eql (length clause) 2)) ; (not xxxx) or (not (xxxx))
1023 (nth 1 clause) 1023 (nth 1 clause)
1024 (list 'not clause)) 1024 (list 'not clause))
1025 (if (nthcdr 4 form) 1025 (if (nthcdr 4 form)
1026 (cons 'progn (nthcdr 3 form)) 1026 (cons 'progn (nthcdr 3 form))
1027 (nth 3 form)))) 1027 (nth 3 form))))
1159 (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil))))) 1159 (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
1160 1160
1161 1161
1162 (put 'nth 'byte-optimizer 'byte-optimize-nth) 1162 (put 'nth 'byte-optimizer 'byte-optimize-nth)
1163 (defun byte-optimize-nth (form) 1163 (defun byte-optimize-nth (form)
1164 (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1))) 1164 (if (and (eql (safe-length form) 3) (memq (nth 1 form) '(0 1)))
1165 (list 'car (if (zerop (nth 1 form)) 1165 (list 'car (if (zerop (nth 1 form))
1166 (nth 2 form) 1166 (nth 2 form)
1167 (list 'cdr (nth 2 form)))) 1167 (list 'cdr (nth 2 form))))
1168 (byte-optimize-predicate form))) 1168 (byte-optimize-predicate form)))
1169 1169
1170 (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) 1170 (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
1171 (defun byte-optimize-nthcdr (form) 1171 (defun byte-optimize-nthcdr (form)
1172 (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) 1172 (if (and (eql (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2))))
1173 (byte-optimize-predicate form) 1173 (byte-optimize-predicate form)
1174 (let ((count (nth 1 form))) 1174 (let ((count (nth 1 form)))
1175 (setq form (nth 2 form)) 1175 (setq form (nth 2 form))
1176 (while (>= (setq count (1- count)) 0) 1176 (while (>= (setq count (1- count)) 0)
1177 (setq form (list 'cdr form))) 1177 (setq form (list 'cdr form)))