[Emacs-diffs] trunk r117007: Optimize cl-struct-slot-value; fix test

[Daniel Colascione]

------------------------------------------------------------
revno: 117007
revision-id: address@hidden
parent: address@hidden
committer: Daniel Colascione <address@hidden>
branch nick: trunk
timestamp: Mon 2014-04-21 20:51:12 -0700
message:
  Optimize cl-struct-slot-value; fix test
  
  2014-04-22  Daniel Colascione  <address@hidden>
  
        * 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  <address@hidden>
  
        * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to
        account for removal of `cl-struct-set-slot-value'.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/cl-macs.el     clmacs.el-20091113204419-o5vbwnq5f7feedwu-612
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588
  test/automated/cl-lib.el       cllib.el-20130711160611-o23w1tyz0y13jq8e-1

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-04-22 03:18:15 +0000
+++ b/lisp/ChangeLog    2014-04-22 03:51:12 +0000
@@ -1,3 +1,10 @@
+2014-04-22  Daniel Colascione  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure.

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2014-04-22 03:18:15 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2014-04-22 03:51:12 +0000
@@ -2600,6 +2600,7 @@
 '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 @@
 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 @@
 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)

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-04-21 09:34:21 +0000
+++ b/test/ChangeLog    2014-04-22 03:51:12 +0000
@@ -1,3 +1,8 @@
+2014-04-22  Daniel Colascione  <address@hidden>
+
+       * 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  <address@hidden>
 
        * automated/bytecomp-tests.el (test-byte-comp-compile-and-load):

=== modified file 'test/automated/cl-lib.el'
--- a/test/automated/cl-lib.el  2014-04-21 01:28:55 +0000
+++ b/test/automated/cl-lib.el  2014-04-22 03:51:12 +0000
@@ -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))