aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love1999-12-18 17:10:56 +0000
committerDave Love1999-12-18 17:10:56 +0000
commit76f639b0bc1c47290ac1f8c1199da599e2c13a2b (patch)
tree7a1b8043dd630cb773e322908755d0166d746081
parentf67171e6b667ec8d9387822e3b161b98636e0355 (diff)
downloademacs-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.el39
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.
405The 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.
410The result of the body appears to the compiler as a quoted constant." 387The 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)