-;; cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two)
+;;; cl-extra.el --- Common Lisp features, part 2 -*-byte-compile-dynamic: t;-*-
;; Copyright (C) 1993 Free Software Foundation, Inc.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(cond ((eq x y) t)
((stringp x)
(and (stringp y) (= (length x) (length y))
- (or (equal x y)
- (equal (downcase x) (downcase y))))) ; lazy but simple!
+ (or (string-equal x y)
+ (string-equal (downcase x) (downcase y))))) ; lazy but simple!
((numberp x)
(and (numberp y) (= x y)))
((consp x)
- (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y))))
+ (while (and (consp x) (consp y) (equalp (car x) (car y)))
+ (setq x (cdr x) y (cdr y)))
(and (not (consp x)) (equalp x y)))
((vectorp x)
(and (vectorp y) (= (length x) (length y))
(defun isqrt (a)
"Return the integer square root of the argument."
(if (and (integerp a) (> a 0))
- (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000)
- ((>= a 100) 100) (t 10)))
+ (let ((g (cond ((<= a 100) 10) ((<= a 10000) 100)
+ ((<= a 1000000) 1000) (t a)))
g2)
(while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
(setq g g2))
(defun cl-expt (x y)
"Return X raised to the power of Y. Works only for integer arguments."
- (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) x 0))
+ (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0))
(* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2)))))
(or (and (fboundp 'expt) (subrp (symbol-function 'expt)))
(defalias 'expt 'cl-expt))
(defun cl-copy-tree (tree &optional vecp)
"Make a copy of TREE.
If TREE is a cons cell, this recursively copies both its car and its cdr.
-Constrast to copy-sequence, which copies only along the cdrs. With second
+Contrast to copy-sequence, which copies only along the cdrs. With second
argument VECP, this copies vectors as well as conses."
(if (consp tree)
(let ((p (setq tree (copy-list tree))))
cl-closure-vars)
'((quote --cl-rest--)))))))
(list (car form) (list* 'lambda (cadadr form) body))))
- form))
+ (let ((found (assq (cadr form) env)))
+ (if (eq (cadr (caddr found)) 'cl-labels-args)
+ (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
+ form))))
((memq (car form) '(defun defmacro))
(list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
((and (eq (car form) 'progn) (not (cddr form)))