aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDaniel Colascione2014-04-21 11:00:19 -0700
committerDaniel Colascione2014-04-21 11:00:19 -0700
commit44faec17883a77a54378f607adea302f90f2da9d (patch)
tree61fb41a50d4f8243c4789d711775443e5c707e2a
parent9253f7af873a4a343b46c219bbba8daa6ad73fe6 (diff)
downloademacs-44faec17883a77a54378f607adea302f90f2da9d.tar.gz
emacs-44faec17883a77a54378f607adea302f90f2da9d.zip
Remove excess parameters on cl--const-expr-val
2014-04-21 Daniel Colascione <dancol@dancol.org> * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the last two parameters after all. (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member) (cl--compiler-macro-assoc,cl-struct-slot-value) (cl-struct-set-slot-value): Stop using them.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/emacs-lisp/cl-macs.el37
2 files changed, 24 insertions, 23 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0fd29f0ffba..2feab6a9583 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,4 +1,12 @@
12014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> 12014-04-21 Daniel Colascione <dancol@dancol.org>
2
3 * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the
4 last two parameters after all.
5 (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member)
6 (cl--compiler-macro-assoc,cl-struct-slot-value)
7 (cl-struct-set-slot-value): Stop using them.
8
9(2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
2 10
3 * image-mode.el (image-mode-window-put): Don't assume there's a `t' 11 * image-mode.el (image-mode-window-put): Don't assume there's a `t'
4 entry in image-mode-winprops-alist. 12 entry in image-mode-winprops-alist.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 5b9e17af23a..c97f7b94e4b 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -134,15 +134,14 @@
134 ((symbolp x) (and (memq x '(nil t)) t)) 134 ((symbolp x) (and (memq x '(nil t)) t))
135 (t t))) 135 (t t)))
136 136
137(defun cl--const-expr-val (x &optional environment default) 137(defun cl--const-expr-val (x)
138 "Return the value of X known at compile-time. 138 "Return the value of X known at compile-time.
139If X is not known at compile time, return DEFAULT. Before 139If X is not known at compile time, return nil. Before testing
140testing whether X is known at compile time, macroexpand it in 140whether X is known at compile time, macroexpand it completely in
141ENVIRONMENT." 141`macroexpand-all-environment'."
142 (let ((x (macroexpand-all x environment))) 142 (let ((x (macroexpand-all x macroexpand-all-environment)))
143 (if (macroexp-const-p x) 143 (if (macroexp-const-p x)
144 (if (consp x) (nth 1 x) x) 144 (if (consp x) (nth 1 x) x))))
145 default)))
146 145
147(defun cl--expr-contains (x y) 146(defun cl--expr-contains (x y)
148 "Count number of times X refers to Y. Return nil for 0 times." 147 "Count number of times X refers to Y. Return nil for 0 times."
@@ -526,8 +525,7 @@ its argument list allows full Common Lisp conventions."
526 look 525 look
527 `(or ,look 526 `(or ,look
528 ,(if (eq (cl--const-expr-p def) t) 527 ,(if (eq (cl--const-expr-p def) t)
529 `'(nil ,(cl--const-expr-val 528 `'(nil ,(cl--const-expr-val def))
530 def macroexpand-all-environment))
531 `(list nil ,def)))))))) 529 `(list nil ,def))))))))
532 (push karg keys))))) 530 (push karg keys)))))
533 (setq keys (nreverse keys)) 531 (setq keys (nreverse keys))
@@ -2689,8 +2687,7 @@ TYPE is a Common Lisp-style type specifier."
2689(defun cl--compiler-macro-typep (form val type) 2687(defun cl--compiler-macro-typep (form val type)
2690 (if (macroexp-const-p type) 2688 (if (macroexp-const-p type)
2691 (macroexp-let2 macroexp-copyable-p temp val 2689 (macroexp-let2 macroexp-copyable-p temp val
2692 (cl--make-type-test temp (cl--const-expr-val 2690 (cl--make-type-test temp (cl--const-expr-val type)))
2693 type macroexpand-all-environment)))
2694 form)) 2691 form))
2695 2692
2696;;;###autoload 2693;;;###autoload
@@ -2866,8 +2863,7 @@ The function's arguments should be treated as immutable.
2866 2863
2867(defun cl--compiler-macro-member (form a list &rest keys) 2864(defun cl--compiler-macro-member (form a list &rest keys)
2868 (let ((test (and (= (length keys) 2) (eq (car keys) :test) 2865 (let ((test (and (= (length keys) 2) (eq (car keys) :test)
2869 (cl--const-expr-val (nth 1 keys) 2866 (cl--const-expr-val (nth 1 keys)))))
2870 macroexpand-all-environment))))
2871 (cond ((eq test 'eq) `(memq ,a ,list)) 2867 (cond ((eq test 'eq) `(memq ,a ,list))
2872 ((eq test 'equal) `(member ,a ,list)) 2868 ((eq test 'equal) `(member ,a ,list))
2873 ((or (null keys) (eq test 'eql)) `(memql ,a ,list)) 2869 ((or (null keys) (eq test 'eql)) `(memql ,a ,list))
@@ -2875,12 +2871,11 @@ The function's arguments should be treated as immutable.
2875 2871
2876(defun cl--compiler-macro-assoc (form a list &rest keys) 2872(defun cl--compiler-macro-assoc (form a list &rest keys)
2877 (let ((test (and (= (length keys) 2) (eq (car keys) :test) 2873 (let ((test (and (= (length keys) 2) (eq (car keys) :test)
2878 (cl--const-expr-val (nth 1 keys) 2874 (cl--const-expr-val (nth 1 keys)))))
2879 macroexpand-all-environment))))
2880 (cond ((eq test 'eq) `(assq ,a ,list)) 2875 (cond ((eq test 'eq) `(assq ,a ,list))
2881 ((eq test 'equal) `(assoc ,a ,list)) 2876 ((eq test 'equal) `(assoc ,a ,list))
2882 ((and (macroexp-const-p a) (or (null keys) (eq test 'eql))) 2877 ((and (macroexp-const-p a) (or (null keys) (eq test 'eql)))
2883 (if (floatp (cl--const-expr-val a macroexpand-all-environment)) 2878 (if (floatp (cl--const-expr-val a))
2884 `(assoc ,a ,list) `(assq ,a ,list))) 2879 `(assoc ,a ,list) `(assq ,a ,list)))
2885 (t form)))) 2880 (t form))))
2886 2881
@@ -2960,9 +2955,8 @@ VALUE."
2960 2955
2961(cl-define-compiler-macro cl-struct-slot-value 2956(cl-define-compiler-macro cl-struct-slot-value
2962 (&whole orig struct-type slot-name inst) 2957 (&whole orig struct-type slot-name inst)
2963 (or (let* ((macenv macroexpand-all-environment) 2958 (or (let* ((struct-type (cl--const-expr-val struct-type))
2964 (struct-type (cl--const-expr-val struct-type macenv)) 2959 (slot-name (cl--const-expr-val slot-name)))
2965 (slot-name (cl--const-expr-val slot-name macenv)))
2966 (and struct-type (symbolp struct-type) 2960 (and struct-type (symbolp struct-type)
2967 slot-name (symbolp slot-name) 2961 slot-name (symbolp slot-name)
2968 (assq slot-name (cl-struct-slot-info struct-type)) 2962 (assq slot-name (cl-struct-slot-info struct-type))
@@ -2974,9 +2968,8 @@ VALUE."
2974 2968
2975(cl-define-compiler-macro cl-struct-set-slot-value 2969(cl-define-compiler-macro cl-struct-set-slot-value
2976 (&whole orig struct-type slot-name inst value) 2970 (&whole orig struct-type slot-name inst value)
2977 (or (let* ((macenv macroexpand-all-environment) 2971 (or (let* ((struct-type (cl--const-expr-val struct-type))
2978 (struct-type (cl--const-expr-val struct-type macenv)) 2972 (slot-name (cl--const-expr-val slot-name)))
2979 (slot-name (cl--const-expr-val slot-name macenv)))
2980 (and struct-type (symbolp struct-type) 2973 (and struct-type (symbolp struct-type)
2981 slot-name (symbolp slot-name) 2974 slot-name (symbolp slot-name)
2982 (assq slot-name (cl-struct-slot-info struct-type)) 2975 (assq slot-name (cl-struct-slot-info struct-type))