diff options
| author | Stefan Monnier | 2014-04-21 23:18:15 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2014-04-21 23:18:15 -0400 |
| commit | d6f14ca729315dd94cdb24da47e1569519e3a4dd (patch) | |
| tree | 61f745135efdeaee056f0b5c0df5039d8a136cef | |
| parent | 44faec17883a77a54378f607adea302f90f2da9d (diff) | |
| download | emacs-d6f14ca729315dd94cdb24da47e1569519e3a4dd.tar.gz emacs-d6f14ca729315dd94cdb24da47e1569519e3a4dd.zip | |
* lisp/emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure.
(cl--set-elt): Don't proclaim as inline.
(cl-struct-slot-value): Remove explicit gv-setter and compiler-macro.
Define as inlinable instead.
(cl-struct-set-slot-value): Remove.
* doc/misc/cl.texi (Structures): Remove cl-struct-set-slot-value.
* lisp/emacs-lisp/cl-lib.el (cl--set-elt): Remove.
* lisp/emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute):
Use setf instead.
| -rw-r--r-- | doc/misc/ChangeLog | 4 | ||||
| -rw-r--r-- | doc/misc/cl.texi | 13 | ||||
| -rw-r--r-- | etc/NEWS | 3 | ||||
| -rw-r--r-- | lisp/ChangeLog | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 48 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-seq.el | 6 |
7 files changed, 27 insertions, 62 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 949552091e5..fb54cd30b12 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * cl.texi (Structures): Remove cl-struct-set-slot-value. | ||
| 4 | |||
| 1 | 2014-04-20 Daniel Colascione <dancol@dancol.org> | 5 | 2014-04-20 Daniel Colascione <dancol@dancol.org> |
| 2 | 6 | ||
| 3 | * cl.texi (Declarations): Document changes to `cl-the' and defstruct functions. | 7 | * cl.texi (Declarations): Document changes to `cl-the' and defstruct functions. |
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 78bc8fb9479..24ec6ea3c70 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi | |||
| @@ -4278,18 +4278,7 @@ not contain @code{slot-name}. | |||
| 4278 | Return the value of slot @code{slot-name} in @code{inst} of | 4278 | Return the value of slot @code{slot-name} in @code{inst} of |
| 4279 | @code{struct-type}. @code{struct} and @code{slot-name} are symbols. | 4279 | @code{struct-type}. @code{struct} and @code{slot-name} are symbols. |
| 4280 | @code{inst} is a structure instance. This routine is also a | 4280 | @code{inst} is a structure instance. This routine is also a |
| 4281 | @code{setf} place. @code{cl-struct-slot-value} uses | 4281 | @code{setf} place. Can signal the same errors as @code{cl-struct-slot-offset}. |
| 4282 | @code{cl-struct-slot-offset} internally and can signal the same | ||
| 4283 | errors. | ||
| 4284 | @end defun | ||
| 4285 | |||
| 4286 | @defun cl-struct-set-slot-value struct-type slot-name inst value | ||
| 4287 | Set the value of slot @code{slot-name} in @code{inst} of | ||
| 4288 | @code{struct-type}. @code{struct} and @code{slot-name} are symbols. | ||
| 4289 | @code{inst} is a structure instance. @code{value} is the value to | ||
| 4290 | which to set the given slot. Return @code{value}. | ||
| 4291 | @code{cl-struct-slot-value} uses @code{cl-struct-set-slot-offset} | ||
| 4292 | internally and can signal the same errors. | ||
| 4293 | @end defun | 4282 | @end defun |
| 4294 | 4283 | ||
| 4295 | @node Assertions | 4284 | @node Assertions |
| @@ -99,8 +99,7 @@ active region handling. | |||
| 99 | ** You can specify a function's interactive-only property via `declare'. | 99 | ** You can specify a function's interactive-only property via `declare'. |
| 100 | However you specify it, the property affects `describe-function' output. | 100 | However you specify it, the property affects `describe-function' output. |
| 101 | 101 | ||
| 102 | ** You can access the slots of structures using `cl-struct-slot-value' | 102 | ** You can access the slots of structures using `cl-struct-slot-value'. |
| 103 | and `cl-struct-set-slot-value'. | ||
| 104 | 103 | ||
| 105 | 104 | ||
| 106 | * Changes in Emacs 24.5 on Non-Free Operating Systems | 105 | * Changes in Emacs 24.5 on Non-Free Operating Systems |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2feab6a9583..5d96e867072 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,15 @@ | |||
| 1 | 2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. | ||
| 4 | (inline): Don't inline cl--set-elt. | ||
| 5 | (cl-struct-slot-value): Remove explicit gv-setter and compiler-macro. | ||
| 6 | Define as inlinable instead. | ||
| 7 | (cl-struct-set-slot-value): Remove. | ||
| 8 | |||
| 9 | * emacs-lisp/cl-lib.el (cl--set-elt): Remove. | ||
| 10 | * emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute): | ||
| 11 | Use setf instead. | ||
| 12 | |||
| 1 | 2014-04-21 Daniel Colascione <dancol@dancol.org> | 13 | 2014-04-21 Daniel Colascione <dancol@dancol.org> |
| 2 | 14 | ||
| 3 | * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the | 15 | * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the |
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index b9556b06f50..929e3dfb2f5 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el | |||
| @@ -152,9 +152,6 @@ an element already on the list. | |||
| 152 | `(setq ,place (cl-adjoin ,x ,place ,@keys))) | 152 | `(setq ,place (cl-adjoin ,x ,place ,@keys))) |
| 153 | `(cl-callf2 cl-adjoin ,x ,place ,@keys))) | 153 | `(cl-callf2 cl-adjoin ,x ,place ,@keys))) |
| 154 | 154 | ||
| 155 | (defun cl--set-elt (seq n val) | ||
| 156 | (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) | ||
| 157 | |||
| 158 | (defun cl--set-buffer-substring (start end val) | 155 | (defun cl--set-buffer-substring (start end val) |
| 159 | (save-excursion (delete-region start end) | 156 | (save-excursion (delete-region start end) |
| 160 | (goto-char start) | 157 | (goto-char start) |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c97f7b94e4b..a15918d262f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -2621,6 +2621,7 @@ does not contain SLOT-NAME." | |||
| 2621 | :key #'car :test #'eq) | 2621 | :key #'car :test #'eq) |
| 2622 | (error "struct %s has no slot %s" struct-type slot-name))) | 2622 | (error "struct %s has no slot %s" struct-type slot-name))) |
| 2623 | (put 'cl-struct-slot-offset 'side-effect-free t) | 2623 | (put 'cl-struct-slot-offset 'side-effect-free t) |
| 2624 | (put 'cl-struct-slot-offset 'pure t) | ||
| 2624 | 2625 | ||
| 2625 | (defvar byte-compile-function-environment) | 2626 | (defvar byte-compile-function-environment) |
| 2626 | (defvar byte-compile-macro-environment) | 2627 | (defvar byte-compile-macro-environment) |
| @@ -2907,7 +2908,7 @@ The function's arguments should be treated as immutable. | |||
| 2907 | 2908 | ||
| 2908 | ;;; Things that are inline. | 2909 | ;;; Things that are inline. |
| 2909 | (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany | 2910 | (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany |
| 2910 | cl-notevery cl--set-elt cl-revappend cl-nreconc gethash)) | 2911 | cl-notevery cl-revappend cl-nreconc gethash)) |
| 2911 | 2912 | ||
| 2912 | ;;; Things that are side-effect-free. | 2913 | ;;; Things that are side-effect-free. |
| 2913 | (mapc (lambda (x) (put x 'side-effect-free t)) | 2914 | (mapc (lambda (x) (put x 'side-effect-free t)) |
| @@ -2932,9 +2933,11 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." | |||
| 2932 | (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) | 2933 | (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) |
| 2933 | 2934 | ||
| 2934 | ;;; Additional functions that we can now define because we've defined | 2935 | ;;; Additional functions that we can now define because we've defined |
| 2935 | ;;; `cl-define-compiler-macro' and `cl-typep'. | 2936 | ;;; `cl-defsubst' and `cl-typep'. |
| 2936 | 2937 | ||
| 2937 | (defun cl-struct-slot-value (struct-type slot-name inst) | 2938 | (cl-defsubst cl-struct-slot-value (struct-type slot-name inst) |
| 2939 | ;; The use of `cl-defsubst' here gives us both a compiler-macro | ||
| 2940 | ;; and a gv-expander "for free". | ||
| 2938 | "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. | 2941 | "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. |
| 2939 | STRUCT and SLOT-NAME are symbols. INST is a structure instance." | 2942 | STRUCT and SLOT-NAME are symbols. INST is a structure instance." |
| 2940 | (unless (cl-typep inst struct-type) | 2943 | (unless (cl-typep inst struct-type) |
| @@ -2942,45 +2945,6 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance." | |||
| 2942 | (elt inst (cl-struct-slot-offset struct-type slot-name))) | 2945 | (elt inst (cl-struct-slot-offset struct-type slot-name))) |
| 2943 | (put 'cl-struct-slot-value 'side-effect-free t) | 2946 | (put 'cl-struct-slot-value 'side-effect-free t) |
| 2944 | 2947 | ||
| 2945 | (defun cl-struct-set-slot-value (struct-type slot-name inst value) | ||
| 2946 | "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. | ||
| 2947 | STRUCT and SLOT-NAME are symbols. INST is a structure instance. | ||
| 2948 | VALUE is the value to which to set the given slot. Return | ||
| 2949 | VALUE." | ||
| 2950 | (unless (cl-typep inst struct-type) | ||
| 2951 | (signal 'wrong-type-argument (list struct-type inst))) | ||
| 2952 | (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) | ||
| 2953 | |||
| 2954 | (gv-define-simple-setter cl-struct-slot-value cl-struct-set-slot-value) | ||
| 2955 | |||
| 2956 | (cl-define-compiler-macro cl-struct-slot-value | ||
| 2957 | (&whole orig struct-type slot-name inst) | ||
| 2958 | (or (let* ((struct-type (cl--const-expr-val struct-type)) | ||
| 2959 | (slot-name (cl--const-expr-val slot-name))) | ||
| 2960 | (and struct-type (symbolp struct-type) | ||
| 2961 | slot-name (symbolp slot-name) | ||
| 2962 | (assq slot-name (cl-struct-slot-info struct-type)) | ||
| 2963 | (let ((idx (cl-struct-slot-offset struct-type slot-name))) | ||
| 2964 | (cl-ecase (cl-struct-sequence-type struct-type) | ||
| 2965 | (vector `(aref (cl-the ,struct-type ,inst) ,idx)) | ||
| 2966 | (list `(nth ,idx (cl-the ,struct-type ,inst))))))) | ||
| 2967 | orig)) | ||
| 2968 | |||
| 2969 | (cl-define-compiler-macro cl-struct-set-slot-value | ||
| 2970 | (&whole orig struct-type slot-name inst value) | ||
| 2971 | (or (let* ((struct-type (cl--const-expr-val struct-type)) | ||
| 2972 | (slot-name (cl--const-expr-val slot-name))) | ||
| 2973 | (and struct-type (symbolp struct-type) | ||
| 2974 | slot-name (symbolp slot-name) | ||
| 2975 | (assq slot-name (cl-struct-slot-info struct-type)) | ||
| 2976 | (let ((idx (cl-struct-slot-offset struct-type slot-name))) | ||
| 2977 | (cl-ecase (cl-struct-sequence-type struct-type) | ||
| 2978 | (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) | ||
| 2979 | ,value)) | ||
| 2980 | (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) | ||
| 2981 | ,value)))))) | ||
| 2982 | orig)) | ||
| 2983 | |||
| 2984 | (run-hooks 'cl-macs-load-hook) | 2948 | (run-hooks 'cl-macs-load-hook) |
| 2985 | 2949 | ||
| 2986 | ;; Local variables: | 2950 | ;; Local variables: |
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index aa88264c4ab..a7078328748 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el | |||
| @@ -166,7 +166,7 @@ SEQ1 is destructively modified, then returned. | |||
| 166 | (cl-n (min (- (or cl-end1 cl-len) cl-start1) | 166 | (cl-n (min (- (or cl-end1 cl-len) cl-start1) |
| 167 | (- (or cl-end2 cl-len) cl-start2)))) | 167 | (- (or cl-end2 cl-len) cl-start2)))) |
| 168 | (while (>= (setq cl-n (1- cl-n)) 0) | 168 | (while (>= (setq cl-n (1- cl-n)) 0) |
| 169 | (cl--set-elt cl-seq1 (+ cl-start1 cl-n) | 169 | (setf (elt cl-seq1 (+ cl-start1 cl-n)) |
| 170 | (elt cl-seq2 (+ cl-start2 cl-n)))))) | 170 | (elt cl-seq2 (+ cl-start2 cl-n)))))) |
| 171 | (if (listp cl-seq1) | 171 | (if (listp cl-seq1) |
| 172 | (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) | 172 | (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) |
| @@ -392,7 +392,7 @@ to avoid corrupting the original SEQ. | |||
| 392 | cl-seq | 392 | cl-seq |
| 393 | (setq cl-seq (copy-sequence cl-seq)) | 393 | (setq cl-seq (copy-sequence cl-seq)) |
| 394 | (or cl-from-end | 394 | (or cl-from-end |
| 395 | (progn (cl--set-elt cl-seq cl-i cl-new) | 395 | (progn (setf (elt cl-seq cl-i) cl-new) |
| 396 | (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) | 396 | (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) |
| 397 | (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count | 397 | (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count |
| 398 | :start cl-i cl-keys)))))) | 398 | :start cl-i cl-keys)))))) |
| @@ -439,7 +439,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 439 | (setq cl-end (1- cl-end)) | 439 | (setq cl-end (1- cl-end)) |
| 440 | (if (cl--check-test cl-old (elt cl-seq cl-end)) | 440 | (if (cl--check-test cl-old (elt cl-seq cl-end)) |
| 441 | (progn | 441 | (progn |
| 442 | (cl--set-elt cl-seq cl-end cl-new) | 442 | (setf (elt cl-seq cl-end) cl-new) |
| 443 | (setq cl-count (1- cl-count))))) | 443 | (setq cl-count (1- cl-count))))) |
| 444 | (while (and (< cl-start cl-end) (> cl-count 0)) | 444 | (while (and (< cl-start cl-end) (> cl-count 0)) |
| 445 | (if (cl--check-test cl-old (aref cl-seq cl-start)) | 445 | (if (cl--check-test cl-old (aref cl-seq cl-start)) |