diff options
| author | Dave Love | 1999-12-18 17:10:56 +0000 |
|---|---|---|
| committer | Dave Love | 1999-12-18 17:10:56 +0000 |
| commit | 76f639b0bc1c47290ac1f8c1199da599e2c13a2b (patch) | |
| tree | 7a1b8043dd630cb773e322908755d0166d746081 | |
| parent | f67171e6b667ec8d9387822e3b161b98636e0355 (diff) | |
| download | emacs-76f639b0bc1c47290ac1f8c1199da599e2c13a2b.tar.gz emacs-76f639b0bc1c47290ac1f8c1199da599e2c13a2b.zip | |
Remove conditional definition of eval-when-compile. Don't specify abs,
expt, gethash, hash-table-count, hash-table-p as side-effect-free here.
(cl-emacs-type): Don't declare.
(cl-compile-time-init): Remove Emacs 18 compiler patch.
(cl-parse-loop-clause): Remove compatibility code.
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 39 |
1 files changed, 6 insertions, 33 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 75209c08232..af2d31cf216 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -32,8 +32,6 @@ | |||
| 32 | ;; This package was written by Dave Gillespie; it is a complete | 32 | ;; This package was written by Dave Gillespie; it is a complete |
| 33 | ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. | 33 | ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. |
| 34 | ;; | 34 | ;; |
| 35 | ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. | ||
| 36 | ;; | ||
| 37 | ;; Bug reports, comments, and suggestions are welcome! | 35 | ;; Bug reports, comments, and suggestions are welcome! |
| 38 | 36 | ||
| 39 | ;; This file contains the portions of the Common Lisp extensions | 37 | ;; This file contains the portions of the Common Lisp extensions |
| @@ -63,7 +61,6 @@ | |||
| 63 | (put 'cl-pop 'edebug-form-spec 'edebug-sexps) | 61 | (put 'cl-pop 'edebug-form-spec 'edebug-sexps) |
| 64 | (put 'cl-pop2 'edebug-form-spec 'edebug-sexps) | 62 | (put 'cl-pop2 'edebug-form-spec 'edebug-sexps) |
| 65 | 63 | ||
| 66 | (defvar cl-emacs-type) | ||
| 67 | (defvar cl-optimize-safety) | 64 | (defvar cl-optimize-safety) |
| 68 | (defvar cl-optimize-speed) | 65 | (defvar cl-optimize-speed) |
| 69 | 66 | ||
| @@ -86,20 +83,7 @@ | |||
| 86 | 83 | ||
| 87 | (defvar cl-old-bc-file-form nil) | 84 | (defvar cl-old-bc-file-form nil) |
| 88 | 85 | ||
| 89 | ;; Patch broken Emacs 18 compiler (re top-level macros). | ||
| 90 | ;; Emacs 19 compiler doesn't need this patch. | ||
| 91 | ;; Also, undo broken definition of `eql' that uses same bytecode as `eq'. | ||
| 92 | (defun cl-compile-time-init () | 86 | (defun cl-compile-time-init () |
| 93 | (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form)) | ||
| 94 | (or (fboundp 'byte-compile-flush-pending) ; Emacs 19 compiler? | ||
| 95 | (defalias 'byte-compile-file-form | ||
| 96 | (function | ||
| 97 | (lambda (form) | ||
| 98 | (setq form (macroexpand form byte-compile-macro-environment)) | ||
| 99 | (if (eq (car-safe form) 'progn) | ||
| 100 | (cons 'progn (mapcar 'byte-compile-file-form (cdr form))) | ||
| 101 | (funcall cl-old-bc-file-form form)))))) | ||
| 102 | (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro) | ||
| 103 | (run-hooks 'cl-hack-bytecomp-hook)) | 87 | (run-hooks 'cl-hack-bytecomp-hook)) |
| 104 | 88 | ||
| 105 | 89 | ||
| @@ -398,13 +382,6 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." | |||
| 398 | form))) | 382 | form))) |
| 399 | (t (eval form) form))) | 383 | (t (eval form) form))) |
| 400 | 384 | ||
| 401 | (or (and (fboundp 'eval-when-compile) | ||
| 402 | (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload))) | ||
| 403 | (eval '(defmacro eval-when-compile (&rest body) | ||
| 404 | "Like `progn', but evaluates the body at compile time. | ||
| 405 | The result of the body appears to the compiler as a quoted constant." | ||
| 406 | (list 'quote (eval (cons 'progn body)))))) | ||
| 407 | |||
| 408 | (defmacro load-time-value (form &optional read-only) | 385 | (defmacro load-time-value (form &optional read-only) |
| 409 | "Like `progn', but evaluates the body at load time. | 386 | "Like `progn', but evaluates the body at load time. |
| 410 | The result of the body appears to the compiler as a quoted constant." | 387 | The result of the body appears to the compiler as a quoted constant." |
| @@ -862,24 +839,20 @@ Valid clauses are: | |||
| 862 | 839 | ||
| 863 | ((memq word '(frame frames screen screens)) | 840 | ((memq word '(frame frames screen screens)) |
| 864 | (let ((temp (gensym))) | 841 | (let ((temp (gensym))) |
| 865 | (cl-push (list var (if (eq cl-emacs-type 'lucid) | 842 | (cl-push (list var '(selected-frame)) |
| 866 | '(selected-screen) '(selected-frame))) | ||
| 867 | loop-for-bindings) | 843 | loop-for-bindings) |
| 868 | (cl-push (list temp nil) loop-for-bindings) | 844 | (cl-push (list temp nil) loop-for-bindings) |
| 869 | (cl-push (list 'prog1 (list 'not (list 'eq var temp)) | 845 | (cl-push (list 'prog1 (list 'not (list 'eq var temp)) |
| 870 | (list 'or temp (list 'setq temp var))) | 846 | (list 'or temp (list 'setq temp var))) |
| 871 | loop-body) | 847 | loop-body) |
| 872 | (cl-push (list var (list (if (eq cl-emacs-type 'lucid) | 848 | (cl-push (list var (list 'next-frame var)) |
| 873 | 'next-screen 'next-frame) var)) | ||
| 874 | loop-for-steps))) | 849 | loop-for-steps))) |
| 875 | 850 | ||
| 876 | ((memq word '(window windows)) | 851 | ((memq word '(window windows)) |
| 877 | (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) | 852 | (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) |
| 878 | (temp (gensym))) | 853 | (temp (gensym))) |
| 879 | (cl-push (list var (if scr | 854 | (cl-push (list var (if scr |
| 880 | (list (if (eq cl-emacs-type 'lucid) | 855 | (list 'frame-selected-window scr) |
| 881 | 'screen-selected-window | ||
| 882 | 'frame-selected-window) scr) | ||
| 883 | '(selected-window))) | 856 | '(selected-window))) |
| 884 | loop-for-bindings) | 857 | loop-for-bindings) |
| 885 | (cl-push (list temp nil) loop-for-bindings) | 858 | (cl-push (list temp nil) loop-for-bindings) |
| @@ -2625,14 +2598,14 @@ surrounded by (block NAME ...)." | |||
| 2625 | 2598 | ||
| 2626 | ;;; Things that are side-effect-free. | 2599 | ;;; Things that are side-effect-free. |
| 2627 | (mapcar (function (lambda (x) (put x 'side-effect-free t))) | 2600 | (mapcar (function (lambda (x) (put x 'side-effect-free t))) |
| 2628 | '(oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm | 2601 | '(oddp evenp signum last butlast ldiff pairlis gcd lcm |
| 2629 | isqrt floor* ceiling* truncate* round* mod* rem* subseq | 2602 | isqrt floor* ceiling* truncate* round* mod* rem* subseq |
| 2630 | list-length get* getf gethash hash-table-count)) | 2603 | list-length get* getf)) |
| 2631 | 2604 | ||
| 2632 | ;;; Things that are side-effect-and-error-free. | 2605 | ;;; Things that are side-effect-and-error-free. |
| 2633 | (mapcar (function (lambda (x) (put x 'side-effect-free 'error-free))) | 2606 | (mapcar (function (lambda (x) (put x 'side-effect-free 'error-free))) |
| 2634 | '(eql floatp-safe list* subst acons equalp random-state-p | 2607 | '(eql floatp-safe list* subst acons equalp random-state-p |
| 2635 | copy-tree sublis hash-table-p)) | 2608 | copy-tree sublis)) |
| 2636 | 2609 | ||
| 2637 | 2610 | ||
| 2638 | (run-hooks 'cl-macs-load-hook) | 2611 | (run-hooks 'cl-macs-load-hook) |