From 66fda7948f7d0b94194d53edcfbf27bec596c019 Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Mon, 21 Apr 2014 20:51:12 -0700 Subject: [PATCH] Optimize cl-struct-slot-value; fix test 2014-04-22 Daniel Colascione * emacs-lisp/cl-macs.el (cl-struct-sequence-type,cl-struct-slot-info): Declare pure. (cl-struct-slot-value): Conditionally use aref or nth so that the compiler produces optimal code. 2014-04-22 Daniel Colascione * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to account for removal of `cl-struct-set-slot-value'. --- lisp/ChangeLog | 7 +++++++ lisp/emacs-lisp/cl-macs.el | 9 ++++++++- test/ChangeLog | 5 +++++ test/automated/cl-lib.el | 2 +- 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5d96e867072..c4b1c051210 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2014-04-22 Daniel Colascione + + * emacs-lisp/cl-macs.el + (cl-struct-sequence-type,cl-struct-slot-info): Declare pure. + (cl-struct-slot-value): Conditionally use aref or nth so that the + compiler produces optimal code. + 2014-04-22 Stefan Monnier * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a15918d262f..47a89d0880b 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2600,6 +2600,7 @@ STRUCT-TYPE is a symbol naming a struct type. Return 'vector or 'list, or nil if STRUCT-TYPE is not a struct type. " (car (get struct-type 'cl-struct-type))) (put 'cl-struct-sequence-type 'side-effect-free t) +(put 'cl-struct-sequence-type 'pure t) (defun cl-struct-slot-info (struct-type) "Return a list of slot names of struct STRUCT-TYPE. @@ -2609,6 +2610,7 @@ slot name symbol and OPTS is a list of slot options given to slots skipped by :initial-offset may appear in the list." (get struct-type 'cl-struct-slots)) (put 'cl-struct-slot-info 'side-effect-free t) +(put 'cl-struct-slot-info 'pure t) (defun cl-struct-slot-offset (struct-type slot-name) "Return the offset of slot SLOT-NAME in STRUCT-TYPE. @@ -2942,7 +2944,12 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." STRUCT and SLOT-NAME are symbols. INST is a structure instance." (unless (cl-typep inst struct-type) (signal 'wrong-type-argument (list struct-type inst))) - (elt inst (cl-struct-slot-offset struct-type slot-name))) + ;; We could use `elt', but since the byte compiler will resolve the + ;; branch below at compile time, it's more efficient to use the + ;; type-specific accessor. + (if (eq (cl-struct-sequence-type struct-type) 'vector) + (aref inst (cl-struct-slot-offset struct-type slot-name)) + (nth (cl-struct-slot-offset struct-type slot-name) inst))) (put 'cl-struct-slot-value 'side-effect-free t) (run-hooks 'cl-macs-load-hook) diff --git a/test/ChangeLog b/test/ChangeLog index 4003a24bc6b..1163402fd19 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2014-04-22 Daniel Colascione + + * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to + account for removal of `cl-struct-set-slot-value'. + 2014-04-21 Daniel Colascione * automated/bytecomp-tests.el (test-byte-comp-compile-and-load): diff --git a/test/automated/cl-lib.el b/test/automated/cl-lib.el index 8bf1482a30a..89bc3cea392 100644 --- a/test/automated/cl-lib.el +++ b/test/automated/cl-lib.el @@ -206,7 +206,7 @@ (let ((x (make-mystruct :abc 1 :def 2))) (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) - (cl-struct-set-slot-value 'mystruct 'def x -1) + (setf (cl-struct-slot-value 'mystruct 'def x) -1) (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) -- 2.39.2