Commit d6f14ca7 authored by Stefan Monnier's avatar Stefan Monnier

* 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.
parent 44faec17
2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
* cl.texi (Structures): Remove cl-struct-set-slot-value.
2014-04-20 Daniel Colascione <dancol@dancol.org> 2014-04-20 Daniel Colascione <dancol@dancol.org>
* cl.texi (Declarations): Document changes to `cl-the' and defstruct functions. * cl.texi (Declarations): Document changes to `cl-the' and defstruct functions.
......
...@@ -4278,18 +4278,7 @@ not contain @code{slot-name}. ...@@ -4278,18 +4278,7 @@ not contain @code{slot-name}.
Return the value of slot @code{slot-name} in @code{inst} of Return the value of slot @code{slot-name} in @code{inst} of
@code{struct-type}. @code{struct} and @code{slot-name} are symbols. @code{struct-type}. @code{struct} and @code{slot-name} are symbols.
@code{inst} is a structure instance. This routine is also a @code{inst} is a structure instance. This routine is also a
@code{setf} place. @code{cl-struct-slot-value} uses @code{setf} place. Can signal the same errors as @code{cl-struct-slot-offset}.
@code{cl-struct-slot-offset} internally and can signal the same
errors.
@end defun
@defun cl-struct-set-slot-value struct-type slot-name inst value
Set the value of slot @code{slot-name} in @code{inst} of
@code{struct-type}. @code{struct} and @code{slot-name} are symbols.
@code{inst} is a structure instance. @code{value} is the value to
which to set the given slot. Return @code{value}.
@code{cl-struct-slot-value} uses @code{cl-struct-set-slot-offset}
internally and can signal the same errors.
@end defun @end defun
@node Assertions @node Assertions
......
...@@ -99,8 +99,7 @@ active region handling. ...@@ -99,8 +99,7 @@ active region handling.
** You can specify a function's interactive-only property via `declare'. ** You can specify a function's interactive-only property via `declare'.
However you specify it, the property affects `describe-function' output. However you specify it, the property affects `describe-function' output.
** You can access the slots of structures using `cl-struct-slot-value' ** You can access the slots of structures using `cl-struct-slot-value'.
and `cl-struct-set-slot-value'.
* Changes in Emacs 24.5 on Non-Free Operating Systems * Changes in Emacs 24.5 on Non-Free Operating Systems
......
2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure.
(inline): Don't inline cl--set-elt.
(cl-struct-slot-value): Remove explicit gv-setter and compiler-macro.
Define as inlinable instead.
(cl-struct-set-slot-value): Remove.
* emacs-lisp/cl-lib.el (cl--set-elt): Remove.
* emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute):
Use setf instead.
2014-04-21 Daniel Colascione <dancol@dancol.org> 2014-04-21 Daniel Colascione <dancol@dancol.org>
* emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the
......
...@@ -152,9 +152,6 @@ an element already on the list. ...@@ -152,9 +152,6 @@ an element already on the list.
`(setq ,place (cl-adjoin ,x ,place ,@keys))) `(setq ,place (cl-adjoin ,x ,place ,@keys)))
`(cl-callf2 cl-adjoin ,x ,place ,@keys))) `(cl-callf2 cl-adjoin ,x ,place ,@keys)))
(defun cl--set-elt (seq n val)
(if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
(defun cl--set-buffer-substring (start end val) (defun cl--set-buffer-substring (start end val)
(save-excursion (delete-region start end) (save-excursion (delete-region start end)
(goto-char start) (goto-char start)
......
...@@ -2621,6 +2621,7 @@ does not contain SLOT-NAME." ...@@ -2621,6 +2621,7 @@ does not contain SLOT-NAME."
:key #'car :test #'eq) :key #'car :test #'eq)
(error "struct %s has no slot %s" struct-type slot-name))) (error "struct %s has no slot %s" struct-type slot-name)))
(put 'cl-struct-slot-offset 'side-effect-free t) (put 'cl-struct-slot-offset 'side-effect-free t)
(put 'cl-struct-slot-offset 'pure t)
(defvar byte-compile-function-environment) (defvar byte-compile-function-environment)
(defvar byte-compile-macro-environment) (defvar byte-compile-macro-environment)
...@@ -2907,7 +2908,7 @@ The function's arguments should be treated as immutable. ...@@ -2907,7 +2908,7 @@ The function's arguments should be treated as immutable.
;;; Things that are inline. ;;; Things that are inline.
(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany
cl-notevery cl--set-elt cl-revappend cl-nreconc gethash)) cl-notevery cl-revappend cl-nreconc gethash))
;;; Things that are side-effect-free. ;;; Things that are side-effect-free.
(mapc (lambda (x) (put x 'side-effect-free t)) (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,9 +2933,11 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc."
(cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
;;; Additional functions that we can now define because we've defined ;;; Additional functions that we can now define because we've defined
;;; `cl-define-compiler-macro' and `cl-typep'. ;;; `cl-defsubst' and `cl-typep'.
(defun cl-struct-slot-value (struct-type slot-name inst) (cl-defsubst cl-struct-slot-value (struct-type slot-name inst)
;; The use of `cl-defsubst' here gives us both a compiler-macro
;; and a gv-expander "for free".
"Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
STRUCT and SLOT-NAME are symbols. INST is a structure instance." STRUCT and SLOT-NAME are symbols. INST is a structure instance."
(unless (cl-typep inst struct-type) (unless (cl-typep inst struct-type)
...@@ -2942,45 +2945,6 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance." ...@@ -2942,45 +2945,6 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance."
(elt inst (cl-struct-slot-offset struct-type slot-name))) (elt inst (cl-struct-slot-offset struct-type slot-name)))
(put 'cl-struct-slot-value 'side-effect-free t) (put 'cl-struct-slot-value 'side-effect-free t)
(defun cl-struct-set-slot-value (struct-type slot-name inst value)
"Set the value of slot SLOT-NAME in INST of STRUCT-TYPE.
STRUCT and SLOT-NAME are symbols. INST is a structure instance.
VALUE is the value to which to set the given slot. Return
VALUE."
(unless (cl-typep inst struct-type)
(signal 'wrong-type-argument (list struct-type inst)))
(setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value))
(gv-define-simple-setter cl-struct-slot-value cl-struct-set-slot-value)
(cl-define-compiler-macro cl-struct-slot-value
(&whole orig struct-type slot-name inst)
(or (let* ((struct-type (cl--const-expr-val struct-type))
(slot-name (cl--const-expr-val slot-name)))
(and struct-type (symbolp struct-type)
slot-name (symbolp slot-name)
(assq slot-name (cl-struct-slot-info struct-type))
(let ((idx (cl-struct-slot-offset struct-type slot-name)))
(cl-ecase (cl-struct-sequence-type struct-type)
(vector `(aref (cl-the ,struct-type ,inst) ,idx))
(list `(nth ,idx (cl-the ,struct-type ,inst)))))))
orig))
(cl-define-compiler-macro cl-struct-set-slot-value
(&whole orig struct-type slot-name inst value)
(or (let* ((struct-type (cl--const-expr-val struct-type))
(slot-name (cl--const-expr-val slot-name)))
(and struct-type (symbolp struct-type)
slot-name (symbolp slot-name)
(assq slot-name (cl-struct-slot-info struct-type))
(let ((idx (cl-struct-slot-offset struct-type slot-name)))
(cl-ecase (cl-struct-sequence-type struct-type)
(vector `(setf (aref (cl-the ,struct-type ,inst) ,idx)
,value))
(list `(setf (nth ,idx (cl-the ,struct-type ,inst))
,value))))))
orig))
(run-hooks 'cl-macs-load-hook) (run-hooks 'cl-macs-load-hook)
;; Local variables: ;; Local variables:
......
...@@ -166,7 +166,7 @@ SEQ1 is destructively modified, then returned. ...@@ -166,7 +166,7 @@ SEQ1 is destructively modified, then returned.
(cl-n (min (- (or cl-end1 cl-len) cl-start1) (cl-n (min (- (or cl-end1 cl-len) cl-start1)
(- (or cl-end2 cl-len) cl-start2)))) (- (or cl-end2 cl-len) cl-start2))))
(while (>= (setq cl-n (1- cl-n)) 0) (while (>= (setq cl-n (1- cl-n)) 0)
(cl--set-elt cl-seq1 (+ cl-start1 cl-n) (setf (elt cl-seq1 (+ cl-start1 cl-n))
(elt cl-seq2 (+ cl-start2 cl-n)))))) (elt cl-seq2 (+ cl-start2 cl-n))))))
(if (listp cl-seq1) (if (listp cl-seq1)
(let ((cl-p1 (nthcdr cl-start1 cl-seq1)) (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
...@@ -392,7 +392,7 @@ to avoid corrupting the original SEQ. ...@@ -392,7 +392,7 @@ to avoid corrupting the original SEQ.
cl-seq cl-seq
(setq cl-seq (copy-sequence cl-seq)) (setq cl-seq (copy-sequence cl-seq))
(or cl-from-end (or cl-from-end
(progn (cl--set-elt cl-seq cl-i cl-new) (progn (setf (elt cl-seq cl-i) cl-new)
(setq cl-i (1+ cl-i) cl-count (1- cl-count)))) (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
(apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
:start cl-i cl-keys)))))) :start cl-i cl-keys))))))
...@@ -439,7 +439,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. ...@@ -439,7 +439,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(setq cl-end (1- cl-end)) (setq cl-end (1- cl-end))
(if (cl--check-test cl-old (elt cl-seq cl-end)) (if (cl--check-test cl-old (elt cl-seq cl-end))
(progn (progn
(cl--set-elt cl-seq cl-end cl-new) (setf (elt cl-seq cl-end) cl-new)
(setq cl-count (1- cl-count))))) (setq cl-count (1- cl-count)))))
(while (and (< cl-start cl-end) (> cl-count 0)) (while (and (< cl-start cl-end) (> cl-count 0))
(if (cl--check-test cl-old (aref cl-seq cl-start)) (if (cl--check-test cl-old (aref cl-seq cl-start))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment